Browse Source

Upgrade to Elm 0.18

master
parent
commit
ddf84a9ceb
9 changed files with 349 additions and 261 deletions
  1. +28
    -26
      app/Main.elm
  2. +8
    -5
      app/Messages.elm
  3. +37
    -32
      app/Models.elm
  4. +30
    -19
      app/Ports.elm
  5. +18
    -21
      app/Routing.elm
  6. +48
    -32
      app/Update.elm
  7. +154
    -106
      app/Views.elm
  8. +21
    -15
      app/Wardrobes.elm
  9. +5
    -5
      elm-package.json

+ 28
- 26
app/Main.elm View File

@@ -1,7 +1,8 @@
module Main exposing (..)

import Navigation
import Dict
import List

import Routing
import Messages exposing (..)
import Models exposing (Model)
@@ -10,35 +11,36 @@ import Update
import Wardrobes exposing (initialWardrobe)
import Ports exposing (redrawDoll, redrawEvent, drawerContainerResponder, pngExportResponder)

main : Program Never

main : Program Never Model Msg
main =
Navigation.program Routing.parser
{ init = init
, view = Views.mainApplicationView
, update = Update.update
, urlUpdate = Update.urlUpdate
, subscriptions = subscriptions
}
Navigation.program UpdateLocation
{ init = init
, update = Update.update
, subscriptions = subscriptions
, view = Views.mainApplicationView
}

init : Result String Routing.Route -> (Model, Cmd Msg)
init result =

init : Navigation.Location -> ( Model, Cmd Msg )
init location =
let
route = Routing.routeFromResult result
model =
Model
route
initialWardrobe
(Dict.fromList [])
(case List.head initialWardrobe.drawers of
Just drawer -> Just drawer.id
Nothing -> Nothing)
"data:image/png;base64,"
model = { route = Routing.parseLocation location
, wardrobe = initialWardrobe
, selectedOutfit = (Dict.fromList [])
, selectedDrawer = (case List.head initialWardrobe.drawers of
Just drawer -> Just drawer.id
Nothing -> Nothing)
, dollAsDataURL = "data:image/png;base64,"
}
in
(model, redrawDoll (redrawEvent "final-doll" model))
( model
, redrawDoll (redrawEvent "final-doll" model)
)


subscriptions : Model -> Sub Msg
subscriptions model =
Sub.batch
[ drawerContainerResponder DrawerContainerResult
, pngExportResponder PngExportResult
]
Sub.batch [ drawerContainerResponder DrawerContainerResult
, pngExportResponder PngExportResult
]

+ 8
- 5
app/Messages.elm View File

@@ -1,11 +1,14 @@
module Messages exposing (..)

import Navigation
import Models exposing (..)
import Ports exposing (DrawerContainerInfo)


type Msg
= SelectPart String (Float, Float)
| SelectDrawerTab Drawer
| CalculateDrawerContainer String
| DrawerContainerResult DrawerContainerInfo
| PngExportResult String
= UpdateLocation Navigation.Location
| SelectPart String (Int, Int)
| SelectDrawerTab Drawer
| CalculateDrawerContainer String
| DrawerContainerResult DrawerContainerInfo
| PngExportResult String

+ 37
- 32
app/Models.elm View File

@@ -1,48 +1,53 @@
module Models exposing (..)

import Dict exposing (Dict)

import Routing


type alias Dimensions =
{ width : Int
, height : Int
}
{ width : Int
, height : Int
}


type alias SquareCoords =
{ x : Int
, y : Int
, width : Int
, height : Int
}
{ x : Int
, y : Int
, width : Int
, height : Int
}


type alias Drawer =
{ id : String
, name : String
, spriteUrl : String
, dimensions : Maybe Dimensions
, contentSquare : Maybe SquareCoords
}
{ id : String
, name : String
, spriteUrl : String
, dimensions : Maybe Dimensions
, contentSquare : Maybe SquareCoords
}


type alias Wardrobe =
{ id : String
, name : String
, dollWidth : Int
, dollHeight : Int
, spacerWidth : Int
, spacerHeight : Int
, drawers : List Drawer
}
{ id : String
, name : String
, dollWidth : Int
, dollHeight : Int
, spacerWidth : Int
, spacerHeight : Int
, drawers : List Drawer
}


type alias OutfitSelection =
{ drawerCol : Int
, drawerRow : Int
}
{ drawerCol : Int
, drawerRow : Int
}


type alias Model =
{ route : Routing.Route
, wardrobe : Wardrobe
, selectedOutfit : Dict String OutfitSelection
, selectedDrawer : Maybe String
, dollAsDataURL: String
}
{ route : Routing.Route
, wardrobe : Wardrobe
, selectedOutfit : Dict String OutfitSelection
, selectedDrawer : Maybe String
, dollAsDataURL : String
}

+ 30
- 19
app/Ports.elm View File

@@ -1,43 +1,54 @@
port module Ports exposing (redrawDoll, redrawEvent, calculateDrawerContainer, drawerContainerEvent, drawerContainerResponder, DrawerContainerInfo, pngExportResponder)

import Dict

import Models exposing (..)


type alias RedrawEvent =
{ dollCanvasId : String
, wardrobe : Wardrobe
, outfitSelections : List (String, OutfitSelection)
}
{ dollCanvasId : String
, wardrobe : Wardrobe
, outfitSelections : List ( String, OutfitSelection )
}


type alias DrawerContainerEvent =
{ drawerId : String
, partWidth : Int
, partHeight : Int
}
{ drawerId : String
, partWidth : Int
, partHeight : Int
}


type alias DrawerContainerInfo =
{ drawerId : String
, dimensions : Dimensions
, coords : SquareCoords
}
{ drawerId : String
, dimensions : Dimensions
, coords : SquareCoords
}


port redrawDoll : RedrawEvent -> Cmd msg


port calculateDrawerContainer : DrawerContainerEvent -> Cmd msg


port drawerContainerResponder : (DrawerContainerInfo -> msg) -> Sub msg


port pngExportResponder : (String -> msg) -> Sub msg


redrawEvent : String -> Model -> RedrawEvent
redrawEvent dollId model =
RedrawEvent dollId model.wardrobe (Dict.toList model.selectedOutfit)
RedrawEvent dollId model.wardrobe (Dict.toList model.selectedOutfit)


drawerContainerEvent : String -> Model -> DrawerContainerEvent
drawerContainerEvent drawerId model =
let
partWidth = model.wardrobe.dollWidth + model.wardrobe.spacerWidth
partHeight = model.wardrobe.dollHeight + model.wardrobe.spacerHeight
in
DrawerContainerEvent drawerId partWidth partHeight
let
partWidth =
model.wardrobe.dollWidth + model.wardrobe.spacerWidth

partHeight =
model.wardrobe.dollHeight + model.wardrobe.spacerHeight
in
DrawerContainerEvent drawerId partWidth partHeight

+ 18
- 21
app/Routing.elm View File

@@ -1,36 +1,33 @@
module Routing exposing (..)

import String
import Navigation
import UrlParser exposing (..)


type Route
= Index
-- | SectionIndex Int
-- | ItemDetail Int
| NotFoundRoute
= Index
| NotFoundRoute


matchers : Parser (Route -> a) a
matchers =
oneOf
[ format Index (s "")
]
oneOf
[ map Index (s "")
]


hashParser : Navigation.Location -> Result String Route
hashParser location =
location.hash
|> String.dropLeft 1
|> parse identity matchers
parseLocation : Navigation.Location -> Route
parseLocation location =
case (parsePath matchers location) of
Just route -> route
Nothing -> NotFoundRoute

parser : Navigation.Parser (Result String Route)
parser =
Navigation.makeParser hashParser

routeFromResult : Result String Route -> Route
routeFromResult result =
case result of
Ok route ->
route
case result of
Ok route ->
route

Err string ->
NotFoundRoute
Err string ->
NotFoundRoute

+ 48
- 32
app/Update.elm View File

@@ -1,71 +1,87 @@
module Update exposing (..)

import Dict exposing (Dict)

import Routing
import Messages exposing (..)
import Models exposing (Model, Wardrobe, OutfitSelection)
import Ports exposing (redrawDoll, redrawEvent, calculateDrawerContainer, drawerContainerEvent)

urlUpdate : Result String Routing.Route -> Model -> (Model, Cmd Msg)
urlUpdate result model =
let
currentRoute =
Routing.routeFromResult result
in
({ model | route = currentRoute }, Cmd.none)

calculateOutfitSel : Wardrobe -> (Float, Float) -> OutfitSelection
calculateOutfitSel : Wardrobe -> (Int, Int) -> OutfitSelection
calculateOutfitSel wardrobe offsets =
let
multiplierX = wardrobe.dollWidth + wardrobe.spacerWidth
multiplierY = wardrobe.dollHeight + wardrobe.spacerHeight
(offsetX, offsetY) = offsets
multiplierX =
wardrobe.dollWidth + wardrobe.spacerWidth

multiplierY =
wardrobe.dollHeight + wardrobe.spacerHeight

( offsetX, offsetY ) =
offsets
in
OutfitSelection (floor (offsetX / (toFloat multiplierX)))
(floor (offsetY / (toFloat multiplierY)))
OutfitSelection (offsetX // multiplierX) (offsetY // multiplierY)

toggleDictValue : String -> OutfitSelection -> Dict String OutfitSelection -> Dict String OutfitSelection
toggleDictValue key value dict =
case Dict.get key dict of
Just v ->
if v == value then Dict.remove key dict else Dict.insert key value dict
if v == value then
Dict.remove key dict
else
Dict.insert key value dict

_ ->
Dict.insert key value dict

update : Msg -> Model -> (Model, Cmd Msg)

update : Msg -> Model -> ( Model, Cmd Msg )
update msg model =
case msg of
UpdateLocation newLocation ->
( { model | route = Routing.parseLocation newLocation }, Cmd.none )

SelectPart drawerId offsets ->
let
initialSel = model.selectedOutfit
updatedSel = toggleDictValue drawerId (calculateOutfitSel model.wardrobe offsets) initialSel
updatedModel = { model | selectedOutfit = updatedSel }
updatedSel =
toggleDictValue
drawerId
(calculateOutfitSel model.wardrobe offsets)
model.selectedOutfit

updatedModel =
{ model | selectedOutfit = updatedSel }
in
(updatedModel, redrawDoll (redrawEvent "final-doll" updatedModel))
( updatedModel, redrawDoll (redrawEvent "final-doll" updatedModel) )

SelectDrawerTab drawer ->
({ model | selectedDrawer = Just drawer.id }, Cmd.none)
( { model | selectedDrawer = Just drawer.id }, Cmd.none )

CalculateDrawerContainer drawerId ->
(model, calculateDrawerContainer (drawerContainerEvent drawerId model))
( model, calculateDrawerContainer (drawerContainerEvent drawerId model) )

DrawerContainerResult resp ->
let
modifiedDrawers =
List.map
(\d ->
if d.id == resp.drawerId then
{ d |
dimensions = Just resp.dimensions,
contentSquare = Just resp.coords }
else
d)
if d.id == resp.drawerId then
{ d
| dimensions = Just resp.dimensions
, contentSquare = Just resp.coords
}
else
d
)
model.wardrobe.drawers
initialWardrobe = model.wardrobe
modifiedWardrobe = { initialWardrobe | drawers = modifiedDrawers }

initialWardrobe =
model.wardrobe

modifiedWardrobe =
{ initialWardrobe | drawers = modifiedDrawers }
in
({ model | wardrobe = modifiedWardrobe }, Cmd.none)
( { model | wardrobe = modifiedWardrobe }, Cmd.none )

PngExportResult dataUrl ->
({ model | dollAsDataURL = dataUrl }, Cmd.none)
( { model | dollAsDataURL = dataUrl }, Cmd.none )

+ 154
- 106
app/Views.elm View File

@@ -5,131 +5,179 @@ import Json.Decode as Json exposing (..)
import Html exposing (Html, div, header, canvas, img, a, text, pre)
import Html.Attributes exposing (id, class, downloadAs, style, width, height, src, href)
import Html.Events exposing (on, onClick)

import Models exposing (..)
import Messages exposing (..)

drawerParts : String -> String -> Dimensions -> (Int, Int) -> SquareCoords -> (Int, Int) -> List (Html Msg)

