justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Minor tweaking, argument refining

Browse Source
This commit is contained in:
justin
2022-10-29 12:20:19 +01:00
parent af6cdff063
commit afaef480db
17 changed files with 59 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base/Coordinate.hs
+9 -9
View File
@@ -6,7 +6,10 @@ module Dodge.Base.Coordinate (
import Control.Lens
import Dodge.Base.WinScale
import Dodge.Data.Universe
import Dodge.Data.CamPos
import Dodge.Data.Config
import Dodge.Data.HUD
import Dodge.Data.Input
import Geometry
---- | Transform coordinates from world position to screen coordinates.
@@ -30,10 +33,9 @@ worldPosToScreen cam =
{- | Transform coordinates from the map position to screen
coordinates.
-}
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
cartePosToScreen :: Configuration -> HUD -> Point2 -> Point2
cartePosToScreen cfig thehud = doWindowScale cfig . doRotate . doZoom . doTranslate
where
thehud = w ^. cWorld . lWorld . hud
doTranslate p = p -.- (thehud ^. carteCenter) -- _carteCenter (_hud (_cWorld w))
doZoom p = (thehud ^. carteZoom) *.* p
doRotate p = rotateV (negate $ thehud ^. carteRot) p
@@ -42,12 +44,10 @@ cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
--crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr, 0)
-- | The mouse position in world coordinates.
mouseWorldPos :: World -> Point2
mouseWorldPos w =
mouseWorldPos :: Input -> CamPos -> Point2
mouseWorldPos inp cam =
(cam ^. camCenter)
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos $ _input w)
where
cam = w ^. cWorld . lWorld . camPos
+.+ (1 / (cam ^. camZoom)) *.* rotateV (cam ^. camRot) (_mousePos inp)
---- | The mouse position in map coordinates
--mouseCartePos :: World -> Point2
src/Dodge/Bullet.hs
+1 -1
View File
@@ -78,7 +78,7 @@ useAmmoParams it cr w =
return $ FlechetteTrajectory tpos
BezierTrajectory{} -> fromMaybe BasicBulletTrajectory $ do
tpos <- it ^? itTargeting . tgPos . _Just
return $ BezierTrajectory sp tpos (mouseWorldPos w)
return $ BezierTrajectory sp tpos (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos))
bounceDir :: (Point2, Either Creature Wall) -> Maybe Point2
bounceDir (_, Right wl) | _wlBouncy wl = Just $ uncurry (-.-) (_wlLine wl)
src/Dodge/Clock.hs
+3 -3
View File
@@ -4,12 +4,12 @@ module Dodge.Clock (
import Control.Lens
import qualified Data.Vector as V
import Dodge.Data.World
import Dodge.Data.LWorld
clockCycle :: Int -> V.Vector a -> World -> a
clockCycle :: Int -> V.Vector a -> LWorld -> a
{-# INLINEABLE clockCycle #-}
clockCycle tPeriod xs w = xs V.! i
where
l = V.length xs
t = (w ^. cWorld . lWorld . lClock) `mod` (l * tPeriod)
t = (w ^. lClock) `mod` (l * tPeriod)
i = t `div` tPeriod
src/Dodge/Creature/Action/Blink.hs
+3 -3
View File
@@ -26,7 +26,7 @@ blinkActionMousePos cr w =
& inverseShockwaveAt cpos 40 2 2
where
cid = _crID cr
p1 = mouseWorldPos w
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
cpos = _crPos cr
--p2 = bouncePoint (const True) 1 cpos p1 w
p2 = pushIntoMaybe $ collideCircWalls cpos p1 r (wlsNearSeg cpos p1 w)
@@ -70,7 +70,7 @@ unsafeBlinkAction cr w
wl <- snd $ collidePointWallsFilter (const True) mwp cpos w
return (isLHS mwp `uncurry` _wlLine wl)
cid = _crID cr
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
cpos = _crPos cr
blinkShockwave ::
@@ -96,7 +96,7 @@ blinkActionFail cr w =
distR = 120
distortionBulge = RadialDistortion cpos (cpos +.+ V2 distR 0) (cpos +.+ V2 0 distR) 1.9
cid = _crID cr
p1 = mouseWorldPos w
p1 = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
cpos = _crPos cr
p2 = bouncePoint (const True) 1 cpos p1 w
r = 1.5 * _crRad cr
src/Dodge/Creature/Picture/Awareness.hs
+2 -1
View File
@@ -24,9 +24,10 @@ creatureDisplayText w cr =
, \cr' -> [crDisplayAwareness cr']
]
)
w
lw
cr
where
lw = w ^. cWorld . lWorld
campos = w ^. cWorld . lWorld . camPos . camViewFrom
theScale = 0.15 / (w ^. cWorld . lWorld . camPos . camZoom)
cpos = _crPos cr
src/Dodge/Creature/YourControl.hs
+1 -1
View File
@@ -61,7 +61,7 @@ wasdWithAiming w speed cr
movAbs = rotateV (w ^. cWorld . lWorld . camPos . camRot) $ normalizeV movDir
isAiming = _posture (_crStance cr) == Aiming
mouseDir = case cr ^? crInv . ix (crSel cr) . itScope . scopePos of
Just _ -> argV $ mouseWorldPos w -.- _crPos cr
Just _ -> argV $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- _crPos cr
_ -> argV (_mousePos (_input w)) + (w ^. cWorld . lWorld . camPos . camRot)
wasdM :: SDL.Scancode -> Point2
src/Dodge/HeldUse.hs
+1 -1
View File
@@ -348,7 +348,7 @@ useMod hm = case hm of
directedTelPos it cr w = (p, a)
where
p = fromMaybe (_crPos cr) $ it ^? itTargeting . tgPos . _Just
a = argV (mouseWorldPos w -.- p)
a = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- p)
moddelay x = itUse . heldConsumption . laAmmoType . amBullet . buDelayFraction .~ x
modcrpos x cr =
cr & crDir %~ tweenAngles x (_crOldDir cr)
src/Dodge/Item/Weapon/BatteryGuns.hs
+2 -2
View File
@@ -148,7 +148,7 @@ circleLaser it cr w
| otherwise = w
where
cpos = _crPos cr
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
pos = _crPos cr +.+ rotateV dir (V2 0 (max 70 $ dist cpos mwp))
dir = fromIntegral (_lasCycle (_itParams it)) * pi / 1000
phasev = _phaseV . _itParams $ _crInv cr IM.! crSel cr
@@ -167,7 +167,7 @@ shootDualLaser it cr w =
gap = _dbGap . _itParams $ it
posl = pos +.+ (- gap) *.* vNormal (unitVectorAtAngle dir)
posr = pos +.+ gap *.* vNormal (unitVectorAtAngle dir)
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
mwp'
| dist mwp (_crPos cr) < aimlength + 5 = _crPos cr +.+ (aimlength + 5) *.* unitVectorAtAngle dir
| otherwise = mwp
src/Dodge/Item/Weapon/ExtraEffect.hs
+4 -4
View File
@@ -83,7 +83,7 @@ targetRBCreatureUp it cr w t
. filter (canseepos . _crPos)
$ crsNearCirc mwp 40 w
canseepos p = hasLOS (_crPos cr) p w
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
updatePos t' = t' & tgPos .~ posFromMaybeID (_tgID t')
posFromMaybeID Nothing = Nothing
posFromMaybeID (Just i) = w ^? cWorld . lWorld . creatures . ix i . crPos
@@ -107,7 +107,7 @@ targetCursorUpdate :: World -> Targeting -> Targeting
targetCursorUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
t
& tgPos . _Just .~ mouseWorldPos w
& tgPos . _Just .~ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
& tgActive .~ True
| otherwise =
t & tgPos %~ const Nothing
@@ -117,7 +117,7 @@ targetRBPressUpdate :: World -> Targeting -> Targeting
targetRBPressUpdate w t
| SDL.ButtonRight `M.member` _mouseButtons (_input w) =
t
& tgPos %~ maybe (Just $ mouseWorldPos w) Just
& tgPos %~ maybe (Just $ mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) Just
& tgActive .~ True
| otherwise =
t & tgPos %~ const Nothing
@@ -139,7 +139,7 @@ targetLaserUpdate _ cr w t
where
(mp, _) = reflectLaserAlong 0.2 sp ep w
sp = _crPos cr +.+ 15 *.* unitVectorAtAngle (_crDir cr)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos w -.- sp)
ep = sp +.+ 5000 *.* normalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- sp)
addLaserPic =
cWorld . lWorld . lasers
.:~ LaserStart
src/Dodge/Item/Weapon/TriggerType.hs
+2 -2
View File
@@ -698,12 +698,12 @@ duplicateOffsetsFocus xs eff item cr w = foldr f w poss
& crPos %~ (+.+ pos)
& crDir .~ thedir pos
thedir pos
| dist (mouseWorldPos w) (_crPos cr) < aimingMuzzlePos cr item =
| dist (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)) (_crPos cr) < aimingMuzzlePos cr item =
argV
( _crPos cr +.+ aimingMuzzlePos cr item *.* unitVectorAtAngle (_crDir cr)
-.- (_crPos cr +.+ pos)
)
| otherwise = argV (mouseWorldPos w -.- (_crPos cr +.+ pos))
| otherwise = argV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- (_crPos cr +.+ pos))
duplicateItem :: (Item -> [Item]) -> ChainEffect
duplicateItem fit eff itm cr w = foldr f w (fit itm)
src/Dodge/Item/Weapon/Utility.hs
+1 -1
View File
@@ -84,7 +84,7 @@ unsafeBlinkGun =
useForceFieldGun :: Item -> Creature -> World -> World
useForceFieldGun itm cr w = fromMaybe w $ do
a <- _tgPos $ _itTargeting itm
let mwp = mouseWorldPos w
let mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
b = if dist a mwp < 100 then mwp else a +.+ 100 *.* normalizeV (mwp -.- a)
wlline = (a, b)
return $
src/Dodge/Luse.hs
+1 -1
View File
@@ -98,7 +98,7 @@ boostPoint x cr w = case mayp2 of
where
cpos = _crPos cr
r = 1.5 * _crRad cr
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos w -.- cpos)
p1 = cpos +.+ x *.* squashNormalizeV (mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos) -.- cpos)
mayp2 = bouncePoint (const True) 1 cpos p1 w
addBoostShockwave ::
src/Dodge/Render/HUD.hs
+8 -8
View File
@@ -92,7 +92,7 @@ subInventoryDisplay subinv cfig w = case subinv of
, invHead cfig "TWEAK"
, listPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
]
DisplayTerminal tid -> displayTerminal tid cfig w
DisplayTerminal tid -> displayTerminal tid cfig (w ^. cWorld . lWorld)
CombineInventory mi ->
pictures
[ invHead cfig "COMBINE"
@@ -160,9 +160,9 @@ itmInfo mit = fromMaybe [] $ do
itm <- mit
return (map show . M.assocs . _iyModules $ _itType itm)
displayTerminal :: Int -> Configuration -> World -> Picture
displayTerminal :: Int -> Configuration -> LWorld -> Picture
displayTerminal tid cfig w = fromMaybe mempty $ do
tm <- w ^? cWorld . lWorld . terminals . ix tid
tm <- w ^? terminals . ix tid
return $
pictures
[ invHead cfig (_tmTitle tm ++ ":T" ++ show tid)
@@ -334,7 +334,7 @@ drawCarte cfig w =
where
iPos = w ^. cWorld . lWorld . selLocation
locs = map (\(_, s) -> (s, white)) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locPoss = map (cartePosToScreen cfig w . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locPoss = map (cartePosToScreen cfig (w ^. cWorld . lWorld . hud) . ($ w) . doWorldPos . fst) . IM.elems . _seenLocations . _lWorld $ _cWorld w
locTexts = map fst locs
displayListEndCoords :: Configuration -> [String] -> [Point2]
@@ -348,12 +348,12 @@ displayListEndCoords cfig ss = map (doWindowScale cfig) $ zipWith h ss $ map f [
mapOverlay :: Configuration -> World -> [Picture]
mapOverlay cfig w =
(color (withAlpha 0.5 black) . polygon $ reverse $ rectNSWE 1 (-1) 1 (-1)) :
(mapMaybe (mapWall cfig w) . IM.elems $ w ^. cWorld . lWorld . walls)
(mapMaybe (mapWall cfig (w ^. cWorld . lWorld . hud)) . IM.elems $ w ^. cWorld . lWorld . walls)
mapWall :: Configuration -> World -> Wall -> Maybe Picture
mapWall cfig w wl =
mapWall :: Configuration -> HUD -> Wall -> Maybe Picture
mapWall cfig thehud wl =
if _wlSeen wl
then Just . color c . polygon $ map (cartePosToScreen cfig w) [x, x +.+ n2, y +.+ n2, y]
then Just . color c . polygon $ map (cartePosToScreen cfig thehud) [x, x +.+ n2, y +.+ n2, y]
else Nothing
where
t = normalizeV (y -.- x)
src/Dodge/Render/ShapePicture.hs
+2 -2
View File
@@ -291,7 +291,7 @@ drawDDATest w =
<> setLayer DebugLayer (color yellow (line [cvf, mwp]))
where
cvf = w ^. cWorld . lWorld . camPos . camViewFrom
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
--ps = ddaStreamX 50 cvf mwp
ps = zoneOfSeg 50 cvf mwp
@@ -378,7 +378,7 @@ drawMousePosition cfig w =
$ shortPoint2 mwp
where
p = worldPosToScreen (w ^. cWorld . lWorld . camPos) mwp
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
drawWlIDs :: Configuration -> World -> Picture
drawWlIDs cfig w = setLayer FixedCoordLayer $ foldMap f (w ^. cWorld . lWorld . walls)
src/Dodge/Targeting/Draw.hs
+1 -1
View File
@@ -23,7 +23,7 @@ targetDistanceDraw :: Item -> Creature -> Configuration -> World -> Picture
targetDistanceDraw itm _ cfig w = fromMaybe mempty $ do
p <- itm ^? itTargeting . tgPos . _Just
let p1 = worldPosToScreen cam p
mwp = mouseWorldPos w
mwp = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)
p2 = worldPosToScreen cam mwp
thecol = if dist p mwp > 100 then red else white
return $
src/Dodge/Update.hs
+17 -15
View File
@@ -147,7 +147,7 @@ functionalUpdate w =
checkEndGame
-- . updateRandGen
. over uvWorld (cWorld . lWorld . lClock +~ 1)
. over uvWorld updateWorldSelect
. over uvWorld updateWorldSelect'
-- . over uvWorld doRewind
-- . over uvWorld (hammers . each %~ moveHammerUp)
-- . over (uvWorld . hammers . each) moveHammerUp
@@ -248,29 +248,31 @@ zoneClouds w =
& cWorld . lWorld . clZoning %~ \zn ->
foldl' (flip zoneCloud) zn (w ^. cWorld . lWorld . clouds)
updateWorldSelect' :: World -> World
updateWorldSelect' w = over input (updateWorldSelect (w ^. cWorld . lWorld . camPos)) w
updateWorldSelect :: World -> World
updateWorldSelect w = f . g $ case (w ^? input . mouseButtons . ix ButtonLeft, w ^? input . mouseButtons . ix ButtonRight) of
updateWorldSelect :: CamPos -> Input -> Input
updateWorldSelect cam inp = f . g $ case (inp ^? mouseButtons . ix ButtonLeft, inp ^? mouseButtons . ix ButtonRight) of
(Just False, Nothing) ->
w & input . lLine . _1 .~ mwp
& input . lrLine . _1 .~ mwp
inp & lLine . _1 .~ mwp
& lrLine . _1 .~ mwp
(Just True, Nothing) ->
w & input . lLine . _2 .~ mwp
& input . lrLine . _1 .~ mwp
inp & lLine . _2 .~ mwp
& lrLine . _1 .~ mwp
(Nothing, Just False) ->
w & input . rLine . _1 .~ mwp
& input . lrLine . _2 .~ mwp
inp & rLine . _1 .~ mwp
& lrLine . _2 .~ mwp
(Nothing, Just True) ->
w & input . rLine . _2 .~ mwp
& input . lrLine . _2 .~ mwp
_ -> w
inp & rLine . _2 .~ mwp
& lrLine . _2 .~ mwp
_ -> inp
where
mwp = mouseWorldPos w
mwp = mouseWorldPos inp cam
f
| ButtonLeft `M.member` _mouseButtons (_input w) = input . lSelect .~ mwp
| ButtonLeft `M.member` _mouseButtons inp = lSelect .~ mwp
| otherwise = id
g
| ButtonRight `M.member` _mouseButtons (_input w) = input . rSelect .~ mwp
| ButtonRight `M.member` _mouseButtons inp = rSelect .~ mwp
| otherwise = id
--mcChooseUpdate :: Machine -> Machine -> World -> World
src/Dodge/WorldEvent/Cloud.hs
+1 -1
View File
@@ -72,4 +72,4 @@ makeFlamerSmokeAt p w = makeCloudAt (CloudColor 4 300 (greyN x)) 6 200 40 p w
spawnSmokeAtCursor :: World -> World
spawnSmokeAtCursor w = shellTrailCloud (V3 x y 20) w
where
V2 x y = mouseWorldPos w
V2 x y = mouseWorldPos (w ^. input) (w ^. cWorld . lWorld . camPos)