slow_paint.elm

import Dict
import Graphics.Input (Input, input, hoverable)
import Mouse
import Window 

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}

makeBlankGrid: Int -> Int -> Pixel -> Grid
makeBlankGrid x y c = makeGrid (repeat y (repeat x c))

type Painting = {palette: Palette, grid: Grid}
 
model: Painting
model = {
  palette = makePalette [black, red, orange, yellow, green, blue, purple],
  grid = makeBlankGrid 50 50 0 }

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 }

hoverCoord: Input (Maybe Coord)
hoverCoord = input Nothing

drawCoord: Signal (Maybe Coord)
drawCoord = dropRepeats (keepWhen Mouse.isDown Nothing hoverCoord.signal)

cellAt: Painting -> Int -> Int -> Element
cellAt p y x =
  let cell = (color (colorAt p y x) (spacer 10 10))
  in hoverable hoverCoord.handle (\on -> if on then Just (x,y) else Nothing) cell

rowAt: Painting -> Int -> Element
rowAt p y = 
  flow right (map (cellAt p y) [0..(p.grid.width-1)])

renderPainting: Painting -> Element
renderPainting p = flow down (map (rowAt p) [0..(p.grid.height-1)])

render: Painting -> (Int,Int) -> Element
render p (x,y) = container x y middle (renderPainting p)

step: Maybe Coord -> Painting -> Painting
step coord p = maybe p (\c -> setPixel c 1 p) coord

frames: Signal Painting
frames = foldp step model drawCoord

main: Signal Element
main = lift2 render frames Window.dimensions