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