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

Implement poking using Verx lists

Browse Source
This commit is contained in:
justin
2021-07-30 20:04:55 +02:00
parent 834464db51
commit d7649b951b
12 changed files with 109 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture.hs
+35 -30
View File
@@ -1,6 +1,9 @@
{-# LANGUAGE TupleSections #-}
{-# LANGUAGE TupleSections
, BangPatterns
#-}
module Picture
( module Picture.Data
, blank
, polygon
, polygonZ
, polygonCol
@@ -62,8 +65,9 @@ import Picture.Data
--import Graphics.Rendering.OpenGL (lineWidth, ($=))
import Control.Lens
black :: RGBA
black = (V4 0 0 0 1)
blank :: Picture
{-# INLINE blank #-}
blank = []
polygon :: [Point2] -> Picture
{-# INLINE polygon #-}
@@ -79,9 +83,9 @@ polygonZ ps z = map (f . zeroZ) $ polyToTris ps
polygonCol :: [(Point2,RGBA)] -> Picture
{-# INLINE polygonCol #-}
polygonCol vs = map f $ polyToTris vs
polygonCol vs = polyToTris $ map f vs
where
f ((V2 x y),col) = Verx (V3 x y 0) col PolyV 0
f (V2 x y,col) = Verx (V3 x y 0) col PolyV 0
poly3 :: [Point3] -> Picture
{-# INLINE poly3 #-}
@@ -99,14 +103,13 @@ bezierQuad cola colc ra rc a b c
| a == b && b == c = blank
| a == b || b == c = bezierQuad cola colc ra rc a (0.5 *.* (a +.+ c)) c
| otherwise = bzhelp
[-- ( (0,0) , cola, (0,0), (0,0) )
(aIn, cola, (V2 (fa aIn) (fc aIn)) , (V2 1 0) )
,(aIn, cola, (V2 (fa aIn) (fc aIn)) , (V2 1 0) )
,(cIn, colc, (V2 (fa cIn) (fc cIn)) , (V2 0 1) )
,( aX, cola, (V2 1 0) , (V2 (fa' aX) (fc' aX)) )
,( cX, colc, (V2 0 1) , (V2 (fa' cX) (fc' cX)) )
,( bX, colb, (V2 0 0) , (V2 (fa' bX) (fc' bX)) )
,( bX, colb, (V2 0 0) , (V2 (fa' bX) (fc' bX)) )
[(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1 0 )
,(aIn, cola, V2 (fa aIn) (fc aIn) , V2 1 0 )
,(cIn, colc, V2 (fa cIn) (fc cIn) , V2 0 1 )
,( aX, cola, V2 1 0 , V2 (fa' aX) (fc' aX) )
,( cX, colc, V2 0 1 , V2 (fa' cX) (fc' cX) )
,( bX, colb, V2 0 0 , V2 (fa' bX) (fc' bX) )
,( bX, colb, V2 0 0 , V2 (fa' bX) (fc' bX) )
]
where
colb = mixColors 0.5 0.5 cola colc
@@ -131,7 +134,7 @@ bezierQuad cola colc ra rc a b c
bzhelp :: [(Point2, Point4, Point2, Point2)] -> Picture
bzhelp = map f
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
f (V2 x y,col,V2 a b,V2 c d) = Verx (V3 x y 0) col (BezV (V4 a b c d)) 0
-- given a one and two zeros of a linear function over x and y,
-- determine the function
@@ -154,12 +157,12 @@ color c = map $ overCol (const c)
translate3 :: Float -> Float -> Point3 -> Point3
{-# INLINE translate3 #-}
translate3 a b (V3 x y z) = V3 (x+a) (y+b) z
translate3 !a !b !(V3 x y z) = V3 (x+a) (y+b) z
translate :: Float -> Float -> Picture -> Picture
--{-# INLINE translate #-}
--translate x y = map $ second $ overPos (translate3 x y)
translate x y = map $ overPos (translate3 x y)
translate !x !y = map $! overPos $! translate3 x y
setDepth :: Float -> Picture -> Picture
--{-# INLINE setDepth #-}
@@ -311,20 +314,22 @@ withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-}
withAlpha a (V4 x y z a') = (V4 x y z (a*a'))
red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
red = toV4 (1,0,0,1)
green = toV4 (0,1,0,1)
blue = toV4 (0,0,1,1)
yellow = toV4 (1,1,0,1)
cyan = toV4 (0,1,1,1)
magenta = toV4 (1,0,1,1)
rose = toV4 (1,0,0.5,1)
violet = toV4 (0.5,0,1,1)
azure = toV4 (0,0.5,1,1)
aquamarine= toV4 (0,1,0.5,1)
chartreuse= toV4 (0.5,1,0,1)
orange = toV4 (1,0.5,0,1)
white = toV4 (1,1,1,1)
red,green,blue,yellow,cyan,magenta,rose
,violet,azure,aquamarine,chartreuse,orange,white,black::Color
red = V4 1 0 0 1
green = V4 0 1 0 1
blue = V4 0 0 1 1
yellow = V4 1 1 0 1
cyan = V4 0 1 1 1
magenta = V4 1 0 1 1
rose = V4 1 0 0.5 1
violet = V4 0.5 0 1 1
azure = V4 0 0.5 1 1
aquamarine= V4 0 1 0.5 1
chartreuse= V4 0.5 1 0 1
orange = V4 1 0.5 0 1
white = V4 1 1 1 1
black = V4 0 0 0 1
mixColors :: Float -> Float -> Color -> Color -> Color