TETЯIS

An implementation of the classic 80s computer game TETЯIS, written in the programming language Forml.

Tetris.forml is an example of literate programming - the source when compiled generates this page. You can run the test suite to see the Jasmine test report, or just play Tetris.

Architecture

The entire application will live in the tetris module in the global namespace. We're going to need forml's standard library, the prelude, as well as a number of sub modules: the data representation for the game will need additional functions from array module, and the html module for manipulating the UI.

module tetris

    open prelude.string
    open prelude
    open prelude.html
    open prelude.array
    

The order of import here is important - each open statement defines a new section, where subsequent opens shadow already imported symbols. Because some symbols in prelude.html are shadowed by those in prelude.array, we can bind the prelude.html to a record- typed symbol. This allows us to access all the symbols from prelude.html, as well as use the array symbol as a function parameter.

    open prelude.html as html
    

Some basic constants describing the physical laws of Tetris.

    n_rows    = 19
    n_columns = 9

The Piece type is a type synonym - it declares a local alias which can be used to make the type signatures easier to read.

    Piece = Array (Array Num)

The classic Tetris pieces.

    pieces: Array Piece =
    
        let x = 0
            o = -1

        [ [ [ x ]
            [ x ]
            [ x ]
            [ x ] ]
    
          [ [ x, o ]
            [ x, o ]
            [ x, x ] ]
            
          [ [ o, x ]
            [ o, x ]
            [ x, x ] ]
    
          [ [ x, x ]
            [ x, x ] ]
            
          [ [ o, x, o ]
            [ x, x, x ] ]
            
          [ [ x, x, o ]
            [ o, x, x ] ]
            
          [ [ o, x, x ]
            [ x, x, o ] ] ]
            

The valid piece colors.

    colors = [ [ "#0C3555", "#08789E", "#76F61E", "#F7D909", "#E11E6A" ]
               [ "#320010", "#74220F", "#B8A04E", "#E1D46C", "#80611D" ]
               [ "#542437", "#53777A", "#C02942", "#D95B43", "#53777A" ]  ]
    

The game state.

    Board =

        { piece: Piece
          board: Array (Array Num)
          score: Num
          timer: Num
          level: Num

          x: Num
          y: Num }


        

Main Loop

When the Play Tetris button is clicked, the action bound to the symbol play is realized: the application's HTML UI is appended to the page, the game's state is initialized, and handlers are configured for the game's keyboard events & timing loop.

    play = do
         
        game  <- game_template
        board <- new_board

        "body" $+ game
        draw_board board
        
        board 'move (-1) 0 'on_key 37
        board 'rot         'on_key 38
        board 'move 1    0 'on_key 39
        board 'move 0    1 'on_key 40
        

There are a few pieces which currently require shelling out to Javascript.
game_template is an action which fetches the blank HTML for the board background from an embedded script template (see source)

    game_template = `jQuery("#game").html()`

for controlling the tick rate, we'll need a way to interface with the javascript setInterval and clearInterval. set_timer is necessary because the prelude currently lacks a library for implementing type safe mutations.

    every: Num -> JS _ -> JS Num
    every n action = `setInterval(action, n)`

    set_timer ref board = `board.timer = ref` 
    
    stop_timer { timer = x, _ } = `clearInterval(x)`
    

to_commas pretty prints the current score, using the the regex wrappers from the prelude.string module

    to_commas: Num -> String | x =
    
        let r = "(\\d)(?=(\\d\\d\\d)+(?!\\d))"
        in  x 'to_string 'replace (regex r "g") "$1,"
         
    to_commas 1000 == "1,000"

                      
    

State

new_board is a factory for generating a Board records representing a new game. New games need a random piece, so its type is JS Board to encapsulate this lack of referential transparency, though it performs no mutations.

    new_board: JS Board = do

        let new_row = yield -1 'times (n_columns + 1)
        
        piece <- random_piece 0
        board <- new_row 'times (n_rows + 1) 'sequence

        return {
            piece = piece
            board = board
            score = 0
            timer = 0
            level = 1

            x = 3
            y = 0
        }

Each instance of Board returned by new_board should have a clean state which matches the expected parameters of the game world.

    (n_rows + 1) * (n_columns + 1) == do!
        new_board 'fmap (sum .: map length .: .board)
     

For the main game loop, we simply thread this gamestate through each function which needs it. This makes testing convenient, since we can trivially recreate intermediate game states. The with_board combinator introduces a new gamestate into scope, and isolates test behavior by clearing timers which may have been created in f.

    private   
    with_board f = do!
        board <- new_board
        let result = f board
        stop_timer board
        yield result
            

which lets us write quick tests that are guaranteed a clean gamestate:

    with_board λ b = b.board 'length == n_rows + 1
    with_board λ b = b.board 'get 0 'length == n_columns + 1

It would be helpful to have a function for quickly asserting whether a point has a block.

    inline at x y b = b 'get y 'get x /= -1

Determining whether a particular game state is valid involves testing whether the current piece is within the dimensions of the game board, and whether it intersects any previously laid block. For clarity, these predicates are arranged as let bindings in the definition of is_valid, lazily evaluated inline annotations actually change the behavior of the function. If the predicates defined in the let block were not inline, is_valid would throw array-out-of-bounds exceptions on bounded-ness violating game states, since these predicates to && depend on the lazy evaluation of this function (as in javascript).

    is_valid {board: board, piece: piece, x: x, y: y, _} =

        x >= 0 && x_bound? && y_bound? && intersect?

        where inline intersect? =
                  piece 'length 'by λ r =
                      piece 'get r 'length 'by λ c =
                          let piece? = piece 'at c r
                              board? = board 'at (x + c) (y + r)
                          not (piece? && board?)

              inline x_bound? =
                  x + length (get 0 piece) <= n_columns + 1

              inline y_bound? =
                  y + length piece <= n_rows + 1

              by f n = 0 .. (n - 1) |> map f |> all?

              

We can use these in combination with tick to verify its expected behavior.

    with_board is_valid

    with_board λ board = do!
        tick board 'times 45 'sequence
        yield is_valid board

    with_board λ board = do!
        new_piece board
        yield not (is_valid board)

    with_board λ board = do!
        tick board 'times 400 'sequence
        yield not (is_valid board)

Game Initialization

    draw_board board = do
        "#score" $= to_commas board.score
        "#level" $= board.level
        "#board" $| "background-color" <: colors 'get (board.level - 1) 'get 0
        "#board" $| "border-color"     <: colors 'get (board.level - 1) 'get 1
        stop_timer board
        ref <- board 'tick 'every (0.7 ^ board.level * 400)
        board 'set_timer ref

