' Press Page Down for information on running and modifying QBlocks.
'
' To run this game, press Shift+F5.
'
' To exit this program, press ALT, F, X.
'
' To get help on a BASIC keyword, move the cursor to the keyword and press
' F1 or click the right mouse button.
'
' Suggested Changes
' -----------------
'
' There are many ways that you can modify this BASIC game. The CONST
' statements below these comments and the DATA statements at the end
' of this screen can be modified to change the following:
'
' Block shapes
' Block rotation
' Number of different block shapes
' Score needed to advance to next level
' Width of the game well
' Height of the game well
' Songs played during game
'
' On the right side of each CONST statement, there is a comment that tells
' you what it does and how big or small you can set the value. Above the
' DATA statements, there are comments that tell you the format of the
' information stored there.
'
' On your own, you can also add exciting sound and visual effects or make any
' other changes that your imagination can dream up. By reading the
' Learn BASIC Now book, you'll learn the techniques that will enable you
' to fully customize this game and to create games of your own.
'
' If the game won't run after you have changed it, you can exit without
' saving your changes by pressing Alt, F, X and choosing NO.
'
' If you do want to save your changes, press Alt, F, A and enter a filename
' for saving your version of the program. Before you save your changes,
' however, you should make sure they work by running the program and
' verifying that your changes produce the desired results. Also, always
' be sure to keep a backup of the original program.
'
DEFINT A-Z
' Here are the BASIC CONST statements you can change. The comments tell
' you the range that each CONST value can be changed, or any limitations.
CONST WELLWIDTH = 10 ' Width of playing field (well). Range 5 to 13.
CONST WELLHEIGHT = 21 ' Height of playing field. Range 4 to 21.
CONST NUMSTYLES = 7 ' Number of unique shapes. Range 1 to 20. Make sure you read the notes above the DATA statements at the end of the main program before you change this number!
CONST WINGAME = 1000000 ' Points required to win the game. Range 200 to 9000000.
CONST NEXTLEVEL = 300 ' Helps determine when the game advances to the next level. (Each cleared level gives player 100 points) Range 100 to 2000.
CONST BASESCORE = 1000 ' Number of points needed to advance to first level.
CONST ROTATEDIR = 1 ' Control rotation of blocks. Can be 1 for clockwise, or 3 for counterclockwise.
' The following sound constants are used by the PLAY command to
' produce music during the game. To change the sounds you hear, change
' these constants. Refer to the online help for PLAY for the correct format.
' To completely remove sound from the game set the constants equal to null.
' For example: PLAYINTRO = ""
CONST PLAYCLEARROW = "MBT255L16O4CDEGO6C" ' Tune played when a row is cleared. Range unlimited.
CONST PLAYINTRO = "MBT170O1L8CO2CO1CDCA-A-FGFA-F" ' Song played at game start. Range unlimited.
CONST PLAYGAMEOVER = "MBT255L16O6CO4GEDC" ' Song when the game is lost. Range unlimited.
CONST PLAYNEWBLOCK = "MBT160L28N20L24N5" ' Song when a new block is dropped. Range unlimited.
CONST PLAYWINGAME = "T255L16O6CO4GEDCCDEFGO6CEG" ' Song when game is won. Range unlimited.
' The following CONST statements should not be changed like the ones above
' because the program relies on them being this value.
CONST FALSE = 0 ' 0 means FALSE.
CONST TRUE = NOT FALSE ' Anything but 0 can be thought of as TRUE.
CONST SPACEBAR = 32 ' ASCII value for space character. Drops the shape.
CONST DOWNARROW = 80 ' Down arrow key. Drops the shape.
CONST RIGHTARROW = 77 ' Right arrow key. Moves the shape right.
CONST UPARROW = 72 ' Up arrow key. Rotates the shape.
CONST LEFTARROW = 75 ' Left arrow key. Moves the shape left.
CONST XMATRIX = 3 ' Width of the matrix that forms each falling unit. See the discussions in Suggested Changes #2 and #3.
CONST YMATRIX = 1 ' Depth of the matrix that forms each falling unit.
CONST BYTESPERBLOCK = 76 ' Number of bytes required to store one block in Screen mode 7.
CONST BLOCKVOLUME = (XMATRIX + 1) * (YMATRIX + 1) ' Number of blocks in each shape.
CONST ELEMENTSPERBLOCK = BLOCKVOLUME * BYTESPERBLOCK \ 2 ' Number of INTEGER array elements needed to store an image of a shape.
CONST XSIZE = 13 ' Width, in pixels, of each block. QBlocks assumes that the entire screen is 25 blocks wide. Since the screen is 320 pixels wide, each block is approximately 13 pixels wide.
CONST YSIZE = 8 ' Height, in pixels, of each block. Again, QBlocks assumes that screen is 25 blocks high. At 200 pixels down, each block is exactly 8 pixels high.
CONST XOFFSET = 10 ' X position, in blocks, of the well.
CONST YOFFSET = 2 ' Y position, in blocks, of the well.
CONST WELLX = XSIZE * XOFFSET ' X position, in pixels, of the start of the well.
CONST WELLY = YSIZE * YOFFSET ' Y position.
CONST TILTVALUE = 9999000 ' Points required for QBlocks to tilt.
CONST WELLCOLOR7 = 0 ' Well color for SCREEN 7.
CONST WELLCOLOR1 = 0 ' Well color for SCREEN 1.
CONST BORDERCOLOR1 = 8 ' Border color for SCREEN 1.
CONST BORDERCOLOR7 = 15 ' Border color for SCREEN 7.
TYPE BlockType ' Block datatype.
X AS INTEGER ' Horizontal location within the well.
Y AS INTEGER ' Vertical location within the well.
Style AS INTEGER ' Define shape (and color, indirectly).
Rotation AS INTEGER ' 4 possible values (0 to 3).
END TYPE
' SUB and FUNCTION declarations
DECLARE FUNCTION CheckFit ()
DECLARE FUNCTION GameOver ()
DECLARE SUB AddBlockToWell ()
DECLARE SUB CheckForFullRows ()
DECLARE SUB Center (M$, Row)
DECLARE SUB DeleteChunk (Highest%, Lowest%)
DECLARE SUB DisplayIntro ()
DECLARE SUB DisplayGameTitle ()
DECLARE SUB DisplayChanges ()
DECLARE SUB DrawBlock (X, Y, FillColor)
DECLARE SUB InitScreen ()
DECLARE SUB MakeInfoBox ()
DECLARE SUB NewBlock ()
DECLARE SUB PerformGame ()
DECLARE SUB RedrawControls ()
DECLARE SUB Show (b AS BlockType)
DECLARE SUB UpdateScoring ()
DECLARE SUB PutBlock (b AS BlockType)
DECLARE SUB DrawAllShapes ()
DECLARE SUB DrawPattern (Patttern)
DECLARE SUB DrawPlayingField ()
' DIM SHARED indicates that a variable is available to all subprograms.
' Without this statement, a variable used in one subprogram cannot be
' used by another subprogram or the main program.
DIM SHARED Level AS INTEGER ' Difficulty level. 0 is slowest, 9 is fastest.
DIM SHARED WellBlocks(WELLWIDTH, WELLHEIGHT) AS INTEGER ' 2 dimensional array to hold the falling shapes that have stopped falling and become part of the well.
DIM SHARED CurBlock AS BlockType ' The falling shape.
DIM SHARED BlockShape(0 TO XMATRIX, 0 TO YMATRIX, 1 TO NUMSTYLES) ' Holds the data required to make each shape. Values determined by the DATA statements at the end of this window.
DIM SHARED PrevScore AS LONG ' Holds the previous level for scoring purposes.
DIM SHARED Score AS LONG ' Score.
DIM SHARED ScreenWidth AS INTEGER ' Width of the screen, in character-sized units.
DIM SHARED ScreenMode AS INTEGER ' Value of the graphics screen mode used.
DIM SHARED WellColor AS INTEGER ' Color inside the well.
DIM SHARED BorderColor AS INTEGER ' Color of well border and text.
DIM SHARED OldBlock AS BlockType ' An image of the last CurBlock. Used to erase falling units when they move.
DIM SHARED TargetTime AS SINGLE ' Time to move the shape down again.
DIM SHARED GameTiltScore AS LONG ' Holds the value that this game will tilt at.
DIM SHARED Temp(11175) AS INTEGER ' Used by several GET and PUT statements to store temporary screen images.
DIM SHARED BlockColor(1 TO NUMSTYLES) AS INTEGER ' Block color array
DIM SHARED BlockImage((NUMSTYLES * 4 + 3) * ELEMENTSPERBLOCK) AS INTEGER ' Holds the binary image of each rotation of each shape for the PutBlock subprogram to use.
DIM KeyFlags AS INTEGER ' Internal state of the keyboard flags when game starts. Hold the state so it can be restored when the games ends.
DIM BadMode AS INTEGER ' Store the status of a valid screen mode.
ON ERROR GOTO ScreenError ' Set up a place to jump to if an error occurs in the program.
BadMode = FALSE
ScreenMode = 7
SCREEN ScreenMode ' Attempt to go into SCREEN 7 (EGA screen).
IF BadMode = TRUE THEN ' If this attempt failed.
ScreenMode = 1
BadMode = FALSE
SCREEN ScreenMode ' Attempt to go into SCREEN 1 (CGA screen).
END IF
ON ERROR GOTO 0 ' Turn off error handling.
IF BadMode = TRUE THEN ' If no graphics adapter.
CLS
LOCATE 10, 12: PRINT "CGA, EGA Color, or VGA graphics required to run QBLOCKS.BAS"
ELSE
RANDOMIZE TIMER ' Create a new sequence of random numbers based on the clock.
DisplayIntro ' Show the opening screen.
DEF SEG = 0 ' Set the current segment to the low memory area.
KeyFlags = PEEK(1047) ' Read the location that holds the keyboard flag.
IF (KeyFlags AND 32) = 0 THEN ' If the NUM LOCK key is off
POKE 1047, KeyFlays OR 32 ' set the NUM LOCK key to on.
END IF
DEF SEG ' Restore the default segment.
' Read the pattern for each QBlocks shape.
FOR i = 1 TO NUMSTYLES ' Loop for the each shape
FOR j = 0 TO YMATRIX ' and for the Y and X dimensions of
FOR k = 0 TO XMATRIX ' each shape.
READ BlockShape(k, j, i) ' Actually read the data.
NEXT k
NEXT j
NEXT i
DrawAllShapes ' Draw all shapes in all four rotations.
PerformGame ' Play the game until the player quits.
DisplayChanges ' Show the suggested changes.
DEF SEG = 0 ' Set the current segment back to low memory where the keyboard flags are.
POKE 1047, KeyFlags AND 233 ' Set the NUM LOCK key back to where it was at the game start.
DEF SEG ' Restore the current segment back to BASIC's data group area.
IF ScreenMode = 7 THEN PALETTE ' Restore the default color palette if SCREEN 7 was used.
END IF
END ' End of the main program code.
' The DATA statements below define the block shapes used in the game.
' Each shape contains 8 blocks (4 x 2). A "1" means that there
' is a block in that space; "0" means that the block is blank. The pattern
' for Style 1, for example, creates a shape that is 4 blocks wide.
' To change an existing block's shape, change a "0" to a "1" or a "1" to
' a "0". To add new shapes, insert new DATA statements with the same format
' as those below, after the last group of DATA statements (style 7). Be sure
' to change the NUMSTYLES constant at the beginning of this program to reflect
' the new number of block shapes for the game.
' IMPORTANT! Creating a completely blank block will cause QBlocks to fail.
' Data for Style 1: Long
DATA 1,1,1,1
DATA 0,0,0,0
' Data for Style 2: L Right
DATA 1,1,1,0
DATA 0,0,1,0
' Data for Style 3: L Left
DATA 0,1,1,1
DATA 0,1,0,0
' Data for Style 4: Z Right
DATA 1,1,0,0
DATA 0,1,1,0
' Data for Style 5: Z Left
DATA 0,1,1,0
DATA 1,1,0,0
' Data for Style 6: T
DATA 1,1,1,0
DATA 0,1,0,0
' Data for Style 7: Square
DATA 0,1,1,0
DATA 0,1,1,0
ScreenError: ' QBlocks uses this error handler to determine the highest available video mode.
ERASE WellBlocks ' Set all the elements in the WellBlocks array to 0.
Score = 0 ' Clear initial score.
Level = 0 ' Assume Level 0.
PrevScore = BASESCORE - NEXTLEVEL ' Set score needed to get to first level
GameTiltScore = WINGAME ' Set the initial win game value.
InitScreen ' Prepare the screen and get the difficulty level.
IF Level = -1 THEN EXIT SUB ' Player pressed Q instead of a level.
TargetTime = TIMER + 1 / (Level + 1) ' TargetTime is when the falling shape will move down again.
DO ' Create new falling shapes until the game is over.
DoneWithThisBlock = FALSE ' This falling shape is not done falling yet.
NewBlock ' Create a new falling unit.
IF CheckFit = FALSE THEN EXIT DO ' If it does not fit, then the game is over.
PutBlock CurBlock ' Display the new shape.
DO ' Continue dropping the falling shape.
OldBlock = CurBlock ' Save current falling shape for possible later use.
DO ' Loop until enough time elapses.
ValidEvent = TRUE ' Assume a key was pressed.
ans$ = UCASE$(INKEY$)
IF ans$ = PAUSE OR ans$ = QUIT THEN
MakeInfoBox
' SELECT CASE will do different actions based on the
' value of the SELECTED variable.
SELECT CASE ans$
CASE PAUSE
SOUND 1100, .75
LOCATE 16, 6: PRINT "GAME";
LOCATE 18, 5: PRINT "PAUSED";
DO WHILE INKEY$ = "": LOOP ' Wait until another key is pressed.
CASE QUIT
' Play sounds to tell the player that Q was pressed.
SOUND 1600, 1
SOUND 1000, .75
' Confirm that the player really wants to quit.
LOCATE 15, 5: PRINT "Really";
LOCATE 17, 6: PRINT "quit?";
LOCATE 19, 6: PRINT "(Y/N)";
DO
a$ = UCASE$(INKEY$)
LOOP UNTIL a$ <> ""
IF a$ = "Y" THEN EXIT SUB
END SELECT
RedrawControls ' Redraw controls if either Q or P is pressed.
ELSE ' A key was pressed but not Q or P.
ans = ASC(RIGHT$(CHR$(0) + ans$, 1)) ' Convert the key press to an ASCII code for faster processing.
SELECT CASE ans
CASE DOWNARROW, DOWNARROW2, SPACEBAR ' Drop shape immediately.
DO ' Loop to drop the falling unit one row at a time.
CurBlock.Y = CurBlock.Y + 1
LOOP WHILE CheckFit = TRUE ' Keep looping while the falling unit isn't stopped.
CurBlock.Y = CurBlock.Y - 1 ' Went one down too far, restore to previous.
TargetTime = TIMER - 1 ' Ensure that the shape falls immediately.
CASE RIGHTARROW, RIGHTARROW2
CurBlock.X = CurBlock.X + 1 ' Move falling unit right.
CASE LEFTARROW, LEFTARROW2
CurBlock.X = CurBlock.X - 1 ' Move falling unit left.
CASE UPARROW, UPARROW2, UPARROW3
CurBlock.Rotation = ((CurBlock.Rotation + ROTATEDIR) MOD 4) ' Rotate falling unit.
CASE ELSE
ValidEvent = FALSE
END SELECT
IF ValidEvent = TRUE THEN
IF CheckFit = TRUE THEN ' If the move is valid and the shape fits in the new position,
PutBlock OldBlock ' erase the shape from its old position
PutBlock CurBlock ' and display it in the new position.
OldBlock = CurBlock
ELSE
CurBlock = OldBlock ' If it does not fit then reset CurBlock to the OldBlock.
END IF
END IF
END IF
LOOP UNTIL TIMER >= TargetTime ' Keep repeating the loop until it is time to drop the shape. This allows many horizontal movements and rotations per vertical step.
TargetTime = TIMER + 1 / (Level + 1) ' The player has less time between vertical movements as the skill level increases.
CurBlock.Y = CurBlock.Y + 1 ' Try to drop the falling unit one row.
IF CheckFit = FALSE THEN ' Cannot fall any more.
DoneWithThisBlock = TRUE ' Done with this block.
CurBlock = OldBlock
END IF
PutBlock OldBlock ' Erase the falling shape from the old position,
PutBlock CurBlock ' and display it in the new position.
OldBlock = CurBlock
LOOP UNTIL DoneWithThisBlock ' Continue getting keys and moving shapes until the falling shape stops.
AddBlockToWell ' Shape has stopped so logically add it to the well.
CheckForFullRows ' Check to see if a row(s) is now full. If so, deletes it.
UpdateScoring ' Use the UpdateScoring subprogram to add to the score.
IF Score >= GameTiltScore THEN ' See if the score has hit the tilt score.
PLAY PLAYWINGAME
MakeInfoBox
LOCATE 13, 5: PRINT USING "#######"; Score
PLAY PLAYWINGAME
IF GameTiltScore = TILTVALUE THEN ' If the player has tilted the game.
LOCATE 15, 4: PRINT "GAME TILT"
LOCATE 17, 5: PRINT "You are"
LOCATE 18, 4: PRINT "Awesome!"
LOCATE 20, 4: PRINT "Press any"
LOCATE 21, 6: PRINT "key..."
PLAY PLAYWINGAME
DO WHILE INKEY$ = "": LOOP
EXIT SUB
ELSE ' If they just met the WINGAME value.
LOCATE 15, 4: PRINT "YOU WON!"
LOCATE 17, 5: PRINT "Want to"
LOCATE 18, 4: PRINT "continue"
LOCATE 20, 6: PRINT "(Y/N)"
DO ' DO loop to wait for the player to press anything.
a$ = UCASE$(INKEY$) ' The UCASE$ function assures that a$ always has an uppercase letter in it.
LOOP UNTIL a$ <> ""
IF a$ <> "Y" THEN EXIT DO ' Exit this main loop if the player pressed anything but Y.
GameTiltScore = TILTVALUE ' Reset to the tilt value.
RedrawControls
END IF
END IF
LOOP ' Unconditional loop. Each game is stopped by the EXIT DO command at the top of this loop that executes when a new block will not fit in the well.
LOOP UNTIL GameOver ' GameOver is always TRUE (-1) unless the user presses X or the well is full.
SELECT CASE b.Rotation ' Base exact placement on the rotation.
CASE 0 ' No rotation.
x1 = b.X: y1 = b.Y
CASE 1 ' Rotated 90 degrees clockwise, or 270 degrees counterclockwise.
x1 = b.X + 1: y1 = b.Y - 1
CASE 2 ' Rotated 180 degrees.
x1 = b.X: y1 = b.Y
CASE 3 ' Rotated 270 degrees clockwise, or 90 degrees counterclockwise.
x1 = b.X + 1: y1 = b.Y - 1
END SELECT
' Actually PUT the rotated shape on the screen. The XOR option makes the
' new image blend with whatever used to be there in such a way that
' identical colors cancel each other out. Therefore, one PUT with the XOR
' option can draw an object while the second PUT to that same location
' erases it without affecting anything else near it. Often used for animation.
PUT (x1 * XSIZE + WELLX, y1 * YSIZE + WELLY), BlockImage(((b.Style - 1) * 4 + b.Rotation) * ELEMENTSPERBLOCK), XOR ' XOR mixes what used to be there on the screen with the new image. Two identical colors cancel each other.
