desck 0.4.2

package/src/Project.elm

@@ -0,0 +1,1029 @@
+module Project exposing (..)
+
+import Card exposing (Card, defaultCard)
+import Deck exposing (modelAsShort, rankAsChar)
+import DeckView exposing (cardSize)
+import Html.Attributes exposing (maxlength)
+import Layout exposing (Spread, spreadTransforms)
+import Palette exposing (Color(..), colorFromString)
+import Random exposing (initialSeed)
+import Rect exposing (Rect, RectCoordinate, center, enlarge, fromPoints, includeRect, modifyRect, normalizeRect, rect2, toPoints)
+import Util exposing (Id, mapNothing, moveTowardsLast, randf, randomFloat, randomOffset, shuffleList)
+import Vec exposing (Vec2)
+import Zone exposing (Arrow, Stamp, Zone)
+
+
+type Zorder
+    = MoveUp
+    | MoveDown
+    | MoveTop
+
+
+type alias Rotation =
+    { angle : Float, pivot : Vec2 }
+
+
+type alias Project =
+    { description : String
+    , background : Color
+    , viewport : Rect
+    , cards : List Card
+    , zones : List Zone
+    , arrows : List Arrow
+    , stamps : List Stamp
+    }
+
+
+type alias Selection =
+    List Id
+
+
+type Msg
+    = Zoom Float
+    | Pan Vec2
+    | Spawn (List Shape)
+    | Move Vec2 Selection
+    | Turn Float Selection
+    | Remove Selection
+    | Crop Selection
+    | Order Zorder Selection
+    | Shuffle Selection
+    | Humanize Selection
+    | UpdateViewport RectCoordinate String
+    | UpdateZone Id (Zone -> Zone)
+    | UpdateShapes Selection (Shape -> Shape)
+    | Describe String
+    | SetBackground String
+
+
+selectWithCovering : Project -> Id -> List Id
+selectWithCovering p id =
+    let
+        all =
+            mergeAll p
+
+        selected =
+            case all |> List.filter (\( i, _ ) -> i == id) |> List.head of
+                Just ( _, shape ) ->
+                    case shape of
+                        Card card ->
+                            List.foldl
+                                (\( i, s ) ls ->
+                                    let
+                                        overlaps =
+                                            case s of
+                                                Card c ->
+                                                    (c.z
+                                                        >= card.z
+                                                    )
+                                                        && List.any (\( _, prev ) -> Rect.overlaps c.rect (shapeRect p prev)) ls
+
+                                                _ ->
+                                                    False
+                                    in
+                                    if overlaps then
+                                        ( i, s ) :: ls
+
+                                    else
+                                        ls
+                                )
+                                [ ( id, shape ) ]
+                                all
+
+                        Zone zone ->
+                            [ ( id, shape ) ]
+
+                        _ ->
+                            [ ( id, shape ) ]
+
+                Nothing ->
+                    []
+    in
+    selected |> List.map Tuple.first
+
+
+filterBySelection : Selection -> List { a | id : Id } -> List { a | id : Id }
+filterBySelection sel ls =
+    ls
+        |> List.filter (\x -> not <| List.member x.id sel)
+
+
+allIds : Project -> List Id
+allIds self =
+    mergeAll self |> List.map Tuple.first
+
+
+transformShape : Shape -> Transform -> Shape
+transformShape s ( rect, pivot, angle ) =
+    case s of
+        Card c ->
+            Card { c | rect = rect, rot = { pivot = pivot, angle = angle } }
+
+        Zone z ->
+            Zone { z | rect = rect, rot = { pivot = pivot, angle = angle } }
+
+        Stamp t ->
+            Stamp { t | pos = rect.pos }
+
+        Arrow _ ->
+            s
+
+
+update : Msg -> Project -> Project
+update =
+    updateWithSeed 0
+
+
+updateWithSeed : Int -> Msg -> Project -> Project
+updateWithSeed seed msg self =
+    case msg of
+        SetBackground s ->
+            { self | background = colorFromString s }
+
+        Describe desc ->
+            { self | description = desc }
+
+        UpdateZone id fn ->
+            { self
+                | zones =
+                    self.zones
+                        |> List.map
+                            (\z ->
+                                if z.id == id then
+                                    fn z
+
+                                else
+                                    z
+                            )
+            }
+
+        UpdateShapes sel fn ->
+            self
+                |> mutateItems
+                    (\( id, shape ) ->
+                        if List.member id sel then
+                            ( id, fn shape )
+
+                        else
+                            ( id, shape )
+                    )
+
+        -- { self
+        --     | cards =
+        --         self.cards
+        --             |> List.map
+        --                 (\c ->
+        --                     if c.id == id then
+        --                         fn c
+        --                     else
+        --                         c
+        --                 )
+        -- }
+        UpdateViewport coord value ->
+            { self | viewport = modifyRect self.viewport { pos = cardSize, size = cardSize } coord (String.toFloat value |> Maybe.withDefault 0.0) }
+
+        Zoom z ->
+            let
+                -- TODO Editor - zoom to cursor
+                ( viewport, _ ) =
+                    zoomViewport self.viewport z Vec.zero
+            in
+            { self | viewport = viewport }
+
+        Pan delta ->
+            let
+                viewport =
+                    self.viewport
+            in
+            { self | viewport = { viewport | pos = Vec.sub viewport.pos delta } }
+
+        Spawn shapes ->
+            let
+                (Shapes zones unorderedCards arrows stamps) =
+                    shapes
+                        |> List.map (\s -> ( shapeId s, s ))
+                        |> splitAll
+
+                maxZ =
+                    self.cards |> List.map .z |> List.foldl max 0
+
+                -- FIX Editor - order zones, stamps by area
+                cards =
+                    unorderedCards |> List.indexedMap (\i c -> { c | z = maxZ + i + 1 })
+            in
+            { self
+                | cards = self.cards ++ cards
+                , zones = self.zones ++ zones
+                , arrows = self.arrows ++ arrows
+                , stamps = self.stamps ++ stamps
+            }
+
+        Remove selection ->
+            { self
+                | cards = filterBySelection selection self.cards
+                , zones = filterBySelection selection self.zones
+                , arrows = filterBySelection selection self.arrows
+                , stamps = filterBySelection selection self.stamps
+            }
+                |> validateArrows
+
+        Turn offset selected ->
+            self
+                |> mutateItems
+                    (\( id, s ) ->
+                        if List.member id selected then
+                            let
+                                ( _, _, angle ) =
+                                    shapeTransform self s
+                            in
+                            case s of
+                                Card c ->
+                                    ( id
+                                    , Card
+                                        { c
+                                            | rot = { angle = angle + offset, pivot = c.rot.pivot }
+                                        }
+                                    )
+
+                                Zone c ->
+                                    ( id
+                                    , Zone
+                                        { c
+                                            | rot = { angle = angle + offset, pivot = c.rot.pivot }
+                                        }
+                                    )
+
+                                -- Zone z ->
+                                --     let
+                                --         r =
+                                --             z.rect
+                                --     in
+                                --     ( id
+                                --     , Zone
+                                --         { z
+                                --             | rect =
+                                --                 { r
+                                --                     | pos =
+                                --                         snapPos model <| shapePos model (Zone z)
+                                --                 }
+                                --             -- , angle = snapAngle model <| c.angle + model.mouseDelta.x
+                                --         }
+                                --     )
+                                _ ->
+                                    ( id, s )
+
+                        else
+                            ( id, s )
+                    )
+
+        Move offset selected ->
+            self
+                |> mutateItems
+                    (\( id, s ) ->
+                        if List.member id selected then
+                            let
+                                ( r, _, _ ) =
+                                    shapeTransform self s
+                            in
+                            case s of
+                                Card c ->
+                                    ( id
+                                    , Card
+                                        { c
+                                            | rect = { r | pos = Vec.add r.pos offset }
+                                        }
+                                    )
+
+                                Zone z ->
+                                    ( id
+                                    , Zone
+                                        { z
+                                            | rect =
+                                                { r
+                                                    | pos = Vec.add r.pos offset
+                                                }
+                                        }
+                                    )
+
+                                Stamp t ->
+                                    ( id
+                                    , Stamp
+                                        { t
+                                            | pos = Vec.add t.pos offset
+                                        }
+                                    )
+
+                                _ ->
+                                    ( id, s )
+
+                        else
+                            ( id, s )
+                    )
+
+        Crop sel ->
+            let
+                ids =
+                    if List.isEmpty sel then
+                        allIds self
+
+                    else
+                        sel
+            in
+            { self | viewport = cropShapes ids self }
+
+        Order d sel ->
+            let
+                ( selected, rest ) =
+                    self.cards |> List.partition (\c -> List.member c.id sel)
+            in
+            case List.head selected of
+                Nothing ->
+                    self
+
+                Just _ ->
+                    let
+                        highestInRest =
+                            rest
+                                |> List.sortBy .z
+                                |> List.map .z
+                                |> List.reverse
+                                |> List.head
+                                |> Maybe.withDefault 0
+
+                        moved =
+                            selected
+                                |> List.map
+                                    (\c ->
+                                        if c.z <= highestInRest then
+                                            { c | z = c.z + (highestInRest - c.z) + 1 }
+
+                                        else
+                                            { c | z = c.z }
+                                    )
+
+                        cards =
+                            [ rest, moved ]
+                                |> List.concat
+                                |> List.sortBy .z
+                                |> List.indexedMap (\i c -> { c | z = i })
+                    in
+                    case d of
+                        MoveTop ->
+                            { self | cards = cards }
+
+                        _ ->
+                            self
+
+        -- case sel of
+        --     [ id ] ->
+        --         let
+        --             withId =
+        --                 \c -> c.id == id
+        --             cs =
+        --                 case d of
+        --                     MoveDown ->
+        --                         moveTowardsLast withId self.cards
+        --                     MoveUp ->
+        --                         List.reverse self.cards
+        --                             |> moveTowardsLast withId
+        --                             |> List.reverse
+        --                     MoveTop ->
+        --                         let
+        --         in
+        --         { self | cards = cs }
+        --     _ ->
+        --         self
+        Shuffle sel ->
+            let
+                partitionCards : List Card -> ( List Card, List Card )
+                partitionCards cards =
+                    List.partition (\c -> List.member c.id sel) cards
+
+                ( targets, rest ) =
+                    partitionCards self.cards
+
+                shuffleModels =
+                    [ targets
+                        |> List.tail
+                        |> Maybe.withDefault []
+                    , targets
+                        |> List.head
+                        |> Maybe.map (\h -> [ h ])
+                        |> Maybe.withDefault []
+                    ]
+                        |> List.concat
+                        |> List.map .model
+                        |> shuffleList seed
+
+                shuffled =
+                    List.map2 (\c model -> { c | model = model }) targets shuffleModels
+            in
+            { self | cards = List.concat [ shuffled, rest ] }
+
+        Humanize sel ->
+            let
+                humanized =
+                    self.cards
+                        |> List.indexedMap
+                            (\i c ->
+                                if List.isEmpty sel || List.member c.id sel then
+                                    { c | rot = { pivot = c.rot.pivot, angle = c.rot.angle + randomOffset (seed + i) 5.0 } }
+
+                                else
+                                    c
+                            )
+            in
+            { self | cards = humanized }
+
+
+cropViewport : Project -> Rect
+cropViewport p =
+    let
+        firstCard =
+            Maybe.withDefault defaultCard (List.head p.cards)
+                |> Card
+                |> shapeBounds p
+
+        cardsRect =
+            List.foldl (\a c -> includeRect c a) firstCard (List.map (\c -> shapeBounds p (Card c)) p.cards)
+
+        firstZone =
+            List.head p.zones
+
+        zonesRect =
+            case firstZone of
+                Just zone ->
+                    List.foldl (\a c -> includeRect c a) zone.rect (List.map .rect p.zones)
+
+                Nothing ->
+                    cardsRect
+    in
+    includeRect cardsRect zonesRect
+        |> enlarge 10
+
+
+cropShapes : Selection -> Project -> Rect
+cropShapes sel p =
+    let
+        (Shapes zones cards _ _) =
+            mergeAll p
+                |> List.filter (\( id, _ ) -> List.member id sel)
+                |> splitAll
+
+        firstCard =
+            Maybe.withDefault defaultCard (List.head cards)
+                |> Card
+                |> shapeBounds p
+
+        cardsRect =
+            List.foldl (\a c -> includeRect c a) firstCard (List.map (\c -> shapeBounds p (Card c)) cards)
+
+        firstZone =
+            List.head zones
+
+        zonesRect =
+            case firstZone of
+                Just zone ->
+                    List.foldl (\a c -> includeRect c a) zone.rect (List.map .rect zones)
+
+                Nothing ->
+                    cardsRect
+    in
+    includeRect cardsRect zonesRect
+        |> enlarge 50
+
+
+type Shapes
+    = Shapes (List Zone) (List Card) (List Arrow) (List Stamp)
+
+
+splitAll : List ( Id, Shape ) -> Shapes
+splitAll merged =
+    let
+        (Shapes zss css ass sts) =
+            merged
+                |> List.foldl
+                    (\( _, s ) (Shapes zones cards arrows stamps) ->
+                        case s of
+                            Card c ->
+                                Shapes zones (c :: cards) arrows stamps
+
+                            Zone z ->
+                                Shapes (z :: zones) cards arrows stamps
+
+                            Arrow a ->
+                                Shapes zones cards (a :: arrows) stamps
+
+                            Stamp t ->
+                                Shapes zones cards arrows (t :: stamps)
+                    )
+                    (Shapes [] [] [] [])
+    in
+    Shapes (List.reverse zss) (List.reverse css) (List.reverse ass) (List.reverse sts)
+
+
+mergeAll : Project -> List ( Id, Shape )
+mergeAll { zones, cards, arrows, stamps } =
+    List.concat
+        [ List.map (\c -> ( c.id, Card c )) cards
+        , List.map (\z -> ( z.id, Zone z )) zones
+        , List.map (\a -> ( a.id, Arrow a )) arrows
+        , List.map (\s -> ( s.id, Stamp s )) stamps
+        ]
+
+
+mutateItems : (( Id, Shape ) -> ( Id, Shape )) -> Project -> Project
+mutateItems fun p =
+    let
+        (Shapes zones cards arrows stamps) =
+            mergeAll p
+                |> List.map (\is -> fun is)
+                |> splitAll
+    in
+    { p | cards = cards, zones = zones, arrows = arrows, stamps = stamps }
+
+
+findById : List { a | id : Id } -> Id -> Maybe { a | id : Id }
+findById list id =
+    list |> List.filter (\x -> x.id == id) |> List.head
+
+
+getShapeById : Project -> Id -> Maybe Shape
+getShapeById p id =
+    let
+        selectedCard =
+            findById p.cards id
+
+        selectedZone =
+            findById p.zones id
+
+        selectedArrow =
+            findById p.arrows id
+
+        selectedStamp =
+            findById p.stamps id
+    in
+    Maybe.map Card selectedCard
+        |> mapNothing Zone selectedZone
+        |> mapNothing Arrow selectedArrow
+        |> mapNothing Stamp selectedStamp
+
+
+shapeId : Shape -> Id
+shapeId s =
+    case s of
+        Zone z ->
+            z.id
+
+        Card c ->
+            c.id
+
+        Arrow a ->
+            a.id
+
+        Stamp t ->
+            t.id
+
+
+getShapesByPos : Project -> Vec2 -> List ( Id, Shape )
+getShapesByPos self pos =
+    let
+        hovered =
+            List.filter
+                (\s ->
+                    Rect.hasPoint pos s.rect
+                )
+
+        hoveredShapes =
+            [ hovered self.cards |> List.map Card
+            , hovered self.zones |> List.map Zone
+            ]
+                |> List.concat
+    in
+    hoveredShapes
+        |> List.map (\s -> ( shapeId s, s ))
+
+
+getHighestShapeByPos : Project -> Vec2 -> Maybe ( Id, Shape )
+getHighestShapeByPos self pos =
+    getShapesByPos self pos
+        |> List.map Tuple.second
+        |> List.filter
+            (\s ->
+                case s of
+                    Arrow _ ->
+                        False
+
+                    _ ->
+                        True
+            )
+        |> List.sortWith
+            (\a b ->
+                case ( a, b ) of
+                    ( Zone _, Card _ ) ->
+                        Basics.GT
+
+                    ( Card _, Zone _ ) ->
+                        Basics.LT
+
+                    ( Card ca, Card cb ) ->
+                        compare ca.z cb.z
+
+                    _ ->
+                        LT
+            )
+        |> List.head
+        |> Maybe.map (\s -> ( shapeId s, s ))
+
+
+stampRect : Stamp -> Rect
+stampRect s =
+    { pos = Vec.sub s.pos (Vec.scale (s.radius * 2.0) Vec.one), size = Vec.scale (s.radius * 2.0) Vec.one }
+
+
+shapeRect : Project -> Shape -> Rect
+shapeRect self shape =
+    case shape of
+        Zone z ->
+            z.rect
+
+        Card c ->
+            c.rect
+
+        Arrow a ->
+            arrowRect self a
+
+        Stamp s ->
+            stampRect s
+
+
+shapeBounds : Project -> Shape -> Rect
+shapeBounds m s =
+    let
+        ( rect, pivot, angle ) =
+            shapeTransform m s
+    in
+    rect
+        |> toPoints
+        |> List.map (Vec.rotateAround (Vec.mult pivot rect.size |> Vec.add rect.pos) angle)
+        |> fromPoints
+
+
+arrowPointsToPos : Project -> Shape -> Vec2 -> ( Vec2, Vec2 )
+arrowPointsToPos model from pos =
+    let
+        r =
+            shapeRect model from
+
+        c =
+            Rect.center r
+
+        d =
+            0.42
+    in
+    ( Vec.mult
+        (Vec.direction c pos)
+        (Vec.scale d r.size)
+        |> Vec.add c
+    , Vec.mult
+        (Vec.direction pos c)
+        (Vec.scale (d * 0.2) r.size)
+        |> Vec.add pos
+    )
+
+
+
+-- TODO Arrow - better endpoint control with distance
+-- TODO Arrow - layer behind or above
+
+
+type alias Transform =
+    ( Rect, Vec2, Float )
+
+
+arrowPoints : ( Transform, Transform ) -> ( Vec2, Vec2 )
+arrowPoints ( ( fr, _, _ ), ( tr, _, _ ) ) =
+    let
+        -- TODO guard against infinite loop
+        -- in case arrow ids somehow are pointing to arrows
+        fc =
+            Rect.center fr
+
+        tc =
+            Rect.center tr
+
+        d =
+            0.42
+
+        -- v1 =
+        --     Rect.clamp fc (Rect.center tc)
+        -- v2 =
+        --     Rect.clamp tc v1
+        -- Rect.clamp {pos = }
+        v1 =
+            fc
+
+        -- Vec.mult
+        --     (Vec.direction fc tc)
+        --     (Vec.scale d fr.size)
+        --     |> Vec.add fc
+        -- |> Rect.clamp fr
+        v2 =
+            tc
+
+        -- Vec.mult
+        --     (Vec.direction tc fc)
+        --     (Vec.scale d tr.size)
+        --     |> Vec.add tc
+        -- |> Rect.clamp tr
+    in
+    ( v1, v2 )
+
+
+arrowEnds : Project -> Arrow -> ( Vec2, Vec2 )
+arrowEnds p a =
+    case ( getShapeById p a.from, getShapeById p a.to ) of
+        ( Just fromShape, Just toShape ) ->
+            arrowPoints ( shapeTransform p fromShape, shapeTransform p toShape )
+
+        _ ->
+            ( Vec.zero, Vec.zero )
+
+
+arrowRect : Project -> Arrow -> Rect
+arrowRect m a =
+    case ( getShapeById m a.from, getShapeById m a.to ) of
+        ( Just fromShape, Just toShape ) ->
+            let
+                ( from, to ) =
+                    arrowPoints ( shapeTransform m fromShape, shapeTransform m toShape )
+
+                r =
+                    normalizeRect from to
+
+                c =
+                    center r
+
+                dir =
+                    Vec.sub from to
+
+                l =
+                    Vec.length dir
+                        * 0.5
+
+                rad =
+                    atan2 dir.y dir.x
+                        / (pi * 2.0)
+
+                angle =
+                    rad
+                        * 360.0
+            in
+            normalizeRect from to
+
+        _ ->
+            Rect.rect2 Vec.zero Vec.zero
+
+
+shapePos : Project -> Shape -> Vec2
+shapePos m s =
+    let
+        rect =
+            shapeRect m s
+    in
+    rect.pos
+
+
+arrowTransform : Arrow -> ( Vec2, Vec2 ) -> ( Rect, Vec2, Float )
+arrowTransform a ( from, to ) =
+    let
+        r =
+            normalizeRect from to
+
+        c =
+            center r
+
+        dir =
+            Vec.sub from to
+
+        l =
+            Vec.length dir
+                * 0.5
+
+        rad =
+            atan2 dir.y dir.x
+                / (pi * 2.0)
+
+        angle =
+            rad
+                * 360.0
+
+        w =
+            max 50.0 a.width
+
+        rect =
+            rect2 (Vec.vec2 (c.x - l) (c.y - w * 0.5)) (Vec.vec2 (l * 2) w)
+    in
+    ( rect, Vec.half Vec.one, angle )
+
+
+shapeTransform : Project -> Shape -> ( Rect, Vec2, Float )
+shapeTransform model s =
+    case s of
+        Card c ->
+            ( c.rect
+            , c.rot.pivot
+            , c.rot.angle
+            )
+
+        Zone z ->
+            ( z.rect
+            , z.rot.pivot
+            , z.rot.angle
+            )
+
+        Arrow a ->
+            case ( getShapeById model a.from, getShapeById model a.to ) of
+                ( Just fromShape, Just toShape ) ->
+                    arrowPoints ( shapeTransform model fromShape, shapeTransform model toShape )
+                        |> arrowTransform a
+
+                _ ->
+                    ( Rect.rect2 Vec.zero Vec.zero
+                    , Vec.half Vec.one
+                    , 0.0
+                    )
+
+        Stamp t ->
+            ( stampRect t
+            , Vec.half Vec.one
+            , 0.0
+            )
+
+
+
+-- ( arrowRect model a, Vec.scale 0.5 Vec.one, 0 )
+
+
+getSelectedCardModels : List Card -> List Id -> String
+getSelectedCardModels cards selected =
+    List.filterMap (findById cards) selected
+        |> List.map (\c -> modelAsShort c.model)
+        |> List.reverse
+        |> String.join " "
+
+
+positionCards : Spread -> Int -> Vec2 -> List Card -> List Card
+positionCards spreadType spreadValue offset targets =
+    let
+        transforms =
+            spreadTransforms (List.length targets) cardSize spreadValue spreadType
+    in
+    transforms
+        |> List.map2
+            (\c ( pos, pivot, deg ) ->
+                { c
+                    | rect = { pos = Vec.add pos offset, size = c.rect.size }
+                    , rot =
+                        { pivot = pivot
+                        , angle =
+                            if isNaN deg then
+                                0.0
+
+                            else
+                                deg
+                        }
+                }
+            )
+            targets
+
+
+
+-- zoomViewport : Rect -> Float -> Vec2 -> ( Rect, Vec2 )
+-- zoomViewport viewport delta pos =
+--     let
+--         origin =
+--             Vec.add viewport.pos (Vec.scale 0.5 viewport.size)
+--         oldPosRatio =
+--             Vec.div viewport.size (Vec.sub origin viewport.pos)
+--         factor =
+--             if delta > 0.0 then
+--                 1.1
+--             else
+--                 1.0 / 1.1
+--         newSize =
+--             Vec.scale factor viewport.size
+--         oldScale =
+--             1.0
+--         newScale =
+--             factor * oldScale
+--         scaleChange =
+--             newScale - 1.0
+--         offset =
+--             Vec2 -(origin.x * scaleChange) -(origin.y * scaleChange)
+--         newPos =
+--             Vec.add viewport.pos offset
+--     in
+--     ( { pos = newPos
+--       , size = newSize
+--       }
+--     , Vec.add newPos (Vec.mult newSize oldPosRatio)
+--     )
+
+
+zoomViewport : Rect -> Float -> Vec2 -> ( Rect, Vec2 )
+zoomViewport viewport delta pos =
+    let
+        factor =
+            if delta > 0.0 then
+                1.1
+
+            else
+                1.0 / 1.1
+
+        rect =
+            Rect.scale factor viewport
+    in
+    if rect.size.y / cardSize.y >= 1.0 then
+        ( rect, pos )
+
+    else
+        ( viewport, pos )
+
+
+
+-- | RotateSelected String
+--   -- | ActOnCard ( CardAction, CardAction ) String
+-- | Crop
+-- | Shuffle
+-- | UpdateViewportRect RectCoordinate String
+-- | SpreadByType Spread
+-- | SpreadByValue String
+-- | SpreadCards Id
+-- | ApplySelector
+-- | Spawn
+-- | Remove
+-- | Resize Vec2
+-- | UpdateZoneRect Id RectCoordinate String
+-- | UpdateZoneString Id ZoneField String
+-- | SetArrowColor String
+-- | SetArrowWidth String
+-- | SetArrowHead Bool
+-- | Order Zorder
+--
+--
+--
+--
+
+
+type Shape
+    = Card Card
+    | Zone Zone
+    | Arrow Arrow
+    | Stamp Stamp
+
+
+initialViewport : Rect
+initialViewport =
+    Rect (Vec2 0 0) (Vec2 (8.0 * cardSize.x) (3.0 * cardSize.y))
+
+
+empty : Project
+empty =
+    { description = ""
+    , background = Transparent
+    , viewport = initialViewport
+    , cards = []
+    , zones = []
+    , arrows = []
+    , stamps = []
+    }
+
+
+getLastId : Project -> Int
+getLastId p =
+    let
+        parseId id =
+            String.dropLeft 1 id |> String.toInt |> Maybe.withDefault 0
+
+        ids =
+            List.map (\( i, _ ) -> parseId i)
+    in
+    1 + List.foldl max 0 (ids <| mergeAll p)
+
+
+validateArrows : Project -> Project
+validateArrows p =
+    { p
+        | arrows =
+            p.arrows
+                |> List.filter
+                    (\a ->
+                        let
+                            ids =
+                                mergeAll p
+                                    |> List.map Tuple.first
+                        in
+                        List.member a.from ids && List.member a.to ids
+                    )
+    }