90 lines
2.3 KiB
Haskell
90 lines
2.3 KiB
Haskell
module Dodge.Picture.SizeInvariant
|
|
( fixedSizePicClampArrow
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Data.Maybe
|
|
import Dodge.Base.Window
|
|
import Dodge.Data.World
|
|
import Dodge.Data.Config
|
|
import Geometry
|
|
import Picture
|
|
|
|
--fixedSizePicAt ::
|
|
-- Picture ->
|
|
-- Point2 ->
|
|
-- Camera ->
|
|
-- Picture
|
|
--fixedSizePicAt pic p w =
|
|
-- setLayer DebugLayer
|
|
-- . setDepth 20
|
|
-- . translate x y
|
|
-- . scale theScale theScale
|
|
-- $ pic
|
|
-- where
|
|
-- campos = w ^. camViewFrom
|
|
-- v = p -.- campos
|
|
-- theScale = 1 / (w ^. camZoom)
|
|
-- (V2 x y) = campos +.+ v
|
|
|
|
--fixedSizePicClamp ::
|
|
-- -- | horizontal border
|
|
-- Int ->
|
|
-- -- | vertical border
|
|
-- Int ->
|
|
-- Picture ->
|
|
-- Point2 ->
|
|
-- Config ->
|
|
-- Camera ->
|
|
-- Picture
|
|
--fixedSizePicClamp xbord ybord pic p cfig w =
|
|
-- setLayer DebugLayer
|
|
-- . setDepth 20
|
|
-- . translate x y
|
|
-- . scale theScale theScale
|
|
-- $ pic
|
|
-- where
|
|
-- r = negate $ w ^. camRot
|
|
-- z = w ^. camZoom
|
|
-- campos = w ^. camViewFrom
|
|
-- v = p -.- campos
|
|
-- theScale = 1 / (w ^. camZoom)
|
|
-- (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 ::
|
|
-- | horizontal border
|
|
Float ->
|
|
-- | vertical border
|
|
Float ->
|
|
Picture ->
|
|
Point2 ->
|
|
Config ->
|
|
World ->
|
|
Picture
|
|
fixedSizePicClampArrow xbord ybord pic p cfig w =
|
|
fold
|
|
[ setLayer DebugLayer . translate x y . scale theScale theScale $ pic
|
|
, setLayer DebugLayer . color white . setDepth 20 $ arrowPic
|
|
]
|
|
where
|
|
winps = screenPolygon cfig (w ^. wCam)
|
|
bords = screenPolygonBord xbord ybord cfig (w ^. wCam)
|
|
borderPoint = intersectSegPolyFirst campos p bords
|
|
windowPoint = intersectSegPolyFirst campos p winps
|
|
arrowPic = case borderPoint of
|
|
Nothing -> mempty
|
|
Just bp -> thickLine 5 [bp, fromMaybe p windowPoint]
|
|
(V2 x y) = fromMaybe p borderPoint
|
|
campos = w ^. wCam . camCenter
|
|
theScale = 1 / (w ^. wCam . camZoom)
|
|
|
|
--absClamp ::
|
|
-- -- | clamping value, assumed positive
|
|
-- Float ->
|
|
-- Float ->
|
|
-- Float
|
|
--absClamp maxVal = max (negate maxVal) . min maxVal
|