Last active
May 3, 2018 20:58
-
-
Save danneu/164f854fb2212d2f4d82d493d477eb4c to your computer and use it in GitHub Desktop.
my ellie apps
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
<html> | |
<head> | |
<link href="https://cdnjs.cloudflare.com/ajax/libs/meyer-reset/2.0/reset.min.css" rel="stylesheet" /> | |
<style> | |
.quilt { | |
margin: 100px auto; | |
} | |
ul { | |
display: inline-block; | |
vertical-align: top; | |
} | |
li { | |
display: block; | |
} | |
.controls { | |
padding-top: 50px; | |
width: 100%; | |
position: fixed; | |
top: 0; | |
left: 0; | |
text-align: center; | |
background-color: rgba(0,0,0,0.5); | |
} | |
</style> | |
</head> | |
<body> | |
<script> | |
var flags = { seed: Date.now() } | |
var app = Elm.Main.fullscreen(flags) | |
// you can use ports and stuff here | |
</script> | |
</body> | |
</html> |
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
module Main exposing (main) | |
import Array.Hamt as Array exposing (Array) | |
import Html exposing (..) | |
import Html.Attributes exposing (..) | |
import Html.Events | |
import Random | |
-- QUILT LIBRARY -- | |
{-| The goal of the config object is to let the user | |
store anything in quilt but provide accessors to pull | |
data out that quilt needs. | |
-} | |
type alias Config a = | |
{ getId : a -> String | |
, getWidth : a -> Int | |
, getHeight : a -> Int | |
} | |
type alias Quilt a = | |
{ width : Int | |
, columns : Array (Array a) | |
} | |
clear : Quilt a -> Quilt a | |
clear quilt = | |
empty quilt.width (Array.length quilt.columns) | |
empty : Int -> Int -> Quilt a | |
empty width columnCount = | |
{ width = width | |
, columns = | |
Array.initialize | |
(Basics.max 1 columnCount) | |
(\_ -> Array.empty) | |
} | |
columnCount : Quilt a -> Int | |
columnCount { columns } = | |
Array.length columns | |
{-| Get the width of each quilt column. | |
-} | |
columnWidth : Quilt a -> Int | |
columnWidth { width, columns } = | |
width // Array.length columns | |
{-| Scale an image's height to a given width. | |
-} | |
scaleHeight : Config a -> Int -> a -> Int | |
scaleHeight { getHeight, getWidth } colWidth item = | |
let | |
scaledHeight = | |
colWidth * getHeight item // getWidth item | |
in | |
scaledHeight | |
scaledDimensions : Config a -> a -> Quilt a -> ( Int, Int ) | |
scaledDimensions config item quilt = | |
let | |
scaledWidth = | |
columnWidth quilt | |
scaledHeight = | |
scaleHeight config scaledWidth item | |
in | |
( scaledWidth, scaledHeight ) | |
{-| Returns the column with the shortest height | |
after adding up all of its image heights. | |
-} | |
shortestColumnIdx : Config a -> Quilt a -> Int | |
shortestColumnIdx config quilt = | |
let | |
colWidth = | |
columnWidth quilt | |
in | |
quilt.columns | |
|> Array.indexedMap | |
(\idx column -> | |
let | |
columnHeight = | |
Array.foldl | |
(\item acc -> | |
scaleHeight config colWidth item + acc | |
) | |
0 | |
column | |
in | |
( idx, columnHeight ) | |
) | |
|> Array.foldl | |
(\( idx, height ) ( accIdx, accHeight ) -> | |
if height < accHeight then | |
( idx, height ) | |
else | |
( accIdx, accHeight ) | |
) | |
( 0, 99999999999999999 ) | |
|> (\( idx, _ ) -> idx) | |
{-| Insert an item into the quilt's shortest column. | |
-} | |
insert : Config a -> a -> Quilt a -> Quilt a | |
insert config item quilt = | |
let | |
columnIdx = | |
shortestColumnIdx config quilt | |
newColumn = | |
Array.get columnIdx quilt.columns | |
|> (\maybe -> | |
case maybe of | |
Just a -> | |
a | |
Nothing -> | |
Debug.crash "Impossible" | |
) | |
|> Array.push item | |
in | |
{ quilt | |
| columns = | |
quilt.columns |> Array.set columnIdx newColumn | |
} | |
toArray : Quilt a -> Array a | |
toArray { columns } = | |
Array.foldl | |
Array.append | |
Array.empty | |
columns | |
{-| Resizes quilt into given number of columns. | |
Does nothing if column count < 1. | |
Awful implementation. | |
-} | |
resize : Config a -> Int -> Quilt a -> Quilt a | |
resize config newColCount quilt = | |
let | |
oldColCount = | |
Array.length quilt.columns | |
in | |
if newColCount < 1 || oldColCount == newColCount then | |
quilt | |
else | |
Array.foldl | |
(insert config) | |
(empty quilt.width newColCount) | |
(toArray quilt) | |
-- APPLICATION CODE -- | |
type alias Image = | |
{ id : Int | |
, width : Int | |
, height : Int | |
, url : String | |
} | |
type alias Flags = | |
{ seed : Int } | |
type alias Model = | |
{ quilt : Quilt Image | |
, prevId : Int | |
, seed : Random.Seed | |
} | |
type Msg | |
= NoOp | |
| AddImage | |
| Clear | |
| RemoveColumn | |
| AddColumn | |
config : Config Image | |
config = | |
{ getId = .id >> toString | |
, getWidth = .width | |
, getHeight = .height | |
} | |
update : Msg -> Model -> ( Model, Cmd Msg ) | |
update msg model = | |
case msg of | |
NoOp -> | |
( model, Cmd.none ) | |
Clear -> | |
( { model | quilt = clear model.quilt }, Cmd.none ) | |
RemoveColumn -> | |
( { model | quilt = resize config (columnCount model.quilt - 1) model.quilt }, Cmd.none ) | |
AddColumn -> | |
( { model | quilt = resize config (columnCount model.quilt + 1) model.quilt }, Cmd.none ) | |
AddImage -> | |
let | |
id = | |
model.prevId + 1 | |
( ( width, height ), seed_ ) = | |
Random.step | |
(Random.pair | |
(Random.int 200 600) | |
(Random.int 100 400) | |
) | |
model.seed | |
url = | |
"http://placeimg.com/" | |
++ toString width | |
++ "/" | |
++ toString height | |
++ "/any" | |
image = | |
Image id width height url | |
in | |
( { model | |
| quilt = | |
insert config image model.quilt | |
, seed = seed_ | |
, prevId = id | |
} | |
, Cmd.none | |
) | |
init : Flags -> ( Model, Cmd Msg ) | |
init { seed } = | |
( { quilt = | |
empty 400 3 | |
, prevId = | |
0 | |
, seed = | |
Random.initialSeed seed | |
} | |
, Cmd.none | |
) | |
viewImage : Model -> Image -> Html Msg | |
viewImage { quilt } image = | |
let | |
( scaledWidth, scaledHeight ) = | |
scaledDimensions config image quilt | |
in | |
li | |
[] | |
[ img | |
[ src image.url | |
, width scaledWidth | |
, height scaledHeight | |
, style [ ( "background-color", "black" ) ] | |
] | |
[] | |
] | |
viewColumn : Model -> Array Image -> Html Msg | |
viewColumn model images = | |
ul | |
[] | |
(Array.toList <| Array.map (viewImage model) images) | |
view : Model -> Html Msg | |
view model = | |
div | |
[ style | |
[ ( "width", toString model.quilt.width ++ "px" ) ] | |
, class "quilt" | |
] | |
[ div | |
[ class "controls" ] | |
[ button | |
[ Html.Events.onClick AddImage ] | |
[ text "Add Image" ] | |
, button | |
[ Html.Events.onClick Clear ] | |
[ text "Clear" ] | |
, button | |
[ Html.Events.onClick RemoveColumn ] | |
[ text "-1 Column" ] | |
, button | |
[ Html.Events.onClick AddColumn ] | |
[ text "+1 Column" ] | |
] | |
, div | |
[] | |
(Array.toList <| Array.map (viewColumn model) model.quilt.columns) | |
] | |
subscriptions : Model -> Sub Msg | |
subscriptions model = | |
Sub.none | |
main = | |
Html.programWithFlags | |
{ init = init | |
, view = view | |
, update = update | |
, subscriptions = subscriptions | |
} |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment