# Elm Juggling Patterns

(Note: This was written for an older version of elm and only hacked into working after changes to the way Elm handles input.)

This Elm toy draws juggling patterns from siteswap notation. At the moment there is only a single style of throw to choose from, the standard cascade throw.

In the future I could imagine adding:

• More throw styles
• Better animation
• Rainbow-coloured balls
• Validation of the siteswap notation

You can test the program in fullscreen here. Some siteswaps to try are: (3), (5), (4), (441), (50505), (552), (5551) and (55550).

``````module JuggleDrawings where

import Color exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)

import Graphics.Input
import Text
import Time

-----------------
--  Physics
-----------------

gravity = -500

integrate dt ball = { ball | x <- ball.x + dt * ball.xvel
, y <- ball.y + dt * ball.yvel
, yvel <- ball.yvel + dt * gravity }

-----------------
--  Throwing
-----------------

beat = 2 -- number of throws per second

type Hand = Left | Right

swapHand hand = case hand of
Left -> Right
Right -> Left

type alias Ball = { x:Float , y:Float , xvel:Float , yvel:Float }
type alias TimedBall = (Ball,Float)

initialBall =
let (x,y) = leftHand
in {x = x,y = y,xvel = 0 , yvel = 0}

-- Given a start point, end point and a duration, return an initial position and velocity of the ball

throw : (Float,Float) -> (Float,Float) -> Float -> TimedBall
throw (x,y) (x',y') t =
let xvel = (x'-x)/t
yvel = (y'-y)/t - (gravity * t) / 2
in ({ x=x , y=y , xvel=xvel , yvel=yvel },t)

---------------
--  Throws
---------------

-- Each style of throw takes a siteswap number and a starting hand and gives an initial ball
-- Throws are defined by their beginning and ending points

leftHandInner = (-60,-200)
leftHandOuter = (-160,-200)
rightHandInner = (60,-200)
rightHandOuter = (160,-200)

cascade : Int -> Hand -> TimedBall
cascade n hand =
let duration = (toFloat n) / beat
in if (n % 2 == 0)
then
case hand of
Left  -> throw leftHandInner leftHandOuter duration
Right -> throw rightHandInner rightHandOuter duration
else
case hand of
Left  -> throw leftHandInner rightHandOuter duration
Right -> throw rightHandInner leftHandOuter duration

-----------------
--  Siteswaps
-----------------

-- Input is a siteswap, a list of throws that alternate hands and cycles indefinitely

initialSiteswap = [cascade 5]

type SSEvent = SSTick Float | SSChange (List (Hand -> TimedBall))
ssEvents = Signal.mergeMany [ Signal.map SSTick (Time.fps beat) , Signal.map SSChange siteswap ]

-- Loops the siteswap, update it from the input and then extract the first ball every beat.
-- This is a bit sketchy, sampling on 'fps beat' in different places, maybe it won't syncronise?

siteswapCycle =
let step sig (l::list) =
case sig of
SSTick _ -> list ++ [l]
SSChange newlist -> case newlist of
[] -> initialSiteswap
otherwise -> newlist
in Signal.foldp step initialSiteswap ssEvents

alternateHands =
let step sig acc =
case acc of
Left -> Right
Right -> Left
in Signal.foldp step Left (Time.fps beat)

throwSignal : Signal TimedBall
throwSignal = Signal.sampleOn alternateHands <| Signal.map2 (\h (x::xs) -> x h) alternateHands siteswapCycle

----------------
--  Signals
----------------

timeDeltas = Signal.map (\x -> x / 1000) (Time.fps 60)

-- Maintain a list of balls and step them using the physics
-- Cull the list if duration is over and add balls following the siteswap signal

stepBall dt (ball,t) = (integrate dt ball , t - dt)

type Event = Tick Float | Add TimedBall

stepBallList event ballList =
case event of
Tick dt -> List.filter (\(_,t) -> t > 0) <| List.map (\x -> stepBall dt x) ballList
Add ball -> ball :: ballList

events = Signal.mergeMany [ Signal.map Tick timeDeltas , Signal.map Add throwSignal ]

ballListSignal : Signal (List TimedBall)
ballListSignal = Signal.foldp stepBallList [] events

-------------------------
--  Siteswap Selection
-------------------------

throwSpeeds = List.map2 (,) (List.map toString [0..9]) [0..9]

throwStyle : Signal.Mailbox (Int -> Hand -> TimedBall)
throwStyle = Signal.mailbox (cascade)

throwSpeed : Signal.Mailbox Int
throwSpeed = Signal.mailbox 0

type Update = Append | Clear
throwUpdate : Signal.Mailbox Update
throwUpdate = Signal.mailbox Clear

throwSelection = Signal.sampleOn throwUpdate.signal <| Signal.map3 (,,) throwUpdate.signal throwStyle.signal throwSpeed.signal

siteswapString =
let step (update,_,n) list =
case update of
Append -> list ++ [n]
Clear  -> []
in Signal.foldp step [] throwSelection

siteswap =
let step (update,f,n) list =
case update of
Append -> list ++ [f n]
Clear  -> []
in Signal.foldp step [] throwSelection

-------------------------
--  Rendering
-----------------------

leftHand = (-140,-200)
rightHand = (140,-200)

ballSize = 20

body : Element
body =
let bodyColor = black
in color gray <| collage 600 600 [ filled bodyColor <| polygon [(-100,0),(100,0),(60,-300),(-60,-300)] , move (0,80) <| filled bodyColor <| circle 60 , move (-140,-200) <| filled bodyColor <| circle 20 , move (140,-200) <| filled bodyColor <| circle 20 ]

renderBall : Color -> Ball -> Form
renderBall color ball = move (ball.x,ball.y) <| filled color <| circle ballSize

renderBallList : List TimedBall -> List Form
renderBallList = List.map (renderBall red) << List.map fst

renderJuggling renderedBalls = layers [ body , collage 600 600 renderedBalls ]

siteSwapSelectionBox ssText = color darkGray <| container 600 100 middle <| flow right
[ container 120 60 middle <| Graphics.Input.dropDown (Signal.message throwStyle.address) throwStyles
, container 120 60 middle <| Graphics.Input.dropDown (Signal.message throwSpeed.address) throwSpeeds
, container 120 60 middle <| Graphics.Input.button (Signal.message throwUpdate.address Append) "Add"
, container 120 60 middle <| Graphics.Input.button (Signal.message throwUpdate.address Clear) "Clear" ]
`above` (container 480 40 middle <| ((Graphics.Element.leftAligned << Text.fromString) <| "Siteswap: " ++ toString ssText))

------------------------
--  Put it all Together
--------------------------

main = Signal.map2 above (Signal.map siteSwapSelectionBox siteswapString) (Signal.map (renderJuggling << renderBallList) ballListSignal)``````