EJECT	; PAGE
* ------------------------------------------------------------------------------
* MACHINE DEPENDENT ROUTINES -- YZIP
* ------------------------------------------------------------------------------

* NOTE: A SMALL NUMBER OF ROUTINES OUTSIDE OF THIS SECTION MAY STILL CONTAIN MINOR
* MACHINE DEPENDENCIES:
*	QUECHR, SIZEQP, ...

* ----------------------------------------------
* SCREEN/KEY I/O
* ----------------------------------------------

* ----------------------
* SETUPI
* ----------------------

* MUST "BRACKET" CALLS TO TTYIN OR INCHR WITH CALLS TO HERE
* ACTIVATES/DEACTIVATES BLINKING CURSOR AND MENU COMMAND-STRINGS
*    D0.W = 1 TO BEGIN CURSOR, 0 TO END
*    D1.W = 1 IF STRING INPUT, 0 IF SINGLE-CHAR INPUT

SETUPI	TST.W	D0		* STARTING INPUT?
	BEQ.S	SETUX1		* NO, ENDING
	MOVE.W  #1,INLAST(A6)	* SET INPUT FLAG
	MOVE.L	CURWP(A6),A0
	CLR.W	WLCNT(A0)	* RESET THE [MORE] COUNTER

SETUX1	SAVEREGS
	MOVE.B	D0,-(SP)
	MOVE.B	D1,-(SP)
	JSR	SetUpInput
	RESTREGS
	RTS

* ----------------------
* TTYIN, ITTYIN
* ----------------------

* INPUT A SINGLE CHAR (XZIP: or mouse clicks), NO ECHO
* IF NONE AVAILABLE, RETURN A ZERO IMMEDIATELY

ITTYIN	SAVEREGS
	RESWORD
	JSR	EventIn
	POPWORD
	RESTREGS
	ANDI.W  #$00FF,D0
	CMPI.B	#253,D0		* MOUSE BUTTON CLICK? (SINGLE OR DOUBLE)
	BEQ.S	ITTYX11		* YES
	CMPI.B	#254,D0
	BEQ.S	ITTYX11		* YES

	CMPI.B	#13,D0		* CR,BS ARE ONLY VALID CONTROL CHARS
	BEQ.S	ITTYX2
	CMPI.B	#8,D0
	BEQ.S	ITTYX2

	CMPI.B	#3,D0		* [MAC: MAP 'ENTER' TO 'RETURN']
	BNE.S	ITTYX1
	MOVEQ	#13,D0
	BRA.S	ITTYX2
	
ITTYX1	CMPI.B	#31,D0		* SUPPRESS OTHERS (TAB, CLR, ETC)
	BHI.S	ITTYX2
	MOVEQ	#0,D0
ITTYX2	RTS			* RETURN CHAR OR FKEY CODE

* HERE AFTER MOUSE EVENT, STORE POSITION IN GLOBALS

ITTYX11	MOVEM.L	D1-D3/A1,-(SP)
	MOVE.W	D0,D3		* SAVE MOUSE CODE (SINGLE OR DOUBLE)

	MOVE.L	BUFFER(A6),A0
	MOVE.W	PFLAGS(A0),D0
	BTST	#FMOUS,D0	* BUT DOES GAME USE MOUSE?
	BEQ.S	ITTYX18		* NO

* CHECK IF MOUSE INBOUNDS

	MOVE.W	ymouse,D1	* (RELATIVE TO ENTIRE GAME WINDOW; 1-ORIGIN)
**	ADDQ.W	#1,D1
	MOVE.W	xmouse,D2
**	ADDQ.W	#1,D1

	MOVE.W	MSWIND(A6),D0	* CONSTRAIN MOUSE TO THIS WINDOW
	BLT.S	ITTYX13		* -1 MEANS NO CONSTRAINT
	BSR	CALCWP
	MOVE.L	A0,A1		* POINT TO WINDOW-RECORD

	MOVE.W	WYPOS(A1),D0
	CMP.W	D0,D1
	BLT.S	ITTYX18		* OUT OF BOUNDS
	ADD.W	WYSIZE(A1),D0
	CMP.W	D0,D1
	BGE.S	ITTYX18		* OUT OF BOUNDS

	MOVE.W	WXPOS(A1),D0
	CMP.W	D0,D2
	BLT.S	ITTYX18		* OUT OF BOUNDS
	ADD.W	WXSIZE(A1),D0
	CMP.W	D0,D2
	BGE.S	ITTYX18		* OUT OF BOUNDS

* STORE MOUSE Y POSITION
* IF A TABLE ERROR OCCURS, WE NOW RETURN THE MOUSE EVENT ANYWAY
* (DURING A [MORE], THE TABLE PTR IS ZEROED TO PREVENT CHANGES)

ITTYX13	MOVEQ	#PMLOCY,D0	* LOWCORE-EXTENSION VAR FOR MOUSE YPOS
	BSR	LOWCORE		* GET ITS ADDR
	BEQ.S	ITTYX19 *18	* ERROR (TABLE UNDEFINED, OR TOO SMALL)
	MOVE.W	D1,D0
	BSR	PTAWRD

* STORE MOUSE X POSITION

	MOVEQ	#PMLOCX,D0
	BSR	LOWCORE
	BEQ.S	ITTYX19 *18	* ERROR
	MOVE.W	D2,D0
	BSR	PTAWRD
	BRA.S	ITTYX19

ITTYX18	CLR.W	D3		* ERROR, DISCARD MOUSE EVENT
ITTYX19	MOVE.W	D3,D0		* RETURN MOUSE CODE
	MOVEM.L	(SP)+,D1-D3/A1
	RTS

* ENTER HERE TO LOOP UNTIL A CHAR IS AVAILABLE

TTYIN	MOVEM.L	D1-D2,-(SP)
	MOVEQ	#1,D0		* SET UP FOR INPUT
	MOVEQ	#0,D1		* SINGLE CHAR
	BSR	SETUPI

TTYX1	BSR	ITTYIN
	TST.B	D0
	BEQ.S	TTYX1		* IF NONE, KEEP WAITING

	MOVE.W	D0,D2
	MOVEQ	#0,D0		* FINISHED INPUT
	MOVEQ	#0,D1		* SINGLE CHAR
	BSR	SETUPI
	MOVE.W	D2,D0		* RETURN THE CHAR
	MOVEM.L	(SP)+,D1-D2
	RTS

* ----------------------
* GETMOUSE
* ----------------------

* GET MOUSE INFO, 
* RETURN D0.W/D1.W = ROW/COL, D2.W = BUTTON FLAGS
* RETURN D3.W = MENU/ITEM (VALID ONLY AFTER A REPORTED MENU EVENT)

GETMOUSE
	SAVEREGS
	JSR	opMouseInfo
	RESTREGS
	MOVE.W	ymouse,D0
	MOVE.W	xmouse,D1
	MOVE.W	bmouse,D2
	MOVE.W	mmouse,D3
	RTS

* ----------------------
* OUTCHR
* ----------------------

* OUTPUT THE CHAR (OR CR) IN D0.B  (SCROLLING IF NECESSARY)

OUTCHR	CMPI.B	#13,D0		* [DON'T PAUSE AT FINISH JUST FOR CR'S]
	BEQ.S	TTYOUT
	CLR.W	INLAST(A6)	* CURRENT I/O IS OUTPUT

* IF CHAR = BS, THE PREVIOUS CHAR IS NOW PASSED IN THE HIGH BYTE

TTYOUT	SAVEREGS
	MOVE.W	D0,D1
	CMPI.B	#DELCH1,D1	* BS?
	BEQ.S	TTYOX1		* YES
	MOVEQ	#0,D1
	MOVE.B	D0,D1		* OTHERWISE, CLEAR HIGH BYTE

TTYOX1	CMPI.B	#13,D1		* IS THIS A CR?
	BNE.S	TTYOX2
	BSR	CRCHECK		* YES, CHECK FOR POSSIBLE INTERRUPT (XZIP)
    IF D3BUG THEN
	BSR	D3CHK
    ENDIF
    
TTYOX2	MOVE.W	D1,-(SP)
	JSR	CharOut
    IF D3BUG THEN
	BSR	D3CHK
    ENDIF
	RESTREGS
	RTS

* ----------------------
* MDPRINT
* ----------------------

* OUTPUT A STRING, POINTER IN A0, LENGTH IN D0.W

MDPRINT	CLR.W	INLAST(A6)	* CURRENT I/O IS OUTPUT
	TST.W	D0
	BEQ.S	MPRNTX1		* SKIP OUT IF NULL
	SAVEREGS
	MOVE.L	A0,-(SP)	* PASS THE STRING POINTER
	MOVE.W	D0,-(SP)	* AND LENGTH
	JSR	LineOut
	RESTREGS
MPRNTX1	RTS

* ----------------------------------------------
* MORE DISPLAY CALLS
* ----------------------------------------------

* ----------------------
* SETSPLT
* ----------------------

* >>> DEAD <<<
* SET THE SPLIT SIZE, D0 = LINES IN TOP SCREEN (0 IF UNSPLIT)

* ----------------------
* GETSPLT
* ----------------------

* >>> DEAD <<<
* RETURN D0 = SPLIT SIZE

* ----------------------
* SETSCRN
* ----------------------

* >>> DEAD <<<
* SET THE ACTIVE SCREEN, D0 = NEW VALUE (0 OR 1)

* ----------------------
* GETSCRN
* ----------------------

* >>> DEAD <<<
* RETURN D0 = CURRENTLY ACTIVE GAME SCREEN, PLUS FLAGS

* ----------------------
* MAXSCRN
* ----------------------

* GET FULL-SCREEN DIMENSIONS, RETURN D0.W = ROWS, D1.W = COLS

MAXSCRN	
	MOVE.W	totRows,D0
	MOVE.W	totCols,D1
	RTS

* ----------------------
* GETFYX
* ----------------------

* RETURN D0.W = CELL SIZE (IN PIXELS, Y/X) OF CURRENT FONT  [SEE ALSO CHSIZ]
*   IF PROPORTIONAL, RETURN SIZE OF A DIGIT

GETFYX	MOVE.W	lineHeight,D0
	LSL.W	#8,D0
	OR.W	colWidth,D0

***	MOVE.W	#YCHAR*256+XCHAR,D0
***	MOVE.W	#$0101,D0	* 1 CHAR UNIT = 1 PIXEL
	RTS

* ----------------------
* DCHSIZ, SCHSIZ
* ----------------------

* GIVEN AN ASCII CHAR, RETURN ITS UNIT WIDTH (IN CURRENT FONT)
* >> NOW SUPPORTS PROPORTIONAL FONTS <<
* >> Call the Mac Toolbox directly, for speed <<

DCHSIZ	MOVEM.L	D1-D2/A1,-(SP)	* Save regs that Toolbox doesn't [need a new macro]
	SUBQ.L	#2,SP		* [space for return val]
***	MOVE.B	D0,-(SP)	* [only for a boolean!]
	MOVE.W	D0,-(SP)
	_CharWidth
	MOVE.W	(SP)+,D0
	MOVEM.L	(SP)+,D1-D2/A1

***	MOVEQ	#XCHAR,D0	* [IN PIXELS]
	RTS

SCHSIZ	MOVEQ	#1,D0		* SCRIPTING: ALWAYS 1 UNIT
	RTS

* ----------------------
* SETBUF
* ----------------------

* ADJUST BUFFERING LENGTH (AFTER CHANGE IN WINDOW SIZE, OR MARGINS)

SETBUF	MOVE.W	lastCol,D0
	SUB.W	firstCol,D0	* CALC WIDTH
	SUB.W	margLeft,D0
	SUB.W	margRight,D0	* ADJUST FOR MARGINS
	BGT.S	SBFX0
***	MOVEQ	#'M',D0
***	BSR	DCHSIZ
***	MOVEQ	<maxchrsiz>,D0
	MOVEQ	#1,D0		* MINIMUM VALID LEN (UNITS...)
SBFX0	MOVE.L	DQUE(A6),A0
	BRA	SIZEQP		* AND UPDATE LINE-WRAP

* ----------------------
* SETBOUNDS
* ----------------------

* SET DISPLAY-WINDOW POSITION AND SIZE
* ALSO ADJUST CURSOR POSITION; HOME IT IF OUT OF BOUNDS
*   GIVEN D0/D1 = POSITION (ROW/COL, 1-ORIGIN), D2/D3 = SIZE (ROWS/COLS)

SETBOUNDS
	MOVEM.L	D4-D5,-(SP)
	MOVE.W	D0,D4
	MOVE.W	D1,D5
	BSR	PUTLIN		* (MAKE SURE BUFFER IS EMPTY)
	BSR	GETCURS		* READ CURSOR POS (RELATIVE, 1-ORG)
	EXG	D0,D4
	EXG	D1,D5
	BSR	NEWBOUNDS

	MOVE.W	totRows,D0
	SUB.W	firstRow,D0	* CALC NEW HEIGHT
	CMP.W	D0,D4		* CURSOR NOW OUT OF BOUNDS?
	BGT.S	SBNDX4		* YES

	MOVE.W	totCols,D1
	SUB.W	firstCol,D1	* CALC NEW WIDTH
	CMP.W	D1,D5		* CURSOR NOW OUT OF BOUNDS?
	BLE.S	SBNDX6		* NO

SBNDX4	MOVEQ	#1,D4		* HOME CURSOR
	MOVEQ	#1,D5

SBNDX6	MOVE.W	D4,D0		* WRITE NEW CURSOR POS
	MOVE.W	D5,D1
	BSR	SETCURS

	BSR	SETBUF		 * ADJUST BUFFERING LENGTH
	MOVEM.L	(SP)+,D4-D5
	RTS

* ----------------------
* NEWBOUNDS
* ----------------------

* SET DISPLAY-WINDOW POSITION AND SIZE
*   GIVEN D0/D1 = POSITION (ROW/COL, 1-ORIGIN), D2/D3 = SIZE (ROWS/COLS)

NEWBOUNDS
	MOVE.L	D7,-(SP)

	SUBQ.W	#1,D0		* FIRST ROW, MAKE 0-ORIGIN
	MOVE.W	totRows,D7
	SUBQ.W	#1,D7		* (ONLY /LAST/ ROW CAN EQUAL totRows)
	BSR	INBOUNDS	* MUST BE WITHIN SCREEN
	MOVE.W	D0,firstRow

	TST.W	D2		* HEIGHT
	BGE.S	NBNDX2		* MAKE SURE IT'S NON-NEGATIVE
	MOVEQ	#0,D2

NBNDX2	ADD.W	D2,D0		* LAST ROW (+1)
	MOVE.W	totRows,D7
	BSR	INBOUNDS	* MUST BE WITHIN SCREEN
	MOVE.W	D0,lastRow

	SUBQ.W	#1,D1		* FIRST COL, MAKE 0-ORIGIN
	MOVE.W	D1,D0
	MOVE.W	totCols,D7
	SUBQ.W	#1,D7
	BSR	INBOUNDS	* MUST BE WITHIN SCREEN
	MOVE.W	D0,firstCol

	TST.W	D3		* WIDTH
	BGE.S	NBNDX4		* MAKE SURE IT'S NON-NEGATIVE
	MOVEQ	#0,D3

NBNDX4	ADD.W	D3,D0		* LAST COL (+1)
	MOVE.W	totCols,D7
	BSR	INBOUNDS	* MUST BE WITHIN SCREEN
	MOVE.W	D0,lastCol

	MOVE.L	(SP)+,D7
	RTS

* ----------------------
* INBOUNDS
* ----------------------

* GIVEN D0.W = VALUE, D7.W = BOUNDS;  MAKE SURE 0 <= VAL <= BOUNDS

INBOUNDS
	CMP.W	D7,D0
	BLE.S	IBNDX1		* CAN'T EXCEED BOUNDS
	MOVE.W	D7,D0
IBNDX1	TST.W	D0
	BGE.S	IBNDX2		* [THEN] MUST BE NON-NEGATIVE
	MOVEQ	#0,D0
