CarstenKoenig/FayBrot.hs

## FayBrot.hs
-- | Simple Mandelbrot-drawing into a Canvas using Fay
--
-- Compile with
-- $ fay -p FayBrot.hs

{-# OPTIONS -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-do-bind #-}
{-# LANGUAGE EmptyDataDecls #-}

module FayBrot (main) where

import Language.Fay.FFI
import Language.Fay.Prelude
import Mandelbrot

main :: Fay ()
main = do
  let w = 50
  let h = 50
  ready $ do
    ctx <- theContext
    img <- getImageData ctx w h
    forM_ [1..w] $ \y -> do
      forM_ [1..h] $ \x -> do
        setPixel img (x,y) $ getCoordColor (w, h) (x,y)
    putImageData ctx img

--------------------------------------------------------------------------------
-- Canvas-Drawing

data CanvasContext2D
instance Foreign CanvasContext2D

data ImageData
instance Foreign ImageData

setPixel :: ImageData -> (Int, Int) -> (Int, Int, Int) -> Fay ()
setPixel img (x,y) (r,g,b) = do
            width <- imgWidth img
            let ind = (x + y * width) * 4
            setValue img ind r
            setValue img (ind+1) g
            setValue img (ind+2) b
            setValue img (ind+3) 255


theContext :: Fay CanvasContext2D
theContext = do
            can <- theCanvas
            getCtx can

setValue :: ImageData -> Int -> Int -> Fay ()
setValue = ffi "%1.data[%2]=%3"

imgWidth :: ImageData -> Fay Int
imgWidth = ffi "%1.width"

getCtx :: Element -> Fay CanvasContext2D
getCtx = ffi "%1.getContext(\"2d\")"

getImageData :: CanvasContext2D -> Int -> Int -> Fay ImageData
getImageData = ffi "%1.createImageData(%2, %3)"

putImageData :: CanvasContext2D -> ImageData -> Fay()
putImageData = ffi "%1.putImageData(%2, 0, 0)"

--------------------------------------------------------------------------------
-- DOM bindings

data Element
instance Foreign Element


documentGetElement :: String -> Fay Element
documentGetElement = ffi "document.getElementById(%1)"

theCanvas :: Fay Element
theCanvas = documentGetElement "canvas"

--------------------------------------------------------------------------------
-- JQuery bindings
-- These are provided in the fay-jquery package.

data JQuery
instance Foreign JQuery
instance Show JQuery

ready :: Fay () -> Fay ()
ready = ffi "window['jQuery'](%1)"

## Mandel.hs
module Mandelbrot where

import Language.Fay.Prelude

--------------------------------------------------------------------------------
-- Utilities

maxIter :: Int
maxIter = 512

mandelbrotView :: ((Double, Double), (Double, Double))
mandelbrotView = ((-2.1, 0.5), (-1.14, 1.14))

getCoordColor :: (Int, Int) -> (Int, Int) -> (Int, Int, Int)
getCoordColor (w, h) (x, y) = iterToRgb . iterationsToBound $ p
  where p = (size x w (fst mandelbrotView), size y h (snd mandelbrotView))
	      size i m (f, t) = (fromIntegral i) * (t - f) / (fromIntegral m) + f

iterToRgb :: Int -> (Int, Int, Int)
iterToRgb n = (0, 100 * (n `div` 256), n `mod` 256)

iterationsToBound :: (Double, Double) -> Int
iterationsToBound start = iter (0, 0) 0
	where iter val i
	        | i >= maxIter      = i
			| not $ inBound val = i
			| otherwise         = let next = iteratePoint start val in
                                  iter next (i+1)

iteratePoint :: (Double, Double) -> (Double, Double) -> (Double, Double)
iteratePoint (sX, sY) (x, y) = (sX + x*x - y*y, sY + 2*x*y)

inBound :: (Double, Double) -> Bool
inBound (x, y) = x*x + y*y < 4

## Mandel.html
<!doctype html>
<html>
<head>
  <meta http-equiv='Content-Type' content='text/html; charset=utf-8'>
	<script type="text/javascript" src="Mandel.js"></script>
</head>
<body>
	<canvas align="center" id="canvas" width="1000" height="800"></canvas>
</body>
</html>

## Mandel.js
var maxIter = 512;

var height = 800;
var width = 1000;

var minX = -2.1;
var maxX = 0.5;
var minY = -1.14;
var maxY = 1.14;

function inBound (p) {
  return p.x*p.x + p.y*p.y < 4;
}

function iteratePoint (start, p) {
	var neu = { x: start.x + p.x*p.x - p.y*p.y, y: start.y + 2*p.x*p.y };
	return neu;
}

function getIterationCount (p) {
	var i = 0;
	var z = { x: 0, y: 0 }
	while (i < maxIter && inBound(z)){
		z = iteratePoint(p, z);
		i = i + 1;
	}
	return i;
}

function iterCountToColor (i) {
	i = maxIter - i;
	var col = { r: 0, g: i % 256, b: 100 * i / 256, a: 255 };
	return col;
}

function getCoordColor (cx, cy) {
	var p = { x: cx * (maxX - minX) / width + minX
	        , y: cy * (maxY - minY) / height + minY };
    var i = getIterationCount (p);
    return iterCountToColor (i);
}

function showSet() {
	var ctx = document.getElementById('canvas').getContext("2d");
	var img = ctx.createImageData(width, height);
	for (var y = 0; y < height; y++)
		for (var x = 0; x < width; x++)
		{
			var index = (x + y * width) * 4;
			var col = getCoordColor(x,y);
			img.data[index+0] = col.r;
			img.data[index+1] = col.g;
			img.data[index+2] = col.b;
			img.data[index+3] = col.a;
		}
	ctx.putImageData(img, 0, 0);
}

window['jQuery'](showSet);

## mandelbrot.fs
[<ReflectedDefinition>]
module Program

open FunJS

type Complex = { r : double; i : double }
type Color = { r : int; g : int; b : int; a : int }

[<JSEmit("return document.getElementById({0});")>]
let getElement (x:string) : 'a = failwith "never"

[<JSEmit("return {0}.getContext(\"2d\");")>]
let getContext (o : obj) : 'a = failwith "never"

[<JSEmit("return {0}.createImageData({1},{2});")>]
let createImageData (ctx : obj, width : int, height : int) : 'a = failwith "never"

[<JSEmit("{0}.putImageData({1},0,0);")>]
let putImageData (ctx : obj, data : obj) : unit = failwith "never"

[<JSEmit("{0}.data[{1}]={2};")>]
let setPixel (img : obj, index : int, value : int) : unit = failwith "never"

let maxIter = 512

let height = 1000
let width = 1000

let minX = -2.1
let maxX = 0.5
let minY = -1.4
let maxY = 1.4

let inBound (p : Complex) : bool =
    p.r*p.r + p.i*p.i < 4.0

let iteratePoint (s : Complex) (p : Complex) : Complex =
    { r = s.r + p.r*p.r - p.i*p.i; i = s.i + 2.0 * p.i * p.r }

let getIterationCount (p : Complex) =
    let rec iter i z =
        if i >= maxIter || not <| inBound z then i else
        iter (i+1) (iteratePoint p z)
    iter 0 p

let iterCountToColor (i : int) : Color =
    let i = maxIter - i
    { r = 0; g = i % 256; b = 100 * (i / 256); a = 255 }

let getCoordColor (x : int, y : int) : Color =
    let p = { r = float x * (maxX - minX) / float width + minX
            ; i = float y * (maxY - minY) / float height + minY }
    let i = getIterationCount p
    iterCountToColor i

let showSet() =
    let ctx = getElement("canvas") |> getContext
    let img = createImageData(ctx, width, height)
    for y in 0 .. height-1 do
        for x in 0 .. width-1 do
            let index = (x + y * width) * 4
            let color = getCoordColor (x, y)
            setPixel(img, index+0, color.r)
            setPixel(img, index+1, color.g)
            setPixel(img, index+2, color.b)
            setPixel(img, index+3, color.a)
    putImageData(ctx, img)

let main() =
    showSet()

// Compile
let source = <@@ main() @@> |> Compiler.compileWithoutReturn
let filename = "mandelbrot.js"
System.IO.File.Delete filename
System.IO.File.WriteAllText(filename, source)
source|> printfn "%A"
System.Console.ReadLine() |> ignore
	-- \| Simple Mandelbrot-drawing into a Canvas using Fay
	--
	-- Compile with
	-- $ fay -p FayBrot.hs

	{-# OPTIONS -fno-warn-orphans -fno-warn-type-defaults -fno-warn-unused-do-bind #-}
	{-# LANGUAGE EmptyDataDecls #-}

	module FayBrot (main) where

	import Language.Fay.FFI
	import Language.Fay.Prelude
	import Mandelbrot

	main :: Fay ()
	main = do
	let w = 50
	let h = 50
	ready $ do
	ctx <- theContext
	img <- getImageData ctx w h
	forM_ [1..w] $ \y -> do
	forM_ [1..h] $ \x -> do
	setPixel img (x,y) $ getCoordColor (w, h) (x,y)
	putImageData ctx img

	--------------------------------------------------------------------------------
	-- Canvas-Drawing

	data CanvasContext2D
	instance Foreign CanvasContext2D

	data ImageData
	instance Foreign ImageData

	setPixel :: ImageData -> (Int, Int) -> (Int, Int, Int) -> Fay ()
	setPixel img (x,y) (r,g,b) = do
	width <- imgWidth img
	let ind = (x + y * width) * 4
	setValue img ind r
	setValue img (ind+1) g
	setValue img (ind+2) b
	setValue img (ind+3) 255


	theContext :: Fay CanvasContext2D
	theContext = do
	can <- theCanvas
	getCtx can

	setValue :: ImageData -> Int -> Int -> Fay ()
	setValue = ffi "%1.data[%2]=%3"

	imgWidth :: ImageData -> Fay Int
	imgWidth = ffi "%1.width"

	getCtx :: Element -> Fay CanvasContext2D
	getCtx = ffi "%1.getContext(\"2d\")"

	getImageData :: CanvasContext2D -> Int -> Int -> Fay ImageData
	getImageData = ffi "%1.createImageData(%2, %3)"

	putImageData :: CanvasContext2D -> ImageData -> Fay()
	putImageData = ffi "%1.putImageData(%2, 0, 0)"

	--------------------------------------------------------------------------------
	-- DOM bindings

	data Element
	instance Foreign Element


	documentGetElement :: String -> Fay Element
	documentGetElement = ffi "document.getElementById(%1)"

	theCanvas :: Fay Element
	theCanvas = documentGetElement "canvas"

	--------------------------------------------------------------------------------
	-- JQuery bindings
	-- These are provided in the fay-jquery package.

	data JQuery
	instance Foreign JQuery
	instance Show JQuery

	ready :: Fay () -> Fay ()
	ready = ffi "window['jQuery'](%1)"
	module Mandelbrot where

	import Language.Fay.Prelude

	--------------------------------------------------------------------------------
	-- Utilities

	maxIter :: Int
	maxIter = 512

	mandelbrotView :: ((Double, Double), (Double, Double))
	mandelbrotView = ((-2.1, 0.5), (-1.14, 1.14))

	getCoordColor :: (Int, Int) -> (Int, Int) -> (Int, Int, Int)
	getCoordColor (w, h) (x, y) = iterToRgb . iterationsToBound $ p
	where p = (size x w (fst mandelbrotView), size y h (snd mandelbrotView))
	size i m (f, t) = (fromIntegral i) * (t - f) / (fromIntegral m) + f

	iterToRgb :: Int -> (Int, Int, Int)
	iterToRgb n = (0, 100 * (n `div` 256), n `mod` 256)

	iterationsToBound :: (Double, Double) -> Int
	iterationsToBound start = iter (0, 0) 0
	where iter val i
	\| i >= maxIter = i
	\| not $ inBound val = i
	\| otherwise = let next = iteratePoint start val in
	iter next (i+1)

	iteratePoint :: (Double, Double) -> (Double, Double) -> (Double, Double)
	iteratePoint (sX, sY) (x, y) = (sX + xx - yy, sY + 2xy)

	inBound :: (Double, Double) -> Bool
	inBound (x, y) = xx + yy < 4
	<!doctype html>
	<html>
	<head>
	<meta http-equiv='Content-Type' content='text/html; charset=utf-8'>
	<script type="text/javascript" src="Mandel.js"></script>
	</head>
	<body>
	<canvas align="center" id="canvas" width="1000" height="800"></canvas>
	</body>
	</html>
	var maxIter = 512;

	var height = 800;
	var width = 1000;

	var minX = -2.1;
	var maxX = 0.5;
	var minY = -1.14;
	var maxY = 1.14;

	function inBound (p) {
	return p.xp.x + p.yp.y < 4;
	}

	function iteratePoint (start, p) {
	var neu = { x: start.x + p.xp.x - p.yp.y, y: start.y + 2p.xp.y };
	return neu;
	}

	function getIterationCount (p) {
	var i = 0;
	var z = { x: 0, y: 0 }
	while (i < maxIter && inBound(z)){
	z = iteratePoint(p, z);
	i = i + 1;
	}
	return i;
	}

	function iterCountToColor (i) {
	i = maxIter - i;
	var col = { r: 0, g: i % 256, b: 100 * i / 256, a: 255 };
	return col;
	}

	function getCoordColor (cx, cy) {
	var p = { x: cx * (maxX - minX) / width + minX
	, y: cy * (maxY - minY) / height + minY };
	var i = getIterationCount (p);
	return iterCountToColor (i);
	}

	function showSet() {
	var ctx = document.getElementById('canvas').getContext("2d");
	var img = ctx.createImageData(width, height);
	for (var y = 0; y < height; y++)
	for (var x = 0; x < width; x++)
	{
	var index = (x + y * width) * 4;
	var col = getCoordColor(x,y);
	img.data[index+0] = col.r;
	img.data[index+1] = col.g;
	img.data[index+2] = col.b;
	img.data[index+3] = col.a;
	}
	ctx.putImageData(img, 0, 0);
	}

	window['jQuery'](showSet);
	[<ReflectedDefinition>]
	module Program

	open FunJS

	type Complex = { r : double; i : double }
	type Color = { r : int; g : int; b : int; a : int }

	[<JSEmit("return document.getElementById({0});")>]
	let getElement (x:string) : 'a = failwith "never"

	[<JSEmit("return {0}.getContext(\"2d\");")>]
	let getContext (o : obj) : 'a = failwith "never"

	[<JSEmit("return {0}.createImageData({1},{2});")>]
	let createImageData (ctx : obj, width : int, height : int) : 'a = failwith "never"

	[<JSEmit("{0}.putImageData({1},0,0);")>]
	let putImageData (ctx : obj, data : obj) : unit = failwith "never"

	[<JSEmit("{0}.data[{1}]={2};")>]
	let setPixel (img : obj, index : int, value : int) : unit = failwith "never"

	let maxIter = 512

	let height = 1000
	let width = 1000

	let minX = -2.1
	let maxX = 0.5
	let minY = -1.4
	let maxY = 1.4

	let inBound (p : Complex) : bool =
	p.rp.r + p.ip.i < 4.0

	let iteratePoint (s : Complex) (p : Complex) : Complex =
	{ r = s.r + p.rp.r - p.ip.i; i = s.i + 2.0 * p.i * p.r }

	let getIterationCount (p : Complex) =
	let rec iter i z =
	if i >= maxIter \|\| not <\| inBound z then i else
	iter (i+1) (iteratePoint p z)
	iter 0 p

	let iterCountToColor (i : int) : Color =
	let i = maxIter - i
	{ r = 0; g = i % 256; b = 100 * (i / 256); a = 255 }

	let getCoordColor (x : int, y : int) : Color =
	let p = { r = float x * (maxX - minX) / float width + minX
	; i = float y * (maxY - minY) / float height + minY }
	let i = getIterationCount p
	iterCountToColor i

	let showSet() =
	let ctx = getElement("canvas") \|> getContext
	let img = createImageData(ctx, width, height)
	for y in 0 .. height-1 do
	for x in 0 .. width-1 do
	let index = (x + y * width) * 4
	let color = getCoordColor (x, y)
	setPixel(img, index+0, color.r)
	setPixel(img, index+1, color.g)
	setPixel(img, index+2, color.b)
	setPixel(img, index+3, color.a)
	putImageData(ctx, img)

	let main() =
	showSet()

	// Compile
	let source = <@@ main() @@> \|> Compiler.compileWithoutReturn
	let filename = "mandelbrot.js"
	System.IO.File.Delete filename
	System.IO.File.WriteAllText(filename, source)
	source\|> printfn "%A"
	System.Console.ReadLine() \|> ignore