PureScript Bezier Curve experiments

BezierCurve.purs

module Main where

import Prelude
import Effect (Effect)
import Effect.Console (log)
import Debug.Trace (trace)
import Math (pow, pi)
import Graphics.Canvas 
import Partial.Unsafe (unsafePartial)
import Data.Maybe (Maybe(..))
import Data.Array (range)
import Data.List (List(..), (:), length, fromFoldable)
import Data.Int (toNumber)
import Data.Traversable (sequence_)

main :: Effect Unit
main = unsafePartial do
  Just canvas <- getCanvasElementById "canvas"
  ctx <- getContext2D canvas    
  
  let p0 = {x: 50.0, y:300.0 -  50.0, radius: 5.0, start: 0.0, end: 2.0 * pi} :: Arc
  let p1 = {x: 100.0, y:300.0 -  290.0, radius: 5.0, start: 0.0, end: 2.0 * pi} :: Arc
  let p2 = {x: 200.0, y:300.0 -  150.0, radius: 5.0, start: 0.0, end: 2.0 * pi} :: Arc
  let p3 = {x: 300.0, y:300.0 -  250.0, radius: 5.0, start: 0.0, end: 2.0 * pi} :: Arc
  let p4 = {x: 450.0, y:300.0 -  50.0, radius: 5.0, start: 0.0, end: 2.0 * pi} :: Arc

  --Array syntax easier to comment/swap around
  let pointsArray = [
    p0,
    p1,
    p2,
    p3,
    p4
  ]

  let pointsList = (fromFoldable pointsArray) :: List Arc
  let pointsX = map (\p -> p.x) pointsList
  let pointsY = map (\p -> p.y) pointsList

  let points = 4.0:6.0:5.0:Nil  
  let degree = (length points - 1)
  let bFn = bezier points degree
  log $ "0.0: " <> show (bFn 0.0)
  log $ "0.5: " <> show (bFn 0.5)
  log $ "1.0: " <> show (bFn 1.0)

  render ctx pointsList
  mempty

render :: Context2D -> List Arc -> Effect Unit
render ctx ps = do
  let degree = (length ps - 1)
  let bezierX = bezier (map (\p -> p.x) ps) degree
  let bezierY = bezier (map (\p -> p.y) ps) degree

  let dots = map toNumber $ range 0 100
  let ts = map (\n -> div n 100.0) dots  
  let drawDots = map (\n -> drawBezierPoint ctx (bezierX n) (bezierY n)) ts
  
  clearRect ctx {x: 0.0, y: 0.0, width: 500.0, height: 300.0}
  sequence_ $ map (drawControlPoint ctx) ps
  sequence_ drawDots

bezier :: List Number -> Int -> Number -> Number
bezier Nil degree t = 0.0
bezier pps@(Cons p ps) degree t =
  let
    n = degree
    i = degree - (length ps)
    biCoeff = toNumber $ nChooseK n i

    --(1-t)^n-i
    xExp = toNumber $ n - i
    x = pow (1.0-t) xExp

    --C(t^2*P[i])
    yExp = (toNumber i)
    y = (pow t yExp) * p

    term = biCoeff * x * y
  in
    term + (bezier ps degree t)
-- trc = trace ((show biCoeff) <> "(1.0-t)^" <> (show xExp) <> "*" <> (show t) <> "^" <> (show yExp) <> "+") \_ -> 0

nChooseK :: Int -> Int -> Int
nChooseK n k = (factorial n) / ((factorial k) * (factorial (n - k)))

factorial :: Int -> Int
factorial 0 = 1
factorial n = n * factorial (n - 1)


drawControlPoint :: Context2D -> Arc -> Effect Unit
drawControlPoint ctx p = do
  beginPath ctx
  arc ctx p
  setFillStyle ctx "green"
  fill ctx
  closePath ctx

drawBezierPoint :: Context2D -> Number -> Number -> Effect Unit
drawBezierPoint ctx x y = do
  beginPath ctx
  arc ctx {x, y, radius: 1.0, start:0.0, end: 2.0 * pi}
  setFillStyle ctx "red"
  fill ctx
  closePath ctx

quadraticBezier :: Number -> Number -> Number -> Number -> Number
quadraticBezier p0 p1 p2 t =
  let 
    x = (1.0-t)
    y = t
    term1 = 1.0 * (pow x 2.0) * (pow y 0.0) * p0
    term2 = 2.0 * (pow x 1.0) * (pow y 1.0) * p1
    term3 = 1.0 * (pow x 0.0) * (pow y 2.0) * p2
  in
    term1 + term2 + term3
-- f = trace ((show x) <> ", " <> (show y) <> ", " <> (show term1) <> ", " <> (show term2) <> ", " <> (show term3)) \_ -> 5