IBNDX2	RTS

* ----------------------
* SETCURS
* ----------------------

* SET CURSOR POSITION
*   GIVEN D0.W = ROW, D1.W = COL (1-ORIGIN, RELATIVE TO CURRENT WINDOW)
*   -1 MEANS DON'T CHANGE

SETCURS	
***	bsr	putlin    ?? 	* done by caller
***	MOVEM.L	D1/D7,-(SP)
	MOVE.L	D7,-(SP)
	TST.W	D0		* ROW [DON'T CHANGE?]
	BLT.S	SCURX2
	SUBQ.W	#1,D0		* MAKE 0-ORIGIN

	MOVE.W	lastRow,D7
	SUB.W	firstRow,D7	* CALC HEIGHT
	SUBQ.W	#1,D7

*** MAKE SURE AT LEAST 1 /CHAR/ IN FROM WINDOW EDGE (?)
***	MOVE.L	CURWP(A6),A0
***	MOVEQ	#0,D1
***	MOVE.B	WFONTYX(A0),D1	* VERTICAL LINE SIZE

	BSR	INBOUNDS	* "CLIP" (DON'T HOME) POSITION IF NEEDED
	ADD.W	firstRow,D0	* ABSOLUTIZE POSITION
	MOVE.W	D0,curRow

SCURX2	MOVE.W	D1,D0		* COL [DON'T CHANGE?]
	BLT.S	SCURX4
	SUBQ.W	#1,D0		* MAKE 0-ORIGIN
	
	MOVE.W	lastCol,D7
	SUB.W	firstCol,D7	* CALC WIDTH
	SUBQ.W	#1,D7
	BSR	INBOUNDS	* MAKE SURE CURSOR WITHIN WINDOW
	ADD.W	firstCol,D0	* ABSOLUTIZE POSITION
	MOVE.W	D0,curCol

SCURX4	MOVE.L	(SP)+,D7
***	MOVEM.L	(SP)+,D1/D7
	RTS

* ----------------------
* GETCURS
* ----------------------

* RETURN CURSOR POSITION (RELATIVE TO CURRENT WINDOW, 1-ORIGIN)
*   D0.W = ROW, D1.W = COL

GETCURS BSR	PUTLIN		* (FIRST, MAKE SURE BUFFER IS EMPTY)

* ENTER HERE FROM NXTLIN, ETC ...
GETCURS1
	MOVE.W	curRow,D0
	SUB.W	firstRow,D0	* RELATIVIZE IT
	ADDQ.W	#1,D0		* MAKE 1-ORIGIN
	MOVE.W	curCol,D1
	SUB.W	firstCol,D1	* RELATIVIZE IT
	ADDQ.W	#1,D1		* MAKE 1-ORIGIN
	RTS

* ----------------------
* SETFONT
* ----------------------

* SET FONT (IN CURRENT WINDOW), D0.W = ID

* ZFONT ARGS
ZSTD	EQU	1	* Geneva
ZGFX	EQU	2	* "graphics font" -- NOT HANDLED
ZALT	EQU	3	* BZ Font [currently 9-point]
ZMONO2	EQU	4	* Monaco -- NEW ID
* ZFONT EXTENSION ARGS
ZMONO	EQU	-1	* Monaco
ZTOGGLE	EQU	-2	* switch proportional/mono (for debugging)

SETFONT	CMPI.W	#ZMONO2,D0 * [SUPPORT FONT4 = MONO, TOO]
	BNE.S	STFTX1
	MOVEQ	#ZMONO,D0  * MAP NEW ID TO OLD

STFTX1	SAVEREGS
	MOVE.W	D0,-(SP)
	JSR	ZFont
	RESTREGS

***	MOVE.W	D0,currentFont
	RTS

* ----------------------
* GETFONT
* ----------------------

* RETURN FONT (IN CURRENT WINDOW), D0.W = ID
* >> DEAD <<

* ----------------------
* SETATTR
* ----------------------

SETATTR	MOVE.W	D0,currentAttr	* wrap, etc
	RTS

* ----------------------
* SETHL
* ----------------------

SETHL	MOVE.L	D1,-(SP)
	MOVE.W	currentHl,D1	* PREVIOUS VAL
	MOVE.W	D0,currentHl	* UPDATE:  inverse, etc

* BIT 8 = MONOFONT -- CHECK AND HANDLE SEPARATELY
* [IDEA: UNDER YZIP, DEFINE MONOFONT UNDER OPFONT NOT OPHLIGHT]

	EOR.W	D0,D1		* DID MONO BIT CHANGE?
	ANDI.W	#HLMONO,D1	* ISOLATE IT
	BEQ.W	STHLX9		* NO

	MOVEQ	#ZSTD,D1	* YES, DEFAULT ACTION
	ANDI.W	#HLMONO,D0	* ISOLATE NEW VAL
	BEQ.S	STHLX1
	MOVEQ	#ZMONO,D1	* CHANGE TO MONO

STHLX1	MOVE.W	D1,D0
	BSR	SETFONT

STHLX9	MOVE.L	(SP)+,D1
	RTS

* ----------------------
* MDATTR
* ----------------------

* SET THE HIGHLIGHTING ("ATTRIBUTES"), ARGBIT(S) IN D0.W
*   IF D0 = -1, JUST RETURN OLD ATTRIBUTES
* >> DEAD <<

* ----------------------
* MDSCROLL
* ----------------------

* SCROLL CURRENT WINDOW, D0.W = DELTA (IN PIXELS) (NEGATIVE MEANS DOWN)

MDSCROLL
	SAVEREGS
	MOVE.W	D0,-(SP)
	JSR	Scroll
	RESTREGS
	RTS

* ----------------------
* MDCLEAR
* ----------------------

* CLEAR ACTIVE WINDOW
* D0.W = -1 MEANS CLEAR ENTIRE SCREEN

MDCLEAR	SAVEREGS
	MOVE.W	D0,-(SP)
	JSR	ClearWindow	* [was ClearLines]
	RESTREGS
	RTS

* ----------------------
* SETMARG
* ----------------------

* SET THE LEFT AND RIGHT MARGINS
* D0.W = LEFT, D1.W = RIGHT (DEFAULTS ARE BOTH 0)

SETMARG	MOVE.W	D0,margLeft
	MOVE.W	D1,margRight
	BRA	SETBUF		 * ADJUST BUFFERING LENGTH

* ----------------------
* GETMARG
* ----------------------

* >>> DEAD <<<
* RETURN THE LEFT AND RIGHT MARGINS

* ----------------------
* MDERASE
* ----------------------

* CLEAR WITHIN CURRENT LINE, D0.W = START [ABSOLUTE!], D1.W = LEN
* DEFAULTS VALS (-1) ARE CURSOR POSITION AND [TO] EOL

MDERASE	SAVEREGS
	MOVE.W	D0,-(SP)
	MOVE.W	D1,-(SP)
	JSR	EraseLine	* (left, right: INTEGER)
	RESTREGS
	RTS

* ----------------------
* MDCOLOR
* ----------------------

* SET/GET SCREEN COLORS
* GIVEN D0.W = FORE, D1.W = BACK,
* RETURN D0.W = DEFAULT BACK/DEFAULT FORE, D1.W = COLOR FLAG (0 IF MONO)

MDCOLOR	SAVEREGS
	RESWORD
	MOVE.W	D0,-(SP)
	MOVE.W	D1,-(SP)
	JSR	SetColor
	POPWORD
	RESTREGS
	MOVEQ	#0,D1
	MOVE.B	mColor,D1	* Mac: Boolean var
	RTS

* ----------------------------------------------
* SCRIPTING CALLS
* ----------------------------------------------

* ----------------------
* SCRINIT
* ----------------------

* SETUP SCRIPTING, FLAG IN D0: 1=START, 0=STOP

SCRINIT	SAVEREGS
	MOVE.B	D0,-(SP)	* [PASCAL: PASS BOOL @ODD ADDR]
	JSR	PrInit
	RESTREGS
	RTS

* ----------------------
* SCROUT
* ----------------------

* SCRIPT OUT A LINE, START IN A0, END IN D0, THEN TACK ON A CR/LF

SCROUT  SAVEREGS
	SUB.L	A0,D0		* THIS IS THE LENGTH
	MOVE.L	A0,-(SP)
	MOVE.W	D0,-(SP)
	JSR	PrLine		* ALL HANDLED IN PASCAL
	RESTREGS
	RTS

* ----------------------------------------------
* GRAPHICS CALLS
* ----------------------------------------------

* ----------------------
* PICINF
* ----------------------

* LOOKUP PICTURE SIZE INFO
* GIVEN D0.W = ID, A0 -> TABLE FOR RESULTS (Y,X)
*   IF ID = 0, RETURN MAX ID IN TABLE WORD 0
*   IF ID IS IN ERROR, RETURN FLAGS NEGATIVE, ELSE ZERO
* EXTERN FUNCTION opPicinf (n: INTEGER; VAR tbl: ARRAY2): INTEGER;

PICINF	SAVEREGS
	RESWORD
	MOVE.W	D0,-(SP)
	MOVE.L	A0,-(SP)
	JSR	opPicinf
	POPWORD
	RESTREGS

	TSTWORD
	RTS

* ----------------------
* PICDISP
* ----------------------

* DISPLAY [OR CLEAR] A PICTURE
* D0.W = ID (1-ORIG), D1,D2 = YPOS,XPOS (1-ORIG), D3 = NONZERO TO CLEAR
* EXTERN PROCEDURE opDisplay (id, ypos, xpos, erase: INTEGER);

PICDISP	SAVEREGS
	MOVE.W	D0,-(SP)
	SUBQ.W	#1,D1		* MAKE POSITION 0-ORIGIN
	MOVE.W	D1,-(SP)
	SUBQ.W	#1,D2
	MOVE.W	D2,-(SP)
	MOVE.W	D3,-(SP)
	JSR	opDisplay
	RESTREGS
	RTS

* ----------------------
* PICSET
* ----------------------

* PRELOAD A PICTURE SET
* A0 -> WORD TABLE (EVEN ALIGNED, [NULL-TERMINATED]) OF PIC IDS
* D0.W = ID COUNT

PICSET	SAVEREGS
	MOVE.L	A0,-(SP)
	MOVE.W	D0,-(SP)
	JSR	getPicset
	RESTREGS
	RTS

* ----------------------
* ENDTITLE
* ----------------------

* IF A TITLE SCREEN WAS DRAWN, WAIT FOR A KEY. DON'T ERASE SCREEN, LET  
* GAME. (OTHERWISE MAY CAUSE A FLASH AS GAME SETS UP ITS SCREEN COLORS.)
* COME HERE AFTER GAME HAS BEEN LOADED BUT BEFORE STARTING.  

ENDTITLE
	RTS		* Mac: NOT IMPLEMENTED

* ----------------------------------------------
* AUDIO CALLS
* ----------------------------------------------

* ----------------------
* DOSOUND
* ----------------------

* MAC: ADJUST ARG4
*   COUNT: 0=INFINITE, 1-254=FINITE, -1=USE MIDI COUNT

DOSOUND	TST.W	D3
	BGT.S	DOSDX2		* IF 1-254, JUST PASS ALONG
	ADDQ.W	#1,D3		* MAP -1 TO 0
	BEQ.S	DOSDX2
	MOVEQ	#-1,D3		* MAP 0 TO -1

DOSDX2	SAVEREGS
	MOVE.W	D0,-(SP)	* ID
	MOVE.W	D1,-(SP)	* ACTION
	MOVE.W	D2,-(SP)	* VOLUME
	MOVE.W	D3,-(SP)	* COUNT
	JSR	ZSound
	RESTREGS
	RTS

* ----------------------
* ZBEEP
* ----------------------

ZBEEP	MOVEM.L	D1-D3,-(SP)
	MOVEQ	#1,D0		* BEEP ID
	MOVEQ	#2,D1		* START
	MOVEQ	#-1,D2		* DEFAULT VOL
	MOVEQ	#1,D3		* SINGLE REPEAT
	BSR	DOSOUND
	MOVEM.L	(SP)+,D1-D3
	RTS

* ----------------------
* GAMINT, GAMINT1
* ----------------------

GAMINT
GAMINT1
	RTS

*** [INTERRUPT-DRIVEN SOUND ISN'T BEING USED IN YZIP THESE DAYS] ***
    IF CZIP THEN

* PERIODICALLY CHECK FOR GAME INTERRUPTS

* NOTE: BECAUSE THE INTERPRETER AS A WHOLE IS /NOT/ RE-ENTRANT, THIS 
* ROUTINE SHOULD BE CALLED ONLY FROM THE TOP OF THE MAIN LOOP (NXTINS), AND
* (PERHAPS) FROM OPREAD/OPINPUT (SO SOUNDS CAN CHAIN BETWEEN MOVES).  
* BUT IT SHOULD /NOT/ BE CALLED FROM ITTYIN, SINCE THAT IS ALSO CALLED 
* FROM [MORE], AND THE INTERPRETER STATE IS UNDEFINED.

SKPCNT	EQU	50	* 2500 ops/sec (max) ==> 50 ints/sec (max)

* ENTRY POINT FROM MAIN LOOP
* To avoid cutting into interpreter performance too much, we keep a
* simple counter, and only occasionally perform the (somewhat costlier) 
* check for a sound interrupt.

GAMINT	SUBQ.W	#1,SCOUNT(A6)	* TIME FOR A SOUND CHECK?
	BLE.S	GAMIX1
	RTS			* NO, QUICK EXIT
GAMIX1	MOVE.W	#SKPCNT,SCOUNT(A6)    * YES, RESET COUNTER AND FALL THRU

* ENTRY POINT FROM INPUT-WAIT LOOP
* While awaiting Mac input, check for sound every time around (or at least  
* every 1/10 sec).  Note: called from OPREAD/OPINPUT; probably safe to call 
* interrupt function as long as it doesn't itself call OPREAD/OPINPUT.

GAMINT1	SAVEREGS

* (could check first for valid SFUNC(A6), skip end-check if none,
* but then end event would hang around unreported ...)

	RESWORD
	JSR	EndZSound	* END-OF-SOUND CHECK
	MOVE.B	(SP)+,D0	* >> BOOLEAN <<  NON-ZERO IF END DETECTED
	BEQ.S	GAMIX3

	MOVE.W	SFUNC(A6),D0	* SOUND-INTERRUPT FUNCTION ("START NEXT")
	BEQ.S	GAMIX3		* NONE
	BSR	INCALL		* CALL IT (INTERNALLY)
***	TST.W	D0		* (NO RETURN VAL)

GAMIX3	RESTREGS
	RTS
    ENDIF

* ----------------------------------------------
* DISK I/O ROUTINES
* ----------------------------------------------

* ----------------------
* OPNGAM, CLSGAM
* ----------------------

* OPEN THE GAME FILE, STORE REFNUM, RETURN FLAGS

OPNGAM	MOVEQ	#0,D0
	RTS			* [MAC: NOW DONE IN MACINIT]

* CLOSE THE GAME FILE, RETURN FLAGS

CLSGAM	MOVEQ	#0,D0
	RTS			* [MAC: NOW IN FINISH]

* ----------------------
* GETBLK, GTBLKS
* ----------------------

* GET A GAME FILE BLOCK, BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0

GETBLK  MOVEM.L	D1,-(SP)
	MOVEQ	#1,D1		* ONE BLOCK
	BSR	GTBLKS
	MOVEM.L	(SP)+,D1	* (DOESN'T ALTER FLAGS)
	RTS

* GET A SERIES OF GAME FILE BLOCKS
* FIRST BLOCK NUMBER IN D0, CORE TARGET LOCATION IN A0, TOTAL BLOCKS IN D1

GTBLKS  SAVEREGS
	BSR	BLKBYT		* CONVERT BLOCKS TO BYTES
	EXG	D1,D0
	BSR	BLKBYT
	EXG	D1,D0
	RESWORD
	MOVE.W	GAMFIL(A6),-(SP)
	MOVE.L	D0,-(SP)	* OFFSET IN BYTES
	MOVE.L	D1,-(SP)	* LENGTH IN BYTES
	MOVE.L	A0,-(SP)	* BUFFER
	JSR	ReadFile
	POPWORD
	RESTREGS
	TSTWORD			* ERROR ON READ?
	BNE.S	GTBKX2		* YES, FAIL
GTBKX1	RTS

*	TST.W	DSKERR(A6)	* BUT WERE WE ASKED TO RETURN WITH FLAGS?
*	BNE	GTBKX1		* YES

GTBKX2	LEA	MSGREA,A0	* ERROR CODE IN D0
	BRA	FATAL		* 'Story file read error.'

    DATA
MSGREA	DC.B	'Story file read error.',0
    CODE

* ----------------------
* DKSWAP
* ----------------------

* PRELIMINARY DIALOG FOR SAVE/RESTORE
*   PROMPT USER TO SWAP DISKS AND IDENTIFY DRIVE BEING USED
*   RETURN LETTER IN D0, ZERO FOR DEFAULT

* >>> THIS FUNCTION NOW HANDLED WITHIN FILE-SELECT CALL <<<

* ----------------------
* DUPNAM
* ----------------------

* DUPLICATE NAME CHECK/DIALOG (FOR SAVES ONLY)
*   CHECK FOR FILENAME CONFLICT, IF SO, PROMPT USER FOR INSTRUCTIONS
*   RETURN ZERO TO PROCEED NORMALLY, OTHERWISE ABORT

DUPNAM	MOVEQ	#0,D0		* [MAC: THIS FUNC HANDLED BY OS (FSEL)]
	RTS

*	SAVEREGS
*	RESWORD
*	JSR	ExistFile
*	POPWORD
*	MOVE.W	D0,D1		* RESULT
*	BEQ.S	DUPX3		* ZERO MEANS NONE
*
*DUPX1	LEA	MSGDUP,A0
*	BSR	OUTMSG0		* PROMPT, DON'T ADD A CR
*
*    DATA
*MSGDUP	DC.B	'You are about to write over an existing file.  '
*	DC.B	'Proceed? (Y/N) ',0
*    CODE
*
*	BSR	TTYIN		* GET A CHAR
*	CLR.W	D1		* ASSUME A NORMAL SAVE
*
*	CMPI.B	#'Y',D0		* PROCEED?
*	BEQ.S	DUPX2		* YES
*	CMPI.B	#'y',D0
*	BEQ.S	DUPX2		* YES
*
*	MOVEQ	#1,D1		* NO, ABORT (ANY KEY BESIDES 'Y')
*	MOVE.B	#'N',D0
*DUPX2	BSR	PUTCHR
*	BSR	PUTNEW		* FOLLOW WITH A CR
*
*DUPX3	MOVE.W	D1,D0		* RETURN FLAGS FOR RESULT
*	RESTREGS
*	RTS

* ----------------------
* GETSFL
* ----------------------

* POLL USER FOR A FILE NAME, DRIVE, DIRECTORY, ETC  (LEAVE IN GLOBAL)
*   GIVEN:
*	D0.W = SET IF SAVE, 0 IF RESTORE,
*	D1.W = SET IF PARTIAL, 0 IF NORMAL,
*	A0 -> XZIP "SUGGESTED" NAME  (BYTE 0 IS LEN)
*   RETURN WITH FLAGS SET, ZERO IF NO ERROR

GETSFL  MOVEM.L	D2-D3/A1,-(SP)
	MOVE.W	D0,D2		* REPOSITION THESE VALS
	MOVE.W	D1,D3

	TST.W	D3
	BEQ.S	GTSFX2		* IF NORMAL, NO XZIP NAME
	MOVEQ	#1,D0
	ADD.B	(A0),D0
	MOVEQ	#12+1,D1	* MAX LEN  (ST/PC DOS)
	LEA	filename,A1
	BSR	COPYS		* IF PARTIAL, SUGGEST NAME TO USER

GTSFX2	SAVEREGS
	RESWORD
	MOVE.B	D3,-(SP)	* NORMAL/PARTIAL [PASCAL: PASS BOOL @ODD ADDR]
	MOVE.B	D2,-(SP)	* SAVE/RESTORE
	JSR	FileSelect
	POPWORD
	RESTREGS

	MOVE.W	D0,D1		* FSEL RESULT, NON-ZERO IF CANCEL OR ERROR
	BNE.S	GTSFX8
	BSR	SCRNAM		* IF OK, OUTPUT FILENAME TO TRANSCRIPT

	TST.W	D2		* WAS THIS A SAVE?
	BEQ.S	GTSFX8		* NO
	BSR	DUPNAM		* YES, CHECK FOR DUPLICATE FILENAME
	MOVE.W	D0,D1		* NON-ZERO IF USER SAYS ABORT

GTSFX8	MOVEM.L	(SP)+,D2-D3/A1
	TST.W	D1		* FINAL RESULT, RETURN FLAGS
	RTS

* ----------------------
* NEWSFL
* ----------------------

* CREATE (IF NECESSARY) AND OPEN A SAVE FILE, USING GLOBAL FILENAME
*   RETURN WITH FLAGS SET, ZERO IF NO ERROR

NEWSFL  SAVEREGS
	RESWORD
	PEA	SAVFIL(A6)	* RETURN CHANNEL HERE
	JSR	CreateFile
	POPWORD
	RESTREGS
***	TST.W	D0		* [REDUNDANT]
***	BEQ.S	NEWSX2

*	CMPI.W  #-44,D0		* ST: DISK IS WRITE-PROTECTED? (SAY SO)
*	CMPI.W  #-48,D0		* ST: NAME EXISTS ALREADY? (IGNORE)

	MOVE.W	D0,-(SP)
	BSR	WPRCHK		* IF WRITE-PROTECT ERROR, INFORM USER
	MOVE.W	(SP)+,D0

NEWSX2	
***	TST.W	D0		* [REDUNDANT]
	RTS			* RETURN FLAGS

* ----------------------
* OPNSFL
* ----------------------

* OPEN A (RESTORE) FILE, USING GLOBAL FILENAME, LEAVE CHANNEL IN SAVFIL(A6)
*   RETURN WITH FLAGS, ZERO IF NO ERROR

OPNSFL  SAVEREGS
	RESWORD
	PEA	SAVFIL(A6)	* RETURN CHANNEL HERE
	JSR	OpenFile
	POPWORD
	RESTREGS

	TSTWORD
	RTS

* ----------------------
* GTSBKS, SFREAD
* ----------------------

* GET A SERIES OF SAVE FILE BLOCKS
*   FIRST BLOCK NUMBER IN D0, # OF BLOCKS IN D1, CORE TARGET LOCATION IN A0
*   RETURN WITH FLAGS, NONZERO IF ERROR

GTSBKS	BSR	BLKBYT		* CONVERT BLOCKS TO BYTES
	EXG	D1,D0
	BSR	BLKBYT
	EXG	D1,D0

* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
* RETURN FLAGS, >> ALSO D1 = ACTUAL BYTES READ <<

SFREAD	SAVEREGS
	RESWORD
	MOVE.W	SAVFIL(A6),-(SP)
	MOVE.L	D0,-(SP)	* OFFSET IN BYTES
	MOVE.L	D1,-(SP)	* LENGTH IN BYTES
	MOVE.L	A0,-(SP)	* BUFFER POINTER
	JSR	ReadFile
	POPWORD
	RESTREGS
	MOVE.L	actlen,D1
	TST.W	D0		* NONZERO MEANS ERROR
	RTS

* ----------------------
* PTSBKS, SFWRIT
* ----------------------

* WRITE A SERIES OF SAVE FILE BLOCKS,
*   FIRST BLOCK OFFSET IN D0, NUMBER OF BLOCKS IN D1, CORE LOCATION IN A0,
*   RETURN WITH FLAGS, NONZERO IF ERROR

PTSBKS	BSR	BLKBYT		* CONVERT BLOCKS TO BYTES
	EXG	D1,D0
	BSR	BLKBYT
	EXG	D1,D0

* ENTER HERE: BYTE OFFSET IN D0, BYTE LENGTH IN D1
* RETURN FLAGS, >> ALSO D1 = ACTUAL BYTES READ <<

SFWRIT	SAVEREGS
	RESWORD
	MOVE.W	SAVFIL(A6),-(SP)	
	MOVE.L	D0,-(SP)	* OFFSET IN BYTES
	MOVE.L	D1,-(SP)	* LENGTH IN BYTES
	MOVE.L	A0,-(SP)	* BUFFER POINTER
	JSR	WriteFile
	POPWORD
	RESTREGS

	MOVE.W	D0,D1		* ANY ERROR?
	BEQ.S	PTSBX2		* NO

	CMPI.W	#dskFulErr,D0	* Mac: DISK-FULL ERROR?
	BEQ.S	PTSBX1		* YES, INFORM USER

	BSR	WPRCHK		* ALSO CHECK FOR WRITE-PROTECT ERROR
	BRA.S	PTSBX2

PTSBX1	LEA	MSGFUL,A0
	BSR	OUTMSG		* 'Not enough room on disk.'

    DATA
MSGFUL	DC.B	'Not enough room on disk.',0
    CODE

PTSBX2	MOVE.W	D1,D0
	MOVE.L	actlen,D1	* COUNT
	TST.W	D0		* FLAGS, NONZERO MEANS ERROR
	RTS

* ----------------------
* WPRCHK
* ----------------------

* CHECK FOR DISK WRITE-PROTECT ERROR, GIVEN D0 = RESULT CODE
*  (MAY BE CALLED DURING FILE CREATE /OR/ FILE WRITE)

WPRCHK	CMPI.W	#wPrErr,D0	* Mac: WRITE-PROTECT ERROR?
	BNE.S	WPRCX1

	LEA	MSGWPR,A0	* INFORM USER
	BSR	OUTMSG		* 'Disk is write-protected.'
WPRCX1	RTS

    DATA
MSGWPR	DC.B	'Disk is write-protected.',0
    CODE

* ----------------------
* CLSSFL
* ----------------------

* CLOSE A SAVE FILE, CHANNEL IN SAVFIL(A6)
*   RETURN WITH FLAGS SET, ZERO IF NO ERROR

CLSSFL  SAVEREGS
	RESWORD
	MOVE.W	SAVFIL(A6),-(SP)
	JSR	CloseFile
	POPWORD			* NON-ZERO IF ERROR
	RESTREGS

	TSTWORD
	RTS

* ----------------------
* DELSFL
* ----------------------

* DELETE A BAD SAVE FILE, MUST HAVE BEEN ALREADY CLOSED (OR NOT OPENED)
*   RETURN WITH FLAGS SET, ZERO IF NO ERROR

DELSFL  SAVEREGS
	RESWORD
	JSR	DeleteFile
	POPWORD			* NON-ZERO IF ERROR
	RESTREGS

	TSTWORD
	RTS

* ----------------------
* DEFOLD
* ----------------------

DEFOLD	CLR.W	D0		* RETRIEVE PREVIOUS DEFAULT NAMES
	BRA	DEFNX1
DEFNEW  MOVEQ	#1,D0		* UPDATE PREVIOUS DEFAULT NAMES

DEFNX1	SAVEREGS
	MOVE.B	D0,-(SP)	* [PASCAL: PASS BOOL @ODD ADDR]
	JSR	NewDefault	* (COPIES SOME GLOBAL STRINGS)
	RESTREGS
	RTS

* ----------------------
* CHKDSK, CHKDSK1
* ----------------------

* [MAC: THIS CALL ISN'T NEEDED, SINCE THE OS DOES A GOOD JOB OF KEEPING 
* TRACK OF WHEN THE GAME DISK HAS BEEN EJECTED, AND ASKING FOR IT WHEN
* NECESSARY.]

CHKDSK	
CHKDSK1
	RTS

* ----------------------------------------------
* MISC SYSTEM CALLS
* ----------------------------------------------

* ----------------------
* GETM, GETMEM
* ----------------------

* ALLOCATE MEMORY, NUMBER OF BYTES REQUESTED IN D0.L, RETURN POINTER IN A0
*   (GETMEM TRAPS ERRORS, GETM DOESN'T)

GETM	SAVEREGS
	BTST	#0,D0		* ODD REQUEST?
	BEQ.S	GETMX1		* NO
	ADDQ.L	#1,D0		* YES, ROUND UP (FIXES ST GEMDOS-48 BUG)

GETMX1	RESLONG
	MOVE.L	D0,-(SP)	* REQUEST
	JSR	ZAlloc
	POPLONG
	MOVE.L	D0,A0		* RESULT, ZERO IF ERROR
	RESTREGS
	RTS

* ALLOCATE MEMORY AS ABOVE, AND CHECK FOR ERROR

GETMEM	BSR	GETM
	MOVE.L	A0,D0		* GOT IT?
	BEQ.S	MEMERROR	* ZERO MEANS FAILURE
	RTS

MEMERROR
	CLR.W	D0
	LEA	MSGME1,A0
	BRA	FATAL		* 'Not enough memory.'

    DATA
MSGME1	DC.B	'Not enough memory.',0
    CODE

* ----------------------
* GETMEMC
* ----------------------

* ALLOCATE MEMORY AS ABOVE, CHECK FOR ERROR, AND CLEAR
*   (SLOW LOOP; SHOULD USE ONLY FOR SMALL BLOCKS)

GETMEMC	MOVE.L	D0,-(SP)
	BSR	GETMEM
	MOVE.L	(SP)+,D0
	
	MOVE.L	A0,-(SP)
	BRA.S	GTMCX2
GTMCX1	CLR.B	(A0)+
***	CLR.W	(A0)+		* [ASSUME RETURNED PTR IS WORD ALIGNED]
GTMCX2	DBRA	D0,GTMCX1	* [ABSOLUTE MAX LEN = 32K]
	MOVE.L	(SP)+,A0
	RTS

* ----------------------
* MEMAVAIL
* ----------------------

* DETERMINE AVAILABLE MEMORY, RETURN NUMBER OF BYTES AVAILABLE IN D0.L

MEMSYS  EQU	40*1024		* AMOUNT TO LEAVE FOR SYSTEM OVERHEAD
OMEMSYS  EQU	20*1024		* [STILL USE THIS ON 512K MACS]

* THIS NUMBER DETERMINES THE SIZE OF THE (APPL ZONE) FREE-MEMORY POOL
* REMAINING AFTER ZIP INITS ARE FINISHED.  ALLOWS FOR DA'S, PACKAGES, ETC.  
* (NOTE: IT'S ACTUALLY REDUCED ~1.5K BY SOME MISC ZIP ALLOCS.)

* Comments 9/8/88:  20K is too small when displaying color graphics under 
* System 6.0 plus MultiFinder.  Symptoms of the problem are huge areas 
* "stripes" drawn in place of graphics, and little "blocks" in place of text.
* Some ROM routine (might be CopyBits) apparently tries to make large 
* temporary allocs and fails.

* The following MEMSYS behavior was determined empirically:
* 	< 22K		most gfx and text munged
*	22K - 30K	Apple symbol usually/occasionally striped
*	40K		no apparant problems

MEMAVAIL
	SAVEREGS
	RESLONG
	MOVEQ	#-1,D0		* INQUIRE MAXIMUM AVAIL MEMORY
	MOVE.L	D0,-(SP)
	JSR	ZAlloc
	POPLONG

* CHECK A MAGIC BIT TO DETERMINE ROM VERSION.

	MOVE.W	ROM85,D1	* 64K ROM? (ONLY IF HIGH BIT SET)
	BGE.S	MMAVX1		* NO
	MOVE.L	#OMEMSYS,D1	* YES, LESS OVERHEAD NEEDED
	BRA.S	MMAVX2
MMAVX1	MOVE.L	#MEMSYS,D1

MMAVX2	SUB.L	D1,D0		* "FUDGE FACTOR"
	RESTREGS
	RTS

* ----------------------
* GTSEED
* ----------------------

* RETURN A RANDOM NUMBER SEED IN D0, DIFFERENT EACH COLDSTART
* [FOR MAC, RETURN "SECONDS ELAPSED SINCE MIDNIGHT, JAN 1, 1904" -- LOW WORD WILL BE 
* MORE RANDOM THAN HIGH WORD]

GTSEED
	BSR.S	TIME60		* THROW THIS IN FOR GOOD MEASURE
***	MOVE.L	Time,D0
	ADD.L	Time,D0		* [FOR A/UX, /SHOULD/ AVOID LOWMEM GLOBALS!]

***	SUBQ.L	#4,SP		* [CREATE SPACE FOR RESULT, AND PASS PTR TO IT]
***	MOVE.L	SP,-(SP)
***	_GetDateTime		* [CAN'T CALL THIS, NOT IN ROM!]
***	MOVE.L	(SP)+,D0
	RTS

* ----------------------
* TIME60
* ----------------------

* ELAPSED TIME (IN 60THS SECOND) SINCE SYSTEM STARTUP

TIME60	
	SUBQ.L	#4,SP		* [space for return val]
	_TickCount
	MOVE.L	(SP)+,D0
	
***	MOVE.L	Ticks,D0	* [FOR A/UX COMPATIBILITY, ETC, AVOID LOWMEM GLOBALS!]
	RTS

* ----------------------
* SYSIN1
* ----------------------

* MISC SYSTEM INITIALIZATION

SYSIN1	SAVEREGS
	PEA	GAMFIL(A6)	;OPEN GAME FILE, GET REF NUMBER ...
	PEA	APPARM(A6)	;AND FINDER PARAMETERS HANDLE ...
	JSR	MacInit 	;WHILE INITIALIZING MACINTOSH INTERFACE
	RESTREGS
	
	TST.W	GAMFIL(A6)
	BEQ.S	SYSX1		* ERROR


	BSR	PATCH_TRAPS	* PATCH THE MAC TRAP DISPATCH TABLE
	RTS			* OK

SYSX1	LEA	MSGOPN,A0
	BRA	FATAL		* 'Story file open error.'

    DATA
MSGOPN	DC.B	'Story file open error.',0
    CODE

* ----------------------
* MDFINI
* ----------------------

* CLEANUP, EXIT TO OS

MDFINI	MOVE.W	GAMFIL(A6),-(SP)
	JSR	QuitGame	* CLOSE GAME FILE, WINDOWS, ETC.

* THIS LINE FIXES A BUG IN ONE OF THE MPW 1.0 LIBRARIES -- IT CORRECTLY
* RESETS A SYSTEM GLOBAL USED BY THE SOUND DRIVER.  MPW 2.0 IS SAID TO
* FIX THE BUG TOO, SO BEST TO REMOVE THIS LINE AFTER WE UPGRADE.
*
* NOPE, THE ZIP CAN'T DO THIS -- THE DEALLOC HASN'T HAPPENED YET!
****	MOVE.L	#$0A06,#$0AE8	* (RESETS PTR TO $FFFFFFFF AFTER DEALLOC)

	BSR	UNPATCH_TRAPS	* UNDO OUR CHANGES

	UNLK	A6		* FLUSH THE ZIP'S STACK FRAME
	RTS			* RETURN TO ORIGINAL CALLER


	EJECT	; PAGE
* ------------------------------------------------------------------------------
* MACHINE DEPENDENT ROUTINES -- APPLICABLE TO MACINTOSH ONLY
* ------------------------------------------------------------------------------

* ----------------------
* SETMENU
* ----------------------

* INIT A COUPLE OF MENU-RELATED FLAGS FOR PASCAL
* D0.B = "MENU/ITEM IDS UNDERSTOOD" FLAG, D1.B = "UNDO-SUPPORTED" FLAG
* RETURN OLD VALS

SETMENU
	LEA	menuflag,A0
	MOVE.B	(A0),-(SP)
	MOVE.B	D0,(A0)		* [BOOL, ADDRESS AS BYTE FROM 68K]
	MOVE.B	(SP)+,D0
	
	LEA	undoflag,A0
	MOVE.B	(A0),-(SP)
	MOVE.B	D1,(A0)		* [BOOL, ADDRESS AS BYTE FROM 68K]
	MOVE.B	(SP)+,D1
	RTS

* ----------------------
* SYSIN2, FNDRSF
* ----------------------

* THIS ROUTINE EXISTS TO ALLOW MACINTOSH USERS TO LAUNCH DIRECTLY INTO
*   A SAVED GAME  (BY DOUBLE-CLICKING IT),  SKIPPING THE NORMAL GAME 
*   OPENING.  IT CAN FUNCTION AT MOST ONCE.

* WE USED TO FORCE A "VERSION" DISPLAY (BY FAKING INPUT).  THIS PREVENTED 
*   AN OPENING SCREEN THAT (IN SOME ZIP GAMES) SAID NOTHING BUT "OK".  BUT  
*   SOME LATER GAMES PRINT LENGTHY DESCS, AND A "VERSION" LOOKS BAD.

SYSIN2	MOVE.L	APPARM(A6),D0	* GET THE "FINDER PARAMETERS" HANDLE
	BEQ.S	SS2X1		* EXIT IF BEEN HERE ALREADY (HANDLE IS NULL)
	CLR.L	APPARM(A6)	* MARK HANDLE, SO THIS CODE ONLY RUNS ONCE!

	MOVE.L	D0,A0
	MOVE.L	(A0),A0 	* EXTRACT THE POINTER
	TST.W	2(A0)		* WAS ZIP LAUNCHED VIA A 'DOCUMENT'?
	BEQ.S	SS2X1		* NO, NORMAL LAUNCH, JUST MARK THE HANDLE

* WE NOW CHECK THE FILETYPE OF THE DOCUMENT (COULD BE DATA OR DEFS FILE)

	CMPI.L	#'ZSAV',6(A0)	* IS IT REALLY A SAVE FILE?
	BNE.S	SS2X1		* NO, IGNORE
	
	BSR	FNDRSF		* COPY FINDER INFO INTO SF REPLY RECORD

* [THIS IS IMPLICIT TO RESTORE, I THINK]
***	MOVE.L	BUFFER(A6),A0
***	BSET	#FSTAT,PFLAGS+1(A0)	* REQUEST STATUS LINE BE REDRAWN

* WARNING: HACKING (FOR TIMEOUTS) IN RES1 MEANS THAT CONTROL MAY NEVER 
* RETURN HERE (IT JUMPS TO DISPATCH).  DON'T ADD CODE BEYOND THIS POINT!.

	BSR	RES1		* DO A SPECIAL RESTORE, SKIPPING NORMAL DIALOG
SS2X1	RTS

* GIVEN A0 -> "FINDER PARAMETERS BLOCK" (AS FROM GetAppParm),
*   COPY THE SAVED GAME INFO (NAME AND VOL) INTO OUR RESTORE VARS
*   (USE ONLY FIRST GAME, IF MORE THAN ONE IS INDICATED)

FNDRSF	MOVEM.L D1/A1-A2,-(SP)
	MOVE.L	A0,A2		* PARAMS PTR HERE

	LEA	12(A2),A0	* COPY FILE NAME
	LEA	filename,A1
	MOVEQ	#1,D0		* ALLOW FOR LENGTH BYTE
	ADD.B	(A0),D0		* IN FIRST BYTE  [MAC PASCAL]
	MOVEQ	#64,D1		* MAX LEN  (OF filename)
	BSR	COPYS

	MOVE.W	4(A2),filevol	* AND COPY VOLUME REFNUM
	MOVEM.L (SP)+,D1/A1-A2
	RTS

* ----------------------
* HANDLE_TRAPS
* ----------------------

* [CODE MOVED INTO SYSTEM HEAP STARTS HERE]

* GIVEN (TOP WORD ON STACK) = ADDR OF INTERCEPTED TRAP
* DO OUR PREPROCESSING, THEN JUMP TO NORMAL HANDLER

HANDLE_TRAPS
***	SUBQ.L	#4,SP			* RESERVE SPACE FOR JUMP VECTOR
	SUBQ.L	#2,SP			*   (4 BYTES TOTAL)
***	SUBQ.L	#4+4,SP			* AND RETURN VECTOR
	MOVEM.L	D0-D2/A0-A1/A5,-(SP)	* [SAME AS SAVEREGS, PLUS D0/A0, A5]
	
* MAKE SURE A5 IS CORRECT (USED IMPLICITLY IN REFS TO BlitBits, trapAddr, ETC).  
* [MIGHT WE EVER BE CALLED DURING AN INTERRUPT, WITH A DIFFERENT A5?]
* [I DON'T THINK SO - THE /INTERRUPT/ MUST FIX A5 BEFORE CALLING TOOLBOX]

	MOVE.L	CurrentA5,A5	* THIS SHOULD ENSURE CORRECTNESS

* GO SAVE OUR WINDOW BITS, IF NECESSARY

	CLR.W	-(SP)		* "TO BACKUP"
	MOVE.W	#-1,-(SP)	* WHOLE SCREEN
***	JSR	BlitBits	*   [PC RELATIVE, NOT A5 RELATIVE]
	MOVE.L	BlitBitsAddr,A0
	JSR	(A0)
	
	MOVE.B	#1,blittrap	* [BOOLEAN] 

* JUMP TO NORMAL ROUTINE 
* [CLEVER USE OF RTS AVOIDS DISTURBING ANY REGS]
	
***	MOVE.L	trapaddr,24(SP)
	LEA	trapaddr,A0
	ADDA.W	24+2(SP),A0		* OFFSET INTO TABLE
	MOVE.L	(A0),24(SP)		* GET/PUT (NORMAL) TRAP ADDR
	
***	LEA	HANDLE_RET,A0		* GET/PUT OUR POST-PROCESSING ADDR
***	MOVE.L	A0,28(SP)

	MOVEM.L	(SP)+,D0-D2/A0-A1/A5	* RESTORE PARAMS, A5, ETC  (LEN = 24)
	RTS

* NORMAL TRAP RETURNS HERE FOR POST-PROCESSING

HANDLE_RET
* CALL UPDATEMYWINDOW HERE?
* NO -- MUST WAIT UNTIL NEXT GAME OUTPUT (TEXT OR GFX), AND CHECK FLAG.  
* THIS IS NECESSARY, FOR EXAMPLE, IN THE CASE OF "Please insert disk X"
* BECAUSE THE SysError CALL ONLY /DISPLAYS/ THE REQUEST BOX.  SOMEBODY ELSE
* WAITS FOR A DISK EVENT, AND THE SCREEN CAN'T BE UPDATED UNTIL AFTER 
* THE REQUEST IS SATISFIED.

***	NOP
***	RTS

* EACH OF THE FOLLOWING ENTRY POINTS CORRESPONDS TO ONE SLOT IN THE trapAddr ARRAY

HANDLE_T0
	MOVE.W	#4*0,-(SP)	
	BRA	HANDLE_TRAPS
HANDLE_T1
	MOVE.W	#4*1,-(SP)	
	BRA	HANDLE_TRAPS
HANDLE_T2
	MOVE.W	#4*2,-(SP)	
	BRA	HANDLE_TRAPS
HANDLE_T3
	MOVE.W	#4*3,-(SP)	
	BRA	HANDLE_TRAPS
HANDLE_T4
	MOVE.W	#4*4,-(SP)	
	BRA	HANDLE_TRAPS

* [END OF CODE TO MOVE INTO SYSTEM HEAP]
HT_END

* ----------------------
* PATCH_TRAPS
* ----------------------

* THIS ROUTINE MODIFIES THE MAC TRAP DISPATCH TABLE SO THAT CERTAIN TRAPS 
* CAN BE INTERCEPTED AND "PREPROCESSED".  IT INSTALLS (IN THE SYSTEM HEAP!) 
* THE CODE TO HANDLE THE INTERCEPTS.  WHEN AN INTERCEPT OCCURS, THE HANDLER 
* SAVES OUR WINDOW BITS TO AN OFFSCREEN BUFFER, IF NECESSARY.

* THIS KLUDGY EFFORT IS REQUIRED BECAUSE SITUATIONS EXIST WHERE OTHER WINDOWS
* CAN "POP UP" ON TOP OF OURS WITHOUT WARNING.  WITHOUT A CHANCE TO SAVE OUR BITS
* THEY ARE DESTROYED, AND OUR WINDOW CANNOT LATER BE CORRECTLY UPDATED.  

* KNOWN PROBLEM SITUATIONS, IN APPROXIMATE ORDER OF SERIOUSNESS:
*	- THE "Please insert disk X" ALERT
*	- APPLE MENU DROP-DOWN, WHEN FREEMEM IS LOW UNDER MULTIFINDER
*	- MACROMAKER POP-UP WINDOW (INCLUDED WITH SYS 6.0)
*	- MINI-MACSBUG DEBUGGING WINDOW

* IN THE FUTURE WE SHOULD THINK ABOUT WAYS TO MAINTAIN A LOGICAL IMAGE OF
* THE SCREEN.  THINGS THAT WOULD SIMPLIFY THIS ARE SEPARATING TEXT AND GRAPHICS
* AND AVOIDING SCROLLING AND LAYERING OF GRAPHICS.  OR, MAKE GAME RESPONSIBLE 
* FOR GRAPHICS UPDATES AND INTERPRETER FOR TEXT UPDATES.

* TRAPS TO BE PATCHED:
*   (PURE TABLE, DEFINED IN /CODE/ SPACE, SO CAN REF TRAPS SYMBOLICALLY)

PATCHTAB
	_SysError
	DC.W	HANDLE_T0-HANDLE_TRAPS	* THIS CATCHES "Please insert disk X"
	_NewWindow
	DC.W	HANDLE_T1-HANDLE_TRAPS	* THIS CATCHES 'MACROMAKER'
	_GetNewWindow
	DC.W	HANDLE_T2-HANDLE_TRAPS
	_NewDialog
	DC.W	HANDLE_T3-HANDLE_TRAPS
	_GetNewDialog
	DC.W	HANDLE_T4-HANDLE_TRAPS
	DC.W	0			* END OF TABLE

    DATA
SYSBLK	DC.L	0		* ADDR OF OUR BLOCK IN SYSTEM ZONE
    CODE

PATCH_TRAPS
	MOVEM.L	D1-D2/A1-A2,-(SP)

	MOVEQ	#HT_END-HANDLE_TRAPS,D0	* LENGTH OF CODE
	_NewPtr ,SYS			* ALLOC SPACE IN SYSTEM HEAP

	TST.L	D0
	BNE.S	PTTPX6			* ERROR
	MOVE.L	A0,SYSBLK

* MUST BE WITHIN 64K OF SYS HEAP BASE /ONLY/ IF RUNNING UNDER ORIGINAL
* "64K" ROMS (II-384, IV-13).  CHECK A MAGIC BIT TO DETERMINE ROM VERSION.
* SYS HEAP ON 512K MAC IS NORMALLY < 64K, BUT EXCEPTIONS MAY EXIST.

	MOVE.W	ROM85,D0		* 64K ROM? (ONLY IF HIGH BIT SET)
	BGE.S	PTTPX1			* NO

	MOVE.L	A0,D0			* YES, CHECK OFFSET
	SUB.L	SysZone,D0		* BASE
	CMPI.L	#64*1024,D0
	BCC.S	PTTPX7		* BHS	* ERROR

* COPY CODE INTO SYSTEM HEAP  [COULD THE LOADER DO THIS?]
* [HANDLE_TRAPS MUST BE RELOCATABLE!]

PTTPX1	MOVE.L	A0,A1
	LEA	HANDLE_TRAPS,A0
	MOVEQ	#HT_END-HANDLE_TRAPS,D0
	_BlockMove

* FIX UP A COUPLE GLOBALS

	LEA	BlitBits,A0		* GET THIS ADDR  [PC RELATIVE; NOT RELOCATABLE!]
	MOVE.L	A0,BlitBitsAddr		* AND SAVE, ABSOLUTE
	CLR.B	blittrap	* [BOOLEAN] INIT THIS ONE TOO

* LOOP TO PATCH THE TRAP DISPATCH TABLE

	LEA	trapAddr,A1
	LEA	PATCHTAB,A2
	
PTTPX2	MOVE.W	(A2)+,D0		* NEXT TRAP ID
	BEQ.S	PTTPX9			* ALL DONE
	MOVE.L	SYSBLK,A0
	ADDA.W	(A2)+,A0		* ADDR (IN SYS HEAP) OF OUR HANDLER
	BSR	PATCH_ONE
	
	MOVE.L	A0,(A1)+		* STORE ORIGINAL HANDLER
	BRA.S	PTTPX2

* HANDLE ERRORS

PTTPX6	CLR.L	SYSBLK
PTTPX7	LEA	trapAddr,A1
	CLR.L	(A1)

PTTPX9	MOVEM.L	(SP)+,D1-D2/A1-A2
	RTS
	
* ----------------------
* PATCH_ONE
* ----------------------

* PATCH ONE ENTRY IN THE TRAP DISPATCH TABLE
* GIVEN D0.W = TRAP NUMBER, A0 -> NEW HANDLER, RETURN A0 -> OLD HANDLER

PATCH_ONE
	MOVEM.L	D1-D4/A1-A4,-(SP)	* SAVE REGS THAT TOOLBOX DOESN'T, PLUS EXTRA
	MOVE.W	D0,D4
	MOVE.L	A0,A4
	_GetTrapAddress
	
	EXG	A0,A4		* SAVE THE REAL TRAP ADDR, AND INSTALL OURS
	MOVE.W	D4,D0
	_SetTrapAddress
	
	MOVE.L	A4,A0
	MOVEM.L	(SP)+,D1-D4/A1-A4
	RTS

* ----------------------
* UNPATCH_TRAPS
* ----------------------

* RESTORE ORIGINAL VECTOR(S)

UNPATCH_TRAPS
	MOVEM.L	D1-D2/A1-A2,-(SP)
	LEA	trapAddr,A1
	TST.L	(A1)			* DID ORIGINAL PATCHING ACTUALLY HAPPEN?
	BEQ.S	UPTPX8			* NO

* LOOP TO UNPATCH THE TRAPS WE CHANGED

	LEA	PATCHTAB,A2
UPTPX2	MOVE.W	(A2)+,D0		* NEXT TRAP ID
	BEQ.S	UPTPX8			* NO MORE
	MOVE.L	(A1)+,A0		* ORIGINAL HANDLER		
	BSR	PATCH_ONE
	TST.W	(A2)+			* [SKIP THIS SLOT]
	BRA.S	UPTPX2

* RELEASE SPACE (IN SYSTEM HEAP)

UPTPX8	MOVE.L	SYSBLK,D0
	BEQ.S	UPTPX9

	MOVE.L	D0,A0
	_DisposPtr
	CLR.L	SYSBLK

UPTPX9	MOVEM.L	(SP)+,D1-D2/A1-A2
	RTS


	EJECT	; PAGE
* ------------------------------------------------------------------------------
* 68000 CALLS FROM PASCAL/C 	(XDEFS REQUIRED)
* ------------------------------------------------------------------------------

    DATA
ZVARS	DC.L	0	* CORRECT A6 STORED HERE, MUST RESTORE IF NEEDED
    CODE

* PROCEDURE OutBufLen (charCount: INTEGER) -- ADJUST MAC FOLDING
* RESET ENDBUF (WHEN NEXT EMPTIED, TO PREVENT BUGS)

* OUTBUFLEN
*	MOVE.L  ZVARS,A0	   * GET ZIP'S VALUE OF A6
*	MOVE.W	4(SP),CURSIZ
*	MOVE.L  D0,MACBUF(A0)
*	RTS

* ----------------------------------------------
* FAST MEMORY ROUTINES
* ----------------------------------------------

* THESE ARE USED FOR ISAVE/IRESTORE, ALSO FOR SCROLLING ON THE ST

* ----------------------
* _mov_mem, MOVMEM
* ----------------------

* THIS ROUTINE PERFORMS A FAST BLOCKMOVE.  ASSUMPTIONS ARE:
*    () COPY MUST BE FROM HIGH TO LOW MEMORY IF IT OVERLAPS ("SCROLL UP")
*    () MAX LENGTH IS 1024K (32K x 32), DUE TO USE OF "DBxx"

MMSRC	EQU	8+0		* 8 = 4 (REG) + 4 (RTS)
MMDEST	EQU	8+4
MMLEN	EQU	8+8

_mov_mem
	MOVE.L	A1,-(SP)
	MOVE.L	MMSRC(SP),A0
	MOVE.L	MMDEST(SP),A1
	MOVE.L	MMLEN(SP),D0
	BEQ.S	MMX0		* ZERO LENGTH, EXIT
	BSR	MOVMEM
MMX0	MOVE.L	(SP)+,A1
	RTS

* ALTERNATE ENTRY POINT (FOR 68K CALLERS), JUST TAKES ARGS IN REGS
* A0 -> SOURCE, A1 -> DEST, D0.L = LENGTH

MOVMEM	MOVE.L	D1,-(SP)
	MOVE.W	A0,D1		* CHECK FOR ODD-ALIGNED SRC ADDRESS
	ANDI.W	#1,D1
	BNE.S	MMX3		* IF SO, MUST USE SLOWER CODE
	MOVE.W	A1,D1		* CHECK DEST ADDRESS, TOO
	ANDI.W	#1,D1
	BNE.S	MMX3

	MOVE.L	D0,D1
	ASR.L	#5,D1		* DIVIDE BY 32: QUOTIENT HERE
	BRA.S	MMX2		* ENTER LOOP AT DBRA

* PHASE 1 COPY -- MAXIMIZE SPEED

MMX1	MOVE.L	(A0)+,(A1)+	* COPY 32 BYTES (UNROLL EIGHT ITERATIONS)
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
	MOVE.L	(A0)+,(A1)+
MMX2	DBRA	D1,MMX1		* LOOP (MAX COUNT = 32K)

	ANDI.L	#$1F,D0		* DIVIDE BY 32: REMAINDER
	BEQ.S	MMX5		* FALL THROUGH IF ANYTHING LEFT

* PHASE 2 COPY -- HANDLE EXTRA BYTES OR ODD CASES

MMX3	MOVE.B	(A0)+,(A1)+	* COPY ONE BYTE
	SUBQ.L	#1,D0
	BGT.S	MMX3		* LOOP (NO MAX COUNT)

MMX5	MOVE.L	(SP)+,D1	* DONE
	RTS

* ----------------------
* _clr_mem
* ----------------------

CMSRC	EQU	12+0		* 12 = 8 (REGS) + 4 (RTS)
CMLEN	EQU	12+4

_clr_mem
	MOVEM.L	D1/A1,-(SP)
	MOVE.L	CMLEN(SP),D0
	BEQ.S	CMX5		* ZERO, EXIT
	MOVE.L	CMSRC(SP),A0

	MOVE.W	A0,D1		* CHECK FOR ODD SRC ADDRESS
	ANDI.W	#1,D1
	BNE.S	CMX3

	MOVE.L	D0,D1
	ASR.L	#4,D1		* DIVIDE BY 16: QUOTIENT
	BRA.S	CMX2		* ENTER LOOP AT DBRA

* PHASE 1 "CLEAR" -- MAXIMIZE SPEED

CMX1	CLR.L	(A0)+		* CLEAR 16 BYTES ("UNROLL" FOUR ITERATIONS)
	CLR.L	(A0)+
	CLR.L	(A0)+
	CLR.L	(A0)+
CMX2	DBRA	D1,CMX1		* LOOP (32K IS MAXIMUM COUNT)

	ANDI.L	#$0F,D0		* DIVIDE BY 16: REMAINDER
	BEQ.S	CMX5		* FALL THROUGH IF ANYTHING LEFT

* PHASE 2 "CLEAR" -- HANDLE EXTRA BYTES OR ODD CASES

CMX3	CLR.B	(A0)+		* CLEAR ONE BYTE
	SUBQ.L	#1,D0
	BNE.S	CMX3		* LOOP (NO MAXIMUM COUNT)
	
CMX5	MOVEM.L	(SP)+,D1/A1
	RTS

* ----------------------------------------------
* GRAPHICS ROUTINES (IN 68K FOR SPEED)
* ----------------------------------------------

* ----------------------
* SqzRow
* ----------------------

* PROCEDURE SqzRow (src, dst: Ptr; len: INTEGER);

SqzRow
	MOVE.W	4(SP),D0	* LEN
	MOVE.L  6(SP),A1	* DST
	MOVE.L	10(SP),A0	* SRC

* SQZROW: SQUEEZE BYTES INTO NIBBLES, THROWING AWAY THE HIGH NIBBLES
* GIVEN A0 -> SRC, A1 -> DST, D0.W = COUNT

SQRWX1	MOVE.B	(A0)+,D1	* GET FIRST LOW-NIBBLE
	LSL.W	#4,D1		* POSITION IT
	ANDI.B	#$0F,(A0)	* [MAKE SURE HIGH NIBBLE = 0]
	OR.B	(A0)+,D1	* GET SECOND LOW-NIBBLE
	MOVE.B	D1,(A1)+

	SUBQ.W	#2,D0		* 2 BYTES INTO 1
	BGT.S	SQRWX1

	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#10,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

* ----------------------
* FillCSpec
* ----------------------

* PROCEDURE FillCSpec (CSpec: Ptr; ix: INTEGER; bytePal: Ptr);

FillCSpec
	MOVE.L	4(SP),A0	* bytePal = SRC
	MOVE.W	8(SP),D0	* ix
	MOVE.L  10(SP),A1	* CSpec = DST

* FillCSpec: COPY INDEX/PALETTE INTO DEST, SCALING THE RGB (BYTE-TO-WORD)
* GIVEN A0 -> SRC, A1 -> DST, D0.W = INDEX

	MOVE.W	D0,(A1)+	* COPY IX
	MOVEQ	#3,D0
	
FLCSX1	MOVE.B	(A0),D1		* GET AN RGB BYTE
	LSL.W	#8,D1		* SCALE UP TO A WORD
	OR.B	(A0)+,D1	* DUP VAL IN LOW BYTE
	MOVE.W	D1,(A1)+

	SUBQ.W	#1,D0
	BGT.S	FLCSX1

	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#10,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

* ----------------------
* BuildStips
* ----------------------

* OFFSETS IN EXPANDED STIPPLE TABLE

SH0	EQU	0		* 16 WORDS OF "SHIFT-0", ------xx ------xx
SH2	EQU	16*2		* 16 WORDS OF "SHIFT-2", ----xx-- ----xx--
SH4	EQU	32*2		* ETC
SH6	EQU	48*2

* MAP STIPPLE IDS TO VALUES

    DATA
STPTAB	DC.B	$0		* NO BITS ON
	DC.B	$1,$2,$4,$8	* 1 BIT ON
	DC.B	$3,$5,$6,$9	* 2 BITS ON  00/11, 01/01, 01/10, 10/01
	DC.B	$A,$C		*   [NORMALLY UNUSED] 10/10, 11/00
	DC.B	$7,$B,$D,$E	* 3 BITS ON
	DC.B	$F		* 4 BITS ON
    CODE

* PROCEDURE BuildStips (table1, table2: Ptr);

* BUILD AN "EXPANDED" TABLE OF STIPPLE VALS (16 WORDS x4), FOR USE BY StipRow,
*   GIVEN A TABLE OF STIPPLE IDS (16 BYTES, EACH 0..15)

BuildStips
	MOVE.L	04(SP),A1	* EXPANDED TABLE (RESERVED SPACE, ACTUALLY)
	MOVE.L	08(SP),A0	* ID TABLE
	
	MOVEM.L	D2-D3/A2,-(SP)
	LEA	STPTAB,A2
	MOVEQ	#0,D3		* INITIAL COLOR INDEX

BLDSX1	MOVE.W	D3,D2		* NEXT COLOR INDEX
	MOVEQ	#0,D0
	MOVE.B	(A0)+,D0	* GET CORRESPONDING STIPPLE ID
	MOVE.B	0(A2,D0.W),D0	* MAP TO "DARKNESS" VALUE
	BSR	BuildOne
	
	ADDQ.W	#1,D3
	CMPI.W	#15,D3		* MAX COLOR INDEX
	BLE.S	BLDSX1

	MOVEM.L	(SP)+,D2-D3/A2
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#8,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

* STORE THE STIPPLE FOR ONE PARTICULAR COLOR INDEX
* GIVEN D0.W = STIPPLE VALUE (0..15), D2.W = COLOR INDEX (0..15), 
*   A1 -> EXPANDED TABLE

BuildOne
	NOT.W	D0		* >> MAC: REVERSE WHITE & BLACK! <<
	MOVE.W	D0,D1
	ANDI.W	#$000C,D1	* EXTRACT 1ST HALF-NIBBLE
	LSL.W	#6,D1		* POSITION IT		   ------xx --------
	ANDI.W	#$0003,D0	* EXTRACT 2ND HALF-NIBBLE  -------- ------xx
	OR.W	D1,D0		* RECOMBINE
	
	ADD.W	D2,D2		* 2x INDEX
	MOVE.W	D0,SH0(A1,D2.W)	* STORE "SHIFT-0" POSITION
	LSL.W	#2,D0
	MOVE.W	D0,SH2(A1,D2.W)	* STORE "SHIFT-2" POSITION
	LSL.W	#2,D0
	MOVE.W	D0,SH4(A1,D2.W)	* STORE "SHIFT-4" POSITION
	LSL.W	#2,D0
	MOVE.W	D0,SH6(A1,D2.W)	* STORE "SHIFT-6" POSITION
	RTS

* ----------------------
* Shrink75
* ----------------------

* PROCEDURE Shrink75 (base: Ptr; cols100, cols75, rows75: INTEGER);

* SCALE A GIVEN (COLOR) PICTURE BY 0.75 - DISCARD EVERY 4TH BYTE & EVERY 4TH ROW
* FORMAT: 1 PIXEL/BYTE, NO PADDING

Shrink75
	MOVEM.L	D2-D7/A2-A3,-(SP)	* 8x4 BYTES
	MOVE.W	32+04(SP),D4	* rows75
	BEQ.S	SK75X9
	MOVE.W	32+06(SP),D3	* cols75
	BEQ.S	SK75X9
	MOVE.W	32+08(SP),D2	* cols100
	MOVE.L	32+10(SP),A2	* SRC AND (INITIAL) DST PTRS (IN-PLACE COPY)
	MOVE.L	A2,A3

SK75X1	BSR	ShrinkOne	* COPY 1ST ROW
	ADDA.W	D2,A2		* NEXT SRC
	ADDA.W	D3,A3		* NEXT DST
	SUBQ.W	#1,D4		* DONE?
	BLE.S	SK75X9		* YES

	BSR	ShrinkOne	* COPY 2ND ROW
	ADDA.W	D2,A2
	ADDA.W	D3,A3
	SUBQ.W	#1,D4		* DONE?
	BLE.S	SK75X9		* YES

	BSR	ShrinkOne	* COPY 3RD ROW
	ADDA.W	D2,A2
	ADDA.W	D3,A3
	
	ADDA.W	D2,A2		* AND SKIP 4TH ROW
	SUBQ.W	#1,D4		* DONE?
	BGT.S	SK75X1		* NO

SK75X9	MOVEM.L	(SP)+,D2-D7/A2-A3
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#10,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

* COPY ROW, DISCARDING EVERY 4TH BYTE  [ROUNDING /UP/]
* A2 -> SRC, A3 -> DST, D2.W = BYTES/PIXELS PER FULL ROW  [DON'T CHANGE THESE REGS]

ShrinkOne
	MOVE.L	A2,A0		* MAKE A0 -> SRC, A1 -> DST
	MOVE.L	A3,A1
	
	MOVE.W	D2,D0
	LSR.W	#4,D0		* DIVIDE BY 16: QUOTIENT
	BRA.S	SKONX2		* ENTER LOOP AT DBRA

* PHASE 1 -- COPY 12 BYTES, SKIP 4  (UNROLL LOOP TO MAXIMIZE SPEED)
* NOTE: PTRS MIGHT NOT BE EVEN-ALIGNED ...

SKONX1	
**	MOVE.L	(A0)+,(A1)+	* COPY 3 BYTES, SKIP 4TH (ASSUMES EVEN ALIGNED)
**	SUBQ.L	#1,A1
	MOVE.B	(A0)+,(A1)+	* COPY 3 BYTES, SKIP 4TH
	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	ADDQ.L	#1,A0
	MOVE.B	(A0)+,(A1)+	* COPY 3 BYTES (OUT OF PHASE), SKIP 4TH
	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	ADDQ.L	#1,A0
**	MOVE.L	(A0)+,(A1)+	* COPY 3 BYTES, SKIP 4TH
**	SUBQ.L	#1,A1
	MOVE.B	(A0)+,(A1)+	* COPY 3 BYTES, SKIP 4TH
	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	ADDQ.L	#1,A0
	MOVE.B	(A0)+,(A1)+	* COPY 3 BYTES (OUT OF PHASE), SKIP 4TH
	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	ADDQ.L	#1,A0
SKONX2	DBRA	D0,SKONX1	* LOOP

* PHASE 2 -- HANDLE FINAL BYTES

	MOVE.W	D2,D1
	ANDI.W	#$000F,D1	* REMAINDER AFTER ABOVE, 0-15
	LSR.W	#2,D1		* DIVIDE AGAIN BY 4
	ADDQ.W	#1,D1		* AND ROUND /UP/ (MAX 3-BYTE OVERRUN, SAFE HERE)
	BRA.S	SKONX4		* ENTER LOOP AT DBRA

SKONX3	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	MOVE.B	(A0)+,(A1)+
	ADDQ.L	#1,A0		* SKIP 4TH BYTE
SKONX4	DBRA	D1,SKONX3	* LOOP
	RTS


* ----------------------
* StipPic
* ----------------------

* PROCEDURE StipPic (
* 	srcX, srcY, 			{ color, 1 byte/pixel, [clipped if necessary] }
* 	dstRB: INTEGER;			{ mono rowBytes -- SRCX/4, ROUNDED UP & EVEN }
* 	src, dst, maps: Ptr;
* 	trans: BOOLEAN);

* >>> PROBLEM: destRect in video RAM is generally NOT byte-aligned ... <<<
* >>> For now, we DO stipple to 2nd offscreen bitmap <<<

* This routine produces stipples, reading from a 16-color offscreen bitmap (unpadded,
* 1 byte/pixel), and writing directly to video RAM.  The latter allows it to 
* implement transparency /without/ a second offscreen bitmap & two extra blits.
  
* Note that we work /only/ with monochrome-format bitmaps/pixmaps in video RAM.  
* We must clip carefully, to avoid 
* 	- writing off the end of the screen
* 	- wrapping across scanlines
*   	- drawing outside our window
	
* Actually, we can take advantage of a constraint related to BlitBits: our window 
* is operational only when its content is fully visible within the screen. 

StipPic
	MOVEM.L	D2-D5/A2-A4,-(SP)	* [28 BYTES]

	MOVEQ	#0,D0		* CLEAR HIGH >> BIT << (#31)
	TST.B	28+04(SP)
	BEQ.S	STPPX0
	MOVEQ	#-1,D0		* TRANSPARENCY ENABLED, SET HIGH >> BIT <<
	
STPPX0	MOVE.L	28+06(SP),A3	* MAPS (16 WORDS X4)
	MOVE.L  28+10(SP),A4	* DST(1)
	MOVE.L	28+14(SP),A0	* SRC

	MOVE.W	28+18(SP),D4	* DST ROWBYTES [MONO] -- MULTIPLE OF 2 
	MOVE.W	28+20(SP),D5	* SRC ROWS [COLOR]
	MOVE.W	28+22(SP),D3	* SRC COLUMNS

STPPX1	MOVE.L	A4,A1		* CURRENT DST1
	ADDA.W	D4,A4
	MOVE.L	A4,A2		* CURRENT DST2 (2ND ROW OF STIPPLES)
	ADDA.W	D4,A4		* NEXT DST1

	MOVE.W	D3,D0
	BSR	StipRow
	SUBQ.W	#1,D5
	BGT.S	STPPX1
	
	MOVEM.L	(SP)+,D2-D5/A2-A4
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#20,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)


* StipRow: CONVERT EACH COLOR PIXEL INTO A 2x2 MONO STIPPLE
* OPTIONALLY, A COLOR-0 PIXEL IS INTERPRETED AS TRANSPARENT 
* FOR SPEED, EACH LOOP CONVERTS /4/ COLOR PIXELS INTO AN 8x2 MONO STIPPLE

* GIVEN A0 -> SRC, D0.W = SRCLEN (PIXELS = BYTES)
*       A1 -> DST1, A2 -> DST2,  A3 -> MAPS
*	D0.L (HIGH BIT) = TRANSPARENCY ENABLE FLAG
* USES	D1.W = COLOR PIXEL / OLD STIPPLE,  D2.W = NEW STIPPLE
* RETURNS UPDATED A0

StipRow
STPRX1	MOVEQ	#0,D2		* ZERO RESULT

	SUBQ.W	#1,D0		* END OF ROW?
	BLT	STPRX11		* YES, EXIT (NO PARTIAL TO WRITE)
	
	MOVEQ	#0,D1
	MOVE.B	(A0)+,D1	* GET 1ST PIXEL (4 BITS, ACTUALLY) -- TRANSPARENT?
	BNE.S	STPRX2		* NO, IT'S A REGULAR COLOR
	TST.L	D0		* MAYBE, IS TRANSPARENCY ENABLED?
	BPL.S	STPRX2		* NO

* 1ST PIXEL IS TRANSPARENT; CHECK IF OTHERS IN THIS GROUP ARE TOO (LIKELY, THEY OCCUR IN RUNS).
* IF SO WE CAN SKIP AHEAD, AVOIDING ALL BIT EXTRACTING AND WRITING!
* NOTE: COULD GET RID OF ALL THE END-OF-ROW TESTING BY CORRECTING A0 AT THE START OF EACH ROW,
* BUT THIS WOULD RISK MINOR OVERRUNS.

	SUBQ.W	#1,D0		* BUT AT END OF ROW?
	BLT	STPRX11		* YES, EXIT (NO PARTIAL TO WRITE)
	TST.B	(A0)+		* 2ND TRANSPARENT TOO?
	BNE.S	STPRX1C		* NO

	SUBQ.W	#1,D0		* AT END OF ROW?
	BLT	STPRX11		* YES, EXIT 
	TST.B	(A0)+		* 3RD TRANSPARENT TOO?
	BNE.S	STPRX1B		* NO

	SUBQ.W	#1,D0		* AT END OF ROW?
	BLT	STPRX11		* YES, EXIT 
	TST.B	(A0)+		* 4TH TRANSPARENT TOO?
	BNE.S	STPRX1A		* NO

	ADDQ.L	#1,A1		* YES, ADVANCE BOTH DST PTRS, WITHOUT TOUCHING DATA
	ADDQ.L	#1,A2
***	SUBQ.W	#3,D0		* AND SKIP AHEAD TO NEXT GROUP
	BRA.S	STPRX1

STPRX1A	SUBQ.L	#1,A0		* UN-ADVANCE THE POINTER (BACK TO 2ND)
	ADDQ.W	#1,D0		* AND RE-BUMP THE COUNT
STPRX1B	SUBQ.L	#1,A0
	ADDQ.W	#1,D0
STPRX1C	SUBQ.L	#1,A0
	ADDQ.W	#1,D0

* [POTENTIAL IMPROVEMENT: FETCH THE OLD STIPS ONLY ONCE, INSTEAD OF FOUR MAX]

	MOVE.B	(A1),D1		* FETCH 2x4 MSBITS OF OLD STIPPLES FROM PRIMARY ROW
	LSL.W	#8,D1
	MOVE.B	(A2),D1		* FETCH 2x4 LSBITS OF OLD STIPPLES FROM 2ND ROW
	ANDI.W	#$C0C0,D1	* EXTRACT THE 1ST STIPPLE
	OR.W	D1,D2		* AND RE-USE IT
	BRA.S	STPRX3
STPRX2	ADD.W	D1,D1		* DOUBLE
	OR.W	SH6(A3,D1.W),D2	* xx------ xx------

* HANDLE 2ND PIXEL

STPRX3	SUBQ.W	#1,D0		* END OF ROW?
	BLT.S	STPRX10		* YES, WRITE PARTIAL AND EXIT
	
	MOVEQ	#0,D1
	MOVE.B	(A0)+,D1	* GET 2ND PIXEL (4 BITS, ACTUALLY) -- TRANSPARENT?
	BNE.S	STPRX4		* NO, IT'S A REGULAR COLOR
	TST.L	D0		* MAYBE, IS TRANSPARENCY ENABLED?
	BPL.S	STPRX4		* NO

	MOVE.B	(A1),D1		* FETCH 2x4 MSBITS OF OLD STIPPLES FROM PRIMARY ROW
	LSL.W	#8,D1
	MOVE.B	(A2),D1		* FETCH 2x4 LSBITS OF OLD STIPPLES FROM 2ND ROW
	ANDI.W	#$3030,D1	* EXTRACT THE 2ND STIPPLE
	OR.W	D1,D2		* AND RE-USE IT
	BRA.S	STPRX5
STPRX4	ADD.W	D1,D1
	OR.W	SH4(A3,D1.W),D2	* --xx---- --xx----

* HANDLE 3RD PIXEL

STPRX5	SUBQ.W	#1,D0		* END OF ROW?
	BLT.S	STPRX10		* YES, WRITE PARTIAL AND EXIT
	
	MOVEQ	#0,D1
	MOVE.B	(A0)+,D1	* GET 3RD PIXEL (4 BITS, ACTUALLY) -- TRANSPARENT?
	BNE.S	STPRX6		* NO, IT'S A REGULAR COLOR
	TST.L	D0		* MAYBE, IS TRANSPARENCY ENABLED?
	BPL.S	STPRX6		* NO

	MOVE.B	(A1),D1		* FETCH 2x4 MSBITS OF OLD STIPPLES FROM PRIMARY ROW
	LSL.W	#8,D1
	MOVE.B	(A2),D1		* FETCH 2x4 LSBITS OF OLD STIPPLES FROM 2ND ROW
	ANDI.W	#$0C0C,D1	* EXTRACT THE 3RD STIPPLE
	OR.W	D1,D2		* AND RE-USE IT
	BRA.S	STPRX7
STPRX6	ADD.W	D1,D1
	OR.W	SH2(A3,D1.W),D2	* ----xx-- ----xx--

* HANDLE 4TH PIXEL

STPRX7	SUBQ.W	#1,D0		* END OF ROW?
	BLT.S	STPRX10		* YES, WRITE PARTIAL AND EXIT
	
	MOVEQ	#0,D1
	MOVE.B	(A0)+,D1	* GET 4TH PIXEL (4 BITS, ACTUALLY) -- TRANSPARENT?
	BNE.S	STPRX8		* NO, IT'S A REGULAR COLOR
	TST.L	D0		* MAYBE, IS TRANSPARENCY ENABLED?
	BPL.S	STPRX8		* NO

	MOVE.B	(A1),D1		* FETCH 2x4 MSBITS OF OLD STIPPLES FROM PRIMARY ROW
	LSL.W	#8,D1
	MOVE.B	(A2),D1		* FETCH 2x4 LSBITS OF OLD STIPPLES FROM 2ND ROW
	ANDI.W	#$0303,D1	* EXTRACT THE 4TH STIPPLE
	OR.W	D1,D2		* AND RE-USE IT
	BRA.S	STPRX9
STPRX8	ADD.W	D1,D1
	OR.W	SH0(A3,D1.W),D2	* ------xx ------xx

* AT THIS POINT, WE HAVE 4 FOUR-BIT STIPPLES
* WRITE WORD AND LOOP

STPRX9	MOVE.B	D2,(A2)+	* STORE 2x4 LSBITS OF STIPPLES IN 2ND ROW
	LSR.W	#8,D2
	MOVE.B	D2,(A1)+	* STORE 2x4 MSBITS OF STIPPLES IN PRIMARY ROW
	BRA	STPRX1
	
* WRITE PARTIAL WORD AND EXIT

STPRX10	MOVE.B	D2,(A2)+	* STORE 2x4 LSBITS OF STIPPLES IN 2ND ROW
	LSR.W	#8,D2
	MOVE.B	D2,(A1)+	* STORE 2x4 MSBITS OF STIPPLES IN PRIMARY ROW
STPRX11	RTS

* ----------------------
* MonoPic
* ----------------------

* ALL PARAMS ARE NOW PASSED IN A RECORD, SO THEY WILL REMAIN VALID ACROSS MULTIPLE 
* CALLS TO MonoPic.

M_SRCX	EQU	0	* color, 1 byte/pixel, [clipped if necessary]
M_SRCY	EQU	2
M_DSTRB	EQU	4	* mono rowBytes -- SRCX/4, ROUNDED UP & EVEN
M_TRANS	EQU	6
M_PSRC	EQU	8
M_PDST	EQU	12	* [return updated ptr here]

* PROCEDURE MonoPic (p: MonoPicRecPtr);
* This routine maps bytes to bits, reading from a "3-color" src buffer 
* (0=transparent, 2=white, 3=black).  Src format is unpadded, 1 byte/pixel.
* We currently expect to work always with an integral number of rows, although
* not necessarily the entire screen.  Return updated ptr in pDst.

* Note: writing directly to screen memory would avoid the need for a 2nd offscreen 
* buffer and two extra Copybits calls, BUT we don't, for several reasons:
*   - Copybits handles non-byte-aligned destRects
*   - Copybits handles clipping.  We don't need this currently, because of our tight 
* restrictions on when we draw into our window, but we will need it to overhaul
* our refresh strategy.
*   - Copybits (b/w) is fast; even two extra calls don't really hurt us.

MonoPic
	MOVEM.L	D2-D7/A2-A4/A6,-(SP)	* [40 BYTES]
	MOVE.L	40+4(SP),A6		* PARAMBLOCK PTR

	MOVE.L	M_PDST(A6),A3
	MOVE.L	M_PSRC(A6),A2
	MOVE.W	M_DSTRB(A6),D3	* DST ROWBYTES [MONO] -- MULTIPLE OF 2 
	MOVE.W	M_SRCY(A6),D4	* SRC ROWS
	MOVE.W	M_SRCX(A6),D2	* SRC COLUMNS

MNOPX1	MOVE.L	A2,A0		* CURRENT SRC
	MOVE.L	A3,A1		* CURRENT DST
	MOVE.W	D2,D0
	BSR	MonoRow

	ADDA.W	D2,A2		* NEXT SRC (CALC START OF ROW)
	ADDA.W	D3,A3		* NEXT DST (CALC START OF ROW)
	SUBQ.W	#1,D4
	BGT.S	MNOPX1

MNOPX9	MOVE.L	A3,M_PDST(A6)	* RETURN THIS UPDATED PTR
	MOVEM.L	(SP)+,D2-D7/A2-A4/A6
	MOVE.L	(SP)+,A0	* GET RETURN ADDR
	ADDQ.W	#4,SP		* FLUSH ARG, PASCAL STYLE
	JMP	(A0)

* MonoRow: PACK B/W PIXELS INTO B/W BYTES, (2="OFF"=WHITE, 3="ON"=BLACK)
* ALSO HANDLE 0=TRANSPARENT, IF ENCOUNTERED

* GIVEN A0 -> SRC, A1 -> DST, D0.W = SRC ROWLEN (PIXELS = BYTES)
* USES D5.B = SRCPIX, D6.B = DSTPIX

MonoRow	
	TST.B	M_TRANS(A6)	* SPECIAL CASE IF NON-TRANSPARENT
	BEQ	MonoRow2

MNRWX1	MOVE.B	(A1),D6		* COPY OF NEXT DST BYTE (TRANSPARENT DEFAULTS)

* FOR MAXIMUM SPEED, UNROLL EIGHT ITERATIONS
* CYCLES PER PIXEL: TRANS=18, WHITE=38, BLACK=44
* SHOULD SAVE ~12 CYCLES x 144000 PIXELS / ~5.12 MHZ = 0.34 SEC (~12 PERCENT)

	MOVE.B	(A0)+,D5	* GET NEXT SRC PIXEL			[8]
	BEQ.S	MNRWX2		* TRANSPARENT, SKIP			[10/8]
	ANDI.B	#%01111111,D6	* CLEAR BIT -- ASSUME WHITE		[8]
	SUBQ.B	#2,D5		* WAS IT?				[4]
	BEQ.S	MNRWX2		* YES					[10/8]
	ORI.B	#%10000000,D6	* NO, BLACK				[8]
MNRWX2	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX3
	ANDI.B	#%10111111,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX3
	ORI.B	#%01000000,D6
MNRWX3	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX4
	ANDI.B	#%11011111,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX4
	ORI.B	#%00100000,D6
MNRWX4	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX5
	ANDI.B	#%11101111,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX5
	ORI.B	#%00010000,D6
MNRWX5	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX6
	ANDI.B	#%11110111,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX6
	ORI.B	#%00001000,D6
MNRWX6	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX7
	ANDI.B	#%11111011,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX7
	ORI.B	#%00000100,D6
MNRWX7	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX8
	ANDI.B	#%11111101,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX8
	ORI.B	#%00000010,D6
MNRWX8	MOVE.B	(A0)+,D5
	BEQ.S	MNRWX9
	ANDI.B	#%11111110,D6
	SUBQ.B	#2,D5
	BEQ.S	MNRWX9
	ORI.B	#%00000001,D6

MNRWX9	MOVE.B	D6,(A1)+	* WRITE OUT UPDATED BYTE
	SUBQ.W	#8,D0
	BGT.S	MNRWX1
	RTS

* (DEAD) 
* CYCLES PER PIXEL: TRANS=30, WHITE=52, BLACK=58
* [TESTING FOR ANY-MORE-BITS /FIRST/ LETS THE TRANSPARENCY LOOP BE TIGHTER]

*MNORX1	MOVEQ	#8,D7
*	MOVE.B	(A1),D6		* COPY OF NEXT DST BYTE (TRANSPARENT DEFAULTS)
*	BRA.S	MNORX3

*MNORX2	BCLR	D7,D6		*					["10"]
*MNORX3	SUBQ.B	#1,D7		* ANY MORE BITS IN CURRENT BYTE?	[4]
*	BMI.S	MNORX4		* NO					[8/]
*	MOVE.B	(A0)+,D5	* GET NEXT SRC PIXEL			[8]
*	BEQ.S	MNORX3		* TRANSPARENT, SKIP			[8/10]
*	SUBQ.B	#2,D5		* WHITE?				[4]
*	BEQ.S	MNORX2		* YES					[8/10]
*	BSET	D7,D6		* NO, BLACK				["8"]
*	BRA.S	MNORX3		*					[10]

*MNORX4	MOVE.B	D6,(A1)+	* WRITE OUT UPDATED BYTE
*	SUBQ.W	#8,D0
*	BGT.S	MNORX1
*	RTS

* MonoRow2: same as above, but skip transparency check
* GIVEN A0 -> SRC, A1 -> DST, D0.W = SRC ROWLEN (PIXELS = BYTES)
* USES D5.B = 0, D6.B = DSTPIX

* FOR MAXIMUM SPEED, UNROLL EIGHT ITERATIONS - SAVES 8x COUNTER AND EXTRA BRANCH
* CYCLES PER PIXEL: WHITE=18, BLACK=24

MonoRow2
	MOVEQ	#0,D5
MNR2X1	MOVEQ	#0,D6		* DEFAULT TO ALL WHITE (MORE FREQ THAN BLACK?)

* IF THE DECOMPRESSED BUFFER HELD ONLY 0'S AND 1'S, WE COULD USE THE FOLLOWING
* TECHNIQUE.  WITH 2'S AND 3'S, THIS DOESN'T WORK.
*	OR.B	(A0)+,D6	* GET/WRITE NEXT SRC PIXEL		[8]
*	ADD.B	D6,D6		* SHIFT LEFT				[4]

	BTST.B	D5,(A0)+	* NEXT SRC PIXEL -- WHITE?	[8]
	BEQ.S	MNR2X2		* YES				[10/8]
	OR.B	#128,D6		* NO, BLACK			[8]
MNR2X2	BTST.B	D5,(A0)+
	BEQ.S	MNR2X3
	OR.B	#64,D6
MNR2X3	BTST.B	D5,(A0)+
	BEQ.S	MNR2X4
	OR.B	#32,D6
MNR2X4	BTST.B	D5,(A0)+
	BEQ.S	MNR2X5
	OR.B	#16,D6
MNR2X5	BTST.B	D5,(A0)+
	BEQ.S	MNR2X6
	OR.B	#08,D6
MNR2X6	BTST.B	D5,(A0)+
	BEQ.S	MNR2X7
	OR.B	#04,D6
MNR2X7	BTST.B	D5,(A0)+
	BEQ.S	MNR2X8
	OR.B	#02,D6
MNR2X8	BTST.B	D5,(A0)+
	BEQ.S	MNR2X9
	OR.B	#01,D6

MNR2X9	MOVE.B	D6,(A1)+	* WRITE OUT DST BYTE (NON-TRANSPARENT)
	SUBQ.W	#8,D0
	BGT.S	MNR2X1
	RTS

*------------------------------*
* UncompH 
*------------------------------*

U_INB	EQU	0
U_OUTB	EQU	4
U_HTREE	EQU	8
U_PICX	EQU	12	* pixel width
U_MLEN	EQU	16	* after unhuff, before de-run
U_OLEN	EQU	20	* "interrupt count"
U_FCALL	EQU	24	* raised by caller, initially
U_LCALL	EQU	25	* raised by callee, when done
U_REGS	EQU	26

*** ULONG /*int*/ uncompress_huff (inbuf, outbuf, huff_tree, midlen, pic_x)
*** unsigned char *inbuf, *outbuf, *huff_tree;
*** ULONG midlen, pic_x;

* FUNCTION UncompH (ucr: uncompRecPtr): LONGINT;

* THERE ARE TWO NEW PARAMETERS: A FIRST-CALL FLAG AND AN INTERRUPT COUNT.
* AFTER AN INTERRUPT WE RETURN TO THE CALLER (SINCE THE NEXT STEP IS MODE-DEPENDENT).
* ALL PARAMS ARE NOW PASSED IN A RECORD, SO THEY WILL REMAIN VALID ACROSS MULTIPLE 
* CALLS TO UNCOMPH.

* THE OUTPUT BUFFER LENGTH MUST BE >= (U_OLEN + U_PICX + 128).

* ABOUT BUFFER SIZES
* A nominal full-screen Color pic contains 320x200 or 64000 pixels, decompressed 
* into as many bytes.  Large but not unaffordable on a MacII.  Post-processing consists 
* of packing bytes into row-aligned nibbles.  Transparency is handled by the OS.  
* Stipples are handled by us as a special case.

* A nominal full-screen Mono pic contains 480x300 or 144000 pixels.  Decompressing
* this into as many bytes is only /barely/ affordable on a Mac 512K.  The best
* alternative is probably to decompress only a few rows at a time, into a small
* output buffer adjacent to inbuf, and call MonoPic repeatedly.  Post-processing 
* consists of packing bytes into row-aligned bits, and handling transparency.

* STEPS IN PICTURE DECOMPRESSION (undo in reverse order):
*   1. Each line of the picture is exclusive-or'ed with the previous line.
*   2. A run-length encoding is applied, as follows:  byte values 0
* through 15 represent colors; byte values 16 through 127 are repetition
* counts (16 will never actually appear)  Thus: 3 occurrences of byte 
* value 2 will turn into 2 17 (subtract 15 from the 17 to find that the 
* two should be repeated 2 MORE times).
*   3. Optionally, the whole thing is Huffman-coded, using an encoding
* specified in the header file.

* This routine does all three steps simultaneously--unhuf, then undo rle and 
* xor steps.  Stores extra line of 0s at beginning of outbuf, for xor step.
* Returns number of decompressed bytes.
   
UncompH
	MOVEM.L	D2-D7/A2-A4/A6,-(SP)	* [40 BYTES]
	MOVE.L	40+4(SP),A6		* PARAMBLOCK PTR

	TST.B	U_FCALL(A6)	* FIRST TIME THROUGH?
	BEQ.S	UNCHX4		* NO
	CLR.B	U_FCALL(A6)	* YES, RESET FLAG
	MOVEQ	#0,D0		* [DEFAULT RETURN VAL]

* LOAD REGS FROM PARAMBLOCK

***	MOVE.L	U_ILEN(A6),D1	* [INLEN -- NO LONGER USED]
***	BLE.S	UNCHX9		*   ERROR
	MOVE.L	U_MLEN(A6),D3	* "midlen" (AFTER dehuff, but BEFORE derun)
	BLE.S	UNCHX9		*   ERROR
	MOVE.L	U_INB(A6),A4	* INBUF
	MOVE.L	U_HTREE(A6),A0	* HUFFTREE (256 BYTES MAX)

* ZERO FIRST LINE OF OUTBUF

	MOVE.L	U_OUTB(A6),A1	* OUTBUF(1)
	MOVE.L	A1,A2
	MOVE.L	U_PICX(A6),D1
	BLE.S	UNCHX9		* ERROR
UNCHX2	CLR.B	(A2)+		* CLEAR OUTBUF(1), ADVANCE TO OUTBUF(2)
	SUBQ.W	#1,D1
	BGT.S	UNCHX2
	
	MOVE.L	U_OLEN(A6),D1
	BLE.S	UNCHX9		* ERROR
	MOVE.L	A2,A3
	ADD.L	D1,A3		* OUTBUF(3) IS INTERRUPT POINT

	BSR	UNCOMP		* DIVE IN
	BRA.S	UNCHX9
UNCHX4	BSR	UNCOMP2		* CONTINUE

UNCHX9	MOVEM.L	(SP)+,D2-D7/A2-A4/A6
	MOVE.L	(SP)+,A0	* RETURN ADDR
***	ADDA.W	#20,SP
	ADDQ.L	#4,SP		* FLUSH ARGS, PASCAL STYLE
	MOVE.L	D0,(SP)		* RETURN RESULT, PASCAL STYLE
	JMP	(A0)

*------------------------------*
* UNCOMP, UNCOMP2
*------------------------------*

* GIVEN 
*	A1 -> OUTBUF1 (PREV ROW)	A2 -> OUTBUF2	A3 -> OUTBUF3 (END+1)	
*	A4 -> INBUF	A6 -> PARAMS	A0 -> HUFFTREE	
*	D3.L = MIDLEN [AFTER UNHUFF, BEFORE UNRUN]
* USES  
*	D4.B = INCHR	D5.B = CBIT	D7.L [not .B] = CNODE	D6.B = LASTPIX
*	D1.B = 16	D2.B = 128+16
* RETURNS 
*	D0.L = #BYTES WRITTEN TO OUTBUF
*
* COMMENTED-OUT LINES BELOW REFLECT OPTIMIZATIONS FOR SPEED.

UNCOMP	MOVEQ	#16,D1
	MOVE.B	#128+16,D2
	MOVEQ	#0,D7		* INIT CNODE

UNCPX0	MOVEQ	#7,D5		* RESET CBIT 
***	MOVE.B	#128,D5
	MOVE.B	(A4)+,D4	* Get the next inchr

* [innermost unhuff loop begins here -- 5 ops, 40 cycles]

* Since the bit of interest runs from 7 down to 0, we can avoid an explicit 
* bit test by shifting bits off the left end of the register, one at a time, 
* into the Carry flag (Thanks Mike M).  The fast way to shift a register  
* left by one is to add it to itself. 

UNCPX1	ADD.B	D4,D4		* IF (chr & cbit) SET X FLAG		[4]

* We can check the Carry flag but avoid an expensive branch by taking advantage 
* of the ADDX instruction.  Also, adding D7 to itself here eliminates the need
* to do it separately later.

	ADDX.B	D7,D7		* cnode = (cnode * 2) + X		[4]
	MOVE.B	0(A0,D7.W),D7	* cnode = huff_tree[cnode]		[14]
	BMI.S	UNCPX3		* if (cnode >= 128) IT'S A TERMINAL	[8/]

* We /could/ avoid this conditional branch by unrolling 8 iterations of the loop,
* but would then have to remember where to jump back in ... probably not worth it.

	DBF	D5,UNCPX1	* cbit >>= 1  (next bit)		[10/]	[40 tot]
	BRA.S	UNCPX0		* if done with this char, go to next


* X21	ADD.B	D4,D4		* IF (chr & cbit) SET X FLAG		[4]
*	ADDX.B	D7,D7		* cnode = (cnode * 2) + X		[4]
*	MOVE.B	0(A0,D7.W),D7	* cnode = huff_tree[cnode]		[14]
*	BPL.S	X22		* if (cnode >= 128) IT'S A TERMINAL	[10/]	[32 tot]
*	BSR.B	UNCPX3		*	[18]  [16 RTS]
* X22	ADD.B	D4,D4
*	ADDX.B	D7,D7
*	MOVE.B	0(A0,D7.W),D7
*	BPL.S	X23
*	BSR	UNCPX3
* X23			etc

* SLOWER METHOD(S), HERE FOR DOCUMENTATION ONLY ...

* UNCPX1	
***	MOVE.B	D4,D0
***	AND.B	D5,D0
*	BTST	D5,D4		* IF (chr & cbit)			[6]
*	BEQ.S	UNCPX2		*					[8/10]
*	ADDQ.B	#1,D7		*					[4]
* UNCPX2	
*	MOVE.B	0(A0,D7.W),D7	* THEN cnode = huff_tree[cnode + 1]	[14]
***	CMP.B	#128,D7		* if (cnode < 128)
***	BCC.S	UNCPX3	* BHS
*	BMI.S	UNCPX3		* [FLAG /ALREADY/ SET]			[8/]
*	ADD.B	D7,D7		* THEN cnode *= 2;			[4]
***	LSR.B	#1,D5
*	SUBQ.B	#1,D5		* cbit >>= 1  (next bit)		[4]
*	BPL.S	UNCPX1	* bne	*					[10/]	[56/58 tot]
*	BRA.S	UNCPX0		* if done with this char, go to next

* [cnode >= 128]  here we undo both runlength and xor

UNCPX3	SUB.B	D2,D7		* ELSE cnode -= (128+16)  (this is a terminal)
	BPL.S	UNCPX4
***	ADD.B	#16,D7
	ADD.B	D1,D7		* [RESTORE TO RANGE 0..15]

***	SUB.B	#128,D7
***	CMPI.B	#16,D7		* if (cnode < 16)
***	BCC.S	UNCPX4	* BHS

* It's a color id, output/xor it
***	MOVE.B	(A1)+,(A2)	* [SLOWER by 4 cycles!]
***	EOR.B	D7,(A2)+
	MOVE.B	(A1)+,D0	* *p++ = cnode ^ *outbuf++
	EOR.B	D7,D0
	MOVE.B	D0,(A2)+

	MOVE.B	D7,D6		* lastpix = cnode;
	BRA.S	UNCPX7

* Otherwise, run/xor LAST color id

UNCPX4
***	SUBI.B	#15+1,D7	* for (j = 0; j < (cnode - 15); j++)
UNCPX5	MOVE.B	(A1)+,D0	* *p++ = lastpix ^ *outbuf++
	EOR.B	D6,D0	
	MOVE.B	D0,(A2)+
	DBF	D7,UNCPX5	* [USES D7.W]

UNCPX7	SUBQ.L	#1,D3		* if (--midlen <= 0) break [DONE]
	BEQ.S	UNCPX10

	CMPA.L	A3,A2		* IF OUTLEN_INTERRUPT break
	BCC.S	UNCPX20	* BHS

UNCPX8	MOVEQ	#0,D7		* RESET cnode = 0
***	LSR.B	#1,D5
	SUBQ.B	#1,D5		* cbit >>= 1  (next bit)
	BPL	UNCPX1	* bne	* STILL IN RANGE 7..0
	BRA	UNCPX0		* if done with this char, go to next

* HERE FOR FINAL EXIT

UNCPX10	MOVE.L	A1,D0
	SUB.L	U_OUTB(A6),D0	* RETURN #BYTES IN FINAL OUTBUF
	
	MOVE.B	#1,U_LCALL(A6)	* TELL CALLER WE'RE DONE
	RTS

* HERE FOR TEMPORARY EXIT

UNCPX20	
	MOVEM.L	D3-D6/A2-A4,U_REGS(A6)	* SAVE OUR STATE
	MOVE.L	U_OLEN(A6),D0		* RETURN #BYTES IN FULL OUTBUF
	RTS

* HERE TO RESUME AFTER TEMPORARY EXIT

UNCOMP2	
	MOVEM.L	U_REGS(A6),D3-D6/A2-A4	* RESTORE CRITICAL VARS

* COPY LAST ROW OF BYTES, PLUS ANY OVERRUN, BACK TO THE BASE OF THE BUFFER, 
* SO XOR WILL KEEP WORKING.  WE COULD DO SLIGHTLY LESS WORK BY COPYING /EXACTLY/
* ONE ROW'S WORTH TO /NEAR/ THE BASE, BUT COPYING THE EXTRA BYTES:
*   - PREVENTS A PROBLEM IN THE UNLIKELY CASE OF OVERRUN > 1 ROW, AND ALSO
*   - HELPS ENSURE BLOCKMOVE IS EVEN-ALIGNED.

	MOVE.L	U_PICX(A6),D1
	MOVE.L	U_OLEN(A6),D2
	
	MOVE.L	A3,A0
	SUB.L	D1,A0		* SRC: LAST ROW
	MOVE.L	A0,A1
	SUB.L	D2,A1		* DST: BUFFER BASE
	MOVE.L	A2,D0
	SUB.L	A3,D0
	ADD.L	D1,D0		* ROWBYTES, PLUS #BYTES OVERRUN
	BSR	MOVMEM

* NOTE: FOR THE QUICKEST BLOCKMOVE, BOTH SRC AND DST MUST BE EVEN-ALIGNED.  THIS MEANS
* THE CALLER SHOULD ENSURE THAT U_OLEN IS EVEN, WHETHER OR NOT U_PICX IS.

	SUB.L	D2,A2		* RESET OUTBUF PTRS: 1ST ROW + EXTRA
	MOVE.L	A2,A1
	SUB.L	D1,A1		* BASE + EXTRA

	MOVE.L	U_HTREE(A6),A0	* RESTORE REMAINING REGS
	MOVEQ	#16,D1
	MOVE.B	#128+16,D2
	BRA.S	UNCPX8		* PICK UP WHERE WE LEFT OFF


* THE FOLLOWING IS DEAD (YZIP) CODE
    IF CZIP THEN

* ----------------------
* StipPic
* ----------------------

* PROCEDURE StipPic (src, dst: Ptr; rowBytes, rows: INTEGER; maps: Ptr);

StipPic
	MOVEM.L	D2-D5/A2-A3,-(SP)	* [24 BYTES]

	MOVE.L	24+04(SP),A3	* MAPS (16 WORDS X4)
	MOVE.W	24+08(SP),D5	* ROWS [MONO]
	ASR.W	#1,D5		* ROWS [COLOR]
	MOVE.W	24+10(SP),D4	* ROWBYTES [MONO] -- MULTIPLE OF 2 
	MOVE.L  24+12(SP),A2	* DST
	MOVE.L	24+16(SP),A0	* SRC

STPPX1	MOVE.L	A2,A1		* NEW DST1
	ADDA.W	D4,A2		* NEW DST2 - 2ND ROW OF STIPPLES
	MOVE.W	D4,D0
	BSR	StipRow
	SUBQ.W	#1,D5
	BGT.S	STPPX1
	
	MOVEM.L	(SP)+,D2-D5/A2-A3
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#16,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

* StipRow: CONVERT EACH COLOR PIXEL INTO A 2x2 MONO STIPPLE
* FOR SPEED, EACH LOOP CONVERTS /4/ COLOR PIXELS INTO AN 8x2 MONO STIPPLE

* GIVEN A0 -> SRC, D0.W = ROW LENGTH,  A1 -> DST1, A2 -> DST2,  A3 -> MAPS
* USES	D1.W = PIX1, D2.W = PIX2,  D3.W = STIPPLE
* RETURNS UPDATED PTRS

StipRow
	MOVEQ	#0,D1		* ZERO ALL BYTES
STPRX1	MOVEQ	#0,D3		* ZERO RESULT

	MOVE.B	(A0)+,D1	* GET 2 PIXELS (2x4 BITS)
	MOVE.B	D1,D2
	LSR.W	#4,D1		* EXTRACT HIGH PIXEL
	ADD.W	D1,D1		* 2x
	OR.W	SH6(A3,D1.W),D3	* xx------ xx------
	ANDI.W	#$0F,D2		* EXTRACT LOW PIXEL
	ADD.W	D2,D2		* 2x
	OR.W	SH4(A3,D2.W),D3	* --xx---- --xx----

	MOVE.B	(A0)+,D1	* GET 2 MORE PIXELS (2x4 BITS)
	MOVE.B	D1,D2
	LSR.W	#4,D1		* EXTRACT HIGH PIXEL
	ADD.W	D1,D1		* 2x
	OR.W	SH2(A3,D1.W),D3	* ----xx-- ----xx--
	ANDI.W	#$0F,D2		* EXTRACT LOW PIXEL
	ADD.W	D2,D2		* 2x
	OR.W	SH0(A3,D2.W),D3	* ------xx ------xx

* AT THIS POINT, WE HAVE 4 FOUR-BIT STIPPLES

	MOVE.B	D3,(A2)+	* STORE 2x4 LSBITS OF STIPPLES IN 2ND ROW
	LSR.W	#8,D3
	MOVE.B	D3,(A1)+	* STORE 2x4 MSBITS OF STIPPLES IN PRIMARY ROW
	SUBQ.W	#1,D0
	BGT.S	STPRX1		* LOOP UNTIL END OF ROW
	RTS

* ----------------------
* Shrink75
* ----------------------

* PROCEDURE Shrink75 (base: Ptr; rb1, rb2, rows: INTEGER);

* SCALE A GIVEN (COLOR) PICTURE BY 0.75 - DISCARD EVERY 4TH BYTE AND EVERY 4TH ROW
* NOTE: BOTH RB ARE ALWAYS MULTIPLES OF 4 (SINCE PRE-STIPPLE)

Shrink75
	MOVEM.L	D2-D7/A2-A3,-(SP)	* 8x4 BYTES
	MOVE.W	32+04(SP),D4	* ROWS
	MOVE.W	32+06(SP),D3	* SHRUNK ROWBYTES
	MOVE.W	32+08(SP),D2	* ROWBYTES
	MOVE.L	32+10(SP),A3	* SRC AND (INITIAL) DST PTRS (IN-PLACE COPY)
	MOVE.L	A3,A2

SK75X1	BSR	ShrinkOne	* COPY 1ST ROW
	ADDA.W	D2,A2		* NEXT SRC
	ADDA.W	D3,A3		* NEXT DST
	SUBQ.W	#1,D4		* DONE?
	BLE.S	SK75X2
	
	BSR	ShrinkOne	* COPY 2ND ROW
	ADDA.W	D2,A2
	ADDA.W	D3,A3
	SUBQ.W	#1,D4		* DONE?
	BLE.S	SK75X2
	
	BSR	ShrinkOne	* COPY 3RD ROW
	ADDA.W	D2,A2
	ADDA.W	D3,A3

	ADDA.W	D2,A2		* SKIP 4TH ROW
	SUBQ.W	#2,D4		* DONE?
	BGT.S	SK75X1

SK75X2	MOVEM.L	(SP)+,D2-D7/A2-A3
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#10,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)

ShrinkOne
	MOVE.L	A2,A0
	MOVE.L	A3,A1
	MOVE.W	D2,D1		* FULL ROWBYTES

* GIVEN A0 -> SRC, A1 -> DST, D1.W = FULL ROWBYTES
* NOTE: WE "UNROLL" 2x4 ITERATIONS FOR SPEED - MAY GO 4 BYTES BEYOND END OF DATA

SKONX1	
**	MOVE.L	(A0)+,(A1)+	* COPY 3 BYTES, SKIP 4TH
**	SUBQ.L	#1,A1
**	MOVE.B	(A0)+,(A1)+	* COPY 3 BYTES (OUT OF PHASE), SKIP 4TH
**	MOVE.B	(A0)+,(A1)+
**	MOVE.B	(A0)+,(A1)+
**	ADDQ.L	#1,A0

* COPY 3 BYTES (6 NIBBLES/PIXELS), SKIP 4TH (2 NIBBLES/PIXELS)
	
	MOVE.L	(A0)+,D0
	MOVEQ	#0,D7		* ZERO HIGH WORD
	MOVE.W	D0,D7
	LSL.L	#4,D7		* POSITION NIBBLES: 00 0e fg x0
	ANDI.L	#$FFF00000,D0	* EXTRACT NIBBLES:  ab c0 00 00
	OR.L	D7,D0

	MOVE.L	D0,(A1)+	* STORE 3 BYTES
	SUBQ.L	#1,A1

* COPY 3 BYTES (OUT OF PHASE), SKIP 4TH

	MOVE.L	(A0)+,D0
	MOVEQ	#0,D7		* ZERO HIGH WORD
	MOVE.W	D0,D7
	LSL.L	#4,D7		* POSITION NIBBLES: 00 0e fg x0
	ANDI.L	#$FFF00000,D0	* EXTRACT NIBBLES:  ab c0 00 00
	OR.L	D7,D0

	ROL.L	#8,D0		* STORE 3 BYTES
	MOVE.B	D0,(A1)+
	ROL.L	#8,D0
	MOVE.B	D0,(A1)+
	ROL.L	#8,D0
	MOVE.B	D0,(A1)+

	SUBQ.W	#8,D1
	BGT.S	SKONX1		* LOOP
	RTS

* ----------------------
* Scale2xPic
* ----------------------

* PROCEDURE Scale2xPic (src, dst, randTbl: Ptr; cols {rbSrc, rbDst}, rows: INTEGER);

* SCALE A GIVEN (COLOR) PICTURE BY 2.0, INTERPOLATING /RANDOMLY/
* HOPEFULLY THIS WILL MAKE IT LOOK LESS SCALED-UP AND BLOCKY

Scale2xPic
	MOVEM.L	D2-D7/A2-A6,-(SP)	* 11x4 BYTES
	MOVE.W	44+04(SP),D6	* ROWS
	MOVE.W	44+06(SP),D5	* COLS
	MOVE.L	44+08(SP),A4	* PTR TO TABLE OF RANDOM BITS
	MOVEQ	#0,D4		* INITIAL BIT OFFSET
	MOVE.L	44+12(SP),A1	* DST
	MOVE.L	44+16(SP),A0	* SRC

	MOVE.L	A0,A2
	ADDA.W	D5,A2		* SRC_AHEAD (NEXT ROW)
	MOVE.L	A1,A3
	ADDA.W	D5,A3
	ADDA.W	D5,A3		* DST_MID (NEXT ROW)

	SUBQ.W	#1,D6		* (LAST ROW IS HANDLED SPECIALLY)
	BLE.S	SCXPX2	* BLT?

SCXPX1	MOVE.W	D5,D3
	BSR	Scale2xRow

	MOVE.L	A3,A1		* UPDATE DST
	ADDA.W	D5,A3
	ADDA.W	D5,A3		* AND DST_MID

	MOVE.L	44+08(SP),A4	* RESET: PTR TO TABLE OF RANDOM BITS
	ADDQ.B	#1,D4		* UPDATE: BIT OFFSET (ONLY CARE ABOUT LOW 3 BITS)
	SUBQ.W	#1,D6
	BGT.S	SCXPX1

* LAST ROW, SPECIAL CASE: NO VERTICAL RANDOMIZATION

	MOVE.L	A0,A2		* "SRC = SRC_AHEAD"	
	MOVE.W	D5,D3
	BSR	Scale2xRow

SCXPX2	MOVEM.L	(SP)+,D2-D7/A2-A6
	MOVE.L	(SP)+,A0	* RETURN ADDR
	ADDA.W	#16,SP		* FLUSH ARGS, PASCAL STYLE
	JMP	(A0)


* Scale2xRow
*
* EACH SRC PIXEL MAPS TO 4 DST PIXELS, ACCORDING TO THE FOLLOWING PATTERN:
*
*	1a	1a'	(1b)			1a' = 1a or 1b
*	1'a	1'a'				1'a = 1a or 2a
*	(2a)					1'a' = 1a' or 1'a
*
* 1a is copied directly from the src.  Each of its three spinoffs are generated 
* randomly from two neighbors of that spinoff.
*
* To avoid "feathering" lines and such, the algorithm is extended as follows:
*
*	if 2a = 1a then 1a' = 1a always  (and by implication, 1'a = 1'a' = 1a also)
*	if 1b = 1a then 1'a = 1a always  (and by implication, 1a' = 1'a' = 1a also)
*
* >> NOTE: ALL PIXELS CURRENTLY /BYTE/ VALUES (NOT NIBBLES) <<
*
* GIVEN A0 -> SRC, A2 -> SRC_AHEAD	D3.W = SRC PIXELS (BYTES)
*	A1 -> DST, A3 -> DST_MID
* 	A4 -> TABLE OF RANDOM BYTES (4x200)	D4.B = BIT NUMBER (0-7)
*
* ALSO USES D7
* RETURN UPDATED A0-A3

Scale2xRow
	SUBQ.W	#1,D3		* (LAST PIXEL IS HANDLED SPECIALLY)
	BLE.S	SCXRX9
	MOVE.B	(A0)+,D0	* GET FIRST PIXEL

* A0 -> SRC+1,  D0.B = (A0)

SCXRX1	MOVE.B	D0,(A1)+	* STORE 1a

	MOVE.B	(A0)+,D1	* GET 1b
	MOVE.B	(A2)+,D2	* GET 2a
	MOVE.B	D0,D7
	
	CMP.B	D0,D1		* 1b = 1a?
	BEQ.S	SCXRX2		* YES, FORCE 1'a = 1a 
	
	BTST.B	D4,(A4)+	* RANDOMIZE
	BEQ.S	SCXRX2
	MOVE.B	D2,D7
SCXRX2	MOVE.B	D7,(A3)+	* STORE 1'a

	CMP.B	D0,D2		* 2a = 1a?
	BEQ.S	SCXRX3		* YES, FORCE 1a' = 1a
	
	BTST.B	D4,(A4)+	* RANDOMIZE
	BEQ.S	SCXRX3
	MOVE.B	D1,D0
SCXRX3	MOVE.B	D0,(A1)+	* STORE 1a'

	BTST.B	D4,(A4)+	* RANDOMIZE
	BEQ.S	SCXRX4
	MOVE.B	D7,D0
SCXRX4	MOVE.B	D0,(A3)+	* STORE 1'a'

* Each loop advances each src +1, each dst +2

	MOVE.B	D1,D0		* [POSITION 1b FOR NEXT ITERATION]

	SUBQ.W	#1,D3
	BGT.S	SCXRX1
	BLT.S	SCXRX9

* For the final pixel, make 1b = 1a

	SUBQ.L	#1,A0
	BRA.S	SCXRX1

SCXRX9	RTS

    ENDIF