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

Commit before tree representation of picture

Browse Source
This commit is contained in:
jgk
2021-02-16 00:00:49 +01:00
parent e8b4f8791b
commit c7aa5f707e
2 changed files with 56 additions and 20 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Rendering.hs
+7 -8
View File
@@ -81,9 +81,9 @@ collectDrawings :: World -> Picture
collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts
<> crPicts <> crPicts
<> clPicts <> clPicts
<> buttonPicts <> ptPicts <> buttonPicts <> ptPicts
<> ptPicts' <> ptPicts'
<> afterPtPicts' <> afterPtPicts'
<> wlPicts <> wlPicts
<> wallShadows <> wallShadows
<> smokeShadows <> smokeShadows
@@ -96,7 +96,6 @@ collectDrawings w = screenShift (decPicts <> ppPicts <> itFloorPicts
where where
screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) ) screenShift = scale zoom zoom . rotate (radToDeg (_cameraRot w) )
. uncurry translate ((0,0) -.- _cameraPos w) . uncurry translate ((0,0) -.- _cameraPos w)
rotPicts = map (scale zoom zoom . rotate (radToDeg (_cameraRot w)))
zoom = _cameraZoom w zoom = _cameraZoom w
decPicts :: Picture decPicts :: Picture
decPicts = mconcat $ IM.elems $ _decorations w decPicts = mconcat $ IM.elems $ _decorations w
@@ -152,14 +151,14 @@ hudDrawings w = (onLayer InvLayer)
where itCol = fromMaybe (greyN 0.5) . (^? itInvColor) where itCol = fromMaybe (greyN 0.5) . (^? itInvColor)
crDraw :: Creature -> Drawing crDraw :: Creature -> Drawing
crDraw c = uncurry translateDrawing (_crPos c) $ rotateDrawing (- radToDeg (_crDir c)) (_crPict c c) crDraw c = uncurry translate (_crPos c) $ rotateRad (_crDir c) (_crPict c c)
ppDraw :: PressPlate -> Drawing ppDraw :: PressPlate -> Drawing
ppDraw c = uncurry translateDrawing (_ppPos c) $ rotateDrawing (- radToDeg (_ppRot c)) (_ppPict c) ppDraw c = uncurry translate (_ppPos c) $ rotateRad (_ppRot c) (_ppPict c)
btDraw :: Button -> Drawing btDraw :: Button -> Drawing
btDraw c = uncurry translateDrawing (_btPos c) $ rotateDrawing (- radToDeg (_btRot c)) (_btPict c) btDraw c = uncurry translate (_btPos c) $ rotateRad (_btRot c) (_btPict c)
clDraw :: Cloud -> Drawing clDraw :: Cloud -> Drawing
clDraw c = uncurry translateDrawing (_clPos c) $ (_clPict c c) clDraw c = uncurry translate (_clPos c) $ (_clPict c c)
drawCursor :: World -> Picture drawCursor :: World -> Picture
drawCursor w = translate (105-halfWidth w) drawCursor w = translate (105-halfWidth w)
src/Picture/Data.hs
+49 -12
View File
@@ -3,6 +3,8 @@
module Picture.Data module Picture.Data
where where
import Data.Monoid import Data.Monoid
import qualified Data.Foldable as F
import qualified Data.Sequence as Se
import qualified Data.DList as DL import qualified Data.DList as DL
import qualified Data.Vector as V import qualified Data.Vector as V
import Geometry.Data import Geometry.Data
@@ -13,25 +15,60 @@ type RGBA = (Float,Float,Float,Float)
type Color = (Float,Float,Float,Float) type Color = (Float,Float,Float,Float)
type VerticesContainer a = Se.Seq a
toVC = Se.fromList
fromVC :: VerticesContainer a -> [a]
fromVC = F.toList
--type VerticesContainer a = DL.DList a --type VerticesContainer a = DL.DList a
--toVC = DL.fromList --toVC = DL.fromList
--fromVC = DL.toList --fromVC = DL.toList
type VerticesContainer a = [a] --type VerticesContainer a = [a]
toVC = id --toVC = id
fromVC = id --fromVC = id
mapVC :: (a -> b) -> VerticesContainer a -> VerticesContainer b mapVC :: (a -> b) -> VerticesContainer a -> VerticesContainer b
mapVC = fmap mapVC = fmap
data Shape = Shape data NTree a b
{ _shPos :: VerticesContainer Point3 = NBranch a [NTree a b]
, _shCol :: VerticesContainer RGBA | NLeaf b
}
combineShapes :: Shape -> Shape -> Shape reduceNTree :: NTree (a -> a) a -> NTree () a
combineShapes sa sb = Shape reduceNTree = reduceNTree' id
{ _shPos = _shPos sa <> _shPos sb where
, _shCol = _shCol sa <> _shCol sb reduceNTree' :: (b -> b) -> NTree (b -> b) b -> NTree () b
} reduceNTree' f (NBranch g xs) = NBranch () $ map (reduceNTree' (f . g)) xs
reduceNTree' f (NLeaf x) = NLeaf $ f x
concatLeaves :: NTree a b -> DL.DList b
concatLeaves (NLeaf x) = DL.singleton x
concatLeaves (NBranch _ xs) = mconcat (map concatLeaves xs)
--reduceShapeTree :: (Shape -> Shape) -> ShapeTree -> [Shape]
--reduceShapeTree
-- (TransformShape f xs) = map (f . reduceShapeTree) xs
--reduceShapeTree
-- (Leaf s) = [s]
data ShapeTree
= TransformShape (Shape -> Shape) [ShapeTree]
| Leaf Shape
data Shape
= Shape
{ _shPos :: VerticesContainer Point3
, _shCol :: VerticesContainer RGBA
}
| TextShape
{ _shPos :: VerticesContainer Point3
, _shCol :: VerticesContainer RGBA
, _shTex :: VerticesContainer Point2
}
--combineShapes :: Shape -> Shape -> Shape
--combineShapes sa sb = Shape
-- { _shPos = _shPos sa <> _shPos sb
-- , _shCol = _shCol sa <> _shCol sb
-- }
data Picture = Scene data Picture = Scene
{ _scPosTri :: VerticesContainer Point3 { _scPosTri :: VerticesContainer Point3