Skip to content

Instantly share code, notes, and snippets.

@manuscrypt
Created December 22, 2017 06:32
Show Gist options
  • Star 0 You must be signed in to star a gist
  • Fork 0 You must be signed in to fork a gist
  • Save manuscrypt/c29699ef4f97e0b8ef7be6b141179a92 to your computer and use it in GitHub Desktop.
Save manuscrypt/c29699ef4f97e0b8ef7be6b141179a92 to your computer and use it in GitHub Desktop.
module Main exposing (..)
import Dict exposing (Dict)
import Html exposing (Html, div, text)
import Svg exposing (Svg, g)
import Svg.Attributes as SA
import Svg.Events as SE
type alias Idx =
( Int, Int )
type State
= Clean
| Weak
| Infected
| Flagged
type alias Grid =
Dict Idx State
type alias Model =
{ data : Grid
, idx : Idx
, dir : Dir
, infections : Int
}
type Dir
= Left
| Up
| Right
| Down
type Msg
= Click
startAt =
0
--10000000
sample : String
sample =
"..#\n#..\n..."
real : String
real =
"#.###...#..#..#...##.####\n##.##.#..##.#..#.#..#####\n.####..###.#.#####.#.##.#\n##..#.##.#.#.#...#..##..#\n..#...####.#.###.###...#.\n#..###.##.###.....#....#.\n.#..#.##.##....##...####.\n###.##....#...#.##....##.\n..#.###..######.#.####...\n.#.###..#.##.#..##.######\n###.####.#####.####....#.\n#...####.#.##...##..#.#..\n##.######.#....##.#.####.\n.#.#..#...##....#....#...\n.####.##.#..##...#..####.\n.#.####.##..###..###..##.\n...#...####...#.#.#.###.#\n#.##.####.#..##.###.####.\n.#.#...####....##..####.#\n##.###.##..####..#.######\n#.#...#.#.##.####........\n.......#..##..#.#..###...\n.#..###.###........##.#..\n.######.......#.#.##.#.#.\n.##..#.###.....##.#.#...#"
parseGrid : String -> Grid
parseGrid s =
String.split "\n" s
|> List.indexedMap
(\x row ->
String.split "" row
|> List.indexedMap
(\y col ->
( ( y, x )
, if col == "#" then
Infected
else
Clean
)
)
)
|> List.concat
|> Dict.fromList
center : Grid -> Idx
center grid =
let
ks =
Dict.keys grid
maxX =
List.map Tuple.first ks |> List.maximum |> Maybe.withDefault 0
minX =
List.map Tuple.first ks |> List.minimum |> Maybe.withDefault 0
maxY =
List.map Tuple.second ks |> List.maximum |> Maybe.withDefault 0
minY =
List.map Tuple.second ks |> List.minimum |> Maybe.withDefault 0
in
( (maxX - minX) // 2, (maxY - minY) // 2 )
main : Program Never Model Msg
main =
Html.program
{ init = init
, update = update
, view = view
, subscriptions = always Sub.none
}
init : ( Model, Cmd Msg )
init =
let
grid =
parseGrid real
in
walk startAt { data = grid, dir = Up, idx = center grid, infections = 0 }
! []
update : Msg -> Model -> ( Model, Cmd msg )
update msg model =
case msg of
Click ->
step model ! []
walk : Int -> Model -> Model
walk target model =
if target == 0 then
model
else
let
next =
step model
in
walk (target - 1) next
step : Model -> Model
step model =
let
realDict =
case Dict.get model.idx model.data of
Nothing ->
Dict.insert model.idx Clean model.data
_ ->
model.data
in
case Dict.get model.idx realDict of
Nothing ->
Debug.crash "not possible"
Just cell ->
let
newCell =
toggleCell cell
newDir =
switchDir model.dir cell
newIdx =
go newDir model.idx
in
{ model
| dir = newDir
, idx = newIdx
, data = Dict.insert model.idx newCell model.data
, infections =
if cell == Weak then
model.infections + 1
else
model.infections
}
switchDir : Dir -> State -> Dir
switchDir dir cell =
case cell of
Clean ->
turnLeft dir
Weak ->
dir
Infected ->
turnRight dir
Flagged ->
turnLeft dir |> turnLeft
toggleCell : State -> State
toggleCell cell =
case cell of
Clean ->
Weak
Weak ->
Infected
Infected ->
Flagged
Flagged ->
Clean
go : Dir -> ( number, number1 ) -> ( number, number1 )
go dir ( x, y ) =
case dir of
Up ->
( x, y - 1 )
Down ->
( x, y + 1 )
Left ->
( x - 1, y )
Right ->
( x + 1, y )
turnLeft : Dir -> Dir
turnLeft dir =
case dir of
Up ->
Left
Left ->
Down
Down ->
Right
Right ->
Up
turnRight : Dir -> Dir
turnRight dir =
case dir of
Up ->
Right
Right ->
Down
Down ->
Left
Left ->
Up
view : Model -> Html Msg
view model =
let
( x, y ) =
model.idx
minX =
Dict.keys model.data
|> List.map Tuple.first
|> List.minimum
|> Maybe.withDefault 0
|> Debug.log "minx"
maxX =
Dict.keys model.data
|> List.map Tuple.first
|> List.maximum
|> Maybe.withDefault 0
|> Debug.log "maxx"
minY =
Dict.keys model.data
|> List.map Tuple.second
|> List.minimum
|> Maybe.withDefault 0
|> Debug.log "minY"
maxY =
Dict.keys model.data
|> List.map Tuple.second
|> List.maximum
|> Maybe.withDefault 0
|> Debug.log "maxY"
w =
maxX - minX
h =
maxY - minY
in
Svg.svg
[ SE.onClick Click
, SA.height "100%"
, SA.width "100%"
, SA.viewBox <|
toString (minX * size)
++ " "
++ toString (minY * size)
++ " "
++ toString (w * size)
++ " "
++ toString (h * size)
]
[ g [] <| Dict.values <| Dict.map (viewCell model.idx) model.data
, g [ tx 0 -5 ] [ Svg.text_ [ SA.stroke "black", SA.fill "white" ] [ Svg.text <| toString model.infections ] ]
]
viewCell : Idx -> Idx -> State -> Svg msg
viewCell ( mx, my ) ( x, y ) state =
g [ tx (x * size) (y * size) ] <|
Svg.rect
[ SA.x "0"
, SA.y "0"
, SA.width <| toString size
, SA.height <| toString size
, SA.stroke "black"
, SA.fill
(if state == Clean then
"none"
else if state == Weak then
"brown"
else if state == Flagged then
"green"
else if state == Infected then
"red"
else
"purple"
)
]
[]
:: (if mx == x && my == y then
[ g [ tx (size // 2) (size // 2) ] [ Svg.circle [ SA.r <| toString (size // 2), SA.fill "black" ] [] ] ]
else
[]
)
tx : a -> b -> Svg.Attribute msg
tx x y =
SA.transform <| "translate(" ++ toString x ++ "," ++ toString y ++ ")"
size : number
size =
20
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment