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

Implement terminals

Browse Source
This commit is contained in:
justin
2022-03-14 20:39:23 +00:00
parent 1b6f11709c
commit f16f32d9d3
30 changed files with 313 additions and 119 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Base.hs
+5 -4
View File
@@ -428,9 +428,9 @@ coordinates. -}
cartePosToScreen :: Configuration -> World -> Point2 -> Point2
cartePosToScreen cfig w = doWindowScale cfig . doRotate . doZoom . doTranslate
where
doTranslate p = p -.- _carteCenter w
doZoom p = _carteZoom w *.* p
doRotate p = rotateV (negate $ _carteRot w) p
doTranslate p = p -.- _carteCenter (_hud w)
doZoom p = _carteZoom (_hud w) *.* p
doRotate p = rotateV (negate $ _carteRot (_hud w)) p
crToMousePosOffset :: Creature -> World -> (Point2,Float)
crToMousePosOffset cr w = (mouseWorldPos w -.- _crPos cr,0)
{- | The mouse position in world coordinates. -}
@@ -438,7 +438,8 @@ mouseWorldPos :: World -> Point2
mouseWorldPos w = _cameraCenter w +.+ (1/_cameraZoom w) *.* rotateV (_cameraRot w) (_mousePos w)
{- | The mouse position in map coordinates -}
mouseCartePos :: World -> Point2
mouseCartePos w = _carteCenter w +.+ (1/_carteZoom w) *.* rotateV (_carteRot w) (_mousePos w)
mouseCartePos w = _carteCenter (_hud w) +.+ (1/_carteZoom (_hud w))
*.* rotateV (_carteRot (_hud w)) (_mousePos w)
{- | Create a logistic function given three parameters. -}
logistic :: Float -> Float -> Float -> (Float -> Float)
logistic x0 l k x = l / (1 + exp (k*(x0 - x)))
src/Dodge/Base/Collide.hs
+7
View File
@@ -2,6 +2,7 @@
{- | Basic collision detection for a moving point -}
module Dodge.Base.Collide
( hasLOS
, hasButtonLOS
, reflectPointWalls
, ssfold
, collidePointUpToIndirectMinDist
@@ -25,6 +26,12 @@ hasLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasLOS #-}
hasLOS p1 p2 = not . pointHitsWalls p1 p2 . wallsAlongLine p1 p2
hasButtonLOS :: Point2 -> Point2 -> World -> Bool
{-# INLINE hasButtonLOS #-}
hasButtonLOS p1 p2 = not . pointHitsWalls p1 p2
. IM.filter (not . _wlTouchThrough)
. wallsAlongLine p1 p2
--hitPointLines
-- :: Point2
-- -> Point2
src/Dodge/Combine.hs
+3 -3
View File
@@ -104,12 +104,12 @@ combineModules = mergeA
h _ im _ = ([],im)
toggleCombineInv :: World -> World
toggleCombineInv w = case _inventoryMode w of
CombineInventory _ -> w & inventoryMode .~ TopInventory
toggleCombineInv w = case _hudElement (_hud w) of
DisplayInventory CombineInventory {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & enterCombineInv
enterCombineInv :: World -> World
enterCombineInv w = w & inventoryMode .~ CombineInventory mi
enterCombineInv w = w & hud . hudElement .~ DisplayInventory (CombineInventory mi)
where
mi = 0 <$ listToMaybe (combineItemListYou w)
src/Dodge/Combine/Combinations.hs
+2 -2
View File
@@ -59,13 +59,13 @@ itemCombinations =
, p [p 2 TUBE,o LAUNCHER] (launcherX 2)
] ++ [ p [p 2 TUBE,o $ LAUNCHERX i] (launcherX (i+1)) | i <- [2..9]]
++
[ po [LIGHTER,PIPE,CAN] flameStick
[ po [LIGHTER,PUMP,CAN] flameStick
, po [FLAMESTICK,CAN,PUMP] blowTorch
, po [FLAMESTICK,DRUM] flameThrower
, po [FLAMETHROWER,DRUM] flameWall
, po [FLAMETHROWER,PUMP] flameTorrent
, p [o PRISM,p 2 PIPE,o HARDWARE] lasGun
, p [o PRISM,o TRANSFORMER,o PIPE] lasGun
, p [o TRANSFORMER,p 2 CAN] sparkGun
, p [o SPARKGUN,p 2 PIPE] teslaGun
src/Dodge/Data.hs
+35 -15
View File
@@ -110,17 +110,13 @@ data World = World
, _pathGraph :: ~(Gr Point2 Float)
, _pathGraphP :: ~[(Point2,Point2)]
, _pathPoints :: ~(IM.IntMap (IM.IntMap [(Int,Point2)]))
, _carteDisplay :: Bool
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
, _hud :: HUD
, _lightSources :: IM.IntMap LightSource
, _tempLightSources :: [TempLightSource]
, _closeObjects :: [Either FloorItem Button]
, _seenLocations :: IM.IntMap (World -> Point2,String)
, _selLocation :: Int
, _sideEffects :: Universe -> IO Universe
, _inventoryMode :: InventoryMode
, _distortions :: [Distortion]
, _worldBounds :: Bounds
, _gameRooms :: [GameRoom] -- consider using an IntMap
@@ -129,10 +125,30 @@ data World = World
, _timeFlow :: TimeFlowStatus
, _worldClock :: Int
, _youHammerPosition :: HammerPosition
, _worldTerminal :: Maybe' WorldTerminal
}
data WorldTerminal = WorldTerminal Int [(Int,String)]
data HUDElement = DisplayInventory {_subInventory :: SubInventory}
| DisplayCarte
deriving (Eq,Ord,Show)
data SubInventory
= NoSubInventory
| TweakInventory
| CombineInventory {_combineInvSel :: Maybe Int}
| InspectInventory
| LockedInventory
| DisplayTerminal
{_termParams :: TerminalParams
,_termID :: Int
}
deriving (Eq,Ord,Show)
data HUD = HUD
{ _hudElement :: HUDElement
, _carteCenter :: Point2
, _carteZoom :: Float
, _carteRot :: Float
}
data TimeFlowStatus
= RewindingNow
| RewindingLastFrame
@@ -183,13 +199,6 @@ data MenuOption
{ _moKey :: Scancode
, _moEff :: Universe -> IO (Maybe Universe)
}
data InventoryMode
= TopInventory
| TweakInventory
| CombineInventory {_combineInvSel :: Maybe Int}
| InspectInventory
| LockedInventory
deriving (Eq, Ord, Show)
data CrGroupParams = CrGroupParams
{ _crGroupParamID :: Int
, _crGroupIDs :: IS.IntSet
@@ -306,7 +315,14 @@ data Button = Button
, _btID :: Int
, _btText :: String
, _btState :: ButtonState
, _btTerminalParams :: TerminalParams
}
data TerminalParams = NoTerminalParams | TerminalParams
{ _termDisplayedLines :: [(String,Color)]
, _termFutureLines :: [(Int,(String,Color))]
, _termMaxLines :: Int
}
deriving (Eq,Ord,Show)
data ButtonState = BtOn | BtOff | BtNoLabel
deriving (Eq, Show)
data PressPlate = PressPlate
@@ -754,6 +770,7 @@ data Wall = Wall
, _wlOpacity :: Opacity
, _wlPathable :: Bool
, _wlWalkable :: Bool
, _wlTouchThrough :: Bool
, _wlFireThrough :: Bool
, _wlReflect :: Bool
, _wlDraw :: Bool
@@ -981,7 +998,6 @@ makeLenses ''LSParam
makeLenses ''ItemParams
makeLenses ''ItemTweaks
makeLenses ''Maybe'
makeLenses ''InventoryMode
makeLenses ''ItemPortage
makeLenses ''Magnet
makeLenses ''Gust
@@ -989,3 +1005,7 @@ makeLenses ''GunBarrels
makeLenses ''ItemModule
makeLenses ''Targeting
makeLenses ''Nozzle
makeLenses ''HUD
makeLenses ''HUDElement
makeLenses ''SubInventory
makeLenses ''TerminalParams
src/Dodge/Default.hs
+1
View File
@@ -260,6 +260,7 @@ defaultButton = Button
, _btID = 0
, _btText = "Button"
, _btState = BtOff
, _btTerminalParams = NoTerminalParams
}
defaultPT :: Prop
defaultPT = Projectile
src/Dodge/Default/Wall.hs
+1
View File
@@ -13,6 +13,7 @@ defaultWall = Wall
, _wlOpacity = Opaque
, _wlPathable = False
, _wlFireThrough = False
, _wlTouchThrough = False
, _wlReflect = False
, _wlDraw = True
, _wlRotateTo = True
src/Dodge/Default/World.hs
+6 -6
View File
@@ -65,10 +65,12 @@ defaultWorld = World
, _pathGraph = Data.Graph.Inductive.Graph.empty
, _pathGraphP = []
, _pathPoints = IM.empty
, _carteDisplay = False
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
, _hud = HUD
{ _hudElement = DisplayInventory NoSubInventory
, _carteCenter = V2 0 0
, _carteZoom = 0.5
, _carteRot = 0
}
, _lightSources = IM.empty
, _tempLightSources = [youLight]
, _closeObjects = []
@@ -80,7 +82,6 @@ defaultWorld = World
--, _keyConfig = defaultKeyConfigSDL
-- , _config = defaultConfig
, _sideEffects = return
, _inventoryMode = TopInventory
, _foregroundShape = mempty
, _distortions = []
, _gameRooms = []
@@ -90,7 +91,6 @@ defaultWorld = World
, _rewindWorlds = []
, _timeFlow = NormalTimeFlow
, _youHammerPosition = HammerUp
, _worldTerminal = Nothing'
}
youLight :: TempLightSource
youLight =
src/Dodge/Event.hs
+13 -11
View File
@@ -89,10 +89,12 @@ handleResizeEvent sev u = return . Just $ u
handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
handlePressedMouseButton but w
| but == ButtonMiddle || _carteDisplay (_uvWorld w)
| but == ButtonMiddle || _hudElement (_hud $ _uvWorld w) == DisplayCarte
= Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
| but == ButtonLeft = case _inventoryMode (_uvWorld w) of
CombineInventory mi -> Just $ fromMaybe (w & uvWorld . inventoryMode .~ TopInventory) $ do -- ugly
| but == ButtonLeft = case _hudElement (_hud $ _uvWorld w) of
DisplayInventory (CombineInventory mi)
-> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory)
$ do -- ugly
i <- mi
return $ over uvWorld (doCombine i) w
_ -> Just w
@@ -117,11 +119,11 @@ handleMouseWheelEvent mwev w = case _menuLayers w of
_ -> Just w
wheelEvent :: Float -> World -> World
wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
(True, _)
| rbDown -> w & carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
wheelEvent y w = case _hudElement $ _hud w of
DisplayCarte
| rbDown -> w & hud . carteZoom %~ min 0.75 . max 0.05 . ((1+y*0.1) * )
| otherwise -> w & selLocation %~ (`mod` numLocs) . (+ yi)
(_, TopInventory)
DisplayInventory NoSubInventory
-- functions that modify the inventory should be centralised so that
-- this lock can be sensibly applied, perhaps
| _crInvLock (_creatures w IM.! _yourID w) -> w
@@ -131,14 +133,14 @@ wheelEvent y w = case (_carteDisplay w, _inventoryMode w) of
| lbDown -> w & cameraZoom +~ y
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeSwapInvSel yi w
| otherwise -> stopSoundFrom (CrReloadSound 0) $ changeAugInvSel yi w
(_, TweakInventory)
DisplayInventory TweakInventory
| invKeyDown && rbDown -> w & moveTweakSel yi
| invKeyDown -> stopSoundFrom (CrReloadSound 0) $ changeInvSel yi w
| rbDown -> w & changeTweakParam yi
| otherwise -> w & moveTweakSel yi
(_, CombineInventory _) -> w
& inventoryMode . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
(_, _) -> w
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
_ -> w
where
numcombs = length $ combineItemListYou w
yi = round $ signum y
src/Dodge/Event/Keyboard.hs
+18 -13
View File
@@ -50,14 +50,14 @@ handlePressedKeyInGame scode w = case scode of
ScancodeM -> Just $ toggleMap w
ScancodeR -> Just $ fromMaybe w $ startReloadingWeapon (you w) w
ScancodeT -> Just $ testEvent w
ScancodeX -> Just $ w & inventoryMode %~ toggleInv TweakInventory
ScancodeX -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory TweakInventory)
ScancodeC -> Just $ toggleCombineInv w
ScancodeI -> Just $ w & inventoryMode %~ toggleInv InspectInventory
ScancodeI -> Just $ w & hud . hudElement %~ toggleInv (DisplayInventory InspectInventory)
_ -> Just w
toggleInv :: InventoryMode -> InventoryMode -> InventoryMode
toggleInv :: HUDElement -> HUDElement -> HUDElement
toggleInv x y
| x == y = TopInventory
| x == y = DisplayInventory NoSubInventory
| otherwise = x
gotoTerminal :: Universe -> Universe
@@ -66,13 +66,14 @@ gotoTerminal w = case _menuLayers w of
_ -> w & menuLayers %~ (InputScreen [] :)
spaceAction :: World -> World
spaceAction w = if _carteDisplay w
then w & carteCenter .~ theLoc
else case (_inventoryMode w, selectedCloseObject w) of
(TopInventory,Just (_,Left flit)) -> pickUpItem 0 flit w
--(TopInventory,(Just (_,Right but))) -> updateTopCloseObject (_btID but) $ _btEvent but but w
(TopInventory,Just (_,Right but)) -> _btEvent but but w
_ -> w & inventoryMode .~ TopInventory
spaceAction w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . carteCenter .~ theLoc
DisplayInventory NoSubInventory -> case selectedCloseObject w of
Just (_,Left flit) -> pickUpItem 0 flit w
Just (_,Right but) -> _btEvent but but w
_ -> w
DisplayInventory DisplayTerminal {} -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayInventory NoSubInventory
where
theLoc = fst (_seenLocations w IM.! _selLocation w) w
-- updateTopCloseObject i w' = w' & closeObjects %~ ( Right (_buttons w' IM.! i) : ) . tail
@@ -81,6 +82,10 @@ pauseGame :: World -> World
pauseGame w = w & sideEffects %~ (. (menuLayers .~ [pauseMenu]))
toggleMap :: World -> World
toggleMap w = w & carteDisplay %~ not
toggleMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w & hud . hudElement .~ DisplayCarte
escapeMap :: World -> World
escapeMap w = w & carteDisplay .~ False
escapeMap w = case _hudElement $ _hud w of
DisplayCarte -> w & hud . hudElement .~ DisplayInventory NoSubInventory
_ -> w
src/Dodge/Floor.hs
+2 -2
View File
@@ -8,7 +8,7 @@ module Dodge.Floor
import Dodge.LockAndKey
--import Dodge.Creature.State.Data
import Dodge.Room
import Dodge.Data.DamageType
--import Dodge.Data.DamageType
--import Dodge.Placement.Instance.Button
import Dodge.Tree
import Dodge.Annotation
@@ -36,7 +36,7 @@ import System.Random
initialAnoTree :: RandomGen g => Tree [Annotation g]
initialAnoTree = padSucWithCorridors $ treeFromTrunk
[[AnoApplyInt 0 startRoom]
, [SpecificRoom $ sensorRoom Flaming 50]
-- , [SpecificRoom $ sensorRoom Flaming 50]
, [PassthroughLockKeyLists 2 lockRoomKeyItems itemRooms]
, [SpecificRoom randomChallenges]
, [AnoApplyInt 1 lasSensorTurretTest]
src/Dodge/Inventory.hs
+31 -3
View File
@@ -12,6 +12,7 @@ module Dodge.Inventory
, augmentedInvSizes
, rmInvItem
, updateCloseObjects
, updateTerminal
, closeObjScrollDir
, closeObjectCol
-- , swapInvDir
@@ -33,15 +34,15 @@ import Dodge.Base.Collide
import Geometry
--import FoldableHelp
import Padding
import Color
import qualified IntMapHelp as IM
import ListHelp
import Color
import LensHelp
import qualified Data.IntSet as IS
import Data.Maybe
--import Data.List
--import System.Random
import Control.Lens
-- | after this the item at the inventory position will no longer exist
rmInvItem :: Int -- ^ Creature id
@@ -120,6 +121,33 @@ invSelPos w = splitgap + (foldl' (+) 0 . fst $ IM.split invsel (augmentedInvSize
| yourInvSel w < length (yourInv w) = 0
| otherwise = 1
updateTerminal :: World -> World
updateTerminal w = case _hudElement $ _hud w of
DisplayInventory dt@DisplayTerminal{} -> w & hud . hudElement %~ updateDisplayTerminal dt w
_ -> w
updateDisplayTerminal :: SubInventory -> World -> HUDElement -> HUDElement
updateDisplayTerminal sub w inv
| closetest == Just True = inv & subInventory %~ tickDisplayTerminal
| otherwise = DisplayInventory NoSubInventory
where
closetest = do
btpos <- w ^? buttons . ix (_termID sub) . btPos
return $ dist btpos (_crPos $ you w) < 40
tickDisplayTerminal :: SubInventory -> SubInventory
tickDisplayTerminal dt = case dt of
DisplayTerminal{} -> dt & termParams . termDisplayedLines .++~ maybeToList ml
& termParams . termFutureLines .~ newtfl
where
tfl = _termFutureLines $ _termParams dt
(ml,newtfl) = tickFutureLines tfl
tickFutureLines ((0,sc):xs) = (Just sc,xs)
tickFutureLines ((i,sc):xs) = (Nothing,(i-1,sc):xs)
tickFutureLines [] = (Nothing,[])
_ -> dt
-- this looks ugly...
updateCloseObjects :: World -> World
updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered currentClose
@@ -128,7 +156,7 @@ updateCloseObjects w = w & closeObjects .~ unionBy closeObjEq oldCloseFiltered c
updateinvsel curinvsel
| length (augmentedInvSizes w) <= curinvsel = max 0 $ length (augmentedInvSizes w) - 1
| otherwise = curinvsel
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasLOS ypos (closeObjPos obj) w
filt = filter $ \obj -> dist ypos (closeObjPos obj) < 40 && hasButtonLOS ypos (closeObjPos obj) w
ypos = _crPos $ you w
activeButtons = map Right
. filter ( (/=) BtNoLabel . _btState)
src/Dodge/Inventory/CloseObject.hs
-1
View File
@@ -2,7 +2,6 @@ module Dodge.Inventory.CloseObject where
import Dodge.Data
import Geometry
closeObjPos :: Either FloorItem Button -> Point2
closeObjPos e = case e of
Right x -> _btPos x
src/Dodge/LevelGen/Data.hs
+6 -2
View File
@@ -20,7 +20,7 @@ import qualified Data.IntMap.Strict as IM
data PSType = PutCrit {_unPutCrit :: Creature}
| PutMachine { _putMachineColor :: Color, _putMachinePoly :: [Point2], _unPutMachine :: Machine }
| PutLS LightSource
| PutButton Button
| PutButton {_pstPutButton :: Button}
| PutProp Prop
| PutFlIt Item
| PutPPlate PressPlate
@@ -52,6 +52,7 @@ data PlacementSpot
{ _psRoomRandPointNum :: Int
, _psRandShift :: (Point2,Float) -> PlacementSpot
}
-- TODO attempt to unify/simplify this union type
data Placement
= Placement
{ _plSpot :: PlacementSpot
@@ -59,7 +60,10 @@ data Placement
, _plMID :: Maybe Int
, _plIDCont :: Placement -> Maybe Placement
}
| PlacementGenUpdate (GenParams -> Placement -> (GenParams, Placement)) Placement
| PlacementGenUpdate
{_plGenUpdate :: (GenParams -> Placement -> (GenParams, Placement))
,_plGenPL :: Placement
}
| PlacementUsingPos Point3 (Point3 -> Placement) -- allows a placement to use a shifted position
| RandomPlacement {_unRandomPlacement :: State StdGen Placement}
| PickOnePlacement Int Placement
src/Dodge/LevelGen/Switch.hs
+3
View File
@@ -28,6 +28,7 @@ makeButton col eff = Button
, _btID = 0
, _btText = "Button"
, _btState = BtOff
, _btTerminalParams = NoTerminalParams
}
where
turnOn bt = bt {_btState = BtNoLabel, _btEvent = const id}
@@ -68,6 +69,7 @@ makeSwitchSPic dswitch effOn effOff = Button
, _btID = 0
, _btText = "SWITCH/"
, _btState = BtOff
, _btTerminalParams = NoTerminalParams
}
where
flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w
@@ -102,6 +104,7 @@ makeSwitch col1 col2 effOn effOff = Button
, _btID = 0
, _btText = "SWITCH/"
, _btState = BtOff
, _btTerminalParams = NoTerminalParams
}
where
flipSwitch b w = switchEffect b . soundFromGeneral (LeverSound 0) (bpos b) click1S Nothing $ w
src/Dodge/LockAndKey.hs
+13 -6
View File
@@ -14,11 +14,14 @@ import Control.Monad.State
lockRoomKeyItems :: RandomGen g => [ (Int -> State g (SubCompTree Room) , State g CombineType ) ]
lockRoomKeyItems =
[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
,(const slowDoorRoomRunPast, return MINIGUN)
,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
,(const glassLessonRunPast, takeOne [LASGUN])
,(const $ lasTunnelRunPast 400, return FLATSHIELD)
--[(lasCenSensEdge, takeOne [LAUNCHER,LASGUN,SPARKGUN,FLATSHIELD] )
--,(sensorRoomRunPast Electrical, return SPARKGUN )
[(sensorRoomRunPast Flaming, return FLAMESTICK )
-- ,(sensorRoomRunPast Lasering, return LASGUN )
-- ,(const slowDoorRoomRunPast, return MINIGUN)
-- ,(const longRoomRunPast, takeOne [SNIPERRIFLE,FLATSHIELD])
-- ,(const glassLessonRunPast, takeOne [LASGUN])
-- ,(const $ lasTunnelRunPast 400, return FLATSHIELD)
]
itemRooms :: RandomGen g => [(CombineType, State g (SubCompTree Room))]
@@ -30,13 +33,17 @@ itemRooms =
)
, (MINIGUN , join $ takeOne [roomMiniIntro, minigunFakeout] )
, (LASGUN , join $ takeOne
[rc $ map makeTypeCraft [PRISM,PIPE,PIPE,HARDWARE]
[rc $ map makeTypeCraft [PRISM,TRANSFORMER,PIPE]
]
)
, (SPARKGUN , join $ takeOne
[rc $ map makeTypeCraft [TRANSFORMER,CAN,CAN]
]
)
, (FLAMESTICK , join $ takeOne
[rc $ map makeTypeCraft [LIGHTER,PUMP,CAN]
]
)
, (FLATSHIELD , join $ takeOne
[rc $ map makeTypeCraft [PLATE,PLATE]
,rc $ map makeTypeCraft [DRUM,DRUM,PLATE]
src/Dodge/Placement/Instance/Terminal.hs
+41
View File
@@ -0,0 +1,41 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Placement.Instance.Terminal where
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
import Color
import Geometry
import ShapePicture
import LensHelp
import Shape
import Data.Maybe
putTerminal :: (GenParams -> TerminalParams) -> Placement
putTerminal f = PlacementGenUpdate g $ ps0jPushPS (PutButton $ thebutton)
$ pt0 (PutMachine (dark magenta) (reverse $ square 10) defaultMachine
{ _mcDraw = drawTerminal
, _mcHP = 100
})
$ const Nothing
where
g gp pl = (gp, pl & plType . pstPutButton . btTerminalParams .~ f gp)
thebutton = Button
{ _btPict = const mempty
, _btPos = 0
, _btRot = 0
, _btEvent = displayTerminalMessage . _btID
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10
}
drawTerminal :: Machine -> SPic
drawTerminal _ = noPic $ colorSH (dark green) $ upperPrismPoly 15 $ square 10
displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
{ _termID = btid
, _termParams = fromMaybe NoTerminalParams $ w ^? buttons . ix btid . btTerminalParams
}
src/Dodge/Placement/PlaceSpot.hs
+1
View File
@@ -201,6 +201,7 @@ placeMachineWalls col poly mcid wlid = flip (foldr f) $ zip [wlid..] $ loopPairs
baseWall = defaultMachineWall
& wlColor .~ col
& wlStructure . wlStMachine .~ mcid
& wlTouchThrough .~ True
mvLS :: Point3 -> Float -> LightSource -> LightSource
mvLS (V3 x y z) rot ls = ls & lsParam . lsPos .~ V3 x y z +.+.+ startPos
src/Dodge/PlacementSpot.hs
+24 -16
View File
@@ -8,6 +8,7 @@ module Dodge.PlacementSpot
, anyUnusedSpot
, unusedSpotAwayFromLink
, isUnusedLnk
, isUnusedLnk'
, isInLnk
, unusedSpotNearInLink
, randDirPS
@@ -21,7 +22,7 @@ module Dodge.PlacementSpot
, twoRoomPoss
, isUnusedLinkType
, rprBoolShift
, rpBool
, rprBool
, shiftInBy
, resetPLUse
) where
@@ -47,11 +48,18 @@ randDirPS ps = do
a <- state $ randomR (0,pi*2)
return $ setDirPS a ps
rpBool :: (RoomPos -> Bool) -> PlacementSpot
rpBool t = PSPos (useRoomPosCond t) (const id) Nothing
isUnusedLnk :: RoomPos -> Room -> Bool
isUnusedLnk rp _ = case _rpLinkStatus rp of
UnusedLink {} -> _rpPlacementUse rp == 0
_ -> False
isUnusedLnk' :: RoomPos -> Bool
isUnusedLnk' rp = case _rpLinkStatus rp of
UnusedLink {} -> _rpPlacementUse rp == 0
_ -> False
anyUnusedSpot :: PlacementSpot
anyUnusedSpot = rpBool $ \rp -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
anyUnusedSpot = rprBool $ \rp _ -> _rpLinkStatus rp == NotLink && _rpPlacementUse rp == 0
rprBool :: (RoomPos -> Room -> Bool) -> PlacementSpot
rprBool t = PSPos (useRoomPosRoomCond t) (const id) Nothing
@@ -98,18 +106,18 @@ unusedSpotAwayFromInLink x = rprBool $ \rp r -> _rpLinkStatus rp == NotLink
--twoUnusedLinks :: (PlacementSpot -> PlacementSpot -> Placement) -> Placement
--twoUnusedLinks = twoRoomPoss isUnusedLnk isUnusedLnk
twoRoomPoss :: (RoomPos -> Bool)
-> (RoomPos -> Bool)
twoRoomPoss :: (RoomPos -> Room -> Bool)
-> (RoomPos -> Room -> Bool)
-> (PlacementSpot -> PlacementSpot -> Placement)
-> Placement
twoRoomPoss cond1 cond2 f = Placement (rpBool cond1) PutNothing Nothing
$ \pl1 -> Just $ Placement (rpBool cond2) PutNothing Nothing
twoRoomPoss cond1 cond2 f = Placement (rprBool cond1) PutNothing Nothing
$ \pl1 -> Just $ Placement (rprBool cond2) PutNothing Nothing
$ \pl2 -> Just $ f (_plSpot pl1) (_plSpot pl2)
isUnusedLnk :: RoomPos -> Bool
isUnusedLnk rp = case _rpLinkStatus rp of
UnusedLink {} -> _rpPlacementUse rp == 0
_ -> False
--isUnusedLnk :: RoomPos -> Bool
--isUnusedLnk rp = case _rpLinkStatus rp of
-- UnusedLink {} -> _rpPlacementUse rp == 0
-- _ -> False
isInLnk :: RoomPos -> Bool
isInLnk rp = case _rpLinkStatus rp of
@@ -117,7 +125,7 @@ isInLnk rp = case _rpLinkStatus rp of
_ -> False
useUnusedLnk :: PlacementSpot
useUnusedLnk = rpBool isUnusedLnk
useUnusedLnk = rprBool isUnusedLnk
isUsedLnkUnplaced :: RoomPos -> Bool
isUsedLnkUnplaced rp = case _rpLinkStatus rp of
@@ -125,8 +133,8 @@ isUsedLnkUnplaced rp = case _rpLinkStatus rp of
UsedInLink {} -> _rpPlacementUse rp == 0
_ -> False
useRoomPosCond :: (RoomPos -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosCond f = useRoomPosRoomCond $ \rp _ -> f rp
useRoomPosCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosCond f = useRoomPosRoomCond $ \rp r -> f rp r
useRoomPosRoomCond :: (RoomPos -> Room -> Bool) -> RoomPos -> Room -> Maybe (PlacementSpot,RoomPos)
useRoomPosRoomCond t rp r
@@ -159,7 +167,7 @@ usedRoomLinkPoss r = mapMaybe f $ _rmPos r
_ -> Nothing
atFstLnkOut :: PlacementSpot
atFstLnkOut = rpBool $ \rp -> rp ^? rpLinkStatus . rplsChildNum == Just 0
atFstLnkOut = rprBool $ \rp _ -> rp ^? rpLinkStatus . rplsChildNum == Just 0
atNthLnkOutShiftBy :: Int -> ((Point2,Float) -> (Point2,Float)) -> PlacementSpot
atNthLnkOutShiftBy n = rprBoolShift
src/Dodge/Render/HUD.hs
+12 -8
View File
@@ -28,16 +28,16 @@ import SDL (MouseButton (..))
--import Data.Bifunctor
hudDrawings :: Configuration -> World -> Picture
hudDrawings cfig w = if _carteDisplay w
then drawCarte cfig w
else drawInGameHUD cfig w
hudDrawings cfig w = case _hudElement $ _hud w of
DisplayCarte -> drawCarte cfig w
DisplayInventory subinv -> drawInGameHUD cfig w
<> subInventoryDisplay subinv cfig w
drawInGameHUD :: Configuration -> World -> Picture
drawInGameHUD cfig w = pictures
[ winScale cfig . dShadCol white $ displayHP 0 cfig w
, listTextPicturesAt (halfWidth cfig) 0 cfig $ map text (_testString w w)
, inventoryDisplay cfig w
, subInventoryDisplay cfig w
]
inventoryDisplay :: Configuration -> World -> Picture
@@ -49,7 +49,7 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
++ displayFreeSlots
++ map floorItemsColor (concatMap (closeObjectToTextPictures nfreeslots) (_closeObjects w))
floorItemsColor
| _inventoryMode w == TopInventory = id
| _hudElement (_hud w) == DisplayInventory NoSubInventory = id
| otherwise = color invDimColor
nfreeslots = crNumFreeSlots cr
displayFreeSlots = case nfreeslots of
@@ -57,10 +57,10 @@ inventoryDisplay cfig w = listTextPicturesAt 0 0 cfig invlist
1 -> [color invDimColor . text $ " +1 FREE SLOT"]
x -> [color invDimColor . text $ " +" ++ show x ++ " FREE SLOTS"]
subInventoryDisplay :: Configuration -> World -> Picture
subInventoryDisplay cfig w = case _inventoryMode w of
subInventoryDisplay :: SubInventory -> Configuration -> World -> Picture
subInventoryDisplay subinv cfig w = case subinv of
LockedInventory -> mempty -- topInvCursor col cursPos cfig w
TopInventory -> pictures
NoSubInventory -> pictures
[ selcursor
, closeobjectcursor
, equipcursor
@@ -81,6 +81,10 @@ subInventoryDisplay cfig w = case _inventoryMode w of
, invHead cfig "TWEAK"
, listTextPicturesAt subInvX 60 cfig $ map text (ammoTweakStrings it)
]
DisplayTerminal {_termParams = tp} -> pictures
[ invHead cfig "TERMINAL"
, renderListAt subInvX 60 cfig . reverse $ take (_termMaxLines tp) (_termDisplayedLines tp)
]
CombineInventory mi -> pictures
[ invHead cfig "COMBINE"
, listTextPicturesAt subInvX 60 cfig $ combineListStringPictures w
src/Dodge/Render/List.hs
+1 -1
View File
@@ -61,7 +61,7 @@ listTextPictureAt xoff yoff cfig yint = winScale cfig
hh = halfHeight cfig
renderListAt :: Float -> Float -> Configuration -> [(String,Color)] -> Picture
renderListAt tx ty cfig = listTextPicturesAt tx (negate ty) cfig . map (\(str,col) -> color col $ text str)
renderListAt tx ty cfig = listTextPicturesAt tx ty cfig . map (\(str,col) -> color col $ text str)
-- concatMapPic (winScale cfig) . zipWith (listPairAt tx ty cfig) [0..]
--TODO put the following functions in an appropriate place
src/Dodge/Room/LasTurret.hs
+1 -1
View File
@@ -34,7 +34,7 @@ cenLasTur :: Room
cenLasTur = roomNgon 8 200 & rmPmnts .~
[ putLasTurret 0.02
, heightWallPS (resetPLUse $ rprBoolShift (const . isInLnk) (shiftInBy 100)) 30 covershape
, mntLightLnkCond $ rpBool isInLnk
, mntLightLnkCond $ rprBool $ const . isInLnk
]
where
covershape = rectNSEW 10 (-10) 20 (-20)
src/Dodge/Room/LongDoor.hs
+1 -1
View File
@@ -117,7 +117,7 @@ addButtonSlowDoor x h rm = do
Nothing
getdoorpos drid w = let Just (a,b) = w ^? doors . ix drid . drPos
in (b, argV (a-.-b))
butPosCond = useRoomPosCond $ \rp -> isUnusedLnk rp && yV2 (_rpPos rp) < 0.5 * h
butPosCond = useRoomPosCond $ \rp _ -> isUnusedLnk' rp && yV2 (_rpPos rp) < 0.5 * h
--butPosCond _ = True -- y < h
col = dim $ light red
cond' btid w = w ^? buttons . ix btid . btState /= Just BtOff
src/Dodge/Room/Procedural.hs
+9 -5
View File
@@ -51,6 +51,7 @@ roomRect
roomRect x y xn yn = defaultRoom
{ _rmPolys = [rectNSWE y 0 0 x ]
, _rmLinks = lnks
, _rmName = "rect"
, _rmPath = concatMap doublePair pth
, _rmPos = map (roomposat RoomPosOnPath) posps
++ map (roomposat RoomPosOffPath) interposps
@@ -77,7 +78,7 @@ roomRect x y xn yn = defaultRoom
++ m East FromSouth FromNorth elnks
++ m West FromSouth FromNorth wlnks
++ m South FromWest FromEast slnks
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd' (OnEdge edge) edgefrom1 edgefrom2) [0..]
m edge edgefrom1 edgefrom2 = zipWith (lnkBothAnd (OnEdge edge) edgefrom1 edgefrom2) [0..]
. zipCountDown
pth = linksAndPath' lnks $ map (bimap (+.+ V2 20 20) (+.+ V2 20 20)) (makeGrid xd xn yd yn)
posps = map (+.+ V2 20 20) $ gridPoints xd (xn+1) yd (yn+1)
@@ -86,10 +87,10 @@ roomRect x y xn yn = defaultRoom
zipCountDown :: [a] -> [(Int,a)]
zipCountDown xs = zip [length xs - 1, length xs - 2 ..] xs
lnkBothAnd' :: RoomLinkType -> (Int -> RoomLinkType)
lnkBothAnd :: RoomLinkType -> (Int -> RoomLinkType)
-> (Int -> RoomLinkType)
-> Int -> (Int,(Point2,Float)) -> RoomLink
lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
lnkBothAnd rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
{_rlType = S.fromList [OutLink,InLink,rlt,ltcon i,ltcon2 j]
,_rlPos = p
, _rlDir = a
@@ -98,10 +99,13 @@ lnkBothAnd' rlt ltcon ltcon2 i (j,(p,a)) = RoomLink
-- it is not clear to me that this works for very small rooms (but it does seem
-- to do so)
roomRectAutoLinks :: Float -> Float -> Room
roomRectAutoLinks x y = (roomRect x y (f x) (f y)) {_rmPmnts = plmnts}
roomRectAutoLinks x y = (roomRect x y (f x) (f y))
{_rmPmnts = plmnts
,_rmName = "autoRect"
}
where
f z = max 1 $ (ceiling z - 40) `div` 60
plmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
plmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isInLnk rp]
{- Combines two rooms into one room.
- will have to work out exactly what to do with combining links
Mostly involves concatenation. -}
src/Dodge/Room/Room.hs
+2 -2
View File
@@ -185,9 +185,9 @@ roomOctogon = defaultRoom
roomNgon :: Int -> Float -> Room
roomNgon n x = defaultRoom
{ _rmPolys = [poly]
, _rmLinks = muout (init lnks) ++ muin[last lnks]
, _rmLinks = map toBothLnk lnks -- muout (init lnks) ++ muin[last lnks]
, _rmPath = [] -- TODO
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rpBool isInLnk]
, _rmPmnts = [mntLightLnkCond $ resetPLUse $ rprBool $ const . isInLnk]
, _rmBound = [poly]
, _rmFloor = Tiled [makeTileFromPoly poly 9]
, _rmName = show n ++ "gon"
src/Dodge/Room/SensorDoor.hs
+46 -7
View File
@@ -1,13 +1,14 @@
module Dodge.Room.SensorDoor where
import Dodge.LevelGen.Data
import Dodge.PlacementSpot
import Dodge.Placement.Instance.Terminal
import Dodge.Data
import Dodge.Tree
--import Dodge.RoomLink
import Dodge.Room.Door
import Dodge.Room.Procedural
import Dodge.Room.Room
--import Dodge.Room.Corridor
import Dodge.Room.Corridor
import Dodge.Room.Link
--import Dodge.Room.Procedural
import Dodge.Room.Foreground
@@ -22,11 +23,13 @@ import Geometry
--import Padding
import Color
import Shape
--import Lorem
import LensHelp
import Dodge.RandomHelp
--import qualified Data.Set as S
import qualified Data.Set as S
import Data.Maybe
import Data.Char
--import Data.Tree
import Control.Monad.State
import System.Random
@@ -38,6 +41,16 @@ sensorRoom senseType n = do
let doorroom = triggerDoorRoom n
return $ treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
sensorRoomRunPast :: RandomGen g => DamageType -> Int -> State g (SubCompTree Room)
sensorRoomRunPast dt n = do
t <- sensorRoom dt n
return $ applyToSubforest [0] (++
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
& rmName .~ "test"
] (UseLabel 0 corridor)]
) t
--[return $ UseLabel 0 $ door & rmConnectsTo .~ S.member InLink]
sensAboveDoor :: DamageType -> Float -> PlacementSpot -> Placement
sensAboveDoor sensetype wth ps = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
@@ -48,9 +61,35 @@ sensAboveDoor sensetype wth ps = extTrigLitPos
sensInsideDoor :: DamageType -> Int -> Room -> Room
sensInsideDoor senseType outplid rm = rm
& rmPmnts .:~ psPt atFstLnkOut
(PutShape $ colorSH yellow $
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
& rmName .++~ take 4 (show senseType)
& rmPmnts .++~
[ psPt atFstLnkOut
(PutShape $ colorSH yellow $
thinHighBar 0 (V2 20 (-1)) (V2 20 (-100))
<> thinHighBar 0 (V2 0 (-100)) (V2 20 (-100))
<> barPP 1.5 (V3 20 (-1) 0) (V3 20 (-1) 80))
, putTerminal messagef
& plGenPL . plSpot .~ rprBoolShift isUnusedLnk (shiftInBy 10)
]
& rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
where
mtoup = map toUpper
horline = "-----------------"
topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. length horline -1]]
messagef gp =
let Just (pc,ds) = gp ^? sensorCoding . ix senseType
themessage =
topflush ++
[horline
,"SENSOR ATTRIBUTES"
,horline
,mtoup $ show senseType
,"COLOR:"++ mtoup (show pc)
,"SHAPE:"++ mtoup (reverse . drop 10 . reverse $ show ds)
,horline
]
in TerminalParams
{_termDisplayedLines = [] --zip (replicate 7 horline) (repeat white)
,_termFutureLines = zip (repeat 0) $ zip themessage $ repeat white
,_termMaxLines = 7
}
src/Dodge/Room/Tanks.hs
+2 -2
View File
@@ -41,8 +41,8 @@ tanksRoom crs its = do
girderPosOrder <- shuffle [1 .. nwestlnks - 2]
let plmnts =
--ok, this has become complicated
foldr1 setFallback [ twoRoomPoss (isUnusedLinkType (FromSouth i))
(isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
foldr1 setFallback [ twoRoomPoss (const . isUnusedLinkType (FromSouth i))
(const . isUnusedLinkType (FromSouth i)) $ \ps1 ps2 ->
sps0 $ PutShape $ girderV 96 20 10 (_psPos ps1) (_psPos ps2)
| i <- girderPosOrder]
: map (\it -> sps0 (PutFlIt it) & plSpot .~ anyUnusedSpot) its
src/Dodge/Tree/Polymorphic.hs
+18
View File
@@ -9,6 +9,8 @@ the nodes in the trunk are [a,b] (note that d is not the first child of b).
-}
module Dodge.Tree.Polymorphic
( applyToRoot
, applyToSubtree
, applyToSubforest
, treeFromPost
, treeFromTrunk
, splitTrunk
@@ -56,6 +58,22 @@ applyToNode (i:is) f (Node x xs) = Node x (ys ++ [applyToNode is f z] ++ zs)
where
(ys, z:zs) = splitAt i xs
{- | Applies a function to a specific subtree determined by a list of indices.
Unsafe (partial function). -}
applyToSubtree :: [Int] -> (Tree a -> Tree a) -> Tree a -> Tree a
applyToSubtree [] f t = f t
applyToSubtree (i:is) f (Node x xs) = Node x (ys ++ [applyToSubtree is f z] ++ zs)
where
(ys, z:zs) = splitAt i xs
{- | Applies a function to a specific subforest determined by a list of indices.
Unsafe (partial function). -}
applyToSubforest :: [Int] -> ([Tree a] -> [Tree a]) -> Tree a -> Tree a
applyToSubforest [] f (Node p cs) = Node p (f cs)
applyToSubforest (i:is) f (Node x xs) = Node x (ys ++ [applyToSubforest is f z] ++ zs)
where
(ys, z:zs) = splitAt i xs
-- do not delete: find use for
--{- |
--Applies a function to the first node along a trunk that satisfies a given property.
src/Dodge/Update.hs
+1
View File
@@ -73,6 +73,7 @@ functionalUpdate cfig w = checkEndGame
. updateBlocks
. updateSeenWalls
. (youHammerPosition %~ moveHammerUp)
. updateTerminal
$ updateCloseObjects w
where
--updatedLightSources = mapMaybe (\b -> _tlsUpdate b w b) $ _tempLightSources w
src/Dodge/Update/UsingInput.hs
+8 -8
View File
@@ -12,9 +12,9 @@ import qualified Data.Set as S
import Control.Lens
updateUsingInput :: World -> World
updateUsingInput w = if _carteDisplay w
then updatePressedButtonsCarte (_mouseButtons w) w
else updatePressedButtons (_mouseButtons w) w
updateUsingInput w = case _hudElement $ _hud w of
DisplayInventory {} -> updatePressedButtons (_mouseButtons w) w
DisplayCarte -> updatePressedButtonsCarte (_mouseButtons w) w
updatePressedButtons :: S.Set MouseButton -> World -> World
updatePressedButtons pkeys w
@@ -26,7 +26,7 @@ updatePressedButtons pkeys w
& cameraRot -~ rotation
| otherwise = w
where
inTopInv = _inventoryMode w == TopInventory
inTopInv = _hudElement (_hud w) == DisplayInventory NoSubInventory
lbPressed = ButtonLeft `S.member` pkeys
rbPressed = ButtonRight `S.member` pkeys
mbPressed = ButtonMiddle `S.member` pkeys
@@ -35,10 +35,10 @@ updatePressedButtons pkeys w
updatePressedButtonsCarte :: S.Set MouseButton -> World -> World
updatePressedButtonsCarte pkeys w
| rbPressed = w & clickMousePos .~ _mousePos w
& carteCenter %~ (-.- trans)
& hud . carteCenter %~ (-.- trans)
| lbPressed = w & clickMousePos .~ _mousePos w
& carteRot -~ rot
& carteZoom *~ czoom
& hud . carteRot -~ rot
& hud . carteZoom *~ czoom
| otherwise = w
where
lbPressed = ButtonLeft `S.member` pkeys
@@ -46,4 +46,4 @@ updatePressedButtonsCarte pkeys w
--mbPressed = ButtonMiddle `S.member` pkeys
rot = angleBetween (_mousePos w) (_clickMousePos w)
czoom = magV (_mousePos w) / magV (_clickMousePos w)
trans = rotateV (_carteRot w) $ (1 / _carteZoom w) *.* (_mousePos w -.- _clickMousePos w)
trans = rotateV (_carteRot (_hud w)) $ (1 / _carteZoom (_hud w)) *.* (_mousePos w -.- _clickMousePos w)