ACE
Tetris
by
Ricardo F. Lopes
; Tetris
; A Tetris game for the Jupiter Ace
; from the Jupiter Ace Archive Team - www.jupiter-ace.co.uk
; Compile using TASM assembler:
; TASM -80 -b -l tetris.asm tetris.tap
; Run from Jupiter Ace with:
; LOAD tetris tetris
#define FILENAME .TEXT "tetris "
; keep it exactly 10 chars long! |----------|
#include "ace.inc"
;=======================================================================
; Constants
;=======================================================================
LEVEL_TIMER_0 .EQU 2500 ; Level Timer (loop count to level up)
DLY_INNER .EQU 2000 ; Inner Delay Factor (keyboard scans)
DLY_OUTER .EQU 54 ; Outer Delay Factor
DLY_LEVEL_STEP .EQU 5 ; Delay Decrease Factor by Level
PIT_WIDTH .EQU 10 ; Width of playing field
PIT_DEPTH .EQU 20 ; Height of playing field
SCREEN_LINE .EQU 32 ; Screen Line Width
TOP_LINE .EQU SCREEN + SCREEN_LINE + 11 ; Tetris Pit Top Line
INIT_POS .EQU TOP_LINE - SCREEN_LINE + 3 ; Initial Piece Screen Address
NEXT_POS .EQU SCREEN + (3 * SCREEN_LINE) + 3 ; Next Piece Frame Screen Address
MAX_LEVEL .EQU 10 ; Maximum Game Level
; -------------------- Keys --------------------------------------------
KEY_LEFT .EQU 'j'
KEY_DROP .EQU 'k'
KEY_RIGHT .EQU 'l'
KEY_TURN .EQU 'i'
KEY_PAUSE .EQU 'p'
KEY_QUIT .EQU 'q'
; --------------------- Characters -------------------------------------
CHR_BRICK .EQU 58
CHR_TILE .EQU 59
CHR_TILE2 .EQU 60
CHR_BLOCK .EQU 160
CHR_TOP_LEFT .EQU 148
CHR_TOP_RIGHT .EQU 23
CHR_BOT_LEFT .EQU 145
CHR_BOT_RIGHT .EQU 146
CHR_TOP .EQU 19
CHR_BOTTOM .EQU 147
CHR_LEFT .EQU 149
CHR_RIGHT .EQU 21
;=======================================================================
; Variables
;=======================================================================
; Using Floating Point workspace (max 19 bytes) for variables
Score .EQU FpWs ; 2 bytes Score
Lines .EQU FpWs + 2 ; 2 bytes Lines removed
Level .EQU FpWs + 4 ; 2 bytes Current Level
Rotation .EQU FpWs + 6 ; 1 byte Piece Rotation (bits 2-3)
Piece .EQU FpWs + 7 ; 1 byte Current piece (bits 4-6)
Next .EQU FpWs + 8 ; 1 byte Next piece (bits 4-6)
DelayFactor .EQU FpWs + 9 ; 1 byte Delay Factor
DelayCount .EQU FpWs + 10 ; 1 byte Delay Count
LastKey .EQU FpWs + 11 ; 1 byte Holds last Key pressed
Temp .EQU FpWs + 12 ; 1 byte General usage
LevelTimer .EQU FpWs + 13 ; 2 bytes Level Timer
;=======================================================================
; Tape File Header
;=======================================================================
.ORG DICT_START - 30 ; Make room for Tape file header
.WORD 26 ; TAP 1st chunck size
HEADER_BLK: .BYTE 00 ; File Type
FILENAME ; Filename (10 bytes)
.WORD DATA_BLK_END - DATA_BLK ; File Lenght
.WORD DICT_START ; Start Address
.WORD TETRIS_LNK ; link to newest word
.WORD 3C4Ch ; CURRENT
.WORD 3C4Ch ; CONTEXT
.WORD 3C4Fh ; VOCLNK
.WORD DATA_BLK_END ; STKBOT
.CHK HEADER_BLK ; Header Block CheckSum
.WORD DATA_BLK_END-DATA_BLK + 1 ; TAP 2nd chunck size
DATA_BLK: ; Data Block Start
;=======================================================================
; TETRIS word header
;=======================================================================
TETRIS: .BYTE "TETRI",'S' | BIT_INVERSE ; Word Name
.WORD TETRIS_END - $ ; Word Lenght Field
.WORD 3C49h ; Link Field
TETRIS_LNK: .BYTE $ - TETRIS - 4 ; Name Lenght Field
.WORD gameStart ; Code Field Address
;=======================================================================
; Tetris code
;=======================================================================
; 'Piece' bits: 76543210
; 0|||||^^---> Tile index (4 tiles/piece)
; |||^^-----> Rotation (4 possible orientations)
; ^^^-------> Piece Number (0 to 7)
;-----------------------------------------------------------------------;
; Main Tetris Code ;
;-----------------------------------------------------------------------;
; Set Programmable Characters
gameStart:
LD HL,TBL_CHARACTERS ; Character pattern table
LD DE,CHAR_SET + (8 * 48) ; Starting with character '0' (ASCII 48)
LD BC,13 * 8 ; 13 Characters: Numbers 0-9, brick & tiles
LDIR
; Initialize Variables
initialize:
LD HL,FpWs ; Fill all 19 bytes of FpWs with 0
LD DE,19
LD B,0
CALL fill
CALL levelUp ; Set Initial Level to 1
; Draw Game Screen -----------------------------------------------------
; Fill Screen Background
LD HL,SCREEN ; From screen top left
LD DE,SCREEN_LINE * 23 ; All Screen lines
LD B,CHR_BRICK ; Fill with Brick Char
CALL fill
; Draw Pit
LD HL,STR_TETRIS ; Pit Top
CALL printInverseString
LD DE,SCREEN_LINE - 12 ; Move pointer to next line
ADD HL,DE
LD C,PIT_DEPTH
nextPitLine:
LD (HL),' ' | BIT_INVERSE ; Left Border
INC HL
CALL clearLine ; Pit Line
LD (HL),' ' | BIT_INVERSE ; Right Border
LD DE, SCREEN_LINE - 11 ; Move pointer to next line
ADD HL,DE
DEC C ; Draw all lines
JR NZ,nextPitLine
LD HL,STR_PIT_BOTTOM ; Pit Bottom
CALL printInverseString
; Draw Frames with labels
LD HL,STR_NEXT ; "Next" Frame String
LD C,4 ; Frame Height
CALL drawFrame
LD HL,STR_SCORE ; "Score" Frame String
LD C,1 ; Frame Height
CALL drawFrame
LD HL,STR_LEVEL ; "Level" frame string
LD C,1 ; Frame Height
CALL drawFrame
LD HL,STR_LINES ; "Lines" frame string
LD C,1 ; Frame Height
CALL drawFrame
; Print other Labels
LD HL,STR_JAAT ; Jupiter Ace Archive Team
CALL printInverseString
LD HL,STR_YEAR ; Year
CALL printInverseString
LD HL,STR_KEY_LEFT ; Instruction
CALL printInverseString
LD HL,STR_KEY_RIGHT ; Instruction
CALL printInverseString
LD HL,STR_KEY_TURN ; Instruction
CALL printInverseString
LD HL,STR_KEY_DROP ; Instruction
CALL printInverseString
LD HL,STR_KEY_PAUSE ; Instruction
CALL printInverseString
LD HL,STR_KEY_QUIT ; Instruction
CALL printInverseString
; Generate and show a random Next Piece
CALL nextRandom
; Main Game Loop -----------------------------------------------------
newPiece:
LD A,(Next) ; Current Piece = Next Piece
LD (Piece),A
CALL unDrawNextPiece ; Undraw "Next Piece"
LD HL,INIT_POS ; Set Initial Position
LD (ScrPos),HL
XOR A ; Reset Rotation
LD (Rotation),A
CALL nextRandom ; Generate a new "Next Piece" and show it
; Check if piece can be draw. If not, Game Over
LD A,(Piece) ; Get Piece
LD HL,Rotation ; Apply rotation
OR (HL)
LD DE,(ScrPos) ; Get Screen Address
CALL checkDraw ; Piece can be draw?
JR NZ,gameOver ; If not, Game Over
; Check Level Timer. (Is it time to level up?)
LD HL,LevelTimer + 1 ; Check Level Timer high byte
BIT 7,(HL) ; Is Timer < 0 ?
CALL NZ,levelUp ; Yes, advance Level
; Calculate Delay Factor based on current Game Level
LD A,(Level) ; Calculate Outer Delay factor..
LD B,A ; ..based on current Level
LD A,DLY_OUTER
_delayDecrease: ; A = DLY_OUTER - Level*DLY_LEVEL_STEP
SUB DLY_LEVEL_STEP
DJNZ _delayDecrease
LD (DelayFactor),A
CALL printScore ; Show score
pieceLoop:
CALL drawCurrentPiece ; Draw Piece
LD A,(DelayFactor) ; Initialize Delay Countdown
LD (DelayCount),A
delayLoop:
LD HL,(LevelTimer) ; Decrement Level Timer
DEC HL
LD (LevelTimer),HL
; Inner delay loop
LD BC,DLY_INNER ; Initialize Inner delay loop
shortDelay:
DEC BC
LD A,B
OR C
JR NZ,shortDelay
; Check for user input
CALL scanKeyboard ; Get Keypress
LD HL,LastKey ; Check if it was just pressed
CP (HL)
LD (LastKey),A ; Save it
JR Z,noUserInput
CP KEY_QUIT ; Check for Quit Game request
JR Z,gameOver
CALL userAction ; Execute User requested action
noUserInput:
LD HL,DelayCount ; Decrement Delay Count
DEC (HL)
JR NZ,delayLoop ; Loop if not done
CALL unDrawCurrentPiece ; Undraw Piece
; Check if piece can be draw just below current position
LD A,(Piece) ; Get Piece
LD HL,Rotation ; Apply rotation
OR (HL)
LD HL,(ScrPos) ; Point to one line below
LD BC,SCREEN_LINE
ADD HL,BC
EX DE,HL
CALL checkDraw ; Can be draw?
JR NZ,stopPiece ; No, Stop this Piece
; Move Piece One Line Down
LD HL,(ScrPos) ; Get current position
LD BC,SCREEN_LINE ; Add one line
ADD HL,BC
LD (ScrPos),HL ; Update variable
CALL drawCurrentPiece ; Draw Piece
JP pieceLoop
stopPiece:
CALL drawCurrentPiece
CALL collectLines ; Collect Filled Lines, updating score
LD A,KEY_DROP ; Stop dropping command
LD (LastKey),A
JP newPiece
gameOver:
LD HL,STR_GAME ; Print 'Game Over'
CALL printInverseString
LD HL,STR_OVER ; Print 'Game Over'
CALL printInverseString
CALL playGameOverBuzz
CALL waitKeyPress ; Wait for any key press to proceed
JP initialize ; Play again
;------------- Main code end --------------
;-----------------------------------------------------------------------;
; Fill memory area with a byte ;
;-----------------------------------------------------------------------;
; Input: HL = Start address | Output: HL = Next Address
; DE = Lenght | DE = 0
; B = Byte to use | A = 0
; Affects: A D E H L
fill:
LD (HL),B
INC HL
DEC DE
LD A,D
OR E
JR NZ,fill
RET
;-----------------------------------------------------------------------;
; Fill Pit Line with a character ;
;-----------------------------------------------------------------------;
; Input: HL = Line Address | Output: HL = Next Screen Position
; A = Character to use
; Affects: B
fillLine:
LD B,PIT_WIDTH
_fillLineLoop:
LD (HL),A
INC HL
DJNZ _fillLineLoop
RET
;-----------------------------------------------------------------------;
; Clear Line ;
;-----------------------------------------------------------------------;
; Input: HL = Line Address | Output: HL = Next screen position
; Affects: A, B
clearLine:
LD A,' '
JP fillLine
;-----------------------------------------------------------------------;
; Highlight a Line ;
;-----------------------------------------------------------------------;
; Input: HL = Line Address | Output: HL = Next screen position
; Affects: A, B
highlightLine:
LD A,CHR_TILE2
JP fillLine
;-----------------------------------------------------------------------;
; Print String in Inverse Video ;
;-----------------------------------------------------------------------;
; Input: HL = String (scren address prefix, zero terminated)
; Output: HL = next screen position
printInverseString:
LD E,(HL) ; Get Screen address
INC HL
LD D,(HL)
INC HL
EX DE,HL ; DE = Zero terminated string address
_nextPrintInv: ; HL = Screen address
LD A,(DE) ; Get char from string
OR A ; No more chars? (0)
RET Z ; Return
OR BIT_INVERSE ; Make it inverse video
LD (HL),A ; Place character
INC HL ; Advance string char pointer
INC DE ; Advance screen position
JR _nextPrintInv ; Print next character
;-----------------------------------------------------------------------;
; Draw a Frame of width 7 ;
;-----------------------------------------------------------------------;
; Input: HL = Title String (screen address prefix, zero terminated)
; C = Frame Height
drawFrame:
PUSH HL ; Save string pointer
LD E,(HL) ; Get screen address to DE
INC HL
LD D,(HL)
POP HL ; Recover string pointer
PUSH DE ; Save screen address
CALL printInverseString
POP DE ; Recover screen address
; Calculate Frame Width
OR A ; Clear Carry Before Subtraction
SBC HL,DE ; Current Address - Initiaql Address
LD A,L ; A = Frame Width
DEC A ; Adjust for internal width (excluding borders)
DEC A
EX DE,HL ; HL = Screen Address
LD DE,SCREEN_LINE ; Advance to Next Line
ADD HL,DE
PUSH HL ; Save Current Address
LD (HL),CHR_TOP_LEFT ; Draw Top Left Corner
INC HL
LD B,A ; B = Frame Width
_frameTopLine: ; Draw Frame Top Line
LD (HL),CHR_TOP
INC HL
DJNZ _frameTopLine
LD (HL),CHR_TOP_RIGHT ; Draw Top Right Corner
POP HL ; Recover Line Start Address
ADD HL,DE ; Advance to Next Line
_nextFrameLine: ; Draw Frame Lines
PUSH HL
LD (HL),CHR_LEFT
INC HL
LD B,A ; Frame Width
_frameLine:
LD (HL),' '
INC HL
DJNZ _frameLine
LD (HL),CHR_RIGHT
POP HL
ADD HL,DE ; Next Line
DEC C
JR NZ,_nextFrameLine
LD (HL),CHR_BOT_LEFT ; Draw Frame Bottom Line
INC HL
LD B,A ; Frame Width
_frameBotLine:
LD (HL),CHR_BOTTOM
INC HL
DJNZ _frameBotLine
LD (HL),CHR_BOT_RIGHT
RET
;-----------------------------------------------------------------------;
; Print Integer Value (2 bytes) with left zero suppression ;
;-----------------------------------------------------------------------;
; Input: HL = Integer number to print
; DE = Screen Location
; Affects: A B C D E H L and the variable 'Temp'
; (code adapted from web page "Z80 bits" by Milos Bazelides)
printValue:
LD A,' ' ; Prepare for left zeroes suppression
LD (Temp),A
LD BC,-10000 ; Print 10000th
CALL _printTh
LD BC,-1000 ; Print 1000th
CALL _printTh
LD BC,-100 ; Print 100th
CALL _printTh
LD C,-10 ; Print 10th
CALL _printTh
LD C,-1 ; Print units
LD A,'0' ; rightmost algarism not to be suppressed
LD (Temp),A
_printTh:
LD A,'0' - 1
_printThLoop:
INC A
ADD HL,BC
JR C,_printThLoop
SBC HL,BC
CP '0' ; algarism is 0, suppress it
JR Z,_zeroSuppress
LD (DE),A ; Print non-zero algarism to the screen
INC DE ; Advance screen pointer
LD A,'0' ; Stop zero suppression on next algarism
LD (Temp),A
RET
_zeroSuppress:
LD A,(Temp) ; Print SPACE or 0 to the screen
LD (DE),A
INC DE ; Advance screen pointer
RET
;-----------------------------------------------------------------------;
; Print Score ;
;-----------------------------------------------------------------------;
printScore:
LD HL,(Score) ; Print Score
LD DE,SCREEN+( 3*SCREEN_LINE)+24
CALL printValue
LD HL,(Level) ; Print Level
LD DE,SCREEN+(9*SCREEN_LINE)+24
CALL printValue
LD HL,(Lines) ; Print Lines
LD DE,SCREEN+(15*SCREEN_LINE)+24
CALL printValue
RET
;-----------------------------------------------------------------------;
; Increment Level ;
;-----------------------------------------------------------------------;
; Affects: A H L
levelUp:
LD HL,LEVEL_TIMER_0 ; Reset Level Timer
LD (LevelTimer),HL
LD HL,Level ; Level reached ?
LD A,MAX_LEVEL
XOR (HL)
RET Z
INC (HL) ; Increment Level
CALL playLevelUpBip
RET
;-----------------------------------------------------------------------;
; Get Current Piece with Rotation applyed ;
;-----------------------------------------------------------------------;
; Output: A = Piece with Rotation
; DE = Screen Address
; Affects: A D E H L
getPiece:
LD A,(Piece) ; Get piece
LD HL,Rotation ; and apply rotation
OR (HL)
LD DE,(ScrPos) ; Get Screen Address
RET
;-----------------------------------------------------------------------;
; Draw Piece ;
;-----------------------------------------------------------------------;
; Input: A = Piece with rotation already applied
; C = Character to use when drawing
; DE = Screen Address
drawPiece:
LD HL,TBL_PIECES ; Point to Piece Pattern
ADD A,L ; Table location = HL + A
JR NC,_draw1
INC H
_draw1:
LD L,A
LD B,4 ; Four tiles to draw
_drawNextTile:
LD A,(HL) ; Get tile offset
ADD A,E ; Apply offset to screen address
JR NC,_placeBrick
INC D
_placeBrick:
LD E,A
LD A,C
LD (DE),A ; Place a Brick into screen
INC HL ; Point to Next tile offset
DJNZ _drawNextTile
RET
;-----------------------------------------------------------------------;
; Check if piece can be draw ;
;-----------------------------------------------------------------------;
; Input: A = Piece with rotation applied
; DE = Screen Address
; Output: Zero flag set if no other tile on the way
checkDraw:
LD HL,TBL_PIECES ; Piece Pattern Table Address
LD C,A
LD B,0 ; Expand BC to 16 bits before adding
ADD HL,BC ; Find correct position in table (HL)
LD B,4 ; Every piece has 4 tiles
_checkNextTile:
LD A,(HL) ; Get tile offset
ADD A,E ; Apply offset to screen address
JR NC,_checkTile
INC D
_checkTile:
LD E,A
LD A,(DE) ; Read a Tile from screen
CP ' ' ; Check if not a Space
RET NZ
INC HL ; Point to Next tile offset
DJNZ _checkNextTile
XOR A ; Clear Zero Flag
RET
;-----------------------------------------------------------------------;
; Draw Current Piece ;
;-----------------------------------------------------------------------;
drawCurrentPiece:
LD C,CHR_TILE
CALL getPiece
JP drawPiece
;-----------------------------------------------------------------------;
; Undraw Current Piece ;
;-----------------------------------------------------------------------;
unDrawCurrentPiece:
LD C,' '
CALL getPiece
JP drawPiece
;-----------------------------------------------------------------------;
; Undraw Next Piece ;
;-----------------------------------------------------------------------;
unDrawNextPiece:
LD C,' '
LD A,(Next)
LD DE,NEXT_POS
JP drawPiece
;-----------------------------------------------------------------------;
; Generate a random Next Piece and show it ;
;-----------------------------------------------------------------------;
nextRandom:
LD A,(Frames) ; Generate a random Next Piece
RLA ; Move to bits 4-6
RLA
RLA
RLA
AND 01110000b
LD (Next),A ; Next = Random
LD C,CHR_TILE ; Draw Next Piece
LD DE,NEXT_POS
JP drawPiece
;-----------------------------------------------------------------------;
; Remove line moving above lines down ;
;-----------------------------------------------------------------------;
; Input: HL = Line Address
removeLine:
LD D,H ; DE = Destination
LD E,L
LD BC,-SCREEN_LINE ; HL = Source (above line)
ADD HL,BC
PUSH HL ; Save above line address
LD BC,PIT_WIDTH
LDIR ; Copy above line over current line
; Check if top line reached
LD BC,TOP_LINE + PIT_WIDTH
OR A ; Clear Carry before subtraction
SBC HL,BC ; Set Z flag if top line reached
POP HL ; Get above line address
JR NZ,removeLine
; Clear Top Line
CALL clearLine
RET
;-----------------------------------------------------------------------;
; Collect Filled lines ;
;-----------------------------------------------------------------------;
collectLines:
LD B,PIT_DEPTH ; Line Count
LD HL,TOP_LINE ; Check from top to bottom
_collectNext:
PUSH BC ; Save Line Count
PUSH HL ; Save Line Address
LD B,PIT_WIDTH ; Search along a line width..
LD A,' ' ; ..for a space char
_searchSpace:
CP (HL) ; Zero Flag set if a space is found
JR Z, _lineNotFilled ; Line is not filled, skip it.
INC HL ; Next screen column
DJNZ _searchSpace
; Line is filled. Remove it.
LD DE,-PIT_WIDTH
ADD HL,DE
PUSH HL
CALL highlightLine ; Flash Line before removing
CALL playLineSound ; Play a sound
POP HL
CALL removeLine ; Remove line
LD DE,(Lines) ; Count removed lines
INC DE
LD (Lines),DE
CALL scoreLine ; Score removed lines
_lineNotFilled:
POP HL
POP BC
LD DE, SCREEN_LINE
ADD HL,DE
DJNZ _collectNext ; Go check next line
RET
;-----------------------------------------------------------------------;
; Sound for collecting lines ;
;-----------------------------------------------------------------------;
; Affect: A, B, C
playLineSound:
DI ; Avoid interrupt during sound play
LD C,96 ; Number of cycles to play
_lineSoundLoop:
LD B,C ; Set 1st Half Cycle delay factor
DJNZ $ ; 1st Half cycle delay
pullSpeaker ; Pull in the speaker diaphragm
LD B,C ; Set 2nd Half Cycle delay factor
DJNZ $ ; 2nd Half cycle delay
pushSpeaker ; Push out the speaker diaphragm
DEC C ; Count number of cycles
JR NZ,_lineSoundLoop ; loop back if not done
EI ; Restore interrupt
RET
;-----------------------------------------------------------------------;
; Play a Tone ;
;-----------------------------------------------------------------------;
; Input: E = Tone
; D = Duration (cycles)
playTone:
DI ; Avoid interrupt during sound play
_toneLoop:
LD B,E ; Set 1st Half Cycle delay factor
DJNZ $ ; 1st Half cycle delay
pullSpeaker ; Pull in the speaker diaphragm
LD B,E ; Set 2nd Half Cycle delay factor
DJNZ $ ; 2nd Half cycle delay
pushSpeaker ; Push out the speaker diaphragm
DEC D ; Count number of cycles
JR NZ,_toneLoop ; loop back if not done
EI ; Restore interrupt
RET
;-----------------------------------------------------------------------;
; Play Level Up Bip ;
;-----------------------------------------------------------------------;
playLevelUpBip:
LD D,32 ; Duration
LD E,32 ; Tone
JP playTone
;-----------------------------------------------------------------------;
; Play Game Over Buzz ;
;-----------------------------------------------------------------------;
playGameOverBuzz:
LD D,200 ; Duration
LD E,255 ; Tone
JP playTone
;-----------------------------------------------------------------------;
; Scoring Collected Lines ;
;-----------------------------------------------------------------------;
scoreLine:
LD DE,(Score)
LD HL,(Level)
ADD HL,DE
LD (Score),HL
RET
;-----------------------------------------------------------------------;
; Wait for a Keypress ;
;-----------------------------------------------------------------------;
waitKeyPress:
CALL scanKeyboard ; Wait for no key pressed
JR NZ,waitKeyPress
_waitKey:
CALL scanKeyboard ; Wait for a key press
JR Z,_waitKey
RET
;-----------------------------------------------------------------------;
; Check User Input ;
;-----------------------------------------------------------------------;
; Input: A = Key pressed
userAction:
OR A
RET Z ; No keypressed do nothing
CALL unDrawCurrentPiece
LD A,(LastKey)
CP KEY_TURN ; Rotate Piece
JR Z,_rotate
CP KEY_LEFT ; Move Piece Left
JR Z,_moveLeft
CP KEY_RIGHT ; Move Piece Right
JR Z,_moveRight
CP KEY_DROP ; Drop Piece
JR Z,_dropPiece
CP KEY_PAUSE ; Pause Game
JR Z,_pause
_userActionEnd: ; Other Key: do nothing
JP drawCurrentPiece
_rotate:
LD A,(Rotation) ; Get current rotation
ADD A,00000100b ; Rotate
AND 00001100b ; Mask Rotation bits (2 and 3)
LD (Temp),A ; Save result to be used soon
LD HL,Piece ; Get current piece
OR (HL) ; Apply rotation
LD DE,(ScrPos) ; Check if piece can be draw
CALL checkDraw
JR NZ,_userActionEnd ; If not, do not rotate
LD A,(Temp) ; If ok, save new rotation
LD (Rotation),A
JR _userActionEnd
_moveLeft:
CALL getPiece
DEC DE ; Check if moving left is possible
CALL checkDraw
JR NZ,_userActionEnd
LD DE,(ScrPos) ; If possible move left
DEC DE
LD (ScrPos),DE
JR _userActionEnd
_moveRight:
CALL getPiece
INC DE ; Check if moving right is possible
CALL checkDraw
JR NZ,_userActionEnd
LD DE,(ScrPos) ; If possible move right
INC DE
LD (ScrPos),DE
JR _userActionEnd
_dropPiece:
LD HL,1 ; Speed up the drop loop
LD (DelayCount),HL
XOR A ; Clear LastKey allowing key repeat effect
LD (LastKey),A
JR _userActionEnd
_pause:
CALL drawCurrentPiece ; Show Current Piece
LD HL,STR_PAUSED ; Show Pause Message
CALL printInverseString
CALL waitKeyPress ; Wait for user input
LD HL,STR_PIT_BOTTOM ; Remove Pause Message
JP printInverseString
;=======================================================================
; Constants
;=======================================================================
;-----------------------------------------------------------------------;
; Piece patterns at 4 possible rotations ;
;-----------------------------------------------------------------------;
; Each line represents a different piece rotation.
; There are four lines (rotations) per piece.
; The 4 values are to be added in sequence to a screen address.
TBL_PIECES:
; -------Rotation-------
; 0 1 2 3
.BYTE 33, 01, 31, 01 ; ---- ---- ---- ---- 0: Piece 'O'
.BYTE 33, 01, 31, 01 ; -##- -##- -##- -##-
.BYTE 33, 01, 31, 01 ; -##- -##- -##- -##-
.BYTE 33, 01, 31, 01 ; ---- ---- ---- ----
.BYTE 32, 01, 01, 01 ; ---- --#- ---- --#- 1: Piece 'I'
.BYTE 02, 32, 32, 32 ; #### --#- #### --#-
.BYTE 32, 01, 01, 01 ; ---- --#- ---- --#-
.BYTE 02, 32, 32, 32 ; ---- --#- ---- --#-
.BYTE 32, 01, 01, 31 ; ---- -#-- -#-- -#-- 2: Piece 'T'
.BYTE 01, 32, 01, 31 ; ###- -##- ###- ##--
.BYTE 01, 31, 01, 01 ; -#-- -#-- ---- -#--
.BYTE 01, 31, 01, 32 ; ---- ---- ---- ----
.BYTE 33, 01, 30, 01 ; ---- -#-- ---- -#-- 3: Piece 'S'
.BYTE 01, 32, 01, 32 ; -##- -##- -##- -##-
.BYTE 33, 01, 30, 01 ; ##-- --#- ##-- --#-
.BYTE 01, 32, 01, 32 ; ---- ---- ---- ----
.BYTE 32, 01, 32, 01 ; ---- --#- ---- --#- 4: Piece 'Z'
.BYTE 02, 31, 01, 31 ; ##-- -##- ##-- -##-
.BYTE 32, 01, 32, 01 ; -##- -#-- -##- -#--
.BYTE 02, 31, 01, 31 ; ---- ---- ---- ----
.BYTE 32, 01, 01, 32 ; ---- -##- #--- -#-- 5: Piece 'J'
.BYTE 01, 01, 31, 32 ; ###- -#-- ###- -#--
.BYTE 00, 32, 01, 01 ; --#- -#-- ---- ##--
.BYTE 01, 32, 31, 01 ; ---- ---- ---- ----
.BYTE 32, 01, 01, 30 ; ---- -#-- --#- ##-- 6: Piece 'L'
.BYTE 01, 32, 32, 01 ; ###- -#-- ###- -#--
.BYTE 02, 30, 01, 01 ; #--- -##- ---- -#--
.BYTE 00, 01, 32, 32 ; ---- ---- ---- ----
.BYTE 32, 01, 01, 31 ; ---- -#-- -#-- -#-- 2: Piece 'T' (again)
.BYTE 01, 32, 01, 31 ; ###- -##- ###- ##--
.BYTE 01, 31, 01, 01 ; -#-- -#-- ---- -#--
.BYTE 01, 31, 01, 32 ; ---- ---- ---- ----
;-----------------------------------------------------------------------;
; Strings - Format: Screen address followed by a zero terminated string ;
;-----------------------------------------------------------------------;
STR_TETRIS .WORD SCREEN + 10
.BYTE " ACE TETRIS ", 0
STR_PIT_BOTTOM .WORD SCREEN + (21*SCREEN_LINE) + 10
.BYTE "____________", 0
STR_PAUSED .WORD SCREEN + (21*SCREEN_LINE) + 11
.BYTE "**PAUSED**", 0
STR_GAME .WORD SCREEN + (10*SCREEN_LINE) + 12
.BYTE " GAME ", 0
STR_OVER .WORD SCREEN + (11*SCREEN_LINE) + 12
.BYTE " OVER ", 0
STR_NEXT .WORD SCREEN + ( 1*SCREEN_LINE) + 2
.BYTE " Next ",0
STR_SCORE .WORD SCREEN + ( 1*SCREEN_LINE) + 23
.BYTE " Score ",0
STR_LEVEL .WORD SCREEN + ( 7*SCREEN_LINE) + 23
.BYTE " Level ",0
STR_LINES .WORD SCREEN + (13*SCREEN_LINE) + 23
.BYTE " Lines ",0
STR_KEY_PAUSE .WORD SCREEN + (19*SCREEN_LINE) + 23
.BYTE " P Pause",0
STR_KEY_QUIT .WORD SCREEN + (20*SCREEN_LINE) + 23
.BYTE " Q Quit ",0
STR_JAAT .WORD SCREEN + (11*SCREEN_LINE) + 2
.BYTE " JAAT ",0
STR_YEAR .WORD SCREEN + (12*SCREEN_LINE) + 2
.BYTE " 2009 ",0
STR_KEY_LEFT .WORD SCREEN + (17*SCREEN_LINE) + 1
.BYTE " J Left ",0
STR_KEY_RIGHT .WORD SCREEN + (18*SCREEN_LINE) + 1
.BYTE " L Right",0
STR_KEY_TURN .WORD SCREEN + (19*SCREEN_LINE) + 1
.BYTE " I Turn ",0
STR_KEY_DROP .WORD SCREEN + (20*SCREEN_LINE) + 1
.BYTE " K Drop ",0
;-----------------------------------------------------------------------;
; Programmable Characters ;
;-----------------------------------------------------------------------;
TBL_CHARACTERS:
.BYTE 01111110b ; Zero
.BYTE 01000010b
.BYTE 01000010b
.BYTE 01000010b
.BYTE 01110010b
.BYTE 01110010b
.BYTE 01110010b
.BYTE 01111110b
.BYTE 00001000b ; One
.BYTE 00001000b
.BYTE 00001000b
.BYTE 00001000b
.BYTE 00011000b
.BYTE 00011000b
.BYTE 00011000b
.BYTE 00011000b
.BYTE 01111110b ; Two
.BYTE 01100010b
.BYTE 01100010b
.BYTE 00000010b
.BYTE 00111110b
.BYTE 01100000b
.BYTE 01100000b
.BYTE 01111110b
.BYTE 01111110b ; Three
.BYTE 01100110b
.BYTE 00000110b
.BYTE 00011100b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 01100110b
.BYTE 01111110b
.BYTE 00011100b ; Four
.BYTE 00100100b
.BYTE 01000100b
.BYTE 01000100b
.BYTE 01111110b
.BYTE 00001100b
.BYTE 00001100b
.BYTE 00001100b
.BYTE 01111100b ; Five
.BYTE 01100000b
.BYTE 01100000b
.BYTE 01111110b
.BYTE 00000010b
.BYTE 00000010b
.BYTE 01100010b
.BYTE 01111110b
.BYTE 01111110b ; Six
.BYTE 01000110b
.BYTE 01000000b
.BYTE 01111110b
.BYTE 01100010b
.BYTE 01100110b
.BYTE 01100110b
.BYTE 01111110b
.BYTE 01111110b ; Seven
.BYTE 00000010b
.BYTE 00000010b
.BYTE 00000010b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 01111100b ; Eight
.BYTE 01000100b
.BYTE 01000100b
.BYTE 00111100b
.BYTE 01100110b
.BYTE 01100110b
.BYTE 01100110b
.BYTE 01111110b
.BYTE 01111110b ; Nine
.BYTE 01000010b
.BYTE 01000010b
.BYTE 01000110b
.BYTE 01111110b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 00000110b
.BYTE 11101111b ; Brick
.BYTE 11101111b
.BYTE 11101111b
.BYTE 00000000b
.BYTE 11111110b
.BYTE 11111110b
.BYTE 11111110b
.BYTE 00000000b
.BYTE 11111111b ; Tile
.BYTE 10101011b
.BYTE 11010101b
.BYTE 10101011b
.BYTE 11010101b
.BYTE 10101011b
.BYTE 11010101b
.BYTE 11111111b
.BYTE 11111111b ; Tile2
.BYTE 10000001b
.BYTE 10000001b
.BYTE 10000001b
.BYTE 10000001b
.BYTE 10000001b
.BYTE 10000001b
.BYTE 11111111b
TETRIS_END: ;================================================
DATA_BLK_END:
.CHK DATA_BLK ; Data Block Checksum
;=======================================================================
; Show code statistics when compiling
.ECHO "-----> Start Address: "
.ECHO DICT_START
.ECHO " , Lenght: "
.ECHO (DATA_BLK_END - DATA_BLK)
.ECHO " bytes\n"
.END