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)
where
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 cr i
src/Dodge/Data.hs
+10 -10
View File
@@ -817,7 +817,7 @@ data Modification
}
data Prop
= Projectile
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
@@ -825,7 +825,7 @@ data Prop
, _pjUpdate :: Prop -> World -> World
}
| PropZ
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
@@ -839,7 +839,7 @@ data Prop
, _pjColor :: Color
}
| Drone
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
@@ -847,14 +847,14 @@ data Prop
, _pjUpdate :: Prop -> World -> World
}
| RecursiveProp
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjID :: Int
, _pjDraw :: Prop -> SPic
, _pjUpdate :: Prop -> World -> World
, _pjProp :: Prop
}
| ProjectileTimed
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
@@ -863,7 +863,7 @@ data Prop
, _pjTime :: Int
}
| ShapeProp
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjID :: Int
, _pjRot :: Float
, _pjUpdate :: Prop -> World -> World
@@ -871,7 +871,7 @@ data Prop
, _prToggle :: Bool
}
| RemoteShell
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _prDraw :: Prop -> SPic
@@ -880,7 +880,7 @@ data Prop
, _pjPayload :: Point2 -> World -> World
}
| Shell
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjStartPos :: Point2
, _pjVel :: Point2
, _pjAcc :: Point2
@@ -894,7 +894,7 @@ data Prop
, _pjZ :: Float
}
| Bomb
{ _pjPos :: Point2
{ _prPos :: Point2
, _pjVel :: Point2
, _pjZ :: Float
, _pjVelZ :: Float
@@ -906,7 +906,7 @@ data Prop
}
| LinearShockwave
{ _prDraw :: Prop -> SPic
, _pjPos :: Point2
, _prPos :: Point2
, _pjID :: Int
, _pjUpdate :: Prop -> World -> World
, _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 p t col w = w & props %~
IM.insert k Projectile
{ _pjPos = p
{ _prPos = p
, _pjStartPos = p
, _pjVel = V2 0 0
, _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 ps t col w = w & props %~
IM.insert k Projectile
{ _pjPos = head ps
{ _prPos = head ps
, _pjStartPos = head ps
, _pjVel = V2 0 0
, _prDraw = \_ -> (,) mempty $ setDepth 20 $ color col $ thickLine 5 ps
src/Dodge/Default.hs
-9
View File
@@ -251,15 +251,6 @@ defaultButton = Button
, _btTermMID = Nothing
, _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
{ _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 = Shell
{ _pjPos = V2 0 0
{ _prPos = V2 0 0
, _pjZ = 20
, _pjStartPos = 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 i pos outpos dir power = ProjectileTimed
{ _pjPos = pos
{ _prPos = pos
, _pjStartPos = outpos
, _pjVel = d
, _prDraw = tractorSPic
@@ -480,7 +480,7 @@ updateTractor pj w
where
i = _pjID pj
pullVel = _pjVel pj
pos = _pjPos pj
pos = _prPos pj
outpos = _pjStartPos pj
tractFlIt :: Point2 -> Point2 -> Point2 -> FloorItem -> FloorItem
@@ -519,7 +519,7 @@ tractorSPic pj = (,) mempty $ setLayer BloomNoZWrite $ setDepth 20 $ color (with
]
where
size = fromIntegral (_pjTime pj)
spos = _pjPos pj
spos = _prPos pj
xpos = _pjStartPos pj
d = squashNormalizeV $ spos -.- xpos
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
thePJ = LinearShockwave
{ _prDraw = drawBoostShockwave
, _pjPos = p
, _prPos = p
, _pjID = pjid
, _pjUpdate = updateLinearShockwave
, _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
--ammoMvs pj w' = foldr (\pjP -> _pjMoveParam pjP (_pjIntParam pjP) it cr pj) w' (_amPjParams am)
theShell = Drone
{ _pjPos = pos
{ _prPos = pos
, _pjStartPos = pos
, _pjVel = rotateV dir (V2 1 0)
, _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
| _pjTimer pj <= 0 = w
& 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
Nothing -> w & props . ix pID %~ normalUpdate
Just (p,v) -> w
& 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
pID = _pjID pj
normalUpdate = (pjTimer -~ 1)
. (pjZ %~ (max 0 . (+ _pjVelZ pj)))
. (pjVelZ -~ 0.1)
. ( pjPos .~ newPos )
oldPos = _pjPos pj
. ( prPos .~ newPos )
oldPos = _prPos pj
newPos = _pjVel pj +.+ oldPos
grenadePic :: Int -> SPic
@@ -77,11 +77,8 @@ grenadePic time =
)
grenadeDraw :: Float -> Prop -> SPic
grenadeDraw dir prop = translateSPz z $ uncurryV translateSPf p $ rotateSP dir $ grenadePic time
where
p = _pjPos prop
time = _pjTimer prop
z = _pjZ prop
grenadeDraw dir prop = translateSPz (_pjZ prop) $ uncurryV translateSPf (_prPos prop)
$ rotateSP dir $ grenadePic $ _pjTimer prop
throwGrenade
:: (Point2 -> World -> World) -- ^ Payload
@@ -92,7 +89,7 @@ throwGrenade thePayload cr w = setWp $ removePict $ over props addG w
where
n = _crID cr
addG = IM.insert i $ Bomb
{ _pjPos = p
{ _prPos = p
, _pjZ = 10
, _pjVelZ = 2
, _pjVel = v
@@ -174,13 +171,13 @@ moveRemoteBomb itid time pID w
Just (p,_) -> soundStart (Tap 0) p tapQuietS Nothing updatedWorld
_ -> updatedWorld
where
updatedWorld
= updateV $ set (props . ix pID . pjPos) finalPos
$ updatePicture
$ set (props .ix pID.pjUpdate) (\_ -> moveRemoteBomb itid (time-1) pID)
w
updatedWorld = w
& updateV
& props . ix pID . prPos .~ finalPos
& updatePicture
& props . ix pID . pjUpdate .~ (\_ -> moveRemoteBomb itid (time-1) pID)
pj = _props w IM.! pID
oldPos = _pjPos pj
oldPos = _prPos pj
newPos = _pjVel pj +.+ oldPos
-- this is hacky, should use a version of collidePointWalls' that collides
-- circles and walls
@@ -225,7 +222,7 @@ throwRemoteBomb cr w = setLocation
where
cid = _crID cr
addG = IM.insert i $ Projectile
{ _pjPos = p
{ _prPos = p
, _pjStartPos = p
, _pjVel = v
, _prDraw = const mempty
@@ -261,7 +258,7 @@ explodeRemoteBomb itid pjid cr w
-- $ resetName
$ resetPict
-- $ resetScope
$ makeExplosionAt (_pjPos (_props w IM.! pjid)) w
$ makeExplosionAt (_prPos (_props w IM.! pjid)) w
-- - $ makeShrapnelBombAt (_pjPos (_props w IM.! pjid)) w
where
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
| otherwise = 40 - (i * 20)
st = et - 100
pjpos = _pjPos pj
rotateToTarget _ = fromMaybe id $ do
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
doThrust :: Prop -> World -> World
@@ -173,7 +172,7 @@ doThrust pj w = w
where
accel = _pjAcc pj
i = _pjID pj
oldPos = _pjPos pj
oldPos = _prPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
(frict,g) = randomR (0.6,0.9) $ _randGen w
@@ -209,7 +208,7 @@ moveShell pj w
& stopSoundFrom (ShellSound i)
& props %~ IM.delete i
i = _pjID pj
oldPos = _pjPos pj
oldPos = _prPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
@@ -219,7 +218,7 @@ reduceSpinBy x pj = props . ix (_pjID pj) . pjSpin *~ x
drawShell :: Prop -> SPic
drawShell pj = noPic
. translateSHz 18
. uncurryV translateSHf (_pjPos pj)
. uncurryV translateSHf (_prPos pj)
$ rotateSH (argV $ _pjAcc pj) shellShape
shellShape :: Shape
@@ -239,7 +238,7 @@ drawRemoteShell pj
col | t > (-99) = green
| otherwise = red
t = _pjTimer pj
doposition = translateSPz 18 . uncurryV translateSPf (_pjPos pj) . rotateSP (_pjDir pj)
doposition = translateSPz 18 . uncurryV translateSPf (_prPos pj) . rotateSP (_pjDir pj)
pjEffTimeRange
:: (Int,Int)
@@ -319,7 +318,7 @@ moveRemoteShell cid itid pj w
where
time = _pjTimer pj
i = _pjID pj
oldPos = _pjPos pj
oldPos = _prPos pj
vel = _pjVel pj
newPos = oldPos +.+ vel
newdir
@@ -351,7 +350,7 @@ explodeRemoteRocket itid pjid w = w
& props . ix pjid . prDraw .~ const mempty
& itPoint . itUse . rUse .~ (\_ _ -> id)
-- & itPoint . itName .~ "REMOTELAUNCHER"
& _pjPayload thepj (_pjPos thepj)
& _pjPayload thepj (_prPos thepj)
where
itPoint = pointToItem $ _itemPositions w IM.! itid
thepj = _props w IM.! pjid
@@ -373,7 +372,7 @@ fireTrackingShell it cr w = addTrackRocket w'
makeShell :: Item -> Creature -> (Prop -> World -> World) -> World -> World
makeShell it cr theupdate w = w & props %~ IM.insert i Shell
{ _pjPos = pos
{ _prPos = pos
, _pjZ = 20
, _pjStartPos = pos
, _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
. scopePos .~ (pos -.- _crPos (_creatures w' IM.! cid))
_ -> 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 itid pj w' = case _itemPositions w' IM.! itid of
InInv cid invid
-> 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
.~ (defaultItZoom {_itZoomMax = 0.5, _itZoomMin = 0.5})
_ -> w'
@@ -44,5 +44,5 @@ setRemoteScope :: Int -> Prop -> World -> World
setRemoteScope itid pj w' = case w' ^? itemPositions . ix itid of
Just (InInv cid' invid )
-> 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'
src/Dodge/Item/Weapon/Shell.hs
+1 -1
View File
@@ -8,7 +8,7 @@ import Control.Lens
decTimMvVel :: Prop -> World -> World
decTimMvVel pj = props . ix pjid %~
( (pjTimer -~ 1)
. (pjPos %~ (+.+ vel) )
. (prPos %~ (+.+ vel) )
. (pjAcc %~ rotateV rot )
)
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
where
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)
lsupdate _ w = lsParam . lsPos .~ addZ 0 (fst (posf w)) +.+.+ rotate3z (snd (posf w)) off
thels = defaultLS
theprop = ShapeProp
{ _pjPos = 0
{ _prPos = 0
, _pjID = 0
, _pjRot = 0
, _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
}
src/Dodge/Placement/Instance/LightSource/Cover.hs
+18 -35
View File
@@ -5,12 +5,13 @@ import Geometry.Data
import ShapePicture
import Shape
import Geometry
import Dodge.Default.Prop
import Control.Lens
lampCover :: Float -> Prop
lampCover h = ShapeProp
{ _pjPos = V2 0 0
{ _prPos = V2 0 0
, _pjID = 0
, _pjRot = 0
, _pjUpdate = rotateProp 0.15
@@ -18,35 +19,26 @@ lampCover h = ShapeProp
, _prToggle = True
}
lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
lampCoverWhen cond pos h = ShapeProp
{ _pjPos = pos
, _pjID = 0
, _pjRot = 0
lampCoverWhen cond pos h = defaultShapeProp
{ _prPos = pos
, _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15
, _prDraw = drawLampCover h
, _prToggle = True
}
doubleLampCover :: Float -> Prop
doubleLampCover h = ShapeProp
{ _pjPos = V2 0 0
, _pjID = 0
, _pjRot = 0
doubleLampCover h = defaultShapeProp
{ _prPos = V2 0 0
, _pjUpdate = rotateProp 0.15
, _prDraw = drawDoubleLampCover h
, _prToggle = True
}
-- on the current (27/9/21) version of shadow stencilling, this glitches
-- slightly when the shadow rotates towards the screen
verticalLampCover :: Float -> Prop
verticalLampCover h = ShapeProp
{ _pjPos = V2 0 0
, _pjID = 0
, _pjRot = 0
, _pjUpdate = rotateProp 0.15
verticalLampCover h = defaultShapeProp
{ _pjUpdate = rotateProp 0.15
, _prDraw = drawVerticalLampCover h
, _prToggle = True
}
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
drawLampCover :: Float -> Prop -> SPic
drawLampCover h pr | not (_prToggle pr) = mempty
| otherwise =
( translateSHz (h-2.5) . uncurryV translateSHf pos
$ rotateSH a $ mconcat
drawLampCover h pr
| not (_prToggle pr) = mempty
| otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot pr) $ mconcat
[ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2 3 (-1)
, translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
, upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
]
, mempty
)
where
a = _pjRot pr
pos = _pjPos pr
, mempty
)
drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr =
( translateSHz (h-2.5) . uncurryV translateSHf pos
$ rotateSH a $ mconcat
( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot pr) $ mconcat
[ upperPrismPoly 5 $ rectNSEW 6 5 6 (-6)
, upperPrismPoly 5 $ rectNSEW (-5) (-6) 6 (-6)
, upperPrismPoly 1 [V2 0 (-1),V2 6 5,V2 (-6) 5]
@@ -84,19 +73,13 @@ drawDoubleLampCover h pr =
]
, mempty
)
where
a = _pjRot pr
pos = _pjPos pr
drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHf pos
$ rotateSHx a $ mconcat
( translateSHz h . uncurryV translateSHf (_prPos pr)
$ rotateSHx (_pjRot pr) $ mconcat
[
translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
]
, 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
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 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 = PropZ
{_pjPos = 0
{_prPos = 0
,_pjStartPos = 0
,_pjVel = 0
,_prDraw = drawGib 3
@@ -34,7 +34,7 @@ aGib = PropZ
drawGib :: Float -> Prop -> SPic
drawGib x pr = noPic
. translateSHz (_pjPosZ pr)
. uncurryV translateSHf (_pjPos pr)
. uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_pjQuat pr))
$ flesh <> skin
where
@@ -68,10 +68,10 @@ updateGib' w pr
newposz = _pjPosZ pr + velz
velz = _pjVelZ 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
Nothing -> pjPos +~ v
Just (p,v') -> (pjPos .~ p) . (pjVel .~ v')
Nothing -> prPos +~ v
Just (p,v') -> (prPos .~ p) . (pjVel .~ v')
addCrGibs :: Creature -> World -> World
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
quats :: [Q.Quaternion Float]
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
& pjVel .~ v
& 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
quats :: [Q.Quaternion Float]
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
& pjVel .~ v
& 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
let v = s *.* dir
return $ aGib
& pjPos .~ p
& prPos .~ p
& pjColor .~ col
& pjVel .~ v
& 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
let v = s *.* unitVectorAtAngle dir
return $ aGib
& pjPos .~ p
& prPos .~ p
& pjColor .~ col
& pjVel .~ v
& 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 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 ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures)
<> foldMap floorItemSPic (filtOn _flItPos _floorItems)