Last active
August 29, 2015 13:57
-
-
Save skybrian/9826804 to your computer and use it in GitHub Desktop.
This file contains hidden or 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
import Dict | |
import Graphics.Input (Input, input, clickable) | |
type Pixel = (Int) | |
type Palette = {length: Int, colors: Dict.Dict Pixel Color} | |
makePalette: [Color] -> Palette | |
makePalette list = | |
let indexed = zip [0..(length list) - 1] list | |
in {length = (length list), colors = Dict.fromList indexed} | |
type Coord = (Int, Int) | |
type Grid = {width: Int, height: Int, pixels: Dict.Dict Coord Pixel} | |
makeGrid: [[Pixel]] -> Grid | |
makeGrid pixels = | |
let width = (length (head pixels)) | |
height = (length pixels) | |
indexed y list = | |
let coord x = (x, y) | |
in zip (map coord [0..width-1]) list | |
in let pairs = concat (zipWith indexed [0..height-1] pixels) | |
in {width = width, height = height, pixels = Dict.fromList pairs} | |
type Painting = {palette: Palette, grid: Grid} | |
model: Painting | |
model = { | |
palette = makePalette [red, orange, yellow, green, blue, purple], | |
grid = makeGrid [[0,1,2,3,4,5], [1,2,3,4,5,0], [2,3,4,5,0,1]] } | |
pixelAt: Painting -> Int -> Int -> Pixel | |
pixelAt p y x = | |
case Dict.lookup (x, y) p.grid.pixels of | |
Just px -> px | |
Nothing -> 0 | |
colorAt: Painting -> Int -> Int -> Color | |
colorAt p y x = | |
case Dict.lookup (pixelAt p y x) p.palette.colors of | |
Just c -> c | |
Nothing -> black | |
setPixel: Coord -> Pixel -> Painting -> Painting | |
setPixel coord pixel p = | |
let grid = p.grid in | |
let newGrid = { grid | pixels <- (Dict.insert coord pixel p.grid.pixels) } | |
in { p | grid <- newGrid } | |
clicks: Input Coord | |
clicks = input (0, 0) | |
cellAt: Painting -> Int -> Int -> Element | |
cellAt p y x = | |
let cell = (color (colorAt p y x) (spacer 10 10)) | |
in clickable clicks.handle (x,y) cell | |
rowAt: Painting -> Int -> Element | |
rowAt p y = flow right (map (cellAt p y) [0..(p.grid.width-1)]) | |
render: Painting -> Element | |
render p = flow down (map (rowAt p) [0..(p.grid.height-1)]) | |
step: Coord -> Painting -> Painting | |
step coord p = setPixel coord 0 p | |
frames: Signal Painting | |
frames = foldp step model clicks.signal | |
main: Signal Element | |
main = lift render frames |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment