; Filename: ULTRIS.M68 Date: 01/08/92

;*************************** AMUS Program Label ******************************
; Filename: ULTRIS.M68 Date: 01/08/92
; Category: UTIL Hash Code: 442-153-546-057 Version: 1.0(4)
; Initials: ULTR/US Name: DAVID PALLMANN
; Company: ULTRASOFT CORPORATION Telephone #: 5163484848
; Related Files:
; Min. Op. Sys.: AMOSL 1.3B/AMOS32 1.0 Expertise Level: BEG
; Special: Display is best suited to color terminals (AM72,AM75,PCs).
; Description: UltraSoft's Tetris-like game. Press E to get extended pieces
;*****************************************************************************

;****************************************************************************
;* *
;* ULTRIS *
;* UltraSoft's Tetris-like Game *
;* *
;****************************************************************************
;[104] 08 January 1992 13:39 Edited by David Pallmann
; Enhance for usability on non-Alpha Micro monochrome terminals.
;
;[103] 30 December 1991 13:40 Edited by David Pallmann
; Improve random number generator.
;
;[102] 24 December 1991 14:01 Edited by David Pallmann
; Adjusted scoring and speed-up logic for broader appeal.
;
;[101] 24 December 1991 10:04 Edited by David Pallmann
; Added B)ase vs. E)xtended piece set selection.
;
;[100] 19 December 1991 14:33 Edited by David Pallmann
; Created.

;version

VMAJOR =1
VMINOR =0
VSUB =0
VEDIT =104.
VWHO =0

;universals

SEARCH SYS
SEARCH SYSSYM
SEARCH TRM

;assembly parameters

HEIGHT =24. ; well height
WIDTH =14. ; well width

LFTOFF =<<80.-<WIDTH*2>>/2>

;colors

BLACK =0
WHITE =1
BLUE =2
MAGENTA =3
RED =4
YELLOW =5
GREEN =6
CYAN =7

;variables

.OFINI
.OFDEF RANIDX, 1 ; random number generator index
.OFDEF PROT, 1 ; piece rotation (0,1,2,3)
.OFDEF PROW, 1 ; moving piece row
.OFDEF PCOL, 1 ; moving piece column
.OFDEF PTYPE, 1 ; piece type code
.OFDEF DROP, 1 ; drop flag
.OFDEF PADR, 4 ; address of piece definition
.OFDEF COLOR, 1 ; color flag (0=monochrome)
.OFDEF XXXXXX, 1 ; unused (even up address)
.OFDEF SETFLG, 1 ; piece set flag (0=basic, 1=extended)
.OFDEF BLKFLG, 1 ; solid block flag (0=none, 1=supported)
.OFDEF ACCUM, 2 ; timer - count up register
.OFDEF MAXVAL, 2 ; timer - max value
.OFDEF BUFFER, 8. ; temporary work buffer
.OFDEF SCORE, 4 ; score
.OFDEF LEVSCR, 2 ; score for this piece
.OFDEF LEVELS, 2 ; levels removed
.OFDEF TRMFLG, TC.SIZ ; terminal characteristics
.OFDEF BOARD, HEIGHT*WIDTH ; the current display
.OFDEF PRVBRD, HEIGHT*WIDTH ; the prior display
.OFSIZ MEMSIZ

;macros

DEFINE CRT FUNC
MOVW #-1_8.+^D<FUNC>,D1
TCRT
ENDM

DEFINE CURSOR R,C
MOVB R,D1
ROLW D1,#8.
MOVB C,D1
TCRT
ENDM

DEFINE FCOLOR N
MOVW #-2_8.+^D<N>,D1
TCRT
ENDM

DEFINE BCOLOR N
MOVW #-3_8.+^D<N>,D1
TCRT
ENDM

DEFINE CHKCRT FUNC
LEA A6,TRMFLG+TC.BMP(A5)
ADD #FUNC/8.,A6
MOVB @A6,D7
ANDB #<1_<FUNC&7>>,D7
ENDM

DEFINE BOX R1,C1,R2,C2
LEA A6,1$$
CALL BOX
BR 2$$
1$$: BYTE R1'.,C1'.,R2'.,C2'.
2$$:
ENDM

;***********
;* START *
;***********
;initialization

START: PHDR -1,0,PH$REE!PH$REU ; program header
GETIMP MEMSIZ,A5 ; allocate memory for variables

TRMCHR TRMFLG(A5),TC$BMP ; get terminal characteristics and bitmap

CLRB BLKFLG(A5) ; pre-clear solid block flag [104]
CHKCRT 49. ; does terminal support solid block? [104]
BEQ 10$ ; no [104]
MOVB #1,BLKFLG(A5) ; yes [104]

10$: CLRB COLOR(A5) ; set or clear color flag
MOV TRMFLG(A5),D7 ;
AND #TD$CLR,D7 ;
BEQ 20$ ;
MOVB #1,COLOR(A5) ;

20$: TRMRST D0 ; set data
ORW #T$DAT!T$ECS,D0 ; mode and
TRMWST D0 ; disable echoplex

CLRB SETFLG(A5) ; start with standard base set

;**************
;* NEW.GAME *
;**************
;Set up for a new game

NEW.GAME:
CLR SCORE(A5) ;
CALL BACKGROUND ; display screen background
CLEAR BOARD(A5),HEIGHT*WIDTH ;

LEA A6,BOARD(A5) ;
MOV #WIDTH,D6 ;
10$: MOVB #1,(A6)+ ;
SOB D6,10$ ;

LEA A6,BOARD+WIDTH(A5) ;
MOV #HEIGHT-2,D6 ;
20$: MOVB #1,@A6 ;
MOVB #1,WIDTH-1(A6) ;
ADD #WIDTH,A6 ;
SOB D6,20$ ;

LEA A6,BOARD+<<HEIGHT-1>*WIDTH>(A5) ;
MOV #WIDTH,D6 ;
30$: MOVB #1,(A6)+ ;
SOB D6,30$ ;

LEA A0,BOARD(A5) ;
LEA A1,PRVBRD(A5) ;
MOV #HEIGHT*WIDTH,D0 ;
40$: MOVB (A0)+,(A1)+ ;
SOB D0,40$ ;

MOVW #425.,MAXVAL(A5) ;
CLRB DROP(A5) ;

MOVW #1000.,LEVSCR(A5) ; set initial score for this piece

;create a new piece if necessary

CREATE: TSTB PROW(A5) ; is there a piece moving?
JNE SCAN ; yes - strobe for input

2$: CALL RANDOM ;
INCB D7 ;
MOVB D7,PCOL(A5) ;
MOVB #2,PROW(A5) ;

LEA A0,BOARD+WIDTH+1(A5) ;

CLR D7 ;
MOVB PCOL(A5),D7 ;
ADD D7,A0 ;

LEA A1,PIECE ;

5$: CALL RANDOM ;
MOV D7,D0 ;
TSTB SETFLG(A5) ; are we using extended or base set?
BEQ 61$ ; base

6$: CALL RANDOM ;
MOV D0,D6 ;
ADD D7,D6 ;
; extended
CMP D6,#PIECECOUNT ;
BHIS 5$ ;
MOV D6,D7 ;
BR 69$ ;

61$: CMPB D0,#7 ;
BHIS 5$ ;

69$: MOVB D7,PTYPE(A5) ;
INCB PTYPE(A5) ;
MUL D7,#16. ; point to standard shape for piece
ADD D7,A1 ;
MOV A1,PADR(A5) ;
CLRB PROT(A5) ;

7$: CALL RANDOM ;
CMPB D7,#3 ;
BHI 7$
MOVB D7,PROT(A5) ;
MUL D7,#4 ;
ADD D7,A1 ;
MOV A1,PADR(A5) ;

CALL CHECK ; will this be a collision?
JEQ GAMOVR ; yes - game if over
CALL ADD ; add the piece
CALL UPDATE ; update the display

;scan for user input

SCAN: TCKI ; input?
JNE MOVE ; no - go move piece
TIN ;
UCS ;
CMPB D1,#'C-'@ ;
JEQ QUIT ;
CMPB D1,#'[-'@ ;
JEQ QUIT ;
CMPB D1,#'Q ;
JEQ QUIT ;
CMPB D1,#40 ;
JEQ DROPIT ;
CMPB D1,#'5 ;
JEQ ROTATE ;
CMPB D1,#'R ;
JEQ ROTATE ;
CMPB D1,#'4 ;
JEQ LEFT ;
CMPB D1,#'H-'@ ;
JEQ LEFT ;
CMPB D1,#'6 ;
JEQ RIGHT ;
CMPB D1,#'L-'@ ;
JEQ RIGHT ;
CMPB D1,#'B ;
JEQ SETBAS ;
CMPB D1,#'E ;
JEQ SETEXT ;
CMPB D1,#'H ;
JEQ HELP ;

;move the current piece

MOVE: TSTB PROW(A5) ; is there a piece to move?
JEQ CREATE ; no - go create one
TSTB DROP(A5) ; are we in Fast Drop mode?
BNE 10$ ; yes - go to it

;idler loop to pace drop rate with game duration

INCW ACCUM(A5) ; add one to accumulator
CMMW ACCUM(A5),MAXVAL(A5) ; time to move the piece?
BHIS 10$ ; yes - go do it
SLEEP #10. ; sleep 1/1000th second
JMP SCAN ; go check for keyboard input

;this is where the piece is actually moved

10$: CMPW LEVSCR(A5),#10. ;
BLOS 15$ ;
SUBW #5.,LEVSCR(A5) ;
15$: CLRW ACCUM(A5) ; clear out the accumulator
CALL DELETE ; delete piece from the board
INCB PROW(A5) ; add one to row
CALL CHECK ; will this be a collision?
BEQ 20$ ; yes
CALL ADD ; add piece back to the board
CALL UPDATE ; update the screen
JMP SCAN ; check input again

;we could not move the piece so it is at rock bottom
;cancel the current moving piece so that a new one will be created

20$: DECB PROW(A5) ;
CALL ADD ;
CLRB PROW(A5) ;
CLRB PCOL(A5) ;
CLRB PTYPE(A5) ;
CLR PADR(A5) ;
CLRB PROT(A5) ;
CLRB DROP(A5) ;
CMPW MAXVAL(A5),#5 ; are we as fast as can be?
JLO 10$ ; yes
SUBW #2,MAXVAL(A5) ; no - pick up the pace
30$: CALL REMOVE ; remove any levels that need it
JMP SCAN ; go check for keyboard input

;select Fast Drop mode in which our timing delay is temporarily inactivated
;for the current piece

DROPIT: MOVB #1,DROP(A5) ;
JMP SCAN ;

;move the current piece left

LEFT: CALL DELETE ;
DECB PCOL(A5) ;
CALL CHECK ; collision?
BNE 10$ ; no
INCB PCOL(A5) ; yes - undo the change
CALL ADD ;
JMP SCAN ;
10$: CALL ADD ;
CALL UPDATE ;
JMP SCAN ;

;move the current piece right

RIGHT: CALL DELETE ;
INCB PCOL(A5) ;
CALL CHECK ; collision?
BNE 10$ ; no
DECB PCOL(A5) ; yes - undo the change
CALL ADD ;
JMP SCAN ;
10$: CALL ADD ;
CALL UPDATE ;
JMP SCAN ;

;rotate the current piece clockwise 90 degrees

ROTATE: MOVB PROT(A5),D4 ;
MOV PADR(A5),D5 ;
CALL DELETE ;
SUB #4,PADR(A5) ;
DECB PROT(A5) ;
BPL 10$ ;
MOVB #3,PROT(A5) ;
ADD #16.,PADR(A5) ;
10$: CALL CHECK ;
BEQ UNROTATE ;
CALL ADD ;
CALL UPDATE ;
JMP SCAN ;

UNROTATE:
MOVB D4,PROT(A5) ;
MOV D5,PADR(A5) ;
CALL ADD ;
JMP SCAN ;

;set base piece set

SETBAS: CLRB SETFLG(A5) ;
BCOLOR GREEN ;
CURSOR #8.,#56. ;
TYPE < E extended pieces >
JMP SCAN ;

;set extended piece set

SETEXT: MOVB #1,SETFLG(A5) ;
BCOLOR GREEN ;
CURSOR #8.,#56. ;
TYPE < B basic pieces > ;
JMP SCAN ;

;**********
;* HELP *
;**********

HELP:

;************
;* GAMOVR *
;************
;game over

GAMOVR:

;**********
;* QUIT *
;**********
;Leave Ultris and return to AMOS command level

QUIT: CURSOR #24.,#1 ;
CRT 28 ;
CRT 12 ;
BCOLOR 0 ;
FCOLOR 1 ;
EXIT ;

;************
;* REMOVE *
;************
;Function: Remove any full levels
; Calls UPDATE if any have been removed

