content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DeriveFunctor #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE KindSignatures #-}
  {-# LANGUAGE MagicHash #-}
  {-# LANGUAGE PatternGuards #-}
  {-# LANGUAGE RecordWildCards #-}
  {-# OPTIONS_GHC -Wno-name-shadowing -Wno-star-is-type #-}
  {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
  {-# HLINT ignore "Redundant bracket" #-}
  
  {-
    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.EntryPoints where
  
  import CodeWorld.Color
  import CodeWorld.Driver
  import CodeWorld.Event
  import CodeWorld.Picture
  import Data.Text (Text)
  import qualified Data.Text as T
  import GHC.Prim
  import GHC.StaticPtr
  import GHC.Types
  import Numeric (showFFloatAlt)
  import System.IO
  import System.IO.Unsafe
  import System.Random
  
  --------------------------------------------------------------------------------
  -- Common code for activity, interaction, animation and simulation interfaces
  
  -- | Runs an interactive CodeWorld program that responds to 'Event's.
  -- Activities can interact with the user, change over time, and remember
  -- information about the past.
  --
  -- Example: a program which draws a circle and changes its radius when user
  -- presses Up or Down keys on her keyboard
  --
  -- @
  --  &#x7b;-\# LANGUAGE OverloadedStrings \#-&#x7d;
  -- import CodeWorld
  --
  -- main = activityOf initialRadius updateRadius circle
  --    where
  --      initialRadius = 1
  --
  --      updateRadius event radius =
  --        case event of
  --          KeyPress "Up"   -> radius + 1
  --          KeyPress "Down" -> radius - 1
  --          _               -> radius
  -- @
  activityOf ::
    -- | The initial state of the activity.
    world ->
    -- | The event handling function, which updates
    --   the state given an event.
    (Event -> world -> world) ->
    -- | The visualization function, which converts
    --   the state into a picture to display.
    (world -> Picture) ->
    IO ()
  activityOf initial change picture = do
    hFlush stdout
    runInspect initial (const id) change picture picture
  
  data Timeline a = Timeline
    { past :: [a], -- reversed list of past states
      present :: !a, -- present state
      future :: [a] -- list of future states
    }
  
  newTimeline :: a -> Timeline a
  newTimeline x = Timeline [] x []
  
  applyToTimeline :: (a -> a) -> Timeline a -> Timeline a
  applyToTimeline f timeline@(Timeline {..})
    | identical present new = timeline
    | otherwise = Timeline (present : past) new []
    where
      new = f present
  
  undoTimeline :: Timeline a -> Timeline a
  undoTimeline timeline@(Timeline {..}) = case past of
    [] -> timeline
    (x : xs) -> Timeline xs x (present : future)
  
  redoTimeline :: Timeline a -> Timeline a
  redoTimeline timeline@(Timeline {..}) = case future of
    [] -> timeline
    (x : xs) -> Timeline (present : past) x xs
  
  restartTimeline :: Timeline a -> Timeline a
  restartTimeline timeline@(Timeline {..}) = case reverse past of
    [] -> timeline
    x : xs -> Timeline [] x (xs ++ present : future)
  
  timelineLength :: Timeline a -> Int
  timelineLength (Timeline {..}) = length past + 1 + length future
  
  travelToTime :: Double -> Timeline a -> Timeline a
  travelToTime t timeline@(Timeline {..})
    | diff >= 0 = iterate redoTimeline timeline !! diff
    | otherwise = iterate undoTimeline timeline !! (- diff)
    where
      desiredPast = round (t * (fromIntegral (timelineLength timeline - 1)))
      actualPast = length past
      diff = desiredPast - actualPast
  
  timelinePos :: Timeline a -> Double
  timelinePos (Timeline {..})
    | null past && null future = 1
    | otherwise = fromIntegral (length past) / fromIntegral (length past + length future)
  
  data Control :: * -> * where
    PlayButton :: Point -> Control a
    PauseButton :: Point -> Control a
    StepButton :: Point -> Control a
    RestartButton :: Point -> Control Double
    ZoomInButton :: Point -> Control a
    ZoomOutButton :: Point -> Control a
    PanningLayer :: Control a
    ResetViewButton :: Point -> Control a
    FastForwardButton :: Point -> Control a
    StartOverButton :: Point -> Control (Timeline a)
    BackButton :: Point -> Control Double
    TimeLabel :: Point -> Control Double
    SpeedSlider :: Point -> Control a
    ZoomSlider :: Point -> Control a
    UndoButton :: Point -> Control (Timeline a)
    RedoButton :: Point -> Control (Timeline a)
    HistorySlider :: Point -> Control (Timeline a)
  
  data StrictPoint = SP !Double !Double deriving (Eq, Show)
  
  data StrictMaybe a = SNothing | SJust !a deriving (Functor, Show)
  
  data Wrapped a = Wrapped
    { state :: a,
      playbackSpeed :: !Double,
      lastInteractionTime :: !Double,
      zoomFactor :: !Double,
      panCenter :: !StrictPoint,
      panDraggingAnchor :: !(StrictMaybe StrictPoint),
      isDraggingSpeed :: !Bool,
      isDraggingHistory :: !Bool,
      isDraggingZoom :: !Bool
    }
    deriving (Show, Functor)
  
  wrappedInitial :: a -> Wrapped a
  wrappedInitial w =
    Wrapped
      { state = w,
        playbackSpeed = 1,
        lastInteractionTime = 1000,
        zoomFactor = 1,
        panCenter = SP 0 0,
        panDraggingAnchor = SNothing,
        isDraggingSpeed = False,
        isDraggingHistory = False,
        isDraggingZoom = False
      }
  
  identical :: a -> a -> Bool
  identical !x !y = isTrue# (reallyUnsafePtrEquality# x y)
  
  toState :: (a -> a) -> (Wrapped a -> Wrapped a)
  toState f w
    | identical s s' = w
    | otherwise = w {state = s'}
    where
      s = state w
      s' = f s
  
  wrappedStep :: (Double -> a -> a) -> Double -> Wrapped a -> Wrapped a
  wrappedStep f dt w
    | playbackSpeed w == 0 = w
    | otherwise = toState (f (dt * playbackSpeed w)) w
  
  wrappedEvent ::
    (Wrapped a -> [Control a]) ->
    (Double -> a -> a) ->
    (Event -> a -> a) ->
    Event ->
    Wrapped a ->
    Wrapped a
  wrappedEvent ctrls stepHandler eventHandler event = markInteraction . handleChange
    where
      markInteraction w
        | TimePassing _ <- event, lastInteractionTime w > 5 = w
        | TimePassing dt <- event = w {lastInteractionTime = lastInteractionTime w + dt}
        | otherwise = w {lastInteractionTime = 0}
      handleChange w0
        | playbackSpeed w0 == 0 || handled = w1
        | otherwise = toState (eventHandler (adaptEvent event)) w1
        where
          (w1, handled) = foldr doCtrl (w0, False) (ctrls w0)
          doCtrl _ (w, True) = (w, True)
          doCtrl ctrl (w, False) = handleControl fullStep event ctrl w
          fullStep dt = stepHandler dt . eventHandler (TimePassing dt)
          adaptEvent (PointerMovement p) = PointerMovement (adaptPoint p)
          adaptEvent (PointerPress p) = PointerPress (adaptPoint p)
          adaptEvent (PointerRelease p) = PointerRelease (adaptPoint p)
          adaptEvent (TimePassing dt) = TimePassing (dt * playbackSpeed w0)
          adaptEvent other = other
          adaptPoint (x, y) = (x / k - dx, y / k - dy)
          SP dx dy = panCenter w1
          k = zoomFactor w1
  
  scaleRange :: (Double, Double) -> (Double, Double) -> Double -> Double
  scaleRange (a1, b1) (a2, b2) x = min b2 $ max a2 $ (x - a1) / (b1 - a1) * (b2 - a2) + a2
  
  snapSlider :: Double -> [Double] -> Double -> Double
  snapSlider eps targets val = foldr snap val targets
    where
      snap t v
        | abs (t - v) < eps = t
        | otherwise = v
  
  xToPlaybackSpeed :: Double -> Double
  xToPlaybackSpeed x = snapSlider 0.2 [1 .. 4] $ scaleRange (-1.4, 1.4) (0, 5) x
  
  playbackSpeedToX :: Double -> Double
  playbackSpeedToX = scaleRange (0, 5) (-1.4, 1.4)
  
  zoomIncrement :: Double
  zoomIncrement = 8 ** (1 / 10)
  
  yToZoomFactor :: Double -> Double
  yToZoomFactor y = zoomIncrement ** (scaleRange (-1.4, 1.4) (-10, 10) y)
  
  zoomFactorToY :: Double -> Double
  zoomFactorToY z = scaleRange (-10, 10) (-1.4, 1.4) (logBase zoomIncrement z)
  
  handleControl ::
    (Double -> a -> a) -> Event -> Control a -> Wrapped a -> (Wrapped a, Bool)
  handleControl _ (PointerPress (x, y)) (RestartButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {state = 0}, True)
  handleControl _ (PointerPress (x, y)) (StartOverButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (restartTimeline <$> w, True)
  handleControl _ (PointerPress (x, y)) (PlayButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {playbackSpeed = 1}, True)
  handleControl _ (PointerPress (x, y)) (PauseButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {playbackSpeed = 0}, True)
  handleControl _ (PointerPress (x, y)) (FastForwardButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {playbackSpeed = max 2 (playbackSpeed w + 1)}, True)
  handleControl _ (PointerPress (x, y)) (ZoomInButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {zoomFactor = zoomFactor w * zoomIncrement}, True)
  handleControl _ (PointerPress (x, y)) (ZoomOutButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {zoomFactor = zoomFactor w / zoomIncrement}, True)
  handleControl _ (PointerPress (x, y)) (ResetViewButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {zoomFactor = 1, panCenter = SP 0 0}, True)
  handleControl _ (PointerPress (x, y)) (BackButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (max 0 . (subtract 0.1) <$> w, True)
  handleControl _ (PointerPress (x, y)) (UndoButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (undoTimeline <$> w, True)
  handleControl _ (PointerPress (x, y)) (RedoButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (redoTimeline <$> w, True)
  handleControl f (PointerPress (x, y)) (StepButton (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 0.4 = (w {state = f 0.1 (state w)}, True)
  handleControl _ (PointerPress (x, y)) (SpeedSlider (cx, cy)) w
    | abs (x - cx) < 1.5 && abs (y - cy) < 0.4 =
      (w {playbackSpeed = xToPlaybackSpeed (x - cx), isDraggingSpeed = True}, True)
  handleControl _ (PointerMovement (x, _)) (SpeedSlider (cx, _)) w
    | isDraggingSpeed w = (w {playbackSpeed = xToPlaybackSpeed (x - cx)}, True)
  handleControl _ (PointerRelease (x, _)) (SpeedSlider (cx, _)) w
    | isDraggingSpeed w = (w {playbackSpeed = xToPlaybackSpeed (x - cx), isDraggingSpeed = False}, True)
  handleControl _ (PointerPress (x, y)) (ZoomSlider (cx, cy)) w
    | abs (x - cx) < 0.4 && abs (y - cy) < 1.5 =
      (w {zoomFactor = yToZoomFactor (y - cy), isDraggingZoom = True}, True)
  handleControl _ (PointerMovement (_, y)) (ZoomSlider (_, cy)) w
    | isDraggingZoom w = (w {zoomFactor = yToZoomFactor (y - cy)}, True)
  handleControl _ (PointerRelease (_, y)) (ZoomSlider (_, cy)) w
    | isDraggingZoom w = (w {zoomFactor = yToZoomFactor (y - cy), isDraggingZoom = False}, True)
  handleControl _ (PointerPress (x, y)) (HistorySlider (cx, cy)) w
    | abs (x - cx) < 2.5 && abs (y - cy) < 0.4 =
      (travelToTime (1 / 2 + (x - cx) / 4.8) <$> w {isDraggingHistory = True}, True)
  handleControl _ (PointerMovement (x, _)) (HistorySlider (cx, _)) w
    | isDraggingHistory w = (travelToTime (1 / 2 + (x - cx) / 4.8) <$> w, True)
  handleControl _ (PointerRelease (x, _)) (HistorySlider (cx, _)) w
    | isDraggingHistory w = (travelToTime (1 / 2 + (x - cx) / 4.8) <$> w {isDraggingHistory = False}, True)
  handleControl _ (PointerPress (x, y)) PanningLayer w =
    (w {panDraggingAnchor = SJust (SP x y)}, True)
  handleControl _ (PointerMovement (x, y)) PanningLayer w
    | SJust (SP ax ay) <- panDraggingAnchor w,
      SP px py <- panCenter w =
      ( w
          { panCenter =
              SP
                (px + (x - ax) / zoomFactor w)
                (py + (y - ay) / zoomFactor w),
            panDraggingAnchor = SJust (SP x y)
          },
        True
      )
  handleControl _ (PointerRelease _) PanningLayer w
    | SJust _ <- panDraggingAnchor w = (w {panDraggingAnchor = SNothing}, True)
  handleControl _ _ _ w = (w, False)
  
  wrappedDraw ::
    (Wrapped a -> [Control a]) -> (a -> Picture) -> Wrapped a -> Picture
  wrappedDraw ctrls f w = drawControlPanel ctrls w <> dilated k (translated dx dy (f (state w)))
    where
      SP dx dy = panCenter w
      k = zoomFactor w
  
  drawControlPanel :: (Wrapped a -> [Control a]) -> Wrapped a -> Picture
  drawControlPanel ctrls w
    | alpha > 0 = pictures [drawControl w alpha c | c <- ctrls w]
    | otherwise = blank
    where
      alpha
        | lastInteractionTime w < 4.5 = 1
        | lastInteractionTime w < 5.0 = 10 - 2 * lastInteractionTime w
        | otherwise = 0
  
  drawControl :: Wrapped a -> Double -> Control a -> Picture
  drawControl _ alpha (RestartButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( thickArc 0.1 (pi / 6) (11 * pi / 6) 0.2
              <> translated 0.173 (-0.1) (solidRectangle 0.17 0.17)
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (StartOverButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( thickArc 0.1 (pi / 6) (11 * pi / 6) 0.2
              <> translated 0.173 (-0.1) (solidRectangle 0.17 0.17)
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (PlayButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          (solidPolygon [(-0.2, 0.25), (-0.2, -0.25), (0.2, 0)])
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (PauseButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated (-0.15) 0 (solidRectangle 0.2 0.6)
              <> translated 0.15 0 (solidRectangle 0.2 0.6)
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (FastForwardButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( solidPolygon [(-0.3, 0.25), (-0.3, -0.25), (-0.05, 0)]
              <> solidPolygon [(0.05, 0.25), (0.05, -0.25), (0.3, 0)]
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (ZoomInButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated
              (-0.05)
              (0.05)
              ( thickCircle 0.1 0.22
                  <> solidRectangle 0.06 0.25
                  <> solidRectangle 0.25 0.06
                  <> rotated (- pi / 4) (translated 0.35 0 (solidRectangle 0.2 0.1))
              )
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (ZoomOutButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated
              (-0.05)
              (0.05)
              ( thickCircle 0.1 0.22
                  <> solidRectangle 0.25 0.06
                  <> rotated (- pi / 4) (translated 0.35 0 (solidRectangle 0.2 0.1))
              )
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ _ PanningLayer = blank
  drawControl _ alpha (ResetViewButton (x, y)) = translated x y p
    where
      p =
        colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.7 0.2)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.2 0.7)
          <> colored (RGBA 0.0 0.0 0.0 alpha) (thickRectangle 0.1 0.5 0.5)
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (BackButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated 0.15 0 (solidRectangle 0.2 0.5)
              <> solidPolygon [(-0.05, 0.25), (-0.05, -0.25), (-0.3, 0)]
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (UndoButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated 0.15 0 (solidRectangle 0.2 0.5)
              <> solidPolygon [(-0.05, 0.25), (-0.05, -0.25), (-0.3, 0)]
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (StepButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated (-0.15) 0 (solidRectangle 0.2 0.5)
              <> solidPolygon [(0.05, 0.25), (0.05, -0.25), (0.3, 0)]
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl _ alpha (RedoButton (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated (-0.15) 0 (solidRectangle 0.2 0.5)
              <> solidPolygon [(0.05, 0.25), (0.05, -0.25), (0.3, 0)]
          )
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.8 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.8 0.8)
  drawControl w alpha (TimeLabel (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          (scaled 0.5 0.5 $ lettering (T.pack (showFFloatAlt (Just 4) (state w) "s")))
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 3.0 0.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 3.0 0.8)
  drawControl w alpha (SpeedSlider (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated xoff 0.75 $ scaled 0.5 0.5 $
              lettering (T.pack (showFFloatAlt (Just 2) (playbackSpeed w) "x"))
          )
          <> colored (RGBA 0 0 0 alpha) (translated xoff 0 (solidRectangle 0.2 0.8))
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 2.8 0.25)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 2.8 0.25)
      xoff = playbackSpeedToX (playbackSpeed w)
  drawControl w alpha (ZoomSlider (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated (-1.1) yoff $ scaled 0.5 0.5 $
              lettering (T.pack (show (round (zoomFactor w * 100) :: Int) ++ "%"))
          )
          <> colored (RGBA 0 0 0 alpha) (translated 0 yoff (solidRectangle 0.8 0.2))
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 0.25 2.8)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 0.25 2.8)
      yoff = zoomFactorToY (zoomFactor w)
  drawControl w alpha (HistorySlider (x, y)) = translated x y p
    where
      p =
        colored
          (RGBA 0 0 0 alpha)
          ( translated xoff 0.75 $ scaled 0.5 0.5 $
              lettering (T.pack (show i ++ "/" ++ show n))
          )
          <> colored (RGBA 0.0 0.0 0.0 alpha) (translated xoff 0 (solidRectangle 0.2 0.8))
          <> colored (RGBA 0.2 0.2 0.2 alpha) (rectangle 4.8 0.25)
          <> colored (RGBA 0.8 0.8 0.8 alpha) (solidRectangle 4.8 0.25)
      xoff = timelinePos (state w) * 4.8 - 2.4
      i = 1 + length (past (state w))
      n = timelineLength (state w)
  
  drawingControls :: Wrapped () -> [Control ()]
  drawingControls w
    | lastInteractionTime w > 5 = []
    | otherwise = commonControls ++ resetViewButton
    where
      commonControls =
        [ PanningLayer,
          ZoomInButton (9, -4),
          ZoomOutButton (9, -8),
          ZoomSlider (9, -6)
        ]
      resetViewButton
        | zoomFactor w /= 1 || panCenter w /= SP 0 0 = [ResetViewButton (9, -3)]
        | otherwise = []
  
  -- | Draws a 'Picture'. This is the simplest CodeWorld entry point.
  --
  -- Example: a program which draws a circle of radius 1 in the middle of canvas
  --
  -- @
  -- main = drawingOf $ circle 1
  -- @
  drawingOf ::
    -- | The picture to show on the screen.
    Picture ->
    IO ()
  drawingOf pic = do
    hFlush stdout
    runInspect
      (wrappedInitial ())
      (wrappedStep step)
      (wrappedEvent drawingControls step event)
      (wrappedDraw drawingControls draw)
      (draw . state)
    where
      step _ _ = ()
      event _ _ = ()
      draw _ = pic
  
  animationControls :: Wrapped Double -> [Control Double]
  animationControls w
    | lastInteractionTime w > 5 = []
    | otherwise =
      commonControls ++ pauseDependentControls
        ++ backButton
        ++ resetViewButton
    where
      commonControls =
        [ PanningLayer,
          RestartButton (-9, -9),
          TimeLabel (8, -9),
          SpeedSlider (-3, -9),
          FastForwardButton (-1, -9),
          ZoomInButton (9, -4),
          ZoomOutButton (9, -8),
          ZoomSlider (9, -6)
        ]
      pauseDependentControls
        | playbackSpeed w == 0 = [PlayButton (-8, -9), StepButton (-6, -9)]
        | otherwise = [PauseButton (-8, -9)]
      backButton
        | playbackSpeed w == 0 && state w > 0 = [BackButton (-7, -9)]
        | otherwise = []
      resetViewButton
        | zoomFactor w /= 1 || panCenter w /= SP 0 0 = [ResetViewButton (9, -3)]
        | otherwise = []
  
  -- | Shows an animation, with a picture for each time given by the parameter.
  --
  -- Example: a program showing a square which rotates once every two seconds
  --
  -- @
  -- main = animationOf rotatingSquare
  --
  -- rotatingSquare :: Double -> Picture
  -- rotatingSquare seconds = rotated angle square
  --   where
  --     square = rectangle 2 2
  --     angle = pi * seconds
  -- @
  animationOf ::
    -- | A function that produces animation
    --   frames, given the time in seconds.
    (Double -> Picture) ->
    IO ()
  animationOf f = do
    hFlush stdout
    runInspect
      (wrappedInitial 0)
      (wrappedStep (+))
      (wrappedEvent animationControls (+) (const id))
      (wrappedDraw animationControls f)
      (f . state)
  
  simulationControls :: Wrapped w -> [Control w]
  simulationControls w
    | lastInteractionTime w > 5 = []
    | otherwise = commonControls ++ pauseDependentControls ++ resetViewButton
    where
      commonControls =
        [ PanningLayer,
          FastForwardButton (-4, -9),
          SpeedSlider (-6, -9),
          ZoomInButton (9, -4),
          ZoomOutButton (9, -8),
          ZoomSlider (9, -6)
        ]
      pauseDependentControls
        | playbackSpeed w == 0 = [PlayButton (-8, -9), StepButton (-2, -9)]
        | otherwise = [PauseButton (-8, -9)]
      resetViewButton
        | zoomFactor w /= 1 || panCenter w /= SP 0 0 = [ResetViewButton (9, -3)]
        | otherwise = []
  
  statefulDebugControls :: Wrapped (Timeline w) -> [Control (Timeline w)]
  statefulDebugControls w
    | lastInteractionTime w > 5 = []
    | otherwise =
      panningLayer ++ pauseDependentControls ++ commonControls
        ++ resetViewButton
    where
      hasHistory = not (null (past (state w)))
      hasFuture = not (null (future (state w)))
      advance
        | hasFuture = [RedoButton (6, -9)]
        | otherwise = [StepButton (6, -9)]
      regress
        | hasHistory = [UndoButton (0, -9)]
        | otherwise = []
      commonControls =
        [ StartOverButton (-1, -9),
          FastForwardButton (-4, -9),
          SpeedSlider (-6, -9),
          ZoomInButton (9, -4),
          ZoomOutButton (9, -8),
          ZoomSlider (9, -6)
        ]
      pauseDependentControls
        | playbackSpeed w == 0 =
          [PlayButton (-8, -9), HistorySlider (3, -9)] ++ advance ++ regress
        | otherwise = [PauseButton (-8, -9)]
      resetViewButton
        | zoomFactor w /= 1 || panCenter w /= SP 0 0 = [ResetViewButton (9, -3)]
        | otherwise = []
      panningLayer
        | playbackSpeed w == 0 = [PanningLayer]
        | otherwise = []
  
  -- | A version of 'activityOf' which runs an interactive CodeWorld program
  -- in debugging mode.  In this mode, the program gets controls to pause and
  -- manipulate time, and even go back in time to look at past states.
  debugActivityOf ::
    -- | The initial state of the interaction.
    world ->
    -- | The event handling function, which updates
    --   the state given an event.
    (Event -> world -> world) ->
    -- | The visualization function, which converts
    --   the state into a picture to display.
    (world -> Picture) ->
    IO ()
  debugActivityOf initial change picture = do
    hFlush stdout
    runInspect
      (wrappedInitial (newTimeline initial))
      (wrappedStep (const id))
      (wrappedEvent statefulDebugControls (const id) (applyToTimeline . change))
      (wrappedDraw statefulDebugControls (picture . present))
      (picture . present . state)
  
  -- | Runs an interactive multi-user CodeWorld program that is joined by several
  -- participants over the internet.
  --
  -- Example: a skeleton of a game for two players
  --
  -- @
  -- &#x7b;-\# LANGUAGE StaticPointers, OverloadedStrings \#-&#x7d;
  -- import CodeWorld
  --
  -- main = groupActivityOf 2 init step view
  --   where
  --     init = static (\\gen -> {- initialize state of the game world, possibly using random number generator -})
  --     step = static (\\playerNumber event world -> {- modify world based on event occuring for given player -})
  --     view = static (\\playerNumber world -> {- generate a picture that will be shown to given player in the given state of the world-})
  -- @
  groupActivityOf ::
    -- | The number of participants to expect.  The participants will be
    -- numbered starting at 0.
    Int ->
    -- | The function to create initial state of the activity. 'System.Random.StdGen' parameter can be used to generate random numbers.
    StaticPtr (StdGen -> world) ->
    -- | The event handling function, which updates the state given a
    --   participant number and user interface event.
    StaticPtr (Int -> Event -> world -> world) ->
    -- | The visualization function, which converts a participant number
    --   and the state into a picture to display.
    StaticPtr (Int -> world -> Picture) ->
    IO ()
  groupActivityOf numPlayers initial event draw = do
    hFlush stdout
    dhash <- getDeployHash
    let token =
          SteplessToken
            { tokenDeployHash = dhash,
              tokenNumPlayers = numPlayers,
              tokenInitial = staticKey initial,
              tokenEvent = staticKey event,
              tokenDraw = staticKey draw
            }
    runGame
      token
      numPlayers
      (deRefStaticPtr initial)
      (const id)
      (deRefStaticPtr event)
      (deRefStaticPtr draw)
  
  -- | A version of 'groupActivityOf' that avoids static pointers, and does not
  -- check for consistency.
  unsafeGroupActivityOf ::
    -- | The number of participants to expect.  The participants will be
    -- numbered starting at 0.
    Int ->
    -- | The initial state of the activity.
    (StdGen -> world) ->
    -- | The event handling function, which updates the state given a
    --   participant number and user interface event.
    (Int -> Event -> world -> world) ->
    -- | The visualization function, which converts a participant number
    --   and the state into a picture to display.
    (Int -> world -> Picture) ->
    IO ()
  unsafeGroupActivityOf numPlayers initial event draw = do
    hFlush stdout
    dhash <- getDeployHash
    let token = PartialToken dhash
    runGame token numPlayers initial (const id) event draw
  
  -- | Prints a debug message to the CodeWorld console when a value is forced.
  -- This is equivalent to the similarly named function in `Debug.Trace`, except
  -- that it sets appropriate buffering to use the CodeWorld console.
  trace :: Text -> a -> a
  trace msg x = unsafePerformIO $ do
    oldMode <- hGetBuffering stderr
    hSetBuffering stderr (BlockBuffering Nothing)
    hPutStrLn stderr (T.unpack msg)
    hFlush stderr
    hSetBuffering stderr oldMode
    return x
  