justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Further strictifying

Browse Source
This commit is contained in:
justin
2021-07-30 00:23:02 +02:00
parent bd8ef3f416
commit 2d8b27746c
33 changed files with 228 additions and 211 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Render/Picture.hs
+16 -16
View File
@@ -50,9 +50,9 @@ fixedCoordPictures w = case _menuLayers w of
customMouseCursor :: World -> Picture
customMouseCursor w =
scale (2 /getWindowX w) (2/ getWindowY w)
. uncurry translate (_mousePos w)
. uncurryV translate (_mousePos w)
. color white
$ pictures [ line [(-5,0),(5,0)] , line [(0,-5),(0,5)] ]
$ pictures [ line [(V2 (-5) (0)),(V2 5 0)] , line [(V2 (0) (-5)),(V2 0 5)] ]
testPic :: World -> Picture
testPic _ = blank
@@ -63,12 +63,12 @@ testPic _ = blank
crDraw :: World -> Creature -> Picture
crDraw w c = _crPict c c w
ppDraw :: PressPlate -> Picture
ppDraw c = uncurry translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
ppDraw c = uncurryV translate (_ppPos c) $ rotate (_ppRot c) (_ppPict c)
btDraw :: Button -> Picture
btDraw c = uncurry translate (_btPos c) $ rotate (_btRot c) (_btPict c)
btDraw c = uncurryV translate (_btPos c) $ rotate (_btRot c) (_btPict c)
clDraw :: Cloud -> Picture
clDraw c = uncurry translate (_clPos c) (_clPict c c)
clDraw c = uncurryV translate (_clPos c) (_clPict c c)
wallFloorsToDraw :: World -> [Wall]
wallFloorsToDraw w = filter isVisible $ IM.elems $ wallsOnScreen w
@@ -88,15 +88,15 @@ drawWallFloor wl = if _wlIsSeeThrough wl
n2 = 15 *.* (vNormal . errorNormalizeVDR $ y -.- x)
errorNormalizeVDR :: Point2 -> Point2
errorNormalizeVDR (0,0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
errorNormalizeVDR (V2 0 0) = error "problem with function: errorNormalizeVDR in DodgeRendering"
errorNormalizeVDR p = normalizeV p
printPoint :: Point2 -> Picture
printPoint p = color white $ uncurry translate p $ pictures [circle 3 ,scale 0.05 0.05 $ text (show p)]
printPoint p = color white $ uncurryV translate p $ pictures [circle 3 ,scale 0.05 0.05 $ text (show p)]
printRotPoint :: Float -> Point2 -> Picture
printRotPoint r p = color white
. uncurry translate p
. uncurryV translate p
$ pictures [circle 3 , rotate (negate r) $ scale 0.1 0.1 $ text (show p)]
outsideScreenPolygon :: World -> [Point2]
@@ -106,10 +106,10 @@ outsideScreenPolygon w = [tr,tl,bl,br]
scZoom p | _cameraZoom w /= 0 = (1/_cameraZoom w) *.* p
| otherwise = error "Trying to set screen zoom to zero"
scTran p = p +.+ _cameraCenter w
tr = scTran $ scRot $ scZoom ( 3*halfWidth w , 3* halfHeight w)
tl = scTran $ scRot $ scZoom (- (3*halfWidth w), 3* halfHeight w)
br = scTran $ scRot $ scZoom ( 3*halfWidth w ,- (3* halfHeight w))
bl = scTran $ scRot $ scZoom (- (3*halfWidth w),- (3* halfHeight w))
tr = scTran $ scRot $ scZoom $ V2 ( 3*halfWidth w ) ( 3* halfHeight w)
tl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) ( 3* halfHeight w)
br = scTran $ scRot $ scZoom $ V2 ( 3*halfWidth w ) (- (3* halfHeight w))
bl = scTran $ scRot $ scZoom $ V2 (- (3*halfWidth w)) (- (3* halfHeight w))
wallShadowsToDraw :: World -> [Wall]
wallShadowsToDraw w = filter (fromMaybe True . (^? blVisible))
@@ -163,10 +163,10 @@ extendConeToScreenEdge w c (x,y) = orderPolygon $ wallScreenIntersect ++ [x,y] +
. makeLoopPairs $ screenPolygon w
rectangleSolid :: Float -> Float -> Picture
rectangleSolid x y = polygon [(x,y),(x,-y),(-x,-y),(-x,y)]
rectangleSolid x y = polygon $ map toV2 [(x,y),(x,-y),(-x,-y),(-x,y)]
drawItem :: FloorItem -> Picture
drawItem flit = uncurry translate (_flItPos flit)
drawItem flit = uncurryV translate (_flItPos flit)
$ rotate (_flItRot flit) (_itFloorPict (_flIt flit))
@@ -212,14 +212,14 @@ wallsAndWindows w
(wins,wls) = partition _wlIsSeeThrough . IM.elems $ wallsDoubleScreen w
wallsToList :: [((Point2,Point2),Point4)] -> [Float]
wallsToList = concatMap (\(((a,b),(c,d)),(e,f,g,h)) -> [a,b,c,d,e,f,g,h])
wallsToList = concatMap (\(((V2 a b),(V2 c d)),(V4 e f g h)) -> [a,b,c,d,e,f,g,h])
pokeWalls :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
pokeWalls ptr vals0 = go vals0 0
where
go [] n = return n
go ( (((a,b),(c,d)),(e,f,g,h)):vals) n = do
go ( (((V2 a b),(V2 c d)),(V4 e f g h)):vals) n = do
pokeElemOff ptr (off 0) a
pokeElemOff ptr (off 1) b
pokeElemOff ptr (off 2) c