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

Work on more complicated terminals

Browse Source
This commit is contained in:
justin
2022-05-31 13:30:27 +01:00
parent 79b3a86520
commit b54864bbda
13 changed files with 159 additions and 64 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+6
View File
@@ -385,12 +385,18 @@ data TerminalParams = NoTerminalParams | TerminalParams
, _termFutureLines :: [TerminalLine]
, _termMaxLines :: Int
, _termTitle :: String
, _termSel :: Maybe Int
, _termOptions :: [(String, World -> World)]
}
data TerminalLine
= TerminalLineDisplay
{_tlPause :: Int
,_tlString :: World -> (String, Color)
}
| TerminalLineChoice
{_tlPause :: Int
,_tlOptions :: [(String,World -> World)]
}
| TerminalLineEffect
{_tlPause :: Int
,_tlEffect :: SubInventory -> World -> World
src/Dodge/Event.hs
+10
View File
@@ -92,6 +92,13 @@ handlePressedMouseButton :: MouseButton -> Universe -> Maybe Universe
handlePressedMouseButton but w = case (_hudElement (_hud $ _uvWorld w), but) of
(DisplayCarte,_) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
(_,ButtonMiddle) -> Just $ w & uvWorld . clickMousePos .~ _mousePos (_uvWorld w)
( DisplayInventory (DisplayTerminal tp _) , ButtonLeft)
-> Just $ fromMaybe w
$ do -- ugly
i <- _termSel tp
f <- _termOptions tp !? i
return $ w & uvWorld %~ snd f
& uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory
( DisplayInventory (CombineInventory mi) , ButtonLeft)
-> Just $ fromMaybe (w & uvWorld . hud . hudElement .~ DisplayInventory NoSubInventory)
$ do -- ugly
@@ -140,6 +147,9 @@ wheelEvent y w = case _hudElement $ _hud w of
| otherwise -> w & moveTweakSel yi
DisplayInventory (CombineInventory _) -> w
& hud . hudElement . subInventory . combineInvSel . _Just %~ ((`mod` numcombs) . subtract yi)
DisplayInventory (DisplayTerminal tp _) -> w
& hud . hudElement . subInventory . termParams . termSel . _Just
%~ ((`mod` length (_termOptions tp)) . subtract yi)
_ -> w
where
numcombs = length $ combineItemListYou w
src/Dodge/Floor.hs
+2
View File
@@ -16,6 +16,7 @@ import Dodge.PlacementSpot
import Dodge.Annotation
--import Dodge.Placement.Instance.Sensor
import Dodge.Creature
import Dodge.Room.Warning
--import Dodge.LevelGen.Data
--import Dodge.LevelGen.Switch
--import Dodge.Item.Weapon.Launcher
@@ -39,6 +40,7 @@ import System.Random
initialAnoTree :: Tree [Annotation]
initialAnoTree = padSucWithDoors $ treeFromPost
[[AnoApplyInt 0 startRoom]
, [SpecificRoom $ warningRooms 7]
, [SpecificRoom $ return (return . UseAll $ roomRectAutoLinks 400 400
& rmPmnts .++~ [spNoID anyUnusedSpot (PutCrit invisibleChaseCrit)
, spNoID anyUnusedSpot (PutCrit armourChaseCrit)
src/Dodge/Inventory.hs
+4
View File
@@ -164,6 +164,10 @@ updateTerminalLine w = case w ^? hud . hudElement . subInventory . termParams .
Just (TerminalLineEffect _ eff) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& eff (_subInventory . _hudElement $ _hud w)
Just (TerminalLineChoice _ ops) -> w
& hud . hudElement . subInventory . termParams . termFutureLines %~ tail
& hud . hudElement . subInventory . termParams . termOptions .~ ops
& hud . hudElement . subInventory . termParams . termSel ?~ 0
-- this looks ugly...
updateCloseObjects :: World -> World
src/Dodge/Machine.hs
+1 -2
View File
@@ -35,8 +35,7 @@ machineUpdateDeathEff f mc
machineAddSound :: SoundID -> (Machine -> World -> World) -> Machine -> World -> World
machineAddSound sid f mc w
| d < 200
= soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w
| d < 200 = soundContinueVol (1-0.005*d) (MachineSound mid) (_mcPos mc) sid (Just 2) $ f mc w
| otherwise = f mc w
where
d = dist (_crPos $ you w) (_mcPos mc)
src/Dodge/Placement/Instance/Analyser.hs
+11 -40
View File
@@ -1,9 +1,13 @@
module Dodge.Placement.Instance.Analyser where
module Dodge.Placement.Instance.Analyser
( analyser'
, testYouHave
, testYourHealth
) where
import Dodge.LevelGen.Data
--import Dodge.PlacementSpot
import Dodge.Data
import Dodge.Base.You
import Dodge.Default
--import Dodge.Default
--import Dodge.Tree
--import Dodge.RoomLink
--import Dodge.Room.Door
@@ -14,7 +18,7 @@ import Dodge.Default
--import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
import Dodge.Placement.Shift
--import Dodge.Placement.Shift
import Dodge.SoundLogic
--import Dodge.Default.Room
--import Dodge.Item.Weapon.BulletGuns
@@ -24,8 +28,8 @@ import Dodge.SoundLogic
import Geometry
--import Padding
import Color
import Shape
import ShapePicture
--import Shape
--import ShapePicture
import LensHelp
--import Dodge.RandomHelp
@@ -67,6 +71,8 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
++ map simpleline afters
, _termMaxLines = 7
, _termTitle = "ANALYSER"
, _termSel = Nothing
, _termOptions = []
}
)
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
@@ -79,41 +85,6 @@ analyser' starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \t
_ -> (fails,red)
updatebuttonname = plType . putButton . btText .~ "ANALYSER"
analyser
:: [String] -- | initial text
-> String -- | succeed text
-> String -- | fail text
-> [String] -- | after text
-> (Machine -> World -> World)
-> PlacementSpot
-> PlacementSpot
-> Placement
analyser starts sucs fails afters upf pslight psmc = extTrigLitPos pslight $ \tp ->
Just $ psPtCont psmc
(PutMachine aquamarine (reverse $ square 10) defaultMachine
{ _mcDraw = const . noPic . colorSH aquamarine . upperPrismPoly 25 $ square 10
, _mcUpdate = \mc -> (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
. upf mc
, _mcSensor = SensorCloseToggle NotClose False
}
) $ \anmc -> Just
$ plSpot .~ shiftRelativeToPS (V2 20 0) (_plSpot anmc)
$ updatebuttontext $ putTerminal $ const $ TerminalParams
{ _termDisplayedLines = []
, _termFutureLines = map simpleline starts
++ [testline' (fromJust $ _plMID anmc)]
++ map simpleline afters
, _termMaxLines = 7
, _termTitle = "ANALYSER"
}
where
simpleline str = TerminalLineDisplay {_tlPause = 0, _tlString = const (str,white)}
testline' mcid = TerminalLineDisplay 0 (testline mcid)
testline mcid w = case w ^? machines . ix mcid . mcSensor . sensToggle of
Just True -> (sucs,green)
_ -> (fails,red)
updatebuttontext = plType . putButton . btText .~ "ANALYSER"
analyserTest :: (World -> Bool) -> Machine -> World -> World
analyserTest t mc w = case
(_sensCloseToggle sens
src/Dodge/Placement/Instance/Terminal.hs
+33 -18
View File
@@ -27,7 +27,7 @@ putTerminal'
-> Placement
putTerminal' col mcf = ps0PushPS (PutButton thebutton)
$ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . colorSH col . terminalShape
{ _mcDraw = noPic . terminalShape col
, _mcHP = 100
, _mcUpdate = mcf (fromJust $ _plMID pl)
, _mcSensor = SensorCloseToggle NotClose False
@@ -42,13 +42,13 @@ putTerminal' col mcf = ps0PushPS (PutButton thebutton)
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
}
putTerminal :: (GenParams -> TerminalParams) -> Placement
putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
$ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
{ _mcDraw = noPic . colorSH terminalColor . terminalShape
{ _mcDraw = noPic . terminalShape terminalColor
, _mcHP = 100
, _mcUpdate = machineAddSound fridgeHumS
$ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
@@ -68,14 +68,24 @@ putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
, _btID = 0
, _btText = "TERMINAL"
, _btState = BtOff
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL"
, _btTerminalParams = TerminalParams [] [] 10 "TERMINAL" Nothing []
}
terminalColor :: Color
terminalColor = dark magenta
terminalShape :: Machine -> Shape
terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape :: Color -> Machine -> Shape
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape col _ = colorSH col (prismPoly
[V3 10 10 20, V3 (-10) 10 20, V3 (-10) (-10) 10, V3 10 (-10) 10]
[V3 10 10 0, V3 (-10) 10 0, V3 (-10) (-10) 0, V3 10 (-10) 0]
)
<> colorSH black (prismPoly
[V3 8 8 20, V3 (-8) 8 20, V3 0 (-8) 10]
[V3 8 8 19, V3 (-8) 8 19, V3 0 (-8) 9]
--[V3 8 8 20, V3 (-8) 8 20, V3 (-8) (-8) 10, V3 8 (-8) 10]
--[V3 8 8 19, V3 (-8) 8 19, V3 (-8) (-8) 9, V3 8 (-8) 9]
)
displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
@@ -84,18 +94,21 @@ displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory Display
}
simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
simpleTermMessage ss = const $ TerminalParams
{_termDisplayedLines = []
,_termFutureLines = TerminalLineEffect 0 termsound
: map totermline (topFlushStrings ss ++ ss)
,_termMaxLines = 7
,_termTitle = "TERMINAL"
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))
termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
where
tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
simpleTermMessage = genTermMessage . const
--simpleTermMessage ss = const $ TerminalParams
-- {_termDisplayedLines = []
-- ,_termFutureLines = TerminalLineEffect 0 termsound
-- : map totermline (topFlushStrings ss ++ ss)
-- ,_termMaxLines = 7
-- ,_termTitle = "TERMINAL"
-- ,_termSel = Nothing
-- ,_termMaxSel = Nothing
-- }
-- where
-- totermline s = TerminalLineDisplay 0 (const (s,white))
-- termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
-- where
-- tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos
topFlushStrings :: [String] -> [String]
topFlushStrings = topFlush . maximum . map length
@@ -110,6 +123,8 @@ genTermMessage f = \gp -> TerminalParams
: map totermline (topFlushStrings (f gp) ++ f gp)
,_termMaxLines = 7
,_termTitle = "TERMINAL"
,_termSel = Nothing
,_termOptions = []
}
where
totermline s = TerminalLineDisplay 0 (const (s,white))
src/Dodge/PlacementSpot.hs
+10
View File
@@ -21,6 +21,7 @@ module Dodge.PlacementSpot
, twoRoomPoss
, isUnusedLnkType
, rprBoolShift
, rprShift
, rprBool
, shiftInBy
, resetPLUse
@@ -71,6 +72,15 @@ resetPLUse (PSPos f g fallback) = PSPos f' g fallback
f' rp = fmap (second (rpPlacementUse .~ 0)) . f rp
resetPLUse _ = error "Tried to reset _rpPlacementUse of non PSPos placement"
rprShift
:: (RoomPos -> Room -> Maybe (Point2,Float))
-> PlacementSpot
rprShift t = PSPos f (const id) Nothing
where
f rp r = case t rp r of
Just (p,a) -> Just (PS p a, rp & rpPlacementUse +~ 1)
Nothing -> Nothing
rprBoolShift :: (RoomPos -> Room -> Bool)
-> ((Point2,Float) -> (Point2,Float))
-> PlacementSpot
src/Dodge/Render/HUD.hs
+4
View File
@@ -84,9 +84,13 @@ subInventoryDisplay subinv cfig w = case subinv of
DisplayTerminal {_termParams = tp} -> pictures
[ invHead cfig (_termTitle tp)
, renderListAt subInvX 60 cfig
. (++ (map (\(str,_) -> (str,white)) (_termOptions tp)))
. reverse
. take (_termMaxLines tp)
$ _termDisplayedLines tp <&> ($ w)
, fromMaybe mempty $ do
cursori <- _termSel tp <&> (+ _termMaxLines tp)
return $ listCursorNSW subInvX 60 cfig cursori white 15 1
]
CombineInventory mi -> pictures
[ invHead cfig "COMBINE"
src/Dodge/Room/Door.hs
+1
View File
@@ -34,6 +34,7 @@ triggerDoorRoom inplid = defaultRoom
, _rmLinks = init lnks++ [last lnks]
, _rmPath = [(V2 20 35,V2 20 5)]
, _rmInPmnt = [InPlacement f inplid]
, _rmName = "triggerDoorRoom"
-- door extends into side walls (for shadows as rendered 12/03/21)
-- note no bounds
}
src/Dodge/Room/SensorDoor.hs
-1
View File
@@ -47,7 +47,6 @@ sensorRoomRunPast dt n = do
t <- sensorRoom dt n
return (applyToSubforest [0] (++
[treeFromPost [PassDown $ door & rmConnectsTo .~ S.member InLink
& rmName .~ "test"
] (UseLabel 0 corridor)]
) t
,TreeSubLabelling "sensorRoomRunPast" Nothing)
src/Dodge/Room/Warning.hs
+74
View File
@@ -0,0 +1,74 @@
{-# LANGUAGE TupleSections #-}
module Dodge.Room.Warning 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.Ngon
import Dodge.Room.Procedural
--import Dodge.Room.Corridor
import Dodge.Room.Link
--import Dodge.Room.Procedural
--import Dodge.Room.Foreground
--import Dodge.Room.RoadBlock
import Dodge.Placement.Instance
--import Dodge.Default.Room
--import Dodge.Item.Weapon.BulletGuns
--import Dodge.Item.Weapon.Utility
--import Dodge.LevelGen.Data
--import Geometry.Data
import Geometry
--import Padding
--import Color
--import Shape
--import Lorem
import LensHelp
import Dodge.RandomHelp
--import qualified Data.Set as S
import Data.Maybe
--import Data.Char
--import Data.Tree
import Control.Monad.State
import System.Random
warningRooms :: RandomGen g => Int -> State g (LabSubCompTree Room)
warningRooms n = do
rm <- takeOne [roomNgon 8 200, roomRectAutoLinks 200 200]
cenroom <- shuffleLinks $ addWarningTerminal n rm
let doorroom = triggerDoorRoom n
return ( treeFromPost [PassDown door,PassDown cenroom,PassDown doorroom] (UseAll door)
, TreeSubLabelling "warningRooms" Nothing)
addWarningTerminal :: Int -> Room -> Room
addWarningTerminal outplid = (rmName .++~ "warningTerm-")
-- & rmOutPmnt .~ [OutPlacement (sensAboveDoor senseType 10 (atFstLnkOutShiftInward 100)) outplid]
. (rmOutPmnt .~ [OutPlacement outplace outplid])
where
outplace = extTrigLitPos
(atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a)))
(\trid -> Just $ set plSpot (rprShift fps) $ putTerminal $ termMessages trid)
--termspot = atFstLnkOutShiftBy (\(p,a) -> (p +.+ rotateV a (V2 18.5 (-2.5)), a))
fps rp rm = case rp ^? rpLinkStatus . rplsChildNum of
Just 0 ->
let rppos = _rpPos rp
rpdir = _rpDir rp
inpos = rppos +.+ rotateV rpdir (V2 0 (-12.5))
rtpos = inpos +.+ rotateV rpdir (V2 30 0)
ltpos = inpos +.+ rotateV rpdir (V2 (-30) 0)
in if any (isJust . intersectSegPolyFirst inpos ltpos) (_rmPolys rm)
-- the above test may not work properly if the room polys are
-- complicated, it should really use created walls...
then Just (rtpos, rpdir)
else Just (ltpos, rpdir)
_ -> Nothing
termMessages trid = (genTermMessage $ const ["A","TEST"])
<&> termFutureLines %~ (++ [TerminalLineChoice 0 (ops trid)])
ops trid = [ ("OPEN", triggers . ix (fromJust $ _plMID trid) .~ const True)
, ("LEAVE", id)
]
src/Geometry/Polygon.hs
+3 -3
View File
@@ -8,16 +8,16 @@ import Data.Maybe
import Data.List
import qualified Control.Foldl as L
-- | Draw a clockwise rectangle based on maximal N E S W values.
-- | Draw an anticlockwise rectangle based on maximal N E S W values.
rectNESW :: Float -> Float -> Float -> Float -> [Point2]
rectNESW !a !b !c !d = [V2 b a,V2 b c,V2 d c,V2 d a]
-- | Draw a clockwise rectangle based on maximal N S E W values.
rectNSEW :: Float -> Float -> Float -> Float -> [Point2]
rectNSEW !n !s !e !w = rectNESW n e s w
-- | Draw a clockwise rectangle based on maximal N S W E values.
-- | Draw an anticlockwise rectangle based on maximal N S W E values.
rectNSWE :: Float -> Float -> Float -> Float -> [Point2]
rectNSWE !n !s !w !e = [V2 w n, V2 w s, V2 e s, V2 e n]
-- | Draw a clockwise rectangle around the origin with given height and width
-- | Draw an anticlockwise rectangle around the origin with given height and width
rectWH :: Float -> Float -> [Point2]
rectWH w h = rectNSWE h (-h) (-w) w