content: {-# LANGUAGE OverloadedStrings #-}
  {-# LANGUAGE PackageImports #-}
  {-# LANGUAGE ParallelListComp #-}
  {-# LANGUAGE RebindableSyntax #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# LANGUAGE NoImplicitPrelude #-}
  
  -------------------------------------------------------------------------------
  
  -- | Additional entry points and graphical primitives for CodeWorld.
  --
  -- To use a function defined in this module, you must begin your code with this
  -- line:
  --
  -- > import Extras.Cw(function)
  --
  -- where instead of @function@ you write the actual name of the function you
  -- want to use.
  --
  -- You can specifiy more than one function. For example, if you want to use 3
  -- functions, then instead of writing 3 separate @import@ lines, you can write
  -- this:
  --
  -- > import Extras.Cw(function1,function2,function3)
  --
  -- All the functions defined in this module could be implemented directly
  -- in CodeWorld, as no internal features of the CodeWorld system are
  -- used in their implementation. These functions are provided to save
  -- you the tedium of having to add them to your code. To keep this module
  -- as small as possible, functions are added to this module only when
  -- it has been observed that several people keep adding variations of them
  -- to their respective codes.
  module Extras.Cw
    ( -- * Animation convenience functions
      between,
      beyond,
      saw,
  
      -- * Functions for accessing the points in a curve
      openCurvePoints,
      closedCurvePoints,
  
      -- * Layout
      pageFromTexts,
      grid,
      sprite,
      overlays,
      underlays,
      squareFrame,
  
      -- * Graphing
      graphed,
      wideGraphed,
      customGraphed,
  
      -- * Drawing Trees
      Tree,
      (-<),
      treeDepth,
      treeWidth,
      tree,
  
      -- * New entry points
      slideshow,
      autoSlideshow,
  
      -- * Entry points with randomization
      -- $randomIntro
      randomDrawingOf,
      randomAnimationOf,
      randomSlideshow,
      randomAutoSlideshow,
    )
  where
  
  import Extras.Util
  import Prelude
  
  -------------------------------------------------------------------------------
  --- Top Level
  -------------------------------------------------------------------------------
  
  -- | A slide show of the given list of pictures with keyboard and mouse
  -- navigation. The following keys can be used to control the slide show:
  --
  --     * Restart the slide show: R
  --     * Go to the next slide: N, space bar, Enter, Page Down
  --     * Go to the previous slide: P, Backspace, Page Up
  --
  -- The given list of pictures must be finite. When the last slide is
  -- reached, the slide show will wrap, so that the first slide is shown
  -- next. This function cannot be used for showing undelimited step-motion
  -- animations.
  slideshow :: [Picture] -> Program
  slideshow (slides) = randomSlideshow (makeslides)
    where
      makeslides _ = slides
  
  -- | A slide show that automatically cycles through the list of given
  -- pictures. Each picture will be shown for the given number of seconds
  -- before advancing to the next picture.
  autoSlideshow :: ([Picture], Number) -> Program
  autoSlideshow (slides, period) = animationOf (sshow)
    where
      len = length (slides)
      sshow (t)
        | len < 1 = pictures ([])
        | otherwise = slides #num
        where
          num = 1 + remainder (truncation (t / period), len)
  
  -- $randomIntro
  -- All the randomized versions of entry points provided in this module use
  -- the same mechanism to handle random numbers. Before your code runs,
  -- the CodeWorld system generates a very large list of random numbers,
  -- which is passed to your code. For efficiency, the list is generated
  -- on demand, so that only those random numbers actually used in your code
  -- are generated. All the random numbers that the system generates are
  -- between 0 (included) and 1 (excluded).
  --
  -- Using the randomized versions is very simple.
  -- When you click on the output window, the drawing or animation that is
  -- currently being shown is replaced with a new one that uses different
  -- random numbers. You can keep clicking on your output to see different
  -- randomized outputs of your program.
  --
  -- When you write a program that uses the randomized versions,
  -- instead of providing a definition of a drawing, you
  -- must provide a definition of a function that takes in the list of
  -- random numbers as
  -- input and generates your drawing as output. Inside your function, you
  -- can use as many random numbers as you want.
  
  -- | A randomized version of 'drawingOf'
  --
  -- Example:
  --
  -- > program = randomDrawingOf(draw)
  -- > draw(random) = solidRectangle(width,height)
  -- >     where
  -- >     width  = 1 + 9 * random#1
  -- >     height = 1 + 9 * random#2
  --
  -- The example above will show a different rectangle every time you click
  -- on the output. The width and the height will vary randomly between 1
  -- and 10 units.
  randomDrawingOf :: ([Number] -> Picture) -> Program
  randomDrawingOf (makeDrawing) = activityOf (initial, handle, draw)
    where
      initial rs = rs
      handle (r : rs, PointerPress (_)) = rs
      handle (model, _) = model
      draw (r : _) = makeDrawing (randomNumbers (r))
  
  -- | A randomized version of 'animationOf'
  --
  -- Example:
  --
  -- > program = randomAnimationOf(movie)
  -- > movie(random,t) = rotated(solidRectangle(width,height),45*t)
  -- >     where
  -- >     width  = 1 + 9 * random#1
  -- >     height = 1 + 9 * random#2
  --
  -- The example above will show a random rectangle that rotates around
  -- the origin. When you click on the output, a different random rectangle
  -- will be shown, which will also be rotating around the origin.
  randomAnimationOf :: (([Number], Number) -> Picture) -> Program
  randomAnimationOf (movie) = activityOf (initial, handle, draw)
    where
      initial (seed : rs) = (rs, 0, seed)
      handle ((rs, t, seed), TimePassing (dt)) = (rs, t + dt, seed)
      handle ((rs, t, seed), PointerPress (_)) = (newrs, t, newseed)
        where
          newseed : newrs = randomNumbers (seed)
      handle (model, _) = model
      draw (rs, t, seed) = movie (rs, t)
  
  -- | A randomized version of 'slideshow'
  randomSlideshow :: ([Number] -> [Picture]) -> Program
  randomSlideshow = randomSlideshow_
  
  -- | A randomized version of 'autoSlideshow'
  randomAutoSlideshow :: ([Number] -> [Picture], Number) -> Program
  randomAutoSlideshow (mkslides, period) = activityOf (initial, update, render)
    where
      initial (r : rs) =
        SS
          { time = 0,
            tlast = 0,
            current = 1,
            random = rs,
            slides = mkslides (randomNumbers (r))
          }
      update (ss, TimePassing (dt)) = update_wrap (update_current (update_time (ss, dt)))
      update (ss, _) = ss
      update_time (ss@(SS {..}), dt) = ss {time = time + dt}
      update_current ss@(SS {..})
        | time - tlast > period =
          ss
            { tlast = tlast + period,
              current = current + 1
            }
        | otherwise = ss
      update_wrap ss@(SS {..})
        | current > length (slides) =
          ss
            { current = 1,
              random = rs,
              slides = mkslides (randomNumbers (r))
            }
        | otherwise = ss
        where
          r : rs = random
      render (SS {..}) = slides #current
  
  -------------------------------------------------------------------------------
  --- Top Level
  -------------------------------------------------------------------------------
  
  data SS = SS
    { time :: Number,
      tlast :: Number,
      current :: Number,
      random :: [Number],
      slides :: [Picture]
    }
  
  randomSlideshow_ :: ([Number] -> [Picture]) -> Program
  randomSlideshow_ (mkslides) = activityOf (initial, handle, render)
    where
      initial (r : rs) =
        SS
          { time = 0,
            tlast = 0,
            current = 1,
            random = rs,
            slides = mkslides (randomNumbers (r))
          }
      render (SS {..})
        | empty (slides) = pictures ([])
        | otherwise = showSlide & slides #current
        where
          showSlide
            | time - tlast > 2 = blank
            | otherwise = translated (mark, -9.5, -9.5)
          mark =
            scaled (lettering (printed (current)), 0.5, 0.5)
              & colored (solidRectangle (1, 1), RGB (0.9, 0.9, 0.9))
      handle (ss@(SS {..}), TimePassing (dt)) = ss {time = time + dt}
      handle (ss, event) = mayHandleEvent (ss)
        where
          handleNav (c, s) = case event of
            KeyPress "R" -> 1 + length (s)
            KeyPress "N" -> c + 1
            KeyPress " " -> c + 1
            KeyPress "Enter" -> c + 1
            KeyPress "PageDown" -> c + 1
            KeyPress "P" -> c -1
            KeyPress "PageUp" -> c -1
            KeyPress "Backspace" -> c -1
            PointerPress _ -> c + 1
            other -> c
          handlePan (c, s) = case event of
            KeyPress "Left" -> over c moveleft s
            KeyPress "Right" -> over c moveright s
            KeyPress "Up" -> over c moveup s
            KeyPress "Down" -> over c movedown s
            KeyPress "A" -> over c moveleft s
            KeyPress "D" -> over c moveright s
            KeyPress "W" -> over c moveup s
            KeyPress "S" -> over c movedown s
            --KeyPress key -> (0,[messages [key]])
            other -> s
            where
              moveleft (p) = translated (p, -1, 0)
              moveright (p) = translated (p, 1, 0)
              moveup (p) = translated (p, 0, 1)
              movedown (p) = translated (p, 0, -1)
              over n f slides =
                [ if i == n then f s else s
                  | s <- slides
                  | i <- [1 ..]
                ]
          mayHandleEvent (ss) = wrap (handleEvent (ss))
          handleEvent ss@(SS {..}) =
            ss
              { current = nextCurrent,
                tlast = time,
                slides = handlePan (current, slides)
              }
            where
              nextCurrent = handleNav (current, slides)
          remake ss@(SS {..}) =
            ss
              { random = rs,
                slides = mkslides (randomNumbers (r))
              }
            where
              r : rs = random
          realign (ss, newCurrent) = ss {current = newCurrent}
          wrap ss@(SS {..})
            | current > nslides = wrap (realign (remake (ss), current - nslides))
            | current < 1 = wrap (realign (remake (ss), current + nslides))
            | otherwise = ss
            where
              nslides = length (slides)
  
  -------------------------------------------------------------------------------
  -- Animation Helpers
  -------------------------------------------------------------------------------
  
  -- | The expression @between(t,start,stop,drawing)@ will show
  -- the given @drawing@ when the time @t@ is between @start@ and @stop@
  between :: (Number, Number, Number, Picture) -> Picture
  between (t, start, stop, drawing) =
    if t < start
      then blank
      else
        if t < stop
          then drawing
          else blank
  
  -- | The expression @beyond(t,start,drawing)@ will
  -- show the given @drawing@ when the time @t@ is beyond the @start@ time
  beyond :: (Number, Number, Picture) -> Picture
  beyond (t, start, drawing) =
    if t < start
      then blank
      else drawing
  
  -- | The expression @saw(t,p)@ is @0@
  -- when @t=0@, increases up to 1 when @t=p/2@, and then decreases back
  -- to 0 when @t=p@.
  -- This increasing and decreasing when @t@ goes from @0@ to @p@ is called
  -- an oscillation of period @p@. The oscillations will keep repeating,
  -- so that the function is @0@ when @t@ is @0,p,2p,3p,4p,5p,...@
  -- and it is 1 when @t@ is @p/2@, @3p/2@, @5p/2@, @7p/2@, @...@
  saw :: (Number, Number) -> Number
  saw (t, p) = 1 - abs (2 * abs (remainder (t, p)) / p - 1)
  
  ------------------------------------------------------------------------------
  -- Curve interpolation
  ------------------------------------------------------------------------------
  
  -- | @openCurvePoints(controls,distance)@ is a list of points that approximate
  -- a curve passing through the given @controls@. A variable number of points
  -- is generated in such a way that the distance between them is approximately
  -- the given @distance@.
  openCurvePoints :: ([Point], Number) -> [Point]
  
  -- | This function is similar to 'openCurvePoints', but the points approximate
  -- a closed curve passing through the given controls.
  closedCurvePoints :: ([Point], Number) -> [Point]
  (openCurvePoints, closedCurvePoints) = (ocp, ccp)
    where
      -- 1D Linear interpolation
      lerp1 (a, b, t) = (1 - t) * a + t * b
      -- 2D Linear interpolation
      lerp2 ((x0, y0), (x1, y1), t) = (lerp1 (x0, x1, t), lerp1 (y0, y1, t))
      -- 2D Quadratic interpolation
      qerp2 (p0, p1, p2, t) = lerp2 (lerp2 (p0, p1, t), lerp2 (p1, p2, t), t)
      -- 2D Cubic interpolation
      cerp2 (p0, p1, p2, p3, t) = lerp2 (qerp2 (p0, p1, p2, t), qerp2 (p1, p2, p3, t), t)
      -- initial interpolation (p1,p2)
      bezierFirst (p1, p2, p3, grain)
        | d12 <= grain = [p1]
        | otherwise = [qerp2 (p1, c, p2, t) | t <- [0, grain .. l]]
        where
          c = vectorSum (p2, scaledVector (vectorDifference (p1, p3), r / 2))
          r = d12 / (d12 + d23)
          d12 = dist (p1, p2)
          d23 = dist (p2, p3)
          l = 1 - grain / d12
      -- final interpolation (p2,p3)
      bezierLast (p1, p2, p3, grain)
        | d23 <= grain = [p2]
        | otherwise = [qerp2 (p2, c, p3, t) | t <- [0, grain .. l]]
        where
          c = vectorSum (p2, scaledVector (vectorDifference (p3, p1), r / 2))
          r = d23 / (d12 + d23)
          d12 = dist (p1, p2)
          d23 = dist (p2, p3)
          l = 1 - grain / d23
      -- middle interpolation (p2,p3)
      bezierMiddle (p1, p2, p3, p4, grain)
        | d23 <= grain = [p2]
        | otherwise = [cerp2 (p2, c1, c2, p3, t) | t <- [0, grain .. l]]
        where
          c1 = vectorSum (p2, scaledVector (vectorDifference (p3, p1), r1 / 2))
          c2 = vectorSum (p3, scaledVector (vectorDifference (p2, p4), r2 / 2))
          r1 = d23 / (d12 + d23)
          r2 = d23 / (d23 + d34)
          d12 = dist (p1, p2)
          d23 = dist (p2, p3)
          d34 = dist (p3, p4)
          l = 1 - grain / d23
      ccp ([], _) = []
      ccp ([p1], _) = []
      ccp ([p1, p2], _) = [p1, p2]
      ccp (ps, grain) = go (last (ps, 1) ++ ps ++ first (ps, 2))
        where
          go (p1 : p2 : p3 : p4 : more) = bezierMiddle (p1, p2, p3, p4, grain) ++ go (p2 : p3 : p4 : more)
          go (_) = []
      ocp ([], _) = []
      ocp ([p1], _) = []
      ocp ([p1, p2], _) = [p1, p2]
      ocp (p1 : p2 : p3 : more, grain) = bezierFirst (p1, p2, p3, grain) ++ go (p1 : p2 : p3 : more)
        where
          go (p1 : p2 : p3 : p4 : more) = bezierMiddle (p1, p2, p3, p4, grain) ++ go (p2 : p3 : p4 : more)
          go ([p1, p2, p3]) = bezierLast (p1, p2, p3, grain)
          go (_) = []
      dist (p, q) = vectorLength (vectorDifference (p, q))
  
  -------------------------------------------------------------------------------
  --- Layout
  -------------------------------------------------------------------------------
  
  -- | A picture that represents the given list of texts, so that each
  -- text in the list is shown in a separate line. Lines start at the
  -- top left corner of the output window and grow downward.
  -- Each line of text can fit 66 characters, and 40 lines can fit
  -- in a single page. The lettering is shown in monospaced font.
  --
  -- Example:
  --
  -- > program = slideshow(pages)
  -- >   where
  -- >   pages = foreach(gs,pageFromTexts)
  -- >   gs = groups(ls,40)
  -- >   ls = foreach(result,\g -> joinedWith(g,", "))
  -- >   result = groups(forloop(1,(<= 2000000),(+ 1),printed),7)
  -- >
  --
  -- The example above shows two million numbers in 7143 pages, so that each
  -- page has 40 lines, each of which has 7 numbers. This example uses
  -- 'forloop' and 'foreach' from "Extras.Util".
  pageFromTexts :: [Text] -> Picture
  pageFromTexts (lines) = pictures ([showline (i) | i <- [1 .. n]])
    where
      n = length (lines)
      showline (i) = translated (scaled (fmt (lines #i), 0.5, 0.5), 0, 10.25 -0.5 * i)
      -- Output should be 40 rows and 66 columns
      fmt (txt) = styledLettering (lJustified (txt, 66), Monospace, Italic)
  
  -- | A @grid(cell,rows,columns)@ is a grid with the given number of @rows@ and
  -- @columns@, where the rows are numbered top to bottom (top row is row 1)
  -- and the columns are numbered left to right (leftmost column is column 1).
  -- The user needs to specify what to draw at each cell in the grid. The given
  -- function @cell@ should specify a 20 by 20 picture for each row and column,
  -- where the first argument is the row number, and the second argument is the
  -- column number:
  --
  -- > cell(row,col) = fullSizePicture
  --
  -- Each full size picture will be scaled to fit within the corresponding cell.
  -- Look at the example in the documentation of 'sprite' to see how to use it.
  grid :: ((Number, Number) -> Picture, Number, Number) -> Picture
  grid (cell, rows, cols) = translated (pictures (rpic), -10, 10)
    where
      w = 20 / cols
      h = 20 / rows
      transform (row, col) = translated (base, w * (col -1 / 2), - h * (row -1 / 2))
        where
          base = scaled (cell (row, col), 1 / cols, 1 / rows)
      rpic = [transform (row, col) | row <- [1 .. rows], col <- [1 .. cols]]
  
  -- | A @sprite(picture,rows,columns)@ creates a function that can be used to
  -- place the given @picture@ of a sprite into a grid with the given
  -- number of @rows@ and @columns@. The created function needs two
  -- arguments: the row and the column at which you want to show the sprite.
  -- The picture of the sprite should be a full size picture (20x20), which
  -- will be scaled to fit the corresponding cell in the grid.
  --
  --
  -- Example:
  --
  -- > import Extras.Cw(saw,grid,sprite)
  -- > import Extras.Util(printedPoint)
  -- >
  -- > program = animationOf(movie)
  -- >
  -- > movie(t) = sprite1(row,col) & background
  -- >   where
  -- >   -- Jump between rows 1 and 10 every 100 seconds
  -- >   row = 1 + truncation(10*saw(t,100))
  -- >   -- Move smoothly between cols 1 and 10 every 10 seconds
  -- >   col = 1 + 9*saw(t,10)
  -- >
  -- > sprite1 = sprite(pic,10,10)
  -- >   where
  -- >   pic = rotated(eks,45)
  -- >   eks = solidRectangle(10,1) & solidRectangle(1,10)
  -- >
  -- > background = grid(cell,10,10)
  -- >     where
  -- >     cell(row,col) = dilated(lettering(printedPoint(row,col)),5)
  -- >                   & rectangle(19,19)
  sprite :: (Picture, Number, Number) -> (Number, Number) -> Picture
  sprite (pic, rows, cols) = transform
    where
      w = 20 / cols
      h = 20 / rows
      dw = w / 2 + 10
      dh = h / 2 + 10
      base = scaled (pic, 1 / cols, 1 / rows)
      transform (row, col) = translated (base, w * col - dw, - h * row + dh)
  
  -- | @overlays(fig,n)@ is a shortcut for @fig(1) & fig(2) & ... & fig(n)@
  overlays :: ((Number -> Picture), Number) -> Picture
  overlays (f, n) = overlays' (f, max (0, truncation (n)))
    where
      overlays' (f, 0) = blank
      overlays' (f, n) = overlays' (f, n -1) & f (n)
  
  -- | @underlays(fig,n)@ is a shortcut for @fig(n) & fig(n-1) & ... & fig(1)@
  underlays :: ((Number -> Picture), Number) -> Picture
  underlays (f, n) = underlays' (f, max (0, truncation (n)))
    where
      underlays' (f, 0) = blank
      underlays' (f, n) = f (n) & underlays' (f, n -1)
  
  -- | A white frame around the standard 20x20 output window that covers
  -- anything that may spill over. The argument is the thickness of
  -- the frame border.
  squareFrame :: Number -> Picture
  squareFrame (border) = colored (thickRectangle (s, s, border), RGB (1, 1, 1))
    where
      s = 20 + border
  
  -------------------------------------------------------------------------------
  --- Zoomable graph
  -------------------------------------------------------------------------------
  
  -- | The given picture scaled by the given scaling factors and shown in a
  -- graph
  -- that zooms along with the picture. For example, a scaling factor of 2
  -- in either the X direction or the Y direction means
  -- that the picture will show twice as big as usual in that direction.
  --
  -- Example 1:
  --
  -- > program = animationOf(movie)
  -- >     where movie(t) = let zoom = 1/(1 + t^3)
  -- >                      in  graphed(circle(5*t^3), zoom, zoom)
  --
  -- Example 2:
  --
  -- > program = guiDrawingOf(widgets,draw)
  -- >   where
  -- >   widgets = [ withConversion(zooming, slider("zoomX",-8,9))
  -- >             , withConversion(zooming, slider("zoomY",-8,7))
  -- >             ]
  -- >   zooming(v) = 2^(-8 + v*16)
  -- >   draw([zoomX,zoomY]) = graphed(manyCircles, zoomX, zoomY)
  -- >   manyCircles = pictures([circle(n) | n <- [1..100]])
  --
  -- Example 1 shows a circle that grows forever, while the graph keeps
  -- adjusting the scale so that it fits within the output.
  -- Example 2 shows a graph with 100 circles. It uses the function
  -- 'guiDrawingOf' from "Extras.Widget".
  graphed :: (Picture, Number, Number) -> Picture
  graphed (pic, zoomx, zoomy) =
    graph (10 / zoomx, 10 / zoomy, 10, 10)
      & scaled (pic, zoomx, zoomy)
  
  -- | This function is similar to 'graphed', but it creates a graph that is
  -- as wide as specified by the first parameter.
  -- Thus, @wideGraphed(width,pic,sx,sy)@ creates a graph that is @width@
  -- units wide and @20@ units high.
  wideGraphed :: (Number, Picture, Number, Number) -> Picture
  wideGraphed (width, pic, zoomx, zoomy) =
    graph (halfwidth / zoomx, 10 / zoomy, halfwidth, 10)
      & scaled (pic, zoomx, zoomy)
    where
      halfwidth = width / 2
  
  -- | This function is similar to 'graphed', but it creates a graph that is
  -- as wide and as high as specified by the first two parameters.
  -- Thus, @customGraphed(width,height,pic,sx,sy)@ creates a graph that
  -- is @width@ units wide and @heighth@ units high.
  customGraphed :: (Number, Number, Picture, Number, Number) -> Picture
  customGraphed (width, height, pic, zoomx, zoomy) =
    graph (halfwidth / zoomx, halfheight / zoomy, halfwidth, halfheight)
      & scaled (pic, zoomx, zoomy)
    where
      halfwidth = width / 2
      halfheight = height / 2
  
  graph (maxX, maxY, width, height) = labels & axesX & rotated (axesY, 90)
    where
      (majorX, axesX) = axes (maxX, width, height)
      (majorY, axesY) = axes (maxY, height, width)
      labels =
        pictures (forloop (majorX, (<= maxX), (+ majorX), p))
          & pictures (forloop (majorY, (<= maxY), (+ majorY), q))
      p (x)
        | x < 1000000 =
          translated (lunj (x), pos, -1 / 2)
            & translated (lunj (- x), - pos, -1 / 2)
        | 3 <= pos && pos < 6 =
          translated (lunj (x), pos, -1 / 2)
            & translated (lunj (- x), - pos, -1 / 2)
        | otherwise = blank
        where
          pos = x * width / maxX
      q (y)
        | y < 50000 =
          translated (ljust (y), -1, pos)
            & translated (ljust (- y), -1, - pos)
        | 3 <= pos && pos < 6 =
          translated (lunj (y), -1, pos)
            & translated (lunj (- y), -1, - pos)
        | otherwise = blank
        where
          pos = y * height / maxY
      lunj (v) = dilated (styledLettering (printed (v), Monospace, Plain), 0.5)
      ljust (v) =
        dilated
          ( styledLettering
              ( rJustified (printed (v), 5),
                Monospace,
                Plain
              ),
            0.5
          )
  
  axes (maxnum, width, height) = (major, allAxes)
    where
      allAxes =
        semiMajor & scaled (semiMajor, -1, 1)
          & semiMinor
          & scaled (semiMinor, -1, 1)
      semiMajor = pictures (forloop (0, (<= maxnum), (+ major), majorAxis))
      semiMinor = pictures (forloop (0, (<= maxnum), (+ minor), minorAxis))
      (_, major, _) = resolution (maxnum * 10 / width)
      (_, minor, _) = resolution (major)
      scaling = width / maxnum
      axis (x) = polyline ([(x * scaling, - height), (x * scaling, height)])
      majorAxis (x) = colored (axis (x), g (0.2, 0.5))
      minorAxis (x) = colored (axis (x), g (0.1, 0.2))
      g (s, a) = RGBA (s, s, s, a)
  
  -- Major interval, minor interval and number of decimals
  resolution (x) = if x >= 1 then goUp (1) else goDn (1, 0)
    where
      goDn (base, dec)
        | x > base5 = (base, base / 5, dec)
        | x > base2 = (base5, base5 / 5, dec + 1)
        | x > base1 = (base2, base2 / 4, dec + 1)
        | otherwise = goDn (base1, dec + 1)
        where
          base5 = base / 2
          base2 = base / 5
          base1 = base / 10
      goUp (base)
        | x <= base1 = (base1, base1 / 5, 0)
        | x <= base2 = (base2, base2 / 4, 0)
        | x <= base5 = (base5, base5 / 5, 0)
        | otherwise = goUp (base * 10)
        where
          base1 = base
          base2 = base * 2
          base5 = base * 5
  
  -------------------------------------------------------------------------------
  -- Drawing Trees
  -------------------------------------------------------------------------------
  
  -- | A Tree is built by repeated applications of the @-<@ operator.
  --
  -- Example:
  --
  -- > import Extras.Cw((-<),tree,treeDepth,treeWidth)
  -- >
  -- > program = drawingOf(picture)
  -- >   where
  -- >   w = 3
  -- >   picture = tree(t1,draw,w) & translated(lettering(info),5,-9)
  -- >     where
  -- >     draw(node) = lettering(node)
  -- >                & colored(solidRectangle(0.8*w,1),translucent(light(red)))
  -- >     info = joined([ "width: ", printed(treeWidth(t1))
  -- >                   , ", depth: ", printed(treeDepth(t1))
  -- >                   ])
  -- >     t1 = "hello" -< [ "a" -< [ "a1" -< []
  -- >                              , "a2" -< []
  -- >                              ]
  -- >                     , "b" -< [ "b1" -< [ "b11" -< []
  -- >                                        , "b12" -< [ "b121" -< []
  -- >                                                   , "b122" -< [ "b1221" -< []
  -- >                                                               , "b1222" -< []
  -- >                                                               , "b1223" -< []
  -- >                                                               ]
  -- >                                                   ]
  -- >                                        ]
  -- >                              , "b2" -< [ "b21" -< []
  -- >                                        , "b22" -< []
  -- >                                        , "b23" -< []
  -- >                                        ]
  -- >                              ]
  -- >                     , "c" -< []
  -- >                     , "d" -< []
  -- >                     ]
  -- >
  data Tree a = Node (a, [Tree a])
  
  -- | A tree that has the given node at the head and the given list
  -- of trees as children nodes.
  --
  -- Example: A binary tree
  --
  -- >  program = drawingOf(tree(t,\n -> lettering(printed(n)),1.2))
  -- >
  -- >  t = 1 -< [ 2 -< [ 4 -< [  8 -< [ 16 -< []
  -- >                                 , 17 -< []
  -- >                                 ]
  -- >                         ,  9 -< [ 18 -< []
  -- >                                 , 19 -< []
  -- >                                 ]
  -- >                         ]
  -- >                  , 5 -< [ 10 -< [ 20 -< []
  -- >                                 , 21 -< []
  -- >                                 ]
  -- >                         , 11 -< [ 22 -< []
  -- >                                 , 23 -< []
  -- >                                 ]
  -- >                         ]
  -- >                  ]
  -- >           , 3 -< [ 6 -< [ 12 -< [ 24 -< []
  -- >                                 , 25 -< []
  -- >                                 ]
  -- >                         , 13 -< [ 26 -< []
  -- >                                 , 27 -< []
  -- >                                 ]
  -- >                         ]
  -- >                  , 7 -< [ 14 -< [ 28 -< []
  -- >                                 , 29 -< []
  -- >                                 ]
  -- >                         , 15 -< [ 30 -< []
  -- >                                 , 31 -< []
  -- >                                 ]
  -- >                         ]
  -- >                  ]
  -- >           ]
  -- >
  (-<) :: a -> [Tree a] -> Tree a
  x -< t = Node (x, t)
  
  -- | The depth of the given tree
  treeDepth :: Tree a -> Number
  treeDepth (Node (_, [])) = 1
  treeDepth (Node (_, t)) = 1 + maximum (foreach (t, treeDepth))
  
  -- | The width of the given tree
  treeWidth :: Tree a -> Number
  treeWidth (Node (_, [])) = 1
  treeWidth (Node (_, t)) = sum (foreach (t, treeWidth))
  
  -- | A Picture of the given tree, where each node is drawn according
  -- to the given function. It is assumed that each node is no wider than the
  -- given width. Otherwise, overlap between nodes will occur.
  tree :: (Tree a, a -> Picture, Number) -> Picture
  tree (tt, draw, size) = dilated (fulltree, 20 / sfactor)
    where
      sfactor = max (width, depth)
      width = size * treeWidth (tt)
      fulltree = translated (tree' (tt, - width / 2, width), 0, (depth -1) / 2)
      depth = 2 * treeDepth (tt) -1
      tree' (Node (a, t), offset, alloc) =
        translated (draw (a), anchor, 0)
          & pointers
          & translated (nodes, 0, -2)
        where
          pointers =
            if empty (t)
              then blank
              else polyline ([(anchor, -0.5), (anchor, -1)])
          anchor = offset + alloc / 2
          nodes = pictures (forloop (input, cond, next, output))
            where
              input = (t, offset, if empty (t) then 0 else size * treeWidth (t # 1))
              cond (ns, _, _) = nonEmpty (ns)
              next (ns, d, w) = (ns', d + w, if empty (ns') then 0 else size * treeWidth (ns' # 1))
                where
                  ns' = rest (ns, 1)
              output (ns, d, w) =
                tree' (ns # 1, d, w)
                  & polyline ([(d + w / 2, 0.5), (d + w / 2, 1)])
                  & polyline ([(d + w / 2, 1), (offset + alloc / 2, 1)])
  