diff --git a/src/Dodge/Base/Window.hs b/src/Dodge/Base/Window.hs index 3e079183f..8b6ec0695 100644 --- a/src/Dodge/Base/Window.hs +++ b/src/Dodge/Base/Window.hs @@ -5,6 +5,7 @@ import Dodge.Data import Dodge.Config.Data import Geometry +-- | A box covering the screen in world coordinates screenPolygon :: World -> [Point2] screenPolygon w = [tr,tl,bl,br] where @@ -17,9 +18,36 @@ screenPolygon w = [tr,tl,bl,br] br = scTran $ scRot $ scZoom (V2 ( halfWidth w) (-halfHeight w)) bl = scTran $ scRot $ scZoom (V2 (-halfWidth w) (-halfHeight w)) +-- | A box covering the screen in world coordinates, with a x and y border +screenPolygonBord + :: Float -- ^ X border + -> Float -- ^ Y border + -> World + -> [Point2] +screenPolygonBord xbord ybord w = [tr,tl,bl,br] + where + hw = halfWidth w - xbord + hh = halfHeight w - ybord + scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p + | otherwise = p + theTransform = (+.+ _cameraCenter w) . rotateV (_cameraRot w) . scZoom + tr = theTransform (V2 hw hh ) + tl = theTransform (V2 (-hw) hh ) + br = theTransform (V2 hw (-hh)) + bl = theTransform (V2 (-hw) (-hh)) + halfWidth,halfHeight :: World -> Float halfWidth w = getWindowX w / 2 halfHeight w = getWindowY w / 2 getWindowX ,getWindowY :: World -> Float getWindowX = _windowX . _config getWindowY = _windowY . _config + +-- | A box of the size of the screen in screen centered coordinates +screenBox + :: World + -> [Point2] +screenBox w = rectNSEW hh (-hh) hw (-hw) + where + hw = halfWidth w + hh = halfHeight w diff --git a/src/Dodge/Menu.hs b/src/Dodge/Menu.hs index 7a7812fc8..26b5e3920 100644 --- a/src/Dodge/Menu.hs +++ b/src/Dodge/Menu.hs @@ -12,7 +12,7 @@ import Preload.Update import Dodge.Base.Window import Dodge.SoundLogic import Picture -import Geometry +--import Geometry import Control.Lens import Data.Maybe @@ -193,10 +193,3 @@ controlsList = pictures $ concat $ zipWith butAndEff ,translate 0 y $ scale 0.15 0.15 $ color white $ text etext ] -screenBox - :: World - -> [Point2] -screenBox w = rectNSEW hh (-hh) hw (-hw) - where - hw = halfWidth w - hh = halfHeight w diff --git a/src/Dodge/Render/Picture.hs b/src/Dodge/Render/Picture.hs index b61dfc777..06200dacb 100644 --- a/src/Dodge/Render/Picture.hs +++ b/src/Dodge/Render/Picture.hs @@ -6,6 +6,7 @@ import Dodge.Base import Dodge.Base.Window import Dodge.Base.Zone import Dodge.Picture +import Dodge.Picture.SizeInvariant import Dodge.Picture.Layer import Dodge.Render.HUD import Dodge.Render.MenuScreen @@ -18,6 +19,7 @@ import Control.Lens import Data.Maybe import Data.List (partition) import qualified Data.IntMap.Lazy as IM +import qualified Data.Map as M worldPictures :: World -> Picture worldPictures w = pictures @@ -59,9 +61,24 @@ customMouseCursor w = $ pictures [ line [V2 (-5) 0,V2 5 0] , line [V2 0 (-5),V2 0 5] ] testPic :: World -> Picture -testPic _ = blank +testPic w = pictures + [ soundPics w +-- , fixedSizePicClampArrow 10 50 thepic (mouseWorldPos w) w + ] +-- where +-- thepic = setDepth 20 . color green . polygon $ rectNSEW 5 (-5) (-5) (5) +--testPic _ = blank --testPic w = color green . pictures . map (flip thickLine 5 . tflat2) . graphToEdges $ _pathGraph w +soundPics :: World -> Picture +soundPics w = pictures $ M.map (soundPic w) $ _playingSounds w + +soundPic :: World -> Sound -> Picture +soundPic w s = fixedSizePicClampArrow 50 50 thePic p w + where + p = _soundPos s + thePic = scale 0.15 0.15 $ text "SOUND" + crDraw :: World -> Creature -> Picture crDraw w c = _crPict c c w ppDraw :: PressPlate -> Picture diff --git a/src/Geometry/Intersect.hs b/src/Geometry/Intersect.hs index 7221ccf63..97cf88b20 100644 --- a/src/Geometry/Intersect.hs +++ b/src/Geometry/Intersect.hs @@ -178,3 +178,11 @@ intersectSegsSeg = undefined -- | Placeholder: should intersect a segment with a bezier curve. intersectSegBezquad :: Point2 -> Point2 -> Point2 -> Point2 -> Point2 -> [Point2] intersectSegBezquad = undefined + +-- | finds one (if any) of the points of intersection between a segment and a +-- polygon. +-- Can almost certainly be optimised. +intersectSegPolyFirst :: Point2 -> Point2 -> [Point2] -> Maybe Point2 +intersectSegPolyFirst a b xs = foldr (<|>) Nothing $ zipWith lineColl xs (tail xs ++ [head xs]) + where + lineColl = intersectSegSeg a b