Programming C, C++, Java, PHP, Ruby, Turing, VB
Computer Science Canada 
Programming C, C++, Java, PHP, Ruby, Turing, VB  

Username:   Password: 
 RegisterRegister   
 Tetris!
Index -> Programming, Turing -> Turing Submissions
View previous topic Printable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic
Author Message
Insectoid




PostPosted: Sat Jan 21, 2017 8:51 pm   Post subject: Tetris!

I haven't written any actual code in quite some time, other than bits and pieces here on the forums, so I whipped up a game of Tetris to make sure I still know how to program.

Neat features:

-Major phases of the program are controlled by a state machine (the game itself, pause screen, lose screen, animations, etc). This means the main loop is really quite small, and everything that would have been in it has been moved off to their own 'state procedures'. As you might imagine, it makes switching between, creating and editing states really, really easy.

-Unlimited frame rate: There are no delays in the main game (some animations have delays). Timing is controlled by Time.Elapsed. This means frames are drawn and pushed to the screen as fast as possible, but more importantly, there's no input lag. Delays block Input.KeyDown, so some key presses (most, in the case of Tetris) would be missed.

-I think this project has more re-used code than anything else I've ever written. There were a few functions I thought would be hard, but by the time I got to them, I had so many small functions already written that I could glue together like legos to do what I wanted. One in particular would have been 20 or more lines long, but it turned out to be just two. I didn't plan that in advance, which was neat. It's not often in programming that you do something good by accident.

-I'm sure I did some other neat funky stuff in there but I can't think of any off hand. I tried to comment the code pretty well so you guys could learn from it. Have a gander and if you have any questions or suggestions, let me know.

There is one bug that I know of. Well, not really a bug, I'm just too lazy to do it. When a row is cleared, the column above drops down to that row and stops. What should happen, is the column should drop as far as it can without hitting something. It's basically just a reversal of the shiftBy function but I got bored so I didn't do it.

Oh yeah, uh, controls are left/right for left/right, up to rotate, down to go faster, p for pause. After you lose, hit enter to restart.

Don't try handing this in to your teacher. S/he will know you didn't write it. That's the Insectoid Guarantee!

Turing:
%Tetris

/*
 ************************
 **** Declarations ****
 ************************
 */






%x/y coordinates
type coord :
    record
        x : int
        y : int
    end record

%This represents a piece on the board.
%Note that it does not have absolute coordinates-
%There is only one active piece at a time, so I only have one set of global
%coordinates for the active piece- (cPieceX, cPieceY)
type piece :
    record
        cell : array 0 .. 3 of coord %Relative coordinates of each cell that makes up the piece
        shift : int %amount to shift by after rotating
        c : int %color of the piece
    end record

%height and width of the game board in cells
%Changing these shouldn't break the game itself, but rendering might not work.
%If you change height/width, you must also manually change height/width in the
%View.Set() line way at the bottom of this file.
const height := 50
const width := 10
const s := 10     %scale multiplier for drawing. s = width/height per cell in pixels.

var grid : array 0 .. width + 1, -3 .. height of int %A 2-d array represents the game board. Pieces spawn with negative y values, so the grid starts at -3
var pieces : array 0 .. 6 of piece     %This array holds one of each type of piece. Do not change. Should really be constant, but that just causes more pain.
var currentPiece : piece % This is the piece that is currently falling down
var cPieceX, cPieceY : int %The coordinates of the current piece

%timing
var tickRate : int %rate of fall, in milliseconds. Change this for different difficulty settings.
var currentTime : int %Stores the current time
var lastTime : int %Stores the time of last tick

%Input
var keys : array char of boolean
var keyReleased : int %keypresses only register when this is true. Prevents press-and-hold.

%Execution is controlled by a state machine
type states : enum (paused, playing, clearing, lose) %These are all the possible states
var state : states %the current state. This decides what code runs in the main loop.





/*
 **************************
 **** Piece Behavior ****
 **************************
 */







%Rotates a piece clockwise when r = 1, ccw when r = -1
%Should only be called on currentPiece or newly created pieces
%Do not use on pieces array
function rotatePiece (p : piece, r : int) : piece
    var out : piece %We don't want to edit p, so we make a new piece to return
    out.shift := p.shift
    out.c := p.c
   
    %Iterate over each piece segment and rotate it about the origin
    for i : 0 .. 3

        %This rotates the piece about the origin relative to the cells.
        %It's a long way of saying 'x := -y, y := -x'.
        out.cell (i).x := p.cell (i).y * r * -1
        out.cell (i).y := p.cell (i).x * r

        %This is an over-complicated way to say 'if left, shift right. If right, shift up'.
        %When we rotate a piece left, the x value becomes negative
        %When we rotate right, the y value becomes negative
        %So we shift up or right to push it back into positive land.
        %Can't just multiply x -1, because that flips the piece. We only want to
        %shift it
        out.cell (i).x += (r + 1) div 2 * p.shift
        out.cell (i).y -= (r - 1) div 2 * p.shift
    end for
    result out
