Set up some basic canvas stuff

elm.json

@@ -0,0 +1,25 @@
+{
+    "type": "application",
+    "source-directories": [
+        "src"
+    ],
+    "elm-version": "0.19.1",
+    "dependencies": {
+        "direct": {
+            "elm/browser": "1.0.2",
+            "elm/core": "1.0.5",
+            "elm/html": "1.0.0",
+            "elm/json": "1.1.3",
+            "elm/svg": "1.0.1",
+            "elm/url": "1.0.0"
+        },
+        "indirect": {
+            "elm/time": "1.0.0",
+            "elm/virtual-dom": "1.0.3"
+        }
+    },
+    "test-dependencies": {
+        "direct": {},
+        "indirect": {}
+    }
+}

src/FunkyFunktions.elm

@@ -0,0 +1,9 @@
+module FunkyFunktions exposing (..)
+constant a b = a
+flip f a b = f b a
+compose f1 f2 a = f1 (f2 a)
+withCmd cmd model = (model, cmd)
+withoutCmd model = (model, Cmd.none)
+andCmd cmd2 (model, cmd1) = (model, Cmd.batch [cmd1, cmd2])
+curry2 f (a, b) = f a b
+uncurry2 f a b = f (a, b)

src/Main.elm

@@ -0,0 +1,90 @@
+module Main exposing (main)
+
+import FunkyFunktions exposing (..)
+
+import Browser
+import Browser.Dom exposing (getViewport, Viewport)
+import Browser.Navigation exposing (Key)
+import Browser.Events exposing (onResize)
+import Json.Decode as D
+import List exposing (singleton)
+import String exposing (fromInt)
+import Svg exposing (Svg, svg)
+import Svg.Attributes exposing (height, viewBox, width)
+import Svg.Events exposing (on)
+import Task
+import Url exposing (Url)
+
+main = Browser.application
+  { init = init
+  , view = view
+  , update = update
+  , onUrlChange = constant Noop
+  , onUrlRequest = constant Noop
+  , subscriptions = constant <| onResize WindowSize
+  }
+
+type Msg
+  = Noop
+  | Click Int Int
+  | WindowSize Int Int
+
+type alias Model =
+  { windowW: Int
+  , windowH: Int
+  }
+
+sqrt2 = sqrt 2
+
+viewportToWindowSize : Viewport -> Msg
+viewportToWindowSize { viewport } =
+  WindowSize (round viewport.width) (round viewport.height)
+
+canvasSize : Int -> Int -> (Int, Int)
+canvasSize windowW windowH =
+  if (toFloat windowW) / (toFloat windowH) < sqrt2
+    then (windowW, (toFloat windowW) / sqrt2 |> round)
+    else (sqrt2 * (toFloat windowH) |> round, windowH)
+
+translateToCanvasCoords : Int -> Int -> Int -> Int -> (Int, Int)
+translateToCanvasCoords realCanvasW realCanvasH x y =
+  (x * 11890 // realCanvasW, y * 8410 // realCanvasH)
+
+init : () -> Url -> Key -> (Model, Cmd Msg)
+init flags url browserKey =
+  {windowW = 1, windowH = 1}
+    |> withCmd (
+      getViewport
+        |> Task.perform viewportToWindowSize
+    )
+
+view : Model -> Browser.Document Msg
+view {windowW, windowH} =
+  let
+    (canvasW, canvasH) = canvasSize windowW windowH
+  in
+    svg
+      [ viewBox "0 0 11890 8410"
+      , width <| fromInt canvasW
+      , height <| fromInt canvasH
+      , on "click" <| (
+          D.map2 (uncurry2 <| compose (curry2 Click) (curry2 <| translateToCanvasCoords canvasW canvasH))
+            (D.field "x" D.int)
+            (D.field "y" D.int)
+        )
+      ]
+      []
+      |> singleton
+      |> Browser.Document "meow!"
+
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model = case Debug.log "UPDATE" (msg, model) of
+  (Noop, _) -> (model, Cmd.none)
+  (WindowSize w h, _) ->
+    { model | windowW = w, windowH = h }
+      |> withoutCmd
+  (Click x y, _) ->
+    let
+      _ = Debug.log "Click!" (x, y)
+    in
+      (model, Cmd.none)

src/Stickers.elm

@@ -0,0 +1,14 @@
+module Stickers exposing (Sticker)
+
+type alias Sticker =
+  { content: StickerContent
+  , tooltip: String
+  , x: Int
+  , y: Int
+  , rotation: Int
+  , scale: Int
+  , isHovered: Bool
+  }
+
+type StickerContent
+  = TextSticker String {- Text -} String {- Color -}