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

import Data.List
import Control.Lens

heightWallPS :: PlacementSpot -> Float -> [Point2] -> Placement
heightWallPS spot h ps = psj spot (PutShape . colorSH col $ upperPrismPoly h ps)
    $ sps spot $ PutWall ps theWall
  where
    col = _wlColor defaultWall
    theWall = defaultWall
        { _wlOpacity = SeeAbove
        , _wlDraw = False
        , _wlHeight = h
        }

heightWall :: Float -> [Point2] -> Placement
heightWall h ps = ps0j (PutShape . colorSH col $ upperPrismPoly h ps)
    $ sps0 $ PutWall ps theWall
  where
    col = _wlColor defaultWall
    theWall = defaultWall
        { _wlOpacity = SeeAbove
        , _wlDraw = False
        , _wlHeight = h
        }

midWall :: [Point2] -> Placement
midWall ps = ps0j (PutShape . colorSH col $ upperPrismPoly 50 ps)
    $ sps0 $ PutWall ps theWall
  where
    col = _wlColor defaultWall
    theWall = defaultWall
        { _wlOpacity = SeeAbove
        , _wlDraw = False
        , _wlHeight = 50
        }


singleBlock :: Point2 -> [Placement]
singleBlock a = 
    [sPS a 0 
        $ PutBlock StoneBlock 5 [20,20] baseBlockPane
        $ reverse 
        $ square 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 StoneBlock 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 GlassBlock 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 GlassBlock 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
    }
dirtWall :: Wall
dirtWall = defaultWall
    { _wlLine = (V2 0 0,V2 50 0)
    , _wlID = 0
    , _wlColor = V4 (150/256) ( 75/256)  0 ( 250/256)
    , _wlSeen = False
    , _wlOpacity = Opaque
    , _wlRotateTo = False
    , _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)
    ]