--{-# 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.SoundLogic
import Color
import Geometry
import LensHelp

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