Cleanup creature picture
This commit is contained in:
@@ -18,7 +18,6 @@ import Data.Aeson
|
||||
import GHC.Generics
|
||||
--import System.Directory
|
||||
import Control.Lens
|
||||
|
||||
data Configuration = Configuration
|
||||
{ _volume_master :: Float
|
||||
, _volume_sound :: Float
|
||||
@@ -30,7 +29,6 @@ data Configuration = Configuration
|
||||
, _windowY :: Float
|
||||
}
|
||||
deriving (Generic, Show)
|
||||
|
||||
makeLenses ''Configuration
|
||||
|
||||
instance ToJSON Configuration where
|
||||
@@ -43,10 +41,9 @@ defaultConfig = Configuration
|
||||
{ _volume_master = 1
|
||||
, _volume_sound = 1
|
||||
, _volume_music = 1
|
||||
, _wall_textured = False
|
||||
, _wall_textured = True
|
||||
, _cloud_shadows = True
|
||||
, _resolution_factor = 1
|
||||
, _windowX = 800
|
||||
, _windowY = 600
|
||||
}
|
||||
|
||||
|
||||
@@ -15,10 +15,9 @@ import Dodge.Creature.Test
|
||||
--import Dodge.Creature.AlertLevel.Data
|
||||
--import Dodge.Picture.Layer
|
||||
import Dodge.Item.Data
|
||||
import Dodge.Base.Window
|
||||
import Picture
|
||||
import Geometry
|
||||
import Geometry.Vector3D
|
||||
--import Geometry.Vector3D
|
||||
|
||||
import Control.Lens
|
||||
import Data.List
|
||||
@@ -28,24 +27,28 @@ basicCrPict
|
||||
-> Creature
|
||||
-> World
|
||||
-> Picture
|
||||
basicCrPict col cr w
|
||||
| dist (_crPos cr) (_cameraCenter w) > 1.5 * max (getWindowX w) (getWindowY w) = blank
|
||||
| otherwise = setLayer 0 $ pictures $
|
||||
targetingPic ++
|
||||
[ tr . setDepth 0 $ color yellow $ circleSolid 10
|
||||
, tr . piercingMod $ bluntScale $ naked col cr
|
||||
, tr $ torso (light4 col) (V2 0 (-crad)) (V2 0 crad)
|
||||
, trFeet $ feet cr
|
||||
, tr $ arms col cr
|
||||
, tr $ drawEquipment cr
|
||||
]
|
||||
basicCrPict col cr w = setLayer 0 $ pictures $
|
||||
targetingPic ++
|
||||
[ tr . dm . rotdir $ scalp cr
|
||||
, tr . dm . rotdir $ upperBody col cr
|
||||
, tr . dm . rotmdir $ feet cr
|
||||
, tr . rotdir $ drawEquipment cr
|
||||
]
|
||||
where
|
||||
crad = _crRad cr
|
||||
dm = damageMod cr
|
||||
targetingPic = IM.elems $ IM.mapMaybeWithKey f $ _crInv cr
|
||||
f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
|
||||
tr = uncurryV translate (_crPos cr) . rotate (_crDir cr)
|
||||
trFeet = uncurryV translate (_crPos cr) . rotate (_crMvDir cr)
|
||||
tr = uncurryV translate (_crPos cr)
|
||||
rotdir = rotate (_crDir cr)
|
||||
rotmdir = rotate (_crMvDir cr)
|
||||
. setDepth 1
|
||||
. color (greyN 0.3)
|
||||
|
||||
damageMod :: Creature -> Picture -> Picture
|
||||
damageMod cr pic = piercingMod $ bluntScale pic
|
||||
where
|
||||
cdir = _crDir cr
|
||||
pastDams = _crPastDamage $ _crState cr
|
||||
bluntDam :: Maybe Point2
|
||||
bluntDam = find isBluntDam (concat pastDams) >>= (\dm -> (-.-) <$> dm ^? dmFrom <*> dm ^? dmTo)
|
||||
bluntScale = case fmap argV bluntDam of
|
||||
@@ -59,94 +62,104 @@ basicCrPict col cr w
|
||||
piercingMod = case fmap argV piercingDam of
|
||||
Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a)
|
||||
_ -> id
|
||||
pastDams = _crPastDamage $ _crState cr
|
||||
|
||||
feet :: Creature -> Picture
|
||||
feet cr = case cr ^? crStance . carriage of
|
||||
Just (Walking sa LeftForward) -> setL
|
||||
[ translate (f sa) off $ circleSolid 5
|
||||
, translate (-f sa) (-off) $ circleSolid 5
|
||||
Just (Walking sa LeftForward) -> pictures
|
||||
[ translate ( f sa) off aFoot
|
||||
, translate (-f sa) (-off) aFoot
|
||||
]
|
||||
Just (Walking sa RightForward) -> setL
|
||||
[ translate (-f sa) off $ circleSolid 5
|
||||
, translate (f sa) (-off) $ circleSolid 5
|
||||
Just (Walking sa RightForward) -> pictures
|
||||
[ translate (-f sa) off aFoot
|
||||
, translate ( f sa) (-off) aFoot
|
||||
]
|
||||
_ -> setL
|
||||
[ translate 0 off $ circleSolid 5
|
||||
, translate 0 (-off) $ circleSolid 5
|
||||
_ -> pictures
|
||||
[ translate 0 off aFoot
|
||||
, translate 0 (-off) aFoot
|
||||
]
|
||||
where
|
||||
--setL = onLayerL [levLayer CrLayer, -5] . color (greyN 0.3) . pictures
|
||||
setL = setDepth 1 . color (greyN 0.3) . pictures
|
||||
aFoot = circleSolid 4
|
||||
off = 5
|
||||
sLen = _strideLength $ _crStance cr
|
||||
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
|
||||
|
||||
arms :: Color -> Creature -> Picture
|
||||
arms col cr
|
||||
| aimingTwist = blank
|
||||
arms :: Creature -> Picture
|
||||
arms cr
|
||||
| oneH cr = shoulderH . translate 11 (-3) . rotate (-0.5) $ scale 1 1.5 aHand
|
||||
| twists cr = shoulderH . translate 0 (0.5* crad) . rotate (-1) $ pictures
|
||||
[ translate 12 4 aHand
|
||||
, translate 4 (-10) aHand
|
||||
]
|
||||
| otherwise = case cr ^? crStance . carriage of
|
||||
Just (Walking sa LeftForward) -> setL
|
||||
[ translate (-f sa) (-off) . sc $ circleSolid 4
|
||||
]
|
||||
Just (Walking sa RightForward) -> setL
|
||||
[ translate (-f sa) off . sc $ circleSolid 4
|
||||
]
|
||||
Just (Walking sa LeftForward) -> waistH $ translate (-f sa) (-off) aHand
|
||||
Just (Walking sa RightForward) -> waistH $ translate (-f sa) off aHand
|
||||
_ -> blank
|
||||
where
|
||||
sc = scale 1 1
|
||||
--setL = onLayerL [levLayer CrLayer, -4] . color (light4 col) . pictures
|
||||
setL = setDepth 20 . color (light4 col) . pictures
|
||||
aHand = circleSolid 4
|
||||
crad = _crRad cr
|
||||
off = 8
|
||||
sLen = _strideLength $ _crStance cr
|
||||
f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen
|
||||
aimingTwist = crIsAiming' cr -- && crIt ^? itAimStance == Just TwoHandTwist
|
||||
--crIt = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
torso :: Color -> Point2 -> Point2 -> Picture
|
||||
torso col x y = color col $ pictures
|
||||
[ poly3 [addZ 20 x, addZ 12 v, addZ 12 (V2 0 0 -.- v), addZ 20 y]
|
||||
, setDepth 12 . rotate a . scale 1 1 $ circleSolid $ magV v
|
||||
]
|
||||
scalp :: Creature -> Picture
|
||||
scalp cr
|
||||
| twists cr = translate 0 (0.5*crad) . rotate (-1) $ translate (negate 0.25 * crad) 0.25 fhead
|
||||
| oneH cr = rotate 0.5 $ translate (0.25 * crad) 0 fhead
|
||||
| otherwise = translate (0.25 * crad) 0 fhead
|
||||
|
||||
where
|
||||
v = 0.25 *.* (x -.- y)
|
||||
a = argV v
|
||||
fhead = setDepth 22 $ circleSolid $ crad * 0.5
|
||||
crad = _crRad cr
|
||||
|
||||
oneH :: Creature -> Bool
|
||||
oneH cr = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
|
||||
where
|
||||
crIt = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
twists :: Creature -> Bool
|
||||
twists cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
|
||||
where
|
||||
crIt = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
torso :: Creature -> Picture
|
||||
torso cr
|
||||
| oneH cr = rotate 0.5 $ pictures
|
||||
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
|
||||
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
]
|
||||
| twists cr = translate 0 (0.5* crad) . rotate (-1) $ pictures
|
||||
[ rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) $ aShoulder
|
||||
, rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
]
|
||||
| otherwise = pictures
|
||||
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
|
||||
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
]
|
||||
where
|
||||
aShoulder = scale 0.5 1 $ circleSolid crad
|
||||
crad = _crRad cr
|
||||
|
||||
upperBody :: Color -> Creature -> Picture
|
||||
upperBody col cr = color (light4 col) $ pictures
|
||||
[ arms cr
|
||||
, shoulderH $ torso cr
|
||||
]
|
||||
|
||||
naked :: Color -> Creature -> Picture
|
||||
naked col cr
|
||||
naked _ cr
|
||||
| strikeMelee = shoulderH . color white $ circleSolid $ _crRad cr
|
||||
| pdam > 200 = shoulderH . color red $ circleSolid $ _crRad cr
|
||||
| pdam > 99 = shoulderH . color white $ circleSolid $ _crRad cr
|
||||
| aimingOneHand = rotate (negate twistA * 0.5) $ pictures
|
||||
[ translate (0.25 * crad) 0 fhead
|
||||
, shoulderH . translate 8 (-8) . color col' $ circleSolid 4
|
||||
, translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
, translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
]
|
||||
| aimingTwist = translate 0 (0.5* crad) . rotate twistA $ pictures
|
||||
[ translate (negate 0.25 * crad) 0.25 fhead
|
||||
, shoulderH . translate 12 4 . color col' $ circleSolid 4
|
||||
, shoulderH . translate 4 (-10) . color col' $ circleSolid 4
|
||||
, shoulderH . rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
, shoulderH . rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
]
|
||||
| otherwise = pictures
|
||||
[ translate (0.25 * crad) 0 fhead
|
||||
, shoulderH . translate 0 3 . rotate (negate 0.2) . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
, shoulderH . translate 0 (negate 3) . rotate 0.2 . scale 0.5 1 $ color col' $ circleSolid $ _crRad cr
|
||||
]
|
||||
| otherwise = []
|
||||
where
|
||||
fhead = setDepth 22 $ circleSolid $ crad * 0.5
|
||||
shoulderH = setDepth 20
|
||||
twistA = negate 1
|
||||
aimingOneHand = crIsAiming' cr && crIt ^? itAimStance == Just OneHand
|
||||
aimingTwist = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
|
||||
crIt = _crInv cr IM.! _crInvSel cr
|
||||
strikeMelee = _crMeleeCooldown cr > 5
|
||||
pdam = sum $ concatMap (map _dmAmount) pastDams
|
||||
crad = _crRad cr
|
||||
pastDams = _crPastDamage $ _crState cr
|
||||
col' = light . light . light $ light col
|
||||
|
||||
shoulderH :: Picture -> Picture
|
||||
shoulderH = setDepth 20
|
||||
waistH :: Picture -> Picture
|
||||
waistH = setDepth 10
|
||||
|
||||
light4 :: Color -> Color
|
||||
light4 = light . light . light . light
|
||||
|
||||
+35
-2
@@ -19,7 +19,6 @@ import Dodge.Creature.State.Data
|
||||
import Dodge.Creature.Stance.Data
|
||||
import Dodge.Creature.AlertLevel.Data
|
||||
import Dodge.Debug.Flag.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Data.SoundOrigin
|
||||
import Dodge.Data.DamageType
|
||||
import Dodge.Config.Data
|
||||
@@ -88,7 +87,7 @@ data World = World
|
||||
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
|
||||
, _pathInc :: ~(M.Map Point2 [Point2])
|
||||
, _storedLevel :: Maybe World
|
||||
, _menuLayers :: [MenuLayer]
|
||||
, _menuLayers :: [ScreenLayer]
|
||||
, _worldState :: M.Map WorldState Bool
|
||||
, _worldTriggers :: S.Set WorldTrigger
|
||||
, _carteDisplay :: !Bool
|
||||
@@ -110,6 +109,40 @@ data World = World
|
||||
, _radDistortion :: [(Point2,Point2,Point2,Float)]
|
||||
, _gameRooms :: [GameRoom]
|
||||
}
|
||||
data OptionScreenFlag = NormalOptions | GameOverOptions
|
||||
data ScreenLayer
|
||||
= OptionScreen
|
||||
{ _scTitle :: World -> String
|
||||
, _scOptions :: [MenuOption]
|
||||
, _scDefaultEff :: World -> Maybe World
|
||||
, _scOptionFlag :: OptionScreenFlag
|
||||
}
|
||||
| InputScreen String
|
||||
| TerminalScreen Int [(Int,String)]
|
||||
| WaitScreen
|
||||
{ _scWaitMessage :: World -> String
|
||||
, _scWaitTime :: Int
|
||||
}
|
||||
| DisplayScreen
|
||||
{ _scDisplay :: World -> Picture
|
||||
}
|
||||
data MenuOption
|
||||
= Toggle
|
||||
{ _moKey :: Scancode
|
||||
, _moEff :: World -> Maybe World
|
||||
, _moString :: World -> String
|
||||
}
|
||||
| Toggle2
|
||||
{ _moKey1 :: Scancode
|
||||
, _moEff1 :: World -> Maybe World
|
||||
, _moKey2 :: Scancode
|
||||
, _moEff2 :: World -> Maybe World
|
||||
, _moString :: World -> String
|
||||
}
|
||||
| InvisibleToggle
|
||||
{ _moKey :: Scancode
|
||||
, _moEff :: World -> Maybe World
|
||||
}
|
||||
data InventoryMode
|
||||
= TopInventory
|
||||
| TweakInventory
|
||||
|
||||
@@ -1,15 +0,0 @@
|
||||
{-# LANGUAGE StrictData #-}
|
||||
module Dodge.Data.Menu
|
||||
where
|
||||
data MenuLayer
|
||||
= LevelMenu Int
|
||||
| PauseMenu
|
||||
| GameOverMenu
|
||||
| OptionMenu
|
||||
| SoundOptionMenu
|
||||
| GraphicsOptionMenu
|
||||
| ControlList
|
||||
| WaitMessage String Int
|
||||
| Terminal String
|
||||
| TerminalMessage Int [(Int,String)]
|
||||
deriving (Eq,Ord)
|
||||
@@ -1,12 +1,12 @@
|
||||
module Dodge.Default.World
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Base
|
||||
import Dodge.Debug.Flag.Data
|
||||
import Dodge.Config.Data
|
||||
import Dodge.Config.KeyConfig
|
||||
import Dodge.Item.Data
|
||||
--import Dodge.Menu
|
||||
--import Picture
|
||||
import Geometry.Data
|
||||
--import Picture.Texture
|
||||
@@ -52,7 +52,8 @@ defaultWorld = World
|
||||
, _corpses = IM.empty
|
||||
, _decorations = IM.empty
|
||||
, _storedLevel = Nothing
|
||||
, _menuLayers = [LevelMenu 1]
|
||||
--, _menuLayers = [levelMenu 1]
|
||||
, _menuLayers = []
|
||||
, _worldState = M.empty
|
||||
, _worldTriggers = S.empty
|
||||
, _clickMousePos = V2 0 0
|
||||
|
||||
@@ -6,7 +6,7 @@ module Dodge.Event.Keyboard
|
||||
)
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
--import Dodge.Data.Menu
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Base
|
||||
import Dodge.Creature.Action
|
||||
@@ -18,6 +18,7 @@ import Dodge.Creature.Inanimate
|
||||
import qualified Data.IntMap.Strict as IM
|
||||
import Dodge.Event.Test
|
||||
import Dodge.Event.Menu
|
||||
import Dodge.Menu
|
||||
|
||||
import SDL
|
||||
import Data.Maybe
|
||||
@@ -39,7 +40,7 @@ handleKeyboardEvent kev w = case keyboardEventKeyMotion kev of
|
||||
|
||||
handlePressedKey :: Bool -> Scancode -> World -> Maybe World
|
||||
handlePressedKey True _ w = Just w
|
||||
handlePressedKey _ ScancodeSemicolon w | not (inTerminal w) = Just $ gotoTerminal w
|
||||
handlePressedKey _ ScancodeSemicolon w = Just $ gotoTerminal w
|
||||
handlePressedKey _ scode w
|
||||
| null (_menuLayers w) = handlePressedKeyInGame scode w
|
||||
| otherwise = handlePressedKeyInMenu (head $ _menuLayers w) scode w
|
||||
@@ -67,15 +68,10 @@ toggleInv x y
|
||||
| x == y = TopInventory
|
||||
| otherwise = x
|
||||
|
||||
|
||||
inTerminal :: World -> Bool
|
||||
inTerminal w = case _menuLayers w of
|
||||
(Terminal _ : _) -> True
|
||||
_ -> False
|
||||
gotoTerminal :: World -> World
|
||||
gotoTerminal w = case _menuLayers w of
|
||||
(Terminal _ : _ ) -> w
|
||||
_ -> w & menuLayers %~ (Terminal [] :)
|
||||
(InputScreen _ : _ ) -> w
|
||||
_ -> w & menuLayers %~ (InputScreen [] :)
|
||||
|
||||
spaceAction :: World -> World
|
||||
spaceAction w = if _carteDisplay w
|
||||
@@ -89,7 +85,7 @@ spaceAction w = if _carteDisplay w
|
||||
updateTopCloseObject i w' = w' & closeActiveObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
|
||||
|
||||
pauseGame :: World -> World
|
||||
pauseGame w = w {_menuLayers = [PauseMenu]}
|
||||
pauseGame w = w {_menuLayers = [pauseMenu]}
|
||||
|
||||
toggleMap :: World -> World
|
||||
toggleMap w = w & carteDisplay %~ not
|
||||
|
||||
+20
-49
@@ -2,63 +2,39 @@ module Dodge.Event.Menu
|
||||
( handlePressedKeyInMenu
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
--import Dodge.Base.Window
|
||||
--import Dodge.Floor
|
||||
--import Dodge.Initialisation
|
||||
import Dodge.SoundLogic
|
||||
--import Dodge.Config.Data
|
||||
import Dodge.Config.Update
|
||||
--import Dodge.Layout
|
||||
--import Preload.Update
|
||||
import Dodge.Debug.Terminal
|
||||
import Dodge.Menu
|
||||
|
||||
--import Data.Maybe
|
||||
--import Data.Foldable
|
||||
--import qualified Data.Set as S
|
||||
import Control.Monad
|
||||
import Control.Lens
|
||||
import SDL
|
||||
--import SDL.Internal.Numbered
|
||||
|
||||
handlePressedKeyInMenu :: MenuLayer -> Scancode -> World -> Maybe World
|
||||
handlePressedKeyInMenu mState scode w = case mState of
|
||||
TerminalMessage 0 _ -> popMenu w
|
||||
TerminalMessage _ m -> Just $ w & menuLayers %~ ((TerminalMessage 0 m : ) . tail)
|
||||
Terminal s -> case scode of
|
||||
ScancodeEscape -> popMenu w
|
||||
ScancodeReturn -> popMenu $ applyTerminalString s w
|
||||
ScancodeBackspace -> popMenu w >>= pushMenu (Terminal $ dropLast s)
|
||||
_ -> popMenu w >>= pushMenu (Terminal $ s ++ [scodeToChar scode])
|
||||
LevelMenu _ -> optionListToEffects levelMenuOptions startLevel scode w
|
||||
PauseMenu -> optionListToEffects pauseMenuOptions unpause scode w
|
||||
GameOverMenu -> optionListToEffects pauseMenuOptions pure scode w
|
||||
OptionMenu -> optionListToEffects optionsOptions popMenu scode w
|
||||
SoundOptionMenu -> optionListToEffects
|
||||
soundMenuOptions
|
||||
( popMenu . writeConfig )
|
||||
scode
|
||||
w
|
||||
GraphicsOptionMenu -> optionListToEffects graphicsMenuOptions (popMenu . writeConfig) scode w
|
||||
ControlList -> Just $ w & menuLayers %~ tail
|
||||
_ -> Just w
|
||||
handlePressedKeyInMenu :: ScreenLayer -> Scancode -> World -> Maybe World
|
||||
handlePressedKeyInMenu mState scode = case mState of
|
||||
OptionScreen { _scOptions = mos, _scDefaultEff = defeff}
|
||||
-> optionListToEffects mos defeff scode
|
||||
DisplayScreen {} -> popScreen
|
||||
WaitScreen {} -> Just
|
||||
TerminalScreen 0 _ -> popScreen
|
||||
TerminalScreen _ m -> Just . ( menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )
|
||||
InputScreen s -> case scode of
|
||||
ScancodeEscape -> popScreen
|
||||
ScancodeReturn -> popScreen . applyTerminalString s
|
||||
ScancodeBackspace
|
||||
-> popScreen >=> pushScreen (InputScreen $ dropLast s)
|
||||
_ -> popScreen >=> pushScreen (InputScreen $ s ++ [scodeToChar scode])
|
||||
where
|
||||
writeConfig = sideEffects %~ (saveConfig (_config w) :)
|
||||
unpause w' = Just . resumeSound $ w' {_menuLayers = []}
|
||||
startLevel = unpause . storeLevel
|
||||
popMenu w' = Just $ w' & menuLayers %~ tail
|
||||
dropLast (x:xs) = init (x:xs)
|
||||
dropLast _ = []
|
||||
|
||||
dropLast _ = []
|
||||
optionListToEffects :: [MenuOption] -> (World -> Maybe World) -> Scancode -> World -> Maybe World
|
||||
optionListToEffects mos eff sc w = case lookup sc listEffects of
|
||||
Nothing -> eff w
|
||||
Just eff' -> eff' w
|
||||
optionListToEffects mos defaulteff sc w = case lookup sc listEffects of
|
||||
Nothing -> defaulteff w
|
||||
Just eff -> eff w
|
||||
where
|
||||
listEffects = concatMap menuOptionToEffects mos
|
||||
|
||||
menuOptionToEffects :: MenuOption -> [(Scancode,World -> Maybe World)]
|
||||
menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
|
||||
menuOptionToEffects Toggle {_moKey = k, _moEff = eff} = [(k,eff)]
|
||||
menuOptionToEffects InvisibleToggle {_moKey = k, _moEff = eff} = [(k,eff)]
|
||||
menuOptionToEffects Toggle2
|
||||
{ _moKey1 = k1
|
||||
@@ -66,8 +42,3 @@ menuOptionToEffects Toggle2
|
||||
, _moKey2 = k2
|
||||
, _moEff2 = eff2
|
||||
} = [(k1,eff1) , (k2,eff2)]
|
||||
|
||||
storeLevel :: World -> World
|
||||
storeLevel w = case _storedLevel w of
|
||||
Nothing -> w & storedLevel ?~ w
|
||||
_ -> w
|
||||
|
||||
@@ -1,7 +1,6 @@
|
||||
module Dodge.Initialisation where
|
||||
import Dodge.Default.World
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Creature
|
||||
--import Dodge.Base
|
||||
import Dodge.Floor
|
||||
@@ -49,7 +48,7 @@ initialWorld = defaultWorld
|
||||
, _sounds = M.empty
|
||||
, _decorations = IM.empty
|
||||
, _storedLevel = Nothing
|
||||
, _menuLayers = [TerminalMessage 300 rezText']
|
||||
, _menuLayers = [TerminalScreen 300 rezText']
|
||||
, _worldState = M.empty
|
||||
}
|
||||
testStringInit :: World -> [String]
|
||||
|
||||
+107
-29
@@ -1,7 +1,6 @@
|
||||
module Dodge.Menu
|
||||
where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Config.Data
|
||||
import Dodge.Config.Update
|
||||
import SDL
|
||||
@@ -11,38 +10,37 @@ import Dodge.Floor
|
||||
import Dodge.Initialisation
|
||||
import Preload.Update
|
||||
import Dodge.Base.Window
|
||||
import Dodge.SoundLogic
|
||||
import Picture
|
||||
import Geometry
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
|
||||
data MenuOption
|
||||
= Toggle
|
||||
{ _moKey :: Scancode
|
||||
, _moEff :: World -> Maybe World
|
||||
, _moString :: World -> String
|
||||
}
|
||||
| Toggle2
|
||||
{ _moKey1 :: Scancode
|
||||
, _moEff1 :: World -> Maybe World
|
||||
, _moKey2 :: Scancode
|
||||
, _moEff2 :: World -> Maybe World
|
||||
, _moString :: World -> String
|
||||
}
|
||||
| InvisibleToggle
|
||||
{ _moKey :: Scancode
|
||||
, _moEff :: World -> Maybe World
|
||||
}
|
||||
optionMenu :: ScreenLayer
|
||||
optionMenu = OptionScreen
|
||||
{ _scTitle = const "OPTIONS"
|
||||
, _scOptions = optionsOptions
|
||||
, _scDefaultEff = popScreen
|
||||
, _scOptionFlag = NormalOptions
|
||||
}
|
||||
optionsOptions :: [MenuOption]
|
||||
optionsOptions =
|
||||
[ Toggle ScancodeV (pushMenu SoundOptionMenu) (const "VOLUME")
|
||||
, Toggle ScancodeG (pushMenu GraphicsOptionMenu) (const "GRAPHICS")
|
||||
[ Toggle ScancodeV (pushScreen soundMenu) (const "VOLUME")
|
||||
, Toggle ScancodeG (pushScreen graphicsMenu) (const "GRAPHICS")
|
||||
]
|
||||
levelMenuOptions :: [MenuOption]
|
||||
levelMenuOptions =
|
||||
[ InvisibleToggle ScancodeEscape (const Nothing)
|
||||
, InvisibleToggle ScancodeO (pushMenu OptionMenu)
|
||||
, InvisibleToggle ScancodeC (pushMenu ControlList)
|
||||
, InvisibleToggle ScancodeO (pushScreen optionMenu)
|
||||
, InvisibleToggle ScancodeC (pushScreen displayControls)
|
||||
]
|
||||
soundMenu :: ScreenLayer
|
||||
soundMenu = OptionScreen
|
||||
{ _scTitle = const "OPTIONS:VOLUME"
|
||||
, _scOptions = soundMenuOptions
|
||||
, _scDefaultEff = popScreen . writeConfig
|
||||
, _scOptionFlag = NormalOptions
|
||||
}
|
||||
soundMenuOptions :: [MenuOption]
|
||||
soundMenuOptions =
|
||||
[ Toggle2 ScancodeY (master dec . sw)
|
||||
@@ -65,9 +63,22 @@ soundMenuOptions =
|
||||
muvol w = f $ _volume_music $ cfig w
|
||||
f x = show (round $ 10 * x :: Int)
|
||||
|
||||
pushMenu :: MenuLayer -> World -> Maybe World
|
||||
pushMenu ml w' = Just $ w' & menuLayers %~ (ml :)
|
||||
pushScreen :: ScreenLayer -> World -> Maybe World
|
||||
pushScreen ml w = Just $ w & menuLayers %~ (ml :)
|
||||
|
||||
popScreen :: World -> Maybe World
|
||||
popScreen = Just . (menuLayers %~ tail)
|
||||
|
||||
writeConfig :: World -> World
|
||||
writeConfig w = w & sideEffects %~ (saveConfig (_config w) :)
|
||||
|
||||
graphicsMenu :: ScreenLayer
|
||||
graphicsMenu = OptionScreen
|
||||
{ _scTitle = const "OPTIONS:GRAPHICS"
|
||||
, _scOptions = graphicsMenuOptions
|
||||
, _scDefaultEff = popScreen . writeConfig
|
||||
, _scOptionFlag = NormalOptions
|
||||
}
|
||||
graphicsMenuOptions :: [MenuOption]
|
||||
graphicsMenuOptions =
|
||||
[ Toggle ScancodeW (Just . (config . wall_textured %~ not)) wtextstring
|
||||
@@ -86,18 +97,32 @@ cycleResolution 2 = 4
|
||||
cycleResolution 4 = 1
|
||||
cycleResolution _ = 1
|
||||
|
||||
gameOverMenu :: ScreenLayer
|
||||
gameOverMenu = OptionScreen
|
||||
{ _scTitle = const "GAME OVER"
|
||||
, _scOptions = pauseMenuOptions
|
||||
, _scDefaultEff = Just
|
||||
, _scOptionFlag = GameOverOptions
|
||||
}
|
||||
|
||||
pauseMenu :: ScreenLayer
|
||||
pauseMenu = OptionScreen
|
||||
{ _scTitle = const "PAUSED"
|
||||
, _scOptions = pauseMenuOptions
|
||||
, _scDefaultEff = unpause
|
||||
, _scOptionFlag = NormalOptions
|
||||
}
|
||||
pauseMenuOptions :: [MenuOption]
|
||||
pauseMenuOptions =
|
||||
[ Toggle ScancodeN startNewGame (const "NEW LEVEL")
|
||||
, Toggle ScancodeR (\w -> return $ fromMaybe w $ _storedLevel w) (const "RESTART")
|
||||
, Toggle ScancodeO (pushMenu OptionMenu ) (const "OPTIONS")
|
||||
, Toggle ScancodeC (pushMenu ControlList) (const "CONTROLS")
|
||||
, Toggle ScancodeO (pushScreen optionMenu ) (const "OPTIONS")
|
||||
, Toggle ScancodeC (pushScreen displayControls) (const "CONTROLS")
|
||||
, InvisibleToggle ScancodeEscape (const Nothing)
|
||||
]
|
||||
|
||||
startNewGame :: World -> Maybe World
|
||||
startNewGame w = Just $ w
|
||||
& menuLayers .~ [WaitMessage "GENERATING..." 1]
|
||||
& menuLayers .~ [WaitScreen (const "GENERATING...") 1]
|
||||
& worldEvents .~ const aNewGame
|
||||
where
|
||||
aNewGame :: World
|
||||
@@ -118,3 +143,56 @@ updateFramebufferSize w = w & sideEffects
|
||||
where
|
||||
(x,y) = (round $ getWindowX w, round $ getWindowY w)
|
||||
divRes = w ^. config . resolution_factor
|
||||
|
||||
levelMenu :: Int -> ScreenLayer
|
||||
levelMenu x = OptionScreen
|
||||
{ _scTitle = const $ "LEVEL "++ show x
|
||||
, _scOptions = levelMenuOptions
|
||||
, _scDefaultEff = unpause . storeLevel
|
||||
, _scOptionFlag = NormalOptions
|
||||
}
|
||||
unpause :: World -> Maybe World
|
||||
unpause w = Just . resumeSound $ w {_menuLayers = []}
|
||||
|
||||
storeLevel :: World -> World
|
||||
storeLevel w = case _storedLevel w of
|
||||
Nothing -> w & storedLevel ?~ w
|
||||
_ -> w
|
||||
|
||||
displayControls :: ScreenLayer
|
||||
displayControls = DisplayScreen
|
||||
{_scDisplay = \w -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
,tst (-100) 100 0.4 "CONTROLS"
|
||||
,controlsList
|
||||
]
|
||||
}
|
||||
where
|
||||
tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
|
||||
controlsList :: Picture
|
||||
controlsList = pictures $ concat $ zipWith butAndEff
|
||||
[("wasd", "movement")
|
||||
,("[rmb]", "aim")
|
||||
,("[rmb+lmb]", "shoot or use item")
|
||||
,("[wheelscroll]" , "select item" )
|
||||
,("[space]" , "pickup item" )
|
||||
,("m" , "display map" )
|
||||
,("f" , "drop item" )
|
||||
,("c[esc]" , "pause" )
|
||||
,("qe" , "rotate camera")
|
||||
]
|
||||
[60,30..]
|
||||
where
|
||||
butAndEff (btext,etext) y =
|
||||
[translate (-250) y $ scale 0.15 0.15 $ color white $ text btext
|
||||
,translate 0 y $ scale 0.15 0.15 $ color white $ text etext
|
||||
]
|
||||
|
||||
screenBox
|
||||
:: World
|
||||
-> [Point2]
|
||||
screenBox w = rectNSEW hh (-hh) hw (-hw)
|
||||
where
|
||||
hw = halfWidth w
|
||||
hh = halfHeight w
|
||||
|
||||
+15
-17
@@ -121,7 +121,7 @@ doDrawing pdata w = do
|
||||
textureBinding Texture2D $= Just (snd $ _fboBloom pdata)
|
||||
blend $= Disabled
|
||||
drawShader (_bloomBlurShader pdata) 4
|
||||
replicateM_ 5 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
|
||||
replicateM_ 9 $ pingPongBetween (_fboHalf1 pdata) (_fboHalf2 pdata) (_bloomBlurShader pdata)
|
||||
blend $= Enabled
|
||||
setViewportSize (round winx `div` resFact) (round winy `div` resFact)
|
||||
--draw clouds
|
||||
@@ -137,22 +137,20 @@ doDrawing pdata w = do
|
||||
clear [ColorBuffer]
|
||||
renderLayer 2 shadV layerCounts
|
||||
renderWindows pdata windowPoints
|
||||
if (_cloud_shadows $ _config w)
|
||||
then do
|
||||
----render transparency depths
|
||||
depthMask $= Enabled
|
||||
blend $= Disabled
|
||||
drawBuffers $= [NoBuffers,FBOColorAttachment 1]
|
||||
renderLayer 2 shadV layerCounts
|
||||
renderWindows pdata windowPoints
|
||||
----draw lightmap for cloud buffer
|
||||
depthMask $= Disabled
|
||||
blend $= Enabled
|
||||
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
|
||||
createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
|
||||
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
||||
clearColor $= Color4 0 0 0 0
|
||||
else return ()
|
||||
when (_cloud_shadows $ _config w) $ do
|
||||
----render transparency depths
|
||||
depthMask $= Enabled
|
||||
blend $= Disabled
|
||||
drawBuffers $= [NoBuffers,FBOColorAttachment 1]
|
||||
renderLayer 2 shadV layerCounts
|
||||
renderWindows pdata windowPoints
|
||||
----draw lightmap for cloud buffer
|
||||
depthMask $= Disabled
|
||||
blend $= Enabled
|
||||
bindFramebuffer Framebuffer $= fst (_fboLighting pdata)
|
||||
createLightMap pdata lightPoints nWalls nSils nCaps (snd $ snd $ _fboCloud pdata)
|
||||
colorMask $= Color4 Enabled Enabled Enabled Enabled
|
||||
clearColor $= Color4 0 0 0 0
|
||||
--apply lightmap to cloud buffer
|
||||
clearColor $= Color4 0 0 0 0
|
||||
bindFramebuffer Framebuffer $= fst (_fboCloud pdata)
|
||||
|
||||
@@ -5,56 +5,41 @@ module Dodge.Render.MenuScreen
|
||||
( menuScreen
|
||||
)
|
||||
where
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Data
|
||||
--import Dodge.Config.Update
|
||||
--import Dodge.Config.Data
|
||||
import Dodge.Base.Window
|
||||
import Picture
|
||||
import Geometry
|
||||
import Dodge.Menu
|
||||
--import Geometry.Data
|
||||
|
||||
menuScreen
|
||||
:: World
|
||||
-> [MenuLayer]
|
||||
-> ScreenLayer
|
||||
-> Picture
|
||||
menuScreen w mLays = case mLays of
|
||||
(LevelMenu x:_) -> optionsFromList w ("LEVEL"++show x) levelMenuOptions
|
||||
(PauseMenu : _) -> optionsFromList w "PAUSED" pauseMenuOptions
|
||||
(GameOverMenu : _) -> optionsFromList w "GAME OVER" pauseMenuOptions
|
||||
(OptionMenu : _) -> optionsFromList w "OPTIONS" optionsOptions
|
||||
(SoundOptionMenu : _) -> optionsFromList w "OPTIONS:VOLUME" soundMenuOptions
|
||||
(GraphicsOptionMenu : _) -> optionsFromList w "OPTIONS:GRAPHICS" graphicsMenuOptions
|
||||
(ControlList : _) -> pictures
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,tst (-100) 100 0.4 "CONTROLS"
|
||||
,controlsList
|
||||
]
|
||||
(WaitMessage s _ : _) -> optionsList hw hh s []
|
||||
(Terminal s : _) -> optionsList hw hh "SCANCODE INPUT" ['>':s ++ "_"]
|
||||
(TerminalMessage t xs : _) -> displayStringList hw hh $ map snd $ filter (( > t) . fst) xs
|
||||
_ -> blank
|
||||
where
|
||||
tst x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
hh = halfHeight w
|
||||
hw = halfWidth w
|
||||
menuScreen w screen = case screen of
|
||||
OptionScreen {_scTitle = titf, _scOptions = mos}
|
||||
-> drawOptions w (titf w) mos
|
||||
(WaitScreen sf _) -> drawOptions w (sf w) []
|
||||
(InputScreen s) -> drawOptions w ('>':s) []
|
||||
(TerminalScreen t xs ) -> displayStringList w $ map snd $ filter (( > t) . fst) xs
|
||||
(DisplayScreen sd ) -> sd w
|
||||
|
||||
displayStringList :: Float -> Float -> [String] -> Picture
|
||||
displayStringList hw hh ss = pictures
|
||||
( polygon (rectNSEW hh (-hh) hw (-hw))
|
||||
displayStringList :: World -> [String] -> Picture
|
||||
displayStringList w ss = pictures
|
||||
( polygon (screenBox w)
|
||||
: zipWith f ys ss
|
||||
)
|
||||
where
|
||||
hw = halfWidth w
|
||||
ys = [0,22..]
|
||||
f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
|
||||
|
||||
optionsFromList
|
||||
drawOptions
|
||||
:: World
|
||||
-> String -- ^ Title
|
||||
-> String -- ^ Title
|
||||
-> [MenuOption] -- ^ Options
|
||||
-> Picture
|
||||
optionsFromList w title ops = pictures $
|
||||
drawOptions w title ops = pictures $
|
||||
[darkenBackground
|
||||
,theTitle]
|
||||
++
|
||||
@@ -64,59 +49,17 @@ optionsFromList w title ops = pictures $
|
||||
notInvisible InvisibleToggle {} = False
|
||||
notInvisible _ = True
|
||||
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox w
|
||||
theTitle = placeString (-hw + 30) (hh - 50) 0.4 title
|
||||
hh = halfHeight w
|
||||
hw = halfWidth w
|
||||
|
||||
menuOptionToString :: World -> MenuOption -> String
|
||||
menuOptionToString w mo@(Toggle{})
|
||||
= (scodeToChar $ _moKey mo) : ':' : _moString mo w
|
||||
menuOptionToString w mo@(Toggle2{})
|
||||
= (scodeToChar $ _moKey1 mo) : '/' : (scodeToChar $ _moKey2 mo) : ':' : _moString mo w
|
||||
menuOptionToString _ _ = "undefined option string"
|
||||
|
||||
|
||||
optionsList
|
||||
:: Float -- ^ Half screen width
|
||||
-> Float -- ^ Half screen height
|
||||
-> String -- ^ Title
|
||||
-> [String] -- ^ Options
|
||||
-> Picture
|
||||
optionsList hw hh tit ops = pictures $
|
||||
[color (withAlpha 0.5 black) $ polygon $ screenBox hw hh
|
||||
,placeString (-hw + 30) (hh - 50) 0.4 tit]
|
||||
++
|
||||
zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) ops [hh-100,hh-150 ..]
|
||||
menuOptionToString w mo = theKeys ++ _moString mo w
|
||||
where
|
||||
placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
|
||||
|
||||
controlsList :: Picture
|
||||
controlsList = pictures $ concat $ zipWith butAndEff
|
||||
[("wasd", "movement")
|
||||
,("[rmb]", "aim")
|
||||
,("[rmb+lmb]", "shoot or use item")
|
||||
,("[wheelscroll]" , "select item" )
|
||||
,("[space]" , "pickup item" )
|
||||
,("m" , "display map" )
|
||||
,("f" , "drop item" )
|
||||
,("c[esc]" , "pause" )
|
||||
,("qe" , "rotate camera")
|
||||
]
|
||||
[60,30..]
|
||||
where
|
||||
butAndEff (btext,etext) y =
|
||||
[translate (-250) y $ scale 0.15 0.15 $ color white $ text btext
|
||||
,translate 0 y $ scale 0.15 0.15 $ color white $ text etext
|
||||
]
|
||||
|
||||
screenBox
|
||||
:: Float -- ^ Half screen width
|
||||
-> Float -- ^ Half screen height
|
||||
-> [Point2]
|
||||
screenBox halfW halfH = map toV2
|
||||
[ (halfW, halfH)
|
||||
, (-halfW, halfH)
|
||||
, (-halfW,-halfH)
|
||||
, ( halfW,-halfH)
|
||||
]
|
||||
|
||||
theKeys :: String
|
||||
theKeys = case mo of
|
||||
Toggle {_moKey = k} -> stc k : ":"
|
||||
Toggle2 {_moKey1 = k1, _moKey2 = k2} -> stc k1 : '/' : stc k2 : ":"
|
||||
_ -> undefined
|
||||
stc = scodeToChar
|
||||
|
||||
+11
-14
@@ -1,4 +1,4 @@
|
||||
{-# LANGUAGE TupleSections #-}
|
||||
--{-# LANGUAGE TupleSections #-}
|
||||
module Dodge.Render.Picture
|
||||
where
|
||||
import Dodge.Data
|
||||
@@ -8,29 +8,21 @@ import Dodge.Base.Zone
|
||||
import Dodge.Picture
|
||||
import Dodge.Picture.Layer
|
||||
import Dodge.Render.HUD
|
||||
--import Dodge.Render.List
|
||||
import Dodge.Render.MenuScreen
|
||||
--import Dodge.GameRoom
|
||||
--import Dodge.Debug
|
||||
import Geometry
|
||||
--import Geometry.Zone
|
||||
--import Geometry.Data
|
||||
import Picture
|
||||
import Polyhedra.Data
|
||||
|
||||
--import Dodge.Creature.YourControl
|
||||
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import Data.List (partition)
|
||||
import qualified Data.IntMap.Lazy as IM
|
||||
--import qualified Data.Vector.Fusion.Stream.Monadic as VS
|
||||
|
||||
worldPictures :: World -> Picture
|
||||
worldPictures w = pictures
|
||||
[pictures (_decorations w)
|
||||
,concatMapPic (dbArg _pjDraw) $ _projectiles w
|
||||
,concatMapPic (crDraw w) $ _creatures w
|
||||
,concatMapPic (crDraw w) . IM.filter crIsClose $ _creatures w
|
||||
,concatMapPic (dbArg _ptDraw) $ _particles w
|
||||
,testPic w
|
||||
,concatMapPic drawItem $ _floorItems w
|
||||
@@ -40,6 +32,10 @@ worldPictures w = pictures
|
||||
,concatMapPic btDraw $ _buttons w
|
||||
,concatMapPic drawWallFloor $ wallFloorsToDraw w
|
||||
]
|
||||
where
|
||||
crIsClose cr = dist (_crPos cr) camCen < winSize
|
||||
winSize = 30 + max (getWindowX w) (getWindowY w)
|
||||
camCen = _cameraCenter w
|
||||
|
||||
foregroundPics :: World -> [Polyhedra]
|
||||
foregroundPics = _foregroundDecorations
|
||||
@@ -50,7 +46,7 @@ fixedCoordPictures w = case _menuLayers w of
|
||||
[ hudDrawings w
|
||||
, customMouseCursor w
|
||||
]
|
||||
lays -> scaler . onLayer MenuDepth $ menuScreen w lays
|
||||
(lay:_) -> scaler . onLayer MenuDepth $ menuScreen w lay
|
||||
where
|
||||
scaler = setDepth (-1) . scale (2 / getWindowX w) (2 / getWindowY w)
|
||||
|
||||
@@ -121,9 +117,10 @@ outsideScreenPolygon w = [tr,tl,bl,br]
|
||||
bl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) (- (3* halfHeight w))
|
||||
|
||||
wallShadowsToDraw :: World -> [Wall]
|
||||
wallShadowsToDraw w = filter (fromMaybe True . (^? blVisible))
|
||||
. IM.elems
|
||||
$ wallsNearZones (zoneOfSight w) w
|
||||
wallShadowsToDraw w
|
||||
= filter (fromMaybe True . (^? blVisible))
|
||||
. IM.elems
|
||||
$ wallsNearZones (zoneOfSight w) w
|
||||
|
||||
-- cannot only test if walls are on screen, but also if they are on the cone
|
||||
-- towards the center of sight
|
||||
|
||||
+6
-6
@@ -6,7 +6,7 @@ module Dodge.Update
|
||||
( update
|
||||
) where
|
||||
import Dodge.Data
|
||||
import Dodge.Data.Menu
|
||||
import Dodge.Menu
|
||||
import Dodge.World.Trigger.Data
|
||||
--import Dodge.Config.Data
|
||||
import Dodge.Base
|
||||
@@ -45,11 +45,11 @@ pushSideEffects w = w
|
||||
For most menus the only way to change the world is using event handling. -}
|
||||
functionalUpdate :: World -> World
|
||||
functionalUpdate w = case _menuLayers w of
|
||||
(TerminalMessage t xs:mls) -> w & menuLayers .~ (TerminalMessage (max (t-1) 0) xs:mls)
|
||||
(WaitMessage s i: _)
|
||||
(TerminalScreen t xs:mls) -> w & menuLayers .~ (TerminalScreen (max (t-1) 0) xs:mls)
|
||||
(WaitScreen s i : _)
|
||||
| i < 1 -> w & dbArg _worldEvents
|
||||
| otherwise -> w & menuLayers %~ ( (WaitMessage s (i-1) :) . tail )
|
||||
(GameOverMenu : _) -> updateParticles
|
||||
| otherwise -> w & menuLayers %~ ( (WaitScreen s (i-1) :) . tail )
|
||||
(OptionScreen {_scOptionFlag = GameOverOptions} : _) -> updateParticles
|
||||
. updateProjectiles
|
||||
. updateLightSources
|
||||
. updateClouds
|
||||
@@ -164,7 +164,7 @@ updateSeenWalls w = foldl' (flip markSeen) w wallsToUpdate
|
||||
|
||||
checkEndGame :: World -> World
|
||||
checkEndGame w
|
||||
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [GameOverMenu]}
|
||||
| _crHP (you w) < 1 = haltSound $ w {_menuLayers = [gameOverMenu]}
|
||||
| otherwise = w
|
||||
|
||||
--updateClouds :: World -> World
|
||||
|
||||
Reference in New Issue
Block a user