module CodeWorld.Picture where
import CodeWorld.Color
import Data.Monoid ((<>))
import Data.Text (Text, pack)
import GHC.Stack
type Point = (Double, Double)
type Vector = (Double, Double)
vectorLength :: Vector -> Double
vectorLength (x, y) = sqrt (x ^ 2 + y ^ 2)
vectorDirection :: Vector -> Double
vectorDirection (x, y) = atan2 y x
vectorSum :: Vector -> Vector -> Vector
vectorSum (x1, y1) (x2, y2) = (x1 + x2, y1 + y2)
vectorDifference :: Vector -> Vector -> Vector
vectorDifference (x1, y1) (x2, y2) = (x1 x2, y1 y2)
scaledVector :: Double -> Vector -> Vector
scaledVector k (x, y) = (k * x, k * y)
rotatedVector :: Double -> Vector -> Vector
rotatedVector angle (x, y) =
(x * cos angle y * sin angle, x * sin angle + y * cos angle)
dotProduct :: Vector -> Vector -> Double
dotProduct (x1, y1) (x2, y2) = x1 * x2 + y1 * y2
data Picture
= Polygon CallStack
[Point]
!Bool
| Path CallStack
[Point]
!Double
!Bool
!Bool
| Sector CallStack
!Double
!Double
!Double
| Arc CallStack
!Double
!Double
!Double
!Double
| Text CallStack
!TextStyle
!Font
!Text
| Color CallStack
!Color
!Picture
| Translate CallStack
!Double
!Double
!Picture
| Scale CallStack
!Double
!Double
!Picture
| Rotate CallStack
!Double
!Picture
| CoordinatePlane CallStack
| Logo CallStack
| Pictures [Picture]
data TextStyle
= Plain
| Bold
| Italic
data Font
= SansSerif
| Serif
| Monospace
| Handwriting
| Fancy
| NamedFont !Text
blank :: Picture
blank = Pictures []
polyline :: HasCallStack => [Point] -> Picture
polyline ps = Path callStack ps 0 False False
path :: HasCallStack => [Point] -> Picture
path ps = Path callStack ps 0 False False
thickPolyline :: HasCallStack => Double -> [Point] -> Picture
thickPolyline n ps = Path callStack ps n False False
thickPath :: HasCallStack => Double -> [Point] -> Picture
thickPath n ps = Path callStack ps n False False
polygon :: HasCallStack => [Point] -> Picture
polygon ps = Path callStack ps 0 True False
thickPolygon :: HasCallStack => Double -> [Point] -> Picture
thickPolygon n ps = Path callStack ps n True False
solidPolygon :: HasCallStack => [Point] -> Picture
solidPolygon ps = Polygon callStack ps False
curve :: HasCallStack => [Point] -> Picture
curve ps = Path callStack ps 0 False True
thickCurve :: HasCallStack => Double -> [Point] -> Picture
thickCurve n ps = Path callStack ps n False True
closedCurve :: HasCallStack => [Point] -> Picture
closedCurve ps = Path callStack ps 0 True True
loop :: HasCallStack => [Point] -> Picture
loop ps = Path callStack ps 0 True True
thickClosedCurve :: HasCallStack => Double -> [Point] -> Picture
thickClosedCurve n ps = Path callStack ps n True True
thickLoop :: HasCallStack => Double -> [Point] -> Picture
thickLoop n ps = Path callStack ps n True True
solidClosedCurve :: HasCallStack => [Point] -> Picture
solidClosedCurve ps = Polygon callStack ps True
solidLoop :: HasCallStack => [Point] -> Picture
solidLoop ps = Polygon callStack ps True
rectangle :: HasCallStack => Double -> Double -> Picture
rectangle w h =
polygon [(w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2)]
solidRectangle :: HasCallStack => Double -> Double -> Picture
solidRectangle w h =
solidPolygon
[(w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2)]
thickRectangle :: HasCallStack => Double -> Double -> Double -> Picture
thickRectangle lw w h =
thickPolygon
lw
[(w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2), (w / 2, h / 2)]
circle :: HasCallStack => Double -> Picture
circle = arc 0 (2 * pi)
thickCircle :: HasCallStack => Double -> Double -> Picture
thickCircle w = thickArc w 0 (2 * pi)
arc :: HasCallStack => Double -> Double -> Double -> Picture
arc b e r = Arc callStack b e r 0
thickArc :: HasCallStack => Double -> Double -> Double -> Double -> Picture
thickArc w b e r = Arc callStack b e r w
solidCircle :: HasCallStack => Double -> Picture
solidCircle = sector 0 (2 * pi)
sector :: HasCallStack => Double -> Double -> Double -> Picture
sector = Sector callStack
text :: HasCallStack => Text -> Picture
text = Text callStack Plain Serif
styledText :: HasCallStack => TextStyle -> Font -> Text -> Picture
styledText = Text callStack
colored :: HasCallStack => Color -> Picture -> Picture
colored = Color callStack
coloured :: HasCallStack => Color -> Picture -> Picture
coloured = colored
translated :: HasCallStack => Double -> Double -> Picture -> Picture
translated = Translate callStack
scaled :: HasCallStack => Double -> Double -> Picture -> Picture
scaled = Scale callStack
dilated :: HasCallStack => Double -> Picture -> Picture
dilated k = scaled k k
rotated :: HasCallStack => Double -> Picture -> Picture
rotated = Rotate callStack
pictures :: [Picture] -> Picture
pictures = Pictures
instance Monoid Picture where
mempty = blank
mappend a (Pictures bs) = Pictures (a : bs)
mappend a b = Pictures [a, b]
mconcat = pictures
(&) :: Picture -> Picture -> Picture
infixr 0 &
(&) = mappend
coordinatePlane :: HasCallStack => Picture
coordinatePlane = CoordinatePlane callStack
codeWorldLogo :: HasCallStack => Picture
codeWorldLogo = Logo callStack