REMOVE: CLR D5 ; removed level count
LEA A0,BOARD+WIDTH(A5) ;
MOV #2,D4 ;
MOV #HEIGHT-2,D3 ;
10$: BCALL REMLVL ;
INCW D4 ;
ADD #WIDTH,A0 ;
SOB D3,10$ ;
TSTW D5 ; was anything removed?
BEQ 20$ ; no
CALL UPDATE ; update the display
CALL UPDATE.SCORE ; update score
20$: RTN ; return

;remove level @A0, row D4, if full

REMLVL: SAVE A0-A1 ;
MOV A0,A6 ;
MOV #WIDTH,D6 ;
10$: TSTB (A6)+ ;
BEQ 90$ ;
SOB D6,10$ ;

20$: LEA A6,BOARD+WIDTH(A5) ;
CMP A0,A6 ;
BLOS 80$ ;
MOV A0,A1 ;
SUB #WIDTH,A1 ;
MOV #WIDTH,D6 ;
30$: MOVB (A1)+,(A0)+ ;
SOB D6,30$ ;
SUB #WIDTH*2,A0 ;
BR 20$ ;

80$: INCW D5 ; update removed level count
MOVW LEVSCR(A5),D7 ;
ADD D7,SCORE(A5) ;
INCW LEVELS(A5) ;
MOVW #1000.,LEVSCR(A5) ;
90$: REST A0-A1 ;
RTN ;

;****************
;* BACKGROUND *
;****************
;Function: Put up background screen

BACKGROUND:
BCOLOR BLUE ;
CRT 29 ;
CRT 0 ;
BCOLOR WHITE ;
FCOLOR BLACK ;
CRT 23 ;

;top lines

CURSOR #1,#LFTOFF+1 ;
CRT 38 ;
MOV #<<WIDTH-2>*2>,D0 ;
10$: CRT 46 ;
SOB D0,10$ ;
CRT 39 ;

;middle lines

MOV #2,D2 ;

20$: CURSOR D2,#LFTOFF+1 ;
CRT 47 ;
MOV #<<WIDTH-2>*2>,D0 ;
30$: TYPESP ;
SOB D0,30$ ;
CRT 47 ;

INCW D2 ;
CMPW D2,#HEIGHT ;
BLO 20$ ;

;bottom line

CURSOR #HEIGHT,#LFTOFF+1 ;
CRT 40 ;
MOV #<<WIDTH-2>*2>,D0 ;
40$: CRT 46 ;
SOB D0,40$ ;
CRT 41 ;

CRT 24 ;

;title box

BOX 2,7,6,19 ;
BCOLOR MAGENTA ;
FCOLOR WHITE ;
CURSOR #3,#8. ;
TYPE < > ;
CURSOR #4,#8. ;
TYPE < ULTRIS > ;
BCOLOR MAGENTA+8. ;
TYPESP ;
BCOLOR MAGENTA ;
CURSOR #5,#8. ;
TYPE < > ;
BCOLOR MAGENTA+8. ;
TYPESP ;
TSTB COLOR(A5) ;
BEQ 50$ ;
CURSOR #6,#9. ;
TYPE < > ;

;score box

50$: BOX 8,4,14,23
BCOLOR RED ;
FCOLOR WHITE ;
CURSOR #9.,#5 ;
TYPE < > ;
CURSOR #10.,#5 ;
TYPE < Score: > ;
BCOLOR RED+8. ;
TYPESP ;
BCOLOR RED ;
CURSOR #11.,#5 ;
TYPE < > ;
BCOLOR RED+8. ;
TYPESP ;
BCOLOR RED ;
CURSOR #12.,#5 ;
TYPE < Levels: > ;
BCOLOR RED+8. ;
TYPESP ;
BCOLOR RED ;
CURSOR #13.,#5 ;
TYPE < > ;
BCOLOR RED+8. ;
TYPESP ;
TSTB COLOR(A5) ;
BEQ 60$ ;
CURSOR #14.,#6 ;
BCOLOR RED+8. ;
TYPE < >

;instructions

60$: BOX 2,55,11,79
BCOLOR GREEN ;
FCOLOR WHITE ;
CURSOR #3,#56. ;
TYPE < >
CURSOR #4,#56. ;
TYPE < 4 moves piece left >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #5,#56. ;
TYPE < 5 rotates piece >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #6,#56. ;
TYPE < 6 moves piece right >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #7,#56. ;
TYPE < SPACE drops piece >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #8.,#56. ;
TYPE < E extended pieces >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #9.,#56. ;
TYPE < Q quits game >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
CURSOR #10.,#56. ;
TYPE < >
BCOLOR GREEN+8. ;
TYPESP ;
BCOLOR GREEN ;
TSTB COLOR(A5) ;
BEQ 70$ ;
CURSOR #11.,#57. ;
BCOLOR GREEN+8. ;
TYPE < >

