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

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

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

putTerminalFull ::
    (Placement -> Placement -> Placement -> Maybe Placement) ->
    Machine ->
    Terminal ->
    Placement
putTerminalFull f mc tm =
    ps0PushPS (PutTerminal tm) $
        \tmpl -> Just $
            ps0PushPS (PutButton defaultButton) $
                \btpl -> Just $
                    pt0
                        ( PutMachine
                            (reverse $ square 10)
                            ( mc & mcMounts . at OTButton ?~ fromJust (_plMID btpl)
                                & mcMounts . at OTTerminal .~ _plMID tmpl
                            )
                            Nothing
                        )
                        $ \mcpl -> Just $ pt0 (PutWorldUpdate $ const $ const $ over gwWorld  (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 :: Machine -> Terminal -> Placement
putTerminal = putTerminalFull (\_ _ _ -> Nothing)

tmMachine :: Machine
tmMachine = defaultMachine & mcType .~ McTerminal & mcHP .~ 100

putMessageTerminal :: Terminal -> Placement
putMessageTerminal = putTerminal tmMachine

putImmediateMessageTerminal :: Terminal -> Placement
putImmediateMessageTerminal = putTerminalImediateAccess tmMachine