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

General cleanup, remove Drawing type synonym

Browse Source
This commit is contained in:
jgk
2021-03-23 15:48:14 +01:00
parent b13467053a
commit 451ef98b9f
8 changed files with 100 additions and 48 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
-3
View File
@@ -760,9 +760,6 @@ wallsLOS :: Foldable t => t [Point2] -> Point2 -> Point2 -> Bool
{-# INLINE wallsLOS #-}
wallsLOS !ls !c !p = all (\l -> wallLOS l c p) ls
translateDrawing = translate
rotateDrawing = rotate
mvPointTowardAtSpeed :: Float -> Point2 -> Point2 -> Point2
mvPointTowardAtSpeed speed !ep !p
| dist p ep < speed = ep
src/Dodge/CreatureState.hs
+3 -3
View File
@@ -9,6 +9,7 @@ import Dodge.WallCreatureCollisions
import Dodge.CreatureAction
import Geometry
import Picture
import Data.List
import Data.Char
@@ -54,9 +55,8 @@ stateUpdate u w (f,g) cr = case u w (f,g) (updateMovement g cr) of
. over decorations addCorpse
. insertIt
crBeforeDeath = colCrWall w $ cr
-- addCorpse = insertNewKey $ uncurry translateDrawing (_crPos crBeforeDeath)
addCorpse = insertNewKey $ uncurry translateDrawing (_crOldPos cr)
$ rotateDrawing (radToDeg (_crDir cr))
addCorpse = insertNewKey $ uncurry translate (_crOldPos cr)
$ rotate (_crDir cr)
(_crCorpse cr)
maybeIt = evalState (maybeTakeOne $ IM.elems (_crInv cr)) (_randGen w)
insertIt = case maybeIt of
src/Dodge/Critters.hs
+4 -4
View File
@@ -252,11 +252,11 @@ explosiveBarrel = basicCreature
, _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
equipOnTop :: (Creature -> Picture) -> Creature -> Drawing
equipOnTop :: (Creature -> Picture) -> Creature -> Picture
--equipOnTop f cr = onLayer CrLayer $ pictures $ fst (drawEquipment cr) ++ [f cr] ++ snd (drawEquipment cr)
equipOnTop f cr = pictures [onLayer CrLayer (f cr) , drawEquipment cr]
drawEquipment :: Creature -> Drawing
drawEquipment :: Creature -> Picture
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
where f (i,it) = case it ^? itEquipPict of
Just g -> g cr i
@@ -367,7 +367,7 @@ startCr = basicCreature
smokeGenGun = effectGun "smoke" $ \_ -> spawnSmokeAtCursor
enemyPict :: Color -> Creature -> Drawing
enemyPict :: Color -> Creature -> Picture
enemyPict col = equipOnTop $ sizeEnemy (light $ light $ light $ light col)
sizeEnemy col cr
@@ -380,7 +380,7 @@ sizeEnemy col cr
sizeColEnemy r col = pictures [color col $ circleSolid r, circLine r]
basicCrPict :: Color -> Creature -> Drawing
basicCrPict :: Color -> Creature -> Picture
basicCrPict col cr = pictures [ onLayer CrLayer naked , drawEquipment cr]
where naked | pdam > 200 = color red $ circleSolid $ _crRad cr
| pdam > 100 = color white $ circleSolid $ _crRad cr
src/Dodge/Data.hs
+27 -29
View File
@@ -64,7 +64,7 @@ data World = World
, _buttons :: IM.IntMap Button
, _soundQueue :: [Int]
, _sounds :: M.Map SoundOrigin Sound
, _decorations :: IM.IntMap Drawing
, _decorations :: IM.IntMap Picture
, _corpses :: IM.IntMap (IM.IntMap [Corpse])
, _lbClickMousePos :: (Float,Float)
, _lbRotation :: Float
@@ -84,11 +84,9 @@ data World = World
, _remap :: Keycode -> Keycode
} --deriving (Show)
type Drawing = Picture
data Corpse = Corpse
{ _cpPos :: Point2
, _cpPict :: Drawing
, _cpPict :: Picture
, _cpRes :: Creature
}
@@ -103,7 +101,7 @@ data Cloud = Cloud
{ _clID :: Int
, _clPos :: Point2
, _clVel :: Point2
, _clPict :: Cloud -> Drawing
, _clPict :: Cloud -> Picture
, _clRad :: Float
, _clTimer :: Int
, _clEffect :: Cloud -> World -> World
@@ -130,7 +128,7 @@ data Creature = Creature
, _crOldPos :: Point2
, _crDir :: Float
, _crID :: Int
, _crPict :: Creature -> Drawing
, _crPict :: Creature -> Picture
, _crUpdate :: World -> (World -> World,StdGen) -> Creature
-> ((World -> World,StdGen), Maybe Creature)
, _crRad :: Float
@@ -140,7 +138,7 @@ data Creature = Creature
, _crInv :: IM.IntMap Item
, _crInvSel :: Int
, _crState :: CreatureState
, _crCorpse :: Drawing
, _crCorpse :: Picture
}
data CreatureState
@@ -243,7 +241,7 @@ data MenuState
deriving (Eq,Ord)
data Button = Button
{ _btPict :: Drawing
{ _btPict :: Picture
, _btPos :: Point2
, _btRot :: Float
, _btEvent :: Button -> World -> World
@@ -255,7 +253,7 @@ data Button = Button
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
data PressPlate = PressPlate { _ppPict :: Drawing
data PressPlate = PressPlate { _ppPict :: Picture
, _ppPos :: Point2
, _ppRot :: Float
, _ppEvent :: PressPlate -> World -> World
@@ -283,13 +281,13 @@ data Item = Weapon
, _wpSpread :: Float
, _wpRange :: Float
, _itHammer :: HammerPosition
, _itFloorPict :: Drawing
, _itFloorPict :: Picture
, _itMaxStack :: Int
, _itAmount :: Int
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Drawing
, _itEquipPict :: Creature -> Int -> Picture
, _itScrollUp :: Int -> World -> World
, _itScrollDown :: Int -> World -> World
, _itIdentity :: ItemIdentity
@@ -304,8 +302,8 @@ data Item = Weapon
, _itMaxStack :: Int
, _itAmount :: Int
, _cnEffect :: Int -> World -> Maybe World
, _itFloorPict :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
@@ -317,8 +315,8 @@ data Item = Weapon
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itInvDisplay :: Item -> String
@@ -328,8 +326,8 @@ data Item = Weapon
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Drawing
, _itEquipPict :: Creature -> Int -> Drawing
, _itFloorPict :: Picture
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itEffect :: ItEffect
, _itID :: Maybe Int
@@ -344,14 +342,14 @@ data Item = Weapon
{ _itName :: String
, _itMaxStack :: Int
, _itAmount :: Int
, _itFloorPict :: Drawing
, _itFloorPict :: Picture
, _twMaxRange :: Float
, _twAccuracy :: Float
, _twFire :: Int -> World -> World
, _itAimingSpeed :: Float
, _itAimingRange :: Float
, _itZoom :: ItZoom
, _itEquipPict :: Creature -> Int -> Drawing
, _itEquipPict :: Creature -> Int -> Picture
, _itIdentity :: ItemIdentity
, _itID :: Maybe Int
, _itAttachment :: Maybe ItAttachment
@@ -432,10 +430,10 @@ data ItemIdentity
data Particle' =
Particle'
{ _ptPict' :: Drawing
{ _ptPict' :: Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
}
| Bul' { _ptPict' :: Drawing
| Bul' { _ptPict' :: Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
@@ -445,7 +443,7 @@ data Particle' =
, _btTimer' :: Int
, _btHitEffect' :: HitEffect
}
| Pt' { _ptPict' :: Drawing
| Pt' { _ptPict' :: Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btVel' :: Point2
, _btColor' :: Color
@@ -456,7 +454,7 @@ data Particle' =
, _btHitEffect' :: HitEffect
}
| Shockwave'
{ _ptPict' :: Drawing
{ _ptPict' :: Picture
, _ptUpdate' :: World -> Particle' -> (World, Maybe Particle')
, _btColor' :: Color
, _btPos' :: Point2
@@ -479,7 +477,7 @@ data Projectile =
Projectile { _ptPos :: Point2
, _ptStartPos :: Point2
, _ptVel :: Point2
, _ptPict :: Drawing
, _ptPict :: Picture
, _ptID :: Int
, _ptUpdate :: World -> World
}
@@ -515,7 +513,7 @@ data Wall
= Wall
{ _wlLine :: [Point2] , _wlID :: Int
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlDraw :: Maybe (Wall -> Picture)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
}
@@ -524,7 +522,7 @@ data Wall
, _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlDraw :: Maybe (Wall -> Picture)
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
@@ -534,7 +532,7 @@ data Wall
{ _wlLine :: [Point2] , _wlID :: Int
, _doorMech :: World -> World
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlDraw :: Maybe (Wall -> Picture)
, _wlSeen :: Bool
, _wlIsSeeThrough :: Bool
, _doorPathable :: Bool
@@ -543,7 +541,7 @@ data Wall
{ _wlLine :: [Point2]
, _wlID :: Int
, _wlColor :: Color
, _wlDraw :: Maybe (Wall -> Drawing)
, _wlDraw :: Maybe (Wall -> Picture)
, _wlSeen :: Bool
, _blIDs :: [Int]
, _blHP :: Int
@@ -579,7 +577,7 @@ data SoundOrigin = InventorySound
type Poly = [Point2]
data PSType = PutCrit Creature
| PutLS LightSource Drawing
| PutLS LightSource Picture
| PutButton Button
| PutFlIt FloorItem
| PutPressPlate PressPlate
src/Dodge/Item/Draw.hs
+1 -1
View File
@@ -5,7 +5,7 @@ import Dodge.Base
import Picture
drawWeapon :: Picture -> Creature -> Int -> Drawing
drawWeapon :: Picture -> Creature -> Int -> Picture
drawWeapon p cr posInInv
| _crInvSel cr == posInInv = onLayer PtLayer drawnWep
| otherwise = blank
src/Dodge/LevelGen.hs
+1 -1
View File
@@ -151,7 +151,7 @@ placeCr crF p rot w = over creatures addCr w
(crF {_crPos = p,_crOldPos = p,_crDir = rot,_crID = newKey crs})
crs
placeLS :: LightSource -> Drawing -> Point2 -> Float -> World -> World
placeLS :: LightSource -> Picture -> Point2 -> Float -> World -> World
placeLS ls dec p rot w = over lightSources addLS
$ over decorations addDec w
where addLS lss = IM.insert (newKey lss)
src/Dodge/Rendering.hs
+6 -6
View File
@@ -55,14 +55,14 @@ testPic w = [blank]
-- $ uncurry translate (mouseWorldPos w)
crDraw :: Creature -> Drawing
crDraw :: Creature -> Picture
crDraw c = uncurry translate (_crPos c) $ rotate (_crDir c) (_crPict c c)
ppDraw :: PressPlate -> Drawing
ppDraw :: PressPlate -> Picture
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Drawing
btDraw :: Button -> Picture
btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Drawing
clDraw :: Cloud -> Picture
clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
@@ -204,9 +204,9 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] +
rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
drawItem :: FloorItem -> Drawing
drawItem :: FloorItem -> Picture
drawItem flIt = uncurry translate (_flItPos flIt)
$ rotateDrawing (radToDeg $ _flItRot flIt) (_itFloorPict (_flIt flIt))
$ rotate (_flItRot flIt) (_itFloorPict (_flIt flIt))
ffToDraw :: World -> [ForceField]
src/Dodge/WorldEvent/Flash.hs
+58 -1
View File
@@ -22,6 +22,29 @@ lowLightColAt :: Color -> Float -> Point2 -> World -> World
lowLightColAt col alphay p w = foldr (lowLightWidthHit 10 5 col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad 20 30
lowLightWidthForHit :: Float -> Float -> Color -> Float -> Int -> Point2 -> Point2 -> World -> World
lowLightWidthForHit len wdth col alphay t a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> over particles' ((:) (wallGlareFor t len wdth col alphay p wall)) w
((p, E3x1 cr):_)
-> over particles' ((:) (crGlareFor t wdth col alphay p cr)) w
_ -> w
lowLightPic :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> Picture
lowLightPic len wdth col alphay a b w
= case thingsHitLongLine a b w of
((p, E3x2 wall):_)
-> setCol . lineOfThickness wdth $ [p +.+ x, p -.- x]
where x = len *.* (normalizeV $ wa -.- wb)
(wa:wb:_) = _wlLine wall
((p, E3x1 cr):_)
-> setCol . uncurry translate cp . rotate (-0.25 * pi + argV (p -.- cp))
$ thickArc 0 (pi/2) (_crRad cr) wdth
where cp = _crPos cr
_ -> blank
where setCol = color (withAlpha alphay col) . setDepth 0 . setLayer 1
lowLightWidthHit :: Float -> Float -> Color -> Float -> Point2 -> Point2 -> World -> World
lowLightWidthHit len wdth col alphay a b w
= case thingsHitLongLine a b w of
@@ -41,6 +64,15 @@ flashColAt col alphax (x,y) =
[20,25,30,35,40,45,50]
, _ptUpdate' = ptTimer' 1
}
wallGlareFor :: Int -> Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
wallGlareFor t len wdth col alphay p wl =
Particle'
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l
, _ptUpdate' = ptTimer' t
}
where l = color (withAlpha alphay col) $ lineOfThickness wdth $ [p +.+ x, p -.- x]
x = len *.* ( normalizeV $ a -.- b)
(a:b:_) = _wlLine wl
wallGlareWidth :: Float -> Float -> Color -> Float -> Point2 -> Wall -> Particle'
wallGlareWidth len wdth col alphay p wl =
@@ -52,6 +84,25 @@ wallGlareWidth len wdth col alphay p wl =
x = len *.* ( normalizeV $ a -.- b)
(a:b:_) = _wlLine wl
crGlareFor :: Int -> Float -> Color -> Float -> Point2 -> Creature -> Particle'
crGlareFor t wdth col alphay p cr =
Particle'
{ _ptPict' = onLayerL [levLayer GloomLayer + 2] $ l cp
, _ptUpdate' = \w pt -> (w, Just $ pt {_ptPict' = onLayerL [levLayer GloomLayer + 2] $ upp cid w
,_ptUpdate' = ptTimer' (t - 1)
}
)
}
where l x = uncurry translate x
$ rotate (-0.25*pi + argV (p -.- x))
$ color (withAlpha alphay col)
$ thickArc 0 (pi/2) (_crRad cr) wdth
cp = _crPos cr
cid = _crID cr
upp cid' w' = case w' ^? creatures . ix cid . crPos of
Just y -> l y
_ -> blank
crGlareWidth :: Float -> Color -> Float -> Point2 -> Creature -> Particle'
crGlareWidth wdth col alphay p cr =
Particle'
@@ -96,9 +147,15 @@ lowLightWidthAt :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 ->
lowLightWidthAt len wdth col alphay rays rad p w = foldr (lowLightWidthHit len wdth col alphay p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
lowLightAtFor :: Float -> Float -> Color -> Float -> Int -> Float -> Point2 -> Int -> World -> World
lowLightAtFor len wdth col alphay rays rad p t w
= foldr (lowLightWidthForHit len wdth col alphay t p) w ps
where ps = map ((+.+) p) $ nRaysRad rays rad
explosionFlashAt :: Point2 -> World -> World
explosionFlashAt p = over tempLightSources ((:) $ tLightFade 20 150 intensityFunc p)
. lowLightWidthAt 10 5 white 0.3 75 150 p
. lowLightAtFor 10 5 white 0.3 75 150 p 20
where intensityFunc x
| x < 10 = 1 / (10 - fromIntegral x)
| otherwise = 1