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

Refactor vertex poking

Browse Source
This commit is contained in:
justin
2021-08-10 02:29:17 +02:00
parent 79eb031637
commit 51b8fab214
4 changed files with 57 additions and 66 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture.hs
+8 -8
View File
@@ -73,19 +73,19 @@ polygon :: [Point2] -> Picture
{-# INLINE polygon #-} {-# INLINE polygon #-}
polygon ps = map (f . zeroZ) $ polyToTris ps polygon ps = map (f . zeroZ) $ polyToTris ps
where where
f pos = Verx pos black PolyV 0 polyNum f pos = Verx pos black [] 0 polyNum
polygonZ :: [Point2] -> Float -> Picture polygonZ :: [Point2] -> Float -> Picture
{-# INLINE polygonZ #-} {-# INLINE polygonZ #-}
polygonZ ps z = map (f . zeroZ) $ polyToTris ps polygonZ ps z = map (f . zeroZ) $ polyToTris ps
where where
f pos = Verx pos black (PolyzV z) 0 polyzNum f pos = Verx pos black [z] 0 polyzNum
polygonCol :: [(Point2,RGBA)] -> Picture polygonCol :: [(Point2,RGBA)] -> Picture
{-# INLINE polygonCol #-} {-# INLINE polygonCol #-}
polygonCol vs = polyToTris $ map f vs polygonCol vs = polyToTris $ map f vs
where where
f (V2 x y,col) = Verx (V3 x y 0) col PolyV 0 polyNum f (V2 x y,col) = Verx (V3 x y 0) col [] 0 polyNum
poly3 :: [Point3] -> Picture poly3 :: [Point3] -> Picture
{-# INLINE poly3 #-} {-# INLINE poly3 #-}
@@ -95,7 +95,7 @@ poly3Col :: [(Point3,RGBA)] -> Picture
{-# INLINE poly3Col #-} {-# INLINE poly3Col #-}
poly3Col vs = map f $ polyToTris vs poly3Col vs = map f $ polyToTris vs
where where
f (pos,col) = Verx pos col PolyV 0 polyNum f (pos,col) = Verx pos col [] 0 polyNum
-- note that much of work computing the width of the bezier curve is done here -- note that much of work computing the width of the bezier curve is done here
bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 -> Picture
@@ -134,7 +134,7 @@ bezierQuad cola colc ra rc a b c
bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
bzhelp = map f bzhelp = map f
where where
f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col (BezV (V4 a b c d)) 0 bezNum f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col [a,b,c,d] 0 bezNum
-- given a one and two zeros of a linear function over x and y, -- given a one and two zeros of a linear function over x and y,
-- determine the function -- determine the function
@@ -215,7 +215,7 @@ circleSolidCol colC colE r = map f
,( (V3 ( r) (-r) (0)), black) ,( (V3 ( r) (-r) (0)), black)
] ]
where where
f (pos,col) = Verx pos col EllV 0 ellNum f (pos,col) = Verx pos col [] 0 ellNum
circle :: Float -> Picture circle :: Float -> Picture
{-# INLINE circle #-} {-# INLINE circle #-}
@@ -225,7 +225,7 @@ text :: String -> Picture
{-# INLINE text #-} {-# INLINE text #-}
text s = map f $ stringToList s text s = map f $ stringToList s
where where
f (pos,col,val) = Verx pos col (TextV val) 0 textNum f (pos,col,V2 a b) = Verx pos col [a,b] 0 textNum
line :: [Point2] -> Picture line :: [Point2] -> Picture
{-# INLINE line #-} {-# INLINE line #-}
@@ -306,7 +306,7 @@ thickArcHelp startA endA rad wdth = map f
(V2 xa ya) = rotateV startA (V2 rad 0) (V2 xa ya) = rotateV startA (V2 rad 0)
(V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) (0)) (V2 xb yb) = rotateV (0.5 * (startA + endA)) (V2 (rad * sqrt 2) (0))
(V2 xc yc) = rotateV endA (V2 rad 0) (V2 xc yc) = rotateV endA (V2 rad 0)
f (pos,col,val) = Verx pos col (ArcV val) 0 arcNum f (pos,col,V3 a b c) = Verx pos col [a,b,c] 0 arcNum
withAlpha :: Float -> RGBA -> RGBA withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-} {-# INLINE withAlpha #-}
src/Picture/Data.hs
+1 -1
View File
@@ -20,7 +20,7 @@ import Control.Lens
data Verx = Verx data Verx = Verx
{ _vxPos :: !Point3 { _vxPos :: !Point3
, _vxCol :: !Point4 , _vxCol :: !Point4
, _vxType :: !VertexType , _vxExt :: [Float]
, _vxLayer :: !Int , _vxLayer :: !Int
, _vxShadNum :: !ShadNum , _vxShadNum :: !ShadNum
} }
src/Polyhedra.hs
+1 -1
View File
@@ -88,7 +88,7 @@ polyToPics = map helpPoly3D . _pyFaces
helpPoly3D :: [(Point3, Point4)] -> [Verx] helpPoly3D :: [(Point3, Point4)] -> [Verx]
helpPoly3D vs = map f $ polyToTris vs helpPoly3D vs = map f $ polyToTris vs
where where
f (pos,col) = Verx pos col PolyV 0 polyNum f (pos,col) = Verx pos col [] 0 polyNum
polysToPic :: [Polyhedra] -> Picture polysToPic :: [Polyhedra] -> Picture
polysToPic = pictures . concatMap polyToPics polysToPic = pictures . concatMap polyToPics
src/Shader/Poke.hs
+47 -56
View File
@@ -20,7 +20,7 @@ import Geometry.Data
--import Data.List --import Data.List
import Foreign import Foreign
import Control.Monad import Control.Monad
import qualified Control.Foldl as F --import qualified Control.Foldl as F
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
--import Control.Lens --import Control.Lens
import qualified Data.Vector.Unboxed.Mutable as MV import qualified Data.Vector.Unboxed.Mutable as MV
@@ -43,40 +43,41 @@ vToPicShad :: MV.MVector (PrimState IO) Int -> IO (PicShads Int)
vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5 vToPicShad mv = mapM (MV.unsafeRead mv) $ PicShads 0 1 2 3 4 5
pokeVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO () pokeVerx :: PicShads VBO -> MV.MVector (PrimState IO) Int -> Verx -> IO ()
{-# INLINE pokeVerx #-} --{-# INLINE pokeVerx #-}
pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxType=theType} = case theType of pokeVerx vbos offsets Verx{_vxPos=thePos,_vxCol=theCol,_vxExt=ext,_vxShadNum=theShadNum} = do
PolyV -> do typeOff <- MV.unsafeRead offsets sn
typeOff <- MV.unsafeRead offsets 0 let thePtr = plusPtr (_vboPtr $ vboFromType vbos sn) (typeOff * pokeStride sn * floatSize)
poke34 (plusPtr (_vboPtr $ _psPoly vbos) (typeOff * 7 * floatSize)) thePos theCol poke34 thePtr thePos theCol
PolyzV x -> do pokeArrayOff thePtr 7 ext
typeOff <- MV.unsafeRead offsets 1 where
let thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (typeOff * 8 * floatSize) sn = _unShadNum theShadNum
poke34 thePtr thePos theCol -- case _unShadNum theShadNum of
pokeElemOff thePtr 7 x -- 0 -> do
BezV (V4 x y z w) -> do -- typeOff <- MV.unsafeRead offsets 0
typeOff <- MV.unsafeRead offsets 2 -- poke34 (plusPtr (_vboPtr $ vboFromType vbos 0) (typeOff * 7 * floatSize)) thePos theCol
let thePtr = plusPtr (_vboPtr $ _psBez vbos) (typeOff * 11 * floatSize) -- 1 -> do
poke34 thePtr thePos theCol -- typeOff <- MV.unsafeRead offsets 1
pokeElemOff thePtr 7 x -- let thePtr = plusPtr (_vboPtr $ _psPolyz vbos) (typeOff * 8 * floatSize)
pokeElemOff thePtr 8 y -- poke34 thePtr thePos theCol
pokeElemOff thePtr 9 z -- pokeArrayOff thePtr 7 ext
pokeElemOff thePtr 10 w -- 2 -> do
TextV (V2 x y) -> do -- typeOff <- MV.unsafeRead offsets 2
typeOff <- MV.unsafeRead offsets 3 -- let thePtr = plusPtr (_vboPtr $ _psBez vbos) (typeOff * 11 * floatSize)
let thePtr = plusPtr (_vboPtr $ _psText vbos) (typeOff * 9 * floatSize) -- poke34 thePtr thePos theCol
poke34 thePtr thePos theCol -- pokeArrayOff thePtr 7 ext
pokeElemOff thePtr 7 x -- 3 -> do
pokeElemOff thePtr 8 y -- typeOff <- MV.unsafeRead offsets 3
ArcV (V3 x y z) -> do -- let thePtr = plusPtr (_vboPtr $ _psText vbos) (typeOff * 9 * floatSize)
typeOff <- MV.unsafeRead offsets 4 -- poke34 thePtr thePos theCol
let thePtr = plusPtr (_vboPtr $ _psArc vbos) (typeOff * 10 * floatSize) -- pokeArrayOff thePtr 7 ext
poke34 thePtr thePos theCol -- 4 -> do
pokeElemOff thePtr 7 x -- typeOff <- MV.unsafeRead offsets 4
pokeElemOff thePtr 8 y -- let thePtr = plusPtr (_vboPtr $ _psArc vbos) (typeOff * 10 * floatSize)
pokeElemOff thePtr 9 z -- poke34 thePtr thePos theCol
EllV -> do -- pokeArrayOff thePtr 7 ext
typeOff <- MV.unsafeRead offsets 5 -- 5 -> do
poke34 (plusPtr (_vboPtr $ _psEll vbos) (typeOff * 7 * floatSize)) thePos theCol -- typeOff <- MV.unsafeRead offsets 5
-- poke34 (plusPtr (_vboPtr $ _psEll vbos) (typeOff * 7 * floatSize)) thePos theCol
poke34 :: Ptr Float -> Point3 -> Point4 -> IO () poke34 :: Ptr Float -> Point3 -> Point4 -> IO ()
{-# INLINE poke34 #-} {-# INLINE poke34 #-}
@@ -131,29 +132,17 @@ comLayVerx vbos counts vx = do
theOff <- MV.unsafeRead counts vecPos theOff <- MV.unsafeRead counts vecPos
let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize) let thePtr = plusPtr basePtr ((theOff + layOff) * theStride * floatSize)
poke34 thePtr thePos theCol poke34 thePtr thePos theCol
pokeVerxType thePtr theType pokeArrayOff thePtr 7 (_vxExt vx)
MV.unsafeModify counts (+ 1) vecPos MV.unsafeModify counts (+ 1) vecPos
where where
sn = _unShadNum (_vxShadNum vx) sn = _unShadNum (_vxShadNum vx)
vecPos = theLayer * 6 + sn vecPos = theLayer * 6 + sn
theLayer = _vxLayer vx theLayer = _vxLayer vx
theType = _vxType vx
thePos = _vxPos vx thePos = _vxPos vx
theCol = _vxCol vx theCol = _vxCol vx
basePtr = _vboPtr $ vboFromType vbos sn basePtr = _vboPtr $ vboFromType vbos sn
layOff = theLayer * numSubElements layOff = theLayer * numSubElements
theStride = pokeStride theType theStride = pokeStride sn
pokeVerxType :: Ptr Float -> VertexType -> IO ()
{-# INLINE pokeVerxType #-}
pokeVerxType thePtr vt = case vt of
PolyzV x -> pokeElemOff thePtr 7 x
BezV (V4 x y z w) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y
>> pokeElemOff thePtr 9 z >> pokeElemOff thePtr 10 w
TextV (V2 x y) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y
ArcV (V3 x y z) -> pokeElemOff thePtr 7 x >> pokeElemOff thePtr 8 y
>> pokeElemOff thePtr 9 z
_ -> return ()
vboFromType :: PicShads VBO -> Int -> VBO vboFromType :: PicShads VBO -> Int -> VBO
{-# INLINE vboFromType #-} {-# INLINE vboFromType #-}
@@ -164,6 +153,7 @@ vboFromType ps sn = case sn of
3 -> _psText ps 3 -> _psText ps
4 -> _psArc ps 4 -> _psArc ps
5 -> _psEll ps 5 -> _psEll ps
_ -> undefined
pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int)) pokeLayVerxs :: PicShads VBO -> [Verx] -> IO (IM.IntMap (PicShads Int))
@@ -177,14 +167,15 @@ vToLayPicShad mv = foldM f IM.empty [0..5]
where where
f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ MV.unsafeSlice (i * 6) 6 mv) f m i = fmap (\ps -> IM.insert i ps m) (vToPicShad $ MV.unsafeSlice (i * 6) 6 mv)
pokeStride :: VertexType -> Int pokeStride :: Int -> Int
{-# INLINE pokeStride #-} {-# INLINE pokeStride #-}
pokeStride PolyV = 7 pokeStride 0 = 7
pokeStride PolyzV{} = 8 pokeStride 1 = 8
pokeStride BezV{} = 11 pokeStride 2 = 11
pokeStride TextV{} = 9 pokeStride 3 = 9
pokeStride ArcV{} = 10 pokeStride 4 = 10
pokeStride EllV = 7 pokeStride 5 = 7
pokeStride _ = undefined
poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int poke224s :: Ptr Float -> [((Point2,Point2),Point4)] -> IO Int
poke224s ptr vals0 = go vals0 0 poke224s ptr vals0 = go vals0 0