module Dodge.Placement.Instance.Wall
    where
import Dodge.Data
import Color
import Geometry
import Dodge.LevelGen.Data
import Dodge.Default.Wall

import Data.List
import Control.Lens
singleBlock :: Point2 -> [Placement]
singleBlock a = 
    [sPS a 0 
        $ PutBlock [5,20,20] (greyN 0.5)
        $ reverse 
        $ rectNSWE 10 (-10) (-10) 10
    ]
{-
Places a line of blocks between two points.
Width 9, also extends out from each point by 9.
 -}
blockLine :: Point2 -> Point2 -> Placement
blockLine a b = sps0 $ PutLineBlock baseBlockPane 9 9 a b

{-
Places an breakable window between two points.
Width 8, also extends out from each point by 8.
 -}
windowLine :: Point2 -> Point2 -> Placement
windowLine a b = sps0 $ PutLineBlock baseWindowPane 8 8 a b
{-
Places an unbreakable window between two points.
Width 7, also extends out from each point by 7.
 -}
crystalLine :: Point2 -> Point2 -> Placement
crystalLine a b = sps0 $ PutWall ps defaultCrystalWall
  where
    ps = 
        [ a +.+ left +.+ up
        , (a +.+ left) -.- up
        , (b -.- left) -.- up
        , (b -.- left) +.+ up
        ]
    left = 7 *.* normalizeV (a-.-b)
    up   = vNormal left
{- Places an unbreakable wall between two points.
Depth 15, does not extend wider than points.
 -}
wallLine :: Point2 -> Point2 -> Placement
wallLine a b = sps0 $ PutWall ps defaultWall
  where
    ps = [ a  +.+ up
        , a  -.- up
        , b  -.- up
        , b  +.+ up
        ]
    left = 15 *.* normalizeV (a-.-b)
    up   = vNormal left

windowLineType :: Point2 -> Point2 -> PSType
windowLineType = PutLineBlock baseWindowPane 8 8

baseBlockPane :: Wall
baseBlockPane = defaultWall
    { _wlLine = (V2 0 0,V2 50 0)
    , _wlID = 0
    , _wlColor = greyN 0.5
    , _wlSeen = False
    , _wlOpacity = Opaque
    , _wlDraw = True
    , _wlFireThrough = True
    }
baseWindowPane :: Wall
baseWindowPane = defaultWall
    { _wlLine = (V2 0 0,V2 50 0)
    , _wlID = 0
    , _wlColor = withAlpha 0.2 cyan
    , _wlSeen = False
    , _wlOpacity = SeeThrough
    , _wlDraw = True
    , _wlFireThrough = True
    }
-- TODO find home for this
{- Replaces instances of a given 'PutID' with 'PSType's drawn from a list.  -}
replacePutID 
    :: Int      -- ^ The id of 'PutID' to be replaced
    -> [PSType] -- ^ List of replacements
    -> Room 
    -> Room
replacePutID i psts r =
    r & rmPmnts %~ flip (subZipWith (isPutID i) (\ps pt -> ps & plType .~ pt)) psts
{- Partition a list by a predicate, apply a zip to those elements 
that satisfy the predicate, concatenate 
the new zipped list and the other (unchanged) half.  -}
subZipWith 
    :: (a -> Bool)      -- ^ Filter: elements to apply zip to
    -> (a -> b -> a)    -- ^ Combining function
    -> [a]              -- ^ List to be partitioned
    -> [b]              -- ^ Modifying list
    -> [a]
subZipWith f g xs ys =
    let (zs,ws) = partition f xs
    in  zipWith g zs ys ++ ws

isPutID :: Int -> Placement -> Bool
isPutID i ps = Just i == ps ^? plType . putID

putBlockRect :: Float -> Float -> Float -> Float -> [Placement]
putBlockRect a x b y =
    [ blockLine (V2 a b) (V2 a y)
    , blockLine (V2 a y) (V2 x y)
    , blockLine (V2 x y) (V2 x b)
    , blockLine (V2 x b) (V2 a b)
    ]
putBlockV :: Float -> Float -> Float -> Float -> [Placement]
putBlockV a x b y = 
    [ blockLine (V2 a b) (V2 a y)
    , blockLine (V2 x b) (V2 a b)
    ]
putBlockC :: Float -> Float -> Float -> Float -> [Placement]
putBlockC a x b y = 
    [ blockLine (V2 a b) (V2 a y)
    , blockLine (V2 x b) (V2 a b)
    , blockLine (V2 a y) (V2 x y)
    ]
putBlockN :: Float -> Float -> Float -> Float -> [Placement]
putBlockN a x b y = 
    [ blockLine (V2 a b) (V2 a y)
    , blockLine (V2 x b) (V2 a b)
    , blockLine (V2 x y) (V2 x b)
    ]