Elm Recursive Blocks

Everyone knows Minecraft. The game took the world by storm and it’s grid-like approach to terrain was a big part of that.

At the time, I had an idea running around my head for a recursive take on the Minecraft world. Instead of a fixed grid of cubes, each cube is either solid, or divided into smaller cubes. With this approach you could potentially have ‘infinite detail’.

In practice it’s not particularly useful. Because the subdivisions are exponential, the details quickly become invisible.

Functional langauges are perfect for this kind of recursive data, so it’s a perfect chance to play with elm. You can test a 2d version here. Controls are ‘z’ and ‘x’ to change the size of the cursor, ‘1’,‘2’,‘3’,‘4’ to select materials, ‘wasd’ to move and the arrow keys to zoom and rotate. Note that I did this in a much older version of Elm and the code hasn’t aged gracefully. The curse of an evolving language!

module StructuredBlock where

import Color exposing (..)
import Graphics.Collage exposing (..)
import Graphics.Element exposing (..)

import Signal exposing((<~),(~))

import Mouse
import Keyboard
import Window
import Time

{-
  General Model: Fold the MODEL over the INPUT SIGNAL using an UPDATE ACCUMULATOR and then RENDER the state. 
-}

------------------------------
-- Model
------------------------------

type Material = Grass | Rock | Wood | Empty
type Cube = Solid Material | SubDiv Cube Cube Cube Cube

baseSize = 400

-- Functions for editing a cube

subdivideCube : Cube -> Cube
subdivideCube c = 
    case c of
        Solid m -> SubDiv (Solid m) (Solid m) (Solid m) (Solid m)
        x       -> x

-- Function for editing at a certain scale at a certain coordinate
-- Use of s and s' is a total hack to both increase and decrease the scale as we recurse!

modifyCube : Cube -> (Float,Float) -> Float -> Float -> Material -> Cube
modifyCube base (x,y) s s' m =
    let moveSize = baseSize * (0.5)^(s')
        region f (a,b) (SubDiv tl tr bl br) =
        if | a <= 0 && b >= 0 -> SubDiv (f (a + moveSize , b - moveSize) tl) tr bl br
           | a >= 0 && b >= 0 -> SubDiv tl (f (a - moveSize , b - moveSize) tr) bl br
           | a <= 0 && b <= 0 -> SubDiv tl tr (f (a + moveSize , b + moveSize) bl) br
           | a >= 0 && b <= 0 -> SubDiv tl tr bl (f (a - moveSize , b + moveSize) br)
    in
    case s of
        0 -> Solid m
        n -> case base of
            Solid p -> region (\coord cu -> modifyCube cu coord (s-1) (s'+1) m) (x,y) (subdivideCube <| Solid p)
            sub     -> region (\coord cu -> modifyCube cu coord (s-1) (s'+1) m) (x,y) sub

-- Initial image

initialCube : Cube
initialCube = SubDiv (SubDiv (Solid Empty) (SubDiv (Solid Empty) (Solid Empty) (Solid Wood) (Solid Wood)) (Solid Wood) (Solid Rock)) (SubDiv (SubDiv (Solid Empty) (Solid Grass) (Solid Rock) (Solid Grass)) (SubDiv (Solid Grass) (Solid Empty) (Solid Grass) (Solid Grass)) (SubDiv (Solid Rock) (Solid Rock) (Solid Rock) (Solid Rock)) (SubDiv (Solid Grass) (Solid Grass) (Solid Rock) (Solid Grass))) (SubDiv (Solid Grass) (SubDiv (Solid Grass) (Solid Wood) (Solid Grass) (Solid Grass)) (Solid Empty) (Solid Grass)) (SubDiv (SubDiv (Solid Rock) (Solid Rock) (Solid Grass) (Solid Wood)) (Solid Wood) (Solid Empty) (SubDiv (Solid Wood) (Solid Empty) (Solid Wood) (Solid Empty)))

------------------------------
-- Input
------------------------------

-- Signal for centered relative mouse coordinates

relativeMouse : Signal (Float,Float)
relativeMouse =
    let x = Signal.map toFloat Mouse.x
        y = Signal.map toFloat Mouse.y
        w = Signal.map toFloat Window.width
        h = Signal.map toFloat Window.height
    in Signal.map4 (\x y w h -> (x - w / 2,-(y - h / 2))) x y w h

-- Signal of rounded mouse positions
roundedMouse=
    let roundToPower g x = toFloat (floor (x / g)) * g
        g s = baseSize * (0.5)^(toFloat s)
        f (x,y) s = (roundToPower (g s) x + g s / 2 , roundToPower (g s) y + g s / 2)
    in Signal.map2 f transformedMouse cursorScale

-- Signal for scale of editing cube

cursorScale : Signal Int
cursorScale =
    let keyTuple = Signal.map2 (,) (Keyboard.isDown 88) (Keyboard.isDown 90)
        boundedAccumulator (a,z) acc =
            if | a            -> acc + 1
               | z && acc > 1 -> acc - 1
               | otherwise    -> acc
    in Signal.foldp boundedAccumulator 1 keyTuple

-- Signal to remember chosen editing material

initialMaterial = Grass

keyToMaterial : Keyboard.KeyCode -> Material -> Material
keyToMaterial code mat =
    case code of
        49 -> Grass
        50 -> Rock
        51 -> Wood
        52 -> Empty
        _  -> mat

materialSelection : Signal Material
materialSelection = Signal.foldp keyToMaterial initialMaterial Keyboard.presses

-- Transformation Signal

transformSignal =
    let timeSignal = Time.fps 30
        recordToTuple {x,y} = (toFloat x,toFloat y)
        keysSignal = Signal.sampleOn timeSignal <| Signal.map3 (\wa arr time -> (recordToTuple wa,recordToTuple arr, time)) Keyboard.wasd Keyboard.arrows timeSignal
        accumulator ((mx',my'),(r',s'),_) ((mx,my),r,s) = ((mx + moveSpeed * mx' , my + moveSpeed * my'), r + rotationSpeed * r' , s + scaleSpeed * s' )
    in Signal.foldp accumulator (initialMove,initialRotation,initialScale) keysSignal

-- Transform to reinterpret mouse input coordinates

rotatePoints r (x,y) =
    let c = cos r
        s = sin r
    in (c*x - s*y , s*x + c*y)

scalePoints s (x,y) = (s * x , s * y)

movePoints (mx,my) (x,y) = (mx + x,my + y)

mouseInverseTransform ((mx,my),r,s) (x,y) =
    scalePoints (1/s) <| rotatePoints (-r) <| movePoints (-mx,-my) <| (x,y)

transformedMouse = Signal.map2 mouseInverseTransform transformSignal relativeMouse

-- Input Signal

inputSignal : Signal (Bool, (Float,Float), Int, Material)
inputSignal = Signal.sampleOn Mouse.isDown <| Signal.map4 (,,,) Mouse.isDown transformedMouse cursorScale materialSelection

------------------------------
-- Update
------------------------------

clickUpdate : Cube -> Signal (Bool,(Float,Float),Int,Material) -> Signal Cube
clickUpdate initial sig =
    let clickAccumulator (clicks, relMPos, s, mat) cube =
        if clicks then modifyCube cube relMPos (toFloat s) 2 mat
        else cube
    in Signal.foldp clickAccumulator initial sig

-- Transformation Parameters

rotationSpeed = 0.1
scaleSpeed = 0.1
moveSpeed = 10

initialRotation = 0
initialScale = 1
initialMove = (0,0)

------------------------------
-- Render
------------------------------

-- Draw cursor
drawCursor : (Float,Float) -> Int -> Form
drawCursor pos s =
    let s'  = toFloat s
        s'' = baseSize * (0.5)^s'
    in move pos <| outlined (solid black) <| square s''

-- Draw the cube

baseSquare col = filled col (square baseSize)

drawCube : Cube -> Form
drawCube cube =
  let t = baseSize / 4
  in
    case cube of
      Solid Grass        -> baseSquare green
      Solid Rock         -> baseSquare darkGrey
      Solid Wood         -> baseSquare brown
      Solid Empty        -> baseSquare white
      SubDiv tl tr bl br -> group <| List.map (scale 0.5) [ move (-t,t) <| drawCube tl
                                                     , move (t,t) <| drawCube tr
                                                     , move (-t,-t) <| drawCube bl
                                                     , move (t,-t) <| drawCube br ]

-- Draw the selected material

drawSelMat : Material -> Form
drawSelMat mat = show mat
                 |> toForm
                 |> scale 2
                 |> move (-baseSize/1.6,baseSize/4)                 

-- Render the Screen

renderScreen : Cube -> ((Float,Float),Float,Float) -> (Int,Int) -> (Float,Float) -> Int -> Material -> Element
renderScreen cube (transM,transR,transS) dims pos s mat =
    let collageSize = 600
        (w,h) = dims
        trans = rotate transR << scale transS << move transM
    in container w h middle
       <| collage collageSize collageSize
       <| [ trans <| group [ drawCube cube , drawCursor pos s ] , drawSelMat mat ]


-- Main
--Fold the MODEL over the INPUT SIGNAL using an UPDATE ACCUMULATOR and then RENDER the state. 

main = renderScreen <~ (clickUpdate initialCube inputSignal) ~ transformSignal ~ Window.dimensions ~ roundedMouse ~ cursorScale ~ materialSelection