The tick function itself is quite simple, and represents the game state update invoked at the game's speed interval.

    tick board = do
        `board.y += 1`
        if not (is_valid board) then do
            `board.y = board.y - 1`
            new_piece board
            clear_lines board
        "#board" $= draw board

    with_board λ board = do!
        tick board
        tick board
        yield board.y == 2

    with_board λ board =
        let board_sim n = do
                sequence (tick board 'times n)
                yield sum <| map sum board.board
        in  do! before <- board_sim 16
                after  <- board_sim 5
                yield before == -200 and after > -200

Generate a random piece by selecting from pieces, then color it with a random color from the current palette.

    random_piece: Num -> JS Piece | level = do
        r <- rand (length pieces)
        c <- rand (length (get level colors) - 2)
        let piece = get r pieces
        yield piece 'map (map λ 0 = c | _ = -1)

    4 <= do! random_piece 0 'fmap (sum .: map sum .: map (map ((+) 1)))

Rotate a piece 90 degrees. Although this function is pure, internally it mutates arrays for construction, so we've just left its return type JS Piece to reflect these side-effects.

    rotate: Piece -> JS Piece | x =
        var new_row acc piece index col =
                if index < length piece then do
                    acc <- put (get col (get index piece)) acc
                    new_row acc piece (index + 1) col
                else return do! reverse acc
        sequence <| map (new_row [] x 0) (0 .. length (get 0 x) - 1)

    get 3 pieces is
        do! pieces 'get 3 'rotate
    
    get 1 pieces is
        do! pieces 'get 1 'rotate >>= rotate >>= rotate >>= rotate
            
    get 4 pieces isnt
        do! pieces 'get 4 'rotate >>= rotate

Player Events

Moving left, right and down is handled by move.

    move:
          Num -> Num -> Board -> JS Board
        | x      y      board  = do
            `board.x += x`
            `board.y += y`
            if is_valid board
                "#board" $= draw board
            else do
                `board.x = board.x - x`
                `board.y = board.y - y`
            yield board

    with_board λ board = do!
        board 'move 1 0
        yield board.x == 4

    with_board λ board = do!
        board 'move 1 0 >>= tick 'times 20 'sequence
        yield is_valid board

The up key rotates the current piece

    rot board = do
        let old_piece = board.piece 
        rotated_piece <- rotate board.piece
        `board.piece = rotated_piece`
        if is_valid board
            "#board" $= draw board
        else 
            `board.piece = old_piece`

    with_board λ board = do!
        orig <- clone board
        rot board 'times 4 'sequence
        yield orig == board

Once a piece has hit the bottom, we need to cement it to the game board, then generate a new game piece and update the game's state.

    new_piece board = do

        board.piece 'for_each λ row = do!
            get row board.piece 'for_each λ col = do!

                if board.piece 'at col row 
                    && (board.y + row <= n_rows + 1)
                    && (board.x + col <= n_columns + 1)

                    board.piece 'get row 'get col 'paint board (board.y + row) (board.x + col)
         
        new_piece <- random_piece (board.level - 1)    
        `board.piece = new_piece`
        `board.x = 3`
        `board.y = 0`

Check for lines, and update the game state if the player has made a line.

    clear_lines board =
        board.board 'for_each λ row = do!
            if reduce (&&) (map (λx = x != -1) (get row board.board))
                 clear_row board row
            
    with_board λ board = do!
        let line = 5 'times (n_columns + 1)
        `board.board[9] = line`
        clear_lines board
        yield board.score == 100
              && sum (map sum board.board) == -200

Once a full row has been found, we call clear_row to update the state of the board, moving all of the blocks above down and incrementing the score.

    clear_row: Board -> Num -> JS {} | board x = do
        `board.score += 100`
        if board.score % 1000 == 0
            `board.level += 1`
        draw_board board

        ignore <: sequence <: x .. 1 'map λ row =
            board.board 'get row 'for_each λ col = do!

                board.board 'get (row - 1)
                            'get col
                            'paint board row col
 
    with_board λ board = do!
        let line = 5 'times (n_columns + 1)
        `board.board[9] = line`
        clear_row board 9
        yield board.score == 100
              && sum (map sum board.board) == -200

    
                      

    

Rendering

The paint function encapsulates the mutation of a single cell on the board. Forml currently does not support mutation natively in any way except through the Javascript FFI, and these calls are tracked through the type system as the JS a type.

    inline paint board x y color =
        `board.board[x][y] = color`

    inline
    block_string:
          Num -> Num -> String -> String
        | x      y      color   =
            let style =
                    "top:`y*30`px;
                     left:`x*30`px;
                     background-color:`color`;"
            in "<div style='`style`' class='cell'></div>"

    draw: Board -> String
    draw { board: board, piece: piece, x: bx, y: by, level = level, _ } =

        0 .. n_rows 
          'map λ_ = 0 .. n_columns 
          'zip_with draw_row (0 .. n_rows)
          'concat

        where draw_row x = concat .: map ((') x) .: map draw_block

              draw_block x y when board 'at x y =
                  let color = colors 'get (level - 1) 'get (2 + (board 'get y 'get x))
                  block_string x y color

              draw_block x y when piece_bounds? x y =
                  let c_idx = piece  'get (y - by) 'get (x - bx)
                      color = colors 'get (level - 1) 'get (c_idx + 2)
                  block_string x y color

              draw_block _ _ = ""

              inline piece_bounds? x y =
                  x - bx >= 0
                    && x - bx < piece 'get 0 'length
                    && y - by >= 0
                    && y - by < length piece
                    && piece 'at (x - bx) (y - by)