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

import Data.Maybe

putTerminal' 
    :: Color
    -> (Int -> Machine -> World -> World)  -- | machine update, takes button id as input
    -> Placement
putTerminal' col mcf = ps0PushPS (PutButton termButton)
    $ \pl -> Just $ pt0 (PutMachine col (reverse $ square 10) defaultMachine
    { _mcDraw = noPic . terminalShape col
    , _mcHP = 100
    , _mcUpdate = mcf (fromJust $ _plMID pl)
    , _mcSensor = SensorCloseToggle NotClose False
    })
    $ const Nothing

putTerminal :: (GenParams -> World -> TerminalParams) -> Placement
putTerminal f = ps0PushPSw PutNothing $ \w _ -> Just $
     --plGenUpdate ?~ g $ ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w))
     ps0PushPS (PutButton $ termButton & btTerminalParams .~ f (_genParams w))
    $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
    { _mcDraw = noPic . terminalShape terminalColor
    , _mcHP = 100
    , _mcUpdate = machineAddSound fridgeHumS 
        $ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
        . makeExplosionAt (_mcPos mc)
    })
    $ const Nothing
termButton :: Button
termButton = Button
    { _btPict = const mempty
    , _btPos = 0
    , _btRot = 0
    , _btEvent = displayTerminalMessage . _btID
    , _btID = 0
    , _btText = "TERMINAL"
    , _btState = BtOff
    , _btTerminalParams = const $ TerminalParams [] [] 10 "TERMINAL" Nothing Nothing [] []
    , _btName = ""
    }


terminalColor :: Color
terminalColor = dark magenta

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

displayTerminalMessage :: Int -> World -> World
displayTerminalMessage btid w = w & hud . hudElement .~ DisplayInventory DisplayTerminal
    { _termID = btid
    , _termParams = fromMaybe NoTerminalParams $ (w ^? buttons . ix btid . btTerminalParams) <&> ($ w)
    }

simpleTermMessage :: [String] -> (GenParams -> World -> TerminalParams)
simpleTermMessage = genTermMessage . const
--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]]

genTermMessage :: (GenParams -> [String]) -> (GenParams -> World -> TerminalParams)
genTermMessage f = \gp _ -> TerminalParams
    {_termDisplayedLines = []
    ,_termFutureLines = termSoundLine computerBeepingS
        : map totermline (topFlushStrings (f gp) ++ f gp)
    ,_termMaxLines = 7
    ,_termTitle = "TERMINAL"
    ,_termSel = Nothing
--    ,_termOptions = []
    ,_termInput   = Nothing
    ,_termScrollCommands = []
    ,_termWriteCommands = []
    }
  where
    totermline s = TerminalLineDisplay 0 (const (s,white))

termSoundLine :: SoundID -> TerminalLine
termSoundLine sid = TerminalLineEffect 0 termsound
  where
    termsound subinv w = soundStart TerminalSound tpos sid Nothing w
      where
        tpos = fromMaybe 0 $ w ^? buttons . ix (_termID subinv) . btPos