2023-11-16 18:19:54 -05:00

2978 lines
72 KiB
Plaintext

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