touchpage 0.2.2

control panel server with shared-state web controls
Documentation 
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133

module SvgLabel exposing (Model, Msg(..), Spec, UpdateMessage, init, jsSpec, jsUpdateMessage, resize, update, view)

import Html exposing (Html)
import Html.Events exposing (onClick, onMouseDown, onMouseOut, onMouseUp)
import Json.Decode as JD
import Json.Encode as JE
import String
import Svg exposing (Attribute, Svg, g, rect, svg, text)
import Svg.Attributes exposing (..)
import SvgCommand exposing (Command(..))
import SvgTextSize exposing (..)
import SvgThings exposing (UiColor(..), UiTheme)
import Task
import Template exposing (render, template)
import Time exposing (..)
import VirtualDom as VD


type alias Spec =
    { name : String
    , label : String
    }


jsSpec : JD.Decoder Spec
jsSpec =
    JD.map2 Spec
        (JD.field "name" JD.string)
        (JD.field "label" JD.string)


type alias Model =
    { name : String
    , label : String
    , stringWidth : Maybe Float
    , cid : SvgThings.ControlId
    , rect : SvgThings.Rect
    , srect : SvgThings.SRect
    , textSvg : List (Svg ())
    }


type Msg
    = SvgUpdate UpdateMessage
    | NoOp


type alias UpdateMessage =
    { controlId : SvgThings.ControlId
    , label : String
    }


jsUpdateMessage : JD.Decoder UpdateMessage
jsUpdateMessage =
    JD.map2 UpdateMessage
        (JD.field "controlId" SvgThings.decodeControlId)
        (JD.field "label" JD.string)


init :
    SvgThings.Rect
    -> SvgThings.ControlId
    -> Spec
    -> ( Model, Command )
init rect cid spec =
    let
        model =
            Model spec.name
                spec.label
                Nothing
                cid
                rect
                (SvgThings.SRect (String.fromInt rect.x)
                    (String.fromInt rect.y)
                    (String.fromInt rect.w)
                    (String.fromInt rect.h)
                )
                []
    in
    ( model, resizeCommand model )


update : Msg -> Model -> ( Model, Command )
update msg model =
    case msg of
        SvgUpdate um ->
            let
                newmodel =
                    { model | label = um.label, textSvg = [], stringWidth = Nothing }
            in
            ( newmodel, resizeCommand newmodel )

        NoOp ->
            ( model, None )


resize : Model -> SvgThings.Rect -> ( Model, Command )
resize model rect =
    let
        -- ts = calcTextSvgM theme model
        newmodel =
            { model
                | rect = rect
                , srect =
                    SvgThings.SRect (String.fromInt rect.x)
                        (String.fromInt rect.y)
                        (String.fromInt rect.w)
                        (String.fromInt rect.h)
                , textSvg = []
                , stringWidth = Nothing
            }
    in
    ( newmodel, resizeCommand newmodel )


view : UiTheme -> Model -> Svg Msg
view theme model =
    let
        lbrect =
            rect
                [ x model.srect.x
                , y model.srect.y
                , width model.srect.w
                , height model.srect.h
                , style ("fill: #" ++ theme.colorString Labels ++ ";")
                ]
                []

        svgl =
            lbrect :: model.textSvg
    in
    VD.map (\_ -> NoOp) (g [] svgl)