132 src/Components/Dialog.elm
View file
@@ -1,20 +1,22 @@
module Components.Dialog exposing
( Msg, OutMsg(..)
, Model, model
, view, update
, toggleOpen
)
module Components.Dialog
exposing
( Msg
, OutMsg(..)
, Model
, model
, view
, update
, toggleOpen
)

import Html exposing (Html, div, p, label, input, text)
import Html.Attributes exposing (class, classList, type', value)
import Html.Events exposing (onInput, onClick)
import Html.App as App

import Components.Config as Config
import Components.Utils as Utils



-- MESSAGES


@@ -23,16 +25,23 @@ type UpdateInput
| UpdateColumns String
| UpdateMines String


type Button
= OK
| Cancel


type Msg
= UpdateMsg UpdateInput
| ButtonMsg Button



-- for communication child -> parent
type OutMsg = SaveCustomLevel


type OutMsg
= SaveCustomLevel



@@ -46,27 +55,31 @@ type alias Model =
, mines : Int
}


model : Model
model =
model =
{ open = False
, rows = .rows Config.model
, columns = .columns Config.model
, mines = .mines Config.model
}



-- VIEW


view : Model -> Html Msg
view model =
div [ classList
[ ("custom-level-dialog window-wrapper-outer", True)
, ("open", model.open)
div
[ classList
[ ( "custom-level-dialog window-wrapper-outer", True )
, ( "open", model.open )
]
]
]
[ div [ class "window-wrapper-inner" ]
[ div [ class "window-container" ]
[ div [ class "title-bar"] []
[ div [ class "title-bar" ] []
, div [ class "content" ]
[ App.map UpdateMsg <| viewFields model
, App.map ButtonMsg viewButtons
@@ -75,67 +88,81 @@ view model =
]
]


viewFields : Model -> Html UpdateInput
viewFields model =
div [ class "fields" ]
[ p []
[ label [] [ text "Height:"]
, input [ class "form-textbox custom-height"
, type' "text"
, value (toString model.rows)
, onInput UpdateRows
] []
[ label [] [ text "Height:" ]
, input
[ class "form-textbox custom-height"
, type' "text"
, value (toString model.rows)
, onInput UpdateRows
]
[]
]
, p []
[ label [] [ text "Width:"]
, input [ class "form-textbox custom-width"
, type' "text"
, value (toString model.columns)
, onInput UpdateColumns
] []
[ label [] [ text "Width:" ]
, input
[ class "form-textbox custom-width"
, type' "text"
, value (toString model.columns)
, onInput UpdateColumns
]
[]
]
, p []
[ label [] [ text "Mines:"]
, input [ class "form-textbox custom-mines"
, type' "text"
, value (toString model.mines)
, onInput UpdateMines
] []
[ label [] [ text "Mines:" ]
, input
[ class "form-textbox custom-mines"
, type' "text"
, value (toString model.mines)
, onInput UpdateMines
]
[]
]
]


viewButtons : Html Button
viewButtons =
div [ class "buttons" ]
[ input [ class "form-button ok-btn"
, type' "button"
, value "OK"
, onClick OK
] []
, input [ class "form-button cancel-btn"
, type' "button"
, value "Cancel"
, onClick Cancel
] []
[ input
[ class "form-button ok-btn"
, type' "button"
, value "OK"
, onClick OK
]
[]
, input
[ class "form-button cancel-btn"
, type' "button"
, value "Cancel"
, onClick Cancel
]
[]
]



-- UPDATE


update : Msg -> Model -> (Model, Maybe OutMsg)
update : Msg -> Model -> ( Model, Maybe OutMsg )
update msg model =
case msg of
UpdateMsg updateInput ->
(updateFields updateInput model, Nothing)
( updateFields updateInput model, Nothing )

ButtonMsg button ->
let
newModel = toggleOpen model
newModel =
toggleOpen model
in
updateButton button newModel


updateFields : UpdateInput -> Model -> Model
updateFields updateInput model =
case updateInput of
@@ -148,14 +175,15 @@ updateFields updateInput model =
UpdateMines mines ->
{ model | mines = Utils.toInt mines }

updateButton : Button -> Model -> (Model, Maybe OutMsg)

updateButton : Button -> Model -> ( Model, Maybe OutMsg )
updateButton buttonMsg model =
case buttonMsg of
OK ->
(model, Just SaveCustomLevel)
case buttonMsg of
OK ->
( model, Just SaveCustomLevel )

Cancel ->
(model, Nothing)
Cancel ->
( model, Nothing )



99 src/Components/Game.elm
View file
@@ -4,14 +4,12 @@ import Html exposing (Html, div, text)
import Html.Attributes exposing (class, classList)
import Html.Events exposing (onClick)
import Html.App as App

import Components.Config as Config
import Components.Dialog as Dialog
import Components.Board as Board
import Components.Menu as Menu



-- MESSAGES


@@ -31,8 +29,9 @@ type alias Model =
, board : Board.Model
}


model : Model
model =
model =
{ config = Config.model
, dialog = Dialog.model
, board = Board.model
@@ -51,44 +50,51 @@ view model =
, App.map BoardMsg <| Board.view model.board model.config
]


viewClickerAway : Model -> Html Msg
viewClickerAway model =
div [ classList
[ ("clicker-away", True)
, ("ready", model.board.menu.open)
], onClick ClickAway ] []
div
[ classList
[ ( "clicker-away", True )
, ( "ready", model.board.menu.open )
]
, onClick ClickAway
]
[]



-- UPDATE


update : Msg -> Model -> (Model, Cmd Msg)
update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
DialogMsg dialogMsg ->
let
( dialogModel
, dialogOutMsg
) = Dialog.update dialogMsg model.dialog
( dialogModel, dialogOutMsg ) =
Dialog.update dialogMsg model.dialog

newModel = { model | dialog = dialogModel }
newModel =
{ model | dialog = dialogModel }
in
(processDialogOutMsg dialogOutMsg newModel dialogModel, Cmd.none)
( processDialogOutMsg dialogOutMsg newModel dialogModel, Cmd.none )

BoardMsg boardMsg ->
let
( boardModel
, boardOutMsg
) = Board.update boardMsg model.board model.config
( boardModel, boardOutMsg ) =
Board.update boardMsg model.board model.config

newModel = { model | board = boardModel }
newModel =
{ model | board = boardModel }
in
(processBoardOutMsg boardOutMsg newModel, Cmd.none)
( processBoardOutMsg boardOutMsg newModel, Cmd.none )

ClickAway ->
if model.board.menu.open then
update (BoardMsg Board.ToggleMenu) model
else
(model, Cmd.none)
( model, Cmd.none )



@@ -107,21 +113,24 @@ subscriptions model =
processDialogOutMsg : Maybe Dialog.OutMsg -> Model -> Dialog.Model -> Model
processDialogOutMsg dialogOutMsg model dialogModel =
case dialogOutMsg of
Just Dialog.SaveCustomLevel ->
let newConfig = Config.customLevel
model.config
dialogModel.mines
dialogModel.rows
dialogModel.columns
Just (Dialog.SaveCustomLevel) ->
let
newConfig =
Config.customLevel
model.config
dialogModel.mines
dialogModel.rows
dialogModel.columns
in
{ model |
config = newConfig,
board = Board.createMinefield model.board newConfig
{ model
| config = newConfig
, board = Board.createMinefield model.board newConfig
}

Nothing ->
model


processBoardOutMsg : Maybe Board.OutMsg -> Model -> Model
processBoardOutMsg boardOutMsg model =
case boardOutMsg of
@@ -131,6 +140,7 @@ processBoardOutMsg boardOutMsg model =
Nothing ->
model


processMenuMsg : Menu.Msg -> Model -> Model
processMenuMsg menuMsg model =
case menuMsg of
@@ -139,33 +149,40 @@ processMenuMsg menuMsg model =

Menu.BeginnerLevel ->
let
newConfig = Config.beginnerLevel model.config
newConfig =
Config.beginnerLevel model.config
in
{ model |
config = newConfig,
board = Board.createMinefield model.board newConfig
{ model
| config = newConfig
, board = Board.createMinefield model.board newConfig
}

Menu.IntermediateLevel ->
let
newConfig = Config.intermediateLevel model.config
newConfig =
Config.intermediateLevel model.config
in
{ model |
config = newConfig,
board = Board.createMinefield model.board newConfig
{ model
| config = newConfig
, board = Board.createMinefield model.board newConfig
}

Menu.ExpertLevel ->
let
newConfig = Config.expertLevel model.config
newConfig =
Config.expertLevel model.config
in
{ model |
config = newConfig,
board = Board.createMinefield model.board newConfig
{ model
| config = newConfig
, board = Board.createMinefield model.board newConfig
}

Menu.CustomLevel ->
{ model | dialog = Dialog.toggleOpen model.dialog }

Menu.CheckMarks ->
model
let
newConfig =
Config.toggleMarks model.config
in
{ model | config = newConfig }
72 src/Components/Header.elm
View file
@@ -1,24 +1,26 @@
module Components.Header exposing
( Msg(..), Face(..)
, Model, model
, view
, update
)
module Components.Header
exposing
( Msg(..)
, Face(..)
, Model
, model
, view
, update
)

import Html exposing (Html, div)
import Html.Attributes exposing (class)
import Html.Events exposing
( onMouseDown
, onMouseUp
, onMouseLeave
, onClick
)
import Html.Events
exposing
( onMouseDown
, onMouseUp
, onMouseLeave
, onClick
)
import String exposing (padLeft, slice)

import Components.Config as Config



-- MESSAGES


@@ -28,13 +30,15 @@ type Msg
| FaceLeave
| ResetGame


type Face
= Smile
| Pressed
| Surprised
| Sad



-- MODEL


@@ -43,6 +47,7 @@ type alias Model =
, face : Face
}


model : Model
model =
{ timer = 0
@@ -55,7 +60,7 @@ model =


view : Model -> Config.Model -> Html Msg
view model config =
view model config =
div [ class "header-wrapper" ]
[ div [ class "header-container" ]
[ div [ class "header" ]
@@ -66,17 +71,20 @@ view model config =
]
]


viewMineCount : Model -> Config.Model -> Html Msg
viewMineCount model config =
let
(hundres, tens, ones) = getDigits config.mines
( hundres, tens, ones ) =
getDigits config.mines
in
div [ class "mine-count numbers" ]
[ div [ class <| "digit hundres t" ++ hundres ] []
, div [ class <| "digit tens t" ++ tens ] []
, div [ class <| "digit ones t" ++ ones ] []
]


viewFace : Face -> Html Msg
viewFace face =
div
@@ -85,12 +93,15 @@ viewFace face =
, onMouseUp FaceUp
, onMouseLeave FaceLeave
, onClick ResetGame
] []
]
[]


viewTimer : Int -> Html Msg
viewTimer timer =
let
(hundres, tens, ones) = getDigits timer
( hundres, tens, ones ) =
getDigits timer
in
div [ class "timer numbers" ]
[ div [ class <| "digit hundres t" ++ hundres ] []
@@ -126,22 +137,31 @@ update msg model =
-- Helpers


getDigits : Int -> (String, String, String)
getDigits : Int -> ( String, String, String )
getDigits num =
let
digits = num
|> toString
|> padLeft 3 '0'
digits =
num
|> toString
|> padLeft 3 '0'
in
( slice 0 1 digits
, slice 1 2 digits
, slice 2 3 digits
)


typeFace : Face -> String
typeFace face =
case face of
Smile -> "smile"
Pressed -> "pressed"
Surprised -> "surprised"
Sad -> "sad"
Smile ->
"smile"

Pressed ->
"pressed"

Surprised ->
"surprised"

Sad ->
"sad"
94 src/Components/Menu.elm
View file
@@ -1,18 +1,19 @@
module Components.Menu exposing
( Msg(..)
, Model, model
, view, update
, toggleOpen
)
module Components.Menu
exposing
( Msg(..)
, Model
, model
, view
, update
, toggleOpen
)

import Html exposing (Html, ul, li, text)
import Html.Attributes exposing (class, classList)
import Html.Events exposing (onClick)

import Components.Config as Config



-- MESSAGES


@@ -25,48 +26,71 @@ type Msg
| CheckMarks



-- MODEL


type alias Model =
{ open : Bool }


model : Model
model =
model =
{ open = False
}



-- VIEW


view : Model -> Config.Model -> Html Msg
view model config =
ul [ classList [ ("menu", True), ("open", model.open) ] ]
[ li [ class "menu-new", onClick NewGame ] [ text "New" ]
, li [ class "menu-divider" ] []
, li [ classList
[ ("game-level menu-beginner", True)
, ("checked", Config.isBeginnerLevel config.level)
], onClick BeginnerLevel ] [ text "Beginner" ]
, li [ classList
[ ("game-level menu-intermediate", True)
, ("checked", Config.isIntermediateLevel config.level)
], onClick IntermediateLevel ] [ text "Intermediate" ]
, li [ classList
[ ("game-level menu-expert", True)
, ("checked", Config.isExpertLevel config.level)
], onClick ExpertLevel ] [ text "Expert" ]
, li [ classList
[ ("game-level menu-custom", True)
, ("checked", Config.isCustomLevel config.level)
], onClick CustomLevel ] [ text "Custom..." ]
, li [ class "menu-divider" ] []
, li [ classList
[ ("menu-marks", True)
, ("checked", config.marks)
], onClick CheckMarks ] [ text "Marks (?)" ]
]
ul [ classList [ ( "menu", True ), ( "open", model.open ) ] ]
[ li [ class "menu-new", onClick NewGame ] [ text "New" ]
, li [ class "menu-divider" ] []
, li
[ classList
[ ( "game-level menu-beginner", True )
, ( "checked", Config.isBeginnerLevel config.level )
]
, onClick BeginnerLevel
]
[ text "Beginner" ]
, li
[ classList
[ ( "game-level menu-intermediate", True )
, ( "checked", Config.isIntermediateLevel config.level )
]
, onClick IntermediateLevel
]
[ text "Intermediate" ]
, li
[ classList
[ ( "game-level menu-expert", True )
, ( "checked", Config.isExpertLevel config.level )
]
, onClick ExpertLevel
]
[ text "Expert" ]
, li
[ classList
[ ( "game-level menu-custom", True )
, ( "checked", Config.isCustomLevel config.level )
]
, onClick CustomLevel
]
[ text "Custom..." ]
, li [ class "menu-divider" ] []
, li
[ classList
[ ( "menu-marks", True )
, ( "checked", config.marks )
]
, onClick CheckMarks
]
[ text "Marks (?)" ]
]



@@ -84,4 +108,4 @@ update msg model =

toggleOpen : Model -> Model
toggleOpen model =
{ model | open = not model.open }
{ model | open = not model.open }
14 src/Components/Minefield.elm
View file
@@ -4,39 +4,44 @@ import Html exposing (Html, div)
import Html.Attributes exposing (class)
import List exposing (repeat, length, map)
import Html.App as App

import Components.Config as Config
import Components.Cell as Cell



-- MESSAGES


type Msg
= CellMsg Cell.Msg



-- MODEL


type alias Model =
List (List Cell.Model)


model : Model
model = create Config.model
model =
create Config.model



-- VIEW


view : Model -> Html Msg
view model =
div [ class "minefield" ] <| map viewRowCells model


viewRowCells : List Cell.Model -> Html Msg
viewRowCells cells =
div [ class "row" ] <| map viewCell cells


viewCell : Cell.Model -> Html Msg
viewCell cell =
App.map CellMsg <| Cell.view cell
@@ -45,8 +50,9 @@ viewCell cell =

-- Helpers


create : Config.Model -> List (List Cell.Model)
create config =
Cell.model
|> repeat (.columns config)
|> repeat (.rows config)
|> repeat (.rows config)
7 src/Components/Utils.elm
View file
@@ -4,9 +4,8 @@ import String
import Result



toInt : String -> Int
toInt strNum =
strNum
|> String.toInt
|> Result.withDefault 0
strNum
|> String.toInt
|> Result.withDefault 0
9 src/Main.elm
View file
@@ -1,11 +1,14 @@
module Main exposing (..)

import Html.App exposing (program)
import Components.Game as Game


main : Program Never
main =
program
{ init = (Game.model, Cmd.none)
program
{ init = ( Game.model, Cmd.none )
, view = Game.view
, update = Game.update
, subscriptions = Game.subscriptions
}
}