diff --git a/src/FunkyFunktions.elm b/src/FunkyFunktions.elm index a3069a5..a101223 100644 --- a/src/FunkyFunktions.elm +++ b/src/FunkyFunktions.elm @@ -1,4 +1,7 @@ module FunkyFunktions exposing (..) + +import Array exposing (get, set) + constant a b = a flip f a b = f b a compose f1 f2 a = f1 (f2 a) @@ -6,4 +9,8 @@ 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) \ No newline at end of file +uncurry2 f a b = f (a, b) +updateArray f i a = + case get i a of + Just e -> set i (f e) a + Nothing -> a \ No newline at end of file diff --git a/src/Main.elm b/src/Main.elm index 51e777b..87f03d0 100644 --- a/src/Main.elm +++ b/src/Main.elm @@ -3,11 +3,14 @@ module Main exposing (main) import FunkyFunktions exposing (..) import Stickers exposing (Sticker, StickerContent(..), viewSticker) +import Array exposing (Array, get, set) import Browser import Browser.Dom exposing (getViewport, Viewport) import Browser.Navigation exposing (Key) import Browser.Events exposing (onResize) -import Html.Attributes exposing (style) +import Html exposing (div, h3, Html, section, text) +import Html.Attributes exposing (class, style) +import Html.Events exposing (onClick) import Json.Decode as D import List exposing (map, singleton) import String exposing (fromInt) @@ -28,58 +31,112 @@ main = Browser.application type Msg = Noop - | Click Int Int + | Click Int Int Int Int | WindowSize Int Int type alias Model = { windowW: Int , windowH: Int - , stickers: List Sticker + , columns: Array Column } -sqrt2 = sqrt 2 +type alias Column = + { name: String + , tiles: Array Tile + } + +type alias Tile = + { text: String + , stickers: List Sticker + } 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, stickers = []} + { windowW = 1 + , windowH = 1 + , columns = + [ { name = "Yes - Into" + , tiles = + [ Tile + "Vore" + [(Sticker (TextSticker "red" "<3") "Into This" 100 40)] + ] |> Array.fromList + } + , { name = "Yes - Willing" + , tiles = Array.empty + } + , { name = "Maybe" + , tiles = Array.empty + } + , { name = "No" + , tiles = Array.empty + } + ] + |> Array.fromList + } |> withCmd ( getViewport |> Task.perform viewportToWindowSize ) view : Model -> Browser.Document Msg -view {windowW, windowH, stickers} = - let - (canvasW, canvasH) = canvasSize windowW windowH - in - svg - [ viewBox "0 0 11890 8410" - , width <| fromInt canvasW - , height <| fromInt canvasH +view {windowW, windowH, columns} = + section + [ class "columns" + ] + ( Array.indexedMap viewColumn columns + |> Array.toList + ) + |> singleton + |> Browser.Document "meow!" + +viewColumn : Int -> Column -> Html Msg +viewColumn columnIndex {name, tiles} = + div + [ class "column" + ] + ( ( h3 + [] + [text name] + ) :: (Array.indexedMap (viewTile columnIndex) tiles |> Array.toList) + ) + +viewTile : Int -> Int -> Tile -> Html Msg +viewTile columnIndex tileIndex tile = + div + [ class "tile" + , on "click" <| ( + D.map2 (Click columnIndex tileIndex) + (D.field "x" D.int) + (D.field "y" D.int) + ) + ] + [ text tile.text + , svg + [ Svg.Attributes.class "tile-stickers" + , height "80" + , width "400" , 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!" + (map viewSticker tile.stickers) + ] + +addStickerToTile : Sticker -> Tile -> Tile +addStickerToTile sticker tile = + { tile | stickers = sticker :: tile.stickers } + +addStickerToColumn : Int -> Sticker -> Column -> Column +addStickerToColumn tileIndex sticker column = + { column | tiles = + updateArray + (addStickerToTile sticker) + tileIndex + column.tiles + } update : Msg -> Model -> (Model, Cmd Msg) update msg model = case Debug.log "UPDATE" (msg, model) of @@ -87,6 +144,12 @@ update msg model = case Debug.log "UPDATE" (msg, model) of (WindowSize w h, _) -> { model | windowW = w, windowH = h } |> withoutCmd - (Click x y, {stickers}) -> - { model | stickers = (Sticker (TextSticker "red" "<3" ) "Into This" x y ) :: stickers } + (Click columnIndex tileIndex x y, {columns}) -> + { model + | columns = + updateArray + (addStickerToColumn tileIndex (Sticker (TextSticker "red" "<3") "Into This" x y)) + columnIndex + columns + } |> withoutCmd \ No newline at end of file diff --git a/src/Stickers.elm b/src/Stickers.elm index 1d0092e..559f3be 100644 --- a/src/Stickers.elm +++ b/src/Stickers.elm @@ -21,13 +21,13 @@ viewSticker sticker = let attributes = [ x <| fromInt sticker.x - , y <| fromInt (sticker.y + 100) + , y <| fromInt (sticker.y + 13) ] in case sticker.content of TextSticker color textContent -> text_ ( fill color - :: fontSize "200px" + :: fontSize "30px" :: textAnchor "middle" :: attributes )