--{-# LANGUAGE TupleSections #-}
module Dodge.Placement.Instance.Terminal 
    ( putMessageTerminal
    , putTerminal
    , simpleTermMessage
    , terminalColor
    , accessTerminal
    ) where
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
--import Dodge.Machine
import Dodge.SoundLogic
import Dodge.Terminal
import Color
import Geometry
import ShapePicture
import LensHelp
import Shape
--import ShapePicture
--import Sound.Data

import Data.Maybe

putTerminal :: Machine -> Terminal -> Placement
putTerminal mc tm 
    = ps0PushPS (PutTerminal tm) 
    $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
    $ \btpl -> Just $ pt0 
        (PutMachine (reverse $ square 10)
            (mc & mcMounts . at ObButton ?~ fromJust (_plMID btpl)
                & mcCloseSound ?~ fridgeHumS)       
            defaultSensorWall
        )
    $ \mcpl -> Just $ sps0 $ PutWorldUpdate $ const (setids tmpl btpl mcpl) 
  where
    setids tmpl btpl mcpl w = w
        & terminals . ix tmid . tmButtonID .~ btid
        & terminals . ix tmid . tmMachineID .~ mcid
        & machines  . ix mcid . mcMounts . at ObTerminal ?~ tmid
        & buttons   . ix btid . btTermMID ?~ tmid
      where
        tmid = fromJust (_plMID tmpl)
        btid = fromJust (_plMID btpl)
        mcid = fromJust (_plMID mcpl)

putMessageTerminal :: Color -> Terminal -> Placement
putMessageTerminal col = putTerminal $ defaultMachine
    & mcColor .~ col
    & mcDraw .~ MachineDrawTerminal --terminalSPic
    & mcHP .~ 100

termButton :: Button
termButton = Button
    { _btPict   = DrawNoButton
    , _btPos    = 0
    , _btRot    = 0
    , _btEvent  = ButtonAccessTerminal
    , _btID     = 0
    , _btText   = "TERMINAL"
    , _btState  = BtOff
    , _btTermMID = Nothing
    , _btName   = ""
    , _btColor  = dark magenta
    }

terminalColor :: Color
terminalColor = dark magenta


accessTerminal :: Maybe Int -> World -> World
accessTerminal mtmid w = case mtmid of
    Nothing -> w
    Just tmid -> w & hud . hudElement .~ DisplayInventory (DisplayTerminal tmid)
        & terminals . ix tmid . tmInput . tiFocus .~ True
        & terminals . ix tmid %~ tryToBoot
      where
        tryToBoot tm = case _tmStatus tm of
            TerminalReady -> tm
            TerminalBusy -> tm
            TerminalOff -> tm
                & tmFutureLines .~ _tmBootProgram tm tm w
                & tmStatus .~ TerminalBusy

simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs