--{-# LANGUAGE TupleSections #-}
module Dodge.Placement.Instance.Terminal 
    ( putTerminal
    , putTerminal'
    , putTerminal''
    , simpleTermMessage
    , topFlushStrings
    , 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'))
            & 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)

-- machineAddSound fridgeHumS 

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 = ""
    }


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
            Connected -> tm
            Disconnected -> tm
                & tmFutureLines ++.~ _tmProgram tm tm w
                & tmStatus .~ Connected

simpleTermMessage :: [String] -> Terminal
simpleTermMessage strs = defaultTerminal & tmFutureLines .~ map makeTermLine strs
--simpleTermMessage ss = const $ TerminalParams
--    {_termDisplayedLines = []
--    ,_termFutureLines = TerminalLineEffect 0 termsound
--        : map totermline (topFlushStrings ss ++ ss)
--    ,_termMaxLines = 7
--    ,_termTitle = "TERMINAL"
--    ,_termSel = Nothing
--    ,_termMaxSel = Nothing
--    }
--  where
--    totermline s = TerminalLineDisplay 0 (const (s,white))
--    termsound subinv w' = soundStart TerminalSound tpos computerBeepingS Nothing w'
--      where
--        tpos = fromMaybe 0 $ w' ^? buttons . ix (_termID subinv) . btPos

topFlushStrings :: [String] -> [String]
topFlushStrings = topFlush . maximum . map length

topFlush :: Int -> [String]
topFlush twidth = [replicate i ' ' ++ "*" | i <- [0, max 1 $ twidth `div` 5 .. twidth]]