116 lines
3.8 KiB
Haskell
116 lines
3.8 KiB
Haskell
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.Tree
|
|
--import Dodge.RoomLink
|
|
--import Dodge.Room.Door
|
|
--import Dodge.Room.Corridor
|
|
--import Dodge.Room.Link
|
|
--import Dodge.Room.Ngon
|
|
--import Dodge.Room.Procedural
|
|
--import Dodge.Room.Foreground
|
|
--import Dodge.Room.RoadBlock
|
|
import Dodge.Placement.Instance
|
|
--import Dodge.Placement.Shift
|
|
import Dodge.SoundLogic
|
|
--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 ShapePicture
|
|
import LensHelp
|
|
--import Dodge.RandomHelp
|
|
|
|
--import qualified Data.Set as S
|
|
import Data.Maybe
|
|
--import Data.Tree
|
|
--import Control.Monad.State
|
|
--import System.Random
|
|
|
|
|
|
initMCUpdate
|
|
:: (Machine -> World -> World)
|
|
-> (Machine -> World -> World)
|
|
-> Machine -> World -> World
|
|
initMCUpdate initup f mc
|
|
= (machines . ix (_mcID mc) . mcUpdate .~ f)
|
|
. initup mc
|
|
|
|
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 $ updatebuttonname $ plSpot .~ psmc $ putTerminal' aquamarine (termupdate tp)
|
|
where
|
|
termupdate tp btid = initMCUpdate
|
|
(\mc -> buttons . ix btid . btTerminalParams .~
|
|
const (TerminalParams
|
|
{ _termDisplayedLines = []
|
|
, _termFutureLines =
|
|
map simpleline (topFlushStrings allstrings)
|
|
++ map simpleline starts
|
|
++ [testline' (_mcID mc)]
|
|
++ map simpleline afters
|
|
, _termMaxLines = 7
|
|
, _termTitle = "ANALYSER"
|
|
, _termSel = Nothing
|
|
-- , _termOptions = []
|
|
, _termInput = Nothing
|
|
, _termScrollCommands = []
|
|
, _termWriteCommands = []
|
|
})
|
|
)
|
|
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
|
|
)
|
|
allstrings = sucs : fails : afters ++ starts
|
|
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)
|
|
updatebuttonname = plType . putButton . btText .~ "ANALYSER"
|
|
|
|
analyserTest :: (World -> Bool) -> Machine -> World -> World
|
|
analyserTest t mc w = case
|
|
(_sensCloseToggle sens
|
|
, _sensToggle sens
|
|
, t w
|
|
, dist (_crPos ycr) (_mcPos mc) < 40) of
|
|
(_,True,_,_) -> w
|
|
(_,False,True,True) -> w
|
|
& machines . ix (_mcID mc) . mcSensor . sensToggle .~ True
|
|
& playsound dedaS
|
|
& machines . ix (_mcID mc) . mcSensor . sensCloseToggle .~ IsClose
|
|
(NotClose,_,False,True) -> w & playsound dedumS
|
|
& machines . ix (_mcID mc) . mcSensor . sensCloseToggle .~ IsClose
|
|
(_,_,_,False) -> w & machines . ix (_mcID mc) . mcSensor . sensCloseToggle .~ NotClose
|
|
_ -> w
|
|
where
|
|
playsound sid = soundContinue (MachineAltSound (_mcID mc)) (_mcPos mc) sid Nothing
|
|
ycr = you w
|
|
sens = _mcSensor mc
|
|
|
|
testYouHave :: CombineType -> Machine -> World -> World
|
|
testYouHave ct = analyserTest (any (\itm -> _itType itm == ct) . _crInv . you )
|
|
|
|
testYourHealth :: Int -> Machine -> World -> World
|
|
testYourHealth hp = analyserTest (\w -> _crHP (you w) >= hp)
|