Apply Hlints
This commit is contained in:
+42
-47
@@ -1,5 +1,3 @@
|
||||
--{-# LANGUAGE BangPatterns #-}
|
||||
--{-# LANGUAGE Strict #-}
|
||||
module Picture
|
||||
( module Picture.Data
|
||||
, polygon
|
||||
@@ -46,7 +44,7 @@ module Picture
|
||||
, setDepth
|
||||
, setLayer
|
||||
)
|
||||
where
|
||||
where
|
||||
import Geometry
|
||||
import Geometry.Data
|
||||
|
||||
@@ -75,33 +73,35 @@ bezierQuad :: Color -> Color -> Float -> Float -> Point2 -> Point2 -> Point2 ->
|
||||
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 = BezierQuad 0 [-- ( (0,0) , cola, (0,0), (0,0) )
|
||||
(aIn, cola, (fa aIn,fc aIn) , (1,0) )
|
||||
,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
|
||||
,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
|
||||
,( aX, cola, (1,0) , (fa' aX,fc' aX) )
|
||||
,( cX, colc, (0,1) , (fa' cX,fc' cX) )
|
||||
,( bX, colb, (0,0) , (fa' bX,fc' bX) )
|
||||
,( bX, colb, (0,0) , (fa' bX,fc' bX) )
|
||||
]
|
||||
where colb = mixColors 0.5 0.5 cola colc
|
||||
b2a | isLHS a b c = a -.- b
|
||||
| otherwise = b -.- a
|
||||
aRadVec = 0.5 * ra *.* (normalizeV $ vNormal b2a)
|
||||
aX = a -.- aRadVec
|
||||
aIn = a +.+ aRadVec
|
||||
b2c | isLHS a b c = b -.- c
|
||||
| otherwise = c -.- b
|
||||
cRadVec = 0.5 * rc *.* (normalizeV $ vNormal b2c)
|
||||
cX = c -.- cRadVec
|
||||
cIn = c +.+ cRadVec
|
||||
bRadVec = 0.25 * (ra + rc) *.* (normalizeV $ a +.+ b -.- 2 *.* c)
|
||||
bX = b +.+ bRadVec
|
||||
bIn = b -.- bRadVec
|
||||
fa = extrapolate aX cX bX
|
||||
fc = extrapolate cX aX bX
|
||||
fa' = extrapolate aIn cIn bIn
|
||||
fc' = extrapolate cIn aIn bIn
|
||||
| otherwise = BezierQuad 0
|
||||
[-- ( (0,0) , cola, (0,0), (0,0) )
|
||||
(aIn, cola, (fa aIn,fc aIn) , (1,0) )
|
||||
,(aIn, cola, (fa aIn,fc aIn) , (1,0) )
|
||||
,(cIn, colc, (fa cIn,fc cIn) , (0,1) )
|
||||
,( aX, cola, (1,0) , (fa' aX,fc' aX) )
|
||||
,( cX, colc, (0,1) , (fa' cX,fc' cX) )
|
||||
,( bX, colb, (0,0) , (fa' bX,fc' bX) )
|
||||
,( bX, colb, (0,0) , (fa' bX,fc' bX) )
|
||||
]
|
||||
where
|
||||
colb = mixColors 0.5 0.5 cola colc
|
||||
b2a | isLHS a b c = a -.- b
|
||||
| otherwise = b -.- a
|
||||
aRadVec = 0.5 * ra *.* normalizeV (vNormal b2a)
|
||||
aX = a -.- aRadVec
|
||||
aIn = a +.+ aRadVec
|
||||
b2c | isLHS a b c = b -.- c
|
||||
| otherwise = c -.- b
|
||||
cRadVec = 0.5 * rc *.* normalizeV (vNormal b2c)
|
||||
cX = c -.- cRadVec
|
||||
cIn = c +.+ cRadVec
|
||||
bRadVec = 0.25 * (ra + rc) *.* normalizeV (a +.+ b -.- 2 *.* c)
|
||||
bX = b +.+ bRadVec
|
||||
bIn = b -.- bRadVec
|
||||
fa = extrapolate aX cX bX
|
||||
fc = extrapolate cX aX bX
|
||||
fa' = extrapolate aIn cIn bIn
|
||||
fc' = extrapolate cIn aIn bIn
|
||||
|
||||
-- given a one and two zeros of a linear function over x and y,
|
||||
-- determine the function
|
||||
@@ -149,25 +149,23 @@ scale x y pic = OverPic (scale3 x y) (\(a,b) ->(a*x,b*y)) 0 id pic
|
||||
rotate3 :: Float -> Point3 -> Point3
|
||||
{-# INLINE rotate3 #-}
|
||||
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
|
||||
{-# INLINE rotate #-}
|
||||
rotate a pic = OverPic (rotate3 a) id a id pic
|
||||
|
||||
--rotateRad a = Rotate a
|
||||
--{-# INLINE rotateRad #-}
|
||||
|
||||
pictures :: [Picture] -> Picture
|
||||
{-# INLINE pictures #-}
|
||||
pictures = Pictures
|
||||
|
||||
|
||||
makeArc :: Float -> (Float,Float) -> [Point2]
|
||||
{-# INLINE makeArc #-}
|
||||
makeArc rad (a,b) = zipWith rotateV as $ repeat (0,rad)
|
||||
where as = [a,a+step.. b]
|
||||
step = pi * 0.2
|
||||
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 #-}
|
||||
@@ -196,16 +194,15 @@ lineCol = LineCol 0
|
||||
thickLine :: [Point2] -> Float -> Picture
|
||||
{-# INLINE thickLine #-}
|
||||
thickLine ps t = pictures $ f ps
|
||||
where f (x:y:ys)
|
||||
| x == y = f (x:ys)
|
||||
| otherwise
|
||||
= polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
|
||||
f _ = []
|
||||
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
|
||||
where
|
||||
f (x:y:ys)
|
||||
| x == y = f (x:ys)
|
||||
| otherwise = polygon [x +.+ n x y, x -.- n x y, y -.- n x y, y +.+ n x y] : f (y:ys)
|
||||
f _ = []
|
||||
n a b = (t*0.5) *.* errorNormalizeV 42 (vNormal (a -.- b))
|
||||
|
||||
thickCircle :: Float -> Float -> Picture
|
||||
{-# 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
|
||||
@@ -219,8 +216,6 @@ arc startA endA rad = thickArc startA endA rad 1
|
||||
thickArc :: Float -> Float -> Float -> Float -> Picture
|
||||
{-# INLINE thickArc #-}
|
||||
thickArc = ThickArc 0
|
||||
--thickArc startA endA rad wdth
|
||||
-- = thickLine (makeArc rad (startA,endA)) wdth
|
||||
|
||||
withAlpha :: Float -> RGBA -> RGBA
|
||||
{-# INLINE withAlpha #-}
|
||||
|
||||
Reference in New Issue
Block a user