Add support for clicking to draw stickers

src/Main.elm

@@ -1,13 +1,15 @@
 module Main exposing (main)
 
 import FunkyFunktions exposing (..)
+import Stickers exposing (Sticker, StickerContent(..), viewSticker)
 
 import Browser
 import Browser.Dom exposing (getViewport, Viewport)
 import Browser.Navigation exposing (Key)
 import Browser.Events exposing (onResize)
+import Html.Attributes exposing (style)
 import Json.Decode as D
-import List exposing (singleton)
+import List exposing (map, singleton)
 import String exposing (fromInt)
 import Svg exposing (Svg, svg)
 import Svg.Attributes exposing (height, viewBox, width)
@@ -32,6 +34,7 @@ type Msg
 type alias Model =
   { windowW: Int
   , windowH: Int
+  , stickers: List Sticker
   }
 
 sqrt2 = sqrt 2
@@ -52,14 +55,14 @@ translateToCanvasCoords realCanvasW realCanvasH x y =
 
 init : () -> Url -> Key -> (Model, Cmd Msg)
 init flags url browserKey =
-  {windowW = 1, windowH = 1}
+  {windowW = 1, windowH = 1, stickers = []}
     |> withCmd (
       getViewport
         |> Task.perform viewportToWindowSize
     )
 
 view : Model -> Browser.Document Msg
-view {windowW, windowH} =
+view {windowW, windowH, stickers} =
   let
     (canvasW, canvasH) = canvasSize windowW windowH
   in
@@ -67,13 +70,14 @@ view {windowW, windowH} =
       [ viewBox "0 0 11890 8410"
       , width <| fromInt canvasW
       , height <| fromInt canvasH
+      , style "user-select" "none"
       , on "click" <| (
           D.map2 (uncurry2 <| compose (curry2 Click) (curry2 <| translateToCanvasCoords canvasW canvasH))
             (D.field "x" D.int)
             (D.field "y" D.int)
         )
       ]
-      []
+      (map viewSticker stickers)
       |> singleton
       |> Browser.Document "meow!"
 
@@ -83,8 +87,6 @@ update msg model = case Debug.log "UPDATE" (msg, model) of
   (WindowSize w h, _) ->
     { model | windowW = w, windowH = h }
       |> withoutCmd
-  (Click x y, _) ->
-    let
-      _ = Debug.log "Click!" (x, y)
-    in
-      (model, Cmd.none)
+  (Click x y, {stickers}) ->
+    { model | stickers = (Sticker (TextSticker "<3" "red") "Into This" x y ) :: stickers }
+      |> withoutCmd

src/Stickers.elm

@@ -1,14 +1,30 @@
-module Stickers exposing (Sticker)
+module Stickers exposing (Sticker, StickerContent(..), viewSticker)
+
+import String exposing (fromInt)
+import Svg exposing (Svg, text, text_)
+import Svg.Attributes exposing (fill, fontSize, x, y)
 
 type alias Sticker =
   { content: StickerContent
   , tooltip: String
   , x: Int
   , y: Int
-  , rotation: Int
-  , scale: Int
-  , isHovered: Bool
+  --, scale: Int
+  --, isHovered: Bool
   }
 
 type StickerContent
-  = TextSticker String {- Text -} String {- Color -}
+  = TextSticker String {- Text -} String {- Color -}
+
+viewSticker : Sticker -> Svg msg
+viewSticker sticker =
+  let
+    attributes =
+      [ x <| fromInt sticker.x
+      , y <| fromInt sticker.y
+      ]
+  in case sticker.content of
+    TextSticker textContent color ->
+      text_
+        (fill color :: fontSize "200px" :: attributes)
+        [ text textContent ]