end rotatePiece

%Here are some functions that just make things easier to read and write later on.
function rotateLeft (p : piece) : piece
    result rotatePiece (p, -1)
end rotateLeft

function rotateRight (p : piece) : piece
    result rotatePiece (p, 1)
end rotateRight

%returns true if cell is taken. False otherwise.
%We get a LOT of mileage out of this function.
function checkCell (x : int, y : int) : boolean
    result (grid (x, y) not= 0)
end checkCell


%returns true if piece p fits at (x,y)
function checkPiece (p : piece, x : int, y : int) : boolean
    for i : 0 .. 3
        if checkCell (p.cell (i).x + x, p.cell (i).y + y) then
            result false
        end if
    end for
    result true
end checkPiece

%Here's some more dinky little functions that make things easier to read

%result true if piece fits at (x, y+1)
function checkBelow (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x, y + 1)
end checkBelow

%result true if piece fits at (x-1, y)
function checkLeft (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x - 1, y)
end checkLeft

%result true if piece fits at (x+1, y)
function checkRight (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x + 1, y)
end checkRight

%result true if piece can rotate right at (x, y)
function checkRotateRight (_p : piece, x : int, y : int) : boolean
    %I expected this function to be a pain to write,
    %but it turns out I already did all the work!
    %Just make a new piece, rotate it with the function we already have,
    %then check if that new piece can fit in (x, y), using the other function
    %we already have!
    var p : piece := rotateRight (_p)
    result checkPiece (p, x, y)
end checkRotateRight

%result true if piece can rotate left at (x,y)
function checkRotateLeft (_p : piece, x : int, y : int) : boolean
    var p : piece := rotateLeft (_p)
    result checkPiece (p, x, y)
end checkRotateLeft



%When a piece is falling, it is separate from the grid. It's drawn there,
%but if you look at the array itself, you'll find all 0's (ie empty) where the piece is supposed
%to be. The piece is only ever added to the grid array when it stop. This way, we
%don't have to think about it anymore.
%This is the function that does that.
proc setPiece (p : piece, _x : int, _y : int)
    for i : 0 .. 3 %iterate over every segment of the piece
        var x := p.cell (i).x + _x %save it to the array
        var y := p.cell (i).y + _y
        grid (x, y) := p.c
    end for
end setPiece




/*
 ******************************
 **** Full Row Handling ****
 ******************************
*/




%Returns value of s at (_x, _y) for proc shiftColumn (_x, _y, s)
%shiftColumn needs to know how much to shift the column by.
%This function figures that out.
%Currently, when a row is deleted, blocks above will fall down and stop at that
%row, even if they could have fallen further. No plans to change at this time.
function shiftBy (_x : int, _y : int) : int
    var out : int := 0
    loop
        var y := (-1) * (_y - out) + height
       
        %These commented out lines visualize how this function works.
        %Uncomment them if you're curious.
        /* 
        %Draw.Box (10 * _x, 10 * y, 10 * _x + 10, 10 * y + 10, black)
        %View.Update
        %delay (10)
        */

       
        %...I forget how this part works.
        exit when _y - out <= 0 or grid (_x, _y - out) not= 0
        out += 1
    end loop
    result out
end shiftBy


%shift column with base at (_x, _y) down by s
proc shiftColumn (_x : int, _y : int, s : int)
    if s > 0 and s < height then
        for decreasing y : _y .. 0
            grid (_x, y + s) := grid (_x, y)
        end for
    end if
end shiftColumn

%shifts all columns at y down appropriately.
proc shiftColumns (y : int)
    for x : 1 .. width
        var n := shiftBy (x, y)
        % var n := 1
        shiftColumn (x, y - n, n)
    end for
end shiftColumns

%sets row at y to 0
proc deleteRow (y : int)
    for x : 1 .. width
        grid (x, y) := 0
    end for
end deleteRow

%sets row at y to 0, then shifts columns at y down.
proc deleteAndShift (y : int)
    deleteRow (y)
    shiftColumns (y)
end deleteAndShift



%return true if row y is full, false otherwise
function checkRow (y : int) : boolean
    for x : 1 .. width
        if grid (x, y) = 0 then
            result false %if we found a zero, the row can't be full, so return false
        end if
    end for
    result true %If we got this far, the row must be full, so return true.
end checkRow


%This finds the lowest full row and returns its y value
function checkRows : int
    for decreasing y : height - 1 .. 0
        if checkRow (y) then
            result y
        end if
    end for
    result - 1 %If we didn't find any, return -1.
end checkRows

%Returns true if the player lost. False otherwise.
function checkLose : boolean
    for x : 1 .. width
        if grid (x, 0) not= 0 then %Simply check if the top row has anything in it.
            result true
        end if
    end for
    result false
end checkLose


