Skip to content

Instantly share code, notes, and snippets.

@pdamoc
Last active September 9, 2015 07:29
Show Gist options
  • Save pdamoc/0aac77e1919bd725bcc7 to your computer and use it in GitHub Desktop.
Save pdamoc/0aac77e1919bd725bcc7 to your computer and use it in GitHub Desktop.
SlideShow delayed action
module SlideShow where
import StartApp
import Time exposing (second, Time)
import Html exposing (Html, Attribute, div, text)
import Html.Attributes exposing (style)
import Effects exposing (Effects, map, batch, Never)
import Array exposing (get, fromList)
import Task
import Mouse
-- MODEL
type alias Slide =
{ text : String
, autoProgressAfter : Maybe Time
}
type alias Model =
{ slides : List Slide
, currentSlide : Int
}
defaultSlideshow =
[ { text = "slide 1", autoProgressAfter = Nothing }
, { text = "slide 2", autoProgressAfter = Just (2*second) }
, { text = "slide 3", autoProgressAfter = Nothing }
]
init =
( { slides = defaultSlideshow
, currentSlide = 0
}
, autoProgressEffect (get 0 <| fromList defaultSlideshow) 0)
-- UPDATE
type Action = AutoAdvance Int ()| Click ()
autoProgressEffect: Maybe Slide -> Int -> Effects Action
autoProgressEffect maybeSlide slideNo =
case maybeSlide of
Nothing ->
Effects.none
Just slide ->
case slide.autoProgressAfter of
Nothing -> Effects.none
Just time ->
Task.sleep time
|> Task.map (AutoAdvance slideNo)
|> Effects.task
update : Action -> Model -> (Model, Effects Action)
update action model =
let
newModel = { model | currentSlide <- model.currentSlide+1 }
maybeSlide = get newModel.currentSlide <| fromList newModel.slides
in
case action of
Click _ ->
(newModel, autoProgressEffect maybeSlide newModel.currentSlide)
AutoAdvance slideNo _ ->
if model.currentSlide == slideNo
then (newModel, autoProgressEffect maybeSlide newModel.currentSlide)
else (model, Effects.none)
-- VIEW
view : Signal.Address Action -> Model -> Html
view address model =
let
slide = get model.currentSlide <| fromList model.slides
in
case slide of
Nothing -> div [ myStyle ] [ text "No More Slides"]
Just slide -> div [ myStyle ] [ text slide.text]
myStyle : Attribute
myStyle =
style
[ ("width", "100%")
, ("height", "40px")
, ("padding", "10px 0")
, ("font-size", "2em")
, ("text-align", "center")
]
-- APP CONFIG
app =
StartApp.start
{ init = init
, update = update
, view = view
, inputs = [ Signal.map Click Mouse.clicks ]
}
main : Signal Html
main =
app.html
port tasks : Signal (Task.Task Never ())
port tasks =
app.tasks
@pdamoc
Copy link
Author

pdamoc commented Sep 8, 2015

Code related to this reddit discussion.

Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment