metabrush/src/app/MetaBrush/Asset/Brushes.hs

71 lines
1.9 KiB
Haskell
Raw Normal View History

{-# LANGUAGE NegativeLiterals #-}
{-# LANGUAGE ScopedTypeVariables #-}
module MetaBrush.Asset.Brushes
( ellipse, blob, rect )
where
-- containers
import Data.Sequence
( Seq(..) )
import qualified Data.Sequence as Seq
( fromList )
-- MetaBrush
import Math.Bezier.Stroke
( StrokePoint(..) )
import Math.Vector2D
( Point2D(..) )
--------------------------------------------------------------------------------
ellipse :: forall d. Double -> Double -> d -> Seq ( StrokePoint d )
ellipse w h d = Seq.fromList
[ pp ( Point2D 0 1 )
, cp ( Point2D a 1 )
, cp ( Point2D 1 a )
, pp ( Point2D 1 0 )
, cp ( Point2D 1 (-a) )
, cp ( Point2D a (-1) )
, pp ( Point2D 0 (-1) )
, cp ( Point2D (-a) (-1) )
, cp ( Point2D (-1) (-a) )
, pp ( Point2D (-1) 0 )
, cp ( Point2D (-1) a )
, cp ( Point2D (-a) 1 )
, pp ( Point2D 0 1 )
]
where
a :: Double
a = 0.551915024494
pp, cp :: Point2D Double -> StrokePoint d
pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d
cp ( Point2D x y ) = ControlPoint ( Point2D ( w * x ) ( h * y ) ) d
blob :: forall d. Double -> Double -> d -> Seq ( StrokePoint d )
blob w h d = Seq.fromList
[ pp ( Point2D 1 0 )
, cp ( Point2D 1 -1 )
, cp ( Point2D -1 -1 )
, pp ( Point2D -1 0 )
, cp ( Point2D -1 1 )
, cp ( Point2D 1 1 )
, pp ( Point2D 1 0 )
]
where
pp, cp :: Point2D Double -> StrokePoint d
pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d
cp ( Point2D x y ) = ControlPoint ( Point2D ( w * x ) ( h * y ) ) d
rect :: forall d. Double -> Double -> d -> Seq ( StrokePoint d )
rect w h d = Seq.fromList
[ pp ( Point2D 1 1 )
, pp ( Point2D 1 -1 )
, pp ( Point2D -1 -1 )
, pp ( Point2D -1 1 )
, pp ( Point2D 1 1 )
]
where
pp :: Point2D Double -> StrokePoint d
pp ( Point2D x y ) = PathPoint ( Point2D ( w * x ) ( h * y ) ) d