/*
 ***************************
 *****Initialization *****
 ***************************
 */





%This function makes things legible later on
proc initCell (p : int, c : int, x : int, y : int)     
    pieces (p).cell (c).x := x
    pieces (p).cell (c).y := y
end initCell

%initializes all pieces in original orientation
%Pieces live on a 3x3 or 4x4 grid. They consist of 4 cells, each
%with (x,y) coordinates relative to the origin of the piece itself.
%Because these coordinates are relative, you must add the absolute coordinates
%(cPieceX, cPieceY) to them to get the absolute position of each cell.
%Colors are also assigned at this time.
proc initPieces     
    %I
    initCell (0, 0, 0, 1)
    initCell (0, 1, 1, 1)
    initCell (0, 2, 2, 1)
    initCell (0, 3, 3, 1)
    pieces (0).shift := 3
    pieces (0).c := red

    %L
    initCell (1, 0, 0, 0)
    initCell (1, 1, 0, 1)
    initCell (1, 2, 1, 1)
    initCell (1, 3, 2, 1)
    pieces (1).shift := 2
    pieces (1).c := blue
    %J
    initCell (2, 0, 2, 0)
    initCell (2, 1, 0, 1)
    initCell (2, 2, 1, 1)
    initCell (2, 3, 2, 1)
    pieces (2).shift := 2
    pieces (2).c := green
    %S
    initCell (3, 0, 0, 0)
    initCell (3, 1, 1, 0)
    initCell (3, 2, 1, 1)
    initCell (3, 3, 2, 1)
    pieces (3).shift := 2
    pieces (3).c := yellow + 5
    %Z
    initCell (4, 0, 0, 1)
    initCell (4, 1, 1, 1)
    initCell (4, 2, 1, 0)
    initCell (4, 3, 2, 0)
    pieces (4).shift := 2
    pieces (4).c := purple
    %T
    initCell (5, 0, 0, 1)
    initCell (5, 1, 1, 1)
    initCell (5, 2, 2, 1)
    initCell (5, 3, 1, 0)
    pieces (5).shift := 2
    pieces (5).c := brown
    %[]
    initCell (6, 0, 1, 1)
    initCell (6, 1, 1, 2)
    initCell (6, 2, 2, 1)
    initCell (6, 3, 2, 2)
    pieces (6).shift := 3
    pieces (6).c := 12
end initPieces

%sets up the empty board
proc initBoard
    %set the game area to 0
    for x : 0 .. width + 1
        for y : -3 .. height
            grid (x, y) := 0
        end for
    end for
   
    %set the floor to 1
    for x : 0 .. width + 1
        grid (x, height) := 1
    end for

    %set the walls to 1
    for y : 0 .. height
        grid (0, y) := 1
        grid (width + 1, y) := 1
    end for
end initBoard

%This inits everything. To start a new game, just call this function.
proc initialize
    initBoard
    initPieces
    currentPiece := pieces (Rand.Int (0, 6))
    %set the game variables to initial values
    cPieceX := 5
    cPieceY := 0 - currentPiece.shift

    keyReleased := 1
    lastTime := Time.Elapsed
    tickRate := 500
end initialize






/*
 *****************************
 *******  Graphics  ********
 *****************************
 */






%The grid is upside down relative to the screen. Flip y coordinates when drawing to
%keep things right-side-up.
function flip (y : int) : int
    result (-1) * y + height
end flip

%Draws the grid, including full cells.
proc drawGrid
    var f := Font.New ("Ariel:8")
    for x : 0 .. width + 1
        for _y : -3 .. height
            var y := flip (_y)
            if grid (x, _y) not= 0 then
                %Draw full cells
                Draw.FillBox (x * s, y * s, x * s + s, y * s + s, grid (x, _y))
            end if
           
            %Draw the empty cells/borders
            Draw.Box (x * s, y * s, x * s + s, y * s + s, white)
            Draw.Box ((x * s) + 1, (y * s) + 1, (x * s + s) - 1, (y * s + s) - 1, black)
        end for
    end for
   
    %This draws line numbers. Leave it in or take it out, doesn't matter.
    %Originally added for debugging purposes and never removed.
    for _y : 0 .. height
        var y := flip (_y)
        Font.Draw (intstr (y), 125, 10 * _y, f, black)
    end for
end drawGrid

%Draw piece p at (_x, _y)
proc drawPiece (_x : int, _y : int, p : piece, color : int)
    var x, y : int
    for i : 0 .. 3
        x := _x + p.cell (i).x
        y := flip (_y + p.cell (i).y)
        Draw.FillBox (x * s, y * s, x * s + s, y * s + s, p.c)
    end for
end drawPiece

%This writes a word vertically on the right side of the screen
%It does not play nice if you change width/height of the grid,
%because I am lazy. If you want to play at a different size,
%you should remove all calls to this function.
proc verticalWrite (word : string)
    var font := Font.New ("Ariel:30")
    var letterHeight, letterWidth : int
    var black_hole : int
    Font.Sizes (font, letterHeight, black_hole, black_hole, black_hole)
    var wLength := length (word)
    var totalHeight := wLength * letterHeight
    var vOffset := (maxy - totalHeight) div 2
    for i : 1 .. wLength
        var y := wLength - i
        letterWidth := Font.Width (word (i), font) div 2
        Font.Draw (word (i), 170 - letterWidth, y * letterHeight + vOffset, font, black)
    end for
end verticalWrite

%This just saves time later.
proc draw
    drawPiece (cPieceX, cPieceY, currentPiece, green)
    drawGrid
end draw



/*
 *********************
 *** Game States ***
 *********************
 */



%Main game. In this state, the game plays as normal.
%This state executes instantly. It only does one frame, then returns control to the
%state machine. No delays, no blocking. Milliseconds.
proc playing

    %Input's a bit funky.
    %First we check if a key is pressed, and if the assossiated action can be performed.
    %If keyReleased = 1, then stuff happens. Otherwise, nothing happens.
    %If no key was pressed, then keyReleased is set to 1.
    %This prevents holding the key down to rapidly rotate or move the piece.
    Input.KeyDown (keys)
    if keys (KEY_LEFT_ARROW) and checkLeft (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            cPieceX -= 1
            keyReleased := 0
        end if
    elsif keys (KEY_RIGHT_ARROW) and checkRight (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            cPieceX += 1
            keyReleased := 0
        end if
    elsif keys (KEY_UP_ARROW) and checkRotateRight (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            currentPiece := rotateRight (currentPiece)
            keyReleased := 0
        end if
    elsif keys (KEY_DOWN_ARROW) and checkBelow (currentPiece, cPieceX, cPieceY) then
        cPieceY += 1
        keyReleased := 0
    elsif keys ('p') then
        if keyReleased = 1 then
            state := states.paused
            keyReleased := 0
        end if

    else %No (useful) key was pressed, so we reset keyReleased
        keyReleased := 1
    end if



    %Pieces are timed to drop every tickRate milliseconds.
    %Instead of a delay that holds up the whole program, we let the program run
    %at max speed all the time. When enough time has passed, the piece drops.

    currentTime := Time.Elapsed     %record current time

    if (currentTime - lastTime > tickRate) then     %Check if tickRate milliseconds has elapsed
        if checkBelow (currentPiece, cPieceX, cPieceY) then
            cPieceY += 1     %If possible, move the piece
        else
            %If piece cannot move, then its position is recorded in the grid array
            setPiece (currentPiece, cPieceX, cPieceY)
            cPieceX := 5     %move the piece back to the top, and pick a new shape
            cPieceY := -2
            currentPiece := pieces (Rand.Int (0, 6))
            state := states.clearing %Switch states to check for full rows
            if checkLose then %If we lost, switch to lose state
                state := states.lose
            end if
        end if
        lastTime := currentTime     %record the time this frame occurred.
    end if
    cls
    draw
    verticalWrite ("Tetris!")
    View.Update
end playing

%in this state, the game is paused until p is pressed.
%This function executes instantly. It runs one frame, then returns control to
%the state machine. No delays, no blocking.
proc paused
    Input.KeyDown (keys)
    if keys ('p') then
        if keyReleased = 1 then
            state := states.playing     %if p is pressed, return to game
            keyReleased := 0
        end if
    else
        keyReleased := 1     %otherwise, stay in this state
    end if
    cls
    draw
    verticalWrite ("PAUSED")
    View.Update
end paused

%This state animates deleting and shifting rows.
%This does not execute instantly. It can take control for an arbitrary amount
%of time. When it's finished it returns control to the state machine.
proc clearing
    var delete := checkRows
    if delete < 0 then
        state := states.playing
        return
    end if
   
    %I break my own rule here and mix drawing with game logic, but this is a blocking
    %function anyway so screw it.
    deleteRow (delete)
    cls
    draw
    verticalWrite ("Awesome!")
    View.Update
    delay (100)
    shiftColumns (delete)
    cls
    draw
    verticalWrite ("Awesome!")
    View.Update
    delay (100)
end clearing

%This state executes when you lose.
%It is a blocking function.
proc lose
    var f := Font.New ("Ariel:16")
    cls
    draw
    verticalWrite ("You Lose!")
    View.Update
    delay (1000)
    cls
    initialize
    draw
    verticalWrite ("Get Ready!")
    View.Update
    state := states.playing
    loop
    Input.KeyDown (keys)
    exit when keys (KEY_ENTER)
    end loop
    cls
end lose

  /*
 *******************
 *** Main Loop ***
 *******************
 */


%screen width = (width + 2) * scale, height = (height+1) * scale
View.Set ("nocursor;offscreenonly;graphics:200;550")
initialize
state := states.playing

%The state machine is just a case statement in a loop. As code executes,
%the state changes. Instead of, say, a menu function calling an 'instructions'
%function, the menu function sets the state to 'instructions' and ends. Then
%The state machine, seeing the state, executes the 'instructions' procedure.
%When 'instructions' ends, it sets the state back to 'menu', and the machine
%executes 'menu' again.
%Obviously, I don't have a menu or instructions, but the concept is the same.

loop
    case state of
        label states.paused :
            paused
        label states.playing :
            playing
        label states.clearing :
            clearing
        label states.lose :
            lose
        label :
            exit
    end case
end loop
Sponsor
Sponsor
Sponsor
sponsor
Insectoid




PostPosted: Sat Jan 21, 2017 9:30 pm   Post subject: RE:Tetris!

Posting this gave me the motivation to fix that one issue, so now we've got sick chain reaction action! It makes the game a lot easier, so I reduced the tickrate to 100ms to increase the challenge.

Turing:
%Tetris

/*
 ************************
 **** Declarations ****
 ************************
 */






%x/y coordinates
type coord :
    record
        x : int
        y : int
    end record

%This represents a piece on the board.
%Note that it does not have absolute coordinates-
%There is only one active piece at a time, so I only have one set of global
%coordinates for the active piece- (cPieceX, cPieceY)
type piece :
    record
        cell : array 0 .. 3 of coord %Relative coordinates of each cell that makes up the piece
        shift : int %amount to shift by after rotating
        c : int %color of the piece
    end record

%height and width of the game board in cells
%Changing these shouldn't break the game itself, but rendering might not work.
%If you change height/width, you must also manually change height/width in the
%View.Set() line way at the bottom of this file.
const height := 50
const width := 10
const s := 10     %scale multiplier for drawing. s = width/height per cell in pixels.

var grid : array 0 .. width + 1, -3 .. height of int %A 2-d array represents the game board. Pieces spawn with negative y values, so the grid starts at -3
var pieces : array 0 .. 6 of piece     %This array holds one of each type of piece. Do not change. Should really be constant, but that just causes more pain.
var currentPiece : piece % This is the piece that is currently falling down
var cPieceX, cPieceY : int %The coordinates of the current piece

%timing
var tickRate : int %rate of fall, in milliseconds. Change this for different difficulty settings.
var currentTime : int %Stores the current time
var lastTime : int %Stores the time of last tick

%Input
var keys : array char of boolean
var keyReleased : int %keypresses only register when this is true. Prevents press-and-hold.

%Execution is controlled by a state machine
type states : enum (paused, playing, clearing, lose) %These are all the possible states
var state : states %the current state. This decides what code runs in the main loop.





/*
 **************************
 **** Piece Behavior ****
 **************************
 */







%Rotates a piece clockwise when r = 1, ccw when r = -1
%Should only be called on currentPiece or newly created pieces
%Do not use on pieces array
function rotatePiece (p : piece, r : int) : piece
    var out : piece %We don't want to edit p, so we make a new piece to return
    out.shift := p.shift
    out.c := p.c

    %Iterate over each piece segment and rotate it about the origin
    for i : 0 .. 3

        %This rotates the piece about the origin relative to the cells.
        %It's a long way of saying 'x := -y, y := -x'.
        out.cell (i).x := p.cell (i).y * r * -1
        out.cell (i).y := p.cell (i).x * r

        %This is an over-complicated way to say 'if left, shift right. If right, shift up'.
        %When we rotate a piece left, the x value becomes negative
        %When we rotate right, the y value becomes negative
        %So we shift up or right to push it back into positive land.
        %Can't just multiply x -1, because that flips the piece. We only want to
        %shift it
        out.cell (i).x += (r + 1) div 2 * p.shift
        out.cell (i).y -= (r - 1) div 2 * p.shift
    end for
    result out
end rotatePiece

%Here are some functions that just make things easier to read and write later on.
function rotateLeft (p : piece) : piece
    result rotatePiece (p, -1)
end rotateLeft

function rotateRight (p : piece) : piece
    result rotatePiece (p, 1)
end rotateRight

%returns true if cell is taken. False otherwise.
%We get a LOT of mileage out of this function.
function checkCell (x : int, y : int) : boolean
    result (grid (x, y) not= 0)
end checkCell


%returns true if piece p fits at (x,y)
function checkPiece (p : piece, x : int, y : int) : boolean
    for i : 0 .. 3
        if checkCell (p.cell (i).x + x, p.cell (i).y + y) then
            result false
        end if
    end for
    result true
end checkPiece

%Here's some more dinky little functions that make things easier to read

%result true if piece fits at (x, y+1)
function checkBelow (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x, y + 1)
end checkBelow

%result true if piece fits at (x-1, y)
function checkLeft (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x - 1, y)
end checkLeft

%result true if piece fits at (x+1, y)
function checkRight (p : piece, x : int, y : int) : boolean
    result checkPiece (p, x + 1, y)
end checkRight

%result true if piece can rotate right at (x, y)
function checkRotateRight (_p : piece, x : int, y : int) : boolean
    %I expected this function to be a pain to write,
    %but it turns out I already did all the work!
    %Just make a new piece, rotate it with the function we already have,
    %then check if that new piece can fit in (x, y), using the other function
    %we already have!
    var p : piece := rotateRight (_p)
    result checkPiece (p, x, y)
end checkRotateRight

%result true if piece can rotate left at (x,y)
function checkRotateLeft (_p : piece, x : int, y : int) : boolean
    var p : piece := rotateLeft (_p)
    result checkPiece (p, x, y)
end checkRotateLeft



%When a piece is falling, it is separate from the grid. It's drawn there,
%but if you look at the array itself, you'll find all 0's (ie empty) where the piece is supposed
%to be. The piece is only ever added to the grid array when it stop. This way, we
%don't have to think about it anymore.
%This is the function that does that.
proc setPiece (p : piece, _x : int, _y : int)
    for i : 0 .. 3 %iterate over every segment of the piece
        var x := p.cell (i).x + _x %save it to the array
        var y := p.cell (i).y + _y
        grid (x, y) := p.c
    end for
end setPiece




/*
 ******************************
 **** Full Row Handling ****
 ******************************
 */




%Returns value of s at (_x, _y) for proc shiftColumn (_x, _y, s)
%shiftColumn needs to know how much to shift the column by.
%This function figures that out.
%Currently, when a row is deleted, blocks above will fall down and stop at that
%row, even if they could have fallen further. No plans to change at this time.
function shiftBy (_x : int, _y : int) : int
    var out : int := 0
    loop
        %var y := (-1) * (_y - out) + height

        %These commented out lines visualize how this function works.
        %Uncomment them if you're curious.
        /*
         %Draw.Box (10 * _x, 10 * y, 10 * _x + 10, 10 * y + 10, black)
         %View.Update
         %delay (10)
         */


        %...I forget how this part works.
        exit when _y - out <= 0 or grid (_x, _y - out) not= 0
        out += 1
    end loop
    result out
end shiftBy

%returns the number of consecutive empty spaces below (x, y)
function countEmptyDown (x : int, y : int) : int
    var out := 0
    loop
        exit when (out + y) >= (height - 1) or grid (x, y + out) not= 0
        out += 1
    end loop
    result out
end countEmptyDown

%shift column with base at (_x, _y) down by s
proc shiftColumn (_x : int, _y : int, s : int)
    if s > 0 and s < height then
        for decreasing y : _y .. 0
            grid (_x, y + s) := grid (_x, y)
        end for
    end if
end shiftColumn

%shifts all columns at y down appropriately.
proc shiftColumns (y : int)
    for x : 1 .. width
        var n := shiftBy (x, y)
        % var n := 1
        shiftColumn (x, y - n, n+countEmptyDown (x, y))
    end for
end shiftColumns

%sets row at y to 0
proc deleteRow (y : int)
    for x : 1 .. width
        grid (x, y) := 0
    end for
end deleteRow

%sets row at y to 0, then shifts columns at y down.
proc deleteAndShift (y : int)
    deleteRow (y)
    shiftColumns (y)
end deleteAndShift



%return true if row y is full, false otherwise
function checkRow (y : int) : boolean
    for x : 1 .. width
        if grid (x, y) = 0 then
            result false %if we found a zero, the row can't be full, so return false
        end if
    end for
    result true %If we got this far, the row must be full, so return true.
end checkRow


%This finds the lowest full row and returns its y value
function checkRows : int
    for decreasing y : height - 1 .. 0
        if checkRow (y) then
            result y
        end if
    end for
    result - 1 %If we didn't find any, return -1.
end checkRows

%Returns true if the player lost. False otherwise.
function checkLose : boolean
    for x : 1 .. width
        if grid (x, 0) not= 0 then %Simply check if the top row has anything in it.
            result true
        end if
    end for
    result false
end checkLose


/*
 ***************************
 *****Initialization *****
 ***************************
 */





%This function makes things legible later on
proc initCell (p : int, c : int, x : int, y : int)
    pieces (p).cell (c).x := x
    pieces (p).cell (c).y := y
end initCell

%initializes all pieces in original orientation
%Pieces live on a 3x3 or 4x4 grid. They consist of 4 cells, each
%with (x,y) coordinates relative to the origin of the piece itself.
%Because these coordinates are relative, you must add the absolute coordinates
%(cPieceX, cPieceY) to them to get the absolute position of each cell.
%Colors are also assigned at this time.
proc initPieces
    %I
    initCell (0, 0, 0, 1)
    initCell (0, 1, 1, 1)
    initCell (0, 2, 2, 1)
    initCell (0, 3, 3, 1)
    pieces (0).shift := 3
    pieces (0).c := red

    %L
    initCell (1, 0, 0, 0)
    initCell (1, 1, 0, 1)
    initCell (1, 2, 1, 1)
    initCell (1, 3, 2, 1)
    pieces (1).shift := 2
    pieces (1).c := blue
    %J
    initCell (2, 0, 2, 0)
    initCell (2, 1, 0, 1)
    initCell (2, 2, 1, 1)
    initCell (2, 3, 2, 1)
    pieces (2).shift := 2
    pieces (2).c := green
    %S
    initCell (3, 0, 0, 0)
    initCell (3, 1, 1, 0)
    initCell (3, 2, 1, 1)
    initCell (3, 3, 2, 1)
    pieces (3).shift := 2
    pieces (3).c := yellow + 5
    %Z
    initCell (4, 0, 0, 1)
    initCell (4, 1, 1, 1)
    initCell (4, 2, 1, 0)
    initCell (4, 3, 2, 0)
    pieces (4).shift := 2
    pieces (4).c := purple
    %T
    initCell (5, 0, 0, 1)
    initCell (5, 1, 1, 1)
    initCell (5, 2, 2, 1)
    initCell (5, 3, 1, 0)
    pieces (5).shift := 2
    pieces (5).c := brown
    %[]
    initCell (6, 0, 1, 1)
    initCell (6, 1, 1, 2)
    initCell (6, 2, 2, 1)
    initCell (6, 3, 2, 2)
    pieces (6).shift := 3
    pieces (6).c := 12
end initPieces

%sets up the empty board
proc initBoard
    %set the game area to 0
    for x : 0 .. width + 1
        for y : -3 .. height
            grid (x, y) := 0
        end for
    end for

    %set the floor to 1
    for x : 0 .. width + 1
        grid (x, height) := 1
    end for

    %set the walls to 1
    for y : 0 .. height
        grid (0, y) := 1
        grid (width + 1, y) := 1
    end for
end initBoard

%This inits everything. To start a new game, just call this function.
proc initialize
    initBoard
    initPieces
    currentPiece := pieces (Rand.Int (0, 6))
    %set the game variables to initial values
    cPieceX := 5
    cPieceY := 0 - currentPiece.shift

    keyReleased := 1
    lastTime := Time.Elapsed
    tickRate := 100
end initialize






/*
 *****************************
 *******  Graphics  ********
 *****************************
 */






%The grid is upside down relative to the screen. Flip y coordinates when drawing to
%keep things right-side-up.
function flip (y : int) : int
    result (-1) * y + height
end flip

%Draws the grid, including full cells.
proc drawGrid
    var f := Font.New ("Ariel:8")
    for x : 0 .. width + 1
        for _y : -3 .. height
            var y := flip (_y)
            if grid (x, _y) not= 0 then
                %Draw full cells
                Draw.FillBox (x * s, y * s, x * s + s, y * s + s, grid (x, _y))
            end if

            %Draw the empty cells/borders
            Draw.Box (x * s, y * s, x * s + s, y * s + s, white)
            Draw.Box ((x * s) + 1, (y * s) + 1, (x * s + s) - 1, (y * s + s) - 1, black)
        end for
    end for

    %This draws line numbers. Leave it in or take it out, doesn't matter.
    %Originally added for debugging purposes and never removed.
    for _y : 0 .. height
        var y := flip (_y)
        Font.Draw (intstr (y), 125, 10 * _y, f, black)
    end for
end drawGrid

%Draw piece p at (_x, _y)
proc drawPiece (_x : int, _y : int, p : piece, color : int)
    var x, y : int
    for i : 0 .. 3
        x := _x + p.cell (i).x
        y := flip (_y + p.cell (i).y)
        Draw.FillBox (x * s, y * s, x * s + s, y * s + s, p.c)
    end for
end drawPiece

%This writes a word vertically on the right side of the screen
%It does not play nice if you change width/height of the grid,
%because I am lazy. If you want to play at a different size,
%you should remove all calls to this function.
proc verticalWrite (word : string)
    var font := Font.New ("Ariel:30")
    var letterHeight, letterWidth : int
    var black_hole : int
    Font.Sizes (font, letterHeight, black_hole, black_hole, black_hole)
    var wLength := length (word)
    var totalHeight := wLength * letterHeight
    var vOffset := (maxy - totalHeight) div 2
    for i : 1 .. wLength
        var y := wLength - i
        letterWidth := Font.Width (word (i), font) div 2
        Font.Draw (word (i), 170 - letterWidth, y * letterHeight + vOffset, font, black)
    end for
end verticalWrite

%This just saves time later.
proc draw
    drawPiece (cPieceX, cPieceY, currentPiece, green)
    drawGrid
end draw



/*
 *********************
 *** Game States ***
 *********************
 */



%Main game. In this state, the game plays as normal.
%This state executes instantly. It only does one frame, then returns control to the
%state machine. No delays, no blocking. Milliseconds.
proc playing

    %Input's a bit funky.
    %First we check if a key is pressed, and if the assossiated action can be performed.
    %If keyReleased = 1, then stuff happens. Otherwise, nothing happens.
    %If no key was pressed, then keyReleased is set to 1.
    %This prevents holding the key down to rapidly rotate or move the piece.
    Input.KeyDown (keys)
    if keys (KEY_LEFT_ARROW) and checkLeft (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            cPieceX -= 1
            keyReleased := 0
        end if
    elsif keys (KEY_RIGHT_ARROW) and checkRight (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            cPieceX += 1
            keyReleased := 0
        end if
    elsif keys (KEY_UP_ARROW) and checkRotateRight (currentPiece, cPieceX, cPieceY) then
        if keyReleased = 1 then
            currentPiece := rotateRight (currentPiece)
            keyReleased := 0
        end if
    elsif keys (KEY_DOWN_ARROW) and checkBelow (currentPiece, cPieceX, cPieceY) then
        cPieceY += 1
        keyReleased := 0
    elsif keys ('p') then
        if keyReleased = 1 then
            state := states.paused
            keyReleased := 0
        end if

    else %No (useful) key was pressed, so we reset keyReleased
        keyReleased := 1
    end if



    %Pieces are timed to drop every tickRate milliseconds.
    %Instead of a delay that holds up the whole program, we let the program run
    %at max speed all the time. When enough time has passed, the piece drops.

    currentTime := Time.Elapsed     %record current time

    if (currentTime - lastTime > tickRate) then     %Check if tickRate milliseconds has elapsed
        if checkBelow (currentPiece, cPieceX, cPieceY) then
            cPieceY += 1     %If possible, move the piece
        else
            %If piece cannot move, then its position is recorded in the grid array
            setPiece (currentPiece, cPieceX, cPieceY)
            cPieceX := 5     %move the piece back to the top, and pick a new shape
            cPieceY := -2
            currentPiece := pieces (Rand.Int (0, 6))
            state := states.clearing %Switch states to check for full rows
            if checkLose then %If we lost, switch to lose state
                state := states.lose
            end if
        end if
        lastTime := currentTime     %record the time this frame occurred.
    end if
    cls
    draw
    verticalWrite ("Tetris!")
    View.Update
end playing

%in this state, the game is paused until p is pressed.
%This function executes instantly. It runs one frame, then returns control to
%the state machine. No delays, no blocking.
proc paused
    Input.KeyDown (keys)
    if keys ('p') then
        if keyReleased = 1 then
            state := states.playing     %if p is pressed, return to game
            keyReleased := 0
        end if
    else
        keyReleased := 1     %otherwise, stay in this state
    end if
    cls
    draw
    verticalWrite ("PAUSED")
    View.Update
end paused

%This state animates deleting and shifting rows.
%This does not execute instantly. It can take control for an arbitrary amount
%of time. When it's finished it returns control to the state machine.
proc clearing
    var delete := checkRows
    if delete < 0 then
        state := states.playing
        return
    end if

    %I break my own rule here and mix drawing with game logic, but this is a blocking
    %function anyway so screw it.
    deleteRow (delete)
    cls
    draw
    verticalWrite ("Awesome!")
    View.Update
    delay (100)
    shiftColumns (delete)
    cls
    draw
    verticalWrite ("Awesome!")
    View.Update
    delay (100)
end clearing

%This state executes when you lose.
%It is a blocking function.
proc lose
    var f := Font.New ("Ariel:16")
    cls
    draw
    verticalWrite ("You Lose!")
    View.Update
    delay (1000)
    cls
    initialize
    draw
    verticalWrite ("Get Ready!")
    View.Update
    state := states.playing
    loop
        Input.KeyDown (keys)
        exit when keys (KEY_ENTER)
    end loop
    cls
end lose

 /*
 *******************
 *** Main Loop ***
 *******************
 */


%screen width = (width + 2) * scale, height = (height+1) * scale
View.Set ("nocursor;offscreenonly;graphics:200;550")
initialize
state := states.playing

%The state machine is just a case statement in a loop. As code executes,
%the state changes. Instead of, say, a menu function calling an 'instructions'
%function, the menu function sets the state to 'instructions' and ends. Then
%The state machine, seeing the state, executes the 'instructions' procedure.
%When 'instructions' ends, it sets the state back to 'menu', and the machine
%executes 'menu' again.
%Obviously, I don't have a menu or instructions, but the concept is the same.

loop
    case state of
        label states.paused :
            paused
        label states.playing :
            playing
        label states.clearing :
            clearing
        label states.lose :
            lose
        label :
            exit
    end case
end loop
Display posts from previous:   
   Index -> Programming, Turing -> Turing Submissions
View previous topic Tell A FriendPrintable versionDownload TopicRate TopicSubscribe to this topicPrivate MessagesRefresh page View next topic

Page 1 of 1  [ 2 Posts ]
Jump to:   


Style:  
Search: