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

Linting

Browse Source
This commit is contained in:
justin
2021-04-23 11:10:45 +02:00
parent c740ca0844
commit ffe4a8083b
14 changed files with 329 additions and 286 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Default.hs
+50 -45
View File
@@ -24,31 +24,34 @@ import qualified Data.Set as S
import Data.Graph.Inductive.Graph hiding ((&))
import Data.List
defaultWall = Wall { _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _wlColor = greyN 0.6
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
}
defaultAutoDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _doorPathable = True
}
defaultDoor = Door { _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _doorPathable = False
}
defaultWall = Wall
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _wlColor = greyN 0.6
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
}
defaultAutoDoor = Door
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _doorPathable = True
}
defaultDoor = Door
{ _wlLine = [(0,0),(50,0)]
, _wlID = 0
, _doorMech = id
, _wlColor = light $ dim $ dim $ dim $ yellow
, _wlDraw = Nothing
, _wlSeen = False
, _wlIsSeeThrough = False
, _doorPathable = False
}
defaultCreature :: Creature
defaultCreature = Creature
{ _crPos = (0,0)
@@ -68,14 +71,15 @@ defaultCreature = Creature
, _crCorpse = onLayer CorpseLayer $ color (greyN 0.5) $ circleSolid 10
, _crIsAnimate = True
}
defaultState = CrSt { _goals = []
, _stance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _faction = NoFaction
, _crDamage = []
, _crPastDamage = 0
, _crSpState = GenCr
, _crApplyDamage = defaultApplyDamage'
}
defaultState = CrSt
{ _goals = []
, _stance = Stance {_carriage=Walking 0 0,_posture=AtEase}
, _faction = NoFaction
, _crDamage = []
, _crPastDamage = 0
, _crSpState = GenCr
, _crApplyDamage = defaultApplyDamage
}
defaultEquipment = Equipment
{ _itIdentity = Generic
, _itName = "genericEquipment"
@@ -108,16 +112,17 @@ defaultConsumable = Consumable
, _itEffect = wpRecock
, _itHammer = HammerUp
}
defaultApplyDamage' :: [DamageType] -> Creature -> (World -> World, Creature)
defaultApplyDamage' ds cr = (id, doPoisonDam $ foldr (\d c -> snd $ defaultApplyDamage d c) cr ds')
where (ps,ds') = partition isPoison ds
isPoison (PoisonDam {}) = True
isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps) - 0)) 10
doPoisonDam = over crHP (\hp -> hp - poisonDam)
defaultApplyDamage :: [DamageType] -> Creature -> (World -> World, Creature)
defaultApplyDamage ds cr = (id, doPoisonDam $ foldr (\d c -> snd $ applyIndividualDamage d c) cr ds')
where
(ps,ds') = partition isPoison ds
isPoison (PoisonDam {}) = True
isPoison _ = False
poisonDam = quot (max 0 (sum (map _dmAmount ps))) 10
doPoisonDam = over crHP (\hp -> hp - poisonDam)
defaultApplyDamage :: DamageType -> Creature -> (World -> World, Creature)
defaultApplyDamage (Concussive amount from push pushexp pushRad) cr
applyIndividualDamage :: DamageType -> Creature -> (World -> World, Creature)
applyIndividualDamage (Concussive amount from push pushexp pushRad) cr
= ( id
, over crHP (\hp -> hp - amount)
$ over crPos (+.+ (pushAmount *.* safeNormalizeV (_crPos cr -.- from)))
@@ -127,14 +132,14 @@ defaultApplyDamage (Concussive amount from push pushexp pushRad) cr
= 0
| otherwise = min 5 $
(push*5*pushRad / (dist (_crPos cr) from * _crMass cr))**pushexp
defaultApplyDamage (TorqueDam amount rot) cr
applyIndividualDamage (TorqueDam amount rot) cr
= ( id
, over crHP (\hp -> hp - amount) $ over crDir (+ rot) cr)
defaultApplyDamage (PushDam amount pback) cr
applyIndividualDamage (PushDam amount pback) cr
= ( id
, over crHP (\hp -> hp - amount) $ over crPos (+.+ ((1/_crMass cr) *.* pback )) cr
)
defaultApplyDamage dt cr
applyIndividualDamage dt cr
= ( id , over crHP (\hp -> hp - _dmAmount dt) cr )
defaultFlIt = FlIt {_flItRot=0,_flIt = defaultIt, _flItPos = (0,0), _flItID = 0}
defaultIt = Consumable
src/Dodge/Layout/Tree/Annotate.hs
+2 -2
View File
@@ -65,8 +65,8 @@ annoToRoomTree [EndRoom] = fmap (pure . Right) (telRoomLev 1)
annoToRoomTree [StartRoom] = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
fmap (pure . Right) $ return (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h) >>= randomiseOutLinks
fmap (pure . Right) $ randomiseOutLinks (shiftRoomBy ((-20,-20),0) $ roomRectAutoLinks w h)
annoToRoomTree _ = do
w <- state $ randomR (100,400)
h <- state $ randomR (200,400)
fmap (pure . Right) $ return (roomRectAutoLinks w h) >>= randomiseOutLinks
fmap (pure . Right) . randomiseOutLinks $ roomRectAutoLinks w h
src/Dodge/LevelGen/StaticWalls.hs
+2 -2
View File
@@ -156,8 +156,8 @@ addPolyWall (p1,p2) walls =
p3 = 0.5 *.* (p1 +.+ p2)
p4 = p3 +.+ 10000 *.* vNormal (p2 -.- p1)
maybeWs = -- listToMaybe .
fmap fst
. fmap unzip
fmap (fst . unzip)
-- . fmap unzip
. listToMaybe
$ groupBy ((==) `on` (dist p3 . snd))
wlsP
src/Dodge/Path.hs
+8 -5
View File
@@ -26,13 +26,16 @@ worldGraph w p = HS.unions $ fmap (\q -> HS.fromList $ pointsAlong w p (p +.+ q)
pointsAlong :: World -> Point2 -> Point2 -> [Point2]
pointsAlong w p q = divideLineFixed 50 p p'
where p' = furthestPointWalkable p q $ wallsAlongLine p q w
where
p' = furthestPointWalkable p q $ wallsAlongLine p q w
divideLineFixed :: Float -> Point2 -> Point2 -> [Point2]
divideLineFixed x a b = fmap (\i -> a +.+ i * x *.* normalizeV (b -.- a))
$ fmap fromIntegral ns
where numPoints = floor $ dist a b / x
ns = [1 .. numPoints]
divideLineFixed x a b = fmap
( \i -> a +.+ i * x *.* normalizeV (b -.- a) )
ns
where
numPoints = floor $ dist a b / x
ns = map fromIntegral [1 .. numPoints]
-- ok, astar or something like it
src/Dodge/Room/Teleport.hs
-6
View File
@@ -38,13 +38,7 @@ telRoomLev i = do
}
ppFootprint = rectNSEW 20 (-20) 20 (-20)
levelReset pp w
-- | crInPolygon (you w) (ppPoly pp) = undefined -- makeExplosionAt (_ppPos pp) $ startNewGame w
| dist (_crPos $ you w) (_ppPos pp) < 20 = makeExplosionAt (_ppPos pp) $ startNewGame w
| otherwise = w
ppPoly pp = map (+.+ (_ppPos pp)) ppFootprint
startNewGame w = w & worldTriggers %~ S.insert (ResetLevel i)
-- generateFromList levx
-- $ initialWorld
-- & randGen .~ _randGen w
-- & windowX .~ _windowX w
-- & windowY .~ _windowY w
src/Dodge/WorldEvent/SpawnParticle.hs
+78 -75
View File
@@ -42,30 +42,32 @@ makeFlame t pos vel maycid = over particles' (aFlameParticle t pos vel maycid :
drawFlame :: Point2 -> Particle' -> Picture
drawFlame rotd pt = thePic
where ep = _btPos' pt
thePic = pictures
[ glow
, aPic prot2 0.2998 (scaleChange + 1,2) red
, aPic prot 0.2996 (scaleChange + 0.5,1.5) orange
, aPic prot3 0.2994 (scaleChange,1) white
]
aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic offset depth (scalex,scaley) col
= setLayer 1
. setDepth depth
. uncurry translate (offset ep)
. rotate (pi * 0.5 + argV rotd)
. scale scalex scaley
. color col
$ circleSolid 5
glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
time = _btTimer' pt
scaleChange | time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2
prot p' = p' +.+ rotateV (fromIntegral time * 1) (0,1)
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time * 1) (0,1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
where
ep = _btPos' pt
thePic = pictures
[ glow
, aPic prot2 0.2998 (scaleChange + 1,2) red
, aPic prot 0.2996 (scaleChange + 0.5,1.5) orange
, aPic prot3 0.2994 (scaleChange,1) white
]
aPic :: (Point2 -> Point2) -> Float -> Point2 -> Color -> Picture
aPic offset depth (scalex,scaley) col
= setLayer 1
. setDepth depth
. uncurry translate (offset ep)
. rotate (pi * 0.5 + argV rotd)
. scale scalex scaley
. color col
$ circleSolid 5
glow = setLayer 1 $ setDepth 0.3 $ uncurry translate ep
$ circleSolidCol (withAlpha 0 orange) (withAlpha 0.02 orange) 50
time = _btTimer' pt
scaleChange
| time < 80 = 3
| otherwise = 3 - (fromIntegral time - 80) * 0.2
prot p' = p' +.+ rotateV (fromIntegral time) (0,1)
prot2 p' = p' +.+ rotateV (negate $ fromIntegral time) (0,1)
prot3 p' = p' +.+ rotateV (2 + fromIntegral time * 0.1) (0,2)
moveFlame :: Point2 -> World -> Particle' -> (World, Maybe Particle')
moveFlame rotd w pt
@@ -74,34 +76,35 @@ moveFlame rotd w pt
((p,(E3x1 cr)):_) -> (soundAndGlare damcrs , mvPt')
(thing@(p,(E3x2 wl)):_) -> (fst $ hiteff [thing] damcrs , rfl wl p)
_ -> (soundAndGlare damcrs , mvPt)
where time = _btTimer' pt
soundAndGlare = soundFrom Flame fireSound 2 500
. over worldEvents ((.) $ flameGlareAt ep)
sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing
,_btVel' = 0.98 *.* vel}
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing
,_btVel' = 0.7 *.* vel}
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
$ IM.elems $ _creatures w
closeCrs cr = dist ep (_crPos cr)
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
hiteff = _btHitEffect' pt pt
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
}
pOut p = p +.+ safeNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
vel )
+.+
(0.2 *.* vel)
smokeGen = makeFlamerSmokeAt ep
where
time = _btTimer' pt
soundAndGlare = soundFrom Flame fireSound 2 500
. over worldEvents ((.) $ flameGlareAt ep)
sp = _btPos' pt
vel = _btVel' pt
ep = sp +.+ vel
mvPt = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing
,_btVel' = 0.98 *.* vel}
mvPt' = Just $ pt {_btTimer' = time - 1, _btPos' = ep
, _btPassThrough' = Nothing
,_btVel' = 0.7 *.* vel}
damcrs = foldr ($) w $ map (\cr -> fst . hiteff [(ep,E3x1 cr)]) $ filter closeCrs
$ IM.elems $ _creatures w
closeCrs cr = dist ep (_crPos cr)
< _crRad cr + 10 - min 9 (max 0 (fromIntegral time - 80))
+ 5 * angleCoeff (angleVV (ep -.- _crPos cr) rotd)
angleCoeff x = abs $ 1 - (abs $ (x * 2 - pi) / (pi))
hiteff = _btHitEffect' pt pt
rfl wl p = Just $ pt {_btTimer' = time -1, _btPos' = pOut p
, _btVel' = reflV wl--, _ptDraw = const $ thepic $ pOut p
}
pOut p = p +.+ safeNormalizeV (sp -.- p)
reflV wall = (0.3 *.* reflectIn (_wlLine wall !! 1 -.- _wlLine wall !! 0)
vel )
+.+
(0.2 *.* vel)
smokeGen = makeFlamerSmokeAt ep
makeFlameletTimed :: Point2 -> Point2 -> Maybe Int -> Float -> Int -> World -> World
makeFlameletTimed pos vel maycid size time w
@@ -311,30 +314,30 @@ crOrWall p dir w = fromMaybe (E3x3 $ p +.+ rotateV dir (arcLen,0))
g (E3x1 cr1) = dist p $ _crPos cr1
(arcLen,_) = randomR (25,50) $ _randGen w
-- if the spark is created by another Particle', it cannot be directly added to
-- the list, hence the redirect through worldEvents
-- | Create a spark.
-- If the spark is created by another Particle, it cannot be directly added to
-- the list, hence the redirect through worldEvents.
createSpark :: Int -> Int -> Point2 -> Float -> Maybe Int -> World -> World
createSpark time colid pos dir maycid w = over worldEvents
((.) $ ( over particles' ((:) spark)
-- . flareAt' white 0.02 0.05 pos')
. sparkFlashAt pos')
) w
where spark = Bul' { _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _btVel' = rotateV dir (5,0)
, _btColor' = numColor colid
, _btTrail' = [pos]
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ SparkDam 1 sp p ep)
where sp = head (_btTrail' bt)
ep = sp +.+ _btVel' bt
createSpark time colid pos dir maycid w
= over worldEvents ((.) ( over particles' (spark :) . sparkFlashAt pos')) w
where
spark = Bul' { _ptDraw = drawBul
, _ptUpdate' = mvGenBullet'
, _btVel' = rotateV dir (5,0)
, _btColor' = numColor colid
, _btTrail' = [pos]
, _btPassThrough' = maycid
, _btWidth' = 1
, _btTimer' = time
, _btHitEffect' = destroyOnImpact sparkEff noEff noEff
}
x = fst $ randomR (0,20) $ _randGen w
pos' = pos +.+ rotateV dir (x,0)
sparkEff bt p cr = over (creatures . ix (_crID cr) . crState . crDamage)
((:) $ SparkDam 1 sp p ep)
where
sp = head (_btTrail' bt)
ep = sp +.+ _btVel' bt
drawBul :: Particle' -> Picture
drawBul pt = setLayer 1 . color white $ thickLine (take 2 $ _btTrail' pt) (_btWidth' pt)
src/Dodge/WorldEvent/ThingsHit.hs
+37 -37
View File
@@ -10,26 +10,26 @@ import Data.List
import Data.Maybe
import Data.Function (on)
thingsHit :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
thingsHit :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
thingsHit sp ep w
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
crs = zip crPs (map E3x1 hitCrs)
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
hitWls = wallsOnLine sp ep (IM.unions [f b $ f a $ _wallsZone w | a<-[x-1,x,x+1]
, b<-[y-1,y,y+1]])
(x,y) = zoneOfPoint (0.5 *.* (sp +.+ ep))
f i m = case IM.lookup i m of Just val -> val
_ -> IM.empty
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitPoint w = intersectSegSeg' sp ep (_wlLine w !! 0) (_wlLine w !! 1)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
@@ -37,34 +37,34 @@ thingsHitExceptCr :: Maybe Int -> Point2 -> Point2 -> World
thingsHitExceptCr Nothing sp ep = thingsHit sp ep
thingsHitExceptCr (Just cid) sp ep = filter crNotCid . thingsHit sp ep
where
crNotCid (_,(E3x1 cr)) = _crID cr /= cid
crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid _ = True
thingsHitExceptCrLongLine :: Maybe Int -> Point2 -> Point2 -> World
-> [(Point2, (Either3 Creature Wall ForceField))]
-> [(Point2, Either3 Creature Wall ForceField)]
thingsHitExceptCrLongLine Nothing sp ep = thingsHitLongLine sp ep
thingsHitExceptCrLongLine (Just cid) sp ep = filter crNotCid . thingsHitLongLine sp ep
where crNotCid (_,(E3x1 cr)) = _crID cr /= cid
where crNotCid (_,E3x1 cr) = _crID cr /= cid
crNotCid _ = True
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, (Either3 Creature Wall ForceField))]
thingsHitLongLine :: Point2 -> Point2 -> World -> [(Point2, Either3 Creature Wall ForceField)]
thingsHitLongLine sp ep w
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where
crs = zip crPs (map E3x1 hitCrs)
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
| sp == ep = []
| otherwise = sortBy (compare `on` dist sp . fst) (crs ++ walls ++ ffs)
where
crs = zip crPs (map E3x1 hitCrs)
hitCrs = IM.elems $ IM.filter (\cr -> circOnSeg sp ep (_crPos cr) (_crRad cr))
$ _creatures w
-- $ creaturesAlongLine sp ep w
crPs = map (\cr -> ssaTriPoint ep (_crPos cr) sp (_crRad cr)) hitCrs
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitPoint wl = intersectSegSeg' sp ep (_wlLine wl !! 0) (_wlLine wl !! 1)
walls = zip (map (fromJust . hitPoint) hitWls) (map E3x2 hitWls)
hitWls = wallsOnLine sp ep $ wallsAlongLine sp ep w
hitPoint wl = intersectSegSeg' sp ep (_wlLine wl !! 0) (_wlLine wl !! 1)
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
hitFFs = mapMaybe (collidePointFF sp ep (_randGen w)) (IM.elems $ _forceFields w)
ffs = map (\(p,(_,i)) -> (p, E3x3 $ _forceFields w IM.! i)) hitFFs
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, (Either3 Creature Wall ForceField) ) ] ]
thingsHitOnPath :: [Point2] -> World -> [ [ ( Point2, Either3 Creature Wall ForceField ) ] ]
thingsHitOnPath [] _ = error "tried to find thingsHitOnPath containing no points"
thingsHitOnPath ps w = map (flip (uncurry thingsHit) w) . zip ps $ tail ps
thingsHitOnPath ps w = zipWith (\ a b -> thingsHit a b w) ps $ tail ps