--{-# LANGUAGE TupleSections #-}
module Dodge.Placement.Instance.Terminal 
    ( putTerminal
    , simpleTermMessage
    , genTermMessage
    ) 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 :: (GenParams -> TerminalParams) -> Placement
putTerminal f = plGenUpdate ?~ g $ ps0PushPS (PutButton thebutton)
    $ \pl -> Just $ pt0 (PutMachine terminalColor (reverse $ square 10) defaultMachine
    { _mcDraw = drawTerminal
    , _mcHP = 100
    , _mcUpdate = machineAddSound fridgeHumS 
        $ machineUpdateDeathEff $ \mc -> (buttons . at (fromJust (_plMID pl)) .~ Nothing)
        . makeExplosionAt (_mcPos mc)
    })
    $ const Nothing
  where
    g gp pl = (gp, 
        pl  & plType . pstPutButton . btTerminalParams .~ f gp
            & plGenUpdate .~ Nothing
        )
    thebutton = Button
        { _btPict = const mempty
        , _btPos = 0
        , _btRot = 0
        , _btEvent = displayTerminalMessage . _btID
        , _btID = 0
        , _btText = "TERMINAL"
        , _btState = BtOff
        , _btTerminalParams = TerminalParams [] [] 10
        }

terminalColor :: Color
terminalColor = dark magenta

drawTerminal :: Machine -> SPic
drawTerminal _ = noPic $ colorSH terminalColor $ upperPrismPoly 15 $ square 10

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

simpleTermMessage :: [String] -> (GenParams -> TerminalParams)
simpleTermMessage ss = const $ TerminalParams
    {_termDisplayedLines = []
    ,_termFutureLines = TerminalLineEffect 0 termsound
        : map totermline (topflush ++ ss)
    ,_termMaxLines = 7
    }
  where
    topflush = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
    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

genTermMessage :: (GenParams -> [String]) -> (GenParams -> TerminalParams)
genTermMessage f = \gp -> TerminalParams
    {_termDisplayedLines = []
    ,_termFutureLines = termSoundLine computerBeepingS
        : map totermline (topflush (f gp) ++ f gp)
    ,_termMaxLines = 7
    }
  where
    topflush ss = [replicate i ' ' ++ "*" | i <- [0,2 .. maximum (map length ss)]]
    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