Elmで開発したルーレットアプリの実装解説

-- MODEL

type alias Model =
  { scene: Scene
  , counters: Counters
  , maxCounters: Int
  , rotation: Float -- in percentage
  , rotationVelocity: Float
  , decayRate: Float
  , goalRotation: Float
  , pointedCounter: Counter
  , cheatedGoalRange: Maybe Range
  }

type alias Counters = List Counter

type alias Counter =
  { id: Int
  , label: String
  , count: Int
  }

type alias FanShape =
  { offset: Float
  , percentage: Float
  , color: String
  }

type alias Color = String

type alias Colors = List Color

type Scene
  = EditingRoulette
  | RouletteSpinning
  | RouletteSpinningTowardsStop
  | RouletteStopped
  | ResultShowed

type alias Range =
  { min: Float
  , max: Float
  }

type alias RotationRange =
 { min: Float
 , max: Float
 }

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
    (Increment counter, EditingRoulette) ->
      let
        (front, back) = separateIntoFrontAndBack model.counters counter
        updatedCounter = { counter | count = counter.count + 1}
        updatedCounters = front ++ [updatedCounter] ++ back
      in
        ({ model | counters = updatedCounters }, Cmd.none)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (Decrement counter, EditingRoulette) ->
      if 0 < counter.count then
        let
          (front, back) = separateIntoFrontAndBack model.counters counter
          updatedCounter = { counter | count = counter.count - 1}
          updatedCounters = front ++ [updatedCounter] ++ back
        in
          ({ model | counters = updatedCounters }, Cmd.none)
      else
        (model, Cmd.none)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (ChangeCount counter newCount, EditingRoulette) ->
      let
        (front, back) = separateIntoFrontAndBack model.counters counter
        updatedCounter = { counter | count = String.toInt newCount |> Maybe.withDefault (if newCount == "" then 0 else counter.count) }
        updatedCounters = front ++ [updatedCounter] ++ back
      in
        ({ model | counters = updatedCounters }, Cmd.none)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (ChangeLabel counter newLabel, EditingRoulette) ->
      let
        (front, back) = separateIntoFrontAndBack model.counters counter
        updatedCounter = { counter | label = newLabel}
        updatedCounters = front ++ [updatedCounter] ++ back
      in
        ({ model | counters = updatedCounters }, Cmd.none)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (Clear counter, EditingRoulette) ->
      let
        (front, back) = separateIntoFrontAndBack model.counters counter
        updatedCounter = { counter | count = 0, label = "" }
        updatedCounters = front ++ [updatedCounter] ++ back
      in
        ({ model | counters = updatedCounters }, Cmd.none)

viewRoulette : Counters -> Colors -> Float -> Html Msg
viewRoulette counters colors rotation =
  let
    counts = List.map (\counter -> toFloat counter.count) counters
    total = List.sum counts
    percentages = List.map (\count -> 100.0 * count / total) counts
    offsets =
      List.foldl (\percentage acc -> List.append acc [(Maybe.withDefault 0.0 <| List.maximum acc) + percentage]) [0.0] percentages
        |> List.map ((+) rotation)
    fanShapes = List.map3 (\offset percentage color -> FanShape offset percentage color) offsets percentages colors
  in
    svg
      [ viewBox "0 0 63.6619772368 63.6619772368", width "500px", style "transform" "rotate(90deg)" ]
      (List.append (List.map (\fanShape -> viewFanShape fanShape) fanShapes) [viewRoulettePointer])

viewFanShape : FanShape -> Html Msg
viewFanShape fanShape =
  let
    strokeDashoffset_ = String.fromFloat <|  -fanShape.offset -- Fan shape direction is opposite to Svg.circle, becouse of the specification of dassArray. So I negat fanshape.offset.
    strokeDasharray_ = String.fromFloat fanShape.percentage ++ " " ++ (String.fromFloat <| 100.0 - fanShape.percentage)
  in
    circle
      [ cx "31.8309886184", cy "31.8309886184", r "15.9154943092"
      , fill "#ffffff", fillOpacity "0.0"
      , stroke fanShape.color, strokeWidth "31.8309886184", strokeDashoffset strokeDashoffset_, strokeDasharray strokeDasharray_ ]
      []

viewRoulettePointer : Html Msg
viewRoulettePointer =
  polygon
    [ points "63.6619772368,29.5309886184 63.6619772368,34.3309886184 57.6619772368,31.8309886184"
    , style "fill" roulettePointerColor
    ]
    []

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (SpinRoulette _, RouletteSpinning) ->
      let
        pointedCounter_ =
          calculateCollisionRanges model.counters model.rotation
            |> List.map2 (\counter collisionRange -> Tuple.pair counter <| willBeNewlyPointed model.rotationVelocity collisionRange) model.counters
            |> List.filter (\(counter, willBeNewlyPointed_) -> willBeNewlyPointed_)
            |> List.head
            |> Maybe.withDefault (model.pointedCounter, False)
            |> Tuple.first
