Remove inline from picture functions
This commit is contained in:
+34
-34
@@ -62,96 +62,96 @@ black :: RGBA
|
|||||||
black = (0,0,0,1)
|
black = (0,0,0,1)
|
||||||
|
|
||||||
polygon :: [Point2] -> Picture
|
polygon :: [Point2] -> Picture
|
||||||
{-# INLINE polygon #-}
|
--{-# INLINE polygon #-}
|
||||||
polygon ps = pure $ (,) 0 $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
polygon ps = pure $ (,) 0 $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ repeat black
|
||||||
|
|
||||||
polygonCol :: [(Point2,RGBA)] -> Picture
|
polygonCol :: [(Point2,RGBA)] -> Picture
|
||||||
{-# INLINE polygonCol #-}
|
--{-#INLINE polygonCol #-}
|
||||||
polygonCol ls = pure $ (,) 0 $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
polygonCol ls = pure $ (,) 0 $ RenderPoly $ zip (map zeroZ $ polyToTris ps) $ polyToTris cs
|
||||||
where (ps,cs) = unzip ls
|
where (ps,cs) = unzip ls
|
||||||
|
|
||||||
polyToTris :: [s] -> [s]
|
polyToTris :: [s] -> [s]
|
||||||
{-# INLINE polyToTris #-}
|
--{-#INLINE polyToTris #-}
|
||||||
polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
|
polyToTris (a:b:c:as) = a : intercalate [a] (zipWith (\x y->[x,y]) (init (b:c:as)) (c:as))
|
||||||
polyToTris _ = []
|
polyToTris _ = []
|
||||||
|
|
||||||
color :: RGBA -> Picture -> Picture
|
color :: RGBA -> Picture -> Picture
|
||||||
{-# INLINE color #-}
|
--{-#INLINE color #-}
|
||||||
color c pic = fmap (second $ colorRen c) pic
|
color c pic = fmap (second $ colorRen c) pic
|
||||||
|
|
||||||
translate3 :: Float -> Float -> Point3 -> Point3
|
translate3 :: Float -> Float -> Point3 -> Point3
|
||||||
{-# INLINE translate3 #-}
|
--{-#INLINE translate3 #-}
|
||||||
translate3 a b (x,y,z) = (x+a,y+b,z)
|
translate3 a b (x,y,z) = (x+a,y+b,z)
|
||||||
|
|
||||||
translate :: Float -> Float -> Picture -> Picture
|
translate :: Float -> Float -> Picture -> Picture
|
||||||
{-# INLINE translate #-}
|
--{-#INLINE translate #-}
|
||||||
translate x y pic = fmap (second $ translateRen x y) pic
|
translate x y pic = fmap (second $ translateRen x y) pic
|
||||||
|
|
||||||
setDepth :: Float -> Picture -> Picture
|
setDepth :: Float -> Picture -> Picture
|
||||||
{-# INLINE setDepth #-}
|
--{-#INLINE setDepth #-}
|
||||||
setDepth d pic = fmap (second $ setDepthRen d) pic
|
setDepth d pic = fmap (second $ setDepthRen d) pic
|
||||||
|
|
||||||
setLayer :: Int -> Picture -> Picture
|
setLayer :: Int -> Picture -> Picture
|
||||||
setLayer i pic = fmap (first $ const i) pic
|
setLayer i pic = fmap (first $ const i) pic
|
||||||
|
|
||||||
scale3 :: Float -> Float -> Point3 -> Point3
|
scale3 :: Float -> Float -> Point3 -> Point3
|
||||||
{-# INLINE scale3 #-}
|
--{-#INLINE scale3 #-}
|
||||||
scale3 a b (x,y,z) = (x*a,y*b,z)
|
scale3 a b (x,y,z) = (x*a,y*b,z)
|
||||||
|
|
||||||
scale :: Float -> Float -> Picture -> Picture
|
scale :: Float -> Float -> Picture -> Picture
|
||||||
{-# INLINE scale #-}
|
--{-#INLINE scale #-}
|
||||||
scale x y pic = fmap (second $ scaleRen x y) pic
|
scale x y pic = fmap (second $ scaleRen x y) pic
|
||||||
|
|
||||||
rotate3 :: Float -> Point3 -> Point3
|
rotate3 :: Float -> Point3 -> Point3
|
||||||
{-# INLINE rotate3 #-}
|
--{-#INLINE rotate3 #-}
|
||||||
rotate3 a (x,y,z) = (x',y',z)
|
rotate3 a (x,y,z) = (x',y',z)
|
||||||
where (x',y') = rotateV a (x,y)
|
where (x',y') = rotateV a (x,y)
|
||||||
|
|
||||||
rotate :: Float -> Picture -> Picture
|
rotate :: Float -> Picture -> Picture
|
||||||
{-# INLINE rotate #-}
|
--{-#INLINE rotate #-}
|
||||||
rotate a pic = fmap (second $ rotateRen a) pic
|
rotate a pic = fmap (second $ rotateRen a) pic
|
||||||
|
|
||||||
--rotateRad a = Rotate a
|
--rotateRad a = Rotate a
|
||||||
--{-# INLINE rotateRad #-}
|
----{-#INLINE rotateRad #-}
|
||||||
|
|
||||||
pictures :: [Picture] -> Picture
|
pictures :: [Picture] -> Picture
|
||||||
{-# INLINE pictures #-}
|
--{-#INLINE pictures #-}
|
||||||
pictures = mconcat
|
pictures = mconcat
|
||||||
|
|
||||||
|
|
||||||
makeArc :: Float -> (Float,Float) -> [Point2]
|
makeArc :: Float -> (Float,Float) -> [Point2]
|
||||||
{-# INLINE makeArc #-}
|
--{-#INLINE makeArc #-}
|
||||||
makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
|
makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
|
||||||
where as = [a,a+step.. b]
|
where as = [a,a+step.. b]
|
||||||
step = pi * 0.2
|
step = pi * 0.2
|
||||||
|
|
||||||
circleSolid :: Float -> Picture
|
circleSolid :: Float -> Picture
|
||||||
{-# INLINE circleSolid #-}
|
--{-#INLINE circleSolid #-}
|
||||||
--circleSolid rad = polygon $ makeArc rad (0,2*pi)
|
--circleSolid rad = polygon $ makeArc rad (0,2*pi)
|
||||||
circleSolid r = pure $ (,) 0 $ RenderCirc $ ((0,0,0),black,r)
|
circleSolid r = pure $ (,) 0 $ RenderCirc $ ((0,0,0),black,r)
|
||||||
|
|
||||||
circle :: Float -> Picture
|
circle :: Float -> Picture
|
||||||
{-# INLINE circle #-}
|
--{-#INLINE circle #-}
|
||||||
circle rad = thickArc 0 (2*pi) rad 1
|
circle rad = thickArc 0 (2*pi) rad 1
|
||||||
|
|
||||||
text :: String -> Picture
|
text :: String -> Picture
|
||||||
{-# INLINE text #-}
|
--{-#INLINE text #-}
|
||||||
text s = pure $ (,) 1 $ RenderText $ stringToList s
|
text s = pure $ (,) 1 $ RenderText $ stringToList s
|
||||||
|
|
||||||
stringToList :: String -> [(Point3,Point4,Point2)]
|
stringToList :: String -> [(Point3,Point4,Point2)]
|
||||||
{-# INLINE stringToList #-}
|
--{-#INLINE stringToList #-}
|
||||||
stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
|
stringToList s = zipWith (\x (a,b,c) -> (translate3 x 0 a,b,c))
|
||||||
[0,0.9*dimText..]
|
[0,0.9*dimText..]
|
||||||
$ map charToTuple s
|
$ map charToTuple s
|
||||||
where dimText = 100
|
where dimText = 100
|
||||||
|
|
||||||
charToTuple :: Char -> (Point3,Point4,Point2)
|
charToTuple :: Char -> (Point3,Point4,Point2)
|
||||||
{-# INLINE charToTuple #-}
|
--{-#INLINE charToTuple #-}
|
||||||
charToTuple c = ((0,0,0),white,(offset,100))
|
charToTuple c = ((0,0,0),white,(offset,100))
|
||||||
where offset = fromIntegral (fromEnum c) - 32
|
where offset = fromIntegral (fromEnum c) - 32
|
||||||
|
|
||||||
line :: [Point2] -> Picture
|
line :: [Point2] -> Picture
|
||||||
{-# INLINE line #-}
|
--{-#INLINE line #-}
|
||||||
line ps = pure $ (,) 0 $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
line ps = pure $ (,) 0 $ RenderLine $ zip (map zeroZ $ doubleLine ps) $ repeat white
|
||||||
|
|
||||||
doubleLine :: [Point2] -> [Point2]
|
doubleLine :: [Point2] -> [Point2]
|
||||||
@@ -159,7 +159,7 @@ doubleLine (x:y:xs) = concat $ zipWith (:) (init (x:y:xs)) $ map (\a -> [a]) (y:
|
|||||||
doubleLine _ = []
|
doubleLine _ = []
|
||||||
|
|
||||||
thickLine :: [Point2] -> Float -> Picture
|
thickLine :: [Point2] -> Float -> Picture
|
||||||
{-# INLINE thickLine #-}
|
--{-#INLINE thickLine #-}
|
||||||
thickLine ps t = pictures $ f ps
|
thickLine ps t = pictures $ f ps
|
||||||
where f (x:y:ys)
|
where f (x:y:ys)
|
||||||
| x == y = f (x:ys)
|
| x == y = f (x:ys)
|
||||||
@@ -169,26 +169,26 @@ thickLine ps t = pictures $ f ps
|
|||||||
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
|
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
|
||||||
|
|
||||||
thickCircle :: Float -> Float -> Picture
|
thickCircle :: Float -> Float -> Picture
|
||||||
{-# INLINE thickCircle #-}
|
--{-#INLINE thickCircle #-}
|
||||||
--thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth
|
--thickCircle rad wdth = thickLine (makeArc rad (0,2*pi)) wdth
|
||||||
thickCircle rad wdth = thickArc 0 (2*pi) rad wdth
|
thickCircle rad wdth = thickArc 0 (2*pi) rad wdth
|
||||||
|
|
||||||
arcSolid :: Float -> Float -> Float -> Picture
|
arcSolid :: Float -> Float -> Float -> Picture
|
||||||
{-# INLINE arcSolid #-}
|
--{-#INLINE arcSolid #-}
|
||||||
arcSolid startA endA rad
|
arcSolid startA endA rad
|
||||||
= polygon $ (0,0) : makeArc rad (startA,endA)
|
= polygon $ (0,0) : makeArc rad (startA,endA)
|
||||||
|
|
||||||
arc startA endA rad = thickArc startA endA rad 1
|
arc startA endA rad = thickArc startA endA rad 1
|
||||||
{-# INLINE arc #-}
|
--{-#INLINE arc #-}
|
||||||
|
|
||||||
thickArc :: Float -> Float -> Float -> Float -> Picture
|
thickArc :: Float -> Float -> Float -> Float -> Picture
|
||||||
{-# INLINE thickArc #-}
|
--{-#INLINE thickArc #-}
|
||||||
thickArc startA endA rad wdth = pure $ (,) 0 $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
thickArc startA endA rad wdth = pure $ (,) 0 $ RenderArc $ ((0,0,0),black,(startA,endA,rad,wdth))
|
||||||
--thickArc startA endA rad wdth
|
--thickArc startA endA rad wdth
|
||||||
-- = thickLine (makeArc rad (startA,endA)) wdth
|
-- = thickLine (makeArc rad (startA,endA)) wdth
|
||||||
|
|
||||||
withAlpha :: Float -> RGBA -> RGBA
|
withAlpha :: Float -> RGBA -> RGBA
|
||||||
{-# INLINE withAlpha #-}
|
--{-#INLINE withAlpha #-}
|
||||||
withAlpha a (x,y,z,a') = (x,y,z,a*a')
|
withAlpha a (x,y,z,a') = (x,y,z,a*a')
|
||||||
|
|
||||||
red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
|
red,green,blue,yellow,cyan,magenta,rose,violet,azure,aquamarine,chartreuse,orange,white::Color
|
||||||
@@ -232,11 +232,11 @@ greyN x = (x,x,x,1)
|
|||||||
|
|
||||||
|
|
||||||
scaleT :: Float -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
|
scaleT :: Float -> (Point3,Point4,Point2) -> (Point3,Point4,Point2)
|
||||||
{-# INLINE scaleT #-}
|
--{-#INLINE scaleT #-}
|
||||||
scaleT x (a,b,(o,s)) = (a,b,(o,s*x))
|
scaleT x (a,b,(o,s)) = (a,b,(o,s*x))
|
||||||
|
|
||||||
overPos :: (Point3 -> Point3) -> RenderType -> RenderType
|
overPos :: (Point3 -> Point3) -> RenderType -> RenderType
|
||||||
{-# INLINE overPos #-}
|
--{-#INLINE overPos #-}
|
||||||
overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
|
overPos f (RenderPoly vs) = RenderPoly $ map (first $ f) vs
|
||||||
overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
|
overPos f (RenderLine vs) = RenderLine $ map (first $ f) vs
|
||||||
overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
|
overPos f (RenderText vs) = RenderText $ map (\(a,b,c) -> (f a,b,c)) vs
|
||||||
@@ -245,7 +245,7 @@ overPos f (RenderArc (a,b,c)) = RenderArc (f a,b,c)
|
|||||||
overPos _ RenderBlank = RenderBlank
|
overPos _ RenderBlank = RenderBlank
|
||||||
|
|
||||||
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
|
overCol :: (Point4 -> Point4) -> RenderType -> RenderType
|
||||||
{-# INLINE overCol #-}
|
--{-#INLINE overCol #-}
|
||||||
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
|
overCol f (RenderPoly vs) = RenderPoly $ map (second $ f) vs
|
||||||
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
|
overCol f (RenderLine vs) = RenderLine $ map (second $ f) vs
|
||||||
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
|
overCol f (RenderText vs) = RenderText $ map (\(a,b,c) -> (a,f b,c)) vs
|
||||||
@@ -254,19 +254,19 @@ overCol f (RenderArc (a,b,c)) = RenderArc (a,f b,c)
|
|||||||
overCol _ RenderBlank = RenderBlank
|
overCol _ RenderBlank = RenderBlank
|
||||||
|
|
||||||
scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
|
scaleRen,translateRen :: Float -> Float -> RenderType -> RenderType
|
||||||
{-# INLINE scaleRen #-}
|
--{-#INLINE scaleRen #-}
|
||||||
scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
|
scaleRen x y (RenderText vs) = overPos (scale3 x y) $ RenderText $ map (scaleT x) vs
|
||||||
scaleRen x y rt = overPos (scale3 x y) rt
|
scaleRen x y rt = overPos (scale3 x y) rt
|
||||||
{-# INLINE translateRen #-}
|
--{-#INLINE translateRen #-}
|
||||||
translateRen x y = overPos $ translate3 x y
|
translateRen x y = overPos $ translate3 x y
|
||||||
rotateRen,setDepthRen :: Float -> RenderType -> RenderType
|
rotateRen,setDepthRen :: Float -> RenderType -> RenderType
|
||||||
{-# INLINE rotateRen #-}
|
--{-#INLINE rotateRen #-}
|
||||||
rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
|
rotateRen a (RenderArc (p,c,(as,ae,r,w))) = overPos (rotate3 a) $ RenderArc (p,c,(f as,f ae,r,w))
|
||||||
--where f b = normalizeAngle $ a + b
|
--where f b = normalizeAngle $ a + b
|
||||||
where f b = a + b
|
where f b = a + b
|
||||||
rotateRen a pic = overPos (rotate3 a) pic
|
rotateRen a pic = overPos (rotate3 a) pic
|
||||||
{-# INLINE setDepthRen #-}
|
--{-#INLINE setDepthRen #-}
|
||||||
setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
|
setDepthRen d = overPos $ \(x,y,_) -> (x,y,-d)
|
||||||
{-# INLINE colorRen #-}
|
--{-#INLINE colorRen #-}
|
||||||
colorRen :: RGBA -> RenderType -> RenderType
|
colorRen :: RGBA -> RenderType -> RenderType
|
||||||
colorRen c = overCol $ const c
|
colorRen c = overCol $ const c
|
||||||
|
|||||||
Reference in New Issue
Block a user