module Dodge.Picture.SizeInvariant 
    where
import Dodge.Data
--import Dodge.Base
import Dodge.Base.Window
import Geometry
import Picture

import Data.Maybe

fixedSizePicAt
    :: Picture
    -> Point2
    -> World
    -> Picture
fixedSizePicAt pic p w 
    = setLayer DebugLayer 
    . setDepth 20 
    . translate x y 
    . scale theScale theScale 
    $ pic 
  where
    campos = _cameraViewFrom w
    v = p -.- campos
    theScale = 1 / _cameraZoom w
    (V2 x y) = campos +.+ v

fixedSizePicClamp
    :: Int      -- ^ horizontal border
    -> Int      -- ^ vertical border
    -> Picture
    -> Point2
    -> Configuration
    -> World
    -> Picture
fixedSizePicClamp xbord ybord pic p cfig w
    = setLayer DebugLayer 
    . setDepth 20
    . translate x y 
    . scale theScale theScale 
    $ pic 
  where
    r = negate $ _cameraRot w
    z = _cameraZoom w
    campos = _cameraViewFrom w
    v = p -.- campos
    theScale = 1 / _cameraZoom w
    (V2 x y) = campos +.+ rotateV (negate r) (V2 xr' yr')
    (V2 xr yr) = rotateV r v
    xr' = absClamp ((halfWidth cfig  - fromIntegral xbord) / z) xr
    yr' = absClamp ((halfHeight cfig - fromIntegral ybord) / z) yr

fixedSizePicClampArrow
    :: Float    -- ^ horizontal border
    -> Float    -- ^ vertical border
    -> Picture
    -> Point2
    -> Configuration
    -> World
    -> Picture
fixedSizePicClampArrow xbord ybord pic p cfig w = pictures 
    [ setLayer DebugLayer . translate x y . scale theScale theScale $ pic 
    , setLayer DebugLayer . color white . setDepth 20 $ arrowPic
    ]
  where
    winps = screenPolygon cfig w
    bords = screenPolygonBord xbord ybord cfig w
    borderPoint = intersectSegPolyFirst campos p bords
    windowPoint = intersectSegPolyFirst campos p winps
    arrowPic = case borderPoint of
        Nothing -> blank
        Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
    (V2 x y) = fromMaybe p borderPoint
    campos = _cameraCenter w
    theScale = 1 / _cameraZoom w

absClamp 
    :: Float -- ^ clamping value, assumed positive
    -> Float 
    -> Float
absClamp maxVal x = max (negate maxVal) $ min maxVal x
