desck 0.4.2

package/src/Main.elm

@@ -0,0 +1,3743 @@
+port module Main exposing (main)
+
+import Browser
+import Card exposing (Card, makeCard)
+import Deck exposing (modelUsing, parseDeck)
+import DeckView exposing (backface, cardSize, cornerRadius, frontface, includes)
+import Draggable
+import Draggable.Events exposing (onDragBy, onDragEnd)
+import File exposing (File)
+import File.Select as Select
+import Html as H exposing (Html)
+import Html.Attributes as HA exposing (style)
+import Html.Events as E
+import Json.Decode as Decode
+import Json.Encode exposing (Value, encode, list, string)
+import Layout exposing (Spread(..), defaultSpread, spreadAsString, updateSpreadValue, validateSpreadValue)
+import Markdown
+import Palette exposing (Color(..), Palette, colorAsString, colorFromString, colorPicker, colorPickerWithTransparent, setPaletteColor)
+import Project exposing (Project, Shape, Shapes(..), Zorder(..), arrowEnds, arrowPoints, arrowPointsToPos, arrowTransform, getHighestShapeByPos, getLastId, getSelectedCardModels, getShapeById, mergeAll, positionCards, selectWithCovering, shapeId, shapeRect, shapeTransform, splitAll, stampRect)
+import Rect exposing (..)
+import SaveFile exposing (Settings, decodeSaveFile, encodePalette, encodeSaveFile)
+import Svg exposing (Svg)
+import Svg.Attributes as Attr
+import Svg.Events exposing (onMouseUp)
+import Svg.Keyed
+import Task
+import Theme
+import Util exposing (..)
+import Vec exposing (Vec2)
+import Zone exposing (..)
+
+
+
+-- INPUTS
+
+
+port resizeMessage : (Vec2 -> msg) -> Sub msg
+
+
+type alias InputMessage =
+    { kind : String
+    , data : String
+    }
+
+
+port input : (InputMessage -> msg) -> Sub msg
+
+
+
+-- OUTPUTS
+
+
+port output : Value -> Cmd msg
+
+
+type alias StartFlags =
+    { seed : Int
+    , offline : Bool
+    , window : Vec2
+    , initial : String
+    , help : String
+    , saveFile : Maybe String
+    }
+
+
+dragState : Maybe Shape -> (Vec2 -> Vec2) -> DragEvent -> DragState
+dragState shape toLocal event =
+    { shape = shape
+    , button = parseMouseButton event.button
+    , start = toLocal <| Vec.vec2 event.x event.y
+    , offset = Vec.zero
+    , selecting = False
+    }
+
+
+type alias DragState =
+    { start : Vec2
+    , offset : Vec2
+    , shape : Maybe Shape
+    , button : MouseButton
+    , selecting : Bool
+
+    -- PLAN Editor - rotate selection around pivot : Maybe Vec2
+    }
+
+
+type Format
+    = SVG
+    | PNG
+    | JSON
+    | Symbols
+
+
+type Panel
+    = Help
+    | Settings
+    | ExportSettings
+
+
+
+-- | IO
+
+
+type SettingFlag
+    = EmbedSymbols
+    | StripData
+    | MapColors
+    | MapFont
+
+
+type ToggleTarget
+    = Boxed
+    | BringForward
+    | StackSelect
+    | ShowPanel (Maybe Panel)
+    | Setting SettingFlag
+
+
+type Layer
+    = Zones
+    | Cards
+    | Arrows
+    | Stamps
+
+
+type alias Drag =
+    { state : DragState
+    , mode : DragMode
+    }
+
+
+type Msg
+    = Noop String
+      -- PORTS
+    | Input InputMessage
+    | Resize Vec2
+    | SetKeyMods KeyMods
+      -- FILES
+    | FileSelected File
+    | FileLoaded String
+    | SaveProject
+    | ListFiles (List String)
+    | LoadProject String
+    | ChangeFilename
+    | TypeFilename String
+    | NewProject
+    | DuplicateProject
+    | Export Format
+    | UploadFile
+      -- DRAG & SELECT
+    | DragMsg (Draggable.Msg Id)
+    | StartDragWithPos Id (Draggable.Msg Id) DragEvent
+    | DragBy Vec2
+    | EndDrag
+    | Click MouseButton (Maybe Shape) Vec2 Bool
+    | FinishSelection Selection
+    | SelectArrow Id
+    | SelectAll
+      -- MODIFY
+    | Mod Project.Msg
+    | ModRandom Project.Msg
+    | Spawn
+    | SpawnStamp
+    | ApplySelector
+    | Remove
+    | SpreadByType Spread
+    | SpreadByValue String
+    | SpreadCards Id
+    | UpdateZoneString ZoneField String
+    | UpdateZoneRect Id RectCoordinate String
+    | SetArrowColor String
+    | SetStampColor Bool String
+    | SetStampLabel String
+    | SetStampSize Bool String
+    | SetArrowWidth String
+    | SetArrowHead String
+      -- TEXT
+    | UpdateFont FontType
+    | TypeFont FontType String
+    | TypeCommand String
+    | TypeStamp String
+    | TypeSelector String
+      -- EDITOR
+    | ToggleLaterMask Layer
+    | Toggle ToggleTarget
+    | Undo
+    | UpdatePaletteColor Color String
+    | UpdatePalette Palette
+    | UpdateHeightPixels String
+
+
+
+-- | UpdateCardField Id CardField String
+-- | OrderSelected SortType
+-- | UpdateSnap String
+-- | UpdateColorPicker ColorPicker.Msg
+-- | UpdatePaletteString String
+-- | OpenColorPicker Color C.Color
+
+
+type alias LayerMask =
+    { cards : Bool
+    , zones : Bool
+    , arrows : Bool
+    , stamps : Bool
+    }
+
+
+type alias Model =
+    { flags : StartFlags
+    , debug : Bool
+
+    -- Files
+    , files : List String
+    , nameInput : String
+    , fileState : FileState
+
+    -- Editor Settings
+    , unlockedLayers : LayerMask
+    , palette : Palette
+    , moveToTop : Bool
+    , stackSelect : Bool
+    , boxed : Bool
+    , zonePreset : Zone
+    , arrowPreset : Arrow
+    , stampPreset : Stamp
+
+    -- Editor State
+    , mods : KeyMods
+    , window : Vec2
+    , command : String
+    , stampInput : String
+    , panel : Maybe Panel
+    , undos : List Value
+    , id : Int
+    , selected : List Id
+    , selectedCardModels : String
+    , drag : Draggable.State Id
+    , dragState : Maybe Drag
+
+    -- Project
+    , spreadType : Spread
+    , spreadValue : Int
+    , project : Project
+    , name : String
+    , settings : Settings
+    }
+
+
+
+-- TODO Help - make a tutorial template
+
+
+init : StartFlags -> ( Model, Cmd Msg )
+init flags =
+    let
+        model : Model
+        model =
+            { flags = flags
+            , debug = False
+            , files = []
+            , nameInput = flags.initial
+            , fileState = New
+
+            -- settings
+            , unlockedLayers = { cards = True, zones = True, arrows = True, stamps = True }
+            , palette = Theme.default
+            , moveToTop = False
+            , stackSelect = False
+            , boxed = True
+            , zonePreset = defaultZone
+            , arrowPreset = defaultArrow
+            , stampPreset = defaultStamp
+
+            -- state
+            , mods = { ctrl = False, shift = False, alt = False }
+            , window = flags.window
+            , command = ""
+            , stampInput = ""
+            , panel = Nothing
+            , undos = []
+            , id = 0
+            , selected = []
+            , selectedCardModels = ""
+            , drag = Draggable.init
+            , dragState = Nothing
+
+            -- project
+            , spreadType = Horizontal
+            , spreadValue = defaultSpread Horizontal
+            , project = Project.empty
+            , name = flags.initial
+            , settings = SaveFile.default_settings
+            }
+    in
+    case flags.saveFile of
+        Just s ->
+            let
+                ( m, cmds ) =
+                    decodeSaveFileIntoModel False
+                        model
+                        s
+                        (\m_ ->
+                            Cmd.batch []
+                        )
+            in
+            ( m
+            , cmds
+            )
+
+        Nothing ->
+            ( model
+            , Cmd.batch <|
+                [ outputString LoadPalette <| Json.Encode.encode 0 <| encodePalette Theme.default
+                , outputString GetSize ""
+                , outputString Import flags.initial
+                ]
+            )
+
+
+subscriptions : Model -> Sub Msg
+subscriptions model =
+    Sub.batch
+        [ Draggable.subscriptions DragMsg model.drag
+        , resizeMessage Resize
+        , input Input
+        ]
+
+
+main : Program StartFlags Model Msg
+main =
+    Browser.element
+        { init = init
+        , update = update
+        , subscriptions = subscriptions
+        , view = view
+        }
+
+
+layerString : Layer -> String
+layerString t =
+    case t of
+        Cards ->
+            "Cards"
+
+        Zones ->
+            "Zones"
+
+        Arrows ->
+            "Arrows"
+
+        Stamps ->
+            "Stamps"
+
+
+type alias KeyMods =
+    { ctrl : Bool
+    , shift : Bool
+    , alt : Bool
+    }
+
+
+type alias Selection =
+    { start : Vec2
+    , end : Vec2
+    }
+
+
+type DragMode
+    = Move
+    | Connect
+    | Select
+    | CreateZone
+    | Turn
+    | Pan
+
+
+type FileState
+    = New
+    | NewModified
+    | Loading
+    | Opened
+    | Modified
+
+
+partitionSelected : Model -> ( List Card, List Card )
+partitionSelected model =
+    List.partition (\c -> List.member c.id model.selected) model.project.cards
+
+
+
+-- FEAT snap to grid, card, zone
+-- dragSelectedBy : Vec2 -> Model -> Model
+-- dragSelectedBy delta model =
+--     let
+--         ( dragged, idle ) =
+--             partitionSelected model
+--         dragCard c =
+--             { c | pos = c.pos |> Vec.add delta }
+--         cards =
+--             if model.bringForward then
+--                 List.concat
+--                     [ List.map
+--                         dragCard
+--                         dragged
+--                     , idle
+--                     ]
+--             else
+--                 model.cards
+--                     |> List.map
+--                         (\c ->
+--                             if List.member c.id model.selected then
+--                                 dragCard c
+--                             else
+--                                 c
+--                         )
+--         zones =
+--             model.zones
+--                 |> List.map
+--                     (\z ->
+--                         if List.member z.id model.selected then
+--                             { z | rect = { pos = Vec.add delta z.rect.pos, size = z.rect.size } }
+--                         else
+--                             z
+--                     )
+--     in
+--     { model | cards = cards, zones = zones }
+
+
+dragConfig : Draggable.Config Id Msg
+dragConfig =
+    Draggable.customConfig
+        [ onDragBy (\( dx, dy ) -> Vec2 dx dy |> DragBy)
+
+        -- , onDragStart StartDrag
+        , onDragEnd EndDrag
+
+        -- , onClick ClickTarget
+        -- , onMouseDown MouseDown
+        ]
+
+
+getContained : Project -> Rect -> List Shape
+getContained p r =
+    mergeAll p
+        |> List.filter
+            (\( _, shape ) ->
+                case shape of
+                    Project.Arrow a ->
+                        let
+                            ( from, to ) =
+                                arrowEnds p a
+                        in
+                        Rect.hasPoint from r && Rect.hasPoint to r
+
+                    _ ->
+                        let
+                            ( rect, _, _ ) =
+                                shapeTransform p shape
+                        in
+                        Rect.hasRect r rect
+            )
+        |> List.map Tuple.second
+
+
+
+-- toggleAct : CardAction -> Model -> List Card
+-- toggleAct action model =
+--     let
+--         { selected, cards } =
+--             model
+--         ( targets, rest ) =
+--             partitionSelected model
+--         center =
+--             Vec.scale 0.5 Vec.one
+--         act : Card -> Card -> Card
+--         act h c =
+--             case action of
+--                 Flip ->
+--                     { c | front = not h.front }
+--                 Rotate ->
+--                     if c.rot.angle == 0.0 then
+--                         { c | rot = { angle = 90.0, pivot = center } }
+--                     else
+--                         { c | rot = { angle = 0.0, pivot = center } }
+--                 Highlight ->
+--                     { c | highlight = not h.highlight }
+--                 Erase ->
+--                     c
+--         head =
+--             List.head selected
+--                 |> Maybe.andThen
+--                     (\n -> List.head <| List.filter (\c -> n == c.id) targets)
+--     in
+--     case head of
+--         Nothing ->
+--             cards
+--         Just h ->
+--             if model.bringForward then
+--                 List.concat
+--                     [ targets |> List.map (act h)
+--                     , rest
+--                     ]
+--             else
+--                 List.map
+--                     (\c ->
+--                         if List.member c.id model.selected then
+--                             act h c
+--                         else
+--                             c
+--                     )
+--                     model.cards
+
+
+serializeModel : Model -> Value
+serializeModel model =
+    { name = model.name
+    , project = model.project
+    , palette = model.palette
+    , settings = model.settings
+    }
+        |> encodeSaveFile
+
+
+stringifyPalette : Palette -> String
+stringifyPalette p =
+    encodePalette p
+        |> Json.Encode.encode 0
+
+
+stringifyModel : Model -> String
+stringifyModel model =
+    serializeModel model
+        |> Json.Encode.encode 0
+
+
+type OutputType
+    = ExportAs Format
+    | Save
+    | Fail
+    | Success
+    | Import
+    | GetSize
+    | LoadPalette
+    | LoadFont FontType
+    | LoadFile
+
+
+outputKindAsString : OutputType -> String
+outputKindAsString kind =
+    case kind of
+        ExportAs format ->
+            case format of
+                PNG ->
+                    "export-png"
+
+                SVG ->
+                    "export-svg"
+
+                JSON ->
+                    "export-json"
+
+                Symbols ->
+                    "export-symbols"
+
+        Save ->
+            "save"
+
+        Fail ->
+            "fail"
+
+        Success ->
+            "success"
+
+        Import ->
+            "import"
+
+        LoadPalette ->
+            "load-palette"
+
+        LoadFont ft ->
+            case ft of
+                PrimaryFont ->
+                    "load-primary-font"
+
+                SecondaryFont ->
+                    "load-secondary-font"
+
+        LoadFile ->
+            "load-file"
+
+        GetSize ->
+            "get-size"
+
+
+outputData : OutputType -> Value -> Cmd msg
+outputData kind data =
+    Json.Encode.object
+        [ ( "kind", Json.Encode.string <| outputKindAsString kind )
+        , ( "data", data )
+        ]
+        |> output
+
+
+outputString : OutputType -> String -> Cmd msg
+outputString kind s =
+    Json.Encode.object
+        [ ( "kind", Json.Encode.string <| outputKindAsString kind )
+        , ( "data", Json.Encode.string s )
+        ]
+        |> output
+
+
+type InputKind
+    = Open
+    | Files
+    | Saved
+    | Exported
+    | Mods
+
+
+inputKindFromString : String -> Maybe InputKind
+inputKindFromString s =
+    case s of
+        "open" ->
+            Just Open
+
+        "files" ->
+            Just Files
+
+        "saved" ->
+            Just Saved
+
+        "exported" ->
+            Just Exported
+
+        "mods" ->
+            Just Mods
+
+        _ ->
+            Nothing
+
+
+decodeSaveFileIntoClearedModel : Model -> String -> (Model -> Cmd Msg) -> ( Model, Cmd Msg )
+decodeSaveFileIntoClearedModel =
+    decodeSaveFileIntoModel True
+
+
+decodeSaveFileIntoModel : Bool -> Model -> String -> (Model -> Cmd Msg) -> ( Model, Cmd Msg )
+decodeSaveFileIntoModel clear model data success =
+    let
+        decoded =
+            decodeSaveFile data
+    in
+    case decoded of
+        Ok p ->
+            let
+                cleared =
+                    if clear then
+                        clearProject model p.name
+
+                    else
+                        model
+
+                zonePreset =
+                    p.project.zones |> List.reverse |> List.head |> Maybe.withDefault model.zonePreset
+            in
+            ( { cleared
+                | fileState = Opened
+                , undos = model.undos
+                , window = model.window
+                , palette = p.palette
+                , settings = p.settings
+                , id = getLastId p.project
+                , project = p.project
+                , zonePreset =
+                    { zonePreset | rect = { pos = Vec.zero, size = cardSize }, rot = { pivot = Vec.half Vec.one, angle = 0.0 } }
+                , arrowPreset = p.project.arrows |> List.reverse |> List.head |> Maybe.withDefault model.arrowPreset
+
+                -- , paletteString = String.join " " p.palette
+              }
+            , Cmd.batch <|
+                List.concat
+                    [ [ success model ]
+                    , case p.settings.primaryFont of
+                        Just font ->
+                            [ outputString (LoadFont PrimaryFont) font ]
+
+                        Nothing ->
+                            []
+                    , case p.settings.secondaryFont of
+                        Just font ->
+                            [ outputString (LoadFont SecondaryFont) font ]
+
+                        Nothing ->
+                            []
+                    , [ outputString LoadPalette <| stringifyPalette p.palette ]
+                    ]
+            )
+
+        Err err ->
+            ( model, outputString Fail <| Decode.errorToString err )
+
+
+
+-- decodeProjectIntoModel : Model -> String -> (Model -> Cmd Msg) -> ( Model, Cmd Msg )
+-- decodeProjectIntoModel model data success =
+--     decodeProjectIntoModelCleared True
+
+
+processInput : Model -> InputMessage -> ( Model, Cmd Msg )
+processInput model im =
+    let
+        n =
+            \m -> ( m, Cmd.none )
+    in
+    case inputKindFromString im.kind of
+        Nothing ->
+            n model
+
+        Just kind ->
+            case kind of
+                Open ->
+                    update (FileLoaded im.data) model
+
+                Saved ->
+                    n { model | fileState = Opened }
+
+                Mods ->
+                    let
+                        decoded =
+                            im.data
+                                |> Decode.decodeString
+                                    (Decode.map3 KeyMods
+                                        (Decode.field "ctrl" Decode.bool)
+                                        (Decode.field "shift" Decode.bool)
+                                        (Decode.field "alt" Decode.bool)
+                                    )
+                                |> Result.withDefault { ctrl = False, shift = False, alt = False }
+                    in
+                    n { model | mods = decoded }
+
+                Files ->
+                    let
+                        decoded =
+                            im.data
+                                |> Decode.decodeString (Decode.list Decode.string)
+
+                        files =
+                            case decoded of
+                                Ok list ->
+                                    list
+
+                                Err _ ->
+                                    []
+                    in
+                    n { model | files = files }
+
+                Exported ->
+                    n model
+
+
+clearProject : Model -> String -> Model
+clearProject model name =
+    let
+        ( initial, _ ) =
+            init model.flags
+    in
+    { initial
+        | files = model.files
+        , name = name
+        , nameInput = name
+        , fileState = New
+    }
+
+
+makeArrow : Arrow -> Id -> Id -> Id -> Arrow
+makeArrow preset from to id =
+    { preset
+        | from = from
+        , to = to
+        , id = id
+    }
+
+
+selectInsideSelection : Model -> Selection -> Model
+selectInsideSelection m s =
+    let
+        rect =
+            normalizeRect s.start s.end
+
+        selected =
+            getContained m.project rect
+                |> List.filter
+                    (\shape ->
+                        case shape of
+                            Project.Card _ ->
+                                m.unlockedLayers.cards
+
+                            Project.Zone _ ->
+                                m.unlockedLayers.zones
+
+                            Project.Arrow _ ->
+                                m.unlockedLayers.arrows
+
+                            Project.Stamp _ ->
+                                m.unlockedLayers.stamps
+                    )
+                |> List.sortWith
+                    (\a b ->
+                        let
+                            ( ar, _, _ ) =
+                                shapeTransform m.project a
+
+                            ( br, _, _ ) =
+                                shapeTransform m.project b
+                        in
+                        case compare br.pos.x ar.pos.x of
+                            EQ ->
+                                compare br.pos.y ar.pos.y
+
+                            o ->
+                                o
+                    )
+                |> List.map shapeId
+    in
+    { m | selected = selected, selectedCardModels = getSelectedCardModels m.project.cards selected }
+
+
+toggleArrow : Model -> Maybe Shape -> Vec2 -> Maybe Model
+toggleArrow m maybeShape pos =
+    case ( maybeShape, getHighestShapeByPos m.project pos ) of
+        ( Just fromShape, Just ( toId, toShape ) ) ->
+            let
+                fromId =
+                    shapeId fromShape
+            in
+            case toShape of
+                Project.Arrow _ ->
+                    Nothing
+
+                _ ->
+                    if fromId == toId then
+                        Nothing
+
+                    else
+                        case
+                            m.project.arrows
+                                |> List.filter (\a -> a.from == fromId && a.to == toId)
+                                |> List.head
+                        of
+                            Just existing ->
+                                Just
+                                    { m
+                                        | project =
+                                            Project.update (Project.Remove [ existing.id ]) m.project
+                                        , selected = m.selected |> List.filter (\s -> s /= existing.id)
+                                    }
+
+                            Nothing ->
+                                let
+                                    arrowId =
+                                        "a" ++ String.fromInt m.id
+                                in
+                                Just
+                                    { m
+                                        | project =
+                                            m.project
+                                                |> Project.update
+                                                    (Project.Spawn
+                                                        [ Project.Arrow <| makeArrow m.arrowPreset fromId toId arrowId ]
+                                                    )
+                                        , selected =
+                                            [ arrowId ]
+                                        , id = m.id + 1
+                                    }
+
+        _ ->
+            Nothing
+
+
+updateArrows : (Arrow -> Arrow) -> Model -> Model
+updateArrows modify model =
+    let
+        project =
+            model.project
+    in
+    { model
+        | arrowPreset = modify model.arrowPreset
+        , project =
+            { project
+                | arrows =
+                    List.map
+                        (\a ->
+                            if List.member a.id model.selected then
+                                modify a
+
+                            else
+                                a
+                        )
+                        model.project.arrows
+            }
+    }
+
+
+updateStamps : (Stamp -> Stamp) -> Model -> Model
+updateStamps modify model =
+    let
+        project =
+            model.project
+    in
+    { model
+        | stampPreset = modify model.stampPreset
+        , project =
+            { project
+                | stamps =
+                    List.map
+                        (\a ->
+                            if List.member a.id model.selected then
+                                modify a
+
+                            else
+                                a
+                        )
+                        model.project.stamps
+            }
+    }
+
+
+update : Msg -> Model -> ( Model, Cmd Msg )
+update msg model =
+    let
+        settings =
+            model.settings
+
+        cards =
+            model.project.cards
+
+        n m =
+            ( m, Cmd.none )
+
+        save m =
+            update SaveProject m
+
+        withUndo m =
+            { m
+                | fileState =
+                    if List.member m.fileState [ New, NewModified ] then
+                        NewModified
+
+                    else
+                        Modified
+                , undos = serializeModel model :: m.undos
+            }
+
+        undoable m =
+            withUndo m
+                |> save
+
+        -- undoableDesk m =
+        --     ( withUndo m
+        --     , Task.attempt (\_ -> Noop <| "couldn't focus element") (Browser.Dom.focus "#view")
+        --     )
+        rect =
+            fitToCenter
+                model.project.viewport.size
+                (Vec2 model.window.x model.window.y)
+
+        toLocal p =
+            Vec.add
+                (Vec.scale
+                    (model.project.viewport.size.x / rect.size.x)
+                    (Vec.sub p rect.pos)
+                )
+                model.project.viewport.pos
+
+        processSelected m id =
+            case id of
+                "background" ->
+                    []
+
+                _ ->
+                    if m.mods.shift || m.stackSelect then
+                        selectWithCovering model.project id
+                            |> List.append
+                                (if m.mods.ctrl then
+                                    m.selected
+
+                                 else
+                                    []
+                                )
+                            |> List.foldl
+                                (\i ls ->
+                                    if List.member i ls then
+                                        ls
+
+                                    else
+                                        i :: ls
+                                )
+                                []
+
+                    else if m.mods.ctrl then
+                        if List.member id m.selected then
+                            m.selected
+                            -- List.filter (\i -> i /= id) m.selected
+
+                        else
+                            id :: m.selected
+
+                    else if List.member id m.selected then
+                        m.selected
+
+                    else
+                        [ id ]
+    in
+    case msg of
+        -- Noop s ->
+        --     Debug.log s (n model)
+        Noop _ ->
+            n model
+
+        -- ⡤⠤⡀⡠⠤⡀⡤⠤⡀⠤⡤⠄
+        -- ⡧⠤⠃⡇⠀⡇⡧⡤⠃⠀⡇⠀
+        -- ⠃⠀⠀⠑⠒⠁⠃⠈⠂⠀⠃⠀
+        SetKeyMods km ->
+            n { model | mods = km }
+
+        Input im ->
+            processInput model im
+
+        Resize ws ->
+            n { model | window = ws }
+
+        -- ⡤⠤⠄⠠⡤⠀⡄⠀⠀⡤⠤⠄⡠⠤⡀
+        -- ⡗⠒⠀⠀⡇⠀⡇⠀⠀⡗⠒⠀⠑⠒⡄
+        -- ⠃⠀⠀⠐⠓⠀⠓⠒⠂⠓⠒⠂⠑⠒⠁
+        FileSelected file ->
+            ( model, Task.perform FileLoaded (File.toString file) )
+
+        FileLoaded s ->
+            decodeSaveFileIntoClearedModel model s (\m -> outputString Success m.name)
+
+        TypeFilename f ->
+            n { model | nameInput = f }
+
+        ChangeFilename ->
+            let
+                name =
+                    if List.member model.nameInput model.files then
+                        generateDuplicateName model.files model.nameInput
+
+                    else
+                        model.nameInput
+            in
+            update SaveProject
+                { model
+                    | name = name
+                    , nameInput = name
+                }
+
+        ListFiles ls ->
+            n { model | files = ls }
+
+        LoadProject f ->
+            ( { model | fileState = Loading, name = f, nameInput = f }, outputString Import f )
+
+        SaveProject ->
+            ( model, outputData Save (serializeModel model) )
+
+        NewProject ->
+            n <| clearProject model "untitled"
+
+        DuplicateProject ->
+            let
+                name =
+                    generateDuplicateName model.files model.name
+            in
+            n { model | name = name, nameInput = name, fileState = New }
+
+        Export format ->
+            let
+                data =
+                    if format == JSON then
+                        stringifyModel model
+
+                    else
+                        model.name
+            in
+            ( model, outputString (ExportAs format) data )
+
+        UploadFile ->
+            ( model, Select.file [ "application/json" ] FileSelected )
+
+        -- ⡤⢄⠀⡤⠤⡀⡠⠤⡀⡠⠤⡀
+        -- ⡇⠀⡇⡧⡤⠃⡧⠤⡇⡇⠤⡄
+        -- ⠓⠊⠀⠃⠈⠂⠃⠀⠃⠑⠒⠁
+        Click button shape _ selecting ->
+            case shape of
+                Nothing ->
+                    n { model | selected = [] }
+
+                Just s ->
+                    let
+                        updateIfCards fn =
+                            case s of
+                                Project.Card card ->
+                                    undoable
+                                        { model
+                                            | project =
+                                                Project.update
+                                                    (Project.UpdateShapes
+                                                        model.selected
+                                                        (\ss ->
+                                                            case ss of
+                                                                Project.Card c ->
+                                                                    Project.Card <| fn card c
+
+                                                                _ ->
+                                                                    ss
+                                                        )
+                                                    )
+                                                    model.project
+                                        }
+
+                                _ ->
+                                    n model
+                    in
+                    case button of
+                        RMB ->
+                            -- TODO UX - context menu to create/delete?
+                            if model.mods.alt then
+                                updateIfCards
+                                    (\card c ->
+                                        { c | highlight = not card.highlight }
+                                    )
+
+                            else if model.mods.shift then
+                                undoable { model | project = Project.update (Project.Remove model.selected) model.project }
+
+                            else if model.mods.ctrl then
+                                updateIfCards
+                                    (\card c ->
+                                        { c | highlight = not card.highlight }
+                                    )
+
+                            else
+                                updateIfCards
+                                    (\card c ->
+                                        { c | front = not card.front }
+                                    )
+
+                        LMB ->
+                            if model.mods.alt then
+                                updateIfCards
+                                    (\card c ->
+                                        let
+                                            angle =
+                                                card.rot.angle
+                                        in
+                                        { c
+                                            | rot =
+                                                { angle =
+                                                    let
+                                                        a =
+                                                            round (angle / 90.0)
+                                                                |> modBy 4
+                                                    in
+                                                    toFloat ((a + 1) * 90)
+                                                , pivot = Vec.half Vec.one
+                                                }
+                                        }
+                                    )
+                                -- else if model.mods.shift then
+                                --     updateIfCards
+                                --         (\card c ->
+                                --             { c | highlight = not card.highlight }
+                                --         )
+
+                            else if selecting then
+                                undoable { model | project = Project.update (Project.Order Project.MoveTop model.selected) model.project }
+
+                            else
+                                n model
+
+                        _ ->
+                            n model
+
+        DragMsg dragMsg ->
+            Draggable.update dragConfig dragMsg model
+
+        StartDragWithPos id dragMsg event ->
+            let
+                maybeShape =
+                    Project.getShapeById model.project id
+
+                state =
+                    dragState maybeShape toLocal event
+
+                mode =
+                    if id == "background" then
+                        case state.button of
+                            LMB ->
+                                if model.mods.shift then
+                                    CreateZone
+
+                                else if model.mods.alt then
+                                    Turn
+
+                                else
+                                    Select
+
+                            MMB ->
+                                Pan
+
+                            RMB ->
+                                CreateZone
+
+                    else
+                        case state.button of
+                            LMB ->
+                                if model.mods.alt then
+                                    Turn
+
+                                else if model.mods.shift then
+                                    Connect
+
+                                else
+                                    Move
+
+                            MMB ->
+                                Pan
+
+                            RMB ->
+                                Connect
+
+                selected =
+                    processSelected model id
+            in
+            { model
+                | dragState =
+                    Just
+                        { state = { state | selecting = List.member id model.selected }
+                        , mode = mode
+                        }
+                , project =
+                    if model.moveToTop then
+                        -- HACK this should be undoable
+                        Project.update (Project.Order MoveTop selected) model.project
+
+                    else
+                        model.project
+                , selected = selected
+                , selectedCardModels = getSelectedCardModels model.project.cards selected
+            }
+                |> Draggable.update dragConfig dragMsg
+
+        DragBy delta ->
+            case model.dragState of
+                Nothing ->
+                    n model
+
+                Just ds ->
+                    let
+                        { state, mode } =
+                            ds
+
+                        localDelta d =
+                            Vec.scale (model.project.viewport.size.x / rect.size.x) d
+
+                        deltaMult =
+                            case mode of
+                                Turn ->
+                                    0.25
+
+                                _ ->
+                                    1.0
+
+                        nextState =
+                            { state | offset = Vec.add state.offset <| localDelta (Vec.scale deltaMult delta) }
+
+                        pos =
+                            Vec.add nextState.start nextState.offset
+
+                        m =
+                            { model | dragState = Just { ds | state = nextState } }
+                    in
+                    case mode of
+                        Pan ->
+                            update (Mod <| Project.Pan <| localDelta delta) m
+
+                        Connect ->
+                            { m
+                                | selected = getHighestShapeByPos model.project pos |> Maybe.map (\( i, _ ) -> [ i ]) |> Maybe.withDefault []
+                            }
+                                |> n
+
+                        _ ->
+                            n m
+
+        FinishSelection s ->
+            selectInsideSelection model s
+                |> n
+
+        EndDrag ->
+            case model.dragState of
+                Nothing ->
+                    n model
+
+                Just { state, mode } ->
+                    let
+                        m =
+                            { model | dragState = Nothing }
+                    in
+                    if Vec.length state.offset <= 5.0 then
+                        update (Click state.button state.shape state.start state.selecting) m
+
+                    else
+                        case mode of
+                            CreateZone ->
+                                let
+                                    s =
+                                        { start = state.start, end = Vec.add state.start state.offset }
+                                in
+                                if Rect.area (normalizeRect s.start s.end) > 100 then
+                                    let
+                                        zonePreset =
+                                            model.zonePreset
+
+                                        r =
+                                            normalizeRect (snapPos model s.start) (snapPos model s.end)
+
+                                        newZone =
+                                            { zonePreset
+                                                | rect = r
+                                                , id = "z" ++ String.fromInt model.id
+                                            }
+                                    in
+                                    undoable
+                                        { m
+                                            | project = Project.update (Project.Spawn [ Project.Zone newZone ]) m.project
+                                            , selected = [ newZone.id ]
+                                            , selectedCardModels = ""
+                                            , id = model.id + 1
+                                        }
+
+                                else
+                                    n m
+
+                            Select ->
+                                update (FinishSelection { start = state.start, end = Vec.add state.start state.offset }) m
+
+                            Move ->
+                                { m
+                                    | project =
+                                        Project.update
+                                            (Project.UpdateShapes model.selected
+                                                (\s ->
+                                                    case s of
+                                                        Project.Arrow a ->
+                                                            Project.Arrow a
+
+                                                        _ ->
+                                                            draggedTransform model s
+                                                                |> Project.transformShape s
+                                                )
+                                            )
+                                            model.project
+                                }
+                                    |> undoable
+
+                            -- { m
+                            --     | project = Project.update (Project.Move state.offset model.selected) model.project
+                            -- }
+                            -- |> undoable
+                            Pan ->
+                                undoable model
+
+                            Turn ->
+                                { m | project = Project.update (Project.Turn state.offset.x model.selected) model.project }
+                                    |> undoable
+
+                            Connect ->
+                                let
+                                    pos =
+                                        state.start |> Vec.add state.offset
+                                in
+                                toggleArrow m state.shape pos
+                                    |> Maybe.map undoable
+                                    |> Maybe.withDefault (n m)
+
+        -- ⣄⢀⡄⡠⠤⡀⡤⢄⠀⠠⡤⠀⡤⠤⠄⡄⠀⡄
+        -- ⡇⠃⡇⡇⠀⡇⡇⠀⡇⠀⡇⠀⡗⠒⠀⠘⡜⠀
+        -- ⠃⠀⠃⠑⠒⠁⠓⠊⠀⠐⠓⠀⠃⠀⠀⠀⠃⠀
+        Mod message ->
+            let
+                project =
+                    Project.update message model.project
+            in
+            undoable { model | project = project }
+
+        ModRandom message ->
+            let
+                flags =
+                    model.flags
+
+                project =
+                    Project.updateWithSeed flags.seed message model.project
+            in
+            undoable { model | project = project, flags = { flags | seed = flags.seed + 1 } }
+
+        ApplySelector ->
+            let
+                nextModels =
+                    parseDeck model.selectedCardModels
+                        |> List.map2 (\id cardModel -> ( id, cardModel )) model.selected
+
+                project =
+                    Project.update
+                        (Project.UpdateShapes model.selected
+                            (\s ->
+                                case s of
+                                    Project.Card c ->
+                                        case
+                                            nextModels
+                                                |> List.filter (\( i, _ ) -> i == c.id)
+                                                |> List.head
+                                        of
+                                            Just ( _, cardModel ) ->
+                                                Project.Card { c | model = cardModel }
+
+                                            Nothing ->
+                                                s
+
+                                    _ ->
+                                        s
+                            )
+                        )
+                        model.project
+            in
+            undoable
+                { model
+                    | project = project
+                    , selectedCardModels = getSelectedCardModels project.cards model.selected
+                }
+
+        UpdateZoneString field string ->
+            undoable
+                { model
+                    | zonePreset = updateZoneString field string model.zonePreset
+                    , project =
+                        Project.update
+                            (Project.UpdateShapes model.selected
+                                (\s ->
+                                    case s of
+                                        Project.Zone z ->
+                                            Project.Zone <|
+                                                updateZoneString field string z
+
+                                        _ ->
+                                            s
+                                )
+                            )
+                            model.project
+                }
+
+        UpdateZoneRect id rc string ->
+            undoable
+                { model
+                    | project =
+                        Project.update
+                            (Project.UpdateZone id
+                                (\z ->
+                                    { z
+                                        | rect =
+                                            modifyRect
+                                                z.rect
+                                                { pos = cardSize, size = cardSize }
+                                                rc
+                                                (String.toFloat string |> Maybe.withDefault 0.0)
+                                                |> minSized cardSize
+                                    }
+                                )
+                            )
+                            model.project
+                }
+
+        SpawnStamp ->
+            case model.stampInput of
+                "" ->
+                    n model
+
+                s ->
+                    let
+                        stampPreset =
+                            model.stampPreset
+
+                        text =
+                            stampPreset.text
+
+                        stampId =
+                            "s" ++ String.fromInt model.id
+
+                        stamp =
+                            { stampPreset
+                                | text = { text | label = s }
+                                , id = stampId
+                                , pos = center model.project.viewport
+                            }
+                    in
+                    undoable
+                        { model
+                            | project = Project.update (Project.Spawn [ Project.Stamp stamp ]) model.project
+                            , id = model.id + 1
+                            , stampInput = ""
+                            , selected = [ stampId ]
+                        }
+
+        Spawn ->
+            case parseDeck model.command of
+                [] ->
+                    n model
+
+                ls ->
+                    let
+                        additions =
+                            List.length ls
+
+                        indices =
+                            List.range model.id (model.id + additions)
+
+                        newCards =
+                            List.map2 (\cm id -> makeCard id cm (Vec2 0.0 0.0)) ls indices
+                                |> positionCards
+                                    model.spreadType
+                                    model.spreadValue
+                                    (Vec.sub (center model.project.viewport) (Vec.half cardSize))
+                                |> List.reverse
+                                |> List.map (\c -> Project.Card c)
+
+                        selected =
+                            indices |> List.map (String.fromInt >> (\i -> "c" ++ i))
+                    in
+                    undoable
+                        { model
+                            | project = Project.update (Project.Spawn newCards) model.project
+                            , command = ""
+                            , selected = selected
+                            , selectedCardModels = getSelectedCardModels model.project.cards selected
+                            , id = model.id + additions + 1
+                        }
+
+        Remove ->
+            if List.isEmpty model.selected then
+                n model
+
+            else
+                undoable
+                    { model
+                        | project = Project.update (Project.Remove model.selected) model.project
+                        , selected = []
+                        , selectedCardModels = ""
+                    }
+
+        SelectAll ->
+            let
+                selected =
+                    List.map .id cards
+            in
+            n
+                { model
+                    | selected = selected
+                    , selectedCardModels = getSelectedCardModels model.project.cards selected
+                }
+
+        SelectArrow id ->
+            n { model | selected = [ id ], selectedCardModels = "" }
+
+        SetArrowWidth s ->
+            updateArrows
+                (\a -> { a | width = Maybe.withDefault a.width <| String.toFloat s })
+                model
+                |> undoable
+
+        SetArrowHead s ->
+            updateArrows
+                (\a -> { a | head = headFromString s })
+                model
+                |> undoable
+
+        SetArrowColor c ->
+            updateArrows
+                (\a -> { a | fill = colorFromString c })
+                model
+                |> undoable
+
+        SetStampLabel s ->
+            updateStamps
+                (\a ->
+                    let
+                        text =
+                            a.text
+                    in
+                    { a | text = { text | label = s } }
+                )
+                model
+                |> undoable
+
+        SetStampColor fill c ->
+            if fill then
+                updateStamps
+                    (\a -> { a | fill = colorFromString c })
+                    model
+                    |> undoable
+
+            else
+                updateStamps
+                    (\a ->
+                        let
+                            t =
+                                a.text
+                        in
+                        { a | text = { t | color = colorFromString c } }
+                    )
+                    model
+                    |> undoable
+
+        SetStampSize fill c ->
+            if fill then
+                updateStamps
+                    (\a -> { a | radius = String.toFloat c |> Maybe.withDefault defaultStamp.radius })
+                    model
+                    |> undoable
+
+            else
+                updateStamps
+                    (\a ->
+                        let
+                            t =
+                                a.text
+                        in
+                        { a | text = { t | size = String.toInt c |> Maybe.withDefault defaultStamp.text.size } }
+                    )
+                    model
+                    |> undoable
+
+        ToggleLaterMask layer ->
+            let
+                layers =
+                    model.unlockedLayers
+            in
+            undoable
+                { model
+                    | unlockedLayers =
+                        case layer of
+                            Zones ->
+                                { layers | zones = not layers.zones }
+
+                            Cards ->
+                                { layers | cards = not layers.cards }
+
+                            Arrows ->
+                                { layers | arrows = not layers.arrows }
+
+                            Stamps ->
+                                { layers | stamps = not layers.stamps }
+                }
+
+        SpreadByType spreadType ->
+            let
+                next =
+                    { model
+                        | spreadType = spreadType
+                        , spreadValue = updateSpreadValue model.spreadType spreadType model.spreadValue
+                    }
+            in
+            case List.head model.selected of
+                Just head ->
+                    update (SpreadCards head) next
+
+                Nothing ->
+                    n next
+
+        SpreadByValue string ->
+            let
+                next =
+                    { model | spreadValue = validateSpreadValue model.spreadType <| Maybe.withDefault 0 (String.toInt string) }
+            in
+            case List.head model.selected of
+                Just head ->
+                    update (SpreadCards head) next
+
+                Nothing ->
+                    n next
+
+        -- FIX Editor - only move and snap selection leader
+        SpreadCards _ ->
+            let
+                ( targets, _ ) =
+                    partitionSelected model
+
+                topLeft =
+                    targets
+                        |> (if model.spreadValue < 0 then
+                                List.foldl
+                                    (\c a -> Vec.max c.rect.pos a)
+                                    (Vec2 -10000.0 -10000.0)
+
+                            else
+                                List.foldl
+                                    (\c a -> Vec.min c.rect.pos a)
+                                    (Vec2 10000.0 10000.0)
+                           )
+
+                lowest =
+                    targets |> List.map .z |> List.foldl min 0
+
+                spreadCards =
+                    targets
+                        |> List.reverse
+                        |> positionCards
+                            model.spreadType
+                            model.spreadValue
+                            topLeft
+                        |> List.reverse
+                        |> List.indexedMap (\i c -> { c | z = lowest + i })
+
+                -- |> List.reverse
+            in
+            undoable
+                { model
+                    | project =
+                        model.project
+                            |> Project.update
+                                (Project.UpdateShapes (spreadCards |> List.map .id)
+                                    (\s ->
+                                        case s of
+                                            Project.Card c ->
+                                                case
+                                                    spreadCards |> List.filter (\sc -> sc.id == c.id) |> List.head
+                                                of
+                                                    Just h ->
+                                                        Project.Card h
+
+                                                    Nothing ->
+                                                        s
+
+                                            _ ->
+                                                s
+                                    )
+                                )
+                }
+
+        -- ⡤⠤⠄⡤⢄⠀⠠⡤⠀⠤⡤⠄⡠⠤⡀⡤⠤⡀
+        -- ⡗⠒⠀⡇⠀⡇⠀⡇⠀⠀⡇⠀⡇⠀⡇⡧⡤⠃
+        -- ⠓⠒⠂⠓⠊⠀⠐⠓⠀⠀⠃⠀⠑⠒⠁⠃⠈⠂
+        Toggle t ->
+            case t of
+                Setting s ->
+                    case s of
+                        EmbedSymbols ->
+                            save { model | settings = { settings | embedSymbols = not settings.embedSymbols } }
+
+                        StripData ->
+                            save { model | settings = { settings | stripData = not settings.stripData } }
+
+                        MapColors ->
+                            save { model | settings = { settings | mapColors = not settings.mapColors } }
+
+                        MapFont ->
+                            save { model | settings = { settings | mapFont = not settings.mapFont } }
+
+                Boxed ->
+                    undoable { model | boxed = not model.boxed }
+
+                BringForward ->
+                    save { model | moveToTop = not model.moveToTop }
+
+                StackSelect ->
+                    save { model | stackSelect = not model.stackSelect }
+
+                ShowPanel p ->
+                    save { model | panel = p }
+
+        Undo ->
+            case model.undos of
+                head :: rest ->
+                    decodeSaveFileIntoClearedModel
+                        { model | undos = rest }
+                        (Json.Encode.encode 1 head)
+                        (\_ -> Cmd.none)
+
+                _ ->
+                    save model
+
+        UpdatePaletteColor target s ->
+            let
+                ( m, _ ) =
+                    undoable { model | palette = setPaletteColor model.palette target s }
+            in
+            ( m, outputString LoadPalette <| stringifyPalette m.palette )
+
+        TypeCommand s ->
+            n { model | command = s }
+
+        TypeStamp s ->
+            n { model | stampInput = s }
+
+        TypeSelector s ->
+            n { model | selectedCardModels = s }
+
+        UpdateHeightPixels string ->
+            let
+                pixels =
+                    String.toInt string
+            in
+            case pixels of
+                Just px ->
+                    n { model | settings = { settings | heightPixels = px } }
+
+                Nothing ->
+                    n model
+
+        -- UpdateSnap string ->
+        --     case String.toInt string of
+        --         Nothing ->
+        --             n model
+        --         Just i ->
+        --             n { model | snap = Basics.clamp 0 8 i }
+        -- UpdatePaletteString string ->
+        --     n { model | paletteString = string }
+        UpdatePalette palette ->
+            let
+                -- colors =
+                --     String.split " " model.paletteString
+                --         |> List.map String.trim
+                --         |> List.filter (\s -> not <| String.isEmpty s)
+                -- palette =
+                --     if List.isEmpty colors then
+                --         [ model.palette.black ]
+                --     else
+                --         colors
+                ( m, _ ) =
+                    undoable { model | palette = palette }
+            in
+            ( m, outputString LoadPalette <| Json.Encode.encode 0 <| encodePalette palette )
+
+        TypeFont ft s ->
+            let
+                f =
+                    if s == "" then
+                        Nothing
+
+                    else
+                        Just s
+            in
+            n
+                { model
+                    | settings =
+                        case ft of
+                            PrimaryFont ->
+                                { settings
+                                    | primaryFont = f
+                                }
+
+                            SecondaryFont ->
+                                { settings
+                                    | secondaryFont = f
+                                }
+                }
+
+        UpdateFont ft ->
+            ( model
+            , outputString (LoadFont ft) <|
+                Maybe.withDefault ""
+                    (if ft == PrimaryFont then
+                        model.settings.primaryFont
+
+                     else
+                        model.settings.secondaryFont
+                    )
+            )
+
+
+
+-- OpenColorPicker c v ->
+--     n { model | pickedColor = Just c, colorPicker = ColorPicker.fromColor v }
+-- UpdateColorPicker cmsg ->
+--     case model.pickedColor of
+--         Nothing ->
+--             n model
+--         Just target ->
+--             let
+--                 ( cp, color ) =
+--                     ColorPicker.update cmsg model.colorPicker
+--             in
+--             let
+--                 ( m, _ ) =
+--                     undoable
+--                         { model
+--                             | colorPicker = cp
+--                             , palette = setPaletteColor model.palette target color
+--                             -- , pickedColor = Nothing
+--                         }
+--             in
+-- UpdateCardField id field string ->
+--     let
+--         updateCard : Card -> Card
+--         updateCard c =
+--             if c.id == id then
+--                 { c
+--                     | model =
+--                         case field of
+--                             CardRank ->
+--                                 { rank =
+--                                     String.toInt string
+--                                         |> Maybe.withDefault (rankAsInt c.model.rank)
+--                                         |> rankFromInt
+--                                 , suit = c.model.suit
+--                                 }
+--                             CardSuit ->
+--                                 { rank = c.model.rank
+--                                 , suit = Maybe.withDefault c.model.suit (suitFromString string)
+--                                 }
+--                 }
+--             else
+--                 c
+--     in
+--     mod { model | cards = model.cards |> List.map updateCard }
+
+
+snapFloat : Float -> Float -> Float
+snapFloat s f =
+    round (f / s) * round s |> toFloat
+
+
+snapPos : Model -> Vec2 -> Vec2
+snapPos model pos =
+    if not model.mods.ctrl then
+        pos
+
+    else
+        let
+            s =
+                toFloat 4
+
+            xs =
+                cardSize.x / s
+
+            ys =
+                cardSize.y / s
+        in
+        { x = snapFloat xs pos.x, y = snapFloat ys pos.y }
+
+
+snapAngle : Model -> Float -> Float
+snapAngle _ angle =
+    -- if model.snap == 0 then
+    --     angle
+    -- else
+    --     snapFloat (360.0 / (toFloat model.snap * 4)) angle
+    angle
+
+
+
+---------------------------------------- ⡄⠀⡄⠠⡤⠀⡤⠤⠄⡄⠀⡄⡠⠤⡀
+---------------------------------------- ⢱⢰⠁⠀⡇⠀⡗⠒⠀⡇⡄⡇⠑⠒⡄
+---------------------------------------- ⠀⠃⠀⠐⠓⠀⠓⠒⠂⠋⠈⠃⠑⠒⠁
+
+
+rectCoordInput : (RectCoordinate -> String -> msg) -> Float -> RectCoordinate -> Html msg
+rectCoordInput message current rc =
+    -- coordString : RectCoordinate -> String
+    -- coordString rc =
+    --     case rc of
+    --         PosX ->
+    --             "X"
+    --         PosY ->
+    --             "Y"
+    --         SizeX ->
+    --             "W"
+    --         SizeY ->
+    --             "H"
+    H.span
+        []
+        -- [ H.h5 [] [ H.text <| coordString rc ]
+        [ H.input
+            [ HA.type_ "number"
+            , HA.value <| String.fromFloat current
+            , HA.class "narrow"
+            , E.onInput (message rc)
+            ]
+            []
+        ]
+
+
+rectInput : (RectCoordinate -> String -> msg) -> Rect -> Html msg
+rectInput fn rect =
+    H.div [ HA.style "display" "flex" ]
+        [ H.span []
+            [ rectCoordInput fn (rect.pos.x / cardSize.x) PosX
+            , rectCoordInput fn (rect.pos.y / cardSize.y) PosY
+            ]
+        , H.span []
+            [ rectCoordInput fn (rect.size.x / cardSize.x) SizeX
+            , rectCoordInput fn (rect.size.y / cardSize.y) SizeY
+            ]
+        ]
+
+
+viewportView : Rect -> Svg Msg
+viewportView viewport =
+    let
+        p =
+            4.0
+
+        pad =
+            Vec2 p p
+
+        size =
+            viewport.size |> Vec.add (Vec.scale 2.0 pad)
+    in
+    Svg.rect
+        [ num Attr.x (viewport.pos.x - p)
+        , num Attr.y (viewport.pos.y - p)
+        , size.x |> num Attr.width
+        , size.y |> num Attr.height
+        , Attr.stroke "#fff"
+        , Attr.fill "none"
+        , Attr.strokeWidth (String.fromFloat <| p * 2.0)
+        , Attr.pointerEvents "none"
+        ]
+        []
+
+
+viewportId : Model -> String
+viewportId m =
+    "viewport" ++ String.fromInt m.flags.seed
+
+
+clipPath : Model -> Svg Msg
+clipPath m =
+    let
+        size =
+            m.project.viewport.size
+    in
+    Svg.clipPath
+        [ Attr.id <| viewportId m ]
+        [ Svg.rect
+            [ num Attr.x m.project.viewport.pos.x
+            , num Attr.y m.project.viewport.pos.y
+            , num Attr.width size.x
+            , num Attr.height size.y
+            ]
+            []
+        ]
+
+
+maybeHtml : Bool -> Html Msg -> Html Msg
+maybeHtml show element =
+    if show then
+        element
+
+    else
+        H.text ""
+
+
+
+-- isJust : Maybe a -> Bool
+-- isJust m =
+--     case m of
+--         Just _ ->
+--             True
+--         Nothing ->
+--             False
+
+
+enumOption : (String -> msg) -> (a -> String) -> (a -> Bool) -> List a -> Html msg
+enumOption message asString isCurrent options =
+    H.select [ E.onInput message ]
+        (List.map
+            (\t ->
+                let
+                    string =
+                        asString t
+                in
+                H.option
+                    [ HA.value string
+                    , isCurrent t |> HA.selected
+                    ]
+                    [ H.text string ]
+            )
+            options
+        )
+
+
+enumButtons : (a -> msg) -> (a -> String) -> (a -> Bool) -> List ( a, String ) -> Html msg
+enumButtons message asString isCurrent options =
+    H.span
+        []
+        (List.map
+            (\( t, label ) ->
+                H.button
+                    [ E.onClick (message t)
+                    , HA.class <|
+                        if isCurrent t then
+                            ""
+
+                        else
+                            "inactive"
+                    , HA.class "enum-button"
+                    , HA.title (asString t)
+                    ]
+                    [ H.text label ]
+            )
+            options
+        )
+
+
+
+-- TODO UX - fix inputs not allowing backspace properly
+-- TODO UX - better number inputs?
+
+
+fieldInputRange : (String -> Msg) -> Maybe Int -> Maybe Int -> String -> Int -> Html Msg
+fieldInputRange msg mn mx n v =
+    H.span
+        []
+        [ H.h5 [ HA.style "display" "inline-block" ] [ H.text n ]
+        , H.input
+            (List.concat
+                [ mn |> Maybe.map (\i -> [ HA.min <| String.fromInt i ]) |> Maybe.withDefault []
+                , mx |> Maybe.map (\i -> [ HA.max <| String.fromInt i ]) |> Maybe.withDefault []
+                , [ E.onInput msg
+                  , HA.value <| String.fromInt v
+                  , HA.type_ "number"
+                  , HA.class "narrow"
+                  , style "width" "6em"
+                  ]
+                ]
+            )
+            []
+        ]
+
+
+fieldInput : (String -> Msg) -> String -> Int -> Html Msg
+fieldInput msg =
+    fieldInputRange msg Nothing Nothing
+
+
+colorInput : Model -> (String -> Msg) -> String -> Color -> Html Msg
+colorInput model msg n v =
+    H.span
+        [ HA.class "inpector-column" ]
+        [ H.text n
+        , colorPickerWithTransparent model.palette msg v
+        ]
+
+
+arrowInspector : Model -> Arrow -> Html Msg
+arrowInspector model a =
+    H.div []
+        [ H.text "" -- <| "arrow " ++ a.from ++ "->" ++ a.to
+        , colorPicker False model.palette SetArrowColor a.fill
+        , H.input
+            [ HA.type_ "number"
+            , E.onInput SetArrowWidth
+            , HA.min "0"
+            , HA.max "100"
+            , HA.class "narrow"
+            , HA.value <| String.fromFloat a.width
+            ]
+            []
+        , enumOption
+            SetArrowHead
+            headString
+            (\h -> h == a.head)
+            [ Triangle, None, Cross ]
+        ]
+
+
+stampInspector : Model -> Stamp -> Html Msg
+stampInspector model a =
+    let
+        symbolPicker ls =
+            H.span
+                [ HA.class "inspector-row"
+                , HA.style "gap" "0.04rem"
+                , HA.style "flex-wrap" "wrap"
+                , HA.style "justify-content" "start"
+                ]
+            <|
+                List.map
+                    (\s ->
+                        H.button
+                            [ E.onClick (SetStampLabel s)
+                            , HA.style "min-width" "1.5rem"
+                            ]
+                            [ H.text s ]
+                    )
+                    ls
+    in
+    H.div []
+        [ H.h5 [] [ H.text "Stamp" ]
+
+        -- TODO UX - disallow same bg and fg for Stamps and Zones?
+        , colorPicker True model.palette (SetStampColor True) a.fill
+        , H.input
+            [ HA.type_ "number"
+            , E.onInput (SetStampSize True)
+            , HA.min "0"
+            , HA.max "100"
+            , HA.class "narrow"
+            , HA.value <| String.fromFloat a.radius
+            ]
+            []
+        , colorPicker False model.palette (SetStampColor False) a.text.color
+        , H.input
+            [ HA.type_ "number"
+            , E.onInput (SetStampSize False)
+            , HA.min "0"
+            , HA.max "400"
+            , HA.class "narrow"
+            , HA.value <| String.fromInt a.text.size
+            ]
+            []
+        , H.input
+            [ E.onInput SetStampLabel
+            , HA.value a.text.label
+            ]
+            []
+        , H.div [ HA.class "inpector-column" ]
+            [ symbolPicker [ "A", "B", "C", "D", "E", "F", "G", "H", "I", "J" ]
+            , symbolPicker [ "1", "2", "3", "4", "5", "6", "7", "8", "9", "0" ]
+
+            -- TODO add geometric symbols and stamps
+            , symbolPicker <|
+                List.concat
+                    [ [ "✓", "✔", "✔️", "✅", "☑️", "☑", "🗹" ]
+                    , [ "✖️", "✖", "❌", "𐄂", "❎", "🚫", "🔒", "⛔", "🛑" ]
+                    , [ "❗"
+                      , "❓"
+                      , "⚠️"
+                      , "💡"
+                      , "🧠"
+                      , "🎯"
+                      , "🧩"
+                      ]
+                    , [ "🏆", "🏅" ]
+                    , [ "⭐", "🌟", "✪", "★", "☆", "∗" ]
+                    ]
+            ]
+        , H.a [ HA.href "https://www.compart.com/en/unicode", HA.target "_blank" ] [ H.text "find more symbols to use..." ]
+
+        -- , enumOption
+        --     SetArrowHead
+        --     headString
+        --     (\h -> h == a.head)
+        --     [ Triangle, None, Cross ]
+        ]
+
+
+zoneInspector : Model -> Bool -> Zone -> Html Msg
+zoneInspector model multi z =
+    H.div
+        [ HA.class "inspector-column"
+        ]
+        [ H.span [ HA.class "inspector-column" ]
+            [ H.h5 [] [ H.text "Label" ]
+            , H.textarea
+                [ E.onInput (UpdateZoneString ZoneLabel)
+                , HA.value z.text.label
+                , HA.disabled multi
+                , HA.classList [ ( "hidden", multi ) ]
+                ]
+                []
+            ]
+        , H.div [ HA.class "inspector-row" ]
+            [ H.div []
+                [ enumOption
+                    (UpdateZoneString ZoneAnchor)
+                    anchorString
+                    (\a -> a == z.text.anchor)
+                    [ Zone.Center, Zone.Top, Zone.Bottom, Zone.Left, Zone.Right ]
+                ]
+            , fieldInput
+                (UpdateZoneString ZoneFontSize)
+                "🗚"
+                z.text.size
+            ]
+
+        -- TODO toggle secondary font
+        , H.span [ HA.class "inspector-column" ]
+            [ H.h5 [] [ H.text "Font" ]
+            , H.div
+                [ HA.class "inpector-column" ]
+                [ enumOption
+                    (UpdateZoneString ZoneFont)
+                    (\b ->
+                        if b then
+                            "Primary"
+
+                        else
+                            "Secondary"
+                    )
+                    (\a -> a == z.text.primary)
+                    [ True, False ]
+                , colorPicker False model.palette (UpdateZoneString ZoneText) z.text.color
+                ]
+            ]
+        , H.span [ HA.class "inspector-column" ]
+            [ H.h5 [] [ H.text "Fill ◼" ]
+            , H.div []
+                [ colorInput model (UpdateZoneString ZoneFill) "" z.fill
+                ]
+            ]
+        , H.span [ HA.class "inspector-column" ]
+            [ H.h5 [] [ H.text "Border ◻" ]
+            , H.div []
+                [ colorInput model (UpdateZoneString ZoneStroke) "" z.border.color
+                , H.div [ HA.class "inspector-row" ]
+                    [ fieldInput (UpdateZoneString ZoneWidth) "Width" z.border.width
+                    , fieldInput (UpdateZoneString ZoneDash) "Dash ⬚" z.border.dash
+                    ]
+                ]
+            ]
+
+        -- , H.div [ HA.class "inspector-column" ]
+        , H.div [ HA.classList [ ( "inspector-column", True ), ( "hidden", multi ) ] ]
+            [ rectInput (UpdateZoneRect z.id) z.rect
+            ]
+        , H.span [ HA.class "inspector-column" ]
+            [ H.h5 [] [ H.text "Grid" ]
+            , H.div [ HA.class "inspector-row" ]
+                [ fieldInputRange (UpdateZoneString ZoneColumns) (Just 0) (Just 32) "" z.grid.columns
+                , fieldInputRange (UpdateZoneString ZoneRows) (Just 0) (Just 32) "" z.grid.rows
+                ]
+            ]
+        ]
+
+
+cardInspector : Model -> Bool -> Card -> Html Msg
+cardInspector model multi _ =
+    inspectorColumn
+        []
+        [ spreadView model
+            |> maybeHtml multi
+        ]
+
+
+selectedViews : Model -> Html Msg
+selectedViews model =
+    let
+        (Shapes zones cards arrows stamps) =
+            model.project
+                |> mergeAll
+                |> List.filter (\( i, _ ) -> List.member i model.selected)
+                |> splitAll
+    in
+    [ zones |> List.head |> Maybe.map (zoneInspector model (1 < List.length zones)) |> Maybe.withDefault (H.text "")
+    , arrows |> List.head |> Maybe.map (arrowInspector model) |> Maybe.withDefault (H.text "")
+    , cards |> List.head |> Maybe.map (cardInspector model (1 < List.length cards)) |> Maybe.withDefault (H.text "")
+    , stamps |> List.head |> Maybe.map (stampInspector model) |> Maybe.withDefault (H.text "")
+    ]
+        |> H.div
+            [ HA.class "inspector-column"
+            ]
+
+
+fileViews : Model -> List (Html Msg)
+fileViews model =
+    if List.member model.fileState [ New, NewModified ] then
+        [ H.form
+            [ E.onSubmit ChangeFilename ]
+            [ H.input [ E.onInput TypeFilename, HA.value model.nameInput ] [] ]
+        , H.button [ E.onClick SaveProject ] [ H.text "save" ]
+        ]
+
+    else
+        [ enumOption
+            LoadProject
+            (\s -> s)
+            (\t -> t == model.name)
+            model.files
+        , case model.fileState of
+            Modified ->
+                H.button [ E.onClick SaveProject ] [ H.text "save" ]
+
+            _ ->
+                H.button [ E.onClick NewProject ] [ H.text "new" ]
+
+        -- TODO add rename option
+        , H.button [ E.onClick DuplicateProject ] [ H.text "clone" ]
+        ]
+
+
+selectedRectsView : Model -> Svg msg
+selectedRectsView model =
+    let
+        selected =
+            List.filterMap (getShapeById model.project) model.selected
+
+        selection =
+            case model.dragState of
+                Nothing ->
+                    []
+
+                Just { state, mode } ->
+                    if mode == Select || mode == CreateZone then
+                        let
+                            start =
+                                state.start
+
+                            end =
+                                state.start |> Vec.add state.offset
+                        in
+                        [ ( normalizeRect start end, Vec.vec2 0.5 0.5, 0 ) ]
+                        -- [ ( normalizeRect (snapPos model start) (snapPos model end), Vec.vec2 0.5 0.5, 0 ) ]
+
+                    else
+                        []
+
+        transforms =
+            List.map
+                (draggedTransform model)
+                selected
+                ++ selection
+    in
+    transforms
+        |> List.map
+            (\( rect, pivot, a ) ->
+                let
+                    pos =
+                        -- rect.pos
+                        case model.dragState of
+                            Nothing ->
+                                rect.pos
+
+                            Just { mode } ->
+                                if mode == Move then
+                                    snapPos model rect.pos
+
+                                else
+                                    rect.pos
+
+                    r =
+                        enlarge 15 { rect | pos = pos }
+                in
+                Svg.rect
+                    [ num Attr.width r.size.x
+                    , num Attr.height r.size.y
+                    , Attr.rx cornerRadius
+                    , Attr.transform <|
+                        pivotRotate pivot r.pos r.size a
+                            ++ translateXY r.pos
+                    , Attr.fill "none"
+                    , Attr.strokeDasharray ((String.fromFloat <| model.project.viewport.size.y / 100.0) ++ "px")
+                    , Attr.stroke "var(--fg)"
+                    , Attr.strokeWidth ((String.fromFloat <| model.project.viewport.size.y / 200.0) ++ "px")
+
+                    -- , Attr.fill <| model.palette.yellow ++ "55"
+                    ]
+                    []
+            )
+        |> Svg.g
+            [ style "pointer-events" "none"
+            , Attr.class "selection"
+            , removeOnExport
+            ]
+
+
+
+-- debugRect : Rect -> Svg Msg
+-- debugRect r =
+--     Svg.rect
+--         -- [ Attr.transform <| translate r.pos.x r.pos.y
+--         [ num Attr.x r.pos.x
+--         , num Attr.y r.pos.y
+--         , num Attr.width r.size.x
+--         , num Attr.height r.size.y
+--         , Attr.stroke "#f0f"
+--         , Attr.fill "transparent"
+--         , Attr.class "debugRect"
+--         , Attr.pointerEvents "none"
+--         ]
+--         []
+-- debugPoint : Vec2 -> Svg Msg
+-- debugPoint p =
+--     Svg.circle
+--         [ Attr.transform <| translate p.x p.y
+--         , num Attr.r 10.0
+--         , Attr.fill "#f0f"
+--         ]
+--         []
+-- debugCards : List Card -> Svg Msg
+-- debugCards cards =
+--     -- cardxs
+--     --     -- |> List.map (\c -> getShapeBounds  c |> debugRect)
+--     --     -- |> List.map (\c -> rect2 c.position cardSize |> toPoints |> List.map (Vec.rotateAround (pivotPos c) c.rotation >> debugPoint))
+--     --     -- |> List.concat
+--     --     |>
+--     Svg.g
+--         []
+--         []
+
+
+svgView : Model -> Html Msg
+svgView model =
+    Svg.svg
+        [ HA.attribute "tabindex" "0"
+        , Attr.id "view"
+        , onWheel (Mod << Project.Zoom)
+        , preventContextMenu
+        , dragEvent "background"
+        , onMouseUp EndDrag
+
+        -- , Draggable.customMouseTrigger "background" (positionDecoder "offset") CustomMouseDown
+        -- , onMouseUp StopDragging
+        -- , E.onDoubleClick SelectAll
+        -- , HA.attribute "data-view" <| Debug.toString model.project.viewport
+        -- , HA.attribute "data-mouse" <| Debug.toString model.mouse
+        , HA.attribute "data-project" <| Json.Encode.encode 0 <| serializeModel model
+        , Attr.viewBox <| rectString model.project.viewport
+
+        -- , if model.boxed then
+        --   else
+        -- Attr.visibility "visible"
+        , Attr.overflow "hidden"
+        ]
+        (List.append
+            includes
+            ([ ( False, H.text "" ) -- ( True, cardMasks model )
+             , ( True, arrowDefs )
+             , ( True, background model )
+             , ( True, clipPath model )
+             , ( True, zonesView model )
+             , maybeIncompleteZone model
+
+             -- , ( False, debugCards model.cards )
+             , ( True, cardsView model )
+             , ( True, arrowsView model )
+             , ( True, stampsView model )
+             , ( True, incompleteArrow model )
+
+             -- , ( False
+             --   , case model.dragState of
+             --        Just {state, _} ->
+             --            Svg.circle
+             --                [ Attr.transform <| translateXY
+             --                , Attr.r "10"
+             --                , Attr.fill "#f00"
+             --                , Attr.pointerEvents "none"
+             --                ]
+             --                [ Svg.text id
+             --                ]
+             --        _ ->
+             --            Svg.g [] []
+             --   )
+             , ( not model.boxed, viewportView model.project.viewport )
+             , ( True, selectedRectsView model )
+             ]
+                |> List.filter Tuple.first
+                |> List.map Tuple.second
+            )
+        )
+
+
+maybeIncompleteZone : Model -> ( Bool, Html Msg )
+maybeIncompleteZone model =
+    model.dragState
+        |> Maybe.andThen
+            (\{ state, mode } ->
+                if mode == CreateZone then
+                    let
+                        s =
+                            { start = state.start, end = Vec.add state.start state.offset }
+
+                        zonePreset =
+                            model.zonePreset
+
+                        r =
+                            normalizeRect (snapPos model s.start) (snapPos model s.end)
+
+                        newZone =
+                            { zonePreset
+                                | rect = r
+                                , id = "z" ++ String.fromInt model.id
+                            }
+                    in
+                    Just
+                        ( True
+                        , Tuple.second <| zoneView model False newZone
+                        )
+
+                else
+                    Nothing
+            )
+        |> Maybe.withDefault ( False, H.text "" )
+
+
+spreadView : Model -> Html Msg
+spreadView model =
+    H.span
+        [ HA.class "inspector-column" ]
+        [ -- H.button
+          --     [ E.onClick (SpreadCards "") ]
+          --     [ H.text "spread" ],
+          enumButtons
+            SpreadByType
+            spreadAsString
+            (\t -> t == model.spreadType)
+            [ ( Horizontal, "🠚" ), ( Vertical, "🠛" ), ( Diagonal, "➘" ), ( Rows, "⇉" ), ( Columns, "⇊" ), ( Stack, "🂠" ), ( Fan, "⌓" ) ]
+        , H.input
+            [ E.onInput SpreadByValue
+            , HA.type_ "number"
+            , HA.class "narrow"
+            , HA.value (String.fromInt model.spreadValue)
+            ]
+            []
+        , H.button
+            [ E.onClick (ModRandom (Project.Shuffle model.selected)) ]
+            [ H.text "shuffle" ]
+        ]
+
+
+paletteSettings : Model -> Html Msg
+paletteSettings model =
+    let
+        themes =
+            Theme.themes
+                |> List.map
+                    (\( name, p ) ->
+                        H.button
+                            [ E.onClick (UpdatePalette p)
+                            ]
+                            [ H.text name ]
+                    )
+
+        colors =
+            Palette.paletteAsList model.palette
+                |> List.map
+                    (\( color, value ) ->
+                        let
+                            name =
+                                Palette.colorAsString color
+                        in
+                        H.span
+                            [ HA.style "white-space" "nowrap" ]
+                            [ H.text <| String.toUpper name
+                            , H.input
+                                [ HA.type_ "color"
+                                , HA.value value
+                                , E.onInput <| UpdatePaletteColor color
+                                ]
+                                []
+                            ]
+                    )
+    in
+    H.span
+        []
+        [ H.div [] themes
+        , H.div [] [ H.span [] colors ]
+        ]
+
+
+panelView : Model -> Html Msg
+panelView m =
+    case m.panel of
+        Just p ->
+            H.div [ Attr.id "panel" ]
+                [ H.div [ Attr.id "panel-header" ]
+                    [ H.h3
+                        []
+                        [ H.text
+                            (case p of
+                                Help ->
+                                    "Help Desck"
+
+                                ExportSettings ->
+                                    "Export Project"
+
+                                Settings ->
+                                    "Settings"
+                            )
+                        ]
+                    , H.button
+                        [ Attr.id "panel-close"
+                        , E.onClick <| Toggle <| ShowPanel Nothing
+                        ]
+                        [ H.text "X" ]
+                    ]
+                , H.div [ Attr.id "panel-body" ] <|
+                    case p of
+                        Help ->
+                            Markdown.toHtml Nothing
+                                m.flags.help
+                                ++ [ H.div []
+                                        [ H.text "If you enjoy this tool, consider "
+                                        , H.a
+                                            [ HA.href "https://ko-fi.com/unlessgames" ]
+                                            [ H.text "donating♥" ]
+                                        ]
+                                   , H.div []
+                                        [ H.text "Check out the source on "
+                                        , H.a
+                                            [ HA.href "https://gitlab.com/unlessgames/desck" ]
+                                            [ H.text "gitlab" ]
+                                        ]
+                                   ]
+
+                        Settings ->
+                            [ H.h3 [] [ H.text "Fonts" ]
+                            , H.div [ Attr.class "panel-row" ]
+                                [ H.form
+                                    [ E.onSubmit (UpdateFont PrimaryFont) ]
+                                    [ H.input
+                                        [ E.onInput (TypeFont PrimaryFont)
+                                        , HA.value <| Maybe.withDefault "" m.settings.primaryFont
+                                        , HA.placeholder "primary font"
+                                        , HA.title "type the name of a custom font from Google Fonts (for example 'Roboto Condensed')"
+                                        ]
+                                        []
+                                    ]
+                                , H.form
+                                    [ E.onSubmit (UpdateFont SecondaryFont) ]
+                                    [ H.input
+                                        [ E.onInput (TypeFont SecondaryFont)
+                                        , HA.value <| Maybe.withDefault "" m.settings.secondaryFont
+                                        , HA.placeholder "secondary font"
+                                        , HA.title "type the name of a custom font from Google Fonts (for example 'Roboto Condensed')"
+                                        ]
+                                        []
+                                    ]
+                                ]
+                            , H.h3 [] [ H.text "Palette" ]
+                            , paletteSettings m
+
+                            -- TODO Editor - add automatic humanize on spawn and pick/drop
+                            -- TODO Editor - crop padding setting
+                            -- TODO Editor - contain or intersect selection mode
+                            , H.span []
+                                [ H.h3 [] [ H.text "Background" ]
+                                , colorPickerWithTransparent m.palette (Mod << Project.SetBackground) m.project.background
+                                ]
+                            ]
+
+                        ExportSettings ->
+                            -- TODO Editor - toggle background include
+                            -- TODO Editor - reset defaults
+                            let
+                                -- TODO GUI - better switches
+                                settingFlag sf st on off desc =
+                                    H.button
+                                        [ E.onClick <| Toggle (Setting sf)
+                                        , Attr.title desc
+                                        ]
+                                        [ H.text <|
+                                            if st then
+                                                on
+
+                                            else
+                                                off
+                                        ]
+                            in
+                            [ H.h3 [] [ H.text "Download" ]
+                            , H.div [ Attr.class "panel-row" ]
+                                [ H.button [ E.onClick <| Export SVG ] [ H.text "⤓ SVG" ]
+                                , H.button [ E.onClick <| Export PNG ] [ H.text "⤓ PNG" ]
+                                , H.button [ E.onClick <| Export JSON ] [ H.text "⤓ JSON" ]
+                                ]
+                            , H.h3 [] [ H.text "SVG Settings" ]
+                            , H.div [ Attr.class "panel-row" ]
+                                [ settingFlag
+                                    EmbedSymbols
+                                    m.settings.embedSymbols
+                                    "embed SVG symbols"
+                                    "strip SVG symbols"
+                                    "choose to embed or strip the symbols (like face cards, pips and digits) for the SVG output, when stripped multiple SVG can be embed on a page with a single symbol library at the top to save on bandwidth (you'll have to set up inlining all of the SVGs and the symbol library)"
+                                , H.button [ E.onClick <| Export Symbols ] [ H.text "⤓ Export SVG symbol library" ]
+                                    |> maybeHtml (not m.settings.embedSymbols)
+                                ]
+                            , settingFlag
+                                StripData
+                                m.settings.stripData
+                                "exclude project data"
+                                "include project data"
+                                "You may choose to strip the JSON formatted data that is inserted into the top of the SVG for desck to be able load the .svg file, if used in automated build, it is good to get rid of this to save some bandwidth"
+                            , settingFlag
+                                MapColors
+                                m.settings.mapColors
+                                "colors as values"
+                                "colors as references"
+                                "map the actual color values you selected in Desck to the SVG, when disabled, colors are kept as CSS variables like 'var(--red)' so that you can dynamically remap them later by swapping variable definitions on your page"
+                            , settingFlag
+                                MapFont
+                                m.settings.mapFont
+                                "fonts as values"
+                                "fonts as references"
+                                "map the actual font values you selected in Desck to the styles in the SVG, when disabled, fonts are kept as CSS variables like 'var(--desck-primary-font)' and 'var(--desck-secondary-font)' so that you can dynamically remap them later by including variable definitions on your page"
+                            , H.textarea
+                                [ E.onInput (Mod << Project.Describe)
+                                , HA.value m.project.description
+                                , HA.placeholder "🖹 describe the image"
+                                , HA.title "write a description that will be saved as the 'title' attribute for the SVG"
+                                ]
+                                []
+                            , H.h3 [] [ H.text "PNG Settings" ]
+                            , H.div [ Attr.class "panel-row" ]
+                                [ H.button [] [ H.text "height of cards" ]
+                                , H.input
+                                    [ HA.type_ "number"
+                                    , HA.min "10"
+                                    , HA.max "1000"
+                                    , HA.value <| String.fromInt m.settings.heightPixels
+                                    , E.onInput UpdateHeightPixels
+                                    , HA.class "narrow"
+                                    , HA.id "heightPixels"
+                                    , HA.title "set the height of cards in pixels in the exported PNG image"
+                                    ]
+                                    []
+                                ]
+                            ]
+                ]
+
+        Nothing ->
+            H.text ""
+
+
+panelToggle : Panel -> String -> Html Msg
+panelToggle msg s =
+    H.button
+        [ E.onClick <| Toggle <| ShowPanel <| Just msg
+        , Attr.class "panel-toggle"
+        ]
+        [ H.text s
+        ]
+
+
+headerView : Model -> Html Msg
+headerView model =
+    List.concat
+        [ fileViews model
+        , [ H.button [ E.onClick UploadFile ] [ H.text "load" ]
+          , H.button [ E.onClick <| Toggle <| Boxed ] [ H.text "▭" ]
+          , rectInput (\c i -> Mod <| Project.UpdateViewport c i) model.project.viewport
+          , H.button [ E.onClick (Mod <| Project.Crop model.selected) ] [ H.text "crop" ]
+          , H.button [ E.onClick <| Toggle BringForward ]
+                [ H.text <|
+                    if model.moveToTop then
+                        "move to top"
+
+                    else
+                        "keep order"
+                ]
+          , H.button [ E.onClick <| Toggle StackSelect ]
+                [ H.text <|
+                    if model.stackSelect then
+                        "stack select"
+
+                    else
+                        "single select"
+                ]
+          ]
+        ]
+        |> H.div
+            [ Attr.id "header"
+            ]
+
+
+inspectorColumn : List (H.Attribute msg) -> List (Html msg) -> Html msg
+inspectorColumn attrs ls =
+    H.div
+        (HA.class "inspector-column"
+            :: attrs
+        )
+        ls
+
+
+inspectorRow : List (Html msg) -> Html msg
+inspectorRow ls =
+    H.div
+        [ HA.class "inspector-row"
+        ]
+        ls
+
+
+inspectorView : Model -> Html Msg
+inspectorView model =
+    let
+        layerToggle layer icon ls field =
+            inspectorColumn
+                [ HA.classList
+                    [ ( "inactive", not (field model.unlockedLayers) )
+                    ]
+                ]
+                [ H.button
+                    [ E.onClick (ToggleLaterMask layer)
+                    , HA.title <| layerString layer
+                    ]
+                    [ H.text icon ]
+                , inspectorRow [ H.text <| String.fromInt <| List.length ls ]
+                ]
+    in
+    [ H.text ""
+    , H.div []
+        [ inspectorRow
+            [ layerToggle Zones "⌧" model.project.zones .zones
+            , layerToggle Cards "🂠" model.project.cards .cards
+            , layerToggle Arrows "↣" model.project.arrows .arrows
+            , layerToggle Stamps "✪" model.project.stamps .stamps
+            ]
+        , inspectorRow
+            [ H.button
+                [ E.onClick <|
+                    ModRandom <|
+                        Project.Humanize model.selected
+                ]
+                [ H.text <|
+                    "humanize"
+                        ++ (if List.isEmpty model.selected then
+                                " all"
+
+                            else
+                                " selected"
+                           )
+                ]
+            ]
+
+        -- enumButtons
+        --     ToggleLaterMask
+        --     layerString
+        --     (\t -> t == )
+        --, ( Colors, "◍" ) ]
+        ]
+    , H.div
+        []
+        [-- , H.span
+         --     []
+         --     [ H.button [ E.onClick (Mod <| Project.Order Project.MoveUp model.selected) ] [ H.text "⯅" ]
+         --     , H.button [ E.onClick (Mod <| Project.Order Project.MoveDown model.selected) ] [ H.text "⯆" ]
+         --     -- , H.input [ E.onInput RotateSelected, HA.type_ "number", HA.class "narrow" ] []
+         --     ]
+         -- |> maybeHtml (1 == List.length model.selected && model.tool == Cards)
+        ]
+        |> maybeHtml (0 < List.length model.selected)
+
+    -- , H.span []
+    --     [ H.text "snap"
+    --     , H.input
+    --         [ HA.type_ "number"
+    --         , HA.value <| String.fromInt model.snap
+    --         , HA.class "narrow"
+    --         , HA.min "0"
+    --         , HA.max "8"
+    --         , E.onInput UpdateSnap
+    --         ]
+    --         []
+    --     ]
+    -- , H.text (status model)
+    , selectedViews
+        model
+    ]
+        |> H.div
+            [ HA.id "inspector"
+            ]
+
+
+footerView : Model -> Html Msg
+footerView model =
+    H.div
+        [ HA.id "footer" ]
+        [ H.div []
+            [ H.button
+                [ E.onClick Remove
+                , HA.style "color" "var(--red)"
+                , HA.classList
+                    [ ( "inactive", List.isEmpty model.selected )
+                    ]
+                ]
+                [ H.text "remove" ]
+            , H.button
+                [ E.onClick Undo
+                , HA.classList
+                    [ ( "inactive"
+                      , 0 == List.length model.undos
+                      )
+                    ]
+                , HA.title "Undo"
+                ]
+                [ H.text "↺"
+                ]
+
+            -- [ H.text <| "undo [" ++ (String.fromInt <| List.length model.undos) ++ "]"
+            ]
+        , H.form
+            [ E.onSubmit Spawn ]
+            [ H.input
+                [ E.onInput TypeCommand
+                , HA.value model.command
+                , HA.title "spawn cards with codes like 'ac 9d k'"
+                , HA.placeholder "spawn cards like '6c ad qh'"
+                ]
+                []
+            ]
+        , H.form
+            [ E.onSubmit SpawnStamp ]
+            [ H.input
+                [ E.onInput TypeStamp
+                , HA.value model.stampInput
+                , HA.title "spawn a stamps with characters like '◬ '"
+                , HA.placeholder "spawn stamps with characters like '◬ '"
+                ]
+                []
+            ]
+        , H.form
+            [ E.onSubmit ApplySelector ]
+            [ H.input
+                [ E.onInput TypeSelector
+                , HA.value model.selectedCardModels
+                , HA.title "modify cards by changing their codes"
+                , HA.placeholder "select some cards to edit..."
+                ]
+                []
+            ]
+        , H.div []
+            [ panelToggle Help "? Help"
+            , panelToggle Settings "◍ Settings"
+            , panelToggle ExportSettings "⤓ Download"
+            , H.a [ HA.href "https://ko-fi.com/unlessgames" ] [ H.button [ HA.id "support-button" ] [ H.text "♥" ] ]
+            ]
+        ]
+
+
+view : Model -> Html Msg
+view model =
+    H.div
+        [ Attr.id "main"
+        ]
+        [ headerView model
+        , inspectorView model
+        , svgView model
+        , panelView model
+        , footerView model
+        ]
+
+
+viewportAttr : Model -> Svg.Attribute Msg
+viewportAttr m =
+    if m.boxed then
+        Attr.clipPath (url <| viewportId m)
+
+    else
+        Attr.visibility "visible"
+
+
+cull : Project -> (a -> Shape) -> a -> Bool
+cull p toShape s =
+    s
+        |> toShape
+        |> shapeRect p
+        |> overlaps (enlarge cardSize.x p.viewport)
+
+
+
+-- TODO Card - different backs, choose red or blue for each card?
+
+
+cardsView : Model -> Svg Msg
+cardsView model =
+    model.project.cards
+        |> List.filter
+            (cull model.project Project.Card)
+        |> List.sortBy .z
+        |> List.map (cardView model)
+        |> Svg.Keyed.node "g" [ viewportAttr model ]
+
+
+arrowDefs : Svg msg
+arrowDefs =
+    let
+        w =
+            3.0
+
+        h =
+            1.5
+
+        w2 =
+            w / 2.0
+    in
+    Svg.defs []
+        [ Svg.marker
+            [ Attr.id "arrow"
+            , num Attr.markerWidth h
+            , num Attr.markerHeight w
+            , num Attr.refX (h * 0.5)
+            , num Attr.refY w2
+            , Attr.orient "auto"
+            , Attr.markerUnits "strokeWidth"
+            , Attr.fill "context-stroke"
+            ]
+            [ Svg.polygon
+                [ Attr.fill "context-stroke"
+                , Attr.points <| "0,0 0," ++ String.fromFloat w ++ " " ++ String.fromFloat h ++ "," ++ String.fromFloat w2
+                ]
+                []
+            ]
+
+        -- , Svg.filter
+        --     [ Attr.id "shadow" ]
+        --     [ Svg.node "feDropShadow"
+        --         [ Attr.dx "4px"
+        --         , Attr.dy "4px"
+        --         , Attr.floodColor "black"
+        --         , Attr.stdDeviation "4"
+        --         ]
+        --         []
+        --     ]
+        ]
+
+
+dragEvent : Id -> Svg.Attribute Msg
+dragEvent id =
+    Draggable.customMouseTrigger id (positionDecoder "offset") (StartDragWithPos id)
+
+
+
+-- TODO customize arrow cap or distance?
+-- TODO respond to pivot and angle
+
+
+arcPath : Float -> ( Vec2, Vec2 ) -> String
+arcPath f ( a, b ) =
+    let
+        p v =
+            String.fromFloat v.x ++ " " ++ String.fromFloat v.y
+
+        m =
+            Vec.sub b a
+                |> Vec.scale 0.5
+
+        c =
+            Vec.vec2 0.0 f
+                |> Vec.rotate pi
+    in
+    "M " ++ p a ++ " Q " ++ p c ++ " " ++ p b
+
+
+arrowView : Model -> ( Vec2, Vec2 ) -> Arrow -> ( String, Svg Msg )
+arrowView model ( from, to ) a =
+    let
+        ( rect, pivot, angle ) =
+            arrowTransform a ( from, to )
+
+        c =
+            center rect
+
+        dir =
+            Vec.sub from to
+
+        l =
+            Vec.length dir
+                * 0.4
+    in
+    ( a.id
+    , Svg.g
+        [ Attr.transform <|
+            pivotRotate (Vec.vec2 0.5 0.5) rect.pos rect.size angle
+                ++ translateXY c
+        ]
+        [ Svg.line
+            ([ num Attr.x1 <| l
+             , num Attr.y1 0.0
+             , num Attr.x2 <| -l
+             , num Attr.y2 0.0
+             , num Attr.strokeWidth a.width
+             , Attr.fill <| getColor model a.fill
+             , Attr.stroke <| getColor model a.fill
+             , Attr.strokeLinecap "butt"
+             , preventContextMenu
+             , dragEvent a.id
+
+             -- , num Attr.opacity 0.0
+             -- , E.onDoubleClick (Mod (Project.Remove model.selected))
+             ]
+                ++ (case a.head of
+                        Triangle ->
+                            [ Attr.markerEnd (url "arrow") ]
+
+                        -- TODO Arrow - cross head!
+                        _ ->
+                            []
+                   )
+            )
+            []
+
+        -- TODO Arrow - curved path
+        -- , Svg.path
+        --     [ Attr.d <| arcPath 100.0 ( Vec.vec2 l 0.0, Vec.vec2 -l 0.0 )
+        --     , num Attr.strokeWidth a.width
+        --     , Attr.fill <| "transparent"
+        --     , Attr.stroke <| getColor model a.fill
+        --     , Attr.strokeLinecap "butt"
+        --     , Attr.markerEnd (url "arrow")
+        --     ]
+        --     []
+        , Svg.text_
+            [ HA.style "font-size" "32px"
+            , Attr.fill "magenta"
+            ]
+            [ Svg.text <| a.id ]
+            |> maybeHtml model.debug
+        ]
+    )
+
+
+arrowsView : Model -> Svg Msg
+arrowsView model =
+    model.project.arrows
+        |> List.filter
+            (cull model.project Project.Arrow)
+        |> List.map
+            (\a ->
+                let
+                    points =
+                        case ( getShapeById model.project a.from, getShapeById model.project a.to ) of
+                            ( Just from, Just to ) ->
+                                arrowPoints ( draggedTransform model from, draggedTransform model to )
+
+                            _ ->
+                                ( Vec.zero, Vec.zero )
+                in
+                arrowView model points a
+            )
+        |> Svg.Keyed.node "g" [ viewportAttr model, Attr.id "arrows" ]
+
+
+stampView : Model -> Stamp -> ( String, Svg Msg )
+stampView m s =
+    let
+        ( rect, _, _ ) =
+            draggedTransform m (Project.Stamp s)
+    in
+    ( s.id
+    , Svg.g
+        [ Attr.transform <| translate (rect.pos.x + s.radius) (rect.pos.y + s.radius)
+        , preventContextMenu
+        , dragEvent s.id
+        , onMouseUp EndDrag
+        ]
+        [ Svg.circle
+            [ Attr.r (String.fromFloat s.radius ++ "px")
+            , Attr.fill <| getColor m s.fill
+            ]
+            []
+        , Svg.text_
+            [ Attr.fill <| getColor m s.text.color
+            , Attr.fontSize <| String.fromInt s.text.size ++ "px"
+            , Attr.textAnchor "middle"
+            , Attr.dominantBaseline
+                (if (s.text.label |> String.toList |> List.foldl (\c b -> b && Char.isAlphaNum c) True) && String.toLower s.text.label == s.text.label then
+                    "middle"
+
+                 else
+                    "central"
+                )
+            ]
+            [ Svg.text s.text.label ]
+        ]
+    )
+
+
+stampsView : Model -> Svg Msg
+stampsView model =
+    model.project.stamps
+        |> List.filter
+            (cull model.project Project.Stamp)
+        |> List.map
+            (\s ->
+                stampView model s
+            )
+        |> Svg.Keyed.node "g" [ viewportAttr model, Attr.id "stamps" ]
+
+
+incompleteArrow : Model -> Svg Msg
+incompleteArrow model =
+    case model.dragState of
+        Nothing ->
+            Svg.g [] []
+
+        Just { state, mode } ->
+            case state.shape of
+                Nothing ->
+                    Svg.g [] []
+
+                Just shape ->
+                    case mode of
+                        Connect ->
+                            let
+                                pos =
+                                    state.start |> Vec.add state.offset
+                            in
+                            let
+                                ( rect, _, _ ) =
+                                    shapeTransform model.project shape
+                            in
+                            if Rect.hasPoint pos <| rect then
+                                Svg.g [] []
+
+                            else
+                                let
+                                    points =
+                                        arrowPointsToPos model.project shape pos
+                                in
+                                Svg.Keyed.node "g"
+                                    [ viewportAttr model
+                                    , Attr.pointerEvents "none"
+                                    ]
+                                    [ arrowView model points (makeArrow model.arrowPreset (shapeId shape) "" "") ]
+
+                        _ ->
+                            Svg.g [] []
+
+
+getColor : Model -> Color -> String
+getColor m c =
+    case c of
+        Transparent ->
+            "transparent"
+
+        _ ->
+            "var(--" ++ colorAsString c ++ ")"
+
+
+
+-- Palette.getColor m.palette c
+
+
+customFont : Bool -> H.Attribute msg
+customFont primary =
+    HA.style "font-family" <|
+        "var(--desck-"
+            ++ (if primary then
+                    "primary"
+
+                else
+                    "secondary"
+               )
+            ++ "-font)"
+
+
+zoneView : Model -> Bool -> Zone -> ( String, Html Msg )
+zoneView model active z =
+    let
+        ( r, pivot, angle ) =
+            draggedTransform model (Project.Zone z)
+
+        border =
+            Vec.scale (toFloat <| z.border.width // 2) Vec.one
+
+        rect =
+            { r | pos = Vec.sub r.pos border, size = Vec.add r.size (Vec.scale 2.0 border) }
+
+        -- TODO make label pos dependent on border width
+        textRectSize =
+            rect.size
+
+        ( textPos, ( textAnchor, dominantBaseline ), lineOffset ) =
+            textAttributes textRectSize z.text
+
+        lines =
+            String.split "\n" z.text.label
+
+        svgLines attrs =
+            attrs
+                |> List.map
+                    (\atts ->
+                        Svg.line
+                            (List.append atts
+                                [ Attr.stroke <| getColor model z.border.color
+                                , Attr.strokeWidth <| String.fromInt z.border.width
+                                , Attr.strokeDasharray <| String.fromInt z.border.dash
+                                ]
+                            )
+                            []
+                    )
+
+        horizontalLines w =
+            if w > 1 then
+                List.range 1 (w - 1)
+                    |> List.map
+                        (\x ->
+                            let
+                                cw =
+                                    rect.size.x / toFloat w
+
+                                px =
+                                    toFloat x * cw
+                            in
+                            [ num Attr.x1 <| px
+                            , num Attr.y1 <| 0
+                            , num Attr.x2 <| px
+                            , num Attr.y2 <| rect.size.y
+                            ]
+                        )
+                    |> svgLines
+
+            else
+                []
+
+        verticalLines h =
+            if h > 1 then
+                List.range 1 (h - 1)
+                    |> List.map
+                        (\y ->
+                            let
+                                cw =
+                                    rect.size.y / toFloat h
+
+                                py =
+                                    toFloat y * cw
+                            in
+                            [ num Attr.x1 <| 0
+                            , num Attr.y1 <| py
+                            , num Attr.x2 <| rect.size.x
+                            , num Attr.y2 <| py
+                            ]
+                        )
+                    |> svgLines
+
+            else
+                []
+    in
+    ( z.id
+    , Svg.g
+        (List.concat
+            [ [ Attr.transform <|
+                    pivotRotate pivot rect.pos rect.size angle
+                        ++ translateXY rect.pos
+              ]
+            , if active then
+                [ preventContextMenu
+                , dragEvent z.id
+                , onMouseUp EndDrag
+
+                -- , E.onDoubleClick (Mod (Project.Remove model.selected))
+                ]
+
+              else
+                [ Attr.pointerEvents "none" ]
+            ]
+        )
+      <|
+        List.concat
+            [ [ Svg.rect
+                    [ num Attr.width rect.size.x
+                    , num Attr.height rect.size.y
+                    , Attr.rx cornerRadius
+                    , Attr.class "zone"
+                    , Attr.fill <| getColor model z.fill
+                    , Attr.stroke <| getColor model z.border.color
+                    , Attr.strokeWidth <| String.fromInt z.border.width
+                    , Attr.strokeDasharray <| String.fromInt z.border.dash
+                    ]
+                    []
+              ]
+            , List.append
+                (if z.grid.columns > 1 then
+                    horizontalLines z.grid.columns
+
+                 else
+                    []
+                )
+                (if z.grid.rows > 1 then
+                    verticalLines z.grid.rows
+
+                 else
+                    []
+                )
+            , [ Svg.text_
+                    [ Attr.class "zone-label"
+                    , Attr.pointerEvents "none"
+                    , Attr.fontSize <| String.fromInt z.text.size
+                    , customFont z.text.primary
+                    , Attr.fill <| getColor model z.text.color
+                    , num Attr.x textPos.x
+                    , num Attr.y textPos.y
+                    , Attr.textAnchor textAnchor
+                    , Attr.dominantBaseline dominantBaseline
+                    ]
+                    (lines
+                        |> List.indexedMap
+                            (\i t ->
+                                Svg.tspan
+                                    [ Attr.dy <| lineOffset i t
+                                    , num Attr.x textPos.x
+                                    , customFont z.text.primary
+                                    ]
+                                    [ Svg.text <|
+                                        if t == "" then
+                                            " "
+
+                                        else
+                                            t
+                                    ]
+                            )
+                    )
+              , Svg.text_ [ HA.style "font-size" "32px", Attr.fill "magenta" ] [ Svg.text <| z.id ]
+                    |> maybeHtml model.debug
+              ]
+            ]
+    )
+
+
+zonesView : Model -> Svg Msg
+zonesView model =
+    model.project.zones
+        |> List.filter
+            (cull model.project Project.Zone)
+        |> List.map (zoneView model model.unlockedLayers.zones)
+        |> Svg.Keyed.node "g" [ viewportAttr model ]
+
+
+inactiveFilter : String
+inactiveFilter =
+    "filter: brightness(50%)"
+
+
+draggedLeaderTransform : Model -> Shape -> ( Rect, Vec2, Float )
+draggedLeaderTransform m s =
+    let
+        trans =
+            shapeTransform m.project s
+
+        ( rect, pivot, angle ) =
+            trans
+    in
+    case m.dragState of
+        Nothing ->
+            trans
+
+        Just { state, mode } ->
+            case mode of
+                Move ->
+                    ( { rect
+                        | pos =
+                            Vec.add rect.pos state.offset
+                                |> snapPos m
+                      }
+                    , pivot
+                    , angle
+                    )
+
+                Turn ->
+                    ( rect, pivot, angle + state.offset.x )
+
+                _ ->
+                    trans
+
+
+
+-- shapeOffset : Model -> Shape -> Shape -> (Rect, Vec2, Float)
+-- shapeOffset m from to =
+--     let
+--         (frect, )
+
+
+draggedFollowerTransform : Model -> Drag -> Shape -> Shape -> ( Rect, Vec2, Float )
+draggedFollowerTransform m drag leader follower =
+    let
+        ( lrect, _, _ ) =
+            shapeTransform m.project leader
+
+        ( ldrect, _, _ ) =
+            draggedLeaderTransform m leader
+
+        offset =
+            Vec.sub rect.pos lrect.pos
+
+        trans =
+            shapeTransform m.project follower
+
+        ( rect, pivot, angle ) =
+            trans
+    in
+    case drag.mode of
+        Move ->
+            ( { rect | pos = Vec.add ldrect.pos offset }, pivot, angle )
+
+        Turn ->
+            ( rect, pivot, angle + drag.state.offset.x )
+
+        _ ->
+            trans
+
+
+draggedTransform : Model -> Shape -> ( Rect, Vec2, Float )
+draggedTransform m s =
+    let
+        affected =
+            case s of
+                Project.Arrow a ->
+                    List.member a.id m.selected
+                        || List.member a.from m.selected
+                        || List.member a.to m.selected
+
+                _ ->
+                    List.member (shapeId s) m.selected
+
+        trans =
+            shapeTransform m.project s
+
+        ( rect, pivot, angle ) =
+            trans
+    in
+    if not affected then
+        trans
+
+    else
+        case m.dragState of
+            Nothing ->
+                trans
+
+            Just { state, mode } ->
+                case mode of
+                    Move ->
+                        case state.shape of
+                            Just l ->
+                                if shapeId l == shapeId s then
+                                    draggedLeaderTransform m s
+
+                                else
+                                    draggedFollowerTransform m { state = state, mode = mode } l s
+
+                            Nothing ->
+                                ( { rect | pos = Vec.add rect.pos state.offset }, pivot, angle )
+
+                    Turn ->
+                        ( rect, pivot, angle + state.offset.x )
+
+                    _ ->
+                        trans
+
+
+cardView : Model -> Card -> ( String, Svg Msg )
+cardView m card =
+    let
+        { model, front, id, highlight } =
+            card
+
+        ( rect, pivot, angle ) =
+            draggedTransform m (Project.Card card)
+    in
+    ( id
+    , Svg.g
+        [ preventContextMenu
+        , dragEvent id
+        , onMouseUp EndDrag
+
+        -- TODO card shadow settings
+        -- , Attr.filter "url(#shadow)"
+        -- , E.onDoubleClick (Mod (Project.Remove m.selected))
+        , Attr.class "card"
+        , Attr.class
+            (if not card.highlight then
+                "card-disabled"
+
+             else
+                ""
+            )
+        , HA.attribute "data-using" (encode 0 (list string (modelUsing model)))
+        , Attr.style
+            (if highlight then
+                ""
+
+             else
+                inactiveFilter
+            )
+        , Attr.transform <|
+            pivotRotate pivot rect.pos rect.size angle
+                ++ translateXY rect.pos
+        ]
+      <|
+        List.concat
+            [ if front then
+                frontface rect.size.x rect.size.y model
+
+              else
+                backface rect.size.x rect.size.y model
+            , [ Svg.text_ [ HA.style "font-size" "32px", Attr.fill "magenta" ] [ Svg.text <| card.id ]
+                    |> maybeHtml m.debug
+              ]
+            ]
+    )
+
+
+preventContextMenu : Svg.Attribute Msg
+preventContextMenu =
+    Svg.Events.preventDefaultOn "contextmenu" (Decode.succeed ( Noop "", True ))
+
+
+removeOnExport : Svg.Attribute msg
+removeOnExport =
+    Attr.class "remove-on-export"
+
+
+background : Model -> Svg Msg
+background model =
+    let
+        id =
+            "background"
+    in
+    Svg.g
+        [ Attr.class
+            (if model.project.background == Transparent then
+                "remove-on-export"
+
+             else
+                ""
+            )
+        ]
+        [ Svg.rect
+            [ Attr.id id
+            , Attr.strokeWidth (String.fromFloat <| model.project.viewport.size.x * 0.005)
+            , num Attr.x model.project.viewport.pos.x
+            , num Attr.y model.project.viewport.pos.y
+            , num Attr.width model.project.viewport.size.x
+            , num Attr.height model.project.viewport.size.y
+            , Attr.fill <| getColor model model.project.background
+            , viewportAttr model
+            ]
+            []
+        , Svg.rect
+            [ Attr.strokeWidth (String.fromFloat <| model.project.viewport.size.x * 0.005)
+            , num Attr.x model.project.viewport.pos.x
+            , num Attr.y model.project.viewport.pos.y
+            , num Attr.width model.project.viewport.size.x
+            , num Attr.height model.project.viewport.size.y
+            , Attr.fill "none"
+            , Attr.stroke "#777"
+            , removeOnExport
+            , viewportAttr model
+            ]
+            []
+        ]