-- | -- Module: Graphics.ChalkBoard.Shapes -- Copyright: (c) 2009 Andy Gill -- License: BSD3 -- -- Maintainer: Andy Gill -- Stability: unstable -- Portability: ghc -- -- This module contains some basic shape generators, expressed as @Board Bool@. -- module Graphics.ChalkBoard.Shapes where import Graphics.ChalkBoard.Board import Graphics.ChalkBoard.Types import Graphics.ChalkBoard.O import Graphics.ChalkBoard.Utils -- import Control.Applicative {- -- | unit circle, radius 0.5, over origin. circle :: Board Bool circle = Cond (InsideCircle (0,0) 0.5 1 0) (Pure True) (Pure False) circle' = (\ (x,y) -> x*x + y*y <= 0.5 * 0.5) <\$> coord -- | unit vertical bar, 1 wide over origin. vbar :: Board Bool vbar = (\ (_x,y) -> y <= 0.5 && y >= -0.5) <\$> coord -- | unit horizontal bar, 1 high over origin. hbar :: Board Bool hbar = (\ (x,_y) -> x <= 0.5 && x >= -0.5) <\$> coord -- | unit square, 1x1 over origin. square = Cond (InsideBox (-0.5,-0.5) 1 1 0) (Pure True) (Pure False) square' = liftA2 (&&) vbar hbar -} {- --squareO :: Board (O Bool) -- squareO = Polygon [(-0.5,-0.5),(-0.5,0.5),(0.5,0.5),(0.5,-0.5)] -- | cheacker board, with squares 1x1. checker :: Board Bool checker = (\ (x,y) -> even ((floor x + floor y) :: Int)) <\$> coord -- | Given two @Point@s, and a thickness, draw a line between the points. -- line :: Line -> Double -> Board Bool -} {- straightline' ((x1,y1),(x2,y2)) width = (\ (x,y) -> --- distance (x1,y1) (x,y) <= width || -- distance (x2,y2) (x,y) <= width || ( let u = intervalOnLine ((x1,y1),(x2,y2)) (x,y) in u >= 0 && u <= 1 && distance (lerp (x1,y1) (x2,y2) u) (x,y) <= width )) <\$> coord -} -- | A straight line, of a given width, between two points. straightLine :: (Point,Point) -> R -> Board Bool straightLine (p1@(x1,y1),p2@(x2,y2)) w = move (x1,y1) \$ rotate (pi /2 - th) \$ box ((-w/2,0),(w/2,len)) where (xd,yd) = (x2 - x1,y2 - y1) (len,th) = toPolar (xd,yd) pointsToLine :: [Point] -> R -> Board Bool pointsToLine points width = stack [ straightLine (p1,p2) width | (p1,p2) <- zip points (tail points) ] `over` stack [ dotAt p width | p <- tail (init points) ] -- | place dot at this location, with given diameter. dotAt :: Point -> R -> Board Bool dotAt p w = move p \$ scale w circle -- | A line generated by sampling a function from @R@ to @Point@s, -- with a specific width. There needs to be at least 2 sample points. functionLine :: (R -> Point) -> R -> Int -> Board Bool functionLine line width steps = pointsToLine samples width where samples = map line (outerSteps steps) -- | arrowhead is a triangle, pointing straight up, height 1, width 1, with the (0,0) at the center of the base. --arrowhead :: Point -> Radian -> R -> Board Bool --arrowhead p rad sz = move p \$ rotate rad \$ scale sz \$ (\ (x,y) -> y >= 0 && y <= 1 && abs x * 2 <= 1 - y) <\$> coord