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

Cleanup

Browse Source
This commit is contained in:
justin
2022-06-08 22:34:29 +01:00
parent 970858e129
commit 4e4759fb1c
17 changed files with 77 additions and 112 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/State.hs
-5
View File
@@ -214,11 +214,6 @@ invSideEff :: Creature -> World -> World
invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr) invSideEff cr w = weaponReloadSounds cr $ IM.foldrWithKey f w (_crInv cr)
where where
f i it w' = doItemTargeting i cr w' & maybe id (\g -> g it cr) (it ^? itEffect . ieInv) f i it w' = doItemTargeting i cr w' & maybe id (\g -> g it cr) (it ^? itEffect . ieInv)
-- Nothing -> id
-- Just g -> g it cr
-- f i it w' = doItemTargeting i cr w' & case it ^? itEffect . ieInv of
-- Nothing -> id
-- Just g -> g it cr
itemUpdate :: Creature -> Int -> Item -> Item itemUpdate :: Creature -> Int -> Item -> Item
itemUpdate cr i itemUpdate cr i
src/Dodge/Data.hs
+10 -10
View File
@@ -817,7 +817,7 @@ data Modification
} }
data Prop data Prop
= Projectile = Projectile
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _prDraw :: Prop -> SPic , _prDraw :: Prop -> SPic
@@ -825,7 +825,7 @@ data Prop
, _pjUpdate :: Prop -> World -> World , _pjUpdate :: Prop -> World -> World
} }
| PropZ | PropZ
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _prDraw :: Prop -> SPic , _prDraw :: Prop -> SPic
@@ -839,7 +839,7 @@ data Prop
, _pjColor :: Color , _pjColor :: Color
} }
| Drone | Drone
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _prDraw :: Prop -> SPic , _prDraw :: Prop -> SPic
@@ -847,14 +847,14 @@ data Prop
, _pjUpdate :: Prop -> World -> World , _pjUpdate :: Prop -> World -> World
} }
| RecursiveProp | RecursiveProp
{ _pjPos :: Point2 { _prPos :: Point2
, _pjID :: Int , _pjID :: Int
, _pjDraw :: Prop -> SPic , _pjDraw :: Prop -> SPic
, _pjUpdate :: Prop -> World -> World , _pjUpdate :: Prop -> World -> World
, _pjProp :: Prop , _pjProp :: Prop
} }
| ProjectileTimed | ProjectileTimed
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _prDraw :: Prop -> SPic , _prDraw :: Prop -> SPic
@@ -863,7 +863,7 @@ data Prop
, _pjTime :: Int , _pjTime :: Int
} }
| ShapeProp | ShapeProp
{ _pjPos :: Point2 { _prPos :: Point2
, _pjID :: Int , _pjID :: Int
, _pjRot :: Float , _pjRot :: Float
, _pjUpdate :: Prop -> World -> World , _pjUpdate :: Prop -> World -> World
@@ -871,7 +871,7 @@ data Prop
, _prToggle :: Bool , _prToggle :: Bool
} }
| RemoteShell | RemoteShell
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _prDraw :: Prop -> SPic , _prDraw :: Prop -> SPic
@@ -880,7 +880,7 @@ data Prop
, _pjPayload :: Point2 -> World -> World , _pjPayload :: Point2 -> World -> World
} }
| Shell | Shell
{ _pjPos :: Point2 { _prPos :: Point2
, _pjStartPos :: Point2 , _pjStartPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _pjAcc :: Point2 , _pjAcc :: Point2
@@ -894,7 +894,7 @@ data Prop
, _pjZ :: Float , _pjZ :: Float
} }
| Bomb | Bomb
{ _pjPos :: Point2 { _prPos :: Point2
, _pjVel :: Point2 , _pjVel :: Point2
, _pjZ :: Float , _pjZ :: Float
, _pjVelZ :: Float , _pjVelZ :: Float
@@ -906,7 +906,7 @@ data Prop
} }
| LinearShockwave | LinearShockwave
{ _prDraw :: Prop -> SPic { _prDraw :: Prop -> SPic
, _pjPos :: Point2 , _prPos :: Point2
, _pjID :: Int , _pjID :: Int
, _pjUpdate :: Prop -> World -> World , _pjUpdate :: Prop -> World -> World
, _pjPoints :: [(Point2,Point2)] , _pjPoints :: [(Point2,Point2)]
src/Dodge/Debug.hs
+2 -2
View File
@@ -17,7 +17,7 @@ drawCircleAtFor p t = drawCircleAtForCol p t white
drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World drawCircleAtForCol :: Point2 -> Int -> Color -> World -> World
drawCircleAtForCol p t col w = w & props %~ drawCircleAtForCol p t col w = w & props %~
IM.insert k Projectile IM.insert k Projectile
{ _pjPos = p { _prPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = V2 0 0 , _pjVel = V2 0 0
, _prDraw = \_ -> (,) mempty $ setDepth 20 $ uncurryV translate p $ color col $ circleSolid 20 , _prDraw = \_ -> (,) mempty $ setDepth 20 $ uncurryV translate p $ color col $ circleSolid 20
@@ -30,7 +30,7 @@ drawCircleAtForCol p t col w = w & props %~
drawLineForCol :: [Point2] -> Int -> Color -> World -> World drawLineForCol :: [Point2] -> Int -> Color -> World -> World
drawLineForCol ps t col w = w & props %~ drawLineForCol ps t col w = w & props %~
IM.insert k Projectile IM.insert k Projectile
{ _pjPos = head ps { _prPos = head ps
, _pjStartPos = head ps , _pjStartPos = head ps
, _pjVel = V2 0 0 , _pjVel = V2 0 0
, _prDraw = \_ -> (,) mempty $ setDepth 20 $ color col $ thickLine 5 ps , _prDraw = \_ -> (,) mempty $ setDepth 20 $ color col $ thickLine 5 ps
src/Dodge/Default.hs
-9
View File
@@ -251,15 +251,6 @@ defaultButton = Button
, _btTermMID = Nothing , _btTermMID = Nothing
, _btName = "" , _btName = ""
} }
defaultPT :: Prop
defaultPT = Projectile
{ _pjPos = V2 0 0
, _pjStartPos = V2 0 0
, _pjVel = V2 0 0
, _prDraw = const mempty
, _pjID = 0
, _pjUpdate = const id
}
defaultPP :: PressPlate defaultPP :: PressPlate
defaultPP = PressPlate defaultPP = PressPlate
{ _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5 { _ppPict = setDepth 1 . color (dim . dim $ bright blue) $ circleSolid 5
src/Dodge/Default/Shell.hs
+1 -1
View File
@@ -6,7 +6,7 @@ import Geometry.Data
defaultShell :: Prop defaultShell :: Prop
defaultShell = Shell defaultShell = Shell
{ _pjPos = V2 0 0 { _prPos = V2 0 0
, _pjZ = 20 , _pjZ = 20
, _pjStartPos = V2 0 0 , _pjStartPos = V2 0 0
, _pjVel = V2 0 0 , _pjVel = V2 0 0
src/Dodge/Item/Weapon/BatteryGuns.hs
+3 -3
View File
@@ -458,7 +458,7 @@ aTractorBeam _ cr w = w & props . at i ?~ tractorBeamAt i spos outpos dir power
tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Point2 -> Prop tractorBeamAt :: Int -> Point2 -> Point2 -> Float -> Point2 -> Prop
tractorBeamAt i pos outpos dir power = ProjectileTimed tractorBeamAt i pos outpos dir power = ProjectileTimed
{ _pjPos = pos { _prPos = pos
, _pjStartPos = outpos , _pjStartPos = outpos
, _pjVel = d , _pjVel = d
, _prDraw = tractorSPic , _prDraw = tractorSPic
@@ -480,7 +480,7 @@ updateTractor pj w
where where
i = _pjID pj i = _pjID pj
pullVel = _pjVel pj pullVel = _pjVel pj
pos = _pjPos pj pos = _prPos pj
outpos = _pjStartPos pj outpos = _pjStartPos pj
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
@@ -519,7 +519,7 @@ tractorSPic pj = (,) mempty $ setLayer BloomNoZWrite $ setDepth 20 $ color (with
] ]
where where
size = fromIntegral (_pjTime pj) size = fromIntegral (_pjTime pj)
spos = _pjPos pj spos = _prPos pj
xpos = _pjStartPos pj xpos = _pjStartPos pj
d = squashNormalizeV $ spos -.- xpos d = squashNormalizeV $ spos -.- xpos
n = vNormal d n = vNormal d
src/Dodge/Item/Weapon/Booster.hs
+1 -1
View File
@@ -64,7 +64,7 @@ addBoostShockwave pjid p v w = w & props %~
where where
thePJ = LinearShockwave thePJ = LinearShockwave
{ _prDraw = drawBoostShockwave { _prDraw = drawBoostShockwave
, _pjPos = p , _prPos = p
, _pjID = pjid , _pjID = pjid
, _pjUpdate = updateLinearShockwave , _pjUpdate = updateLinearShockwave
, _pjPoints = [(p,v)] , _pjPoints = [(p,v)]
src/Dodge/Item/Weapon/Drone.hs
+1 -1
View File
@@ -60,7 +60,7 @@ aDroneWithItemParams it cr w = over props (IM.insert i theShell) w
dir = _crDir cr dir = _crDir cr
--ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am) --ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
theShell = Drone theShell = Drone
{ _pjPos = pos { _prPos = pos
, _pjStartPos = pos , _pjStartPos = pos
, _pjVel = rotateV dir (V2 1 0) , _pjVel = rotateV dir (V2 1 0)
, _prDraw = _amPjDraw $ _laType am , _prDraw = _amPjDraw $ _laType am
src/Dodge/Item/Weapon/Grenade.hs
+15 -18
View File
@@ -51,19 +51,19 @@ moveGrenade :: Prop -> World -> World
moveGrenade pj w moveGrenade pj w
| _pjTimer pj <= 0 = w | _pjTimer pj <= 0 = w
& props %~ IM.delete pID & props %~ IM.delete pID
& _pjPayload pj (_pjPos (_props w IM.! pID)) & _pjPayload pj (_prPos (_props w IM.! pID))
| otherwise = case collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w of | otherwise = case collideCircWalls oldPos newPos 4 $ wallsNearPoint newPos w of
Nothing -> w & props . ix pID %~ normalUpdate Nothing -> w & props . ix pID %~ normalUpdate
Just (p,v) -> w Just (p,v) -> w
& soundStart (Tap 0) p tapQuietS Nothing & soundStart (Tap 0) p tapQuietS Nothing
& props . ix pID %~ ( ( pjPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) ) & props . ix pID %~ ( ( prPos .~ p ) . ( pjTimer -~ 1 ) . (pjVel .~ v) )
where where
pID = _pjID pj pID = _pjID pj
normalUpdate = (pjTimer -~ 1) normalUpdate = (pjTimer -~ 1)
. (pjZ %~ (max 0 . (+ _pjVelZ pj))) . (pjZ %~ (max 0 . (+ _pjVelZ pj)))
. (pjVelZ -~ 0.1) . (pjVelZ -~ 0.1)
. ( pjPos .~ newPos ) . ( prPos .~ newPos )
oldPos = _pjPos pj oldPos = _prPos pj
newPos = _pjVel pj +.+ oldPos newPos = _pjVel pj +.+ oldPos
grenadePic :: Int -> SPic grenadePic :: Int -> SPic
@@ -77,11 +77,8 @@ grenadePic time =
) )
grenadeDraw :: Float -> Prop -> SPic grenadeDraw :: Float -> Prop -> SPic
grenadeDraw dir prop = translateSPz z $ uncurryV translateSPf p $ rotateSP dir $ grenadePic time grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop)
where $ rotateSP dir $ grenadePic $ _pjTimer prop
p = _pjPos prop
time = _pjTimer prop
z = _pjZ prop
throwGrenade throwGrenade
:: (Point2 -> World -> World) -- ^ Payload :: (Point2 -> World -> World) -- ^ Payload
@@ -92,7 +89,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
where where
n = _crID cr n = _crID cr
addG = IM.insert i $ Bomb addG = IM.insert i $ Bomb
{ _pjPos = p { _prPos = p
, _pjZ = 10 , _pjZ = 10
, _pjVelZ = 2 , _pjVelZ = 2
, _pjVel = v , _pjVel = v
@@ -174,13 +171,13 @@ moveRemoteBomb itid time pID w
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
_ -> updatedWorld _ -> updatedWorld
where where
updatedWorld updatedWorld = w
= updateV $ set (props . ix pID . pjPos) finalPos & updateV
$ updatePicture & props . ix pID . prPos .~ finalPos
$ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID) & updatePicture
w & props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
pj = _props w IM.! pID pj = _props w IM.! pID
oldPos = _pjPos pj oldPos = _prPos pj
newPos = _pjVel pj +.+ oldPos newPos = _pjVel pj +.+ oldPos
-- this is hacky, should use a version of collidePointWalls' that collides -- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls -- circles and walls
@@ -225,7 +222,7 @@ throwRemoteBomb cr w = setLocation
where where
cid = _crID cr cid = _crID cr
addG = IM.insert i $ Projectile addG = IM.insert i $ Projectile
{ _pjPos = p { _prPos = p
, _pjStartPos = p , _pjStartPos = p
, _pjVel = v , _pjVel = v
, _prDraw = const mempty , _prDraw = const mempty
@@ -261,7 +258,7 @@ explodeRemoteBomb itid pjid cr w
-- $ resetName -- $ resetName
$ resetPict $ resetPict
-- $ resetScope -- $ resetScope
$ makeExplosionAt (_pjPos (_props w IM.! pjid)) w $ makeExplosionAt (_prPos (_props w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w -- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
where where
cid = _crID cr cid = _crID cr
src/Dodge/Item/Weapon/Launcher.hs
+8 -9
View File
@@ -157,10 +157,9 @@ pjTrack itid i pj w = pjEffTimeRange (st,et) rotateToTarget pj w
et | i == 0 = 36 et | i == 0 = 36
| otherwise = 40 - (i * 20) | otherwise = 40 - (i * 20)
st = et - 100 st = et - 100
pjpos = _pjPos pj
rotateToTarget _ = fromMaybe id $ do rotateToTarget _ = fromMaybe id $ do
tpos <- w ^? itPoint . itTargeting . tgPos . _Just tpos <- w ^? itPoint . itTargeting . tgPos . _Just
return $ props . ix (_pjID pj) . pjSpin .~ turnToAmount 0.15 pjpos tpos (argV $ _pjAcc pj) return $ props . ix (_pjID pj) . pjSpin .~ turnToAmount 0.15 (_prPos pj) tpos (argV $ _pjAcc pj)
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions w IM.! itid
doThrust :: Prop -> World -> World doThrust :: Prop -> World -> World
@@ -173,7 +172,7 @@ doThrust pj w = w
where where
accel = _pjAcc pj accel = _pjAcc pj
i = _pjID pj i = _pjID pj
oldPos = _pjPos pj oldPos = _prPos pj
vel = _pjVel pj vel = _pjVel pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w (frict,g) = randomR (0.6,0.9) $ _randGen w
@@ -209,7 +208,7 @@ moveShell pj w
& stopSoundFrom (ShellSound i) & stopSoundFrom (ShellSound i)
& props %~ IM.delete i & props %~ IM.delete i
i = _pjID pj i = _pjID pj
oldPos = _pjPos pj oldPos = _prPos pj
vel = _pjVel pj vel = _pjVel pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
@@ -219,7 +218,7 @@ reduceSpinBy x pj = props . ix (_pjID pj) . pjSpin *~ x
drawShell :: Prop -> SPic drawShell :: Prop -> SPic
drawShell pj = noPic drawShell pj = noPic
. translateSHz 18 . translateSHz 18
. uncurryV translateSHf (_pjPos pj) . uncurryV translateSHf (_prPos pj)
$ rotateSH (argV $ _pjAcc pj) shellShape $ rotateSH (argV $ _pjAcc pj) shellShape
shellShape :: Shape shellShape :: Shape
@@ -239,7 +238,7 @@ drawRemoteShell pj
col | t > (-99) = green col | t > (-99) = green
| otherwise = red | otherwise = red
t = _pjTimer pj t = _pjTimer pj
doposition = translateSPz 18 . uncurryV translateSPf (_pjPos pj) . rotateSP (_pjDir pj) doposition = translateSPz 18 . uncurryV translateSPf (_prPos pj) . rotateSP (_pjDir pj)
pjEffTimeRange pjEffTimeRange
:: (Int,Int) :: (Int,Int)
@@ -319,7 +318,7 @@ moveRemoteShell cid itid pj w
where where
time = _pjTimer pj time = _pjTimer pj
i = _pjID pj i = _pjID pj
oldPos = _pjPos pj oldPos = _prPos pj
vel = _pjVel pj vel = _pjVel pj
newPos = oldPos +.+ vel newPos = oldPos +.+ vel
newdir newdir
@@ -351,7 +350,7 @@ explodeRemoteRocket itid pjid w = w
& props . ix pjid . prDraw .~ const mempty & props . ix pjid . prDraw .~ const mempty
& itPoint . itUse . rUse .~ (\_ _ -> id) & itPoint . itUse . rUse .~ (\_ _ -> id)
-- & itPoint . itName .~ "REMOTELAUNCHER" -- & itPoint . itName .~ "REMOTELAUNCHER"
& _pjPayload thepj (_pjPos thepj) & _pjPayload thepj (_prPos thepj)
where where
itPoint = pointToItem $ _itemPositions w IM.! itid itPoint = pointToItem $ _itemPositions w IM.! itid
thepj = _props w IM.! pjid thepj = _props w IM.! pjid
@@ -373,7 +372,7 @@ fireTrackingShell it cr w = addTrackRocket w'
makeShell :: Item -> Creature -> (Prop -> World -> World) -> World -> World makeShell :: Item -> Creature -> (Prop -> World -> World) -> World -> World
makeShell it cr theupdate w = w & props %~ IM.insert i Shell makeShell it cr theupdate w = w & props %~ IM.insert i Shell
{ _pjPos = pos { _prPos = pos
, _pjZ = 20 , _pjZ = 20
, _pjStartPos = pos , _pjStartPos = pos
, _pjVel = rotateV dir (V2 1 0) , _pjVel = rotateV dir (V2 1 0)
src/Dodge/Item/Weapon/Remote.hs
+3 -3
View File
@@ -29,13 +29,13 @@ retireRemoteProj resetFire itid t pjid w = setScope w
& creatures . ix cid . crInv . ix invid . itScope & creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid)) . scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> w' _ -> w'
pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . pjPos pos = fromMaybe (V2 0 0) $ w ^? props . ix pjid . prPos
setRemoteBombScope :: Int -> Prop -> World -> World setRemoteBombScope :: Int -> Prop -> World -> World
setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of setRemoteBombScope itid pj w' = case _itemPositions w' IM.! itid of
InInv cid invid InInv cid invid
-> w' & creatures . ix cid . crInv . ix invid . itScope -> w' & creatures . ix cid . crInv . ix invid . itScope
. scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid)) . scopePos .~ (_prPos pj -.- _crPos (_creatures w' IM.! cid))
& creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom & creatures . ix cid . crInv . ix invid . itUse . useAim . aimZoom
.~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5}) .~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
_ -> w' _ -> w'
@@ -44,5 +44,5 @@ setRemoteScope :: Int -> Prop -> World -> World
setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of
Just (InInv cid' invid ) Just (InInv cid' invid )
-> w' & creatures . ix cid' . crInv . ix invid . itScope -> w' & creatures . ix cid' . crInv . ix invid . itScope
. scopePos .~ (_pjPos pj -.- _crPos (_creatures w' IM.! cid')) . scopePos .~ (_prPos pj -.- _crPos (_creatures w' IM.! cid'))
_ -> w' _ -> w'
src/Dodge/Item/Weapon/Shell.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Control.Lens
decTimMvVel :: Prop -> World -> World decTimMvVel :: Prop -> World -> World
decTimMvVel pj = props . ix pjid %~ decTimMvVel pj = props . ix pjid %~
( (pjTimer -~ 1) ( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel) ) . (prPos %~ (+.+ vel) )
. (pjAcc %~ rotateV rot ) . (pjAcc %~ rotateV rot )
) )
where where
src/Dodge/Placement/Instance/LightSource.hs
+3 -3
View File
@@ -36,16 +36,16 @@ moveLSThen :: (World -> (Point2,Float))
moveLSThen posf off sh = propLSThen propupdate lsupdate thels theprop moveLSThen posf off sh = propLSThen propupdate lsupdate thels theprop
where where
propupdate pr w = w propupdate pr w = w
& props . ix (_pjID pr) . pjPos .~ fst (posf w) & props . ix (_pjID pr) . prPos .~ fst (posf w)
& props . ix (_pjID pr) . pjRot .~ snd (posf w) & props . ix (_pjID pr) . pjRot .~ snd (posf w)
lsupdate _ w = lsParam . lsPos .~ addZ 0 (fst (posf w)) +.+.+ rotate3z (snd (posf w)) off lsupdate _ w = lsParam . lsPos .~ addZ 0 (fst (posf w)) +.+.+ rotate3z (snd (posf w)) off
thels = defaultLS thels = defaultLS
theprop = ShapeProp theprop = ShapeProp
{ _pjPos = 0 { _prPos = 0
, _pjID = 0 , _pjID = 0
, _pjRot = 0 , _pjRot = 0
, _pjUpdate = const id , _pjUpdate = const id
, _prDraw = \pr -> noPic $ uncurryV translateSHf (_pjPos pr) $ rotateSH (_pjRot pr) sh , _prDraw = \pr -> noPic $ uncurryV translateSHf (_prPos pr) $ rotateSH (_pjRot pr) sh
, _prToggle = True , _prToggle = True
} }
src/Dodge/Placement/Instance/LightSource/Cover.hs
+18 -35
View File
@@ -5,12 +5,13 @@ import Geometry.Data
import ShapePicture import ShapePicture
import Shape import Shape
import Geometry import Geometry
import Dodge.Default.Prop
import Control.Lens import Control.Lens
lampCover :: Float -> Prop lampCover :: Float -> Prop
lampCover h = ShapeProp lampCover h = ShapeProp
{ _pjPos = V2 0 0 { _prPos = V2 0 0
, _pjID = 0 , _pjID = 0
, _pjRot = 0 , _pjRot = 0
, _pjUpdate = rotateProp 0.15 , _pjUpdate = rotateProp 0.15
@@ -18,35 +19,26 @@ lampCover h = ShapeProp
, _prToggle = True , _prToggle = True
} }
lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
lampCoverWhen cond pos h = ShapeProp lampCoverWhen cond pos h = defaultShapeProp
{ _pjPos = pos { _prPos = pos
, _pjID = 0
, _pjRot = 0
, _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15 , _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15
, _prDraw = drawLampCover h , _prDraw = drawLampCover h
, _prToggle = True , _prToggle = True
} }
doubleLampCover :: Float -> Prop doubleLampCover :: Float -> Prop
doubleLampCover h = ShapeProp doubleLampCover h = defaultShapeProp
{ _pjPos = V2 0 0 { _prPos = V2 0 0
, _pjID = 0
, _pjRot = 0
, _pjUpdate = rotateProp 0.15 , _pjUpdate = rotateProp 0.15
, _prDraw = drawDoubleLampCover h , _prDraw = drawDoubleLampCover h
, _prToggle = True
} }
-- on the current (27/9/21) version of shadow stencilling, this glitches -- on the current (27/9/21) version of shadow stencilling, this glitches
-- slightly when the shadow rotates towards the screen -- slightly when the shadow rotates towards the screen
verticalLampCover :: Float -> Prop verticalLampCover :: Float -> Prop
verticalLampCover h = ShapeProp verticalLampCover h = defaultShapeProp
{ _pjPos = V2 0 0 { _pjUpdate = rotateProp 0.15
, _pjID = 0
, _pjRot = 0
, _pjUpdate = rotateProp 0.15
, _prDraw = drawVerticalLampCover h , _prDraw = drawVerticalLampCover h
, _prToggle = True
} }
rotateProp :: Float -> Prop -> World -> World rotateProp :: Float -> Prop -> World -> World
@@ -57,26 +49,23 @@ setToggle :: (World -> Bool) -> Prop -> World -> World
setToggle cond pr w = w & props . ix (_pjID pr) . prToggle .~ cond w setToggle cond pr w = w & props . ix (_pjID pr) . prToggle .~ cond w
drawLampCover :: Float -> Prop -> SPic drawLampCover :: Float -> Prop -> SPic
drawLampCover h pr | not (_prToggle pr) = mempty drawLampCover h pr
| otherwise = | not (_prToggle pr) = mempty
( translateSHz (h-2.5) . uncurryV translateSHf pos | otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH a $ mconcat $ rotateSH (_pjRot pr) $ mconcat
[ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1) [ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2 , translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1) , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2 , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
, upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)] , upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
] ]
, mempty , mempty
) )
where
a = _pjRot pr
pos = _pjPos pr
drawDoubleLampCover :: Float -> Prop -> SPic drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr = drawDoubleLampCover h pr =
( translateSHz (h-2.5) . uncurryV translateSHf pos ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH a $ mconcat $ rotateSH (_pjRot pr) $ mconcat
[ upperPrismPoly 5 $ rectNSEW 6 5 6 (-6) [ upperPrismPoly 5 $ rectNSEW 6 5 6 (-6)
, upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6) , upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6)
, upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5] , upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
@@ -84,19 +73,13 @@ drawDoubleLampCover h pr =
] ]
, mempty , mempty
) )
where
a = _pjRot pr
pos = _pjPos pr
drawVerticalLampCover :: Float -> Prop -> SPic drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr = drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHf pos ( translateSHz h . uncurryV translateSHf (_prPos pr)
$ rotateSHx a $ mconcat $ rotateSHx (_pjRot pr) $ mconcat
[ [
translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5) translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
] ]
, mempty , mempty
) )
where
a = _pjRot pr
pos = _pjPos pr
src/Dodge/Placement/PlaceSpot.hs
+1 -1
View File
@@ -155,7 +155,7 @@ addPane wl l wls = IM.insert wlid (wl { _wlLine = l, _wlID = wlid }) wls
-- i = IM.newKey $ w ^# l -- i = IM.newKey $ w ^# l
mvProp :: Point2 -> Float -> Prop -> Prop mvProp :: Point2 -> Float -> Prop -> Prop
mvProp p a = (pjRot +~ a) . (pjPos %~ ( (p +.+) . rotateV a )) mvProp p a = (pjRot +~ a) . (prPos %~ ( (p +.+) . rotateV a ))
mvButton :: Point2 -> Float -> Button -> Button mvButton :: Point2 -> Float -> Button -> Button
mvButton p a = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a )) mvButton p a = (btRot +~ a) . (btPos %~ ( (p +.+) . rotateV a ))
src/Dodge/Prop/Gib.hs
+9 -9
View File
@@ -18,7 +18,7 @@ import Data.List (zip4)
aGib :: Prop aGib :: Prop
aGib = PropZ aGib = PropZ
{_pjPos = 0 {_prPos = 0
,_pjStartPos = 0 ,_pjStartPos = 0
,_pjVel = 0 ,_pjVel = 0
,_prDraw = drawGib 3 ,_prDraw = drawGib 3
@@ -34,7 +34,7 @@ aGib = PropZ
drawGib :: Float -> Prop -> SPic drawGib :: Float -> Prop -> SPic
drawGib x pr = noPic drawGib x pr = noPic
. translateSHz (_pjPosZ pr) . translateSHz (_pjPosZ pr)
. uncurryV translateSHf (_pjPos pr) . uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_pjQuat pr)) . overPosSH (Q.rotate (_pjQuat pr))
$ flesh <> skin $ flesh <> skin
where where
@@ -68,10 +68,10 @@ updateGib' w pr
newposz = _pjPosZ pr + velz newposz = _pjPosZ pr + velz
velz = _pjVelZ pr velz = _pjVelZ pr
vel = _pjVel pr vel = _pjVel pr
pos = _pjPos pr pos = _prPos pr
updateWithVel v = case reflectPointWallsDamp 0.5 pos (pos + v) $ wallsAlongLine pos (pos +v) w of updateWithVel v = case reflectPointWallsDamp 0.5 pos (pos + v) $ wallsAlongLine pos (pos +v) w of
Nothing -> pjPos +~ v Nothing -> prPos +~ v
Just (p,v') -> (pjPos .~ p) . (pjVel .~ v') Just (p,v') -> (prPos .~ p) . (pjVel .~ v')
addCrGibs :: Creature -> World -> World addCrGibs :: Creature -> World -> World
addCrGibs cr w = case damageDirection $ _crDamage $ _crState cr of addCrGibs cr w = case damageDirection $ _crDamage $ _crState cr of
@@ -98,7 +98,7 @@ addGibsAt minh maxh col p w = foldr addg w (zip4 vels zspeeds quats hs)
zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
quats :: [Q.Quaternion Float] quats :: [Q.Quaternion Float]
quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
addg (v,zs,q,h) = plNew props pjID (aGib & pjPos .~ p +.+ (5 *.* normalizeV v) addg (v,zs,q,h) = plNew props pjID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
& pjColor .~ col & pjColor .~ col
& pjVel .~ v & pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -119,7 +119,7 @@ addGibsAtDir dir minh maxh col p w = foldr addg w (zip4 vels zspeeds quats hs)
zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w zspeeds = replicateM 4 (state (randomR (-8,8))) & evalState $ _randGen w
quats :: [Q.Quaternion Float] quats :: [Q.Quaternion Float]
quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w quats = replicateM 4 (Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere) & evalState $ _randGen w
addg (v,zs,q,h) = plNew props pjID (aGib & pjPos .~ p +.+ (5 *.* normalizeV v) addg (v,zs,q,h) = plNew props pjID (aGib & prPos .~ p +.+ (5 *.* normalizeV v)
& pjColor .~ col & pjColor .~ col
& pjVel .~ v & pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -141,7 +141,7 @@ addGibAt h col p w = w
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
let v = s *.* dir let v = s *.* dir
return $ aGib return $ aGib
& pjPos .~ p & prPos .~ p
& pjColor .~ col & pjColor .~ col
& pjVel .~ v & pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
@@ -161,7 +161,7 @@ addGibAtDir dir h col p w = w
q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere q <- Q.vToQuat (V3 0 0 1) <$> randOnUnitSphere
let v = s *.* unitVectorAtAngle dir let v = s *.* unitVectorAtAngle dir
return $ aGib return $ aGib
& pjPos .~ p & prPos .~ p
& pjColor .~ col & pjColor .~ col
& pjVel .~ v & pjVel .~ v
& pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1) & pjQuatSpin .~ Q.axisAngle (vNormal v `v2z` 0) (-0.1)
src/Dodge/Render/ShapePicture.hs
+1 -1
View File
@@ -31,7 +31,7 @@ import Data.Maybe
worldSPic :: Configuration -> World -> SPic worldSPic :: Configuration -> World -> SPic
worldSPic cfig w = worldSPic cfig w =
(extraShapes w, extraPics cfig w) (extraShapes w, extraPics cfig w)
<> foldMap (dbArg _prDraw) (filtOn _pjPos _props) <> foldMap (dbArg _prDraw) (filtOn _prPos _props)
<> foldMap (dbArg _cpPict) (filtOn _cpPos _corpses) <> foldMap (dbArg _cpPict) (filtOn _cpPos _corpses)
<> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures) <> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures)
<> foldMap floorItemSPic (filtOn _flItPos _floorItems) <> foldMap floorItemSPic (filtOn _flItPos _floorItems)