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

import Data.Maybe

putTerminal''
    :: Machine
    -> Terminal
    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
    -> Placement
putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) 
    $ \tmpl -> Just $ ps0PushPS (PutButton termButton)
    $ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
        (mc & mcUpdate %~ (\fmu mc' -> mcf (fromJust $ _plMID btpl) mc' . fmu mc') . machineAddSound fridgeHumS
            & mcDeath %~ (\fd mc' -> mcKillTerm mc' . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
        )       )
    $ \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 . mcTermMID ?~ tmid
        & buttons   . ix btid . btTermMID ?~ tmid
      where
        tmid = fromJust (_plMID tmpl)
        btid = fromJust (_plMID btpl)
        mcid = fromJust (_plMID mcpl)

mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
    tmid <- _mcTermMID mc
    tm <- w ^? terminals . ix tmid 
    return $ w 
        & _tmDeathEffect tm tm

putTerminal' 
    :: Color
    -> Terminal
    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
    -> Placement
putTerminal' col = putTerminal'' (defaultMachine 
        & mcColor .~ col)
    { _mcDraw = noPic . terminalShape
    , _mcHP = 100
    , _mcSensor = defaultProximitySensor
    }

putTerminal :: Color -> Terminal -> Placement
putTerminal col f = putTerminal'' (mc & mcColor .~ col) f (\_ -> basicMachineUpdate $ const id)
  where
    mc = defaultMachine
        { _mcDraw = terminalSPic
        , _mcHP = 100
        , _mcDeath = makeExplosionAt . _mcPos
        }

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

terminalColor :: Color
terminalColor = dark magenta

terminalSPic :: Machine -> SPic
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalSPic = noPic . terminalShape

terminalShape :: Machine -> Shape
--terminalShape _ = upperPrismPoly 15 $ square 10
terminalShape mc = 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]
    )
  where
    col = _mcColor mc

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 .~ _tmProgram tm tm w
                & tmStatus .~ TerminalBusy

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