;*************************** AMUS Program Label ******************************
; Filename: ULTRIS.M68                                      Date: 12/23/91
; Category: UTIL         Hash Code: 436-301-552-343      Version: 1.0(2)
; 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
;*****************************************************************************

;****************************************************************************
;*									    *
;*				   ULTRIS				    *
;*			UltraSoft's Tetris-like Game			    *
;*									    *
;****************************************************************************
;[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	=102.
	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	SETFLG,	1		; set flag (0=basic, 1=extended)
	.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	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)		; get terminal characteristics

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

10$:	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

UPDATE:
	TSTB	COLOR(A5)		; color terminal?
	BNE	5$			;   yes
	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$			; 
	CRT	49			; 
	CRT	49			; 
	JMP	25$			; 
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	0,0,0,0,0,0,0,0,0,0
	BYTE	1,1,1,1,1,1,1,1,1,1
	BYTE	2,2,2,2,2,2,2,2,2,2
	BYTE	7,7,7,7,7,7,7,7,7,7
	BYTE	5,5,5,5,5,5,5,5,5,5
	BYTE	9,9,9,9,9,9,9,9,9,9
	BYTE	8,8,8,8,8,8,8,8,8,8
	BYTE	3,3,3,3,3,3,3,3,3,3
	BYTE	4,4,4,4,4,4,4,4,4,4
	BYTE	6,6,6,6,6,6,6,6,6,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