aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--src/Main.elm101
-rw-r--r--src/Protocol.elm24
2 files changed, 125 insertions, 0 deletions
diff --git a/src/Main.elm b/src/Main.elm
new file mode 100644
index 0000000..5066ad6
--- /dev/null
+++ b/src/Main.elm
@@ -0,0 +1,101 @@
+port module Main exposing (..)
+
+import Browser
+import Html exposing (Html, button, div, text, br, input, img)
+import Html.Attributes exposing (style, class, value, placeholder, src)
+import Html.Events exposing (onInput, onClick)
+import Html.Lazy exposing (lazy)
+import List exposing (foldr)
+
+import Protocol exposing (decodeState, encodeState)
+import Json.Decode as D
+
+
+main = Browser.document
+ { init = init
+ , update = update
+ , view = view
+ , subscriptions = subscriptions
+ }
+
+ -- subscribe to messages from the websocket
+subscriptions : Model -> Sub Msg
+subscriptions model = recvPort GotMessage
+
+ -- corresponding ports for the subscriptions
+port recvPort : (String -> msg) -> Sub msg
+port sendPort : String -> Cmd msg
+
+
+{- STATE AND STATE TRANSITIONS -}
+
+ -- the main client state
+type alias Model = { slide : Int, max : Int }
+
+ -- start at the first slide, for now just assume that we have ten slides
+init : () -> (Model, Cmd Msg)
+init f = ( { slide = 0, max = 10 }, Cmd.none)
+
+ -- possible state transitions:
+type Msg = GotMessage String
+ | NextSlide
+ | PrevSlide
+
+ -- update stuff
+update : Msg -> Model -> (Model, Cmd Msg)
+update msg model = case msg of
+ NextSlide -> updateSlide ((+) 1) model
+ PrevSlide -> updateSlide ((+) -1) model
+ GotMessage text ->
+ case decodeState text of
+ Nothing -> (model, Cmd.none)
+ Just newstate -> ({model | slide = newstate.state }, Cmd.none)
+
+ -- while changing slides we must take care not to end up in an invalid
+ -- state (where slide > max), so this logic gets its own function
+tweakSlide : (Int -> Int) -> Model -> Model
+tweakSlide f model = { model | slide = modBy model.max (f model.slide) }
+
+updateSlide : (Int -> Int) -> Model -> (Model, Cmd Msg)
+updateSlide f model =
+ let new = tweakSlide f model
+ in (new, sendPort (encodeState { state = new.slide }))
+
+{- VIEW COMPONENTS -}
+
+ -- our body consists of a slide container and a couple controls
+body : Model -> Html Msg
+body model = div []
+ [ div [class "slides"] (slideView model.slide model.max)
+ , div [class "controls"]
+ [ button [ onClick PrevSlide ] [ text "←" ]
+ , text (String.fromInt (model.slide+1))
+ , button [ onClick NextSlide ] [ text "→" ]
+ ]
+ ]
+
+ -- the slide view is just a list of img tags, one for each slide; note
+ -- that these are all loaded on startup, with visibility done through
+ -- z indices so we won't have lags while switching between them.
+slideView : Int -> Int -> List (Html Msg)
+slideView i max = List.range 0 (max - 1)
+ |> List.map (\x -> ("example/" ++ (padNum 2 (x+1)) ++ ".png", x == i))
+ |> List.map (\(path,t) -> img [src path, onTop t] [])
+
+onTop t = style "z-index" (String.fromInt (if t then 10 else 0))
+
+ -- format an int with prefixed 0's — apparently elm doesn't have a
+ -- standard function for that, but it's needed for slide filenames
+padNum : Int -> Int -> String
+padNum l num =
+ let str = String.fromInt num
+ in if (String.length str) > l then str else
+ (String.repeat (l - String.length str) "0") ++ str
+
+
+view : Model -> Browser.Document Msg
+view model = { title = "Websockets example"
+ , body = [body model]
+ }
+
+
diff --git a/src/Protocol.elm b/src/Protocol.elm
new file mode 100644
index 0000000..371a23a
--- /dev/null
+++ b/src/Protocol.elm
@@ -0,0 +1,24 @@
+module Protocol exposing (State, encodeState, decodeState)
+
+import Json.Decode as D
+import Json.Encode as E
+
+{- PROTOCOL -}
+
+ -- for now, this is still very boring and just has one field:
+type alias State = { state : Int }
+
+encodeState : State -> String
+encodeState state =
+ E.object [ ("state", E.int state.state) ]
+ |> E.encode 0
+
+
+stateDecoder : D.Decoder State
+stateDecoder = D.map State (D.field "state" D.int)
+
+decodeState : String -> Maybe State
+decodeState text = case D.decodeString (D.nullable stateDecoder) text of
+ Err e -> Nothing
+ Ok value -> value
+