Pentaflake Recursion Lab
   March 15th, 2023
   By: Nathan Hart
   hartn3 ID:400402172

----- Type Declarations -----

type Msg = Tick Float GetKeyState
         | MouseCoor (Float , Float)
         | MouseOff
         | MouseOn (Float , Float)

type alias Model = { time : Float 
                   , val : Float -- Slider value (from 0 to increments - 1)
                   , rot : Float -- rotation target
                   , rotval : Float -- rotation velocity
                   , increments : Int -- slider incremenets
                   , slidepos : Float -- current slider display position
                   , magpos : Float -- floaty slider position (display only)
                   , slidewidth : Float -- screen width of slider
                   , state : State }

-- State determines if user is interacting with slider or not
type State = Dragging
           | Waiting

type alias FormattedText = ( List ( Stencil -> Stencil )
                           , ( Float, Float ) -- Used to get around tuple size limit
                           , String )

----- Boilerplate -----

init = { time = 0
       , val = 0
       , rot = 0
       , rotval = 0
       , increments = 6 
       , slidepos = -37.5 -- set to -1/2 of slidewidth
       , magpos = -37.5 -- set to slidepos
       , slidewidth = 75
       , state = Waiting }

main = gameApp Tick { model = init, view = view, update = update, title = "Pentaflake" }

view model = collage 192 128 (myShapes model)

----- Text and Paragraph Functions -----

-- Default formatted text options
h1 text = ([bold], (4, 0.65), text)
h2 text = ([bold, italic], (2.5, 0.45), text)
p text = ([], (0.8, 0.3), text)

-- Formatting tags
b (fs, (lh, s), x) = (bold :: fs, (lh, s), x)
em (fs, (lh, s), x) = (italic :: fs, (lh, s), x)

-- Text horizontal rule
hr = ([], (1, 0.4), "_")

-- Paragraph generation function:
--   takes list of FormattedText and renders it as
--   a single unit for display with formatting.
paragraph : List(FormattedText) -> Shape usermsg
paragraph words =
  let
  
    pararecu list id = case list of
      -- Base case
      [] -> []
      
      -- Special case for hr
      ((_, (lh, s), "_")::xs) -> ( line (0, id + (-12 * s)) (25, id + (-12 * s))
                             |> outlined (solid 0.15) (rgb 50 50 100)
                           ) :: pararecu xs (id + (-16 * s) - lh)
      
      -- General text case
      ((fs, (lh, s), x)::xs) -> ( List.foldl (\a -> a) (text x) fs
                     |> fixedwidth
                     |> filled (rgb 50 50 100)
                     |> scale s
                     |> move (0, id + (-12 * s))
                 ) :: pararecu xs (id + (-12 * s) - lh)
                 
  in group ( pararecu words 0 )

----- Recursive Pentaflake -----

