diff --git a/src/Dodge/Bounds.hs b/src/Dodge/Bounds.hs new file mode 100644 index 000000000..9fd32b850 --- /dev/null +++ b/src/Dodge/Bounds.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE TemplateHaskell #-} +{-# LANGUAGE StrictData #-} +module Dodge.Bounds + where +import Control.Lens + +data Bounds = Bounds + { _bdMinX :: Float + , _bdMaxX :: Float + , _bdMinY :: Float + , _bdMaxY :: Float + } +defaultBounds :: Bounds +defaultBounds = Bounds 0 0 0 0 + +makeLenses ''Bounds diff --git a/src/Dodge/Picture/SizeInvariant.hs b/src/Dodge/Picture/SizeInvariant.hs new file mode 100644 index 000000000..5a1f10ea8 --- /dev/null +++ b/src/Dodge/Picture/SizeInvariant.hs @@ -0,0 +1,79 @@ +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 4 + . setDepth 50 + . 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 + -> World + -> Picture +fixedSizePicClamp xbord ybord pic p w + = setLayer 4 +-- . setDepth 50 + . 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 w - fromIntegral xbord) / z) xr + yr' = absClamp ((halfHeight w - fromIntegral ybord) / z) yr + +fixedSizePicClampArrow + :: Float -- ^ horizontal border + -> Float -- ^ vertical border + -> Picture + -> Point2 + -> World + -> Picture +fixedSizePicClampArrow xbord ybord pic p w = pictures + [ setLayer 4 . translate x y . scale theScale theScale $ pic + , setLayer 4 . color white . setDepth 20 $ arrowPic + ] + where + winps = screenPolygon w + bords = screenPolygonBord xbord ybord w + borderPoint = intersectSegPolyFirst campos p bords + windowPoint = intersectSegPolyFirst campos p winps + arrowPic = case borderPoint of + Nothing -> blank + Just bp -> thickLine [bp, fromMaybe p windowPoint] 5 + (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