module Dodge.Placements.LightSource
    where
import Dodge.Data
import Dodge.LightSources.Lamp
import Dodge.LevelGen.Data
import Dodge.Room.Foreground
import Dodge.Placements.Spot
import Geometry
import Dodge.Creature.Inanimate
import Shape.Data
import Dodge.Default
import Dodge.RandomHelp 
import Color
import Shape

mountLightOnShape
    :: (Point2 -> Point3 -> Shape) -- ^ function describing the mount shape
    -> Maybe Color  -- ^ describing a possible color override for the shape
    -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightOnShape shapeF mcol ls wallp lsp = ps0j (PutForeground . setCol $ shapeF wallp lsp)
    . ps0 (PutLS $ ls {_lsPos = lsp})
  where
    setCol = case mcol of
        Just col -> colorSH col
        Nothing  -> id

mountLightID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightID = mountLightOnShape f 
  where
    f wp (V3 x y z) = thinHighBar (z+5) wp pout
      where
        pout = V2 x y +.+ safeNormalizeV (V2 x y -.- wp)

redMID :: (Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement)
    -> Point2 -> Point3 -> Placement
redMID f wallp lampp = f Nothing defaultLS wallp lampp (const Nothing)

mountLight :: Point2 -> Point3 -> Placement
mountLight = redMID mountLightID

mountLightLID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightLID = mountLightOnShape f
  where
    f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
            <> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)    
      where
        n = vNormal (wallpos -.- V2 x y)
        wallposUp = wallpos +.+ n
        turnpos = V2 x y +.+ n

mountLightL :: Point2 -> Point3 -> Placement
mountLightL = redMID mountLightLID

mountLightJID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightJID = mountLightOnShape f
  where
    f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp turn1
        <> thinHighBar (z + 5) turn1 turn2
        <> thinHighBar (z + 5) turn2 (endpos `extendAway` turn2)
      where
        n = vNormal (wallpos -.- V2 x y)
        wallposUp = wallpos +.+ n
        turnpos = V2 x y +.+ n
        endpos = V2 x y
        turn1 = 0.5 *.* (wallposUp +.+ turnpos)
        turn2 = 0.5 *.* (turnpos +.+ endpos)

mountLightJ :: Point2 -> Point3 -> Placement
mountLightJ = redMID mountLightJID

mountLightlID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightlID = mountLightOnShape f
  where
    f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (turnpos `extendAway` wallposUp)
        <> thinHighBar (z + 5) turnpos (V2 x y `extendAway` turnpos)
      where
        n = vNormal (V2 x y -.- wallpos)
        wallposUp = wallpos +.+ n
        turnpos = V2 x y +.+ n

mountLightll :: Point2 -> Point3 -> Placement
mountLightll = redMID mountLightlID

mountLightAID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightAID = mountLightOnShape f
  where
    f wallpos (V3 x y z) = girder (z+10) 20 10 pout wallpos
      where
        pout = V2 x y -.- 2 *.* safeNormalizeV (V2 x y -.- wallpos)

mountLightA :: Point2 -> Point3 -> Placement
mountLightA = redMID mountLightAID

mountLightACond :: ((Point2,Float) -> Bool) -> Placement
mountLightACond f = updatePSToLevel 2 (const thePS) $ mountLightA 0 (V3 0 (-40) 40)
  where
    thePS = PSLnk f (\(p,a)->(p,a))

mountLightVCond :: ((Point2,Float) -> Bool) -> Placement
mountLightVCond f = updatePSToLevel 2 (const thePS) $ mountLightV 0 (V3 0 (-20) 40)
  where
    thePS = PSLnk f id

mntLightCond :: ((Point2,Float) -> Bool) -> Placement
mntLightCond f = RandomPlacement $ takeOne [mountLightVCond f,mountLightACond f]

mountLightVID :: Maybe Color -> LightSource -> Point2 -> Point3 -> (Int -> Maybe Placement) -> Placement
mountLightVID = mountLightOnShape f
  where
    f wallpos (V3 x y z) = thinHighBar (z + 5) wallposUp (lxy `extendAway` wallposUp)
        <> thinHighBar (z + 5) wallposDown (lxy `extendAway` wallposDown)
      where
        lxy = V2 x y
        n = vNormal (wallpos -.- lxy)
        wallposUp = wallpos +.+ n
        wallposDown = wallpos -.- n

mountLightV :: Point2 -> Point3 -> Placement
mountLightV = redMID mountLightVID

spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y h) 0)
    $ sps0 $ PutForeground $ highPipe (h + 5) a b
  where
    V2 x y = 0.5 *.* (a +.+ b)

spanLightI :: Float -> Point2 -> Point2 -> Placement
spanLightI = spanColLightI 0.75

extendAway :: Point2 -> Point2 -> Point2
extendAway p x = p +.+ safeNormalizeV (p -.- x)

putColorLamp :: Point3 -> PSType
putColorLamp col = PutCrit (colorLamp col 90)

putLamp :: PSType
putLamp = PutCrit (lamp 90)