module Dodge.Placement.Instance.Terminal (
    putMessageTerminal,
    putImmediateMessageTerminal,
    putTerminal,
    terminalColor,
) where

import Color
import Data.Maybe
import Dodge.Data.GenWorld
import Dodge.Default
import Dodge.LevelGen.PlacementHelper
import Dodge.WorldEffect
import Geometry
import LensHelp

putTerminalImediateAccess :: Color -> Machine -> Terminal -> Placement
putTerminalImediateAccess = putTerminalFull f
  where
    f tmpl _ _ = Just $ sps0 $ PutWorldUpdate $ const $ accessTerminal (tmpl ^?! plMID . _Just)

putTerminalFull ::
    (Placement -> Placement -> Placement -> Maybe Placement) ->
    Color ->
    Machine ->
    Terminal ->
    Placement
putTerminalFull f col mc tm =
    ps0PushPS (PutTerminal (tm & tmExternalColor .~ col)) $
        \tmpl -> Just $
            ps0PushPS (PutButton defaultButton) $
                \btpl -> Just $
                    pt0
                        ( PutMachine
                            (reverse $ square 10)
                            ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                & mcMounts . at OTTerminal .~ _plMID tmpl
                            )
                            defaultSensorWall
                            Nothing
                        )
                        $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const (setids tmpl btpl mcpl)) (\_ -> f tmpl btpl mcpl)
  where
    setids tmpl btpl mcpl w =
        w
            & cWorld . lWorld . terminals . ix tmid . tmButtonID .~ btid
            & cWorld . lWorld . terminals . ix tmid . tmMachineID .~ mcid
            & cWorld . lWorld . machines . ix mcid . mcMounts . at OTTerminal ?~ tmid
            & cWorld . lWorld . buttons . ix btid . btEvent .~ ButtonAccessTerminal tmid
      where
        tmid = fromJust (_plMID tmpl)
        btid = fromJust (_plMID btpl)
        mcid = fromJust (_plMID mcpl)

putTerminal :: Color -> Machine -> Terminal -> Placement
putTerminal = putTerminalFull (\_ _ _ -> Nothing)

putMessageTerminal :: Color -> Terminal -> Placement
putMessageTerminal col =
    putTerminal col $
        defaultMachine
            & mcColor .~ col
            & mcType .~ McTerminal
            & mcHP .~ 100

putImmediateMessageTerminal :: Color -> Terminal -> Placement
putImmediateMessageTerminal col =
    putTerminalImediateAccess col $
        defaultMachine
            & mcColor .~ col
            & mcType .~ McTerminal
            & mcHP .~ 100

terminalColor :: Color
terminalColor = dark magenta