-- (以下略)

calculateCollisionRanges : Counters -> Float -> List RotationRange
calculateCollisionRanges counters rotation =
  let
    counts = List.map (\counter -> toFloat counter.count) counters
    total = List.sum counts
    percentages = List.map (\count -> 100.0 * count / total) counts
    offsets =
      List.foldl (\percentage acc -> List.append acc [(Maybe.withDefault 0.0 <| List.maximum acc) + percentage]) [0.0] percentages
        |> List.map ((+) rotation)
  in
    List.map2 (\percentage offset -> RotationRange offset <| offset + percentage) percentages offsets

willBeNewlyPointed : Float -> RotationRange -> Bool
willBeNewlyPointed rotationVelocity collisionRange  =
  if carryDownUnder 200.0 100.0 (collisionRange.max + rotationVelocity) > 100.0
    && carryDownUnder 200.0 100.0 (collisionRange.min + rotationVelocity) <= 100
  then
    True
  else
    False

carryDownUnder : Float -> Float -> Float -> Float
carryDownUnder maximum decrementStep value =
  if value < maximum then
    value
  else
    carryDownUnder value decrementStep <| value - decrementStep

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (Cheat counter, EditingRoulette) ->
      let
        cheatedGoalRange_ =
          if counter.count > 0 then
            calculateCollisionRanges model.counters 0.0
              |> List.take counter.id
              |> List.reverse
              |> List.head
              |> Maybe.andThen (\maybeRange -> Just <| Range (100.0 - maybeRange.max) (100.0 - maybeRange.min))
          else
            Nothing
      in
        ({model | cheatedGoalRange = cheatedGoalRange_}, Cmd.none)

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (OnClickStart, EditingRoulette) ->
      let
        goalRange =
          Maybe.withDefault fairGoalRange model.cheatedGoalRange
      in
        (model, Random.generate (StartSpinningRoulette initialDecayRate) <| Random.pair (Random.float initialVelocityRange.min initialVelocityRange.max) (Random.float goalRange.min goalRange.max))

    (StartSpinningRoulette decayRate_ (initialVelocity, goal), EditingRoulette) ->
      if isThereEnogthCountersToStart model.counters then
        ({ model | scene = RouletteSpinning, decayRate = decayRate_,rotationVelocity = initialVelocity, goalRotation = goal }, Cmd.none)
      else
        (model, Cmd.none)
-- (以下略)


-- ヘルパー関数: ルーレットを開始するための最低限の個数のアイテムが設定済みかどうかをチェックする
isThereEnogthCountersToStart : Counters -> Bool
isThereEnogthCountersToStart counters =
  counters
    |> List.filter (\counter -> counter.count > 0)
    |> List.length
    |> (<) 1

subscriptions : Model -> Sub Msg
subscriptions model =
  case model.scene of
    RouletteSpinning ->
      Time.every 30 SpinRoulette
    RouletteSpinningTowardsStop ->
      Time.every 30 SpinRoulette
    _ ->
      Sub.none

update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
  case (msg, model.scene) of
-- (中略)
    (AdjustDecayRateForSmoothStop decayRate_, RouletteSpinning) ->
      ({ model | decayRate = decayRate_, scene = RouletteSpinningTowardsStop }, Cmd.none)

    (SpinRoulette _, RouletteSpinningTowardsStop) ->
      let
        pointedCounter_ =
          calculateCollisionRanges model.counters model.rotation
            |> List.map2 (\counter collisionRange -> Tuple.pair counter <| willBeNewlyPointed model.rotationVelocity collisionRange) model.counters
            |> List.filter (\(counter, willBeNewlyPointed_) -> willBeNewlyPointed_)
            |> List.head
            |> Maybe.withDefault (model.pointedCounter, False)
            |> Tuple.first
        (rotation_, rotationVelocity_) = updateRotation model.rotation model.rotationVelocity model.decayRate
      in
        if willReachGoal model.goalRotation model.rotation model.rotationVelocity then
          update (StopRoulette milliSecondsToKeepRouletteStopUntilResult) model
        else
          ({ model | rotation = rotation_, rotationVelocity = rotationVelocity_, pointedCounter = pointedCounter_}, Cmd.none)

    (StopRoulette forMilliSeconds, RouletteSpinningTowardsStop) ->
      ({ model | scene = RouletteStopped}, Process.sleep forMilliSeconds |> Task.perform (always ShowResult))
-- (以下略)


-- ヘルパー関数: 回転が１つ進むことで予定の停止角に達するかどうかを調べる
willReachGoal : Float -> Float -> Float -> Bool
willReachGoal goal rotation velocity =
  if rotation < goal && goal <= rotation + velocity then
    True
  else
    False