70$: CALL UPDATE.SCORE ;

RTN ;

;******************
;* UPDATE.SCORE *
;******************
;Function: Update score on screen

UPDATE.SCORE:
BCOLOR RED ;
FCOLOR WHITE ;
CURSOR #10.,#15. ;
MOV SCORE(A5),D1 ;
DCVT 5,OT$TRM ;
CURSOR #12.,#15. ;
CLR D1 ;
MOVW LEVELS(A5),D1 ;
DCVT 0,OT$TRM ;
RTN ;

;************
;* UPDATE *
;************
;Function: Update the display, by comparing BOARD(A5) to PRVBRD(A5)
;
; On mode color terminals we use glorious color
; On everything we use boring solid blocks
; On terminals that don't support solid blocks we use even
; more boring "[]"s.

UPDATE:
TSTB COLOR(A5) ; color terminal?
BNE 5$ ; yes
TSTB BLKFLG(A5) ; will we be using solid block? [104]
BEQ 5$ ; no [104]
CRT 23 ; no - select alternate char set
5$: LEA A0,BOARD+WIDTH(A5) ;
LEA A1,PRVBRD+WIDTH(A5) ;
MOV #2,D2 ;
MOV #HEIGHT-2,D4 ;
10$: MOV #1,D3 ;
MOV #WIDTH-2,D5 ;
INC A0 ;
INC A1 ;
20$: MOVB (A0)+,D0 ;
MOVB (A1)+,D1 ;
CMPB D0,D1 ;
BNE 30$ ;
25$: INCW D3 ;
SOB D5,20$ ;
INC A0 ;
INC A1 ;
INCW D2 ;
SOB D4,10$ ;
TSTB COLOR(A5) ; color terminal?
BNE 28$ ; yes
CRT 24 ; no - select standard char set
28$: RTN ;

30$: MOVW #-3_8.+1,D1 ;
MOVB D0,-1(A1) ;
BEQ 40$
TSTB COLOR(A5) ; color terminal?
BEQ 50$ ; no
MOVB D0,D1 ;
INCW D1 ;
AND #377,D1 ;
ADDW #-3_8.+0,D1 ;
40$: TCRT ;
MOV D3,D0 ;
MUL D0,#2 ;
ADD #LFTOFF,D0 ;
CURSOR D2,D0 ;
TYPE < > ;
BR 25$ ;
50$: MOVB D0,-1(A1) ;
MOV D3,D0 ;
MUL D0,#2 ;
ADD #LFTOFF,D0 ;
CURSOR D2,D0 ;
TSTB -1(A1) ;
BEQ 60$ ;
TSTB BLKFLG(A5) ; do we support solid block? [104]
BEQ 55$ ; no [104]
CRT 49 ;
CRT 49 ;
JMP 25$ ;
55$: TYPE [] ; best we can do on this term [104]
JMP 25$ ; [104]
60$: TYPE < > ;
JMP 25$ ;

;***********
;* CHECK *
;***********
;Function: See if piece's new location is a collision
;
;Inputs: PROW(A5), PCOL(A5) - piece location (of top left corner)
; PADR(A5) - index to piece definition
;
;Outputs: Z - set if there is a collision

CHECK: SAVE A0,D2 ;
CLR D7 ;
MOVB PROW(A5),D7 ;
DEC D7 ;
MUL D7,#WIDTH ;
LEA A0,BOARD(A5) ;
ADD D7,A0 ;
CLR D6 ;
MOVB PCOL(A5),D6 ;
ADD D6,A0 ;

MOV PADR(A5),A1 ;

MOV #4,D6 ;
10$: MOV A0,A6 ;
MOV #8.,D7 ;
MOVB (A1)+,D2 ;
20$: ASLB D2,#1 ;
BCC 30$ ;
TSTB @A6 ;
BNE 40$ ;
30$: INC A6 ;
SOB D7,20$ ;
ADD #WIDTH,A0 ;
SOB D6,10$ ;
REST A0,D2 ;
LCC #0 ; clear Z (safe)
RTN ; return
40$: REST A0,D2 ;
LCC #PS.Z ; set Z (collision)
RTN ; return

;*********
;* ADD *
;*********
;Function: Map piece onto board
;
;Inputs: PROW(A5), PCOL(A5) - piece location (of top left corner)
; PADR(A5) - index to piece definition

ADD: SAVE A0,D2 ;
CLR D7 ;
MOVB PROW(A5),D7 ;
DEC D7 ;
MUL D7,#WIDTH ;
LEA A0,BOARD(A5) ;
ADD D7,A0 ;
CLR D6 ;
MOVB PCOL(A5),D6 ;
ADD D6,A0 ;

MOV PADR(A5),A1 ;

MOV #
4,D6 ;
10$: MOV A0,A6 ;
MOV #8.,D7 ;
MOVB (A1)+,D2 ;
20$: ASLB D2,#1 ;
BCC 30$ ;
MOVB PTYPE(A5),@A6 ;
30$: INC A6 ;
SOB D7,20$ ;
ADD #WIDTH,A0 ;
SOB D6,10$ ;
REST A0,D2 ;
RTN ;

;************
;* DELETE *
;************
;Function: Delete piece from board
;
;Inputs: PROW(A5), PCOL(A5) - piece location (of top left corner)
; PADR(A5) - index to piece definition

DELETE: SAVE A0,D2 ;

CLR D7 ;
MOVB PROW(A5),D7 ;
DEC D7 ;
MUL D7,#WIDTH ;
LEA A0,BOARD(A5) ;
ADD D7,A0 ;
CLR D6 ;
MOVB PCOL(A5),D6 ;
ADD D6,A0 ;

MOV PADR(A5),A1 ;

MOV #4,D6 ;
10$: MOV A0,A6 ;
MOV #8.,D7 ;
MOVB (A1)+,D2 ;
20$: ASLB D2,#1 ;
BCC 30$ ;
CLRB @A6 ;
30$: INC A6 ;
SOB D7,20$ ;
ADD #WIDTH,A0 ;
SOB D6,10$ ;

REST A0,A2 ;
RTN ;

;*********
;* BOX *
;*********
;Function: Draw a box
;
;Inputs: A6 - points to row1, col1, row2, col2 (bytes)

BOX: TSTB COLOR(A5) ;
JNE BOXRTN ;

SAVE D0-D5
CLR D2 ;
CLR D3 ;
CLR D4 ;
CLR D5 ;
MOVB (A6)+,D2 ;
MOVB (A6)+,D3 ;
MOVB (A6)+,D4 ;
MOVB (A6)+,D5 ;
CRT 23 ;

CURSOR D2,D3 ;
CRT 38 ;
MOV D5,D0 ;
SUB D3,D0 ;
DEC D0 ;
10$: CRT 46 ;
SOB D0,10$ ;
CRT 39 ;

20$: INCW D2 ;
CMPW D2,D4 ;
BHIS 30$
CURSOR D2,D3 ;
CRT 47 ;
MOV D5,D0 ;
SUB D3,D0 ;
DEC D0 ;
22$: TYPESP ;
SOB D0,22$ ;
CRT 47 ;
BR 20$ ;

30$: CURSOR D4,D3 ;
CRT 40 ;
MOV D5,D0 ;
SUB D3,D0 ;
DEC D0 ;
32$: CRT 46 ;
SOB D0,32$ ;
CRT 41 ;

CRT 24 ;
REST D0-D5 ;

BOXRTN: RTN ;

;************
;* RANDOM *
;************
;Function: Generate random number between 0 and 9
;
;Outputs: D7 - number
;
;Notes: Automatically seeds self the first time it is run and
; periodically.

RANDOM: MOV D7,D5 ; save max value
MOVB RANIDX(A5),D7 ; have we been seeded?
BNE 10$ ; yes
5$: GTIMES BUFFER(A5) ;
CLR D7 ;
LEA A6,BUFFER(A5) ;
MOVB (A6)+,D7 ;
ADDB (A6)+,D7 ;
ADDB (A6)+,D7 ;
ADDB @A6,D7 ;
AND #377,D7 ;
MOVB D7,RANIDX(A5) ;
BR 20$ ;
10$: CLR D7 ;
MOVB RANIDX(A5),D7 ;
INCB D7 ;
MOVB D7,RANIDX(A5) ;
20$: LEA A6,RANTBL ;
ADD D7,A6 ;
MOVB @A6,D7 ;
BMI 5$ ;
RTN ;

RADIX 10

RANTBL: BYTE 0,1,2,3,4,5,6,7,8,9
BYTE 9,8,7,6,5,4,3,2,1,0
BYTE 1,3,5,7,9,0,2,4,6,8
BYTE 0,8,6,4,2,8,6,4,2,0
BYTE 1,3,5,7,9,9,7,5,3,1
BYTE 0,8,9,7,1,3,2,4,6,5
BYTE 0,0,8,8,6,6,4,4,2,2
BYTE 1,3,1,3,5,7,5,7,9,9
BYTE 0,9,8,7,6,5,4,3,2,1
BYTE 1,2,3,4,5,6,7,8,9,0
BYTE 6,5,4,3,2,1,0,9,8,7
BYTE 1,2,4,5,7,8,0,3,6,9
BYTE 0,0,0,9,8,8,8,7,6,6
BYTE 6,5,4,4,4,3,2,2,2,1
BYTE 9,9,7,7,5,5,3,3,1,1
BYTE 1,9,8,0,0,9,0,0,2,0
BYTE 1,4,1,1,1,5,1,1,0,1
BYTE 2,5,6,2,2,4,2,2,6,2
BYTE 7,3,9,7,7,2,7,7,8,7
BYTE 5,7,8,5,5,0,5,5,2,5
BYTE 9,4,7,9,9,6,9,9,4,9
BYTE 8,1,0,8,8,9,8,8,3,8
BYTE 3,9,3,3,3,5,3,3,7,3
BYTE 4,2,6,4,4,8,4,4,1,4
BYTE 6,0,3,6,6,5,6,6,7,6
BYTE 1,2,3,4,5,6

IF NE,256.-<.-RANTBL>,ASMERP "?Random number table does not contain right number of entries"

BYTE -1,-1,-1,-1,-1,-1,-1,-1,-1,-1

RADIX 8

;*****************************
;* piece shape definitions *
;*****************************
;This is where pieces are defined
;Each piece is defined in four rotations (0, 90, 180, 270 degrees)

;piece #1 (square) 0 rotation

PIECE: BYTE ^B11000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #1 (square) 90 rotation

BYTE ^B11000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #1 (square) 180 rotation

BYTE ^B11000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #1 (square) 270 rotation

BYTE ^B11000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #2 (L) 0 rotation

BYTE ^B10000000
BYTE ^B10000000
BYTE ^B11000000
BYTE ^B00000000

;piece #2 (L) 90 rotation

BYTE ^B00100000
BYTE ^B11100000
BYTE ^B00000000
BYTE ^B00000000

;piece #2 (L) 180 rotation

BYTE ^B11000000
BYTE ^B01000000
BYTE ^B01000000
BYTE ^B00000000

;piece #2 (L) 270 rotation

BYTE ^B11100000
BYTE ^B10000000
BYTE ^B00000000
BYTE ^B00000000

;piece #3 (Z) 0 rotation

BYTE ^B11000000
BYTE ^B01100000
BYTE ^B00000000
BYTE ^B00000000

;piece #3 (Z) 90 rotation

BYTE ^B01000000
BYTE ^B11000000
BYTE ^B10000000
BYTE ^B00000000

;piece #3 (Z) 180 rotation

BYTE ^B11000000
BYTE ^B01100000
BYTE ^B00000000
BYTE ^B00000000

;piece #3 (Z) 270 rotation

BYTE ^B01000000
BYTE ^B11000000
BYTE ^B10000000
BYTE ^B00000000

;piece #4 (Z) 0 rotation

BYTE ^B01100000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #4 (Z) 90 rotation

BYTE ^B10000000
BYTE ^B11000000
BYTE ^B01000000
BYTE ^B00000000

;piece #4 (Z) 180 rotation

BYTE ^B01100000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #4 (Z) 270 rotation

BYTE ^B10000000
BYTE ^B11000000
BYTE ^B01000000
BYTE ^B00000000

;piece #5 (T) 0 rotation

BYTE ^B01000000
BYTE ^B11100000
BYTE ^B00000000
BYTE ^B00000000

;piece #5 (T) 90 rotation

BYTE ^B10000000
BYTE ^B11000000
BYTE ^B10000000
BYTE ^B00000000

;piece #5 (T) 180 rotation

BYTE ^B11100000
BYTE ^B01000000
BYTE ^B00000000
BYTE ^B00000000

;piece #5 (T) 270 rotation

BYTE ^B01000000
BYTE ^B11000000
BYTE ^B01000000
BYTE ^B00000000

;piece #6 (-L) 0 rotation

BYTE ^B01000000
BYTE ^B01000000
BYTE ^B11000000
BYTE ^B00000000

;piece #6 (-L) 90 rotation

BYTE ^B10000000
BYTE ^B11100000
BYTE ^B00000000
BYTE ^B00000000

;piece #6 (-L) 180 rotation

BYTE ^B11000000
BYTE ^B10000000
BYTE ^B10000000
BYTE ^B00000000

;piece #6 (-L) 270 rotation

BYTE ^B11100000
BYTE ^B00100000
BYTE ^B00000000
BYTE ^B00000000

;piece #7 (I) 0 rotation

BYTE ^B11110000
BYTE ^B00000000
BYTE ^B00000000
BYTE ^B00000000

;piece #7 (I) 90 rotation

BYTE ^B01000000
BYTE ^B01000000
BYTE ^B01000000
BYTE ^B01000000

;piece #7 (I) 180 rotation

BYTE ^B11110000
BYTE ^B00000000
BYTE ^B00000000
BYTE ^B00000000

;piece #7 (I) 270 rotation

BYTE ^B01000000
BYTE ^B01000000
BYTE ^B01000000
BYTE ^B01000000

;piece #8 (r) 0 rotation

BYTE ^B11000000
BYTE ^B10000000
BYTE ^B00000000
BYTE ^B00000000

;piece #8 (r) 90 rotation

BYTE ^B11000000
BYTE ^B01000000
BYTE ^B00000000
BYTE ^B00000000

;piece #8 (r) 180 rotation

BYTE ^B01000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #8 (r) 270 rotation

BYTE ^B10000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #9 (-r) 0 rotation

BYTE ^B11000000
BYTE ^B01000000
BYTE ^B00000000
BYTE ^B00000000

;piece #9 (-r) 90 rotation

BYTE ^B01000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #9 (-r) 180 rotation

BYTE ^B10000000
BYTE ^B11000000
BYTE ^B00000000
BYTE ^B00000000

;piece #9 (-r) 270 rotation

BYTE ^B11000000
BYTE ^B10000000
BYTE ^B00000000
BYTE ^B00000000

;piece #10 (C) 0 rotation

BYTE ^B11000000
BYTE ^B10000000
BYTE ^B11000000
BYTE ^B00000000

;piece #10 (C) 90 rotation

BYTE ^B11100000
BYTE ^B10100000
BYTE ^B00000000
BYTE ^B00000000

;piece #10 (C) 180 rotation

BYTE ^B11000000
BYTE ^B01000000
BYTE ^B11000000
BYTE ^B00000000

;piece #10 (C) 270 rotation

BYTE ^B10100000
BYTE ^B11100000
BYTE ^B00000000
BYTE ^B00000000

;piece #11 (T) 0 rotation

BYTE ^B11100000
BYTE ^B01000000
BYTE ^B01000000
BYTE ^B00000000

;piece #11 (T) 90 rotation

BYTE ^B00100000
BYTE ^B11100000
BYTE ^B00100000
BYTE ^B00000000

;piece #11 (T) 180 rotation

BYTE ^B01000000
BYTE ^B01000000
BYTE ^B11100000
BYTE ^B00000000

;piece #11 (T) 270 rotation

BYTE ^B10000000
BYTE ^B11100000
BYTE ^B10000000
BYTE ^B00000000

;piece #12 (+) 0 rotation

BYTE ^B01000000
BYTE ^B11100000
BYTE ^B01000000
BYTE ^B00000000

;piece #12 (+) 90 rotation

BYTE ^B01000000
BYTE ^B11100000
BYTE ^B01000000
BYTE ^B00000000

;piece #12 (+) 180 rotation

BYTE ^B01000000
BYTE ^B11100000
BYTE ^B01000000
BYTE ^B00000000

;piece #12 (+) 270 rotation

BYTE ^B01000000
BYTE ^B11100000
BYTE ^B01000000
BYTE ^B00000000

;add new extended piece definitions here
;there must be four definitions for each piece (0, 90, 180, 270 rotations)

;this must come after all piece definitions

PIECECOUNT=<<.-PIECE>/16.>

END