Draw.hs
module Frontend.Draw where
import Prelude
import CSS.Color as CSS
import Color (Color, hsl, rgb, toHSLA, toHexString)
import Control.Safely (for_)
import Data.Array ((!!))
import Data.Function.Uncurried (Fn3, runFn3)
import Data.Int (toNumber)
import Data.Maybe (Maybe(..))
import Effect (Effect)
import Frontend.Types (Box(..), Object(..), Tracklet, Vec2(..))
import Graphics.Canvas (CanvasElement, CanvasImageSource, getCanvasHeight, getCanvasWidth, getContext2D)
import Graphics.Canvas as Canvas
import Math (atan2, cos, pi, sin)
foreign import imgElementToImageSourceImpl :: forall r. Fn3 String (CanvasImageSource -> r) r (Effect r)
foreign import imageShape :: CanvasImageSource -> { width :: Int, height :: Int }
-- | Get a img element by ID, or `Nothing` if the element does not exist.
getImgElementById :: String -> Effect (Maybe CanvasImageSource)
getImgElementById elId = runFn3 imgElementToImageSourceImpl elId Just Nothing
metersToPixels :: Vec2 -> Box -> Vec2 -> Vec2
metersToPixels (V2 canvasW canvasH) (Box {x0, y0, x1, y1}) (V2 x y) = let
w = x1 - x0
h = y1 - y0
px = (x - x0) / w * canvasW
py = (1.0 - (y - y0) / h) * canvasH
in V2 px py
canvasShape :: CanvasElement -> Effect Vec2
canvasShape elem = do
w <- getCanvasWidth elem
h <- getCanvasHeight elem
pure $ V2 w h
drawTracklet :: CanvasElement -> Box -> Number -> Tracklet -> Effect Unit
drawTracklet elem box alpha tracklet = do
shape <- canvasShape elem
ctx <- getContext2D elem
let
color = rgb 100 100 200
Canvas.setLineJoin ctx Canvas.BevelJoin
Canvas.setLineWidth ctx 5.0
Canvas.setGlobalAlpha ctx alpha
Canvas.setStrokeStyle ctx (toHexString color)
Canvas.beginPath ctx
for_ tracklet \pt -> do
let V2 px py = metersToPixels shape box pt.p
Canvas.lineTo ctx px py
Canvas.stroke ctx
-- start circle
case tracklet !! 0 of
Nothing -> pure unit
Just pt -> do
let V2 px py = metersToPixels shape box pt.p
Canvas.setGlobalAlpha ctx 0.2
Canvas.setFillStyle ctx (toHexString $ rgb 200 100 100)
Canvas.beginPath ctx
Canvas.arc ctx
{ x: px
, y: py
, radius: 5.0, start: 0.0, end: 6.3
}
Canvas.fill ctx
hashedColor :: Int -> Color
hashedColor h = hsl (toNumber $ h * 15_485_867 `mod` 255) 1.0 0.3
colorToCss :: Color -> CSS.Color
colorToCss col = let
{h, s, l, a} = toHSLA col
in CSS.hsla h s l a
drawObject :: CanvasElement -> Box -> Object -> Effect Unit
drawObject elem box (Object obj) = do
ctx <- getContext2D elem
shape <- canvasShape elem
let V2 hx hy' = obj.heading
hy = -hy'
angle = atan2 hy hx
V2 px py = metersToPixels shape box $ obj.pos
let color = toHexString (hashedColor obj.id)
alpha = clamp 0.0 1.0 $ toNumber (10 - obj.gap) / 10.0
Canvas.setLineWidth ctx 5.0
Canvas.setGlobalAlpha ctx alpha
Canvas.setStrokeStyle ctx color
Canvas.setFillStyle ctx color
Canvas.beginPath ctx
Canvas.arc ctx
{ x: px
, y: py
, radius: 10.0, start: angle + 3.15 / 3.0, end: angle - 3.15 / 3.0
}
Canvas.moveTo ctx (px + cos (angle - pi / 3.0) * 10.0) (py + sin (angle - pi / 3.0) * 10.0)
Canvas.lineTo ctx (px + hx * 20.0) (py + hy * 20.0)
Canvas.lineTo ctx (px + cos (angle + pi / 3.0) * 10.0) (py + sin (angle + pi / 3.0) * 10.0)
Canvas.stroke ctx
Canvas.setGlobalAlpha ctx (alpha / 3.0)
Canvas.fill ctx