Skip to content

Instantly share code, notes, and snippets.

@matsubara0507
Created December 18, 2018 14:02
Show Gist options
  • Star 1 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save matsubara0507/b3c5b33505fbe50f63c1d3242414eece to your computer and use it in GitHub Desktop.
Save matsubara0507/b3c5b33505fbe50f63c1d3242414eece to your computer and use it in GitHub Desktop.
Elm 0.19 のライフゲーム(スマホ非対応バージョン)
module Main exposing (main)
import Browser exposing (Document)
import Browser.Navigation exposing (Key)
import Html exposing (Html, button, div, text)
import Html.Events exposing (onClick)
import Html.Events.Extra.Pointer as Pointer
import Html.Attributes exposing (style, src)
import Array exposing (Array)
import SingleSlider
import Time
import Url exposing (Url)
import Url.Parser as Url exposing ((</>), (<?>))
import Url.Parser.Query as UrlQuery
main =
Browser.application
{ init = init
, update = update
, view = view
, subscriptions = subscriptions
, onUrlRequest = always (ChangeUrl defaultLinks)
, onUrlChange = \url -> ChangeUrl (parseUrl url)
}
type alias Model =
{ board : Board
, sizeSlider : SingleSlider.Model
, tickSlider : SingleSlider.Model
}
init : () -> Url -> Key -> (Model, Cmd Msg)
init _ url _ = (initModel url, Cmd.none)
initModel : Url -> Model
initModel url =
let
size =
30
defaultSlider =
SingleSlider.defaultModel
sizeSlider =
{ defaultSlider
| min = 5.0
, max = 50.0
, step = 1.0
, value = size
, minFormatter = always ""
, maxFormatter = always ""
, currentValueFormatter =
\n _ -> String.concat [ "1列のマス数: ", String.fromFloat n ]
}
tickSlider =
{ defaultSlider
| min = 50.0
, max = 1000.0
, step = 10.0
, value = 100.0
, minFormatter = always ""
, maxFormatter = always ""
, currentValueFormatter =
\n _ -> String.concat [ "更新間隔: ", String.fromFloat n, "ms" ]
}
in
{ board = initBoard size (parseUrl url)
, sizeSlider = sizeSlider
, tickSlider = tickSlider
}
defaultLinks =
{ alive = "https://github.com/matsubara0507/lifegame/blob/master/docs/static/image/alive.png?raw=true"
, dead = "https://github.com/matsubara0507/lifegame/blob/master/docs/static/image/dead.png?raw=true"
}
parseUrl : Url -> Links
parseUrl url =
let
queryParser =
UrlQuery.map2
Links
(UrlQuery.string "alive" |> UrlQuery.map (Maybe.withDefault defaultLinks.alive))
(UrlQuery.string "dead" |> UrlQuery.map (Maybe.withDefault defaultLinks.dead))
parser =
Url.top <?> queryParser
in
{ url | path = "" }
|> Url.parse parser
|> Maybe.withDefault defaultLinks
type alias Board =
{ size : Int
, cells : Array Cell
, planting : Bool
, links : Links
}
type alias Links =
{ alive : String
, dead : String
}
type Cell = Alive | Dead
initBoard : Int -> Links -> Board
initBoard n links =
{ size = n
, cells = Array.repeat (n * n) Dead
, planting = False
, links = links
}
type Msg
= SizeSliderMsg SingleSlider.Msg
| TickSliderMsg SingleSlider.Msg
| BoardMsg BoardMsg
| NextTick
| ChangeUrl Links
update : Msg -> Model -> (Model, Cmd Msg)
update msg model =
case msg of
SizeSliderMsg subMsg ->
let
( updatedSlider, cmd, _ ) =
SingleSlider.update subMsg model.sizeSlider
updatedBoard =
initBoard (truncate updatedSlider.value) model.board.links
in
( { model | board = updatedBoard, sizeSlider = updatedSlider }
, Cmd.map SizeSliderMsg cmd
)
TickSliderMsg subMsg ->
let
( updatedSlider, cmd, _ ) =
SingleSlider.update subMsg model.tickSlider
in
( { model | tickSlider = updatedSlider }
, Cmd.batch [ Cmd.map TickSliderMsg cmd ]
)
BoardMsg subMsg ->
let
( updatedBoard, cmd ) =
updateBoard subMsg model.board
in
( { model | board = updatedBoard }, Cmd.map BoardMsg cmd )
NextTick ->
( { model | board = nextBoard model.board }, Cmd.none )
ChangeUrl links ->
let
board =
model.board
updatedBoard =
{ board | links = links }
in
( { model | board = updatedBoard }, Cmd.none )
type BoardMsg
= Born Int
| Planting
updateBoard : BoardMsg -> Board -> ( Board, Cmd BoardMsg )
updateBoard msg board =
case msg of
Born idx ->
( born idx board, Cmd.none )
Planting ->
( { board | planting = xor board.planting True }, Cmd.none )
born : Int -> Board -> Board
born idx board =
{ board | cells = Array.set idx Alive board.cells }
nextBoard : Board -> Board
nextBoard board =
{ board | cells = Array.indexedMap (nextCell board) board.cells }
nextCell : Board -> Int -> Cell -> Cell
nextCell board idx cell =
case ( countAroundAliveCell board idx, cell ) of
( 2, Alive ) ->
Alive
( 3, _ ) ->
Alive
_ ->
Dead
countAroundAliveCell : Board -> Int -> Int
countAroundAliveCell board idx =
aroundCell board idx |> List.filter ((==) Alive) |> List.length
aroundCell : Board -> Int -> List Cell
aroundCell board idx =
[ if modBy board.size idx == 0 then
[] -- 左端にいる場合
else
[ idx - board.size - 1, idx - 1, idx + board.size - 1 ]
, [ idx - board.size, idx + board.size ] -- 上下は `Array.get` で `Nothing` になる
, if modBy board.size idx == board.size - 1 then
[] -- 右端にいる場合
else
[ idx - board.size + 1, idx + 1, idx + board.size + 1 ]
]
|> List.concat
|> List.filterMap (\n -> Array.get n board.cells)
view : Model -> Document Msg
view model =
let
sliderAttrs =
[ style "margin-left" "10px"
, style "margin-right" "10px"
]
in
{ title = "Life Game"
, body =
[ div
[ style "text-align" "center"
, style "display" "flex"
, style "justify-content" "center"
]
[ div sliderAttrs
[ Html.map SizeSliderMsg (SingleSlider.view model.sizeSlider) ]
, div sliderAttrs
[ Html.map TickSliderMsg (SingleSlider.view model.tickSlider) ]
]
, Html.map BoardMsg (viewBoard model.board)
]
}
viewBoard : Board -> Html BoardMsg
viewBoard board =
let
attr =
[ style "width" (maxLength |> vmin)
, style "height" (maxLength |> vmin)
]
in
concatIndexedMapWith (Html.div attr) (viewCell board) board
viewCell : Board -> Int -> Cell -> Html BoardMsg
viewCell board idx cell =
let
styleAttrs =
[ style "width" (maxLength / toFloat board.size |> vmin)
, style "height" (maxLength / toFloat board.size |> vmin)
, style "margin" "0"
, style "box-sizing" "border-box"
, style "border" "0.2vmin solid gray"
]
bornAttr =
if board.planting then
[ Pointer.onDown (always Planting)
, Pointer.onOver (always (Born idx))
]
else
[ Pointer.onDown (always Planting) ]
imageLink =
case cell of
Dead ->
[ src board.links.dead ]
Alive ->
[ src board.links.alive ]
in
Html.img (List.concat [ styleAttrs, bornAttr, imageLink ]) []
subscriptions : Model -> Sub Msg
subscriptions model =
if model.board.planting then
Sub.none
else
Time.every model.tickSlider.value (always NextTick)
concatIndexedMapWith : (List a -> b) -> (Int -> Cell -> a) -> Board -> b
concatIndexedMapWith f g board =
board.cells
|> Array.indexedMap g
|> Array.toList
|> f
maxLength : Float
maxLength = 90.0
vmin : Float -> String
vmin n =
String.append (String.fromFloat n) "vmin"
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment