Tetris!
| Author |
Message |
Insectoid
|
 Posted: 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
|
|
|
Insectoid
|
| Posted: 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
|
|
|
|
|
|
|
|
|
Register
Wiki
Blog
Search
Turing
Chat Room
Members
