module Dodge.Room.Pillar (
    blockPillar,
    roomPillars,
    roomPillarsSquare,
    roomPillarsPassage,
) where

import qualified Data.Set as S
import Dodge.Cleat
import Dodge.Data.GenWorld
import Dodge.Default.Block
import Dodge.LevelGen.PlacementHelper
import Dodge.Placement.Instance
import Dodge.PlacementSpot
import Dodge.Room.Link
import Dodge.Room.Modify.Girder
import Dodge.Room.Procedural
import Geometry
import LensHelp
import RandomHelp

blockPillar :: Float -> Float -> Placement
blockPillar w' h' =
    ps0jPushPS (aline tl tr) $
        ps0jPushPS (aline tr br) $
            ps0jPushPS (aline br bl) $
                sps0 (aline bl tl)
  where
    w = w' - 10
    h = h' - 10
    tl = V2 (- w) h
    tr = V2 w h
    br = V2 w (- h)
    bl = V2 (- w) (- h)
    aline = PutLineBlock baseBlockPane 9

smallPillar :: PSType
smallPillar = PutBlock defaultBlock baseBlockPane $ reverse $ square 5

--crossPillar :: Float -> Float -> Placement
--crossPillar w' h' =
--    ps0jPushPS (aline (V2 (- w) 0) (V2 w 0)) $
--        sps0 (aline (V2 0 (- h)) (V2 0 h))
--  where
--    w = w' - 9
--    h = h' - 9
--    aline = PutLineBlock baseBlockPane 9

roomPillarsSquare :: RandomGen g => State g Room
roomPillarsSquare = do
    rm' <- roomRectAutoLinks 300 300
    let nlew = _numLinkEW (_rmType rm')
        nlns = _numLinkNS (_rmType rm')
    thelight <- mntLightLnkCond $ resetPLUse $ rprBool $ \rp _ -> isOutLnk rp
    addlights <-
        takeOne
            [ return
                . set
                    rmPmnts
                    [ mntLS
                        vShape
                        (rotateVAround (V2 150 150) a (V2 30 30))
                        (onXY (rotateVAround (V2 150 150) a) $ V3 60 60 95)
                    | a <- [0, pi / 2, pi, 3 * pi / 2]
                    ]
            , return
                . set
                    rmPmnts
                    [ mntLS
                        vShape
                        (rotateVAround (V2 150 150) a (V2 150 0))
                        (onXY (rotateVAround (V2 150 150) a) $ V3 150 20 95)
                    | a <- [0, pi / 2, pi, 3 * pi / 2]
                    ]
            , addGirderLights . set rmPmnts []
            , return
                . ( rmPmnts
                        .++~ [ spanColLightBlackI 0.75 95 (V2 0 130) (V2 300 130)
                             , spanColLightBlackI 0.75 95 (V2 0 170) (V2 300 170)
                             , thelight
                             ]
                  )
            ]
    rm <- addlights rm'
    shuffleLinks $
        rm & rmPmnts .++~ concatMap (replicate nlew . makepill) [South, North]
            ++ concatMap (replicate nlns . makepill) [East, West]
  where
    makepill edge = sps (rprBool $ \rp _ -> t edge rp) smallPillar
    t edge rp = any (f edge) (_rpFlags rp) && null (_rpPlacementUse rp)
    f edge rpt = maybe False (PathFromEdge edge 0 `S.member`) (rpt ^? offGridFromEdges)

roomPillarsPassage :: RandomGen g => State g Room
roomPillarsPassage = do
    let rm = roomRect 100 300 1 3
    shuffleLinks $
        rm & rmPmnts
            .~ [ mntLS iShape (V2 50 0) (V3 50 10 90)
               , mntLS iShape (V2 50 300) (V3 50 290 90)
               , mntLS iShape (V2 0 150) (V3 10 150 90)
               , mntLS iShape (V2 100 150) (V3 90 150 90)
               ]
            ++ [sPS (V2 30 y) 0 smallPillar | y <- [50, 90 .. 250]]
            ++ [sPS (V2 70 y) 0 smallPillar | y <- [50, 90 .. 250]]

roomPillars :: RandomGen g => Float -> Float -> Float -> Int -> Int -> State g Room
roomPillars pillarsize w h wn hn = do
    let rm = roomRect w h wn hn
        npillars = length $ filter rpIsOffGrid $ _rmPos rm
        plmnts =
            replicate
                npillars
                ( blockPillar (0.5 * pilw) (0.5 * pilh) & plSpot
                    .~ rprBool
                        ( \rp _ ->
                            rpIsOffGrid rp
                                && null (_rpPlacementUse rp)
                                && notLink (_rpType rp)
                        )
                )
    addGirderLights $
        rm
            & cleatSide
            & rmPmnts .~ (testchasm : plmnts)
            & rmName .~ "rectPillars"
  where
    pilw = ((w - 40 * (fromIntegral wn + 1)) / fromIntegral wn) - pillarsize
    pilh = ((h - 40 * (fromIntegral hn + 1)) / fromIntegral hn) - pillarsize
    testchasm = Placement (PS 0 0) (PutChasm (map (+V2 50 120) (rectWH 50 25))) Nothing Nothing
        (\_ _ -> Nothing)