mirror of
https://github.com/erkyrath/infocom-zcode-terps.git
synced 2026-01-21 10:03:09 +00:00
3860 lines
92 KiB
Plaintext
3860 lines
92 KiB
Plaintext
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* ARITHMETIC OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPADD
|
|
* ----------------------
|
|
|
|
OPADD ADD.W D1,D0 * ADD OPR1 AND OPR2
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPSUB
|
|
* ----------------------
|
|
|
|
OPSUB SUB.W D1,D0 * SUBTRACT OPR2 FROM OPR1
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPMUL
|
|
* ----------------------
|
|
|
|
OPMUL MULS D1,D0 * MULTIPLY OPR1 BY OPR2 (16 BIT SIGNED)
|
|
BRA PUTVAL * RETURN THE PRODUCT, IGNORING OVERFLOW
|
|
|
|
* ----------------------
|
|
* OPDIV
|
|
* ----------------------
|
|
|
|
* DIVIDE BY ZERO AND MOD ZERO ARE CAUGHT, AVOIDING CONFUSING HARDWARE TRAPS
|
|
|
|
OPDIV TST.W D1
|
|
BEQ.S ODIVX1 * TRAP DIVIDE-BY-ZERO
|
|
EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
BRA PUTVAL * RETURN THE QUOTIENT, IGNORING REMAINDER
|
|
|
|
ODIVX1
|
|
* CLR.W D0
|
|
LEA MSGODV,A0
|
|
BRA FATAL
|
|
DATA
|
|
MSGODV DC.B 'Bad DIV',0
|
|
CODE
|
|
|
|
* ----------------------
|
|
* OPMOD
|
|
* ----------------------
|
|
|
|
OPMOD TST.W D1
|
|
BEQ.S OMODX1 * TRAP DIVIDE-BY-ZERO
|
|
EXT.L D0 * SIGN-EXTEND OPR1 TO 32 BITS
|
|
DIVS D1,D0 * DIVIDE OPR2 INTO OPR1
|
|
SWAP D0 * GET REMAINDER
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
OMODX1
|
|
* CLR.W D0
|
|
LEA MSGOMD,A0
|
|
BRA FATAL
|
|
DATA
|
|
MSGOMD DC.B 'Bad MOD',0
|
|
CODE
|
|
|
|
* ----------------------
|
|
* OPRAND
|
|
* ----------------------
|
|
|
|
OPRAND TST.W D7 * [GARBAGE FOR ST ASSEMBLER]
|
|
|
|
IF EZIP THEN
|
|
TST.W D0 * DISABLE RANDOMNESS NOW?
|
|
BLT.S RANDX1 * YES
|
|
BEQ.S RANDX2 * ZERO, RE-ENABLE RANDOMNESS
|
|
|
|
TST.W RCYCLE(A6) * IS RANDOMNESS ALREADY DISABLED?
|
|
BNE.S RANDX3 * YES
|
|
ENDIF
|
|
|
|
* NORMAL RANDOMNESS, GENERATE A VALUE
|
|
|
|
MOVE.W RSEED2(A6),D1 * GET BOTH SEEDS
|
|
SWAP D1
|
|
MOVE.W RSEED1(A6),D1
|
|
MOVE.W D1,RSEED2(A6) * UPDATE LOW SEED
|
|
SWAP D1
|
|
|
|
LSR.L #1,D1 * SHIFT BOTH RIGHT BY 1 BIT
|
|
EOR.W D1,RSEED1(A6) * GENERATE OUTPUT & UPDATE HIGH SEED
|
|
MOVE.W RSEED1(A6),D1 * GET NEW HIGH SEED
|
|
|
|
ANDI.L #$00007FFF,D1 * CLEAR HIGH BIT TO PREVENT POSSIBLE OVERFLOW
|
|
DIVU D0,D1 * DIVIDE ARG INTO RANDOM NUMBER
|
|
SWAP D1 * GET REMAINDER
|
|
ADDQ.W #1,D1 * MUST BE BETWEEN 1 AND N, INCLUSIVE
|
|
MOVE.W D1,D0
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
IF EZIP THEN
|
|
|
|
*** GENERATE A NON-RANDOM SEQUENCE HENCEFORTH
|
|
|
|
RANDX1 NEG.W D0 * THIS SPECIFIES UPPER LIMIT OF SEQUENCE
|
|
RANDX2 MOVE.W D0,RCYCLE(A6) * STORE IT
|
|
BRA.S RANDX4 * AND INITIALIZE COUNTER (SEQ BEGINS NEXT PASS)
|
|
|
|
RANDX3 MOVE.W RCONST(A6),D0 * GENERATE NEXT VALUE IN SEQUENCE
|
|
ADDQ.W #1,D0
|
|
CMP.W RCYCLE(A6),D0 * EXCEEDED THE UPPER LIMIT YET?
|
|
BLE.S RANDX4 * NO
|
|
MOVEQ #1,D0 * YES, RESTART THE SEQUENCE
|
|
|
|
RANDX4 MOVE.W D0,RCONST(A6) * UPDATE COUNTER
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
ENDIF
|
|
|
|
* ----------------------
|
|
* OPQLES
|
|
* ----------------------
|
|
|
|
OPQLES CMP.W D1,D0 * IS OPR1 LESS THAN OPR2?
|
|
BLT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQGRT
|
|
* ----------------------
|
|
|
|
OPQGRT CMP.W D1,D0 * IS OPR1 GREATER THAN OPR2?
|
|
BGT PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PRECICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPBTST
|
|
* ----------------------
|
|
|
|
* LOGICAL OPERATIONS
|
|
|
|
OPBTST NOT.W D0 * TURN OFF ALL BITS IN OPR2 THAT ARE ON IN OPR1
|
|
AND.W D0,D1
|
|
BEQ PTRUE * SUCCESS IF OPR2 COMPLETELY CLEARED
|
|
BRA PFALSE
|
|
|
|
* ----------------------
|
|
* OPBOR
|
|
* ----------------------
|
|
|
|
OPBOR OR.W D1,D0 * LOGICAL "OR"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPBCOM
|
|
* ----------------------
|
|
|
|
OPBCOM NOT.W D0 * LOGICAL COMPLEMENT
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPBAND
|
|
* ----------------------
|
|
|
|
OPBAND AND.W D1,D0 * LOGICAL "AND"
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPSHIFT
|
|
* ----------------------
|
|
|
|
OPSHIFT
|
|
TST.W D1 * NEGATIVE?
|
|
BLT.S SHFX1 * YES
|
|
LSL.W D1,D0 * NO, LOGICAL LEFT SHIFT
|
|
BRA PUTVAL
|
|
SHFX1 NEG.W D1
|
|
LSR.W D1,D0 * LOGICAL RIGHT SHIFT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPASHIFT
|
|
* ----------------------
|
|
|
|
OPASHIFT
|
|
TST.W D1 * NEGATIVE?
|
|
BLT.S ASHFX1 * YES
|
|
ASL.W D1,D0 * NO, ARITHMETIC LEFT SHIFT
|
|
BRA PUTVAL
|
|
ASHFX1 NEG.W D1
|
|
ASR.W D1,D0 * ARITHMETIC RIGHT SHIFT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPQEUQ
|
|
* ----------------------
|
|
|
|
* GENERAL PREDICATES
|
|
|
|
OPQEQU NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W (A0)+,D1 * NUMBER OF OPERANDS
|
|
MOVE.W (A0)+,D0 * OPR1
|
|
SUBQ.W #1,D1
|
|
|
|
QEQUX1 CMP.W (A0)+,D0 * IS NEXT OPR EQUAL TO OPR1?
|
|
BEQ.S QEQUX2 * YES
|
|
SUBQ.W #1,D1 * NO, BUT LOOP IF MORE OPERANDS
|
|
BNE.S QEQUX1
|
|
|
|
BRA PFALSE * PREDICATE FALSE
|
|
QEQUX2 BRA PTRUE * PREDICATE TRUE
|
|
|
|
|
|
* ----------------------
|
|
* OPQZER
|
|
* ----------------------
|
|
|
|
OPQZER TST.W D0 * IS OPR ZERO?
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT-RELATED PRIMITIVES
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OBJLOC
|
|
* ----------------------
|
|
|
|
* GIVEN OBJECT NUMBER IN D0.W, RETURN OBJECT LOCATION IN A0
|
|
|
|
OBJLOC MULU #OLEN,D0 * CALCULATE OBJECT OFFSET
|
|
MOVE.L OBJTAB(A6),A0
|
|
ADDA.L D0,A0 * INDEX INTO OBJECT TABLE
|
|
ADDA.W #OPLEN-OLEN,A0 * SKIPPING OVER THE DEFAULT PROPERTY TABLE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* FSTPRP
|
|
* ----------------------
|
|
|
|
* GIVEN OBJECT LOCATION IN A0, RETURN POINTER TO FIRST PROPERTY IN A0
|
|
|
|
FSTPRP ADDA.W #PROP,A0 * POINT TO PROPERTY TABLE SLOT
|
|
MOVEQ #0,D0
|
|
BSR GTAWRD * GET ITS LOCATION
|
|
MOVE.L BUFFER(A6),A0 * ABSOLUTIZE THE LOCATION
|
|
ADDA.L D0,A0
|
|
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * LENGTH OF SHORT DESCRIPTION IN WORDS
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A0 * ADJUST POINTER TO SKIP IT
|
|
RTS
|
|
|
|
* ----------------------
|
|
* NXTPRP
|
|
* ----------------------
|
|
|
|
* GIVEN POINTER TO A PROPERTY ID IN A0, UPDATE IT TO POINT TO NEXT PROPERTY ID
|
|
|
|
IF EZIP THEN
|
|
|
|
NXTPRP MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.S NXTPX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BEQ.S NXTPX2 * NO, PROPERTY LENGTH IS 1
|
|
ADDQ.L #1,A0
|
|
NXTPX2 ADDQ.L #1,A0 * UPDATE POINTER
|
|
RTS
|
|
|
|
NXTPX4 MOVE.B (A0)+,D0 * GET (SECOND) PROPERTY LENGTH BYTE (LOW 6 BITS)
|
|
ANDI.W #$003F,D0 * CLEAR OFF HIGH BITS
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDIF
|
|
IF CZIP THEN
|
|
|
|
NXTPRP CLR.W D0
|
|
MOVE.B (A0)+,D0 * GET PROPERTY ID BYTE
|
|
ASR.W #5,D0 * EXTRACT PROPERTY LENGTH-1 (HIGH 3 BITS)
|
|
ADDQ.W #1,D0 * ADJUST FOR EXTRA LENGTH BYTE
|
|
ADDA.W D0,A0 * UPDATE POINTER
|
|
RTS
|
|
ENDIF
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* OBJECT OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPMOVE
|
|
* ----------------------
|
|
|
|
* MOVE (OBJ1 INTO OBJ2)
|
|
|
|
OPMOVE MOVEM.W D1/D0,-(SP) * PROTECT OPERANDS FROM REMOVE CALL
|
|
BSR OPREMO * REMOVE OBJ1 FROM WHEREVER IT IS
|
|
|
|
MOVE.W 2(SP),D0 * OBJ2
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1 * SAVE IT
|
|
MOVE.W (SP),D0 * OBJ1
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
|
|
MOVEM.W (SP)+,D0/D1 * RESTORE THE OBJ NUMBERS
|
|
|
|
IF EZIP THEN
|
|
MOVE.W FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.W D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.W D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDIF
|
|
IF CZIP THEN
|
|
MOVE.B FIRST(A1),NEXT(A0) * PUT OBJ2'S CHILD INTO OBJ1'S SIBLING SLOT
|
|
MOVE.B D1,LOC(A0) * PUT OBJ2 IN OBJ1'S PARENT SLOT
|
|
MOVE.B D0,FIRST(A1) * PUT OBJ1 IN OBJ2'S CHILD SLOT
|
|
ENDIF
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPREMO
|
|
* ----------------------
|
|
|
|
* REMOVE (OBJ FROM ITS PARENT)
|
|
|
|
IF EZIP THEN
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.W LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.W FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO
|
|
|
|
MOVE.W NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.S REMOX2 * AND EXIT
|
|
|
|
REMOX1 BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.W NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.W D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.W NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.W LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.W NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
|
|
ENDIF
|
|
IF CZIP THEN
|
|
|
|
OPREMO MOVE.W D0,D1 * SAVE OBJ
|
|
BSR OBJLOC * FIND ITS LOCATION
|
|
MOVE.L A0,A1
|
|
MOVE.B LOC(A1),D0 * GET ITS PARENT
|
|
BEQ.S REMOX3 * IF NO PARENT, WE'RE DONE
|
|
|
|
ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND PARENT'S LOCATION
|
|
MOVE.B FIRST(A0),D0 * GET PARENT'S FIRST CHILD
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO
|
|
|
|
MOVE.B NEXT(A1),FIRST(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
BRA.S REMOX2 * AND EXIT
|
|
|
|
REMOX1 ANDI.W #$00FF,D0 * CLEAR UNWANTED BYTE
|
|
BSR OBJLOC * FIND LOCATION OF CURRENT SIBLING
|
|
MOVE.B NEXT(A0),D0 * GET NEXT SIBLING IN CHAIN
|
|
CMP.B D0,D1 * IS IT OBJ?
|
|
BNE.S REMOX1 * NO, CONTINUE SEARCH
|
|
|
|
MOVE.B NEXT(A1),NEXT(A0) * YES, CHANGE IT TO OBJ'S SIBLING
|
|
REMOX2 CLR.B LOC(A1) * OBJ NOW HAS NO PARENT
|
|
CLR.B NEXT(A1) * OR SIBLING
|
|
REMOX3 RTS
|
|
ENDIF
|
|
|
|
* ----------------------
|
|
* OPLOC
|
|
* ----------------------
|
|
|
|
* LOC (RETURN CONTAINER OF OBJ)
|
|
|
|
OPLOC BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IF EZIP THEN
|
|
MOVE.W LOC(A0),D0 * GET PARENT
|
|
ENDIF
|
|
IF CZIP THEN
|
|
CLR.W D0
|
|
MOVE.B LOC(A0),D0 * GET PARENT, CLEARING UNUSED BYTE
|
|
ENDIF
|
|
BRA PUTVAL * RETURN THE VALUE
|
|
|
|
* ----------------------
|
|
* OPQFIR
|
|
* ----------------------
|
|
|
|
* FIRST? (RETURN FIRST CHILD OF OBJ, FAIL IF NONE)
|
|
|
|
OPQFIR BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IF EZIP THEN
|
|
MOVE.W FIRST(A0),D0 * GET FIRST CHILD
|
|
ENDIF
|
|
IF CZIP THEN
|
|
CLR.W D0
|
|
MOVE.B FIRST(A0),D0 * GET FIRST CHILD, CLEARING UNUSED BYTE
|
|
ENDIF
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQNEX
|
|
* ----------------------
|
|
|
|
* NEXT? (RETURN THE NEXT SIBLING OF OBJ, FAIL IF NONE)
|
|
|
|
OPQNEX BSR OBJLOC * FIND OBJ'S LOCATION
|
|
|
|
IF EZIP THEN
|
|
MOVE.W NEXT(A0),D0 * GET SIBLING
|
|
ENDIF
|
|
IF CZIP THEN
|
|
CLR.W D0
|
|
MOVE.B NEXT(A0),D0 * GET SIBLING, CLEARING UNUSED BYTE
|
|
ENDIF
|
|
MOVE.W D0,-(SP)
|
|
BSR PUTVAL * RETURN THE VALUE
|
|
TST.W (SP)+ * NONZERO?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPQIN
|
|
* ----------------------
|
|
|
|
* IN? (IS OBJ1 CONTAINED IN OBJ2?)
|
|
|
|
OPQIN BSR OBJLOC * FIND OBJ1'S LOCATION
|
|
|
|
IF EZIP THEN
|
|
CMP.W LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDIF
|
|
IF CZIP THEN
|
|
CMP.B LOC(A0),D1 * IS OBJ1'S PARENT OBJ2?
|
|
ENDIF
|
|
BEQ PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPGETP
|
|
* ----------------------
|
|
|
|
* GETP (GET SPECIFIED PROPERTY OF OBJ, DEFAULT IF NONE)
|
|
|
|
OPGETP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S GETPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GETPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GETPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S GETPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BLT.S GETPX3 * IF LESS, NO SUCH PROPERTY, USE DEFAULT
|
|
|
|
* (ASSUMIMG NO 2ND EZIP LENGTH BYTE EXISTS HERE)
|
|
|
|
BTST #PLBIT,(A0)+ * GOT IT, EXAMINE (LOW MODE OR) LOWEST LEN BIT
|
|
BNE.S GETPX4 * ONE MEANS WORD VALUE, OTHERWISE BYTE VALUE
|
|
|
|
MOVE.B (A0),D0 * GET THE BYTE
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
GETPX3 SUBQ.W #1,D1 * PROPERTY NOT FOUND, USE DEFAULT PROP TABLE
|
|
ADD.W D1,D1 * WORD OFFSET
|
|
MOVE.L OBJTAB(A6),A0 * GET BASE OF DEFAULT TABLE
|
|
ADDA.W D1,A0 * POINT TO THE DEFAULT PROPERTY
|
|
|
|
GETPX4 BSR GTAWRD * GET THE WORD VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPUTP
|
|
* ----------------------
|
|
|
|
* PUTP (CHANGE VALUE OF SPECIFIED PROPERTY OF OBJ, ERROR IF BAD PROP NUMBER)
|
|
|
|
OPPUTP BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S PUTPX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
PUTPX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
PUTPX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S PUTPX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S PUTPX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGPUP,A0
|
|
BRA FATAL * 'Non-existent put property'
|
|
|
|
DATA
|
|
MSGPUP DC.B 'Non-existent put property',0
|
|
CODE
|
|
|
|
* (ASSUMING NO 2ND EZIP LENGTH BYTE EXISTS HERE)
|
|
|
|
PUTPX3 BTST #PLBIT,(A0)+ * EXAMINE (LOW MODE OR) LOWEST LENGTH BIT
|
|
BNE.S PUTPX4 * ZERO MEANS BYTE VALUE, OTHERWISE WORD VALUE
|
|
|
|
MOVE.B D2,(A0) * STORE THE NEW BYTE
|
|
RTS
|
|
|
|
PUTPX4 MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE NEW WORD
|
|
|
|
* ----------------------
|
|
* OPNEXT
|
|
* ----------------------
|
|
|
|
* NEXTP (RETURN NUMBER OF NEXT PROP FOLLOWING GIVEN PROP IN OBJ)
|
|
|
|
OPNEXT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
TST.W D1 * WERE WE GIVEN ZERO AS PROP?
|
|
BEQ.S NEXTX4 * YES, JUST RETURN FIRST PROPERTY NUMBER
|
|
BRA.S NEXTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
NEXTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX2 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * CLEAN OFF (EZIP MODE AND) LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S NEXTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S NEXTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, FATAL ERROR
|
|
LEA MSGNXP,A0
|
|
BRA FATAL * 'Non-existent next property'
|
|
|
|
DATA
|
|
MSGNXP DC.B 'Non-existent next property',0
|
|
CODE
|
|
|
|
NEXTX3 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
NEXTX4 MOVE.B (A0),D0 * GET PROPERTY IDENTIFIER
|
|
ANDI.W #PMASK,D0 * EXTRACT PROPERTY NUMBER
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* FLGLOC
|
|
* ----------------------
|
|
|
|
* PRIMITIVE TO LOCATE A FLAG BIT
|
|
* GIVEN A POINTER TO FIRST FLAGS BYTE IN A0, TARGET FLAG NUMBER (0-47) IN D0
|
|
* RETURN POINTER TO TARGET FLAGS BYTE IN A0, TARGET BIT NUMBER (7-0) IN D0
|
|
|
|
FLGLOC MOVE.W D0,-(SP)
|
|
LSR.W #3,D0 * EXTRACT BYTE OFFSET
|
|
ADD.W D0,A0 * ADJUST FLAGS POINTER
|
|
|
|
MOVE.W (SP)+,D0
|
|
NOT.W D0 * FIX THE 3 LOW-ORDER BITS
|
|
ANDI.W #$0007,D0 * MASK OFF THE REST
|
|
RTS
|
|
|
|
* ADDQ.L #1,A0 * POINT TO NEXT FLAGS BYTE
|
|
* SUBQ.W #8,D0 * WAS TARGET FLAG IN PREVIOUS BYTE?
|
|
* BGE.S FLGLOC * NO
|
|
* SUBQ.L #1,A0 * YES, POINT TO PREVIOUS FLAGS BYTE
|
|
* NEG.W D0 * AND COMPUTE THE TARGET BIT NUMBER (7-0)
|
|
* SUBQ.W #1,D0
|
|
* RTS
|
|
|
|
* ----------------------
|
|
* OPQFSE
|
|
* ----------------------
|
|
|
|
* FSET? (IS FLAG SET IN OBJ?)
|
|
|
|
OPQFSE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BTST D0,(A0) * IS THE SPECIFIED BIT SET?
|
|
BNE PTRUE * YES, PREDICATE TRUE
|
|
BRA PFALSE * NO, PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPFSET
|
|
* ----------------------
|
|
|
|
* FSET (SET A FLAG IN OBJ)
|
|
|
|
OPFSET BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BSET D0,(A0) * SET THE SPECIFIED BIT
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPFCLE
|
|
* ----------------------
|
|
|
|
* FCLEAR (CLEAR A FLAG IN OBJ)
|
|
|
|
OPFCLE BSR OBJLOC * FIND OBJ'S LOCATION
|
|
MOVE.W D1,D0
|
|
BSR FLGLOC * DETERMINE PROPER FLAGS BYTE & BIT NUMBER
|
|
BCLR D0,(A0) * CLEAR THE SPECIFIED BIT
|
|
RTS
|
|
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* TABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPGET
|
|
* ----------------------
|
|
|
|
* GET (GET THE ITEM'TH WORD FROM TABLE)
|
|
|
|
OPGET ADD.W D1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETWRD * GET THE WORD
|
|
MOVE.W D2,D0
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPGETB
|
|
* ----------------------
|
|
|
|
* GETB (GET THE ITEM'TH BYTE FROM TABLE)
|
|
|
|
OPGETB ADD.W D1,D0 * INDEX INTO TABLE
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BSR GETBYT * GET THE BYTE
|
|
MOVE.W D2,D0
|
|
BRA BYTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPUT
|
|
* ----------------------
|
|
|
|
* NOTE: PROPERTY TABLE POINTERS IN THE NEXT FOUR ROUTINES NOW /MAY/
|
|
* EXCEED 32K, SO SIGN-EXTENSION MUST BE AVOIDED.
|
|
* A "TABLE" ARGUMENT IS A 16-BIT UNSIGNED BYTE POINTER
|
|
|
|
* PUT (REPLACE THE ITEM'TH WORD IN TABLE)
|
|
|
|
OPPUT ADD.W D1,D1 * WORD OFFSET
|
|
ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L BUFFER(A6),A0
|
|
ADD.L D0,A0 * ABSOLUTIZE POINTER
|
|
MOVE.W D2,D0
|
|
BRA PTAWRD * STORE THE WORD
|
|
|
|
* (THIS FAILS IF OFFSET EVER NEG)
|
|
*** EXT.L D1 * ZERO THE HIGH WORD
|
|
*** ADD.W D1,D1 * WORD OFFSET
|
|
*** ADD.W D0,D1 * INDEX INTO TABLE
|
|
|
|
* ----------------------
|
|
* OPPUTB
|
|
* ----------------------
|
|
|
|
* PUTB (REPLACE THE ITEM'TH BYTE IN TABLE)
|
|
|
|
OPPUTB ADD.W D1,D0 * INDEX INTO TABLE
|
|
ANDI.L #$FFFF,D0 * MAKE THE SUM A LONGWORD
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.B D2,0(A0,D0.L) * STORE THE BYTE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPGTPT
|
|
* ----------------------
|
|
|
|
* GETPT (GET POINTER TO PROPERTY TABLE FOR GIVEN OBJ, PROP)
|
|
|
|
OPGTPT BSR OBJLOC * FIND OBJ'S LOCATION
|
|
BSR FSTPRP * GET POINTER TO FIRST PROPERTY
|
|
BRA.S GTPTX2 * SKIP NEXT LINE FIRST TIME THROUGH LOOP
|
|
|
|
GTPTX1 BSR NXTPRP * POINT TO NEXT PROPERTY
|
|
GTPTX2 MOVE.B (A0),D0 * GET (FIRST) PROPERTY ID BYTE
|
|
ANDI.W #PMASK,D0 * CLEAN OFF MODE/LENGTH BITS
|
|
|
|
CMP.W D1,D0 * COMPARE PROPERTY NUMBER WITH DESIRED ONE
|
|
BGT.S GTPTX1 * IF GREATER, LOOP (TABLE SORTED IN REVERSE)
|
|
BEQ.S GTPTX3 * IF EQUAL, GOT IT
|
|
|
|
CLR.W D0 * OTHERWISE, RETURN ZERO FOR NO SUCH PROPERTY
|
|
BRA.S GTPTX5
|
|
|
|
IF EZIP THEN
|
|
GTPTX3 MOVE.B (A0)+,D0 * GET (FIRST) PROPERTY ID BYTE
|
|
BTST #7,D0 * IS THERE A SECOND LENGTH BYTE?
|
|
BEQ.S GTPTX4 * NO
|
|
ADDQ.L #1,A0 * YES, SKIP IT TOO
|
|
ENDIF
|
|
IF CZIP THEN
|
|
|
|
GTPTX3 ADDQ.L #1,A0 * POINT TO PROPERTY VALUE
|
|
ENDIF
|
|
|
|
GTPTX4 MOVE.L A0,D0
|
|
SUB.L BUFFER(A6),D0 * RE-RELATIVIZE POINTER
|
|
GTPTX5 BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPPTSI
|
|
* ----------------------
|
|
|
|
* PTSIZE (GIVEN POINTER TO PROPERTY TABLE, RETURN ITS SIZE)
|
|
|
|
OPPTSI MOVE.L BUFFER(A6),A0
|
|
ANDI.L #$FFFF,D0 * MAKE THE TABLE PTR A LONGWORD
|
|
ADDA.L D0,A0 * ABSOLUTIZE THE TABLE POINTER
|
|
|
|
IF EZIP THEN
|
|
MOVE.B -1(A0),D0 * GET MODE/ID BYTE OR LEN BYTE (EITHER WORKS!)
|
|
BTST #7,D0 * PROPERTY LENGTH GREATER THAN 2?
|
|
BNE.S PTSIX4 * YES
|
|
|
|
BTST #6,D0 * NO, PROPERTY LENGTH 2?
|
|
BNE.S PTSIX2 * YES
|
|
MOVEQ #1,D0 * NO, PROPERTY LENGTH IS 1
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX2 MOVEQ #2,D0
|
|
BRA PUTVAL * RETURN IT
|
|
|
|
PTSIX4 ANDI.W #PMASK,D0 * LENGTH IS LOW 6 BITS
|
|
BRA PUTVAL * RETURN IT
|
|
ENDIF
|
|
IF CZIP THEN
|
|
CLR.W D0
|
|
MOVE.B -1(A0),D0 * GET THE PROP IDENTIFIER BYTE
|
|
ASR.W #5,D0 * EXTRACT LENGTH BITS
|
|
ADDQ.W #1,D0 * ADJUST TO ACTUAL LENGTH
|
|
BRA PUTVAL * RETURN IT
|
|
ENDIF
|
|
|
|
* ----------------------------------------------------------------------------
|
|
* BLOCK OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPINTBL
|
|
* ----------------------
|
|
|
|
* INTBL? (SEARCH TABLE FOR A VALUE)
|
|
|
|
OPINTBL NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * DEFAULT ARGBLK
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
MOVE.W #128+2,ARG4(A1) * DEFAULT -- WORD SEARCH, RECORD LENGTH = 2
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.L A0,A1
|
|
MOVE.W ARG4(A1),D3
|
|
ANDI.W #127,D3 * RECORD LENGTH
|
|
ANDI.W #128,ARG4(A1) * SEARCH MODE BIT -- WORD 1, BYTE 0
|
|
BRA.S ITBX4 * >>> ZERO CHECK <<<
|
|
|
|
ITBX1 MOVE.W ARG2(A1),D0 * RELATIVE BYTE ADDRESS OF TABLE
|
|
BSR BSPLTB * SPLIT IT [D0,D1]
|
|
TST.W ARG4(A1) * WORD SEARCH?
|
|
BEQ.S ITBX2 * NO, BYTE
|
|
BSR GETWRD
|
|
CMP.W ARG1(A1),D2 * MATCH?
|
|
BEQ.S ITBX5 * YES
|
|
BRA.S ITBX3
|
|
ITBX2 BSR GETBYT
|
|
CMP.B ARG1+1(A1),D2 * MATCH?
|
|
BEQ.S ITBX5 * YES
|
|
|
|
ITBX3 ADD.W D3,ARG2(A1) * NO, SKIP TO NEXT RECORD
|
|
ITBX4 SUBQ.W #1,ARG3(A1) * ANY MORE RECORDS?
|
|
BGE.S ITBX1 * YES, CONTINUE SEARCHING
|
|
|
|
CLR.W D0 * FAILED, RETURN ZERO
|
|
BSR PUTVAL
|
|
BRA PFALSE * PREDICATE FALSE
|
|
|
|
ITBX5 MOVE.W ARG2(A1),D0 * SUCCESS, RETURN THE RELATIVE POINTER
|
|
BSR PUTVAL
|
|
BRA PTRUE * PREDICATE TRUE
|
|
|
|
* ----------------------
|
|
* OPCOPYT
|
|
* ----------------------
|
|
|
|
* COPYT (COPY OR CLEAR A TABLE)
|
|
|
|
OPCOPYT NOP * ASK FOR ARGBLK [JUST TO FREE UP REGS]
|
|
MOVE.L A0,A2
|
|
|
|
MOVE.W ARG1(A2),D0
|
|
CMP.W ARG2(A2),D0
|
|
BEQ CPYTX8 * SAME, EXIT
|
|
|
|
MOVE.W ARG3(A2),D1 * CHECK LENGTH:
|
|
BEQ CPYTX8 * ZERO, EXIT
|
|
BGT.S CPYTX1 * POSITIVE
|
|
NEG.W ARG3(A2) * NEGATIVE, MAKE POSITIVE
|
|
|
|
CPYTX1 TST.W ARG2(A2) * DEST
|
|
BEQ.S CPYTX6 * IF ZERO, SPECIAL CASE
|
|
TST.W D1 * WAS LEN NEG?
|
|
BLT.S CPYTX4 * IF SO, DO /NOT/ CHECK FOR OVERLAP
|
|
|
|
*** MOVE.W ARG1(A2),D0 * SRC
|
|
CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"?
|
|
BHI.S CPYTX4 * NO
|
|
|
|
ADD.W ARG3(A2),D0 * MAYBE, SRC END (+1)
|
|
CMP.W ARG2(A2),D0 * ANY "FORWARD OVERLAP"?
|
|
BLS.S CPYTX4 * NO
|
|
|
|
* "FORWARD OVERLAP" DOES EXIST, DO A REVERSE COPY
|
|
|
|
CPYTX2 MOVE.W ARG2(A2),D0 * DEST
|
|
ADD.W ARG3(A2),D0 * END (+1)
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
MOVE.L A0,A1
|
|
|
|
MOVE.W ARG1(A2),D3 * SRC
|
|
ADD.W ARG3(A2),D3 * END (+1)
|
|
|
|
CPYTX3 SUBQ.W #1,D3 * [PREDECREMENT]
|
|
MOVE.W D3,D0
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA
|
|
MOVE.B D2,-(A1) * [PREDECREMENT]
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX3 * LOOP [UNSIGNED TEST]
|
|
RTS
|
|
|
|
* DO A NORMAL COPY
|
|
|
|
CPYTX4 MOVE.W ARG2(A2),D0 * DEST
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
MOVE.L A0,A1
|
|
|
|
MOVE.W ARG1(A2),D0
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
CPYTX5 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = DATA
|
|
MOVE.B D2,(A1)+
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX5 * LOOP [UNSIGNED TEST]
|
|
RTS
|
|
|
|
* NO DEST, JUST CLEAR THE SOURCE TABLE
|
|
|
|
CPYTX6 MOVE.W ARG1(A2),D0 * SRC
|
|
BSR RELABS * ABSOLUTIZE IT [MUST BE PRELOAD]
|
|
CPYTX7 CLR.B (A0)+
|
|
SUBQ.W #1,ARG3(A2)
|
|
BNE.S CPYTX7 * LOOP [UNSIGNED TEST]
|
|
CPYTX8 RTS
|
|
|
|
* ----------------------
|
|
* OPPRNT
|
|
* ----------------------
|
|
|
|
* PRINTT (DISPLAY A TABLE IN BLOCK FORMAT)
|
|
|
|
OPPRNT NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * DEFAULT ARGBLK
|
|
MOVE.W #3,(A1) * 3 ARGS MAX
|
|
MOVE.W #1,ARG3(A1) * DEFAULT # LINES = 1
|
|
BSR SETDEF * SET UP DEFAULT
|
|
MOVE.L A0,A2
|
|
|
|
TST.W ARG2(A2)
|
|
BLE.S PRNTX3 * BAD COL COUNT, EXIT
|
|
TST.W ARG3(A2)
|
|
BLE.S PRNTX3 * BAD ROW COUNT, EXIT
|
|
|
|
BSR PUTLIN * MAKE SURE BUFFER IS EMPTY
|
|
BSR GETCURS
|
|
MOVE.W D1,A1 * INITIAL CURSOR COLUMN -- SAVE HERE
|
|
|
|
* WE NOW USE VIRTUAL MEMORY CALLS TO FETCH TABLE DATA
|
|
|
|
PRNTX1 MOVE.W ARG2(A2),D3 * COLS PER ROW
|
|
MOVE.W ARG1(A2),D0 * TABLE BASE / START OF CURRENT ROW
|
|
BSR BSPLTB * --> D0/D1 = BLK/OFF
|
|
|
|
PRNTX2 BSR GETBYT * --> D0/D1 = NEW BLK/OFF, D2 = CHAR
|
|
EXG D0,D2
|
|
BSR PUTCHR * QUEUE/SCRIPT CHAR, ETC
|
|
EXG D0,D2
|
|
|
|
SUBQ.W #1,D3 * ANY MORE COLS IN THIS ROW?
|
|
BGT.S PRNTX2 * YES, LOOP
|
|
|
|
* BEFORE, WE SAVED THE CURRENT FONT AND ENABLED FONT1, TO BE SURE THE CR
|
|
* WAS CORRECTLY INTERPRETED. BUT (IN OTHER CONTEXTS) IT STILL GOT
|
|
* MISINTERPRETED. NOWADAYS, #13 ALWAYS MEANS CR, REGARDLESS OF CONTEXT
|
|
* (SEE CharOut). A BETTER SOLUTION WILL REQUIRE SOME STICKY RETHINKING.
|
|
|
|
SUBQ.W #1,ARG3(A2) * ANY MORE ROWS IN TABLE?
|
|
BEQ.S PRNTX3 * NO, DONE
|
|
BSR PUTNEW * YES, CR, SCROLL IF NEEDED [PUTCHR #13]
|
|
|
|
MOVEQ #-1,D0 * KEEP CURRENT ROW
|
|
MOVE.W A1,D1 * BUT RESET COLUMN TO ORIGINAL VALUE
|
|
BSR SETCURS
|
|
|
|
MOVE.W ARG2(A2),D0
|
|
ADD.W D0,ARG1(A2) * START OF NEXT LINE
|
|
BRA.S PRNTX1 * LOOP
|
|
PRNTX3 RTS
|
|
|
|
* ----------------------
|
|
* OPPRNF
|
|
* ----------------------
|
|
|
|
* DISPLAY A FORMATTED TABLE (AS FROM 3-ARG DIROUT)
|
|
* >> for now, no formatting (EXCEPT CR'S), just spit it out <<
|
|
|
|
OPPRNF MOVEQ #0,D1
|
|
MOVE.W D0,D1 * TABLE
|
|
MOVE.L BUFFER(A6),A0
|
|
ADD.L D1,A0
|
|
|
|
BSR GTAWRD * GET LENGTH, ADVANCE PTR
|
|
MOVE.L A0,A1
|
|
MOVE.W D0,D1
|
|
BEQ.S PRNFX2 * ZERO, EXIT
|
|
|
|
PRNFX1 MOVE.B (A1)+,D0
|
|
BSR PUTCHR
|
|
SUBQ.W #1,D1
|
|
BGT.S PRNFX1
|
|
PRNFX2 RTS
|
|
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* VARIABLE OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPVALU
|
|
* ----------------------
|
|
|
|
* VALUE (GET VALUE OF VARIABLE)
|
|
|
|
OPVALU BSR GETVAR * GET THE VALUE
|
|
BRA PUTVAL * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPSET
|
|
* ----------------------
|
|
|
|
* SET (VAR TO VALUE)
|
|
|
|
OPSET BRA PUTVAR * STORE THE VALUE
|
|
|
|
* ----------------------
|
|
* OPPUSH
|
|
* ----------------------
|
|
|
|
* PUSH (A VALUE ONTO THE GAME STACK)
|
|
|
|
OPPUSH MOVE.W D0,-(A4) * PUSH THE VALUE
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPXPUSH
|
|
* ----------------------
|
|
|
|
* PUSH (A VALUE ONTO A 'USER STACK')
|
|
|
|
OPXPUSH EXG D0,D1 * SAVE VALUE IN D1
|
|
BSR RELABS * GET A0 -> LTABLE
|
|
BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0
|
|
TST.W D0
|
|
BLE.S XPSHX2 * NO MORE SPACE
|
|
|
|
SUBQ.W #1,D0
|
|
MOVE.L A0,A1
|
|
ADDA.W D0,A1
|
|
ADDA.W D0,A1 * A1 -> FREE SLOT
|
|
|
|
SUBQ.W #2,A0
|
|
BSR PTAWRD * UPDATE LENGTH SLOT
|
|
MOVE.L A1,A0
|
|
MOVE.W D1,D0
|
|
BSR PTAWRD * AND STORE VALUE
|
|
|
|
BRA PTRUE * PREDICATE TRUE
|
|
XPSHX2 BRA PFALSE * PREDICATE FALSE
|
|
|
|
* ----------------------
|
|
* OPPOP
|
|
* ----------------------
|
|
|
|
* POP (A VALUE FROM A STACK, AND RETURN IT [NO LONGER PUTVAR - YZIP] )
|
|
|
|
OPPOP NOP * REQUEST AN ARGBLK
|
|
TST.W (A0) * STACK SUPPLIED?
|
|
BNE.S PPOPX2 * YES
|
|
MOVE.W (A4)+,D0 * NO, POP VAL FROM GAME STACK
|
|
BRA.S PPOPX4
|
|
|
|
PPOPX2 MOVE.W ARG1(A0),D0
|
|
BSR RELABS * GET A0 -> LTABLE
|
|
BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0
|
|
MOVE.L A0,A1
|
|
ADDA.W D0,A1
|
|
ADDA.W D0,A1 * A1 -> LATEST ITEM ON STACK
|
|
|
|
SUBQ.W #2,A0
|
|
ADDQ.W #1,D0
|
|
BSR PTAWRD * UPDATE LENGTH SLOT
|
|
|
|
MOVE.L A1,A0
|
|
BSR GTAWRD * AND GET VALUE
|
|
PPOPX4 BRA PUTVAL * RETURN IT
|
|
|
|
* ----------------------
|
|
* OPINC
|
|
* ----------------------
|
|
|
|
* INC (INCREMENT VAR)
|
|
|
|
OPINC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE THE NEW VALUE
|
|
|
|
* ----------------------
|
|
* OPDEC
|
|
* ----------------------
|
|
|
|
* DEC (DECREMENT VAR)
|
|
|
|
OPDEC MOVE.W D0,D1 * SAVE A COPY HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
BRA PUTVAR * AND STORE NEW VALUE
|
|
|
|
* ----------------------
|
|
* OPQIGR
|
|
* ----------------------
|
|
|
|
* IGRTR? (INCREMENT VAR & TEST IF GREATER THAN VAL)
|
|
|
|
OPQIGR MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
ADDQ.W #1,D0 * INCREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE GREATER THAN VAL?
|
|
BGT.S QIG2 * YES
|
|
QIG1 BSR PUTVAR * NO, STORE THE NEW VALUE
|
|
BRA PFALSE * AND RETURN PREDICATE FALSE
|
|
|
|
QIG2 BSR PUTVAR * STORE THE NEW VALUE
|
|
BRA PTRUE * AND RETURN PREDICATE TRUE
|
|
|
|
* ----------------------
|
|
* OPQDLE
|
|
* ----------------------
|
|
|
|
* DLESS? (DECREMENT VAR & TEST IF LESS THAN VAL)
|
|
|
|
OPQDLE MOVE.W D1,D2 * MOVE VAL HERE
|
|
MOVE.W D0,D1 * COPY VAR HERE
|
|
BSR GETVAR * GET THE VARIABLE'S VALUE
|
|
SUBQ.W #1,D0 * DECREMENT IT
|
|
EXG D0,D1 * POSITION IT
|
|
|
|
CMP.W D2,D1 * NEW VALUE LESS THAN VAL?
|
|
BLT.S QIG2 * YES
|
|
BRA.S QIG1 * NO
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* READ/INPUT OPERATIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* 6/88 -- REGISTER D3 IS BEING TRASHED; TRY TO PINPOINT IT
|
|
|
|
IF D3BUG THEN
|
|
D3CHK
|
|
* [IF BEING CALLED OUTSIDE OF OPREAD, FIRST CHECK THAT "LAST OP WAS OPREAD"]
|
|
CMP.L #$1111EEEE,D6
|
|
BNE.S D3X9
|
|
|
|
CMP.W D3,D7 * [CORRECT VAL SAVED IN D7]
|
|
BEQ.S D3X9
|
|
DATA
|
|
MSGD3C DC.B 'D3 munged in READ',0
|
|
CODE
|
|
MOVEM.L D0/A0,-(SP) * SPECIAL ROUTINE: SAVE /ALL/ REGS
|
|
LEA MSGD3C,A0
|
|
BSR ZWARN * SHOW A WARNING
|
|
|
|
BSR TTYIN * PAUSE FOR DEBUGGING
|
|
MOVEM.L (SP)+,D0/A0
|
|
MOVE.W D7,D3 * "FIX IT UP"
|
|
D3X9 RTS
|
|
ENDIF
|
|
|
|
* ------------------------------
|
|
* OPREAD
|
|
* ------------------------------
|
|
|
|
* READ (A LINE OF INPUT AND MASTICATE IT)
|
|
|
|
OPREAD NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
CLR.W ARG2(A1) * DEFAULT LEXV -- ZERO MEANS DON'T
|
|
MOVE.W #-1,ARG3(A1) * DEFAULT TIMOUT INTERVAL -- NEG MEANS DON'T
|
|
CLR.W ARG4(A1) * DEFAULT TIMOUT HANDLER FUNCTION
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
ADDQ.L #2,A0 * SKIP COUNT SLOT
|
|
MOVE.W (A0)+,D0 * INBUF
|
|
MOVE.W (A0)+,D3 * [LEXV]
|
|
IF D3BUG THEN
|
|
MOVE.W D3,D7
|
|
MOVE.L #$1111EEEE,D6 * MARK D6
|
|
ENDIF
|
|
MOVE.W (A0)+,TWAIT(A6) * [TIME]
|
|
MOVE.W (A0)+,TFUNC(A6) * [HANDLER]
|
|
|
|
BSR RELABS * ABSOLUTIZE THE INBUF PTR
|
|
MOVE.L A0,A2 * KEEP IT HERE
|
|
BSR TRESET * RESET THE TIMER, IF NEEDED
|
|
|
|
IF CZIP THEN
|
|
MOVEM.L D3/A2,-(SP)
|
|
BSR OPUSL * UPDATE STATUS LINE
|
|
MOVEM.L (SP)+,D3/A2
|
|
ENDIF
|
|
|
|
MOVE.L CURWP(A6),A0
|
|
CLR.W WLCNT(A0) * RESET COUNTER (PREVENTS A SPURIOUS [MORE])
|
|
BSR PUTLIN1 * THEN FORCE OUT ANY QUEUED TEXT (THE PROMPT)
|
|
|
|
IF D3BUG THEN
|
|
BSR D3CHK
|
|
ENDIF
|
|
|
|
*** GATHER AND LOWER-CASIFY THE INPUT LINE ...
|
|
|
|
MOVE.L A2,A0 * START OF INPUT LINE BUFFER
|
|
MOVEQ #0,D0
|
|
MOVE.B (A0)+,D0 * 1ST HEADER BYTE == MAX LENGTH
|
|
MOVEQ #0,D1
|
|
MOVE.B (A0)+,D1 * 2ND HEADER BYTE == CURRENT LEN
|
|
BSR READLN * GET IT
|
|
|
|
IF D3BUG THEN
|
|
BSR D3CHK
|
|
MOVEQ #0,D6 * UNMARK D6
|
|
ENDIF
|
|
|
|
MOVE.W D0,D2 * RETURN D0: TERM CHAR
|
|
MOVE.L A0,D0 * RETURN A0: END OF ACTUAL INPUT (+1)
|
|
MOVE.L A2,A0
|
|
ADDQ.L #2,A0 * START OF INPUT, SKIP HEADER
|
|
|
|
SUB.L A0,D0 * NEW TOTAL LENGTH
|
|
MOVE.B D0,1(A2) * STORE THE NEW LENGTH IN THE HEADER
|
|
BSR LCASE * AND LOWER-CASIFY EVERYTHING
|
|
|
|
*** TOKENIZE AND LOOKUP THE INPUT ...
|
|
|
|
MOVE.W D3,D0 * LEXV ARG
|
|
BEQ.S RDX4 * ZERO MEANS EXIT IMMEDIATELY
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A3
|
|
|
|
MOVE.L VOCTAB(A6),A1 * OPREAD: USE "STANDARD" VOCAB TABLE
|
|
MOVEQ #0,D1 * OPREAD: NO PRESERVE FLAG
|
|
BSR LEX
|
|
|
|
RDX4 MOVE.W D2,D0
|
|
BRA BYTVAL * RETURN THE TERM CHARACTER
|
|
|
|
* ------------------------------
|
|
* OPLEX
|
|
* ------------------------------
|
|
|
|
* TOKENIZE AND LOOKUP A LINE OF INPUT
|
|
* (FIND EACH WORD, CONVERT IT TO ZWORD, AND STORE OFFSET INFO IN LEXV)
|
|
|
|
OPLEX NOP * USE AN ARGUMENT BLOCK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
CLR.W ARG3(A1) * DEFAULT VOC TABLE (FLAG)
|
|
CLR.W ARG4(A1) * DEFAULT PRESERVE FLAG = OFF
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.L A0,A1 * ARGBLK
|
|
TST.W (A1)+ * SKIP ACTUAL ARG COUNT (NOT NEEDED)
|
|
MOVE.W (A1)+,D0 * ARG1 == INBUF
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A2 * AND PASS IT HERE
|
|
MOVE.W (A1)+,D0 * ARG2 == LEXV
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,A3 * AND PASS IT HERE
|
|
|
|
MOVE.L VOCTAB(A6),A0 * "STANDARD" VOCTAB
|
|
MOVE.W (A1)+,D0 * USE A SPECIAL VOCTAB?
|
|
BEQ.S LXX0 * NO
|
|
BSR RELABS * YES, ABSOLUTIZE
|
|
LXX0 EXG A0,A1 * PASS VOCTAB IN A1
|
|
MOVE.W (A0)+,D1 * AND PASS "PRESERVE" FLAG HERE
|
|
|
|
* INTERNAL ENTRY POINT
|
|
* GIVEN A1 -> VOCAB TABLE, A2 -> INBUF, A3 -> LEXV, D1 = PRESERVE FLAG
|
|
|
|
LEX MOVE.L D2,-(SP)
|
|
MOVE.L A1,A0
|
|
BSR INITLX * SETUP VOCAB VARS (FOR LOOKUP)
|
|
|
|
MOVE.L A2,RDBOS(A6) * REMEMBER INPUT BUFFER BASE
|
|
MOVEQ #0,D0
|
|
MOVE.B 1(A2),D0 * >> ACTUAL LEN OF INPUT <<
|
|
ADDQ.L #2,A2 * SKIP HEADER (MAX LEN, CUR LEN)
|
|
ADD.L A2,D0
|
|
MOVE.L D0,RDEOS(A6) * REMEMBER END OF INPUT
|
|
|
|
MOVE.L A3,RDRET(A6) * REMEMBER RETURN BUFFER BASE
|
|
CLR.B 1(A3) * BUFFER INITIALLY EMPTY
|
|
ADDQ.L #2,A3 * SKIP HEADER (MAX WORDS, NWORDS)
|
|
|
|
* LOOP STARTS HERE, A2 -> CURRENT INBUF, A3 -> CURRENT LEXV
|
|
|
|
LXX2 MOVE.L A2,A0 * CURRENT INPUT START
|
|
MOVE.L RDEOS(A6),D0
|
|
SUB.L A2,D0 * CURRENT REMAINING LENGTH
|
|
BEQ.S LXX8 * NOTHING, EXIT
|
|
BSR ZWSTR * FIND NEXT WORD, AND CONVERT IT
|
|
|
|
MOVE.L A0,A2 * RETURN: START OF CURRENT WORD
|
|
MOVE.W D0,D2 * RETURN: LENGTH OF CURRENT WORD, OR ZERO
|
|
BEQ.S LXX8 * NOTHING, EXIT
|
|
|
|
*** BUILD THE LEX (RETURN) TABLE ...
|
|
|
|
MOVE.L RDRET(A6),A0 * RETURN TABLE POINTER
|
|
MOVE.B (A0)+,D0 * MAX WORDS ALLOWED
|
|
CMP.B (A0),D0 * ROOM FOR ANOTHER?
|
|
BEQ.S LXX6 * NO, ERROR
|
|
ADDQ.B #1,(A0) * INCREMENT FOUND-WORD COUNT
|
|
|
|
LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE
|
|
BSR LOOKUP * SEARCH VOCAB TABLE FOR IT, RETURN OFFSET
|
|
TST.W D0 * WORD FOUND?
|
|
BNE.S LXX3 * YES
|
|
TST.W D1 * NO, PRESERVE OLD INFO? >> OFFSET ONLY <<
|
|
BNE.S LXX4 * YES
|
|
|
|
LXX3 MOVE.L A3,A0 * CURRENT RETURN SLOT
|
|
BSR PTAWRD * STORE THE OFFSET IN RETURN TABLE
|
|
|
|
LXX4 MOVE.B D2,2(A3) * STORE WORD LENGTH IN RETURN TABLE
|
|
MOVE.L A2,D0
|
|
SUB.L RDBOS(A6),D0 * CALCULATE STARTING BYTE OFFSET OF WORD
|
|
MOVE.B D0,3(A3) * STORE IT TOO
|
|
|
|
ADDQ.L #4,A3 * ADVANCE RETURN TABLE PTR
|
|
ADDA.W D2,A2 * ADVANCE INPUT PTR
|
|
BRA LXX2 * GO FOR THE NEXT WORD
|
|
|
|
*** ERROR, RETURN BUFFER IS FULL, TELL USER, THEN EXIT
|
|
|
|
LXX6 MOVE.L A2,A0 * START OF FLUSHED STRING
|
|
MOVE.L RDEOS(A6),A1 * END (+1)
|
|
BSR RDERR * ECHO IT IN ERROR MESSAGE
|
|
|
|
LXX8 MOVE.L (SP)+,D2 * CLEAN UP AND EXIT
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* OPZWSTR
|
|
* ------------------------------
|
|
|
|
* IDENTIFY THE NEXT WORD (START/END), AND CONVERT IT TO A ZWORD
|
|
|
|
OPZWSTR
|
|
ADD.W D2,D0 * INPUT BUFFER: BASE + OFFSET
|
|
BSR RELABS * ABSOLUTIZE IT
|
|
MOVEQ #VCHARS,D0 * MAX LEN -- IGNORE 2ND ARG (SPEC ERROR)
|
|
BSR ZWSTR * GO FOR IT
|
|
|
|
* (IGNORE RETURNED INFO; WE'RE INTERESTED IN INITIAL WORD ONLY)
|
|
|
|
MOVE.W D3,D0 * REQUESTED ZWORD BUFFER
|
|
BSR RELABS * ABSOLUTIZE IT
|
|
MOVE.L A0,A1
|
|
LEA RDZSTR(A6),A0 * ZWORD WAS LEFT HERE
|
|
MOVEQ #ZCHARS,D0
|
|
BRA COPYB * COPY ZWORD TO FINAL DEST, AND EXIT
|
|
|
|
* INTERNAL ENTRY POINT
|
|
* GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH (TOTAL)
|
|
* RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO
|
|
|
|
ZWSTR BSR FINDBK * FIND NEXT BREAK CHAR
|
|
TST.W D0
|
|
BEQ.S ZWSX1 * EXIT IF NOTHING
|
|
|
|
MOVEM.L D0-D1/A0-A1,-(SP) * SAVE RESULTS
|
|
LEA RDWSTR(A6),A1 * TEMP STRING BUFFER
|
|
MOVEQ #VCHARS,D1 * MAX LENGTH
|
|
BSR COPYS * COPY FIRST WORD, MAKE ASCIZ
|
|
|
|
LEA RDWSTR(A6),A1
|
|
LEA RDZSTR(A6),A0 * TEMP OUTPUT BUFFER
|
|
BSR ZWORD * CONVERT STRING, LEAVE ZWORD IN BUFFER
|
|
MOVEM.L (SP)+,D0-D1/A0-A1 * RESTORE RESULTS
|
|
ZWSX1 RTS
|
|
|
|
* ------------------------------
|
|
* OPINPUT
|
|
* ------------------------------
|
|
|
|
* WAIT FOR A KEY (NO ECHO), HANDLE OPTIONAL TIMEOUTS
|
|
|
|
OPINPUT NOP * USE ARGBLK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #3,(A1) * 3 ARGS MAX
|
|
MOVE.W #-1,ARG2(A1) * DEFAULT TIMOUT INTERVAL -- "DON'T"
|
|
CLR.W ARG3(A1) * DEFAULT TIMOUT HANDLER FUNCTION
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
ADDQ.L #ARG2,A0 * SKIP COUNT AND DEVICE
|
|
MOVE.W (A0)+,TWAIT(A6) * DELAY IN 1/10'S SECOND
|
|
MOVE.W (A0)+,TFUNC(A6) * FUNCTION TO CALL UPON TIMEOUT
|
|
BSR TRESET * RESET THE TIMER, IF NEEDED
|
|
|
|
MOVE.L CURWP(A6),A0
|
|
CLR.W WLCNT(A0) * RESET COUNTER, PREVENTS A SPURIOUS [MORE]
|
|
TST.W VOBUFF(A6) * BUFFERED OUTPUT?
|
|
BEQ.S INPX1 * NO
|
|
BSR PUTLIN * YES, EMPTY THE BUFFER
|
|
|
|
INPX1 MOVEQ #0,D0 * SINGLE CHAR [SUPPRESS MENU CMD-STRINGS]
|
|
BSR INPUT * GET KEY
|
|
CMPI.B #1,D0 * CONTINUE AFTER TIMEOUT?
|
|
BEQ.S INPX1 * YES
|
|
BRA BYTVAL * OTHERWISE, RETURN KEY
|
|
|
|
* INTERNAL ENTRY POINT >> CALLED ALSO FROM READLN; HANDLES TIMEOUTS <<
|
|
* GIVEN D0.W = LINE-INPUT FLAG (ZERO IF SINGLE-CHAR INPUT)
|
|
* WAIT FOR A KEY, RETURN D0.B = VALUE
|
|
* IN CASE OF A TIMEOUT, RETURN D0.B = 0 (ABORT) OR 1 (KEEP WAITING)
|
|
* IF WAITING, RETURN D0 (HI WORD) = NONZERO TO REDRAW INPUT LINE
|
|
|
|
INPUT MOVEM.L D1-D2,-(SP)
|
|
MOVE.W D0,D2 * SAVE FLAG HERE
|
|
MOVEQ #1,D0 * START OF INPUT
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
|
|
INPX4 BSR GAMINT1 * CHECK FOR GAME INTERRUPT (SOUND, ETC)
|
|
BSR ITTYIN * CHECK FOR A KEY << DON'T WAIT! >>
|
|
TST.B D0 * GOT ONE?
|
|
BEQ.S INPX6 * NOTHING YET
|
|
|
|
MOVE.W D0,-(SP)
|
|
CLR.W D0 * END OF INPUT
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
MOVE.W (SP)+,D0
|
|
BRA.S INPX8 * EXIT WITH KEY
|
|
|
|
INPX6 TST.W TWAIT(A6) * TIMOUTS IN EFFECT?
|
|
BLT.S INPX4 * NO, JUST LOOP
|
|
BSR TCHECK * TIME (10'S) REMAINING BEFORE NEXT TIMEOUT
|
|
TST.W D0 * HAS IT RUN OUT?
|
|
BGT.S INPX4 * NO, CONTINUE LOOP
|
|
|
|
BSR TNEXT * YES: UPDATE TIMER
|
|
CLR.W D0 * END OF INPUT (FOR THE MOMENT...)
|
|
MOVE.W D2,D1 * CHAR/LINE
|
|
BSR SETUPI
|
|
|
|
BSR GETCURS
|
|
MOVE.W D1,D2 * REMEMBER CURRENT CURSOR POS (COLUMN)
|
|
|
|
MOVE.W TFUNC(A6),D0 * TIMEOUT FUNCTION
|
|
BSR INCALL * CALL IT (INTERNALLY)
|
|
TST.W D0 * IT RETURNS A BOOLEAN -- ABORT INPUT?
|
|
BNE.S INPX7 * YES
|
|
|
|
BSR GETCURS
|
|
SUB.W D2,D1 * DID CURSOR POS (COLUMN) CHANGE?
|
|
MOVE.W D1,D0 * ZERO IF NO
|
|
SWAP D0 * RETURN THIS FLAG IN HIGH WORD
|
|
MOVE.W #1,D0 * 1 MEANS KEEP WAITING
|
|
BRA.S INPX8
|
|
|
|
INPX7 MOVEQ #0,D0 * NULL CHAR MEANS ABORT INPUT
|
|
INPX8 MOVEM.L (SP)+,D1-D2
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPMSINFO
|
|
* ----------------------
|
|
|
|
* GET MOUSE STATUS
|
|
|
|
OPMSINFO
|
|
BSR RELABS
|
|
MOVE.L A0,A1 * RETURN VALS IN TABLE
|
|
BSR GETMOUSE
|
|
|
|
MOVE.L A1,A0
|
|
BSR PTAWRD * STORE YPOS
|
|
MOVE.W D1,D0
|
|
BSR PTAWRD * STORE XPOS
|
|
MOVE.W D2,D0
|
|
BSR PTAWRD * STORE BUTTON STATUS
|
|
MOVE.W D3,D0
|
|
BRA PTAWRD * STORE MENU/ITEM CODE
|
|
|
|
* ----------------------
|
|
* OPMSLMT
|
|
* ----------------------
|
|
|
|
* SET MOUSE LIMITS (WINDOW)
|
|
|
|
OPMSLMT MOVE.W D0,MSWIND(A6) * UPDATE MOUSE-LIMIT WINDOW ...
|
|
RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* READ/INPUT PRIMITIVES
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ------------------------------
|
|
* READLN
|
|
* ------------------------------
|
|
|
|
* GATHER A LINE OF INPUT
|
|
* GIVEN A0 -> INPUT BUFFER, D0 = MAX LENGTH, D1 = CURRENT LENGTH
|
|
* RETURN A0 -> END OF ACTUAL INPUT (+1), D0 = TERM CHAR
|
|
|
|
EOLCHR EQU $0D * CARRIAGE RETURN
|
|
DELCH1 EQU $08 * BACKSPACE
|
|
DELCH2 EQU $7F * ALSO ACCEPT "DELETE"
|
|
|
|
READLN MOVEM.L D1-D2/A1-A3,-(SP)
|
|
MOVE.L A0,A1 * A1 -> START
|
|
MOVE.L A0,A2
|
|
ADDA.W D1,A2 * A2 -> CURRENT POSITION (MAY BE FULL)
|
|
MOVE.L A0,A3
|
|
ADDA.W D0,A3 * A3 -> END (+1)
|
|
|
|
RDLX1 MOVE.L BUFFER(A6),A0
|
|
MOVE.W PTCHARS(A0),D0 * TABLE OF TERMINATING CHARS
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVE.L A0,D2 * KEEP PTR HERE
|
|
|
|
*** WAIT FOR A KEY, CHECK FOR A TCHAR ...
|
|
|
|
RDLX2 MOVEQ #1,D0 * LINE INPUT [ALLOW MENU CMD-STRINGS]
|
|
BSR INPUT * NO ECHO, HANDLE TIMEOUTS
|
|
IF D3BUG THEN
|
|
BSR D3CHK
|
|
ENDIF
|
|
*** BSR TTYIN
|
|
TST.B D0 * WAS THERE A TIME-OUT AND AN ABORT?
|
|
BEQ.S RDLX10 * YES, BREAK
|
|
CMPI.B #1,D0 * WAS THERE A TIME-OUT WITHOUT AN ABORT?
|
|
BEQ.S RDLX9A * YES, DO INPUT-ECHO HACK
|
|
CMPI.B #EOLCHR,D0 * CR?
|
|
BEQ.S RDLX10 * YES, BREAK
|
|
|
|
MOVE.L D2,A0 * TCHARS TABLE
|
|
MOVEQ #0,D1 * FLAG FOR "FUNCTION-KEY TCHARS"
|
|
RDLX4 CMPI.B #255,(A0) * CONSIDER ALL FKEYS TO BE TCHARS?
|
|
BNE.S RDLX5 * NO
|
|
MOVEQ #1,D1 * YES, SET FLAG
|
|
RDLX5 CMP.B (A0),D0 * CHECK TABLE FOR THIS CHAR
|
|
BEQ.S RDLX10 * >> FOUND IT, BREAK <<
|
|
TST.B (A0)+ * END OF TABLE?
|
|
BNE RDLX4 * NO, CONTINUE SEARCH
|
|
|
|
* LAST CHANCE TO BE A TCHAR ...
|
|
|
|
CMPI.B #127,D0 * SPECIAL CASE: IS THIS CHAR AN FKEY?
|
|
BLS.S RDLX6 * NO
|
|
|
|
TST.W D1 * YES: "FUNCTION-KEY TCHARS" ACTIVE?
|
|
BNE.S RDLX10 * YES, BREAK
|
|
BRA.S RDLX9 * RDLX2 * NO >> REJECT KEY <<
|
|
|
|
* NOT A TCHAR, CHECK FOR A BACKSPACE ...
|
|
|
|
RDLX6 CMPI.B #DELCH1,D0 * BACKSPACE?
|
|
BEQ.S RDLX8 * YES
|
|
CMPI.B #DELCH2,D0 * DELETE?
|
|
BEQ.S RDLX8 * YES
|
|
|
|
*** NORMAL CHARACTER, HANDLE IT ...
|
|
|
|
CMPA.L A3,A2 * BUFFER OVERFLOW?
|
|
BCC.S RDLX9 * BHS * YES, IGNORE CHAR, JUST BEEP
|
|
|
|
MOVE.B D0,(A2)+ * STORE CHAR
|
|
BSR TTYOUT * AND ECHO IT
|
|
BRA.S RDLX2
|
|
|
|
* HANDLE A BACKSPACE
|
|
|
|
RDLX8 CMPA.L A1,A2 * BUFFER UNDERFLOW?
|
|
BLS.S RDLX9 * YES, JUST BEEP
|
|
|
|
SUBQ.L #1,A2 * NO, BACK UP BUFFER POINTER
|
|
MOVE.B (A2),D0 * (PASS PREVIOUS CHAR IN HIGH BYTE)
|
|
LSL.W #8,D0
|
|
MOVE.B #DELCH1,D0
|
|
BSR TTYOUT * AND ECHO A BS
|
|
BRA RDLX2
|
|
|
|
* ERROR, BEEP -- BUFFER TOO FULL/EMPTY. DISCARD CHAR, NO ECHO.
|
|
|
|
RDLX9
|
|
*** MOVEQ #1,D0
|
|
*** BSR DOSOUND
|
|
BSR ZBEEP * BEEP AT USER
|
|
IF D3BUG THEN
|
|
BSR D3CHK
|
|
ENDIF
|
|
BRA RDLX2 * AND KEEP WAITING
|
|
|
|
* TIMEOUT OCCURRED (NO ABORT)
|
|
* RE-ECHO ENTIRE INPUT LINE, BUT ONLY IF GAME WROTE AFTER THE OLD ONE
|
|
* WE ASSUME GAME PRINTED A FRESH CR, AND A PROMPT (>) IF NEEDED
|
|
* >> MAJOR KLUDGE, DEAD IN YZIP <<
|
|
|
|
RDLX9A
|
|
** SWAP D0 * "REDRAW" FLAG IS IN HIGH HALF OF REGISTER
|
|
** TST.W D0 * DID CURSOR POSITION CHANGE DURING TIMEOUT?
|
|
** BEQ RDLX2 * NO, DON'T REDRAW
|
|
|
|
** MOVE.L A1,-(SP) * SAVE START PTR
|
|
** BRA.S RDLX9C
|
|
** X9B MOVE.B (A1)+,D0
|
|
** BSR TTYOUT * ECHO ONE-AT-A-TIME, SO WILL WRAP IF NEEDED
|
|
** X9C CMPA.L A2,A1 * ANY MORE?
|
|
** BLT.S RDLX9B * YES
|
|
** MOVE.L (SP)+,A1
|
|
BRA RDLX2 * START WAITING AGAIN
|
|
|
|
*** DONE, HANDLE THE TERMINATING CHAR <<< DON'T STORE IN BUFFER >>>
|
|
|
|
RDLX10 MOVE.W D0,D2 * SAVE TCHAR
|
|
CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN?
|
|
BNE.S RDLX12 * NO >>> SKIP THE ECHO? <<<
|
|
BSR TTYOUT * YES, ECHO IT
|
|
|
|
RDLX12 CMPA.L A3,A2 * ANY ROOM LEFT?
|
|
BCC.S RDLX14 * BHS * NO (SIGH)
|
|
CLR.B (A2) * INPUT SHOULD BE FOLLOWED BY A BREAK (ZWSTR)
|
|
|
|
* ADJUST THE [MORE] COUNTER AFTER MULTI-LINE INPUT
|
|
* (DEAD; WAS VERY KLUDGY. NOW ADJUST FOR 1 LINE MAX)
|
|
|
|
RDLX14 CMPI.B #EOLCHR,D2 * WAS THE CHAR A RETURN?
|
|
BNE.S RDLX20 * NO
|
|
RDLX16 MOVE.L CURWP(A6),A0
|
|
*** MOVEQ #0,D0
|
|
*** MOVE.B WFONTYX(A0),D0 * VERTICAL LINE SIZE
|
|
*** ADD.W D0,WLCNT(A0) * BUMP THE [MORE] COUNTER
|
|
ADDQ.W #1,WLCNT(A0)
|
|
|
|
* SCRIPT THE USER INPUT LINE (IF SCRIPTING IS ACTIVE)
|
|
* AVOID PROBLEMS WITH BACKSPACES, BY WAITING UNTIL INPUT IS COMPLETE
|
|
* [DEAD -- YZIP]
|
|
RDLX20
|
|
* MOVEQ #0,D1
|
|
*** CMPI.B #EOLCHR,D2 * BUT WAS THE CHAR A RETURN?
|
|
*** BNE.S RDLX22 * NO, AVOID SCRIPTING [XZIP]
|
|
*** MOVEQ #1,D1 * YES, (AND ADD A CR)
|
|
|
|
*** MOVE.L A1,A0 * START OF LINE
|
|
*** MOVE.L A2,D0
|
|
*** SUB.L A1,D0 * LENGTH
|
|
*** BSR SCRINP
|
|
|
|
RDLX22 MOVE.W D2,D0 * RETURN TERM CHAR
|
|
MOVE.L A2,A0 * RETURN END-OF-INPUT (+1) POINTER
|
|
MOVEM.L (SP)+,D1-D2/A1-A3
|
|
RTS
|
|
|
|
* ---------------------------
|
|
* LCASE
|
|
* ---------------------------
|
|
|
|
* LOWER-CASIFY A LINE OF INPUT, A0 -> INPUT, D0.W = LEN
|
|
|
|
LCASE BRA.S LCSX3
|
|
LCSX1 CMPI.B #'A',(A0) * UPPERCASE CHAR?
|
|
BLT.S LCSX2 * NO
|
|
CMPI.B #'Z',(A0) * MAYBE?
|
|
BGT.S LCSX2 * NO
|
|
ADDI.B #32,(A0) * YES, LOWER-CASIFY IT
|
|
LCSX2 ADDQ.L #1,A0
|
|
LCSX3 DBF D0,LCSX1 * ZERO CHECK << ENTRY POINT >>
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* FINDBK
|
|
* ------------------------------
|
|
|
|
* FIND THE NEXT BREAK CHARACTER
|
|
* GIVEN A0 -> INPUT START, D0.W = INPUT LENGTH
|
|
* RETURN A0 -> FIRST WORD START, D0.W = FIRST WORD LENGTH, OR ZERO
|
|
|
|
FINDBK MOVEM.L D1/A1-A3,-(SP)
|
|
MOVE.L A0,A2
|
|
ADDA.W D0,A2 * END OF INPUT (+1)
|
|
CLR.W D1 * COUNT OF SIGNIFICANT CHARS
|
|
|
|
FBX1 MOVE.L A0,A1 * REMEMBER START OF CURRENT WORD
|
|
FBX2 CMPA.L A0,A2 * END OF INPUT STRING?
|
|
BEQ.S FBX8 * YES
|
|
MOVE.B (A0)+,D0 * NO, PICK UP NEXT CHAR
|
|
|
|
MOVE.L RBRKS(A6),A3 * LIST OF READ-BREAK CHARACTERS
|
|
CMPI.B #127,D0 * BUT IS THIS A FUNCTION KEY?
|
|
BHI.S FBX6 * YES, CONSIDER IT A S.I. BREAK (?)
|
|
FBX4 CMP.B (A3),D0 * SEARCH LIST FOR CHAR << XZIP: "NULL" TOO >>
|
|
BEQ.S FBX6 * FOUND IT
|
|
TST.B (A3)+ * END OF (ASCIZ) LIST?
|
|
BNE FBX4 * NO, CONTINUE SEARCH
|
|
ADDQ.W #1,D1 * YES, NOT A BREAK, BUMP COUNT
|
|
BRA FBX2
|
|
|
|
*** BREAK CHAR FOUND ...
|
|
|
|
FBX6 TST.W D1 * WORD READ /BEFORE/ THIS BREAK?
|
|
BNE.S FBX8 * YES, GO FOR IT
|
|
CMPA.L ESIBKS(A6),A3 * NO, BUT WAS THIS A SELF-INSERTING BREAK?
|
|
BCC.S FBX1 * BHS * NO, JUST SKIP IT, LOOP FOR NEXT
|
|
ADDQ.W #1,D1 * YES, BUMP COUNT AND GO FOR ZWORD
|
|
|
|
*** CLEAN UP AND EXIT ...
|
|
|
|
FBX8 MOVE.L A1,A0 * RETURN START OF CURRENT WORD
|
|
MOVE.W D1,D0 * RETURN LENGTH OF CURRENT WORD
|
|
MOVEM.L (SP)+,D1/A1-A3
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* RDERR
|
|
* ------------------------------
|
|
|
|
* TOO MANY WORDS FOUND IN THE INPUT BUFFER, INFORM LOSER
|
|
* A0 -> START OF EXCESS INPUT, A1 -> END OF INPUT (+1)
|
|
|
|
RDERR MOVE.L A0,-(SP) * SAVE ARG HERE
|
|
BSR PUTNEW
|
|
LEA MSGIO1,A0
|
|
BSR OUTMSG0 * '[Too many words ... "'
|
|
DATA
|
|
MSGIO1 DC.B '[Too many words typed, discarding ',$22,0
|
|
CODE
|
|
|
|
MOVE.L (SP)+,A0 * START OF FLUSHED WORD/STRING
|
|
MOVE.B (A1),-(SP) * SAVE TERMINAL BYTE, TO BE SAFE
|
|
CLR.B (A1) * MAKE STRING ASCIZ
|
|
BSR OUTMSG0 * ECHO IT
|
|
MOVE.B (SP)+,(A1) * RESTORE THIS BYTE
|
|
|
|
LEA MSGIO2,A0
|
|
BSR OUTMSG * '."]'
|
|
DATA
|
|
MSGIO2 DC.B '.',$22,']',0
|
|
CODE
|
|
|
|
BSR PUTNEW * FINAL CR
|
|
RTS
|
|
|
|
* ---------------------------
|
|
* INITLX
|
|
* ---------------------------
|
|
|
|
* INIT VOCABULARY VARS, GIVEN A VOCAB TABLE POINTER IN A0
|
|
* (CALLED AT BEGINNING OF EACH "LEX" CALL)
|
|
|
|
INITLX MOVEM.L D1-D2/A1-A2,-(SP)
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * THIS BYTE IS THE # OF SI BREAKS
|
|
ADDA.W D0,A0 * SKIP THEM (READ DURING STARTUP ONLY)
|
|
|
|
CLR.W D0
|
|
MOVE.B (A0)+,D0 * THIS BYTE IS THE LENGTH OF EACH VOCTAB ENTRY
|
|
MOVE.W D0,VWLEN(A6) * SAVE IT
|
|
|
|
MOVE.B (A0)+,D0 * THIS WORD IS # OF VOCTAB ENTRIES
|
|
ASL.W #8,D0
|
|
MOVE.B (A0)+,D0
|
|
MOVE.L A0,VOCBEG(A6) * THIS IS BEGINNING OF ACTUAL VOCABULARY
|
|
|
|
TST.W D0 * IF POSITIVE #, TABLE IS SORTED
|
|
BGT.S INLX4
|
|
NEG.W D0 * OTHERWISE, NOT SORTED, POSITIVIZE COUNT
|
|
CLR.W D1 * AND INDICATE UNSORTED TABLE
|
|
BRA.S INLX6
|
|
|
|
* SORTED TABLE -- CALCULATE INITIAL OFFSET FOR BINARY SEARCH
|
|
|
|
INLX4 MOVE.W D0,D2
|
|
MOVE.W VWLEN(A6),D1 * NUMBER OF BYTES PER VOCAB ENTRY
|
|
ASR.W #1,D2
|
|
INLX5 ASL.W #1,D1
|
|
ASR.W #1,D2
|
|
BNE INLX5
|
|
MOVE.W D1,VWBOFF(A6) * SAVE INITIAL BINARY SEARCH OFFSET
|
|
|
|
MOVEQ #1,D1 * INDICATE A SORTED TABLE
|
|
INLX6 MOVE.W D0,VWORDS(A6) * SAVE COUNT
|
|
MOVE.W D1,VWSORT(A6) * SAVE FLAG
|
|
|
|
SUBQ.W #1,D0
|
|
MULS VWLEN(A6),D0
|
|
ADD.L VOCBEG(A6),D0 * CALCULATE POINTER TO LAST ENTRY
|
|
MOVE.L D0,VOCEND(A6) * SAVE IT
|
|
|
|
MOVEM.L (SP)+,D1-D2/A1-A2
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* LOOKUP
|
|
* ------------------------------
|
|
|
|
* SEARCH (CURRENT) VOCAB TABLE FOR A ZWORD, POINTER TO ZWORD IN A0
|
|
* RETURN ZWORD'S TABLE ADDR (RELATIVIZED) IN D0.W, NULL IF NOT FOUND
|
|
|
|
LOOKUP MOVEM.L D1/A1-A3,-(SP)
|
|
MOVE.L A0,A3 * SAVE POINTER TO GIVEN ZWORD HERE
|
|
MOVE.L VOCBEG(A6),A2 * BEGINNING OF (CURRENT) VOCABULARY TABLE
|
|
|
|
TST.W VWORDS(A6) * EMPTY TABLE?
|
|
BEQ.S LKX14 * YES, RETURN ZERO
|
|
TST.W VWSORT(A6) * SORTED TABLE?
|
|
BNE.S LKX2 * YES
|
|
|
|
LKX1 MOVE.L A2,A0 * NO, MUST DO LINEAR SEARCH
|
|
MOVE.L A3,A1
|
|
BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD
|
|
BEQ.S LKX12 * SAME, WE'VE FOUND IT
|
|
|
|
ADDA.W VWLEN(A6),A2 * NEXT TABLE ITEM
|
|
CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE?
|
|
BLS LKX1 * NO
|
|
BRA.S LKX14 * YES, WORD NOT FOUND, RETURN ZERO
|
|
|
|
*** SORTED TABLE
|
|
|
|
LKX2 MOVE.W VWBOFF(A6),D1 * INITIAL OFFSET FOR BINARY SEARCH
|
|
ADDA.W D1,A2 * INITIAL POINTER INTO TABLE
|
|
SUBA.W VWLEN(A6),A2 * AVOID FENCE-POST BUG, EXACT-POWER-OF-2 TABLE
|
|
|
|
LKX4 ASR.W #1,D1 * NEXT OFFSET WILL BE HALF OF PREVIOUS ONE
|
|
MOVE.L A2,A0
|
|
MOVE.L A3,A1
|
|
BSR VCOMP * COMPARE GIVEN WORD TO CURRENT WORD
|
|
BHI.S LKX8 * GREATER, MOVE DOWN
|
|
BEQ.S LKX12 * SAME, WE'VE FOUND IT
|
|
*** BCS.S LKX6 * (BLO) * LESS, MOVE UP
|
|
|
|
LKX6 ADDA.W D1,A2 * TO MOVE UP, ADD OFFSET
|
|
CMPA.L VOCEND(A6),A2 * HAVE WE MOVED PAST END OF TABLE?
|
|
BLS.S LKX10 * NO
|
|
MOVE.L VOCEND(A6),A2 * YES, POINT TO END OF TABLE
|
|
BRA.S LKX10
|
|
LKX8 SUBA.W D1,A2 * TO MOVE DOWN, JUST SUBTRACT OFFSET
|
|
|
|
LKX10 CMP.W VWLEN(A6),D1 * IS OFFSET RESOLUTION AT LEAST ONE WORD?
|
|
BGE LKX4 * YES, CONTINUE LOOP
|
|
BRA.S LKX14 * NO, WORD NOT FOUND
|
|
|
|
*** DONE, WINNING VOCAB POINTER LEFT IN A2
|
|
|
|
LKX12 MOVE.L A2,D0
|
|
SUB.L BUFFER(A6),D0 * RELATIVIZE THE ZWORD'S VOCAB TABLE OFFSET
|
|
BRA.S LKX16
|
|
|
|
LKX14 MOVEQ #0,D0 * WORD NOT FOUND, RETURN ZERO
|
|
LKX16 MOVEM.L (SP)+,D1/A1-A3
|
|
RTS
|
|
|
|
* ------------------------------
|
|
* VCOMP
|
|
* ------------------------------
|
|
|
|
* COMPARE GIVEN ZWORD (A1) TO CURRENT TABLE ZWORD (A0)
|
|
* RETURN WITH FLAGS
|
|
|
|
VCOMP MOVEQ #ZCHARS-1,D0 * CHECK THREE WORDS
|
|
VCPX1 CMPM.B (A1)+,(A0)+
|
|
DBNE D0,VCPX1 * TAKE BRANCH IF EQUAL
|
|
RTS
|
|
|
|
* UNROLL THE LOOP (RUNS A BIT FASTER)
|
|
|
|
** CMPM.B (A1)+,(A0)+ * CHECK FIRST WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
|
|
** CMPM.B (A1)+,(A0)+ * CHECK SECOND WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
|
|
** IF EZIP THEN
|
|
** CMPM.B (A1)+,(A0)+ * CHECK THIRD WORD
|
|
** BNE.S VCPX2 * DIFFERENT, EXIT
|
|
** CMPM.B (A1)+,(A0)+
|
|
** BNE.S VCPX2
|
|
** ENDIF
|
|
|
|
* VCPX2 RTS * OTHERWISE SAME, EXIT
|
|
|
|
|
|
* ------------------------------
|
|
* TIMEOUT PRIMITIVES
|
|
* ------------------------------
|
|
|
|
* NOTE: THIS TIMEOUT IMPLEMENTATION USES A SIMPLE "BUSY LOOP" RATHER THAN
|
|
* A REAL CPU INTERRUPT. THIS IS OK FOR SOME MACHINES BUT WOULD NOT BE GOOD
|
|
* FOR MULTITASKING ONES. IF AN INTERRUPT IS USED, ONE PROBLEM TO THINK
|
|
* ABOUT: THE LOW-LEVEL INPUT FUNCTION (TTYIN) MUST BE CANCEL-ABLE WHEN THE
|
|
* TIMEOUT ABORT OCCURS.
|
|
*
|
|
* THE TIMEOUT COUNTDOWN MECHANISM HAS CHANGED A BIT; IT NOW FUNCTIONS ONLY
|
|
* WHEN THE BUSY LOOP IS RUNNING. IT'S SUSPENDED IF THE LOOP STOPS FOR
|
|
* MORE THAT 1/10 SEC (E.G. WHEN A DESK ACCESSORY IS UP, OR A MENU IS PULLED
|
|
* DOWN. OTHERWISE, A TIMEOUT COULD OCCUR IN THE BACKGROUND, AND A NOXIOUS
|
|
* EVENT COULD SPILL OUT THE MOMENT THE GAME IS SWITCHED BACK IN.)
|
|
*
|
|
* << WARNING: >> BE CAREFUL ABOUT REDUCING THE POLLING FREQUENCY, AS FOR
|
|
* MULTIFINDER. MUST LOOP AT LEAST EVERY 1/10 SEC FOR US TO WORK CORRECTLY.
|
|
|
|
* ----------------------
|
|
* TRESET, TNEXT
|
|
* ----------------------
|
|
|
|
* RESET THE TIMEOUT COUNTDOWN VARS
|
|
|
|
TRESET TST.W TWAIT(A6) * BUT ARE TIMOUTS IN EFFECT?
|
|
BLT.S TNEX1 * NO, EXIT
|
|
|
|
BSR TIME60
|
|
MOVE.L D0,TCLOCK(A6) * INITIAL REFERENCE TIME (IN 60THS)
|
|
|
|
TNEXT MOVE.W TWAIT(A6),TCOUNT(A6) * TOTAL DELAY (IN 10THS)
|
|
TNEX1 RTS
|
|
|
|
* ----------------------
|
|
* TCHECK
|
|
* ----------------------
|
|
|
|
* UPDATE THE TIMEOUT CLOCK & COUNTER,
|
|
* RETURN TIME REMAINING (ZERO IF NONE) & FLAGS
|
|
|
|
TCHECK BSR TIME60 * CURRENT TIME (IN 60THS)
|
|
SUB.L TCLOCK(A6),D0 * ELAPSED TIME, SINCE LAST CHECK
|
|
CMPI.L #12,D0
|
|
BGE.S TCHX2 * ET >= 2/10, RESET CLOCK, DON'T TOUCH COUNTER
|
|
SUBQ.L #6,D0
|
|
BLT.S TCHX3 * ET < 1/10, DO NOTHING
|
|
|
|
SUBQ.W #1,TCOUNT(A6) * 1/10 <= ET < 2/10, UPDATE CLOCK & COUNTER
|
|
MOVEQ #6,D0
|
|
TCHX2 ADD.L D0,TCLOCK(A6)
|
|
|
|
TCHX3 MOVE.W TCOUNT(A6),D0 * RETURN COUNTER/FLAGS
|
|
RTS
|
|
|
|
|
|
EJECT ; PAGE
|
|
* ---------------------------------------------------------------------------
|
|
* I/O OPERATIONS -- OUTPUT
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPUSL
|
|
* ----------------------
|
|
|
|
* OPUSL (UPDATE STATUS LINE)
|
|
|
|
IF EZIP THEN
|
|
OPUSL BRA OPERR * DEAD INSTRUCTION
|
|
ENDIF
|
|
|
|
* ----------------------
|
|
* OPPRNC
|
|
* ----------------------
|
|
|
|
* PRINTC (PRINT CHAR WHOSE ASCII VALUE IS GIVEN)
|
|
|
|
OPPRNC BRA PUTCHR * HANDLE IT
|
|
|
|
* ----------------------
|
|
* OPPRNN
|
|
* ----------------------
|
|
|
|
* PRINTN (PRINT A NUMBER, USING CURRENT CHARACTER OUTPUT FUNCTION)
|
|
|
|
OPPRNN MOVE.W D0,D1 * NON-ZERO NUMBER?
|
|
BNE.S PRNNX1 * YES
|
|
MOVE.B #'0',D0 * ZERO, SPECIAL CASE
|
|
BRA PUTCHR * PRINT A ZERO
|
|
|
|
PRNNX1 BGT.S PRNNX2 * POSITIVE?
|
|
MOVE.B #'-',D0 * NO, PRINT A MINUS SIGN
|
|
BSR PUTCHR
|
|
NEG.W D1 * AND MAKE NUMBER POSITIVE
|
|
|
|
PRNNX2 CLR.W D2 * COUNT OF DIGITS ON STACK
|
|
BRA.S PRNNX4 * START WITH GREATER-THAN-10 TEST
|
|
|
|
PRNNX3 EXT.L D1 * CLEAR HIGH WORD FOR DIVISION
|
|
DIVU #10,D1 * EXTRACT A DIGIT (THE REMAINDER)
|
|
SWAP D1
|
|
MOVE.W D1,-(SP) * PUSH IT
|
|
SWAP D1
|
|
ADDQ.W #1,D2 * BUMP COUNT
|
|
|
|
PRNNX4 CMPI.W #10,D1 * ANY MORE DIGITS TO EXTRACT?
|
|
BGE PRNNX3 * YES
|
|
MOVE.W D1,D0 * NO, POSITION LAST (FIRST) DIGIT
|
|
BRA.S PRNNX6
|
|
|
|
PRNNX5 MOVE.W (SP)+,D0 * POP NEXT DIGIT
|
|
PRNNX6 ADDI.B #'0',D0 * ASCIIZE IT
|
|
BSR PUTCHR * PRINT NEXT DIGIT
|
|
SUBQ.W #1,D2 * ANY DIGITS LEFT ON STACK?
|
|
BGE PRNNX5 * YES
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPPRIN
|
|
* ----------------------
|
|
|
|
* PRINT (THE STRING POINTED TO)
|
|
|
|
OPPRIN MOVEQ #0,D1 * ZERO HIGH WORD
|
|
MOVE.W D0,D1 * QUAD PTR
|
|
MOVE.L QSOFF(A6),D0 * QUAD STRING OFFSET
|
|
|
|
BSR BSPLTQ2 * SPLIT THE BLOCK AND OFFSET
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRNB
|
|
* ----------------------
|
|
|
|
* PRINTB (THE STRING POINTED TO)
|
|
|
|
OPPRNB BSR BSPLTB * SPLIT THE BLOCK AND OFFSET (BYTE)
|
|
BRA PUTSTR * PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRND
|
|
* ----------------------
|
|
|
|
* PRINTD (PRINT OBJ'S SHORT DESCRIPTION)
|
|
|
|
OPPRND BSR OBJLOC * FIND OBJECT'S LOCATION
|
|
ADDA.W #PROP,A0 * PROPERTY TABLE POINTER (ZIP/EZIP)
|
|
BSR GTAWRD * GET IT
|
|
|
|
ADDQ.W #1,D0 * POINT TO SHORT DESCRIPTION STRING
|
|
BSR BSPLTB * SPLIT THE POINTER
|
|
BRA PUTSTR * AND PRINT THE STRING
|
|
|
|
* ----------------------
|
|
* OPPRNI
|
|
* ----------------------
|
|
|
|
* PRINTI (PRINT THE STRING FOLLOWING THIS INSTRUCTION)
|
|
|
|
OPPRNI MOVE.W ZPC1(A6),D0 * GET POINTER TO STRING
|
|
MOVE.W ZPC2(A6),D1
|
|
BSR PUTSTR * PRINT IT
|
|
MOVE.W D0,ZPC1(A6) * AND UPDATE ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BRA NEWZPC
|
|
|
|
* ----------------------
|
|
* OPPRNR
|
|
* ----------------------
|
|
|
|
* PRINTR (PRINTI FOLLOWED BY RTRUE)
|
|
|
|
OPPRNR BSR OPPRNI * DO A PRINTI
|
|
BSR.S OPCRLF * A CRLF
|
|
BRA OPRTRU * AND AN RTRUE
|
|
|
|
* ----------------------
|
|
* OPCRLF
|
|
* ----------------------
|
|
|
|
* CRLF (DO A NEWLINE)
|
|
|
|
OPCRLF BRA PUTNEW * DO A NEWLINE
|
|
|
|
|
|
* ------------------------------------------------------------------
|
|
* WINDOW-RELATED PRIMITIVES
|
|
* ------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* MAPCW
|
|
* ----------------------
|
|
|
|
* GIVEN D0.W = WINDOW ID, CHECK IF -3; IF SO, SUBSTITUTE CURRENT ID
|
|
|
|
MAPCW CMPI.W #-3,D0
|
|
BNE.S MPWDX1
|
|
MOVE.W CURWIND(A6),D0
|
|
MPWDX1 RTS
|
|
|
|
* ----------------------
|
|
* CALCWP
|
|
* ----------------------
|
|
|
|
* GIVEN D0.W = WINDOW ID, RETURN A0 -> THE CORRESPONDING RECORD
|
|
|
|
CALCWP TST.W D0 * VALID WINDOW ID?
|
|
BLT.S CLWPX2 * NO/MAYBE
|
|
CMPI.W #MAXWIND,D0
|
|
BGE.S CLWPX2 * NO
|
|
|
|
ADD.W D0,D0
|
|
ADD.W D0,D0 * OFFSET x4
|
|
LEA WBLOCKP(A6),A0
|
|
MOVE.L 0(A0,D0.W),A0 * GET PTR TO NEW WINDOW RECORD
|
|
RTS
|
|
|
|
CLWPX2 ADDQ.W #3,D0 * ID = -3 NOW MEANS USE CURRENT WP
|
|
BEQ.S CLWPX3
|
|
|
|
DATA
|
|
MSGWID DC.B 'Bad WID',0
|
|
CODE
|
|
LEA MSGWID,A0
|
|
BSR ZWARN * FOR -1, ETC, SHOW WARNING (& RETURN CURRENT)
|
|
|
|
CLWPX3 MOVE.L CURWP(A6),A0 * RETURN CURRENT WP
|
|
RTS
|
|
|
|
* ----------------------
|
|
* WBOUNDS
|
|
* ----------------------
|
|
|
|
* GIVEN D0.W = ALTERNATE ID
|
|
* SET POSITION/SIZE OF THE DISPLAY WINDOW (TEMPORARY, e.g. FOR SCROLL/CLEAR)
|
|
|
|
WBOUNDS MOVEM.L D1-D3/A1,-(SP)
|
|
BSR CALCWP
|
|
MOVE.L A0,A1
|
|
|
|
MOVE.W WYPOS(A1),D0
|
|
MOVE.W WXPOS(A1),D1
|
|
MOVE.W WYSIZE(A1),D2
|
|
MOVE.W WXSIZE(A1),D3
|
|
BSR NEWBOUNDS
|
|
|
|
* ALSO, TEMPOARILY ADJUST THE (BACKGROUND) COLOR
|
|
* [SHOULD THIS WHOLE ROUTINE BE REPLACED BY A CALL TO OPSCRN?]
|
|
|
|
MOVE.W WCOLOR(A1),D0
|
|
MOVE.W D0,D1
|
|
ANDI.W #$00FF,D0 * FORE
|
|
EXT.W D0 * [IN CASE IT'S -1]
|
|
ASR.W #8,D1 * BACK
|
|
BSR MDCOLOR * SET COLORS TOO
|
|
|
|
MOVEM.L (SP)+,D1-D3/A1
|
|
RTS
|
|
|
|
* ----------------------
|
|
* TSTWFLG
|
|
* ----------------------
|
|
|
|
* TEST A BIT IN THE CURRENT WINDOW ATTRIBUTES WORD (SCROLL, SCRIPT, ETC),
|
|
* GIVEN D0.W = BIT NUMBER, RETURN FLAGS [MAKE THIS A MACRO?]
|
|
|
|
TSTWFLG MOVE.L CURWP(A6),A0
|
|
AND.W WATTR(A0),D0 * INDICATED BIT ON?
|
|
RTS
|
|
|
|
* ------------------------------------------------------------------
|
|
* WINDOW OPERATIONS
|
|
* ------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPSCRN
|
|
* ----------------------
|
|
|
|
* MAKE OUTPUT FALL INTO SPECIFIED WINDOW, D0.W = ID
|
|
* (OPSCRN MAY BE CALLED INTERNALLY, BY OPSPLT)
|
|
|
|
OPSCRN BSR MAPCW * D0.W -> NORMAL ID
|
|
CMP.W CURWIND(A6),D0
|
|
BEQ SCRNX9 * SAME, EXIT
|
|
|
|
MOVE.W D0,D2 * SAVE ARG
|
|
*** BSR PUTLIN1
|
|
BSR PUTLIN * EMPTY BUFFER IF NEEDED (KEEPING CURSIZ)
|
|
|
|
* SAVE CURRENT CURSOR POS IN CURRENT WINDOW REC
|
|
|
|
BSR GETCURS * GET CURSOR POS [1-ORIGIN]
|
|
MOVE.L CURWP(A6),A1
|
|
MOVE.W D0,WYCURS(A1) * AND STORE IT
|
|
MOVE.W D1,WXCURS(A1)
|
|
|
|
* BUFFER "FULLNESS" INFO NOW /IS/ PRESERVED ACROSS WINDOWS
|
|
|
|
MOVE.L DQUE(A6),A2
|
|
MOVE.W CURSIZ(A2),WCSIZ(A1) * SAVE CURRENT BUFFER "FULLNESS"
|
|
|
|
* SWITCH WINDOWS (ALL OTHER PARAMS SHOULD BE VALID!)
|
|
|
|
MOVE.W D2,CURWIND(A6) * STORE NEW WINDOW ID
|
|
MOVE.W D2,D0
|
|
BSR CALCWP
|
|
MOVE.L A0,CURWP(A6) * AND NEW RECORD POINTER
|
|
MOVE.L A0,A1
|
|
|
|
* SET UP NEW BUFFER "FULLNESS" INFO ["BUFSIZ" IS SET ELSEWHERE]
|
|
|
|
MOVE.W WCSIZ(A1),CURSIZ(A2)
|
|
|
|
* SET UP NEW WINDOW POS/SIZE, CURSOR POS, ETC
|
|
|
|
MOVE.W WLMARG(A1),D0
|
|
MOVE.W WRMARG(A1),D1
|
|
BSR SETMARG
|
|
|
|
MOVE.W WYPOS(A1),D0
|
|
MOVE.W WXPOS(A1),D1
|
|
MOVE.W WYSIZE(A1),D2
|
|
MOVE.W WXSIZE(A1),D3
|
|
BSR SETBOUNDS * [MUST CALL /AFTER/ SETMARG]
|
|
|
|
MOVE.W WYCURS(A1),D0 * 1-ORIGIN
|
|
MOVE.W WXCURS(A1),D1
|
|
BSR SETCURS * [MUST CALL /AFTER/ SETBOUNDS]
|
|
|
|
MOVE.W WFONTID(A1),D0
|
|
*** MOVE.W WFONTXY(A1),D1 * [NOT HANDLED]
|
|
BSR SETFONT
|
|
|
|
MOVE.W WHLIGHT(A1),D0
|
|
BSR SETHL
|
|
MOVE.W WATTR(A1),D0
|
|
BSR SETATTR
|
|
|
|
MOVE.W WCOLOR(A1),D0
|
|
MOVE.W D0,D1
|
|
ANDI.W #$00FF,D0 * FORE
|
|
EXT.W D0 * [IN CASE IT'S -1]
|
|
ASR.W #8,D1 * BACK
|
|
BSR MDCOLOR * UPDATE COLORS [/AFTER/ SETCURS, FOR ID = -1]
|
|
|
|
SCRNX9 RTS
|
|
|
|
* ----------------------
|
|
* OPSPLT
|
|
* ----------------------
|
|
|
|
* SPLIT THE SCREEN BETWEEN THE FIRST TWO WINDOWS (FOR BACKWARD COMPATIBILITY)
|
|
* GIVEN D0 = LINES IN WINDOW 1 (UPPER)
|
|
|
|
OPSPLT MOVE.W D0,D2 * SAVE SPLIT COUNT HERE
|
|
BSR PUTLIN1 * EMPTY (&ZERO) BUFFER IF NEEDED
|
|
|
|
* CHECK FOR VALID ARG
|
|
|
|
BSR MAXSCRN * GET TOTAL ROWS
|
|
CMP.W D0,D2
|
|
BLE.S SPLTX1
|
|
MOVE.W D0,D2 * CAN'T HAVE MORE THAN FULL SCREEN
|
|
*** BSR ZWARN
|
|
|
|
* READ CURRENT CURSOR POS INTO CURRENT WINDOW REC (ALL OTHER PARAMS SHOULD BE
|
|
* VALID!) (THIS /NOT/ DONE IN OPSCRN, IF CURRENT WINDOW IS W0)
|
|
|
|
SPLTX1 BSR GETCURS * GET Wx CURSOR POS [1-ORIGIN]
|
|
MOVE.L CURWP(A6),A1
|
|
MOVE.W D0,WYCURS(A1) * AND STORE IT
|
|
MOVE.W D1,WXCURS(A1)
|
|
|
|
MOVE.W D2,-(SP) * PROTECT REG(S) ACROSS OPx CALL
|
|
MOVEQ #0,D0 * MAKE SURE WE'RE IN W0
|
|
BSR OPSCRN
|
|
MOVE.W (SP)+,D2
|
|
|
|
* GET RECORD POINTERS FOR FIRST TWO WINDOWS
|
|
|
|
MOVE.L CURWP(A6),A2 * WINDOW 0
|
|
MOVEQ #1,D0
|
|
BSR CALCWP
|
|
MOVE.L A0,A1 * WINDOW 1
|
|
|
|
* SET NEW POSITIONS/SIZES
|
|
|
|
MOVE.W #1,D0
|
|
MOVE.W D0,WYPOS(A1)
|
|
MOVE.W D2,WYSIZE(A1)
|
|
MOVE.W D0,WYCURS(A1) * "HOME THE W1 CURSOR"
|
|
MOVE.W D0,WXCURS(A1)
|
|
|
|
ADD.W D2,D0
|
|
MOVE.W WYPOS(A2),D1 * OLD W0 POSITION
|
|
MOVE.W D0,WYPOS(A2)
|
|
SUB.W D0,D1
|
|
ADD.W WYSIZE(A2),D1 * "ADJUST SIZE SO W0 BOTTOM DOESN'T MOVE"
|
|
BGE.S SPLTX2
|
|
MOVEQ #0,D1
|
|
SPLTX2 MOVE.W D1,WYSIZE(A2)
|
|
|
|
*** MOVE.W D2,D0
|
|
*** BSR SETSPLT * [FOR BACKWARD COMPATIBILITY]
|
|
|
|
MOVE.W WYPOS(A2),D0
|
|
MOVE.W WXPOS(A2),D1
|
|
MOVE.W WYSIZE(A2),D2
|
|
MOVE.W WXSIZE(A2),D3
|
|
BSR NEWBOUNDS * ADJUST BOUNDS, /DON'T/ ADJUST CURSOR
|
|
|
|
BSR GETCURS * GET NEW >>RELATIVE<< W0 CURSOR POS
|
|
MOVE.W D0,WYCURS(A2) * AND STORE IT
|
|
MOVE.W D1,WXCURS(A2)
|
|
BSR SETCURS * FORCE IT INBOUNDS, IF NEEDED
|
|
SPLTX5 RTS
|
|
|
|
* ----------------------
|
|
* OPWPOS
|
|
* ----------------------
|
|
|
|
OPWPOS BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,D3 * SAVE HERE
|
|
BSR CALCWP
|
|
MOVE.L A0,A3
|
|
|
|
* CHECK FOR VALID POSITION (SIZE NOT TAKEN INTO ACCOUNT HERE)
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
CMP.W PVWRD(A0),D1
|
|
BHI.S WPOSX1 * OUT OF BOUNDS
|
|
CMP.W PHWRD(A0),D2
|
|
BLS.S WPOSX2 * OK
|
|
|
|
DATA
|
|
MSGWPS DC.B 'Bad WINPOS',0
|
|
CODE
|
|
WPOSX1 LEA MSGWPS,A0
|
|
BSR ZWARN * SHOW A WARNING
|
|
|
|
WPOSX2 MOVE.W D1,WYPOS(A3) * STORE NEW COORDS (1-ORIGIN)
|
|
MOVE.W D2,WXPOS(A3)
|
|
CMP.W CURWIND(A6),D3 * THIS THE CURRENT ACTIVE WINDOW?
|
|
BNE.S WPOSX9 * NO
|
|
|
|
MOVE.W D1,D0 * YES, UPDATE SCREEN
|
|
MOVE.W D2,D1
|
|
MOVE.W WYSIZE(A3),D2
|
|
MOVE.W WXSIZE(A3),D3
|
|
BSR SETBOUNDS
|
|
WPOSX9 RTS
|
|
|
|
* ----------------------
|
|
* OPWSIZ
|
|
* ----------------------
|
|
|
|
OPWSIZ BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,D3 * SAVE HERE
|
|
BSR CALCWP
|
|
MOVE.L A0,A3
|
|
|
|
MOVE.W D1,WYSIZE(A3) * STORE NEW SIZE
|
|
MOVE.W D2,WXSIZE(A3)
|
|
* DON'T TOUCH [MORE] COUNTER (WILL BE COMPARED WITH /NEW/ WYSIZE)
|
|
*** CLR.W WLCNT(A3)
|
|
|
|
CMP.W CURWIND(A6),D3 * THIS THE CURRENT ACTIVE WINDOW?
|
|
BNE.S WSIZX3 * NO
|
|
|
|
MOVE.W D2,D3 * YES, UPDATE SCREEN
|
|
MOVE.W D1,D2
|
|
MOVE.W WYPOS(A3),D0
|
|
MOVE.W WXPOS(A3),D1
|
|
BSR SETBOUNDS
|
|
WSIZX3 RTS
|
|
|
|
* ----------------------
|
|
* OPWATTR
|
|
* ----------------------
|
|
|
|
OPWATTR DC.W 3 * DEFAULT ARGBLK
|
|
DC.W SKIP,SKIP,0 * DEFAULT OP = "MOVE"
|
|
|
|
MOVE.L A0,A1
|
|
MOVE.W ARG1(A1),D0 * WINDOW ID
|
|
BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,ARG1(A1) * SAVE
|
|
BSR CALCWP
|
|
MOVE.L A0,A2
|
|
|
|
MOVE.W ARG2(A1),D1 * ARG BITS
|
|
MOVE.W WATTR(A2),D0 * CURRENT BITS
|
|
|
|
MOVE.W ARG3(A1),D2 * BITWISE OP:
|
|
BEQ.S WATTX1 * "MOVE"
|
|
SUBQ.W #1,D2
|
|
BEQ.S WATTX2 * "SET"
|
|
SUBQ.W #1,D2
|
|
BEQ.S WATTX3 * "CLEAR"
|
|
SUBQ.W #1,D2
|
|
BEQ.S WATTX4 * "COMP"
|
|
*** BSR ZWARN
|
|
BRA.S WATTX6 * NOT A VALID OP
|
|
|
|
WATTX1 MOVE.W D1,D0
|
|
BRA.S WATTX5
|
|
WATTX2 OR.W D1,D0
|
|
BRA.S WATTX5
|
|
WATTX3 AND.W D0,D1 * FLIP ONLY THE GIVEN BITS THAT ARE "ON"
|
|
WATTX4 EOR.W D1,D0 * FLIP ALL GIVEN BITS
|
|
WATTX5 MOVE.W D0,WATTR(A2) * STORE BITS
|
|
|
|
MOVE.W D0,D1
|
|
MOVE.W ARG1(A1),D0 * WINDOW ID
|
|
CMP.W CURWIND(A6),D0 * THIS THE CURRENT ACTIVE WINDOW?
|
|
BNE.S WATTX6 * NO
|
|
BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED
|
|
MOVE.W D1,D0
|
|
BSR SETATTR
|
|
WATTX6 RTS
|
|
|
|
* ----------------------
|
|
* OPCURS
|
|
* ----------------------
|
|
|
|
* SET CURSOR TO ROW/COLUMN
|
|
|
|
OPCURS NOP * REQUEST AN ARGBLK
|
|
CMPI.W #2,(A0)
|
|
BGT.S OPCSX1
|
|
MOVE.W CURWIND(A6),ARG3(A0) * USE CURRENT WINDOW
|
|
|
|
OPCSX1 MOVE.L A0,A1
|
|
MOVE.W ARG3(A1),D0 * WINDOW ID
|
|
BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,ARG3(A1) * SAVE
|
|
BSR CALCWP
|
|
MOVE.L A0,A2
|
|
|
|
MOVE.W ARG1(A1),D0 * ROW
|
|
MOVE.W ARG2(A1),D1 * COL
|
|
|
|
CMPI.W #1,D0 * ROW: OUT OF BOUNDS?
|
|
BGE.S OPCSX2
|
|
MOVE.W #1,D0 * YES, MOVE WITHIN BOUNDS
|
|
OPCSX2 CMP.W WYSIZE(A2),D0
|
|
BLE.S OPCSX3
|
|
MOVE.W WYSIZE(A2),D0
|
|
OPCSX3 MOVE.W D0,WYCURS(A2)
|
|
|
|
CMPI.W #1,D1 * COL: OUT OF BOUNDS?
|
|
BGE.S OPCSX4
|
|
MOVE.W #1,D1 * YES, MOVE WITHIN BOUNDS
|
|
OPCSX4 CMP.W WXSIZE(A2),D1
|
|
BLE.S OPCSX5
|
|
MOVE.W WXSIZE(A2),D1
|
|
OPCSX5 MOVE.W D1,WXCURS(A2)
|
|
|
|
MOVE.W D0,D2 * PROTECT ARG
|
|
MOVE.W ARG3(A1),D0
|
|
CMP.W CURWIND(A6),D0 * THIS THE CURRENT ACTIVE WINDOW?
|
|
BNE.S OPCSX6 * NO
|
|
|
|
BSR PUTLIN1 * EMPTY(&ZERO) BUFFER IF NEEDED
|
|
MOVE.W D2,D0
|
|
BSR SETCURS * D0 = ROW, D1 = COL
|
|
OPCSX6 RTS
|
|
|
|
* ----------------------
|
|
* OPCURG
|
|
* ----------------------
|
|
|
|
* GET CURSOR POSITION [1-ORIGIN] [ALWAYS CURRENT WINDOW]
|
|
|
|
OPCURG
|
|
* MOVE.W D0,-(SP)
|
|
* BSR PUTLIN * [DONE BY GETCURS]
|
|
* MOVE.W (SP)+,D0
|
|
BSR RELABS * TABLE FOR RETURN VALUES
|
|
MOVE.L A0,A1
|
|
BSR GETCURS
|
|
MOVE.L A1,A0
|
|
BSR PTAWRD * STORE ROW
|
|
MOVE.L A1,A0
|
|
ADDQ.L #2,A0
|
|
MOVE.W D1,D0
|
|
BRA PTAWRD * STORE COLUMN
|
|
|
|
* ----------------------
|
|
* OPWGET, OPWPUT
|
|
* ----------------------
|
|
|
|
* [REPLACEMENT ROUTINES, PER NEWEST YZIP SPEC]
|
|
* WINGET window,field > VAL
|
|
|
|
OPWGET NOP
|
|
MOVE.L A0,A1 * ARGBLK
|
|
MOVE.W ARG1(A1),D0 * ID
|
|
BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,ARG1(A1)
|
|
CMP.W CURWIND(A6),D0 * FROM THE CURRENT WINDOW?
|
|
BNE.S OPG2X2 * NO
|
|
|
|
* [SHOULD GET CURSOR POS /ONLY/ IF THAT'S WHAT IS NEEDED --
|
|
* WANT TO AVOID FLUSHING BUFFER DURING POSSIBLE CR INTERRUPTS]
|
|
|
|
BSR GETCURS * YES, FIRST GET CURSOR POS
|
|
MOVE.L CURWP(A6),A0
|
|
MOVE.W D0,WYCURS(A0) * AND UPDATE WREC, IN CASE NEEDED
|
|
MOVE.W D1,WXCURS(A0)
|
|
|
|
OPG2X2 BSR.S WGTWPT * CALC FIELD PTR
|
|
MOVE.L A0,D0 * ERROR?
|
|
BEQ.S OPG2X9 * RETURN ZERO
|
|
|
|
MOVE.W (A0),D0
|
|
OPG2X9 BRA PUTVAL * RETURN THE VAL
|
|
|
|
|
|
* WINPUT window,field,val
|
|
|
|
OPWPUT NOP
|
|
MOVE.L A0,A1 * ARGBLK
|
|
BSR.S WGTWPT * CALC FIELD PTR
|
|
MOVE.L A0,D0 * ERROR?
|
|
BEQ.S OPP2X9 * EXIT
|
|
|
|
* CHECK FOR WRITE TO "ILLEGAL" FIELD [GIVE A WARNING BUT ALLOW IT]
|
|
|
|
MOVE.W ARG3(A1),(A0) * STORE THE VAL IN WREC
|
|
|
|
MOVE.W ARG2(A1),D0 * WORD OFFSET AGAIN
|
|
ADD.W D0,D0 * BYTES
|
|
CMPI.W #WCRINT,D0 * THESE ARE THE ONLY LEGAL FIELDS
|
|
BEQ.S OPP2X9
|
|
CMPI.W #WCRCNT,D0
|
|
BEQ.S OPP2X9
|
|
CMPI.W #WLCNT,D0
|
|
BEQ.S OPP2X9
|
|
|
|
LEA MSGWPT,A0
|
|
BSR ZWARN * SHOW A WARNING
|
|
DATA
|
|
MSGWPT DC.B 'Bad wRec Write',0
|
|
CODE
|
|
|
|
OPP2X9 RTS
|
|
|
|
|
|
* COMMON ROUTINE TO INDEX INTO A WINDOW REC
|
|
* GIVEN A1 -> ARGBLK, ARG1 = WINDOW ID, ARG2 = FIELD
|
|
* RETURN A0 -> FIELD, OR NULL IF ERR
|
|
|
|
WGTWPT MOVE.W ARG1(A1),D0
|
|
BSR CALCWP * A0 -> WREC
|
|
MOVE.W ARG2(A1),D0 * WORD OFFSET (IN WREC)
|
|
ADD.W D0,D0 * BYTES
|
|
|
|
* CHECK BOUNDS
|
|
|
|
BLT.S WGWPX9 * NEG, ERROR
|
|
CMPI.W #WBLKLEN,D0
|
|
BGE.S WGWPX9 * TOO BIG, ERROR
|
|
ADDA.W D0,A0 * RETURN FIELD PTR
|
|
RTS
|
|
|
|
WGWPX9 LEA MSGWGP,A0
|
|
BSR ZWARN * SHOW A WARNING
|
|
SUB.L A0,A0 * RETURN NULL PTR
|
|
RTS
|
|
DATA
|
|
MSGWGP DC.B 'Bad wRec field',0
|
|
CODE
|
|
|
|
|
|
*** DEAD ROUTINES
|
|
IF CZIP THEN
|
|
|
|
_OPWGET DC.W 3 * DEFAULT ARGBLK
|
|
DC.W SKIP,SKIP,0 * DEFAULT OFFSET = 0
|
|
|
|
MOVE.L A0,A2 * A2 -> ARGBLK
|
|
MOVE.W ARG1(A2),D0
|
|
CMP.W CURWIND(A6),D0 * FROM THE CURRENT WINDOW?
|
|
BNE.S OPWGX1 * NO
|
|
|
|
BSR GETCURS * YES, FIRST GET CURSOR POS
|
|
MOVE.L CURWP(A6),A0
|
|
MOVE.W D0,WYCURS(A0) * AND STORE IT
|
|
MOVE.W D1,WXCURS(A0)
|
|
BRA.S OPWGX2
|
|
|
|
OPWGX1 BSR CALCWP
|
|
OPWGX2 MOVE.L A0,A1 * A1 -> WREC
|
|
MOVE.W ARG3(A2),D0 * OFFSET (IN WREC)
|
|
BLT.S OPWGX9 * EXIT
|
|
MOVEQ #WBLKLEN/2,D1
|
|
SUB.W D0,D1 * D1 = MAX #ITEMS (WORDS) TO COPY
|
|
BLE.S OPWGX9 * EXIT
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A1
|
|
|
|
MOVE.W ARG2(A2),D0
|
|
BSR RELABS * A0 -> LTABLE
|
|
BSR GTAWRD * (ADVANCE PTR)
|
|
MOVE.W D0,D2 * D2 = MAX TABLE LEN (WORDS)
|
|
BLE.S OPWGX9 * EXIT
|
|
CMP.W D1,D2
|
|
BLE.S OPWGX4 * USE SMALLER OF TWO
|
|
MOVE.W D1,D2
|
|
|
|
OPWGX4 MOVE.W (A1)+,D0
|
|
BSR PTAWRD * COPY A WORD, ADVANCE PTR
|
|
SUBQ.W #1,D2
|
|
BGT.S OPWGX4 * LOOP
|
|
OPWGX9 RTS
|
|
|
|
|
|
_OPWPUT DC.W 3 * DEFAULT ARGBLK
|
|
DC.W SKIP,SKIP,0 * DEFAULT OFFSET = 0
|
|
|
|
MOVE.L A0,A2 * A2 -> ARGBLK
|
|
MOVE.W ARG1(A2),D0
|
|
BSR CALCWP
|
|
MOVE.L A0,A3 * A3 -> WREC
|
|
|
|
MOVEQ #WBLKLEN,D0
|
|
SUB.W D0,SP * MAKE SPACE FOR A TEMPORARY WREC
|
|
MOVE.L SP,A1
|
|
OPWPX2 MOVE.W (A0)+,(A1)+ * COPY CONTENTS
|
|
SUBQ.W #2,D0
|
|
BNE.S OPWPX2
|
|
MOVE.L SP,A1 * A1 -> TEMPORARY WREC
|
|
|
|
MOVE.W ARG3(A2),D0 * OFFSET (IN WREC)
|
|
BLT.S OPWPX9 * EXIT
|
|
MOVEQ #WBLKLEN/2,D1
|
|
SUB.W D0,D1 * D1 = MAX #ITEMS (WORDS) TO COPY
|
|
BLE.S OPWPX9 * EXIT
|
|
ADD.W D0,D0
|
|
ADDA.W D0,A1
|
|
|
|
MOVE.W ARG2(A2),D0
|
|
BSR RELABS * A0 -> LTABLE
|
|
BSR GTAWRD * (ADVANCE PTR)
|
|
MOVE.W D0,D2 * D2 = MAX TABLE LEN (WORDS)
|
|
BLE.S OPWPX9 * EXIT
|
|
CMP.W D1,D2
|
|
BLE.S OPWPX4 * USE SMALLER OF TWO
|
|
MOVE.W D1,D2
|
|
|
|
OPWPX4 BSR GTAWRD * PICKUP A WORD, ADVANCE PTR
|
|
MOVE.W D0,(A1)+ * COPY TO (TEMPORARY) WREC
|
|
SUBQ.W #1,D2
|
|
BGT.S OPWPX4 * LOOP
|
|
|
|
* FINALLY, UPDATE THE ACTUAL WREC
|
|
* THE CR FUNCTION/COUNT SLOTS ARE THE ONLY "LEGALLY WRITABLE" ONES
|
|
|
|
MOVE.L SP,A1 * A1 -> TEMPORARY WREC
|
|
MOVE.W WCRINT(A1),WCRINT(A3)
|
|
MOVE.W WCRCNT(A1),WCRCNT(A3)
|
|
|
|
OPWPX9 MOVEQ #WBLKLEN,D0
|
|
ADD.W D0,SP * CLEANUP STACK
|
|
RTS
|
|
ENDIF
|
|
|
|
* ----------------------
|
|
* OPSCROLL
|
|
* ----------------------
|
|
|
|
OPSCROLL
|
|
DC.W 2 * DEFAULT ARGBLK
|
|
DC.W SKIP,1 * DEFAULT DISTANCE = 1 UP
|
|
|
|
MOVE.L A0,A2 * A2 -> ARGBLK
|
|
BSR PUTLIN * FIRST EMPTY BUFFER, IF NEEDED
|
|
MOVE.W ARG1(A2),D0
|
|
BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,ARG1(A2) * SAVE
|
|
|
|
MOVE.W CURWIND(A6),D2 * SAVE ORIGINAL VALUE
|
|
CMP.W D0,D2 * SAME?
|
|
BEQ.S ROLLX1 * YES, JUST DO THE SCROLL
|
|
|
|
BSR WBOUNDS * OTHERWISE, TEMPORARILY RESET WINDOW BOUNDS
|
|
BSR ROLLX1 * >> CALL AS SUBR <<
|
|
MOVE.W D2,D0 * THEN RESTORE THEM
|
|
BRA WBOUNDS * AND EXIT
|
|
|
|
ROLLX1 MOVE.W ARG2(A2),D0
|
|
BRA MDSCROLL
|
|
|
|
* ----------------------
|
|
* OPCLEAR
|
|
* ----------------------
|
|
|
|
* CLEAR A WINDOW, OR ENTIRE SCREEN
|
|
|
|
OPCLEAR BSR MAPCW * D0.W -> NORMAL ID
|
|
MOVE.W D0,D2
|
|
BSR PUTLIN * EMPTY (IF NEEDED) BUFFER
|
|
TST.W D2 * ID NEGATIVE?
|
|
BLT.S OCLRX6 * YES, HANDLE SPECIALLY
|
|
|
|
MOVE.W CURWIND(A6),D3
|
|
CMP.W D3,D2 * IN CURRENT WINDOW?
|
|
BEQ.S OCLRX1 * YES
|
|
|
|
MOVE.W D2,D0
|
|
BSR WBOUNDS * OTHERWISE, TEMPORARILY RESET WINDOW BOUNDS
|
|
BSR OCLRX2 * >> CALL AS SUBR <<
|
|
MOVE.W D3,D0 * RESTORE CURRENT BOUNDS
|
|
BRA WBOUNDS * AND EXIT
|
|
|
|
OCLRX1 BSR PUTLIN1 * EMPTY (IF NEEDED) >> & ZERO << BUFFER
|
|
OCLRX2 MOVEQ #0,D0
|
|
BSR MDCLEAR * CLEAR TARGET WINDOW (VISIBLY)
|
|
* MOVE.W D2,xx
|
|
BRA OCLRX8 * HOME CURSOR
|
|
|
|
* HANDLE NEGATIVE ARGS:
|
|
|
|
OCLRX6 MOVE.W #1,INLAST(A6) * "DON'T PAUSE UPON EXIT IF SCREEN CLEARED"
|
|
MOVEQ #-1,D0
|
|
BSR MDCLEAR * CLEAR ENTIRE SCREEN
|
|
|
|
CMPI.W #-1,D2 * ALSO SPLIT SCREEN, HOME CURSOR?
|
|
BNE.S OCLRX9 * NO, EXIT
|
|
|
|
* MOVE.L XX,-(SP) * PROTECT REG(S) ACROSS OPx CALL
|
|
MOVEQ #0,D0
|
|
BSR OPSPLT * DO A SPLIT-0
|
|
* MOVE.L (SP)+,XX
|
|
|
|
MOVE.W CURWIND(A6),D2
|
|
|
|
* GIVEN D2.W = TARGET WINDOW
|
|
* HOME CURSOR, RESET LINE COUNT AND WRAP COUNT
|
|
|
|
OCLRX8 MOVE.W D2,D0
|
|
BSR CALCWP * GET TARGET WREC
|
|
MOVEQ #1,D0
|
|
MOVE.W D0,WYCURS(A0) * HOME CURSOR IN TARGET WINDOW
|
|
MOVEQ #1,D1
|
|
ADD.W WLMARG(A0),D1
|
|
MOVE.W D1,WXCURS(A0)
|
|
CLR.W WLCNT(A0) * RESET THE 'MORE' COUNTER
|
|
CLR.W WCSIZ(A0) * RESET THE 'FULLNESS' COUNTER ALSO
|
|
|
|
CMP.W CURWIND(A6),D2 * IN CURRENT WINDOW?
|
|
BNE.S OCLRX9
|
|
BSR SETCURS * YES: UPDATE SCREEN CURSOR
|
|
OCLRX9 RTS
|
|
|
|
* ----------------------
|
|
* OPERASE
|
|
* ----------------------
|
|
|
|
* ERASE (CURRENT LINE, CURSOR TO EOL /OR/ TO GIVEN WIDTH)
|
|
|
|
OPERASE MOVE.W D0,D1 * WIDTH TO ERASE
|
|
BSR PUTLIN * EMPTY BUFFER, IF NEEDED
|
|
|
|
CMPI.W #1,D1 * ARG
|
|
BLT.S ERAX2 * <1 MEANS ERROR, EXIT
|
|
BGT.S ERAX1 * >1 MEANS IT'S A PIXEL COUNT
|
|
MOVEQ #-1,D1 * =1 MEANS ERASE TO EOL
|
|
ERAX1 MOVEQ #-1,D0 * (ALWAYS START AT CURSOR)
|
|
BSR MDERASE
|
|
ERAX2 RTS
|
|
|
|
* ----------------------
|
|
* OPHLIGHT [WAS OPATTR]
|
|
* ----------------------
|
|
|
|
* HIGHLIGHT (SET DISPLAY MODE FOR SUBSEQUENT OUTPUT)
|
|
* D0.W = 0 PLAIN, 1 INVERSE, 2 BOLD, 4 ITALIC (8 MONO)
|
|
|
|
OPHLIGHT
|
|
MOVE.L CURWP(A6),A0 * [ALWAYS IN CURRENT WINDOW]
|
|
MOVE.W D0,WHLIGHT(A0) * STORE NEW MODE
|
|
|
|
MOVE.W D0,D1
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD MODE)
|
|
MOVE.W D1,D0
|
|
BRA SETHL
|
|
*** BRA MDATTR
|
|
|
|
* ----------------------
|
|
* OPFONT
|
|
* ----------------------
|
|
|
|
OPFONT NOP * REQUEST AN ARGBLK
|
|
MOVE.L A0,A1
|
|
CMPI.W #1,(A1) * WINDOW ID SUPPLIED?
|
|
BGT.S FONTX2
|
|
MOVE.L CURWP(A6),A0 * NO, USE DEFAULT
|
|
BRA.S FONTX4
|
|
|
|
FONTX2 MOVE.W ARG2(A1),D0 * YES, GET PTR
|
|
BSR CALCWP
|
|
|
|
FONTX4 MOVE.W ARG1(A1),D1 * NEW FONT ID
|
|
MOVE.W WFONTID(A0),D2 * OLD FONT ID
|
|
CMP.W D2,D1 * >>> IS THE FONT REALLY CHANGING? <<<
|
|
BEQ.S FONTX9 * NO, EXIT (WITHOUT EMPTYING BUFFER!)
|
|
MOVE.W D1,WFONTID(A0) * STORE NEW FONT ID
|
|
|
|
CMP.L CURWP(A6),A0 * WORKING WITH THE CURRENT WINDOW?
|
|
BNE.S FONTX9 * NO, DONE
|
|
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD FONT)
|
|
MOVE.W D1,D0
|
|
BSR SETFONT * UPDATE SCREEN FONT
|
|
|
|
FONTX9 MOVE.W D2,D0
|
|
BRA PUTVAL * RETURN OLD FONT ID
|
|
|
|
* ----------------------
|
|
* OPCOLOR
|
|
* ----------------------
|
|
|
|
OPCOLOR NOP * REQUEST AN ARGBLK
|
|
MOVE.L A0,A1
|
|
CMPI.W #2,(A1) * WINDOW ID SUPPLIED?
|
|
BGT.S COLRX2
|
|
MOVE.L CURWP(A6),A0 * NO, USE DEFAULT
|
|
BRA.S COLRX4
|
|
|
|
COLRX2 MOVE.W ARG3(A1),D0 * YES, GET PTR
|
|
BSR CALCWP
|
|
|
|
* if fore/back id = 0 (no change), don't touch slot in window record ...
|
|
|
|
COLRX4 MOVE.B ARG2+1(A1),D0 * BACK
|
|
BEQ.S COLRX6
|
|
MOVE.B D0,WCOLOR(A0) * STORE NEW BACK (HI BYTE)
|
|
COLRX6 MOVE.B ARG1+1(A1),D0 * FORE
|
|
BEQ.S COLRX8
|
|
MOVE.B D0,WCOLOR+1(A0) * STORE NEW FORE
|
|
|
|
COLRX8 CMP.L CURWP(A6),A0 * WORKING WITH THE CURRENT WINDOW?
|
|
BNE.S COLRX9 * NO, DONE
|
|
|
|
BSR PUTLIN * EMPTY THE LINE BUFFER (IN OLD COLOR)
|
|
MOVE.W ARG1(A1),D0 * FORE
|
|
MOVE.W ARG2(A1),D1 * BACK
|
|
BSR MDCOLOR * UPDATE SCREEN COLORS
|
|
COLRX9 RTS
|
|
|
|
* ----------------------
|
|
* OPMARG
|
|
* ----------------------
|
|
|
|
* SET MARGINS
|
|
|
|
OPMARG NOP * REQUEST AN ARGBLK
|
|
MOVE.L A0,A1
|
|
CMPI.W #2,(A1) * WINDOW ID SUPPLIED?
|
|
BGT.S MARGX2
|
|
MOVE.L CURWP(A6),A0 * NO, USE DEFAULT
|
|
BRA.S MARGX4
|
|
|
|
MARGX2 MOVE.W ARG3(A1),D0 * YES, GET PTR
|
|
BSR CALCWP
|
|
|
|
MARGX4 MOVE.L A0,A2
|
|
MOVE.W ARG1(A1),D2
|
|
MOVE.W D2,WLMARG(A2)
|
|
MOVE.W ARG2(A1),D3
|
|
MOVE.W D3,WRMARG(A2)
|
|
|
|
MOVEQ #1,D1
|
|
ADD.W D2,D1
|
|
MOVE.W D1,WXCURS(A2) * MOVE CURSOR TO LEFT MARGIN
|
|
|
|
CMP.L CURWP(A6),A2 * WORKING WITH THE CURRENT WINDOW?
|
|
BNE.S MARGX9 * NO
|
|
|
|
*** NOTE: CR-INTERRUPT ROUTINES COMMONLY CALL OPMARG (TO FLOW AROUND PICTURES),
|
|
*** IN WHICH CASE WE SHOULD /NOT/ EMPTY THE BUFFER, BUT ALLOW IT TO WRAP.
|
|
*** [MOREOVER, PUTLIN/QUECHR IS /NOT/ RE-ENTRANT -- GARBAGE IS DISPLAYED]
|
|
*** IN OTHER CASES, THE GAME SHOULD ITSELF ENSURE THAT THE BUFFER IS EMPTY.
|
|
*** BSR PUTLIN * EMPTY THE LINE BUFFER
|
|
MOVE.W D2,D0
|
|
MOVE.W D3,D1
|
|
BSR SETMARG * UPDATE DISPLAY VARS
|
|
|
|
MOVEQ #-1,D0 * [DON'T CHANGE ROW]
|
|
MOVEQ #1,D1
|
|
ADD.W D2,D1
|
|
BSR SETCURS * MOVE CURSOR TO LEFT MARGIN
|
|
MARGX9 RTS
|
|
|
|
* ---------------------------------------------------------------------------
|
|
* MORE I/O OPERATIONS
|
|
* ---------------------------------------------------------------------------
|
|
|
|
* ----------------------
|
|
* OPBUFO
|
|
* ----------------------
|
|
|
|
* SET BUFFERING OF OUTPUT ACCORDING TO INT
|
|
|
|
OPBUFO
|
|
*** RTS * [SEMI-OBSOLETE OP; SLOWS DRAWING ON MAC]
|
|
|
|
SUBQ.W #1,D0 * NORMAL BUFFERING?
|
|
BEQ.S BUFOX1 * YES
|
|
ADDQ.W #1,D0 * NO BUFFERING, OUTPUT DIRECTLY TO SCREEN?
|
|
BEQ.S BUFOX2 * YES
|
|
BRA.S BUFOX3 * ELSE DO NOTHING
|
|
|
|
BUFOX1 MOVE.W #1,VOBUFF(A6) * TURN ON BUFFERING
|
|
BRA.S BUFOX3
|
|
BUFOX2
|
|
|
|
* DATA
|
|
* MSGBFO DC.B 'BUFOUT off',0
|
|
* CODE
|
|
* LEA MSGBFO,A0
|
|
* BSR ZWARN * SHOW A WARNING
|
|
|
|
BSR PUTLIN * FIRST EMPTY THE CURRENT OUTPUT BUFFER
|
|
CLR.W VOBUFF(A6) * THEN TURN OFF BUFFERING
|
|
BUFOX3 RTS
|
|
|
|
|
|
* ----------------------
|
|
* TABCHR
|
|
* ----------------------
|
|
|
|
* TABLE OUTPUT FUNCTION --- PUT THE CHAR IN D0 IN THE DEFINED TABLE
|
|
|
|
TABCHR MOVE.L TABPTR(A6),A0 * CURRENT POSITION IN TABLE
|
|
MOVE.B D0,(A0)+ * STORE CHAR
|
|
MOVE.L A0,TABPTR(A6) * UPDATE POINTER
|
|
|
|
BSR DCHSIZ * GET PIXEL WIDTH
|
|
MOVE.L BUFFER(A6),A0
|
|
ADD.W D0,PTWID(A0) * UPDATE COUNTER
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPDIRO
|
|
* ----------------------
|
|
|
|
* REDIRECT OUTPUT (TABLE OR NORMAL) ACCORDING TO INT
|
|
|
|
OPDIRO NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W ARG1(A0),D0 * VIRTUAL OUTPUT DEVICE -- NEGATIVE?
|
|
BLT.S DIRX0 * YES, MEANS TURN IT OFF
|
|
|
|
SUBQ.W #1,D0 * TURN ON SCREEN?
|
|
BEQ.S DIRX1 * YES
|
|
SUBQ.W #1,D0 * TURN ON PRINTER?
|
|
BEQ.S DIRX3 * YES
|
|
SUBQ.W #1,D0 * TURN ON TABLE?
|
|
BEQ.S DIRX5 * YES
|
|
RTS * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
DIRX0 ADDQ.W #1,D0 * TURN OFF SCREEN?
|
|
BEQ.S DIRX2 * YES
|
|
ADDQ.W #1,D0 * TURN OFF PRINTER?
|
|
BEQ.S DIRX4 * YES
|
|
ADDQ.W #1,D0 * TURN OFF TABLE?
|
|
BEQ.S DIRX6 * YES
|
|
RTS * UNKNOWN DEVICE, IGNORE REQUEST
|
|
|
|
*** TURN SCREEN OUTPUT ON, OFF
|
|
|
|
DIRX1 MOVE.W #1,VOCONS(A6)
|
|
BRA DIRX7
|
|
DIRX2 BSR PUTLIN * BUT FIRST DUMP BUFFER, IF NEEDED
|
|
CLR.W VOCONS(A6)
|
|
BRA DIRX7
|
|
|
|
*** TURN SCRIPTING OUTPUT ON, OFF
|
|
|
|
DIRX3 TST.W VOPRNT(A6) * ALREADY ON?
|
|
BNE.S DIRX7 * YES
|
|
|
|
MOVE.W #1,D0
|
|
MOVE.W D0,VOPRNT(A6)
|
|
BSR SCRINIT * OPEN SCRIPT CHANNEL (IF NEEDED)
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
BSET #FSCRI,PFLAGS+1(A0) * SET PRELOAD FLAG, FOR GAME'S USE
|
|
BRA.S DIRX7
|
|
|
|
DIRX4 TST.W VOPRNT(A6) * ALREADY OFF?
|
|
BEQ.S DIRX7 * YES
|
|
|
|
MOVEQ #0,D0
|
|
MOVE.W D0,VOPRNT(A6)
|
|
BSR SCRINIT * CLOSE SCRIPT CHANNEL (IF NEEDED)
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
BCLR #FSCRI,PFLAGS+1(A0) * CLEAR THE PRELOAD FLAG
|
|
BRA.S DIRX7
|
|
|
|
*** TURN TABLE ON, OFF
|
|
|
|
DIRX5 MOVE.L BUFFER(A6),A1
|
|
MOVEQ #0,D0
|
|
MOVE.W ARG2(A0),D0 * GET RELATIVE TABLE POINTER
|
|
ADD.L A1,D0 * ABSOLUTIZE
|
|
MOVE.L D0,TABOUT(A6) * REMEMBER START OF TABLE
|
|
|
|
ADDQ.L #2,D0 * SKIP LENGTH SLOT
|
|
MOVE.L D0,TABPTR(A6) * FIRST CHAR WILL GO HERE
|
|
|
|
CLR.W PTWID(A1) * RESET PIXEL COUNT
|
|
MOVE.W #1,VOTABL(A6) * SET TABLE-OUTPUT FLAG
|
|
BRA.S DIRX7
|
|
|
|
DIRX6 TST.W VOTABL(A6) * MAKE SURE A TABLE DOES EXIST
|
|
BEQ.S DIRX7 * NO TABLE, IGNORE REQUEST
|
|
CLR.W VOTABL(A6) * OK, TURN OFF TABLE-OUTPUT FLAG
|
|
|
|
MOVE.L TABOUT(A6),A0 * COMPUTE LENGTH OF CURRENT TABLE CONTENTS
|
|
MOVE.L TABPTR(A6),D0
|
|
SUB.L A0,D0
|
|
SUBQ.W #2,D0 * ADJUST FOR LENGTH SLOT
|
|
BSR PTAWRD * AND STORE LENGTH IN LENGTH SLOT
|
|
|
|
DIRX7 RTS
|
|
|
|
* REDIRECT INPUT (NORMAL OR COMMAND FILE) ACCORDING TO INT
|
|
|
|
* ----------------------
|
|
* OPDIRI
|
|
* ----------------------
|
|
|
|
OPDIRI NOP * TELL CALLER TO USE ARGBLK
|
|
*** 0 MEANS KEYBOARD, 1 MEANS SPECIAL FILE -- NOT IMPLEMENTED
|
|
RTS
|
|
|
|
* ----------------------
|
|
* OPSOUND
|
|
* ----------------------
|
|
|
|
* MAKE A SOUND
|
|
* ARG1 = ID: 1=BEEP, 2=BOOP, 3+ ARE SPECIAL, 0=MRU
|
|
* [ARG2] = ACTION: 1=INIT, [2=START], 3=STOP, 4=CLEANUP
|
|
* [ARG3] = COUNT (HIBYTE): -1=INFINITE, [0=USE MIDI COUNT], 1-254=FINITE
|
|
* VOL (LOBYTE): 0=MIN, 8=MAX, [-1=USE MIDI VOLUME]
|
|
* [ARG4] = INTERRUPT FUNCTION
|
|
|
|
OPSOUND NOP * REQUEST AN ARGBLK
|
|
LEA DEFBLK(A6),A1 * USE A DEFAULT ARGBLK, TOO
|
|
MOVE.W #4,(A1) * 4 ARGS MAX
|
|
MOVE.W #2,ARG2(A1) * DEFAULT ACTION = "START"
|
|
MOVE.W #$00FF,ARG3(A1) * DEFAULT COUNT=0/VOL=-1 (USE MIDI DATA)
|
|
CLR.W ARG4(A1) * DEFAULT INTERRUPT HANDLER = NONE
|
|
BSR SETDEF * SET UP DEFAULTS
|
|
|
|
MOVE.W ARG4(A0),SFUNC(A6) * SAVE INTERRUPT HERE
|
|
MOVE.W ARG3(A0),D2 * COUNT/VOL
|
|
MOVE.W D2,D3
|
|
EXT.W D2 * VOL (16 BITS)
|
|
LSR.W #8,D3 * COUNT (16 BITS, UNLESS -1)
|
|
CMPI.B #$FF,D3 * -1?
|
|
BNE.S OPSDX1
|
|
EXT.W D3 * YES, MAKE 16 BITS
|
|
|
|
OPSDX1 MOVE.W ARG2(A0),D1 * ACTION
|
|
MOVE.W ARG1(A0),D0 * SOUND ID
|
|
BRA DOSOUND
|
|
|
|
* ----------------------
|
|
* OPPICI
|
|
* ----------------------
|
|
|
|
* GET PICTURE INFO (SIZE)
|
|
|
|
OPPICI SUBQ.L #4,SP * TEMP TABLE, 2 WORDS, >> EVEN-ALIGNED <<
|
|
MOVE.L SP,A0
|
|
BSR PICINF * GET SIZE INFO, STORE IN TABLE
|
|
|
|
EXG D1,D0 * GIVEN TABLE (MAY BE ODD)
|
|
BSR RELABS
|
|
MOVE.W (SP)+,D0
|
|
BSR PTAWRD * COPY INFO TO GIVEN TABLE
|
|
MOVE.W (SP)+,D0
|
|
BSR PTAWRD
|
|
|
|
TST.W D1 * PICINF RESULT
|
|
BLT.S OPICX1 * NEG RESULT MEANS ERROR
|
|
BRA PTRUE
|
|
OPICX1 BRA PFALSE
|
|
|
|
* ----------------------
|
|
* OPDISP, OPDCLR
|
|
* ----------------------
|
|
|
|
* DISPLAY [OR CLEAR] A PICTURE
|
|
|
|
OPDISP DC.W 3 * DEFAULT ARGBLK
|
|
DC.W SKIP,-99,-99 * NEG POSITION MEANS READ PALETTE STUFF ONLY
|
|
|
|
MOVEQ #0,D3 * "CLEAR" FLAG OFF
|
|
BRA.S DISPX1
|
|
|
|
OPDCLR DC.W 3 * DEFAULT ARGBLK
|
|
DC.W SKIP,-99,-99
|
|
|
|
MOVEQ #1,D3 * "CLEAR" FLAG ON
|
|
|
|
DISPX1 MOVE.W ARG1(A0),D0
|
|
MOVE.W ARG2(A0),D1
|
|
MOVE.W ARG3(A0),D2
|
|
BRA PICDISP
|
|
|
|
|
|
* ----------------------
|
|
* OPMENU
|
|
* ----------------------
|
|
|
|
OPMENU BRA PFALSE * [NOT IMPLEMENTED]
|
|
|
|
* ----------------------
|
|
* OPPICSET
|
|
* ----------------------
|
|
|
|
PSMAX EQU 256 * CONVENIENT MAX ITEM COUNT
|
|
|
|
* PRELOAD A PICTURE SET, D0.W = TABLE LOC
|
|
* THINGS TO PONDER:
|
|
* - THE TABLE IS NOT GUARANTEED TO BE WORD ALIGNED (DESIRABLE ON 68K MICROS),
|
|
* OR EVEN TO BE IN PRELOAD. THEREFORE, WE CREATE TEMP SPACE ON THE STACK
|
|
* AND COPY THE TABLE, ONE WORD AT A TIME.
|
|
* - THE TABLE LENGTH ISN'T KNOWN AHEAD OF TIME (AN LTABLE WOULD BE CONVENIENT
|
|
* HERE). RATHER THAT SCANNING THE TABLE TWICE, WE JUST DEFINE A COMFORTABLE
|
|
* MAXIMUM (ANY ITEMS BEYOND THE MAX WILL JUST BE IGNORED).
|
|
|
|
OPPICSET
|
|
TST.W D0
|
|
BEQ.S PCSTX9 * "0 = UNLOAD OLD PICSET" -- A NOOP FOR US
|
|
BSR BSPLTB * SPLIT THE BYTE POINTER
|
|
|
|
SUBA.W #PSMAX*2,SP * CREATE TEMP SPACE (BYTES)
|
|
MOVE.L SP,A2 * BASE
|
|
|
|
MOVEQ #0,D3
|
|
PCSTX2 BSR GETWRD * UPDATE D0/D1, RESULT IN D2
|
|
MOVE.W D2,(A2)+ * COPY ONE ITEM
|
|
BEQ.S PCSTX4 * ZERO MEANS END OF TABLE
|
|
|
|
ADDQ.W #1,D3 * RUNNING COUNT OF ITEMS
|
|
CMPI.W #PSMAX,D3 * ROOM FOR MORE?
|
|
BLT.S PCSTX2 * YES
|
|
*** BSR ZWARN
|
|
|
|
PCSTX4 MOVE.L SP,A0
|
|
MOVE.W D3,D0
|
|
BSR PICSET * A0 -> TABLE, D0.W = COUNT
|
|
ADDA.W #PSMAX*2,SP * FLUSH STACK
|
|
PCSTX9 RTS
|
|
|
|
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* CONTROL OPERATIONS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
MAXLOCS EQU 15 * MAXIMUM LOCALS; VARS 16-255 ARE GLOBAL
|
|
CVFLAG EQU $0100 * FLAG SET (HIGH BYTE) IF CALL RETURNS A VALUE
|
|
|
|
* ----------------------
|
|
* OPICALL, ETC
|
|
* ----------------------
|
|
|
|
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS), NO RETURNED VALUE
|
|
|
|
OPICAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP
|
|
MOVE.W #1,(A0) * ONE ARG (THE FUNCTION)
|
|
MOVE.W D0,ARG1(A0)
|
|
|
|
OPICAL2
|
|
OPIXCAL
|
|
OPICALL NOP * TELL CALLER TO USE ARGBLK
|
|
MOVEQ #0,D3 * FLAG -- DON'T RETURN A VALUE
|
|
BRA.S CALLX1
|
|
|
|
* ----------------------
|
|
* OPCALL, ETC
|
|
* ----------------------
|
|
|
|
* CALL (A FUNCTION WITH OPTIONAL ARGUMENTS)
|
|
|
|
OPCAL1 LEA ARGBLK(A6),A0 * MUST SET UP AN ARGUMENT BLOCK FOR 1-OP
|
|
MOVE.W #1,(A0) * ONE ARG (THE FUNCTION)
|
|
MOVE.W D0,ARG1(A0)
|
|
|
|
OPCAL2
|
|
OPXCAL
|
|
OPCALL NOP * TELL CALLER TO USE ARGBLK
|
|
MOVE.W #CVFLAG,D3 * FLAG (HIGH BYTE) -- RETURN A VALUE
|
|
|
|
*** COMMON ENTRY POINT, A0 -> ARGBLK, D3 (HIGH BYTE) = RETURN-VALUE FLAG
|
|
|
|
CALLX1 MOVE.L A0,A2
|
|
MOVE.W (A2)+,D2 * ARG COUNT
|
|
MOVE.W (A2)+,D0 * FUNCTION TO CALL -- IS IT ZERO?
|
|
BNE.S CALLX2 * NO
|
|
|
|
TST.W D3 * SPECIAL CASE -- RETURN A VALUE?
|
|
BEQ.S CALLX9 * NO, JUST EXIT
|
|
* CLR.W D0 * YES, RETURN A ZERO
|
|
BRA PUTVAL
|
|
|
|
*** BUILD A STACK FRAME, THEN UPDATE THE ZPC AND STATE VARS ...
|
|
|
|
CALLX2 MOVE.W ZPC1(A6),-(A4) * SAVE OLD ZPC
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
MOVE.B NARGS+1(A6),D3 * SAVE OLD "OPTIONALS" COUNT ...
|
|
MOVE.W D3,-(A4) * ALONG WITH /NEW/ RETURN FLAG
|
|
|
|
* >>> old locs pointer (rel) now stacked as word, instead of long <<<
|
|
* >>> new locs pointer now points to (pseudo) loc 0, instead of 1 <<<
|
|
|
|
MOVE.L ZLOCS(A6),D1 * OLD LOCALS/FRAME POINTER
|
|
SUB.L STKBOT(A6),D1 * BUT RELATIVIZE IT, IN CASE OF GAME SAVE
|
|
MOVE.W D1,-(A4) * SAVE IT
|
|
MOVE.L A4,ZLOCS(A6) * NEW LOCALS/FRAME POINTER
|
|
|
|
SUBQ.W #1,D2 * NUMBER OF PARAMETERS ("OPTIONALS")
|
|
MOVE.B D2,NARGS+1(A6) * REMEMBER IT (BYTE)
|
|
|
|
MOVEQ #0,D1 * ZERO HIGH WORD
|
|
MOVE.W D0,D1 * QUAD PTR
|
|
MOVE.L QFOFF(A6),D0 * QUAD FUNCTION OFFSET
|
|
BSR BSPLTQ2 * SPLIT THE BLOCK AND OFFSET
|
|
|
|
MOVE.W D0,ZPC1(A6) * MAKE IT THE NEW ZPC
|
|
MOVE.W D1,ZPC2(A6)
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
|
|
*** GET FUNCTION HEADER
|
|
|
|
BSR NXTBYT * TOTAL # DEFINED LOCALS
|
|
MOVE.W D0,D1
|
|
CMPI.W #MAXLOCS,D1 * VALID?
|
|
BLS.S CALLX3
|
|
LEA MSGCA1,A0 * TOO MANY LOCALS DEFINED
|
|
BSR ZWARN * SHOW A WARNING
|
|
MOVEQ #MAXLOCS,D1 * (CUT BACK -- CAN'T BE TOUCHED ANYWAY)
|
|
|
|
CALLX3 CMP.W D2,D1 * VALID?
|
|
BCC.S CALLX4 * BHS
|
|
LEA MSGCA2,A0 * TOO MANY OPTIONALS SUPPLIED
|
|
BSR ZWARN * SHOW A WARNING
|
|
MOVE.W D1,D2 * (CUT BACK -- WON'T BE TOUCHED ANYWAY)
|
|
|
|
CALLX4 SUB.W D2,D1 * THIS IS NUMBER OF "DEFAULT" VALUES
|
|
BRA.S CALLX6
|
|
|
|
DATA
|
|
MSGCA1 DC.B 'Bad loc num',0
|
|
MSGCA2 DC.B 'Bad optional num',0
|
|
CODE
|
|
|
|
*** BUILD & INITIALIZE A LOCALS FRAME ...
|
|
|
|
CALLX5 MOVE.W (A2)+,-(A4) * POSITION THE OPTIONAL VALUES FIRST
|
|
CALLX6 DBF D2,CALLX5 * ZERO CHECK -- ANY MORE?
|
|
MOVEQ #0,D0
|
|
BRA.S CALLX8
|
|
|
|
CALLX7 MOVE.W D0,-(A4) * CLEAR THE REMAINING DEFAULT VALUES [XZIP]
|
|
CALLX8 DBF D1,CALLX7 * ZERO CHECK -- ANY MORE?
|
|
CALLX9 RTS * DONE
|
|
|
|
* ----------------------
|
|
* OPASSN
|
|
* ----------------------
|
|
|
|
* ASSIGNED? (A LOCAL AN OPTIONAL VALUE)
|
|
|
|
OPASSN CMP.B NARGS+1(A6),D0 * WAS THIS LOCAL ASSIGNED A VALUE?
|
|
BGT PFALSE * NO, VALUE DEFAULTED TO ZERO
|
|
BRA PTRUE * YES
|
|
|
|
* ----------------------
|
|
* OPRETU
|
|
* ----------------------
|
|
|
|
* RETURN (FROM CURRENT FUNCTION CALL)
|
|
|
|
OPRETU MOVE.L ZLOCS(A6),A4 * OLD TOP-OF-STACK
|
|
MOVEQ #0,D1
|
|
MOVE.W (A4)+,D1 * RESTORE OLD LOCALS POINTER
|
|
ADD.L STKBOT(A6),D1 * ABSOLUTIZE IT
|
|
MOVE.L D1,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,D2 * RESTORE RETURN FLAG, OPTS COUNT
|
|
MOVE.B D2,NARGS+1(A6)
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OLD ZPC
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
IF EZIP THEN
|
|
BLT INRETU * SPECIAL INTERNAL CALL/RETURN, HANDLE IT
|
|
ENDIF
|
|
MOVE.W D0,D1 * PROTECT VALUE (IF ANY -- XZIP)
|
|
BSR NEWZPC * UPDATE ZPC STUFF
|
|
MOVE.W D1,D0
|
|
|
|
ANDI.W #CVFLAG,D2 * WAS THIS A RETURN-VALUE CALL? (XZIP)
|
|
BNE PUTVAL * YES, RETURN THE VALUE
|
|
RTS * NO, JUST EXIT
|
|
|
|
* ----------------------
|
|
* OPRTRU
|
|
* ----------------------
|
|
|
|
* RTRUE
|
|
|
|
OPRTRU MOVEQ #1,D0 * RETURN A "1"
|
|
BRA.S OPRETU
|
|
|
|
* ----------------------
|
|
* OPRFAL
|
|
* ----------------------
|
|
|
|
* RFALSE
|
|
|
|
OPRFAL CLR.W D0 * RETURN A "0"
|
|
BRA.S OPRETU
|
|
|
|
* ----------------------
|
|
* OPRSTA
|
|
* ----------------------
|
|
|
|
* RSTACK (RETURN STACK)
|
|
|
|
OPRSTA MOVE.W (A4)+,D0 * POP A VALUE
|
|
BRA OPRETU * AND RETURN IT
|
|
|
|
* ----------------------
|
|
* OPFSTA
|
|
* ----------------------
|
|
|
|
* FSTACK (FLUSH 'N' ELEMENTS OFF A STACK) *** REVIVED FOR YZIP
|
|
|
|
OPFSTA NOP * REQUEST AN ARGBLK
|
|
MOVE.W ARG1(A0),D1 * #ITEMS TO FLUSH
|
|
CMPI.W #1,(A0) * STACK SUPPLIED?
|
|
BGT.S FSTAX2 * YES
|
|
ADD.W D1,D1
|
|
ADDA.W D1,A4 * NO, ADJUST GAME STACK
|
|
BRA.S FSTAX4
|
|
|
|
FSTAX2 MOVE.W ARG2(A0),D0
|
|
BSR RELABS * GET A0 -> LTABLE
|
|
BSR GTAWRD * GET D0.W = SPACE REMAINING, ADVANCE A0
|
|
SUBQ.W #2,A0
|
|
ADD.W D1,D0
|
|
BSR PTAWRD * UPDATE LENGTH SLOT
|
|
FSTAX4 RTS
|
|
|
|
* ----------------------
|
|
* OPJUMP
|
|
* ----------------------
|
|
|
|
* JUMP (TO A NEW LOCATION)
|
|
|
|
OPJUMP SUBQ.W #2,D0 * ADJUST OFFSET
|
|
ADD.W D0,ZPC2(A6) * ADD OFFSET TO CURRENT ZPC
|
|
BRA NEWZPC * NORMALIZE IT & UPDATE ZPC STUFF
|
|
|
|
* ----------------------
|
|
* OPNOOP
|
|
* ----------------------
|
|
|
|
* NOOP (NO OPERATION)
|
|
|
|
OPNOOP RTS * DO NOTHING
|
|
|
|
* ----------------------
|
|
* OPCATCH
|
|
* ----------------------
|
|
|
|
* CATCH
|
|
|
|
OPCATCH MOVE.L ZLOCS(A6),D0 * THE CURRENT "FRAME POINTER"
|
|
SUB.L STKBOT(A6),D0 * RELATIVIZE IT
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPTHROW
|
|
* ----------------------
|
|
|
|
* THROW (NON-LOCAL RETURN)
|
|
|
|
OPTHROW EXT.L D1 * A PREVIOUS FRAME PTR
|
|
ADD.L STKBOT(A6),D1 * ABSOLUTIZE
|
|
CMP.L ZLOCS(A6),D1 * VALID FRAME?
|
|
BLT.S THRX1 * ERROR
|
|
MOVE.L D1,ZLOCS(A6) * OK, FLUSH ANY INTERMEDIATE FRAMES
|
|
BRA OPRETU * AND RETURN VAL (STILL IN D0)
|
|
|
|
THRX1 CLR.W D0
|
|
LEA MSGTHR,A0
|
|
BRA FATAL
|
|
DATA
|
|
MSGTHR DC.B 'Bad Throw',0
|
|
CODE
|
|
|
|
* ----------------------
|
|
* INCALL
|
|
* ----------------------
|
|
|
|
IF EZIP THEN
|
|
|
|
* INTERNALLY CALL A FUNCTION, FUNCTION IN D0, RETURN VALUE IN D0
|
|
|
|
INCALL MOVEM.L D1-D7/A1-A3,-(SP) * SAVE EVERYTHING
|
|
|
|
MOVE.W ZPC1(A6),-(SP)
|
|
MOVE.W #-1,ZPC1(A6) * FAKE ZPC1, SIGNALS AN INTERNAL CALL/RETURN
|
|
|
|
LEA ARGBLK(A6),A0 * SET UP ARGBLK FOR OPCALL
|
|
MOVE.W D0,ARG1(A0) * FUNCTION TO CALL
|
|
MOVE.W #1,(A0) * ONE ARG (FUNCTION ITSELF)
|
|
|
|
BSR OPCALL * CALL THE TIMEOUT FUNCTION
|
|
BRA NXTINS * GO EXECUTE IT
|
|
|
|
* ----------------------
|
|
* INRETU
|
|
* ----------------------
|
|
|
|
* JUMP BACK TO HERE UPON NEXT OPRETURN ...
|
|
|
|
INRETU ADDQ.L #4,SP * CAREFUL -- FLUSH TOP RETURN ADDR (NXTINS)
|
|
MOVE.W (SP)+,ZPC1(A6) * FIX THE ZPC
|
|
|
|
MOVE.W D0,D1
|
|
BSR NEWZPC * RESTORE THE PROPER PAGE
|
|
MOVE.W D1,D0
|
|
|
|
MOVEM.L (SP)+,D1-D7/A1-A3
|
|
RTS * RETURN TO ORIGINAL CALLER
|
|
ENDIF
|
|
|
|
EJECT ; PAGE
|
|
* ----------------------------------------------------------------------------
|
|
* GAME COMMANDS
|
|
* ----------------------------------------------------------------------------
|
|
|
|
* ------------------------------
|
|
* PRIMITIVES FOR SAVE/RESTORE
|
|
* ------------------------------
|
|
|
|
* SAVE STATE VARIABLES ON GAME STACK
|
|
|
|
SAVSTA MOVE.W ZPC1(A6),-(A4)
|
|
MOVE.W ZPC2(A6),-(A4)
|
|
|
|
MOVE.L STKBOT(A6),A0
|
|
MOVE.L ZLOCS(A6),D0 * RELATIVIZE THIS ONE
|
|
SUB.L A0,D0
|
|
MOVE.W D0,-(A4)
|
|
MOVE.W ZORKID(A6),-(A4)
|
|
|
|
MOVE.L A4,D0
|
|
SUB.L A0,D0 * RELATIVIZE GAME SP, TOO
|
|
MOVE.W D0,(A0) * AND SAVE IT IN KNOWN LOCATION
|
|
ADDA.W #8,A4 * RESET THE GAME SP
|
|
RTS
|
|
|
|
* RESTORE STATE VARIABLES FROM GAME STACK, RETURN ZORKID IN D0 AND FLAGS
|
|
|
|
RESSTA MOVE.L STKBOT(A6),A0
|
|
MOVEQ #0,D0
|
|
MOVE.W (A0),D0 * RESTORE GAME SP FROM KNOWN LOCATION
|
|
ADD.L A0,D0 * RE-ABSOLUTIZE IT
|
|
MOVE.L D0,A4
|
|
|
|
MOVE.W (A4)+,-(SP) * GET THE SAVED ZORKID
|
|
MOVEQ #0,D0
|
|
MOVE.W (A4)+,D0 * RESTORE OLD LOCALS POINTER
|
|
ADD.L A0,D0 * RE-ABSOLUTIZE IT
|
|
MOVE.L D0,ZLOCS(A6)
|
|
|
|
MOVE.W (A4)+,ZPC2(A6) * RESTORE OTHER STUFF
|
|
MOVE.W (A4)+,ZPC1(A6)
|
|
|
|
MOVE.W (SP)+,D0
|
|
CMP.W ZORKID(A6),D0 * IS ID THE SAME AS OURS?
|
|
RTS * (RETURN WITH FLAGS)
|
|
|
|
* ----------------------
|
|
* OPISAV
|
|
* ----------------------
|
|
|
|
* ISAVE (SAVE TO MEMORY BUFFER)
|
|
|
|
OPISAV BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK
|
|
MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER
|
|
BEQ SAVERR * ERROR, BUFFER DOESN'T EXIST
|
|
MOVE.L STKBOT(A6),A0
|
|
MOVE.L D2,A1
|
|
MOVE.L #STKLEN,D0
|
|
BSR MOVMEM * SAVE THE STACK (FAST BLOCKMOVE)
|
|
|
|
MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVE.L D2,A1
|
|
ADDA.W #STKLEN,A1 * START WRITING AFTER STACK
|
|
MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS
|
|
BSR BLKBYT
|
|
BSR MOVMEM * SAVE IMPURE DATA (FAST BLOCKMOVE)
|
|
BRA SAVEOK * SUCCESS
|
|
|
|
* ----------------------
|
|
* OPSAVE
|
|
* ----------------------
|
|
|
|
PSNLEN EQU 32 * MAX LENGTH OF SUGGESTED NAME
|
|
|
|
* SAVE (STATE OF GAME, OR SELECTED "PARTIAL" DATA)
|
|
|
|
OPSAVE NOP
|
|
TST.W (A0) * PARTIAL SAVE (ANY ARGS)?
|
|
BEQ SVX2 * NO
|
|
|
|
*** HANDLE A PARTIAL SAVE, A0 -> ARGBLK ***
|
|
|
|
MOVE.L A0,A2
|
|
CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH
|
|
BSR RELABS
|
|
MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL
|
|
MOVEQ #1,D0 * OPSAVE
|
|
MOVEQ #1,D1 * PARTIAL
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE SVX14 * CANCELLED
|
|
|
|
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
|
|
BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE)
|
|
|
|
* WRITE SUGGESTED NAME TO FILE
|
|
|
|
MOVEQ #0,D0
|
|
MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME
|
|
MOVE.L A1,A0 * STARTS HERE (WITH LENGTH BYTE)
|
|
BSR SFWRIT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
* WRITE DATA TO FILE
|
|
|
|
MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVEQ #PSNLEN,D0 * FILE OFFSET
|
|
MOVEQ #0,D1
|
|
MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA
|
|
BSR SFWRIT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
BSR DEFOLD * OK >>> BUT RESTORE "NORMAL" FILE NAMES <<<
|
|
BRA SVX10 * AND CLEAN UP
|
|
|
|
*** ENTER HERE FOR "STANDARD" SAVE ***
|
|
|
|
SVX2 CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVEQ #1,D0 * OPSAVE
|
|
CLR.W D1 * STANDARD
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE SVX14 * CANCELLED
|
|
|
|
BSR NEWSFL * CREATE (IF NEEDED) AND OPEN THE FILE
|
|
BNE SVX14 * ERROR, JUST EXIT (NEED NOT DELETE)
|
|
|
|
* SAVE GAME STACK, THEN IMPURE PRELOAD
|
|
|
|
BSR SAVSTA * SAVE STATE VARIABLES ON GAME STACK
|
|
MOVE.L STKBOT(A6),A0
|
|
CLR.W D0 * THIS WILL BE BLOCK ZERO
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
BSR PTSBKS * WRITE IT OUT
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
MOVE.L BUFFER(A6),A0 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVEQ #STKLEN/512,D0 * START WRITING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * NUMBER OF IMPURE BLOCKS
|
|
BSR PTSBKS
|
|
BNE SVX12 * ERROR, CLOSE AND DELETE THE FILE
|
|
|
|
* SAVE SUCCEEDED
|
|
|
|
SVX10 BSR CLSSFL * SUCCESS, CLOSE THE FILE [NO ERRORS]
|
|
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
SAVEOK MOVEQ #1,D0 * RETURN "SAVE OK"
|
|
BRA PUTVAL
|
|
|
|
* SAVE FAILED FOR SOME REASON ...
|
|
|
|
SVX12 BSR CLSSFL * CLOSE THE BAD FILE
|
|
BSR DELSFL * AND DELETE THE BAD FILE FROM THE DIRECTORY
|
|
|
|
SVX14 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
SAVERR CLR.W D0 * RETURN "SAVE FAILED"
|
|
BRA PUTVAL
|
|
|
|
* ----------------------
|
|
* OPIRES
|
|
* ----------------------
|
|
|
|
* IRESTORE (RESTORE FROM MEMORY BUFFER)
|
|
|
|
OPIRES MOVE.L MSAVEB(A6),D2 * PTR, ISAVE BUFFER
|
|
BEQ RESERR * ERROR, BUFFER DOESN'T EXIST
|
|
MOVE.L D2,A0
|
|
TST.W (A0)
|
|
BEQ RESERR * ERROR, NO PREVIOUS ISAVE!
|
|
MOVE.L STKBOT(A6),A1
|
|
MOVE.L #STKLEN,D0
|
|
BSR MOVMEM * RESTORE THE GAME STACK (FAST BLOCKMOVE)
|
|
|
|
BSR RESSTA * UNSTACK THE OLD STATE INFO
|
|
BNE RESX15 * ERROR, WRONG ZORKID
|
|
|
|
MOVE.L D2,A0
|
|
ADDA.W #STKLEN,A0 * START READING AFTER STACK
|
|
MOVE.L BUFFER(A6),A1 * BEGINNING OF IMPURE STUFF IN CORE
|
|
MOVE.W PURBOT(A6),D0 * IMPURE BLOCKS
|
|
BSR BLKBYT
|
|
BSR MOVMEM * RESTORE IMPURE DATA (FAST BLOCKMOVE)
|
|
BRA RESTOK * SUCCESS
|
|
|
|
* ----------------------
|
|
* OPREST
|
|
* ----------------------
|
|
|
|
* RESTORE (STATE OF GAME, OR SELECTED "PARTIAL" DATA)
|
|
|
|
OPREST NOP
|
|
TST.W (A0) * PARTIAL RESTORE (ANY ARGS)?
|
|
BEQ RESX2 * NO
|
|
|
|
*** HANDLE A PARTIAL RESTORE, A0 -> ARGBLK ***
|
|
|
|
MOVE.L A0,A2
|
|
CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
MOVE.W ARG3(A2),D0 * "SUGGESTED" NAME, BYTE 0 = LENGTH
|
|
BSR RELABS
|
|
MOVE.L A0,A1 * SAVE HERE, & PASS TO FSEL
|
|
MOVEQ #0,D0 * RESTORE
|
|
MOVEQ #1,D1 * PARTIAL
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE RESX13 * CANCELLED
|
|
|
|
BSR OPNSFL * OPEN THE FILE
|
|
BNE RESX13 * ERROR
|
|
|
|
* READ (PREVIOUS) SUGGESTED NAME FROM FILE, & CHECK FOR A MATCH
|
|
|
|
MOVEQ #0,D0
|
|
MOVEQ #PSNLEN,D1 * MAX LENGTH OF SUGGESTED NAME
|
|
MOVE.L STKBOT(A6),A0 * (GRAB TEMP BUFFER AT BASE OF ZSTACK)
|
|
BSR SFREAD
|
|
BNE RESX12 * ERROR, CLOSE THE FILE (NOT FATAL)
|
|
|
|
MOVE.L A1,A0 * CURRENT NAME STARTS HERE (WITH LENGTH BYTE)
|
|
MOVE.L STKBOT(A6),A1
|
|
MOVEQ #1,D0 * COUNT LENGTH BYTE
|
|
ADD.B (A0),D0
|
|
BSR COMPS * COMPARE THE STRINGS
|
|
BNE RESX12 * DIFFERENT, ERROR, CLOSE THE FILE
|
|
|
|
* READ DATA FROM FILE
|
|
|
|
MOVE.W ARG1(A2),D0 * BASE OF PARTIAL SAVE
|
|
BSR RELABS * ABSOLUTIZE
|
|
MOVEQ #PSNLEN,D0 * FILE OFFSET
|
|
MOVEQ #0,D1
|
|
MOVE.W ARG2(A2),D1 * LENGTH OF PARTIAL SAVE DATA
|
|
BSR SFREAD * [RETURNS ACTUAL BYTES READ IN D1]
|
|
BNE RESX12 * ERROR, CLOSE THE FILE
|
|
|
|
BSR DEFOLD * >>> RESTORE "NON-PARTIAL" FILE NAMES <<<
|
|
BSR CLSSFL * CLOSE THE FILE
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
*** [SYSTEM STACK HACKING AND CALL TO NEWZPC NOT NEEDED AFTER PARTIAL OP]
|
|
|
|
MOVE.W D1,D0 * RETURN "ACTUAL BYTES READ"
|
|
BRA PUTVAL
|
|
|
|
*** ENTER HERE FOR "STANDARD" RESTORE ***
|
|
|
|
RESX2 CLR.W D0
|
|
BSR CHKDSK * CHECK FOR GAME DISK AND CLOSE GAME FILE
|
|
|
|
CLR.W D0 * RESTORE
|
|
CLR.W D1 * STANDARD
|
|
BSR GETSFL * GET A NAME FOR THE SAVE FILE
|
|
BNE RESX13 * CANCELLED
|
|
|
|
*** ENTER HERE IF DOING SPECIAL RESTORE DURING LAUNCH ***
|
|
|
|
RES1 BSR OPNSFL * OPEN THE FILE
|
|
BNE RESX13 * ERROR
|
|
|
|
CLR.W D0 * FIRST READ IN STACK
|
|
MOVEQ #STKLEN/512,D1 * BLOCK LENGTH OF STACK
|
|
MOVE.L STKBOT(A6),A0 * PUT IT HERE
|
|
BSR GTSBKS
|
|
BNE RESX16 * DIE IF DISK ERROR
|
|
|
|
BSR RESSTA * UNSTACK THE OLD STATE INFO
|
|
BNE RESX14 * ERROR, WRONG ZORKID
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PFLAGS(A0),-(SP) * PRESERVE THE FLAGS (SCRIPT ETC)
|
|
|
|
MOVEQ #STKLEN/512,D0 * READ IMPURE STUFF STARTING AFTER STACK
|
|
MOVE.W PURBOT(A6),D1 * LENGTH OF IMPURE STUFF
|
|
BSR GTSBKS
|
|
BNE RESX16 * DIE IF DISK ERROR
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W (SP)+,PFLAGS(A0) * RESTORE THE OLD FLAGS
|
|
|
|
* RESTORE SUCCEEDED
|
|
|
|
RESX10 BSR CLSSFL * CLOSE THE FILE
|
|
BSR DEFNEW * UPDATE PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * (1) MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
BSR INITDISP * UPDATE TTY-SPECIFIC LOWCORE (IF NEEDED)
|
|
|
|
* A subtle bug was found in ZIP20 when certain calls that reset the game
|
|
* state (the ZPC and stack) occurred during a timer interrupt. Since control
|
|
* never returned to the code that caused the interrupt, the system (machine)
|
|
* stack never got cleaned up. After several such calls it overflowed.
|
|
|
|
* The questionable calls include (a successful) Restore or Irestore (Undo),
|
|
* and Restart. The first two are handled here, the last elsewhere.
|
|
|
|
RESTOK MOVE.L TOPSP(A6),SP * MAKE SURE THE SYSTEM STACK IS CLEAN
|
|
PEA NXTINS * AND HACK IT SO WE WILL RETURN TO MAIN LOOP
|
|
|
|
BSR NEWZPC * (2) GET THE PROPER ZPC PAGE
|
|
MOVEQ #2,D0 * RETURN "RESTORE OK"
|
|
BRA PUTVAL
|
|
|
|
* SOMETHING WRONG, FAIL ...
|
|
|
|
RESX12 BSR CLSSFL * CLOSE THE FILE
|
|
RESX13 BSR DEFOLD * INSTALL PREVIOUS DEFAULT NAMES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK * MAKE SURE GAME DISK IS BACK IN DRIVE
|
|
|
|
RESERR CLR.W D0 * RETURN "RESTORE FAILED"
|
|
BRA PUTVAL
|
|
|
|
* FATAL ERROR: BAD ZORKID
|
|
|
|
RESX14 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE
|
|
MOVE.W (SP)+,D0 * BAD VERSION ID
|
|
|
|
RESX15 LEA MSGRE2,A0
|
|
BRA FATAL * 'Wrong save file version'
|
|
DATA
|
|
MSGRE2 DC.B 'Wrong save file version',0
|
|
CODE
|
|
|
|
* FATAL ERROR: RESTORE READ ERROR
|
|
|
|
RESX16 MOVE.W D0,-(SP)
|
|
BSR CLSSFL * CLOSE THE BAD FILE AND DIE
|
|
MOVE.W (SP)+,D0 * ERROR CODE
|
|
|
|
LEA MSGRE1,A0
|
|
BRA FATAL * 'Save file read error'
|
|
DATA
|
|
MSGRE1 DC.B 'Save file read error',0
|
|
CODE
|
|
|
|
* ----------------------
|
|
* OPRSTT
|
|
* ----------------------
|
|
|
|
* RESTART (THE GAME)
|
|
|
|
OPRSTT BSR PUTNEW * FORCE OUT ANY QUEUED TEXT
|
|
MOVE.L CURWP(A6),A0
|
|
CLR.W WLCNT(A0) * RESET COUNTER
|
|
|
|
TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN?
|
|
BNE.S RSTTX1 * YES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED)
|
|
|
|
RSTTX1 MOVEQ #-1,D0
|
|
BSR OPCLEAR * CLEAR (AND UNSPLIT) SCREEN
|
|
BRA RESTRT * SKIP MOST INITIALIZATIONS
|
|
|
|
* ----------------------
|
|
* OPQUIT
|
|
* ----------------------
|
|
|
|
* QUIT
|
|
|
|
OPQUIT BRA FINISH * DIE PEACEFULLY
|
|
|
|
* ----------------------
|
|
* OPVERI
|
|
* ----------------------
|
|
|
|
* VERIFY (GAME FILE)
|
|
|
|
OPVERI
|
|
IF CZIP THEN * VERSION INFO FOR ZIP ONLY
|
|
LEA MSGVER,A0
|
|
BSR OUTMSG0 * 'Macintosh interpreter version '
|
|
DATA
|
|
MSGVER DC.B 'Macintosh interpreter version ',0
|
|
CODE
|
|
|
|
MOVE.W INTWRD,D0 * DISPLAY THE LETTER (LOW BYTE)
|
|
BSR OPPRNC
|
|
BSR OPCRLF
|
|
|
|
TST.W SUBVER * DISPLAY SUB-VERSION ONLY IF NON-ZERO
|
|
BEQ.S VERX0
|
|
|
|
LEA MSGVR2,A0
|
|
BSR OUTMSG0 * 'Sub-version '
|
|
DATA
|
|
MSGVR2 DC.B 'Sub-version ',0
|
|
CODE
|
|
|
|
MOVE.W SUBVER,D0 * DISPLAY THE SUB-VERSION NUMBER
|
|
BSR OPPRNN
|
|
BSR OPCRLF
|
|
ENDIF
|
|
|
|
VERX0 TST.W GAMFIL(A6) * GAME FILE ALREADY OPEN?
|
|
BNE.S VERX0A * YES
|
|
MOVEQ #1,D0
|
|
BSR CHKDSK1 * NO, OPEN IT NOW (PROMPTING AS NEEDED)
|
|
|
|
VERX0A MOVE.L BUFFER(A6),A0
|
|
MOVEQ #0,D0
|
|
MOVE.W PLENTH(A0),D0 * LENGTH OF GAME FILE (QUADS OR OCTS)
|
|
|
|
MOVE.W PFOFF(A0),D1 * IS THIS IS A MOBY GAME?
|
|
ADD.W PSOFF(A0),D1
|
|
BEQ.S VERX0B * IF BOTH ZERO, NO
|
|
ADD.L D0,D0 * YES, LENGTH WAS OCTS, MAKE QUADS
|
|
|
|
VERX0B MOVEQ #0,D1 * [NULL 2ND ARG]
|
|
BSR BSPLTQ2 * SPLIT INTO BLOCK AND OFFSET
|
|
|
|
MOVE.W D0,D4 * THIS IS FINAL BLOCK
|
|
MOVE.W D1,D5 * FINAL BYTE
|
|
|
|
CLR.W D0 * STARTING BLOCK NUMBER
|
|
MOVEQ #64,D1 * STARTING BYTE NUMBER
|
|
CLR.W D3 * CHECKSUM HERE
|
|
MOVE.W ENDLOD(A6),-(SP)
|
|
CLR.W ENDLOD(A6) * FORCE LOADING FROM DISK
|
|
|
|
VERX1 BSR GETBYT * GET NEXT BYTE
|
|
ADD.W D2,D3 * ADD IN TO CHECKSUM
|
|
CMP.W D0,D4 * DONE YET?
|
|
BNE VERX1 * NO
|
|
CMP.W D1,D5 * MAYBE
|
|
BNE VERX1 * NO
|
|
|
|
MOVE.W (SP)+,ENDLOD(A6) * YES, RESTORE PROPER ENDLOD
|
|
|
|
MOVE.L BUFFER(A6),A0
|
|
MOVE.W PCHKSM(A0),D0 * GET THE REAL CHECKSUM
|
|
CMP.W D0,D3
|
|
BNE.S VERX2 * ERROR
|
|
|
|
BRA PTRUE * SUCCESS
|
|
VERX2 BRA PFALSE * FAILURE
|
|
|
|
* ----------------------
|
|
* OPORIG
|
|
* ----------------------
|
|
|
|
* ORIGINAL (NOT A COPY) GAME DISK?
|
|
|
|
OPORIG BRA PTRUE * <Mac> NO COPY-PROTECTION, SO ALWAYS TRUE
|
|
|