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

Move main to allow for new executables

Browse Source
This commit is contained in:
justin
2021-08-11 17:54:48 +02:00
parent b74bb45a4c
commit 4bbe5d0cf1
64 changed files with 521 additions and 345 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Picture.hs
+26 -26
View File
@@ -157,7 +157,7 @@ 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 #-}
@@ -181,7 +181,7 @@ setLayer i = map f
scale3 :: Float -> Float -> Point3 -> Point3
{-# INLINE scale3 #-}
scale3 a b (V3 x y z) = (V3 (x*a) (y*b) (z))
scale3 a b (V3 x y z) = V3 (x*a) (y*b) z
scale :: Float -> Float -> Picture -> Picture
{-# INLINE scale #-}
@@ -198,7 +198,7 @@ pictures = concat
makeArc :: Float -> Point2 -> [Point2]
{-# INLINE makeArc #-}
makeArc rad (V2 a b) = map (`rotateV` (V2 0 rad)) angles
makeArc rad (V2 a b) = map (`rotateV` V2 0 rad) angles
where
angles = [a,a+step.. b]
step = pi * 0.2
@@ -210,9 +210,9 @@ circleSolid = circleSolidCol white white
circleSolidCol :: Color -> Color -> Float -> Picture
{-# INLINE circleSolidCol #-}
circleSolidCol colC colE r = map f
[( (V3 (-r) ( r) (0)), colC)
,( (V3 (-r) (-r) (0)), colE)
,( (V3 ( r) (-r) (0)), black)
[(V3 (-r) r 0, colC)
,(V3 (-r) (-r) 0, colE)
,(V3 r (-r) 0, black)
]
where
f (pos,col) = Verx pos col [] 0 ellNum
@@ -270,7 +270,7 @@ arcSolid
-> Float -- ^ Radius
-> Picture
{-# INLINE arcSolid #-}
arcSolid startA endA rad = polygon $ (V2 0 0) : makeArc rad (V2 startA endA)
arcSolid startA endA rad = polygon $ V2 0 0 : makeArc rad (V2 startA endA)
arc
:: Float -- ^ Start angle
@@ -295,22 +295,22 @@ thickArc startA endA rad wdth
thickArcHelp :: Float -> Float -> Float -> Float -> [Verx]
{-# INLINE thickArcHelp #-}
thickArcHelp startA endA rad wdth = map f
[( (V3 0 0 0),black,(V3 0 0 wdth))
,((V3 xa ya 0),black,(V3 1 0 wdth))
,((V3 xb yb 0),black,(V3 1 1 wdth))
,( (V3 0 0 0),black,(V3 0 0 wdth))
,((V3 xb yb 0),black,(V3 1 1 wdth))
,((V3 xc yc 0),black,(V3 0 1 wdth))
[ (V3 0 0 0,black,V3 0 0 wdth)
,(V3 xa ya 0,black,V3 1 0 wdth)
,(V3 xb yb 0,black,V3 1 1 wdth)
, (V3 0 0 0,black,V3 0 0 wdth)
,(V3 xb yb 0,black,V3 1 1 wdth)
,(V3 xc yc 0,black,V3 0 1 wdth)
]
where
(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)
f (pos,col,V3 a b c) = Verx pos col [a,b,c] 0 arcNum
withAlpha :: Float -> RGBA -> RGBA
{-# INLINE withAlpha #-}
withAlpha a (V4 x y z a') = (V4 x y z (a*a'))
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,black::Color
@@ -350,23 +350,23 @@ mixColors rata ratb (V4 r0 g0 b0 a0) (V4 r2 g2 b2 a2) =
normrata = rata / fullrat
normratb = ratb / fullrat
f x y = sqrt $ normrata * x^(2::Int) + normratb * y^(2::Int)
in (V4 (f r0 r2 ) ( f g0 g2 ) ( f b0 b2 ) ( normrata * a0 + normratb * a2))
in V4 (f r0 r2 ) ( f g0 g2 ) ( f b0 b2 ) ( normrata * a0 + normratb * a2)
light :: Color -> Color
{-# INLINE light #-}
light (V4 r g b a) = (V4 (r+0.2) (g+0.2) (b+0.2) (a))
light (V4 r g b a) = V4 (r+0.2) (g+0.2) (b+0.2) a
dark :: Color -> Color
{-# INLINE dark #-}
dark (V4 r g b a) = (V4 (r-0.2) (g-0.2) (b-0.2) (a))
dark (V4 r g b a) = V4 (r-0.2) (g-0.2) (b-0.2) a
dim :: Color -> Color
{-# INLINE dim #-}
dim (V4 r g b a) = (V4 (r/1.2) (g/1.2) (b/1.2) (a))
dim (V4 r g b a) = V4 (r/1.2) (g/1.2) (b/1.2) a
bright :: Color -> Color
{-# INLINE bright #-}
bright (V4 r g b a) = (V4 (r*1.2) (g*1.2) (b*1.2) (a))
bright (V4 r g b a) = V4 (r*1.2) (g*1.2) (b*1.2) a
greyN :: Float -> Color
{-# INLINE greyN #-}
@@ -392,12 +392,12 @@ stringToList s = concatMap (uncurry charToTuple) $ zip [0,0.9*dimText ..] s
charToTuple :: Float -> Char -> [(Point3,Point4,Point2)]
{-# INLINE charToTuple #-}
charToTuple x c =
[((V3 (x-50) (-100) (0)), white,(V2 offset 1))
,((V3 (x-50) (100) (0)), white,(V2 offset 0))
,((V3 (x+50) (100) (0)), white,(V2 (offset+1) 0))
,((V3 (x-50) (-100) (0)), white,(V2 offset 1))
,((V3 (x+50) (-100) (0)), white,(V2 (offset+1) 1))
,((V3 (x+50) (100) (0)), white,(V2 (offset+1) 0))
[(V3 (x-50) (-100) 0, white,V2 offset 1)
,(V3 (x-50) 100 0, white,V2 offset 0)
,(V3 (x+50) 100 0, white,V2 (offset+1) 0)
,(V3 (x-50) (-100) 0, white,V2 offset 1)
,(V3 (x+50) (-100) 0, white,V2 (offset+1) 1)
,(V3 (x+50) 100 0, white,V2 (offset+1) 0)
]
where
offset = fromIntegral (fromEnum c) - 32