{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TemplateHaskell #-}

{-
  Copyright 2020 The CodeWorld Authors. All rights reserved.

  Licensed under the Apache License, Version 2.0 (the "License");
  you may not use this file except in compliance with the License.
  You may obtain a copy of the License at

      http://www.apache.org/licenses/LICENSE-2.0

  Unless required by applicable law or agreed to in writing, software
  distributed under the License is distributed on an "AS IS" BASIS,
  WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
  See the License for the specific language governing permissions and
  limitations under the License.
-}
module CodeWorld.Picture where

import CodeWorld.Color
import Control.DeepSeq
import Data.List
import Data.Text (Text)
import GHC.Generics (Generic)
import GHC.Stack
import Util.EmbedAsUrl

-- | A point in two dimensions.  A point is written with the x coordinate
-- first, and the y coordinate second.  For example, (3, -2) is the point
-- with x coordinate 3 a y coordinate -2.
type Point = (Double, Double)

-- | Moves a given point by given x and y offsets
--
-- >>> translatedPoint 1 2 (10, 10)
-- (11.0, 12.0)
-- >>> translatedPoint (-1) (-2) (0, 0)
-- (-1.0, -2.0)
translatedPoint :: Double -> Double -> Point -> Point
translatedPoint :: Double -> Double -> Point -> Point
translatedPoint Double
tx Double
ty (Double
x, Double
y) = (Double
x forall a. Num a => a -> a -> a
+ Double
tx, Double
y forall a. Num a => a -> a -> a
+ Double
ty)

-- | Rotates a given point by given angle, in radians
--
-- >>> rotatedPoint 45 (10, 0)
-- (7.071, 7.071)
rotatedPoint :: Double -> Point -> Point
rotatedPoint :: Double -> Point -> Point
rotatedPoint = Double -> Point -> Point
rotatedVector

-- | Reflects a given point across a line through the origin at this
-- angle, in radians.  For example, an angle of 0 reflects the point
-- vertically across the x axis, while an angle of @pi / 2@ reflects the
-- point horizontally across the y axis.
reflectedPoint :: Double -> Point -> Point
reflectedPoint :: Double -> Point -> Point
reflectedPoint Double
th (Double
x, Double
y) = (Double
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
a forall a. Num a => a -> a -> a
+ Double
y forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
a, Double
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
a forall a. Num a => a -> a -> a
- Double
y forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
a)
  where
    a :: Double
a = Double
2 forall a. Num a => a -> a -> a
* Double
th

-- | Scales a given point by given x and y scaling factor.  Scaling by a
-- negative factor also reflects across that axis.
--
-- >>> scaledPoint 2 3 (10, 10)
-- (20, 30)
scaledPoint :: Double -> Double -> Point -> Point
scaledPoint :: Double -> Double -> Point -> Point
scaledPoint Double
kx Double
ky (Double
x, Double
y) = (Double
kx forall a. Num a => a -> a -> a
* Double
x, Double
ky forall a. Num a => a -> a -> a
* Double
y)

-- | Dilates a given point by given uniform scaling factor.  Dilating by a
-- negative factor also reflects across the origin.
--
-- >>> dilatedPoint 2 (10, 10)
-- (20, 20)
dilatedPoint :: Double -> Point -> Point
dilatedPoint :: Double -> Point -> Point
dilatedPoint Double
k (Double
x, Double
y) = (Double
k forall a. Num a => a -> a -> a
* Double
x, Double
k forall a. Num a => a -> a -> a
* Double
y)

-- | A two-dimensional vector
type Vector = (Double, Double)

-- | The length of the given vector.
--
-- >>> vectorLength (10, 10)
-- 14.14
vectorLength :: Vector -> Double
vectorLength :: Point -> Double
vectorLength (Double
x, Double
y) = forall a. Floating a => a -> a
sqrt (Double
x forall a. Num a => a -> a -> a
* Double
x forall a. Num a => a -> a -> a
+ Double
y forall a. Num a => a -> a -> a
* Double
y)

-- | The counter-clockwise angle, in radians, that a given vector make with the X-axis
--
-- >>> vectorDirection (1,0)
-- 0.0
-- >>> vectorDirection (1,1)
-- 0.7853981633974483
-- >>> vectorDirection (0,1)
-- 1.5707963267948966
vectorDirection :: Vector -> Double
vectorDirection :: Point -> Double
vectorDirection (Double
x, Double
y) = forall a. RealFloat a => a -> a -> a
atan2 Double
y Double
x

-- | The sum of two vectors
vectorSum :: Vector -> Vector -> Vector
vectorSum :: Point -> Point -> Point
vectorSum (Double
x1, Double
y1) (Double
x2, Double
y2) = (Double
x1 forall a. Num a => a -> a -> a
+ Double
x2, Double
y1 forall a. Num a => a -> a -> a
+ Double
y2)

-- | The difference of two vectors
vectorDifference :: Vector -> Vector -> Vector
vectorDifference :: Point -> Point -> Point
vectorDifference (Double
x1, Double
y1) (Double
x2, Double
y2) = (Double
x1 forall a. Num a => a -> a -> a
- Double
x2, Double
y1 forall a. Num a => a -> a -> a
- Double
y2)

-- | Scales a given vector by a given scalar multiplier.
--
-- >>> scaledPoint 2 (10, 10)
-- (20, 20)
scaledVector :: Double -> Vector -> Vector
scaledVector :: Double -> Point -> Point
scaledVector Double
k (Double
x, Double
y) = (Double
k forall a. Num a => a -> a -> a
* Double
x, Double
k forall a. Num a => a -> a -> a
* Double
y)

-- | Rotates a given vector by a given angle in radians
--
-- >>> rotatedVector pi (1.0, 0.0)
-- (-1.0, 1.2246467991473532e-16)
-- >>> rotatedVector (pi / 2) (1.0, 0.0)
-- (6.123233995736766e-17, 1.0)
rotatedVector :: Double -> Vector -> Vector
rotatedVector :: Double -> Point -> Point
rotatedVector Double
angle (Double
x, Double
y) =
  (Double
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
angle forall a. Num a => a -> a -> a
- Double
y forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
angle, Double
x forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
sin Double
angle forall a. Num a => a -> a -> a
+ Double
y forall a. Num a => a -> a -> a
* forall a. Floating a => a -> a
cos Double
angle)

-- | The dot product of two vectors
dotProduct :: Vector -> Vector -> Double
dotProduct :: Point -> Point -> Double
dotProduct (Double
x1, Double
y1) (Double
x2, Double
y2) = Double
x1 forall a. Num a => a -> a -> a
* Double
x2 forall a. Num a => a -> a -> a
+ Double
y1 forall a. Num a => a -> a -> a
* Double
y2

-- | A design, diagram, or drawing that can be displayed and seen.
-- In technical terms, a picture is an assignment of a color to
-- every point of the coordinate plane.  CodeWorld contains functions
-- to create pictures from simple geometry primitives, to transform
-- existing pictures, and to combine simpler pictures into more
-- complex compositions.
--
-- Ultimately, a picture can be drawn on the screen using one of the
-- CodeWorld entry points such as 'drawingOf'.
data Picture
  = SolidPolygon (Maybe SrcLoc) [Point]
  | SolidClosedCurve (Maybe SrcLoc) [Point]
  | Polygon (Maybe SrcLoc) [Point]
  | ThickPolygon (Maybe SrcLoc) [Point] !Double
  | Rectangle (Maybe SrcLoc) !Double !Double
  | SolidRectangle (Maybe SrcLoc) !Double !Double
  | ThickRectangle (Maybe SrcLoc) !Double !Double !Double
  | ClosedCurve (Maybe SrcLoc) [Point]
  | ThickClosedCurve (Maybe SrcLoc) [Point] !Double
  | Polyline (Maybe SrcLoc) [Point]
  | ThickPolyline (Maybe SrcLoc) [Point] !Double
  | Curve (Maybe SrcLoc) [Point]
  | ThickCurve (Maybe SrcLoc) [Point] !Double
  | Circle (Maybe SrcLoc) !Double
  | SolidCircle (Maybe SrcLoc) !Double
  | ThickCircle (Maybe SrcLoc) !Double !Double
  | Sector (Maybe SrcLoc) !Double !Double !Double
  | Arc (Maybe SrcLoc) !Double !Double !Double
  | ThickArc (Maybe SrcLoc) !Double !Double !Double !Double
  | StyledLettering (Maybe SrcLoc) !TextStyle !Font !Text
  | Lettering (Maybe SrcLoc) !Text
  | Color (Maybe SrcLoc) !Color !Picture
  | Translate (Maybe SrcLoc) !Double !Double !Picture
  | Scale (Maybe SrcLoc) !Double !Double !Picture
  | Dilate (Maybe SrcLoc) !Double !Picture
  | Rotate (Maybe SrcLoc) !Double !Picture
  | Reflect (Maybe SrcLoc) !Double !Picture
  | Clip (Maybe SrcLoc) !Double !Double !Picture
  | CoordinatePlane (Maybe SrcLoc)
  | Sketch (Maybe SrcLoc) !Text !Text !Double !Double
  | Pictures (Maybe SrcLoc) [Picture]
  | PictureAnd (Maybe SrcLoc) [Picture]
  | Blank (Maybe SrcLoc)
  deriving (forall x. Rep Picture x -> Picture
forall x. Picture -> Rep Picture x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Picture x -> Picture
$cfrom :: forall x. Picture -> Rep Picture x
Generic)

instance NFData Picture

-- A style in which to draw lettering.  Either 'Plain', 'Bold', or
-- 'Italic'
data TextStyle
  = -- | Plain letters with no style
    Plain
  | -- | Heavy, thick lettering used for emphasis
    Bold
  | -- | Slanted script-like lettering used for emphasis
    Italic
  deriving (forall x. Rep TextStyle x -> TextStyle
forall x. TextStyle -> Rep TextStyle x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TextStyle x -> TextStyle
$cfrom :: forall x. TextStyle -> Rep TextStyle x
Generic, Int -> TextStyle -> ShowS
[TextStyle] -> ShowS
TextStyle -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [TextStyle] -> ShowS
$cshowList :: [TextStyle] -> ShowS
show :: TextStyle -> [Char]
$cshow :: TextStyle -> [Char]
showsPrec :: Int -> TextStyle -> ShowS
$cshowsPrec :: Int -> TextStyle -> ShowS
Show)

instance NFData TextStyle

-- A font in which to draw lettering.  There are several built-in
-- font families ('SansSerif', 'Serif', 'Monospace', 'Handwriting',
-- and 'Fancy') that can look different on each screen.  'NamedFont'
-- can be used for a specific font.  However, if the font is not
-- installed on the computer running your program, a different font
-- may be used instead.
data Font
  = SansSerif
  | Serif
  | Monospace
  | Handwriting
  | Fancy
  | NamedFont !Text
  deriving (forall x. Rep Font x -> Font
forall x. Font -> Rep Font x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Font x -> Font
$cfrom :: forall x. Font -> Rep Font x
Generic, Int -> Font -> ShowS
[Font] -> ShowS
Font -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [Font] -> ShowS
$cshowList :: [Font] -> ShowS
show :: Font -> [Char]
$cshow :: Font -> [Char]
showsPrec :: Int -> Font -> ShowS
$cshowsPrec :: Int -> Font -> ShowS
Show)

instance NFData Font

-- | A blank picture
blank :: HasCallStack => Picture
blank :: HasCallStack => Picture
blank = Maybe SrcLoc -> Picture
Blank (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A thin sequence of line segments, with these points as endpoints
polyline :: HasCallStack => [Point] -> Picture
polyline :: HasCallStack => [Point] -> Picture
polyline [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
Polyline (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

-- | A thick sequence of line segments, with given line width and endpoints
thickPolyline :: HasCallStack => Double -> [Point] -> Picture
thickPolyline :: HasCallStack => Double -> [Point] -> Picture
thickPolyline Double
n [Point]
ps = Maybe SrcLoc -> [Point] -> Double -> Picture
ThickPolyline (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps Double
n

-- | A thin polygon with these points as vertices
polygon :: HasCallStack => [Point] -> Picture
polygon :: HasCallStack => [Point] -> Picture
polygon [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
Polygon (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

-- | A thick polygon with this line width and these points as
-- vertices
thickPolygon :: HasCallStack => Double -> [Point] -> Picture
thickPolygon :: HasCallStack => Double -> [Point] -> Picture
thickPolygon Double
n [Point]
ps = Maybe SrcLoc -> [Point] -> Double -> Picture
ThickPolygon (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps Double
n

-- | A solid polygon with these points as vertices
solidPolygon :: HasCallStack => [Point] -> Picture
solidPolygon :: HasCallStack => [Point] -> Picture
solidPolygon [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
SolidPolygon (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

-- | A smooth curve passing through these points.
curve :: HasCallStack => [Point] -> Picture
curve :: HasCallStack => [Point] -> Picture
curve [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
Curve (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

-- | A thick smooth curve with this line width, passing through these points.
thickCurve :: HasCallStack => Double -> [Point] -> Picture
thickCurve :: HasCallStack => Double -> [Point] -> Picture
thickCurve Double
n [Point]
ps = Maybe SrcLoc -> [Point] -> Double -> Picture
ThickCurve (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps Double
n

-- | A smooth closed curve passing through these points.
closedCurve :: HasCallStack => [Point] -> Picture
closedCurve :: HasCallStack => [Point] -> Picture
closedCurve [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
ClosedCurve (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

-- | A thick smooth closed curve with this line width, passing through these points.
thickClosedCurve :: HasCallStack => Double -> [Point] -> Picture
thickClosedCurve :: HasCallStack => Double -> [Point] -> Picture
thickClosedCurve Double
n [Point]
ps = Maybe SrcLoc -> [Point] -> Double -> Picture
ThickClosedCurve (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps Double
n

-- | A solid smooth closed curve passing through these points.
solidClosedCurve :: HasCallStack => [Point] -> Picture
solidClosedCurve :: HasCallStack => [Point] -> Picture
solidClosedCurve [Point]
ps = Maybe SrcLoc -> [Point] -> Picture
SolidClosedCurve (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Point]
ps

rectangleVertices :: Double -> Double -> [Point]
rectangleVertices :: Double -> Double -> [Point]
rectangleVertices Double
w Double
h = [(Double
w forall a. Fractional a => a -> a -> a
/ Double
2, Double
h forall a. Fractional a => a -> a -> a
/ Double
2), (Double
w forall a. Fractional a => a -> a -> a
/ Double
2, - Double
h forall a. Fractional a => a -> a -> a
/ Double
2), (- Double
w forall a. Fractional a => a -> a -> a
/ Double
2, - Double
h forall a. Fractional a => a -> a -> a
/ Double
2), (- Double
w forall a. Fractional a => a -> a -> a
/ Double
2, Double
h forall a. Fractional a => a -> a -> a
/ Double
2)]

-- | A thin rectangle, with this width and height
rectangle :: HasCallStack => Double -> Double -> Picture
rectangle :: HasCallStack => Double -> Double -> Picture
rectangle Double
w Double
h = Maybe SrcLoc -> Double -> Double -> Picture
Rectangle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) Double
w Double
h

-- | A solid rectangle, with this width and height
solidRectangle :: HasCallStack => Double -> Double -> Picture
solidRectangle :: HasCallStack => Double -> Double -> Picture
solidRectangle Double
w Double
h = Maybe SrcLoc -> Double -> Double -> Picture
SolidRectangle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) Double
w Double
h

-- | A thick rectangle, with this line width, and width and height
thickRectangle :: HasCallStack => Double -> Double -> Double -> Picture
thickRectangle :: HasCallStack => Double -> Double -> Double -> Picture
thickRectangle Double
lw Double
w Double
h = Maybe SrcLoc -> Double -> Double -> Double -> Picture
ThickRectangle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) Double
lw Double
w Double
h

-- | A thin circle, with this radius
circle :: HasCallStack => Double -> Picture
circle :: HasCallStack => Double -> Picture
circle = Maybe SrcLoc -> Double -> Picture
Circle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A thick circle, with this line width and radius
thickCircle :: HasCallStack => Double -> Double -> Picture
thickCircle :: HasCallStack => Double -> Double -> Picture
thickCircle = Maybe SrcLoc -> Double -> Double -> Picture
ThickCircle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A thin arc, starting and ending at these angles, with this radius
--
-- Angles are in radians.
arc :: HasCallStack => Double -> Double -> Double -> Picture
arc :: HasCallStack => Double -> Double -> Double -> Picture
arc Double
b Double
e Double
r = Maybe SrcLoc -> Double -> Double -> Double -> Picture
Arc (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) Double
b Double
e Double
r

-- | A thick arc with this line width, starting and ending at these angles,
-- with this radius.
--
-- Angles are in radians.
thickArc :: HasCallStack => Double -> Double -> Double -> Double -> Picture
thickArc :: HasCallStack => Double -> Double -> Double -> Double -> Picture
thickArc Double
w Double
b Double
e Double
r = Maybe SrcLoc -> Double -> Double -> Double -> Double -> Picture
ThickArc (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) Double
b Double
e Double
r Double
w

-- | A solid circle, with this radius
solidCircle :: HasCallStack => Double -> Picture
solidCircle :: HasCallStack => Double -> Picture
solidCircle = Maybe SrcLoc -> Double -> Picture
SolidCircle (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A solid sector of a circle (i.e., a pie slice) starting and ending at these
-- angles, with this radius
--
-- Angles are in radians.
sector :: HasCallStack => Double -> Double -> Double -> Picture
sector :: HasCallStack => Double -> Double -> Double -> Picture
sector = Maybe SrcLoc -> Double -> Double -> Double -> Picture
Sector (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A rendering of text characters.
lettering :: HasCallStack => Text -> Picture
lettering :: HasCallStack => Text -> Picture
lettering = Maybe SrcLoc -> Text -> Picture
Lettering (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A rendering of text characters onto a Picture, with a specific
-- choice of font and style.
styledLettering :: HasCallStack => TextStyle -> Font -> Text -> Picture
styledLettering :: HasCallStack => TextStyle -> Font -> Text -> Picture
styledLettering = Maybe SrcLoc -> TextStyle -> Font -> Text -> Picture
StyledLettering (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture drawn entirely in this color.
colored :: HasCallStack => Color -> Picture -> Picture
colored :: HasCallStack => Color -> Picture -> Picture
colored = Maybe SrcLoc -> Color -> Picture -> Picture
Color (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture drawn entirely in this colour.
coloured :: HasCallStack => Color -> Picture -> Picture
coloured :: HasCallStack => Color -> Picture -> Picture
coloured = HasCallStack => Color -> Picture -> Picture
colored

-- | A picture drawn translated in these directions.
translated :: HasCallStack => Double -> Double -> Picture -> Picture
translated :: HasCallStack => Double -> Double -> Picture -> Picture
translated = Maybe SrcLoc -> Double -> Double -> Picture -> Picture
Translate (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture scaled by these factors in the x and y directions.  Scaling
-- by a negative factoralso reflects across that axis.
scaled :: HasCallStack => Double -> Double -> Picture -> Picture
scaled :: HasCallStack => Double -> Double -> Picture -> Picture
scaled = Maybe SrcLoc -> Double -> Double -> Picture -> Picture
Scale (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture scaled uniformly in all directions by this scale factor.
-- Dilating by a negative factor also reflects across the origin.
dilated :: HasCallStack => Double -> Picture -> Picture
dilated :: HasCallStack => Double -> Picture -> Picture
dilated = Maybe SrcLoc -> Double -> Picture -> Picture
Dilate (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture rotated by this angle about the origin.
--
-- Angles are in radians.
rotated :: HasCallStack => Double -> Picture -> Picture
rotated :: HasCallStack => Double -> Picture -> Picture
rotated = Maybe SrcLoc -> Double -> Picture -> Picture
Rotate (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture reflected across a line through the origin at this angle, in
-- radians.  For example, an angle of 0 reflects the picture vertically
-- across the x axis, while an angle of @pi / 2@ reflects the picture
-- horizontally across the y axis.
reflected :: HasCallStack => Double -> Picture -> Picture
reflected :: HasCallStack => Double -> Picture -> Picture
reflected = Maybe SrcLoc -> Double -> Picture -> Picture
Reflect (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | A picture clipped to a rectangle around the origin with this width and height.
clipped :: HasCallStack => Double -> Double -> Picture -> Picture
clipped :: HasCallStack => Double -> Double -> Picture -> Picture
clipped = Maybe SrcLoc -> Double -> Double -> Picture -> Picture
Clip (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- A picture made by drawing these pictures, ordered from top to bottom.
pictures :: HasCallStack => [Picture] -> Picture
pictures :: HasCallStack => [Picture] -> Picture
pictures = Maybe SrcLoc -> [Picture] -> Picture
Pictures (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | Binary composition of pictures.
(&) :: HasCallStack => Picture -> Picture -> Picture

infixr 0 &

Picture
a & :: HasCallStack => Picture -> Picture -> Picture
& PictureAnd Maybe SrcLoc
loc2 [Picture]
bs
  | Maybe SrcLoc -> Maybe SrcLoc -> Bool
srcContains Maybe SrcLoc
loc1 Maybe SrcLoc
loc2 = Maybe SrcLoc -> [Picture] -> Picture
PictureAnd Maybe SrcLoc
loc1 (Picture
a forall a. a -> [a] -> [a]
: [Picture]
bs)
  where
    loc1 :: Maybe SrcLoc
loc1 = CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack
Picture
a & Picture
b = Maybe SrcLoc -> [Picture] -> Picture
PictureAnd (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack) [Picture
a, Picture
b]

instance Monoid Picture where
  mempty :: Picture
mempty = HasCallStack => Picture
blank
  mconcat :: [Picture] -> Picture
mconcat = HasCallStack => [Picture] -> Picture
pictures

instance Semigroup Picture where
  <> :: Picture -> Picture -> Picture
(<>) = HasCallStack => Picture -> Picture -> Picture
(&)

-- | A coordinate plane.  Adding this to your pictures can help you measure distances
-- more accurately.
--
-- Example:
-- @
-- main = drawingOf (myPicture <> coordinatePlane)
-- myPicture = ...
-- @
coordinatePlane :: HasCallStack => Picture
coordinatePlane :: HasCallStack => Picture
coordinatePlane = Maybe SrcLoc -> Picture
CoordinatePlane (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

-- | The CodeWorld logo.
codeWorldLogo :: HasCallStack => Picture
codeWorldLogo :: HasCallStack => Picture
codeWorldLogo =
  Maybe SrcLoc -> Text -> Text -> Double -> Double -> Picture
Sketch
    (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)
    Text
"codeWorldLogo"
    $(embedAsUrl "image/svg+xml" "data/codeworld.svg")
    Double
17.68
    Double
7.28

-- | An image from a standard image format.  The image can be any universally
-- supported format, including SVG, PNG, JPG, etc.  SVG should be preferred, as
-- it behaves better with transformations.
image ::
  HasCallStack =>
  -- | Name for the picture, used for debugging
  Text ->
  -- | Data-scheme URI for the image data
  Text ->
  -- | Width, in CodeWorld screen units
  Double ->
  -- | Height, in CodeWorld screen units
  Double ->
  Picture
image :: HasCallStack => Text -> Text -> Double -> Double -> Picture
image = Maybe SrcLoc -> Text -> Text -> Double -> Double -> Picture
Sketch (CallStack -> Maybe SrcLoc
getDebugSrcLoc HasCallStack => CallStack
callStack)

getDebugSrcLoc :: CallStack -> Maybe SrcLoc
getDebugSrcLoc :: CallStack -> Maybe SrcLoc
getDebugSrcLoc CallStack
cs = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
Data.List.find ((forall a. Eq a => a -> a -> Bool
== [Char]
"main") forall b c a. (b -> c) -> (a -> b) -> a -> c
. SrcLoc -> [Char]
srcLocPackage) [SrcLoc]
locs
  where
    locs :: [SrcLoc]
locs = forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> b
snd (CallStack -> [([Char], SrcLoc)]
getCallStack CallStack
cs)

srcContains :: Maybe SrcLoc -> Maybe SrcLoc -> Bool
srcContains :: Maybe SrcLoc -> Maybe SrcLoc -> Bool
srcContains Maybe SrcLoc
Nothing Maybe SrcLoc
_ = Bool
False
srcContains Maybe SrcLoc
_ Maybe SrcLoc
Nothing = Bool
True
srcContains (Just SrcLoc
a) (Just SrcLoc
b) =
  SrcLoc -> [Char]
srcLocFile SrcLoc
a forall a. Eq a => a -> a -> Bool
== SrcLoc -> [Char]
srcLocFile SrcLoc
b Bool -> Bool -> Bool
&& SrcLoc -> Int
srcLocStartLine SrcLoc
a forall a. Ord a => a -> a -> Bool
< SrcLoc -> Int
srcLocStartLine SrcLoc
b
    Bool -> Bool -> Bool
|| ( SrcLoc -> Int
srcLocStartLine SrcLoc
a forall a. Eq a => a -> a -> Bool
== SrcLoc -> Int
srcLocStartLine SrcLoc
b
           Bool -> Bool -> Bool
&& SrcLoc -> Int
srcLocStartCol SrcLoc
a forall a. Ord a => a -> a -> Bool
<= SrcLoc -> Int
srcLocStartCol SrcLoc
b
       )
    Bool -> Bool -> Bool
&& SrcLoc -> Int
srcLocEndLine SrcLoc
a forall a. Ord a => a -> a -> Bool
> SrcLoc -> Int
srcLocEndLine SrcLoc
b
    Bool -> Bool -> Bool
|| (SrcLoc -> Int
srcLocEndLine SrcLoc
a forall a. Eq a => a -> a -> Bool
== SrcLoc -> Int
srcLocEndLine SrcLoc
b Bool -> Bool -> Bool
&& SrcLoc -> Int
srcLocEndCol SrcLoc
a forall a. Ord a => a -> a -> Bool
>= SrcLoc -> Int
srcLocEndCol SrcLoc
b)