143 lines
5.0 KiB
Haskell
143 lines
5.0 KiB
Haskell
module Dodge.Placement.Instance.Analyser 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 .~
|
|
TerminalParams
|
|
{ _termDisplayedLines = []
|
|
, _termFutureLines =
|
|
map simpleline topflush
|
|
++ map simpleline starts
|
|
++ [testline' (_mcID mc)]
|
|
++ map simpleline afters
|
|
, _termMaxLines = 7
|
|
, _termTitle = "ANALYSER"
|
|
}
|
|
)
|
|
(\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc))
|
|
)
|
|
allstrings = sucs : fails : afters ++ starts
|
|
topflush = [replicate i ' ' ++ "*" | i <- [0,3 .. maximum (map length allstrings)]]
|
|
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"
|
|
|
|
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
|
|
, _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 dededaS
|
|
& machines . ix (_mcID mc) . mcSensor . sensCloseToggle .~ IsClose
|
|
(NotClose,_,False,True) -> w & playsound dededumS
|
|
& 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 (\w -> any (\itm -> _itType itm == ct) (_crInv (you w)))
|
|
|
|
testYourHealth :: Int -> Machine -> World -> World
|
|
testYourHealth hp = analyserTest (\w -> _crHP (you w) >= hp)
|