From 03b37c4e7b9e18dbd6afaa152aed6f14fb63bfdc Mon Sep 17 00:00:00 2001 From: justin Date: Mon, 27 Jun 2022 18:41:43 +0100 Subject: [PATCH] Revert "Turn Shape into a stream" This reverts commit c7e720248dcf9b4c02bbf5faf3344d6b8271a1eb. --- src/Dodge/Creature/HandPos.hs | 2 +- src/Dodge/Item/Equipment/Shape.hs | 2 +- src/Dodge/Item/Weapon/BatteryGuns.hs | 2 +- src/Dodge/Item/Weapon/BulletGun/Cane.hs | 4 +--- src/Dodge/Item/Weapon/Shatter.hs | 2 +- src/Dodge/Item/Weapon/SprayGuns.hs | 2 +- src/Dodge/Room/Foreground.hs | 6 ++--- src/Shader/Poke.hs | 5 +++-- src/Shape.hs | 10 ++++----- src/Shape/Data.hs | 9 ++------ src/ShapePicture.hs | 30 +++++++++++-------------- 11 files changed, 32 insertions(+), 42 deletions(-) diff --git a/src/Dodge/Creature/HandPos.hs b/src/Dodge/Creature/HandPos.hs index 419731b2c..7497664dd 100644 --- a/src/Dodge/Creature/HandPos.hs +++ b/src/Dodge/Creature/HandPos.hs @@ -43,7 +43,7 @@ translatePointToRightHand' cr f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen translateToRightHand :: Creature -> SPic -> SPic -translateToRightHand cr = translateToRightHand' cr -- . mirrorSPxz +translateToRightHand cr = translateToRightHand' cr . mirrorSPxz translateToRightHand' :: Creature -> SPic -> SPic translateToRightHand' cr diff --git a/src/Dodge/Item/Equipment/Shape.hs b/src/Dodge/Item/Equipment/Shape.hs index 8a29ff214..0c6267a20 100644 --- a/src/Dodge/Item/Equipment/Shape.hs +++ b/src/Dodge/Item/Equipment/Shape.hs @@ -23,7 +23,7 @@ equipPosition epos cr sh = case epos of OnLeftWrist -> translateToLeftHand cr sh OnRightWrist -> translateToRightHand cr sh OnLegs -> translateToLeftLeg cr sh <> - translateToRightLeg cr sh --(mirrorSPxz sh) + translateToRightLeg cr (mirrorSPxz sh) OnHead -> translateToHead cr sh OnChest -> translateToChest cr sh _ -> sh diff --git a/src/Dodge/Item/Weapon/BatteryGuns.hs b/src/Dodge/Item/Weapon/BatteryGuns.hs index 7db131418..37e83dab1 100644 --- a/src/Dodge/Item/Weapon/BatteryGuns.hs +++ b/src/Dodge/Item/Weapon/BatteryGuns.hs @@ -99,7 +99,7 @@ teslaGun = defaultBatteryGun teslaGunPic :: Item -> SPic teslaGunPic _ = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb 8 xa 0) - <> upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0) + ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0) where xa = 1 xb = 9 diff --git a/src/Dodge/Item/Weapon/BulletGun/Cane.hs b/src/Dodge/Item/Weapon/BulletGun/Cane.hs index 54c8d2f51..495b552f6 100644 --- a/src/Dodge/Item/Weapon/BulletGun/Cane.hs +++ b/src/Dodge/Item/Weapon/BulletGun/Cane.hs @@ -31,7 +31,6 @@ import Shape import Sound.Data import LensHelp -import qualified Data.Vector.Fusion.Stream.Monadic as VS --import qualified Data.Map.Strict as M --import qualified Data.Sequence as Seq --import Control.Lens @@ -303,8 +302,7 @@ miniGunXPict i spin _ = ) where aBarrel = translateSH (V3 15 2 2) baseCaneShape - barrels = VS.concatMap (\an -> aBarrel & rotateSHx (2*pi * fromIntegral an / fromIntegral i)) - $ VS.fromList [1..i] + barrels = concatMap (\an -> aBarrel & rotateSHx (2*pi * fromIntegral an / fromIntegral i)) [1..i] a = fromIntegral spin / 100 --x = fromIntegral am / 10 -- clip y z = translateSH (V3 0 (-1) z) (rotateSHx (negate $ pi/4) diff --git a/src/Dodge/Item/Weapon/Shatter.hs b/src/Dodge/Item/Weapon/Shatter.hs index 6d424b74d..8a64b8e32 100644 --- a/src/Dodge/Item/Weapon/Shatter.hs +++ b/src/Dodge/Item/Weapon/Shatter.hs @@ -41,7 +41,7 @@ shatterGun = defaultWeapon shatterGunSPic :: Item -> SPic shatterGunSPic _ = noPic $ colorSH blue $ upperPrismPoly 5 (rectNESW xb 8 xa 0) - <> upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0) + ++ upperPrismPoly 5 (rectNESW (-xa) 8 (-xb) 0) where xa = 1 xb = 9 diff --git a/src/Dodge/Item/Weapon/SprayGuns.hs b/src/Dodge/Item/Weapon/SprayGuns.hs index 16f7cfa65..7b70fe3f2 100644 --- a/src/Dodge/Item/Weapon/SprayGuns.hs +++ b/src/Dodge/Item/Weapon/SprayGuns.hs @@ -56,7 +56,7 @@ flamerPic :: Item -> SPic flamerPic it = ( colorSH yellow $ translateSHf tx ty (upperPrismPoly tz $ polyCirc 3 r) - <> upperPrismPoly 5 (rectNESW 2 18 (-2) 0) + ++ upperPrismPoly 5 (rectNESW 2 18 (-2) 0) , color black $ translate3 (V3 tx ty (tz+0.01)) $ circleSolid (r * am) ) where diff --git a/src/Dodge/Room/Foreground.hs b/src/Dodge/Room/Foreground.hs index ac60d5358..6db8339d3 100644 --- a/src/Dodge/Room/Foreground.hs +++ b/src/Dodge/Room/Foreground.hs @@ -5,7 +5,7 @@ import Picture import Geometry import Shape import Quaternion ---import Bound +import Bound --import Dodge.Data.ForegroundShape import Dodge.Default.Foreground @@ -13,8 +13,8 @@ import Data.List import Data.Maybe import Control.Lens import ShapePicture ---import Streaming ---import qualified Streaming.Prelude as S +import Streaming +import qualified Streaming.Prelude as S highDiagonalMesh :: Point2 diff --git a/src/Shader/Poke.hs b/src/Shader/Poke.hs index 827ef172d..a04d76a07 100644 --- a/src/Shader/Poke.hs +++ b/src/Shader/Poke.hs @@ -19,6 +19,7 @@ import qualified Data.Vector.Unboxed as UV import qualified Data.Vector.Unboxed.Mutable as UMV import qualified Data.Vector.Mutable as MV import qualified Data.Vector.Fusion.Stream.Monadic as VS +import Data.Vector.Fusion.Util import Control.Monad.Primitive --import qualified Control.Monad.Parallel as MP @@ -84,9 +85,9 @@ pokeShape :: Ptr Float -> Ptr GLushort -> Ptr GLushort - -> VS.Stream IO ShapeObj + -> [ShapeObj] -> IO (Int,Int,Int) -pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0) +pokeShape ptr iptr ieptr = VS.foldM (pokeShapeObj ptr iptr ieptr) (0,0,0) . VS.fromList pokeShapeObj :: Ptr Float diff --git a/src/Shape.hs b/src/Shape.hs index b540410fa..c453b21ce 100644 --- a/src/Shape.hs +++ b/src/Shape.hs @@ -25,7 +25,7 @@ import qualified Data.Vector.Fusion.Stream.Monadic as VS emptySH :: Shape {-# INLINE emptySH #-} -emptySH = VS.empty +emptySH = mempty -- - approximate a circle by a polygon with n*2 points of radius x polyCirc :: Int -> Float -> [Point2] @@ -45,7 +45,7 @@ prismPoly -> [Point3] -> Shape {-# INLINE prismPoly #-} -prismPoly upps downps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f upps downps) +prismPoly upps downps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)] where n = length upps f (a:as) (b:bs) = g a:g b:f as bs @@ -58,7 +58,7 @@ upperPrismPoly -> [Point2] -> Shape {-# INLINE upperPrismPoly #-} -upperPrismPoly h ps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f ps) +upperPrismPoly h ps = [ShapeObj (TopPrism n) (VS.fromList $ f ps)] where n = length ps g h' (V2 x y) = pairToSV (V3 x y h', black) @@ -70,7 +70,7 @@ upperPrismPolyHalf -> [Point2] -> Shape {-# INLINE upperPrismPolyHalf #-} -upperPrismPolyHalf h ps = VS.singleton $ ShapeObj (TopPrism n) (VS.fromList $ f upps downps) +upperPrismPolyHalf h ps = [ShapeObj (TopPrism n) (VS.fromList $ f upps downps)] where n = length ps upps = map f' ps @@ -94,7 +94,7 @@ overColSH = fmap . overColObj overPosSHI :: (Point3 -> Point3) -> Shape -> Shape {-# INLINE overPosSHI #-} -overPosSHI = VS.map . overPosObj +overPosSHI = fmap . overPosObj translateSH :: Point3 -> Shape -> Shape {-# INLINE translateSH #-} diff --git a/src/Shape/Data.hs b/src/Shape/Data.hs index 0b6772284..01389eb50 100644 --- a/src/Shape/Data.hs +++ b/src/Shape/Data.hs @@ -3,19 +3,14 @@ {-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralisedNewtypeDeriving #-} -{-# LANGUAGE FlexibleInstances #-} module Shape.Data where import Geometry.Data import qualified Data.Vector.Fusion.Stream.Monadic as VS +import Data.Vector.Fusion.Util import Control.Lens -type Shape = VS.Stream IO ShapeObj - -instance Semigroup (VS.Stream IO ShapeObj) where - (<>) = (VS.++) -instance Monoid (VS.Stream IO ShapeObj) where - mempty = VS.empty +type Shape = [ShapeObj] --_shVertices :: Shape -> [ShapeV] --{-# INLINE _shVertices #-} diff --git a/src/ShapePicture.hs b/src/ShapePicture.hs index 5cd93a640..925aa6971 100644 --- a/src/ShapePicture.hs +++ b/src/ShapePicture.hs @@ -1,5 +1,3 @@ -{-# LANGUAGE StrictData #-} -{-# LANGUAGE TemplateHaskell #-} {-# LANGUAGE TupleSections #-} module ShapePicture ( emptyBlank @@ -12,25 +10,23 @@ module ShapePicture , noShape , _spShape , _spPicture --- , mirrorSPyz --- , mirrorSPxz + , mirrorSPyz + , mirrorSPxz ) where import Shape import Picture import Geometry -import qualified Data.Vector.Fusion.Stream.Monadic as VS import Data.Bifunctor ---import Control.Lens -type SPic = (Shape, Picture) +type SPic = (Shape, Picture) -- should all this be inlined/inlinable? noPic :: Shape -> SPic noPic = (,mempty) noShape :: Picture -> SPic -noShape = (VS.empty,) +noShape = (mempty,) _spShape :: SPic -> Shape _spShape = fst @@ -52,12 +48,12 @@ translateSP v = bimap (translateSH v) (translate3 v) rotateSP :: Float -> SPic -> SPic rotateSP a = bimap (rotateSH a) (rotate a) ---mirrorSPxz :: SPic -> SPic ---mirrorSPxz = bimap (reverse . overPosSH flipy) mirrorxz --- where --- flipy (V3 x y z) = V3 x (negate y) z --- ---mirrorSPyz :: SPic -> SPic ---mirrorSPyz = bimap (reverse . overPosSH flipx) mirroryz --- where --- flipx (V3 x y z) = V3 (negate x) y z +mirrorSPxz :: SPic -> SPic +mirrorSPxz = bimap (reverse . overPosSH flipy) mirrorxz + where + flipy (V3 x y z) = V3 x (negate y) z + +mirrorSPyz :: SPic -> SPic +mirrorSPyz = bimap (reverse . overPosSH flipx) mirroryz + where + flipx (V3 x y z) = V3 (negate x) y z