import Maybe as M import Result as R import Matrix import Mouse import Random exposing (Seed) import Matrix.Random import Time exposing (Time, every, second) import Set exposing (Set, fromList) import List exposing (..) import String exposing (join) import Html exposing (Html, br, input, h1, h2, text, div, button) import Html.Events as HE import Html.Attributes as HA import Html.App exposing (program) import Json.Decode as JD import Svg import Svg.Attributes exposing (version, viewBox, cx, cy, r, x, y, x1, y1, x2, y2, fill,points, style, width, height, preserveAspectRatio) minSide = 10 maxSide = 40 w = 700 h = 700 dt = 0.001 type alias Direction = Int down = 0 right = 1 type alias Door = (Matrix.Location, Direction) type State = Initial | Generating | Generated | Solved type alias Model = { rows : Int , cols : Int , animate : Bool , boxes : Matrix.Matrix Bool , doors : Set Door , current : List Matrix.Location , state : State , seedStarter : Int , seed : Seed } initdoors : Int -> Int -> Set Door initdoors rows cols = let pairs la lb = List.concatMap (\at -> List.map ((,) at) lb) la downs = pairs (pairs [0..rows-2] [0..cols-1]) [down] rights = pairs (pairs [0..rows-1] [0..cols-2]) [right] in downs ++ rights |> fromList initModel : Int -> Int -> Bool -> State -> Int -> Model initModel rows cols animate state starter = let rowGenerator = Random.int 0 (rows-1) colGenerator = Random.int 0 (cols-1) locationGenerator = Random.pair rowGenerator colGenerator (c, s)= Random.step locationGenerator (Random.initialSeed starter) in { rows = rows , cols = cols , animate = animate , boxes = Matrix.matrix rows cols (\location -> state == Generating && location == c) , doors = initdoors rows cols , current = if state == Generating then [c] else [] , state = state , seedStarter = starter -- updated every Tick until maze generated. , seed = s } view model = let borderLineStyle = style "stroke:green;stroke-width:0.3" wallLineStyle = style "stroke:green;stroke-width:0.1" x1Min = x1 <| toString 0 y1Min = y1 <| toString 0 x1Max = x1 <| toString model.cols y1Max = y1 <| toString model.rows x2Min = x2 <| toString 0 y2Min = y2 <| toString 0 x2Max = x2 <| toString model.cols y2Max = y2 <| toString model.rows borders = [ Svg.line [ x1Min, y1Min, x2Max, y2Min, borderLineStyle ] [] , Svg.line [ x1Max, y1Min, x2Max, y2Max, borderLineStyle ] [] , Svg.line [ x1Max, y1Max, x2Min, y2Max, borderLineStyle ] [] , Svg.line [ x1Min, y1Max, x2Min, y2Min, borderLineStyle ] [] ] doorToLine door = let (deltaX1, deltaY1) = if (snd door == right) then (1,0) else (0,1) (row, column) = fst door in Svg.line [ x1 <| toString (column + deltaX1) , y1 <| toString (row + deltaY1) , x2 <| toString (column + 1) , y2 <| toString (row + 1) , wallLineStyle ] [] doors = (List.map doorToLine <| Set.toList model.doors ) circleInBox (row,col) color = Svg.circle [ r "0.25" , fill (color) , cx (toString (toFloat col + 0.5)) , cy (toString (toFloat row + 0.5)) ] [] showUnvisited location box = if box then [] else [ circleInBox location "yellow" ] unvisited = model.boxes |> Matrix.mapWithLocation showUnvisited |> Matrix.flatten |> concat current = case head model.current of Nothing -> [] Just c -> [circleInBox c "black"] maze = if model.animate || model.state /= Generating then [ Svg.g [] <| doors ++ borders ++ unvisited ++ current ] else [ Svg.g [] <| borders ] in div [] [ h2 [centerTitle] [text "Maze Generator"] , div [floatLeft] ( slider "rows" minSide maxSide model.rows SetRows ++ [ br [] [] ] ++ slider "cols" minSide maxSide model.cols SetCols ++ [ br [] [] ] ++ checkbox "Animate" model.animate SetAnimate ++ [ br [] [] ] ++ [ button [ HE.onClick Generate ] [ text "Generate"] ] ) , div [floatLeft] [ Svg.svg [ version "1.1" , width (toString w) , height (toString h) , viewBox (join " " [ 0 |> toString , 0 |> toString , model.cols |> toString , model.rows |> toString ]) ] maze ] ] checkbox label checked msg = [ input [ HA.type' "checkbox" , HA.checked checked , HE.on "change" (JD.map msg HE.targetChecked) ] [] , text label ] slider name min max current msg = [ input [ HA.value (if current >= min then current |> toString else "") , HE.on "input" (JD.map msg HE.targetValue ) , HA.type' "range" , HA.min <| toString min , HA.max <| toString max ] [] , text <| name ++ "=" ++ (current |> toString) ] floatLeft = HA.style [ ("float", "left") ] centerTitle = HA.style [ ( "text-align", "center") ] unvisitedNeighbors : Model -> Matrix.Location -> List Matrix.Location unvisitedNeighbors model (row,col) = [(row, col-1), (row-1, col), (row, col+1), (row+1, col)] |> List.filter (\l -> fst l >= 0 && snd l >= 0 && fst l < model.rows && snd l < model.cols) |> List.filter (\l -> (Matrix.get l model.boxes) |> M.withDefault False |> not) updateModel' : Model -> Int -> Model updateModel' model t = case head model.current of Nothing -> {model | state = Generated, seedStarter = t } Just prev -> let neighbors = unvisitedNeighbors model prev in if (length neighbors) > 0 then let (neighborIndex, seed) = Random.step (Random.int 0 (length neighbors-1)) model.seed next = head (drop neighborIndex neighbors) |> M.withDefault (0,0) boxes = Matrix.set next True model.boxes dir = if fst prev == fst next then right else down doorCell = if ( (dir == down) && (fst prev < fst next)) || (dir == right ) && (snd prev < snd next) then prev else next doors = Set.remove (doorCell, dir) model.doors in {model | boxes=boxes, doors=doors, current=next :: model.current, seed=seed, seedStarter = t} else let tailCurrent = tail model.current |> M.withDefault [] in updateModel' {model | current = tailCurrent} t updateModel : Msg -> Model -> Model updateModel msg model = let stringToCellCount s = let v' = String.toInt s |> R.withDefault minSide in if v' < minSide then minSide else v' in case msg of Tick tf -> let t = truncate tf in if (model.state == Generating) then updateModel' model t else { model | seedStarter = t } Generate -> initModel model.rows model.cols model.animate Generating model.seedStarter SetRows countString -> initModel (stringToCellCount countString) model.cols model.animate Initial model.seedStarter SetCols countString -> initModel model.rows (stringToCellCount countString) model.animate Initial model.seedStarter SetAnimate b -> { model | animate = b } NoOp -> model type Msg = NoOp | Tick Time | Generate | SetRows String | SetCols String | SetAnimate Bool subscriptions model = every (dt * second) Tick main = let update msg model = (updateModel msg model, Cmd.none) init = (initModel 21 36 False Initial 0, Cmd.none) in program { init = init , view = view , update = update , subscriptions = subscriptions }