drawerParts : String -> String -> Dimensions -> ( Int, Int ) -> SquareCoords -> ( Int, Int ) -> List (Html Msg)
drawerParts drawerId spriteUrl spriteDimensions dollSize partSquare offset =
if (snd offset) >= spriteDimensions.height then
[]
else
let
offsetX = partSquare.x + (fst offset) - 1
offsetY = partSquare.y + (snd offset) - 1
nextHorizontalOffset = (fst offset) + (fst dollSize)
nextOffset = if nextHorizontalOffset >= spriteDimensions.width then
(0, (snd offset) + (snd dollSize))
else
(nextHorizontalOffset, (snd offset))
in
List.append
[ div [ class "drawer-part"
, style [ ("width", (toString (max 50 partSquare.width)) ++ "px")
, ("height", (toString (max 50 partSquare.height)) ++ "px")
]
, onClick (SelectPart drawerId offset)
]
[ div [ style [ ("width", (toString partSquare.width) ++ "px")
, ("height", (toString partSquare.height) ++ "px")
, ("background-image", "url('" ++ spriteUrl ++ "')")
, ("background-repeat", "no-repeat")
, ("background-position", "-" ++ (toString offsetX) ++ "px -" ++ (toString offsetY) ++ "px")
]
]
[]
]
]
(drawerParts
drawerId
spriteUrl
spriteDimensions
dollSize
partSquare
nextOffset)
if (Tuple.second offset) >= spriteDimensions.height then
[]
else
let
offsetX =
partSquare.x + (Tuple.first offset) - 1

offsetY =
partSquare.y + (Tuple.second offset) - 1

nextHorizontalOffset =
(Tuple.first offset) + (Tuple.first dollSize)

nextOffset =
if nextHorizontalOffset >= spriteDimensions.width then
( 0, (Tuple.second offset) + (Tuple.second dollSize) )
else
( nextHorizontalOffset, (Tuple.second offset) )
in
List.append
[ div
[ class "drawer-part"
, style
[ ( "width", (toString (max 50 partSquare.width)) ++ "px" )
, ( "height", (toString (max 50 partSquare.height)) ++ "px" )
]
, onClick (SelectPart drawerId offset)
]
[ div
[ style
[ ( "width", (toString partSquare.width) ++ "px" )
, ( "height", (toString partSquare.height) ++ "px" )
, ( "background-image", "url('" ++ spriteUrl ++ "')" )
, ( "background-repeat", "no-repeat" )
, ( "background-position", "-" ++ (toString offsetX) ++ "px -" ++ (toString offsetY) ++ "px" )
]
]
[]
]
]
(drawerParts
drawerId
spriteUrl
spriteDimensions
dollSize
partSquare
nextOffset
)


drawerView : Wardrobe -> Drawer -> Html Msg
drawerView wardrobe drawer =
let
drawerImageUrl = "wardrobes/" ++ wardrobe.id ++ "/" ++ drawer.spriteUrl
partWidth = wardrobe.dollWidth + wardrobe.spacerWidth
partHeight = wardrobe.dollHeight + wardrobe.spacerHeight
in
case drawer.contentSquare of
Just square ->
case drawer.dimensions of
Just dimensions ->
div [ class "parts" ]
(drawerParts drawer.id drawerImageUrl dimensions (partWidth, partHeight) square (0, 0))
Nothing ->
text "Internal error: found contentSquare but not dimensions"
Nothing ->
img [ style [ ("display", "none") ]
, src drawerImageUrl
, on "load" (Json.succeed (CalculateDrawerContainer drawer.id))
] []
let
drawerImageUrl =
"wardrobes/" ++ wardrobe.id ++ "/" ++ drawer.spriteUrl

partWidth =
wardrobe.dollWidth + wardrobe.spacerWidth

partHeight =
wardrobe.dollHeight + wardrobe.spacerHeight
in
case drawer.contentSquare of
Just square ->
case drawer.dimensions of
Just dimensions ->
div [ class "parts" ]
(drawerParts drawer.id drawerImageUrl dimensions ( partWidth, partHeight ) square ( 0, 0 ))

Nothing ->
text "Internal error: found contentSquare but not dimensions"