-- Takes the recursive depth (dim) and the display size of the flake.
pentaflake : Float -> Float -> Shape userMsg
pentaflake dim size = 
  let
  
    -- Rem is the real number portion of the dimension < 1.
    -- (floor dim) is the integer portion.
    rem = dim - (toFloat (floor dim))
    -- Growth animation is only animated if there is a (substantial) remainder.
    grow = if rem <= 0.1 then 1 else rem
  
    -- gr is golden ratio, sf is scaling factor (each smaller
    -- pentagon is sf times the 'parent's' size)
    gr = (1 + sqrt(5)) / 2
    sf = 1 / (1 + gr)

-- Recursive auxillary function.
    snowflakeRec n relscale offset =
      -- Base case, render the pentagon
      if n <= 0
        then ngon 5 (size * relscale)
              |> filled (rgb (240 - (dim * 60)) 100 (150 + (dim * 15)) ) -- Fun colour effect
              |> rotate (degrees 18) -- Correction because otherwise the pentagon renders tilted.
              
              -- Supplies growing animation if remainder is supplied.
              -- Will not grow if the dimension is too high (for performance, and it is not visible)
              |> scale ( if dim <= 4 then grow
                                     else 1 ) 
              |> move (0, offset) -- offset is the relative offset of the pentagon from it's parent.
        else
          let 
            
            -- How much is each pentagon offset from the parent (from the centre, linear distance calc)
            newoffset = (size * relscale * sf * gr )
            
            -- Create a "branch" recursively. relscale stacks the scaling factors.
            branch = snowflakeRec (n-1) (relscale * sf) newoffset
            
            -- Render branch, rotating it around centre. Move the branch by this recursive depth's offset.
            rota = \i shape -> shape |> rotate (degrees (72 * toFloat(i))) |> move (0, offset)
          
          -- Generate 5 branches and rotate them around the centre to create "flake" at that depth.
          in group ( List.indexedMap rota ( List.repeat 5 branch ) )
  
  -- Covert dim to integer before rendering at that dimension.
  in snowflakeRec (ceiling dim) 1 0

----- Shapes and Operations -----
myShapes : Model -> List(Shape Msg)
myShapes model =

let
  
    -- Extract values
    val = model.val
    floorval = floor val |> toFloat
    rem = val - (toFloat (floor val))
    
    -- Synonyms
    numNotches = model.increments
    width = model.slidewidth
    
    -- Spacing lambda for slider
    space = \i shape -> shape |> move ( ( 0.5 + toFloat i - ( toFloat numNotches / 2.0 ) ) * width / ( toFloat (numNotches - 1) ) , -55 )
    
    -- Generate notches and num shapes for slider
    notches = group ( List.repeat numNotches ( circle 1 |> filled (rgb 175 175 200) ) |> List.indexedMap space )
    nums = group ( 
             List.repeat numNotches ( text )
               |> List.indexedMap ( 
                    \i text -> text ( String.fromInt (i) ) |> ( if (floor ( val + 0.1 )) == i then bold -- bolds number if recursive depth matches
                                                                                              else identity 
                                                              ) |> fixedwidth |> filled (rgb 50 50 50) |> scale 0.3 |> move (-1.2 , 4)
             ) |> List.indexedMap space
           )
  
  -- The actual shapes
  in [ 
  
       circle 55 |> filled (rgba (240 - (floorval * 60)) 100 (150 + (floorval * 15)) 0.25)
                 |> move (50, 35)
       
       -- Group of 1 to 2 pentaflakes, depending if in transition state (rem > 0.3)
     , group [ pentaflake floorval 40 |> makeTransparent (1 - rem)                                             
             , if rem > 0.3 then pentaflake val 40 |> makeTransparent rem
                            else group [] ]
             |> rotate (degrees model.rot) |> move (40, 6)
     
     -- Slider group
     , group [
       -- Background invisible rect, enables easier 'grabbing'
       rect (width + 20) 20 |> filled (rgba 255 255 255 0.001) |> move (0, -55)
     , roundedRect (width + 3) 3 1.5 |> filled (rgb 240 240 250) |> move (0, -55)
     , notches 
     , circle 2.2
         |> filled (rgba (240 - (floorval * 60)) 100 (150 + (floorval * 15)) 0.8)
         |> addOutline (solid 0.8) white
         -- Moves based on model.magpos (smoothed slider position)
         -- Only has aesthetic/UI effect.
         |> move (model.magpos, -55)
     , nums 
     ] |> move (40, 6)
       |> case model.state of -- Give whole group 'clickability'
              Dragging -> identity
              Waiting -> notifyMouseDownAt MouseOn
       
     -- Dragging panel, invisible but tracks mouse position
     , case model.state of
         Dragging -> rect 192 128 |> filled (rgba 0 0 0 0.001)
           |> notifyMouseMoveAt MouseCoor
           |> notifyMouseUp MouseOff
           |> notifyLeave MouseOff
         Waiting -> group []
         
     -- Displays current recursive depth
     , text (String.append "i = " (String.fromInt (floor (val + 0.1)))) -- close enough
         |> bold |> centered |> fixedwidth
         |> filled (rgb 50 50 100)
         |> scale 0.4
         |> move (40, -36)
     
     -- Displays # of pentagons in render
     , text (String.append (String.fromInt (5 ^ (floor (val + 0.1)))) " pentagon(s)")
         |> bold |> centered |> fixedwidth
         |> filled (rgb 50 50 100)
         |> scale 0.3
         |> move (40, 52)
     
     -- Scrolling paragraphs
     , paragraph [ h1 "Pentaflake"
                 , p "A pentaflake is a type of n-flake"
                 , p "based on the pentagon. It is"
                 , p "composed of 5ⁱ smaller pentagons"
                 , p "to create a 'snowflake' shape."
                 , hr
                 , p "The slider below the pentagon"
                 , p "controls the recursion depth, i"
                 , p ""
                 , p "Drag the slider to try it out!" |> em |> b ]
         -- Moves and renders with scroll effect based on model.magpos (smoothed slider position)
         |> move (-90, 4 + ((model.magpos + ( width / 2 )) * 4))
         |> makeTransparent (1 - 0.01 * ((model.magpos + ( width / 2 )) * 4))
     , paragraph [ p "As you can see, when the"
                 , p "recursion depth of the pentaflake" |> b
                 , p "increases, each pentagon is rep-" |> b
                 , p "laced with 5 smaller pentagons," |> b
                 , p "at each corner... almost in a"
                 , p "snowflake-like fashion." ]
         |> move (-90, -83 + ((model.magpos + ( width / 2 )) * 4))
         |> makeTransparent (1 - 0.01 * ((-17 + model.magpos + ( width / 2 )) * 4))
     , paragraph [ p "Each time you increase the"
                 , p "recursive depth, you repeat this" |> b
                 , p "process. You'll notice that the" |> b
                 , p "pentagonal branches begin to resemble" |> b
                 , p "the entire fractal itself!" ]
         |> move (-90, -147 + ((model.magpos + ( width / 2 )) * 4))
         |> makeTransparent (1 - 0.01 * ((-31 + model.magpos + ( width / 2 )) * 4))
     , paragraph [ h2 "WARNING"
                 , p "Careful, greater recursion depths"
                 , p "can require a lot of shapes to"
                 , p "represent the pentaflake and may"
                 , p "end up slowing down your browser!" ]
         |> move (-90, -205 + ((model.magpos + ( width / 2 )) * 4))
         |> makeTransparent (1 - 0.01 * ((-45 + model.magpos + ( width / 2 )) * 4))
     , paragraph [ h2 "Fun Fact:"
                 , p "At a recursion level of i = 5, the"
                 , p "pentaflake contains 5⁵, or"
                 , p "just over 3,100 pentagons!" |> b
                 , hr
                 , p "A pentaflake is a type of n-flake."
                 , p "Did you know that infinite other"
                 , p "types of n-flakes also exist?" ]
         |> move (-90, -308 + ((model.magpos + ( width / 2 )) * 4))
     ]

-- Update handler
update : Msg -> Model -> Model
update msg model =

let
        
        -- Slider max and min bound range
        bound = (model.slidewidth/2)
        
        -- fst offsets mouse position (as slider it offset on display)
        fst (x, y) = x - 40
        clamp mi ma val = min ma val |> max mi

-- Given coordinates (mouse pos), clamps to to the slider position.
        getSlidePos coor = fst coor |> clamp (-bound) (bound)
       
        -- returns a snapped slider position to a 'notched value'
        snapPos = let frac = ( toFloat model.increments - 1 ) / model.slidewidth 
                  in toFloat ( round ( (model.slidepos + bound) * frac ) ) / frac - bound
        
        -- Updated value, based on mouse input (discrete position or continuous)
        newval = let val = ((model.slidepos + bound) * (toFloat model.increments - 1)) / model.slidewidth
                 in case model.state of
                      Dragging -> val
                      _ -> toFloat (round val)

in case msg of
        MouseOn coor -> { model | state = Dragging , slidepos = getSlidePos coor }
        MouseOff -> { model | state = Waiting , slidepos = snapPos }
        MouseCoor coor -> case model.state of
                            Dragging -> { model | slidepos = getSlidePos coor }
                            _ -> model
        Tick t _ -> let
                        
                        floorval = floor (model.val + 0.1)
                        
                        -- Values for computing rotation dynamics
                        -- For performance/visual accessibility , 4 and 5 have the same rotation target
                        offset = if floorval >= 4 then 4 else floorval
                        currentAngle =  toFloat ( offset - 1 ) * 72
                        weight = ( model.val - ( toFloat offset ) ) * 24
                        target = if floorval >= 4 then currentAngle else currentAngle + weight
                        diff = ( target - model.rot)

in { model | time = t
                        
                       -- Compute rotation velocity
                       , rotval = if ( abs diff > 0.1 ) || ( abs model.rotval > 0.05 )
                                       then case model.state of
                                              Dragging -> ( model.rotval / 1.2 ) + ( diff / 35 )
                                              _ -> ( model.rotval / 1.3 ) + ( diff / 15 )
                                       else 0
                       , rot = model.rot + model.rotval -- add rotation velocity to rotation
                       
                       -- set value (this is recursive depth + rem)
                       , val = newval
                       
                       -- Smoothly update display elements to move towards slider position.
                       , magpos = model.magpos + (model.slidepos - model.magpos) / 2 }

Create a basic game with user interaction, but no commands (needed for better random numbers).