Elm Fractal Zoom Toy

fractalzoom.elm

import Math.Vector2 (Vec2)
import Math.Vector3 (..)
import Math.Matrix4 (..)
import Graphics.WebGL (..)
import Mouse
import Keyboard

-- Define the mesh for a crate
crate : [Triangle { pos:Vec3, coord:Vec3 }]
crate = concatMap rotatedFace [ (0,0), (90,0), (180,0), (270,0), (0,90), (0,-90) ]

rotatedFace : (Float,Float) -> [Triangle { pos:Vec3, coord:Vec3 }]
rotatedFace (angleX,angleY) = 
  let x = makeRotate (degrees angleX) (vec3 1 0 0)
      y = makeRotate (degrees angleY) (vec3 0 1 0)
      t = x `mul` y `mul` makeTranslate (vec3 0 0 1)
  in
      map (mapTriangle (\x -> {x | pos <- transform t x.pos })) face

face : [Triangle { pos:Vec3, coord:Vec3 }]
face =
  let topLeft     = { pos = vec3 -1  1 0, coord = vec3 0 1 0 }
      topRight    = { pos = vec3  1  1 0, coord = vec3 1 1 0 }
      bottomLeft  = { pos = vec3 -1 -1 0, coord = vec3 0 0 0 }
      bottomRight = { pos = vec3  1 -1 0, coord = vec3 1 0 0 }
  in
      [ (topLeft,topRight,bottomLeft), (bottomLeft,topRight,bottomRight) ]

-- View
view : Float -> Mat4
view angle =
    foldr1 mul [ perspective
               , camera
               , makeRotate (3*angle) (vec3 0 1 0)
               , makeRotate (2*angle) (vec3 1 0 0)
               ]

perspective : Mat4
perspective = makePerspective 45 1 0.01 100

camera : Mat4
camera = makeLookAt (vec3 0 0 5) (vec3 0 0 0) (vec3 0 1 0)

-- Putting it together
main : Signal Element
main = lift2 above glscene (lift asText zoom)

glscene : Signal Element
glscene = webgl (400,400) <~ lift3 scene (lift view angle) Mouse.position zoom

angle : Signal Float
angle = foldp (\dt theta -> theta + dt / 10000) 0 (fps 60)

getmouse : Int -> Float
getmouse x =
  let x' = toFloat x
  in x'/1000 
  
zoom : Signal Float
zoom =
  let f = (\x y ->
        if | y >= 100 -> (y/10) * x + y
           | y <= 2 -> (x/100) + y
           | y == 0 -> 1.0
           | otherwise -> x + y)
      acc = foldp f 100 (lift toFloat <| lift .x Keyboard.arrows)
  in lift (\x -> x / 100) acc

scene : Mat4 -> (Int,Int) -> Float -> [Entity]
scene view (mousex,mousey) zoom =
  [entity vertexShader fragmentShader crate { view = view, fracx = getmouse mousex, fracy = getmouse mousey, zoom = zoom}]

-- Shaders
vertexShader : Shader { pos:Vec3, coord:Vec3 } { u | view:Mat4 } { vcoord:Vec2 }
vertexShader = [glsl|

attribute vec3 pos;
attribute vec3 coord;
uniform mat4 view;
varying vec2 vcoord;

void main () {
  gl_Position = view * vec4(pos, 1.0);
  vcoord = coord.xy;
}

|]

fragmentShader : Shader {} { u | zoom:Float, fracx:Float, fracy:Float } { vcoord:Vec2 }
fragmentShader = [glsl|

precision mediump float;
uniform float zoom;
uniform float fracx;
uniform float fracy;
varying vec2 vcoord;

void main () {
    float zx, zy, cx, cy;
    float centerx = fracx;
    float centery = fracy;

    cx = 1.3333 * (vcoord.x - 0.5) * zoom - centerx;
    cy = (vcoord.y - 0.5) * zoom - centery;

    zx = cx;
    zy = cy;

    int stoppedAt = 1;
    for ( int i = 0; i < 2000; i++ ) {
        float x = (zx * zx - zy * zy) + cx;
        float y = (zy * zx + zx * zy) + cy;

        if((x * x + y * y) > 4.0) {
            stoppedAt = i;
            break;
        }
        zx = x;
        zy = y;
    }
    float val = stoppedAt == 1 ? 0.0 : float(stoppedAt) / 100.0;
    gl_FragColor = vec4(val,0.0,0.0,1.0);
}

|]