Nothing ->
img
[ style [ ( "display", "none" ) ]
, src drawerImageUrl
, on "load" (Json.succeed (CalculateDrawerContainer drawer.id))
]
[]


drawerTabView : Maybe String -> Drawer -> Html Msg
drawerTabView maybeDrawerId drawer =
let
extraClass = case maybeDrawerId of
Just id -> if drawer.id == id then " active" else ""
Nothing -> ""
in
div [ class ("drawer-tab" ++ extraClass)
, onClick (SelectDrawerTab drawer)
]
[ text drawer.name ]
let
extraClass =
case maybeDrawerId of
Just id ->
if drawer.id == id then
" active"
else
""

Nothing ->
""
in
div
[ class ("drawer-tab" ++ extraClass)
, onClick (SelectDrawerTab drawer)
]
[ text drawer.name ]


drawerSourceImageView : Wardrobe -> Drawer -> Html Msg
drawerSourceImageView wardrobe drawer =
img [ id drawer.id
, src ("wardrobes/" ++ wardrobe.id ++ "/" ++ drawer.spriteUrl)
] []
img
[ id drawer.id
, src ("wardrobes/" ++ wardrobe.id ++ "/" ++ drawer.spriteUrl)
]
[]


wardrobeView : Wardrobe -> Maybe String -> Html Msg
wardrobeView wardrobe maybeDrawerId =
let
drawerTabList = List.map (drawerTabView maybeDrawerId) wardrobe.drawers
drawerSourceImages = List.map (drawerSourceImageView wardrobe) wardrobe.drawers
in
div [ class "wardrobe-content" ]
[ div [ class "drawer-tabs" ] drawerTabList
, div [ class "drawer-content" ]
[ case maybeDrawerId of
Just selectedDrawerId ->
case List.head (List.filter (\d -> d.id == selectedDrawerId) wardrobe.drawers) of
Just selectedDrawer -> drawerView wardrobe selectedDrawer
Nothing -> text "error!"
Nothing ->
(case List.head wardrobe.drawers of
Just firstDrawer ->
drawerView wardrobe firstDrawer
Nothing ->
text "")
]
, div [ class "drawer-source-images" ] drawerSourceImages
]
let
drawerTabList =
List.map (drawerTabView maybeDrawerId) wardrobe.drawers

drawerSourceImages =
List.map (drawerSourceImageView wardrobe) wardrobe.drawers
in
div [ class "wardrobe-content" ]
[ div [ class "drawer-tabs" ] drawerTabList
, div [ class "drawer-content" ]
[ case maybeDrawerId of
Just selectedDrawerId ->
case List.head (List.filter (\d -> d.id == selectedDrawerId) wardrobe.drawers) of
Just selectedDrawer ->
drawerView wardrobe selectedDrawer

Nothing ->
text "error!"

Nothing ->
(case List.head wardrobe.drawers of
Just firstDrawer ->
drawerView wardrobe firstDrawer

Nothing ->
text ""
)
]
, div [ class "drawer-source-images" ] drawerSourceImages
]


mainApplicationView : Model -> Html Msg
mainApplicationView model =
div []
[ header []
[ div [ class "site-title" ] [ text "Prexxer" ]
, div [ class "wardrobe-title" ] [ text ("Wardrobe: " ++ model.wardrobe.name) ]
]
, div [ class "content" ]
[ div [ class "result-container" ]
[ canvas [ id "final-doll"
, width model.wardrobe.dollWidth
, height model.wardrobe.dollHeight
] []
, a [ class "button"
, downloadAs "doll.png"
, href model.dollAsDataURL
div []
[ header []
[ div [ class "site-title" ] [ text "Prexxer" ]
, div [ class "wardrobe-title" ] [ text ("Wardrobe: " ++ model.wardrobe.name) ]
]
, div [ class "content" ]
[ div [ class "result-container" ]
[ canvas
[ id "final-doll"
, width model.wardrobe.dollWidth
, height model.wardrobe.dollHeight
]
[]
, a
[ class "button"
, downloadAs "doll.png"
, href model.dollAsDataURL
]
[ text "Export" ]
]
[ text "Export" ]
, wardrobeView model.wardrobe model.selectedDrawer
]
, wardrobeView model.wardrobe model.selectedDrawer
]
]

+ 21
- 15
app/Wardrobes.elm View File

@@ -2,20 +2,26 @@ module Wardrobes exposing (..)

import Models exposing (..)


initialWardrobe : Wardrobe
initialWardrobe =
Wardrobe "pixel-people" "Pixel People" 64 112 4 4
[ Drawer "skins" "Skins" "Sprite Sheet - Skin.png" Nothing Nothing
, Drawer "eyes" "Eyes" "Sprite Sheet - Eyes.png" Nothing Nothing
, Drawer "hair" "Hair" "Sprite Sheet - Hair.png" Nothing Nothing
, Drawer "hair2" "Hair 2" "extras2/Hair Sprite Sheet.png" Nothing Nothing
, Drawer "hats" "Hats" "extras2/Hats Sprite Sheet.png" Nothing Nothing
, Drawer "tops" "Tops" "Sprite Sheet - Tops.png" Nothing Nothing
, Drawer "tops2" "Tops 2" "extras/Tops.png" Nothing Nothing
, Drawer "tops3" "Tops 3" "extras2/Tops Sprite Sheet.png" Nothing Nothing
, Drawer "bottoms" "Bottoms" "Sprite Sheet - Bottoms.png" Nothing Nothing
, Drawer "bottoms2" "Bottoms 2" "extras/Bottoms.png" Nothing Nothing
, Drawer "facial-hair" "Facial Hair" "extras/Facial Hair.png" Nothing Nothing
, Drawer "facial-hair2" "Facial Hair 2" "extras2/Facial Hair Sprite Sheet.png" Nothing Nothing
, Drawer "shoes" "Shoes" "Sprite Sheet - Shoes.png" Nothing Nothing
]
Wardrobe "pixel-people"
"Pixel People"
64
112
4
4
[ Drawer "skins" "Skins" "Sprite Sheet - Skin.png" Nothing Nothing
, Drawer "eyes" "Eyes" "Sprite Sheet - Eyes.png" Nothing Nothing
, Drawer "hair" "Hair" "Sprite Sheet - Hair.png" Nothing Nothing
, Drawer "hair2" "Hair 2" "extras2/Hair Sprite Sheet.png" Nothing Nothing
, Drawer "hats" "Hats" "extras2/Hats Sprite Sheet.png" Nothing Nothing
, Drawer "tops" "Tops" "Sprite Sheet - Tops.png" Nothing Nothing
, Drawer "tops2" "Tops 2" "extras/Tops.png" Nothing Nothing
, Drawer "tops3" "Tops 3" "extras2/Tops Sprite Sheet.png" Nothing Nothing
, Drawer "bottoms" "Bottoms" "Sprite Sheet - Bottoms.png" Nothing Nothing
, Drawer "bottoms2" "Bottoms 2" "extras/Bottoms.png" Nothing Nothing
, Drawer "facial-hair" "Facial Hair" "extras/Facial Hair.png" Nothing Nothing
, Drawer "facial-hair2" "Facial Hair 2" "extras2/Facial Hair Sprite Sheet.png" Nothing Nothing
, Drawer "shoes" "Shoes" "Sprite Sheet - Shoes.png" Nothing Nothing
]

+ 5
- 5
elm-package.json View File

@@ -8,10 +8,10 @@
],
"exposed-modules": [],
"dependencies": {
"elm-lang/core": "4.0.1 <= v < 5.0.0",
"elm-lang/html": "1.1.0 <= v < 2.0.0",
"elm-lang/navigation": "1.0.0 <= v < 2.0.0",
"evancz/url-parser": "1.0.0 <= v < 2.0.0"
"elm-lang/core": "5.1.1 <= v < 6.0.0",
"elm-lang/html": "2.0.0 <= v < 3.0.0",
"elm-lang/navigation": "2.1.0 <= v < 3.0.0",
"evancz/url-parser": "2.0.1 <= v < 3.0.0"
},
"elm-version": "0.17.1 <= v < 0.18.0"
"elm-version": "0.18.0 <= v < 0.19.0"
}

Loading…
Cancel
Save