491 lines
9.0 KiB
Plaintext
491 lines
9.0 KiB
Plaintext
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT READ-INPUT,TRM,TMP,N,M,FDEF,DIR,?TMP1
|
|
PUTB P-INBUF,1,0
|
|
?PRG1: ZERO? DEMO-VERSION? /?CCL5
|
|
CALL READ-DEMO,P-INBUF,FALSE-VALUE >TRM
|
|
JUMP ?CND3
|
|
?CCL5: READ P-INBUF,FALSE-VALUE >TRM
|
|
?CND3: ICALL1 MOUSE-INPUT?
|
|
EQUAL? TRM,PAD0 \?CCL8
|
|
SET 'TRM,F10
|
|
JUMP ?CND6
|
|
?CCL8: LESS? TRM,PAD1 /?CND6
|
|
GRTR? TRM,PAD9 /?CND6
|
|
SUB TRM,PAD1
|
|
ADD F1,STACK >TRM
|
|
?CND6: EQUAL? TRM,CLICK1,CLICK2 \?CCL14
|
|
CALL COMPASS-CLICK,COMPASS-PIC-LOC,N-HL >DIR
|
|
ZERO? DIR /?PRG1
|
|
DIROUT D-TABLE-ON,O-INBUF
|
|
CALL2 DIR-TO-STRING,DIR
|
|
PRINT STACK
|
|
DIROUT D-TABLE-OFF
|
|
PUTB O-INBUF,0,INBUF-LENGTH
|
|
ADD O-INBUF,1 >?TMP1
|
|
GETB O-INBUF,1
|
|
ICALL ADD-TO-INPUT,?TMP1,13,STACK
|
|
JUMP ?REP2
|
|
?CCL14: EQUAL? TRM,13,10 /?REP2
|
|
ADD FKEYS,2 >?TMP1
|
|
GET FKEYS,0
|
|
INTBL? TRM,?TMP1,STACK >TMP \?CCL20
|
|
GET TMP,1 >FDEF
|
|
ZERO? FDEF /?CCL20
|
|
ADD 1,FDEF >?TMP1
|
|
GETB FDEF,1
|
|
CALL ADD-TO-INPUT,?TMP1,TRM,STACK >TRM
|
|
EQUAL? TRM,13,10 /?REP2
|
|
JUMP ?PRG1
|
|
?CCL20: SOUND S-BEEP
|
|
JUMP ?PRG1
|
|
?REP2: ICALL1 SCRIPT-INBUF
|
|
LEX P-INBUF,P-LEXV
|
|
RTRUE
|
|
|
|
|
|
.FUNCT ADD-TO-INPUT,FDEF,TRM,M,N,TMP,?TMP1
|
|
GETB P-INBUF,1 >N
|
|
GETB FDEF,M
|
|
EQUAL? STACK,13,10 \?CND1
|
|
SET 'TRM,13
|
|
DEC 'M
|
|
?CND1: INC 'FDEF
|
|
ADD N,2
|
|
ADD P-INBUF,STACK >TMP
|
|
ADD M,N >?TMP1
|
|
GETB P-INBUF,0
|
|
LESS? ?TMP1,STACK /?CND3
|
|
SOUND 1
|
|
GETB P-INBUF,0
|
|
SUB STACK,N
|
|
SUB STACK,1 >M
|
|
?CND3: COPYT FDEF,TMP,M
|
|
PUTB TMP,M,0
|
|
WINATTR -3,A-SCRIPT,O-CLEAR
|
|
PRINTT FDEF,M
|
|
ADD N,M
|
|
PUTB P-INBUF,1,STACK
|
|
EQUAL? TRM,13,10 \?CND5
|
|
CRLF
|
|
?CND5: WINATTR -3,A-SCRIPT,O-SET
|
|
RETURN TRM
|
|
|
|
|
|
.FUNCT SCRIPT-INBUF,BUF,CNT,N,CHR
|
|
GETB P-INBUF,1 >N
|
|
DIROUT D-SCREEN-OFF
|
|
ADD 1,P-INBUF >BUF
|
|
?PRG1: IGRTR? 'CNT,N /?REP2
|
|
GETB BUF,CNT >CHR
|
|
LESS? CHR,97 /?CCL8
|
|
GRTR? CHR,122 /?CCL8
|
|
SUB CHR,32
|
|
PRINTC STACK
|
|
JUMP ?PRG1
|
|
?CCL8: PRINTC CHR
|
|
JUMP ?PRG1
|
|
?REP2: CRLF
|
|
DIROUT D-SCREEN-ON
|
|
RTRUE
|
|
|
|
.ENDSEG
|
|
|
|
.SEGMENT "SOFT"
|
|
|
|
|
|
.FUNCT PRINT-CENTER-TABLE,?TMP2,?TMP1
|
|
DIROUT D-TABLE-OFF
|
|
WINGET -3,WYPOS >?TMP1
|
|
WINGET -3,WWIDE >?TMP2
|
|
GET 0,24
|
|
SUB ?TMP2,STACK
|
|
DIV STACK,2
|
|
ADD STACK,1
|
|
CURSET ?TMP1,STACK
|
|
GET DIROUT-TABLE,0
|
|
PRINTT DIROUT-TABLE+2,STACK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT V-DEFINE,LINE,LINMAX,CHR,TMP,NLINE,FKEY,FDEF,LEFT,FY,FX,?TMP1
|
|
ZERO? DONE-DEFINE? \?CND1
|
|
SET 'DONE-DEFINE?,TRUE-VALUE
|
|
PRINTI "Software Function Key definition. "
|
|
GETB 0,30
|
|
EQUAL? STACK,MACINTOSH \?CND3
|
|
PRINTI "(NOTE: if your Macintosh has no function keys, use Command-1 thru Command-0 instead.) "
|
|
?CND3: PRINTI "Use the arrow keys"
|
|
ZERO? ACTIVE-MOUSE /?CND5
|
|
PRINTI " or the mouse"
|
|
?CND5: PRINTI " to select the key to define or the operation to perform. Hit the RETURN/ENTER key"
|
|
ZERO? ACTIVE-MOUSE /?CND7
|
|
PRINTI " or double-click the mouse"
|
|
?CND7: PRINTI " to perform operations."
|
|
CRLF
|
|
ICALL1 HIT-ANY-KEY
|
|
?CND1: CLEAR -1
|
|
MUL 4,LINE
|
|
ADD 2,STACK
|
|
ADD FKEYS,STACK >FKEY
|
|
GET FKEY,1 >FDEF
|
|
GETB 0,33 >?TMP1
|
|
GETB FDEF,0
|
|
SUB ?TMP1,STACK
|
|
DIV STACK,2 >LEFT
|
|
GET FKEYS,0
|
|
DIV STACK,2 >LINMAX
|
|
CLEAR -1
|
|
SCREEN SOFT-WINDOW
|
|
FONT 4
|
|
WINGET SOFT-WINDOW,WFSIZE >TMP
|
|
SHIFT TMP,-8 >FY
|
|
BAND TMP,255 >FX
|
|
GETB 0,32
|
|
SUB STACK,LINMAX
|
|
DIV STACK,2
|
|
MUL FY,STACK >?TMP1
|
|
MUL FX,LEFT
|
|
WINPOS SOFT-WINDOW,?TMP1,STACK
|
|
ADD LINMAX,1
|
|
MUL FY,STACK >?TMP1
|
|
ADD FLEN,4
|
|
MUL FX,STACK
|
|
ADD 1,STACK
|
|
WINSIZE SOFT-WINDOW,?TMP1,STACK
|
|
ICALL2 DISPLAY-SOFTS,LINE
|
|
ICALL DISPLAY-SOFT,FKEY,LINE,FALSE-VALUE
|
|
?PRG9: ZERO? DEMO-VERSION? /?CCL13
|
|
CALL2 INPUT-DEMO,1 >CHR
|
|
JUMP ?CND11
|
|
?CCL13: INPUT 1 >CHR
|
|
?CND11: SET 'NLINE,LINE
|
|
EQUAL? CHR,CLICK1,CLICK2 \?CND14
|
|
CALL2 IN-WINDOW?,SOFT-WINDOW >TMP
|
|
ZERO? TMP /?CND14
|
|
GRTR? TMP,1 \?CND14
|
|
SUB TMP,2 >NLINE
|
|
EQUAL? LINE,NLINE /?CND19
|
|
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
|
|
MUL 4,NLINE
|
|
ADD 2,STACK
|
|
ADD FKEYS,STACK
|
|
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
|
|
SET 'LINE,NLINE
|
|
MUL 4,LINE
|
|
ADD 2,STACK
|
|
ADD FKEYS,STACK >FKEY
|
|
GET FKEY,1 >FDEF
|
|
?CND19: EQUAL? CHR,CLICK2 \?CND14
|
|
GET FKEY,0
|
|
LESS? STACK,0 \?CND14
|
|
SET 'CHR,13
|
|
?CND14: EQUAL? CHR,CLICK1,CLICK2 /?CND25
|
|
EQUAL? CHR,13 \?CCL28
|
|
GET FKEY,0
|
|
LESS? STACK,0 \?CCL28
|
|
SET 'NLINE,0
|
|
GET FDEF,1
|
|
CALL STACK
|
|
ZERO? STACK /?CCL33
|
|
SCREEN 0
|
|
CLEAR 0
|
|
ICALL1 V-$REFRESH
|
|
RTRUE
|
|
?CCL33: SUB LINMAX,1 >NLINE
|
|
ICALL2 DISPLAY-SOFTS,LINE
|
|
JUMP ?CND25
|
|
?CCL28: EQUAL? CHR,DOWN-ARROW,13 \?CCL35
|
|
INC 'NLINE
|
|
LESS? NLINE,LINMAX /?CND25
|
|
SET 'NLINE,0
|
|
JUMP ?CND25
|
|
?CCL35: EQUAL? CHR,UP-ARROW \?CCL39
|
|
DLESS? 'NLINE,0 \?CND25
|
|
SUB LINMAX,1 >NLINE
|
|
JUMP ?CND25
|
|
?CCL39: ADD FKEYS,2 >?TMP1
|
|
GET FKEYS,0
|
|
INTBL? CHR,?TMP1,STACK >TMP \?CCL43
|
|
SUB TMP,FKEYS
|
|
DIV STACK,4 >NLINE
|
|
JUMP ?CND25
|
|
?CCL43: EQUAL? CHR,8,127 \?CCL45
|
|
GETB FDEF,1 >TMP
|
|
ZERO? TMP /?CCL48
|
|
DEC 'TMP
|
|
PUTB FDEF,1,TMP
|
|
ADD TMP,2
|
|
PUTB FDEF,STACK,32
|
|
ADD LINE,2 >?TMP1
|
|
ADD TMP,5
|
|
ICALL CCURSET,?TMP1,STACK
|
|
ERASE 1
|
|
JUMP ?CND25
|
|
?CCL48: SOUND S-BEEP
|
|
JUMP ?CND25
|
|
?CCL45: LESS? CHR,32 /?CCL50
|
|
LESS? CHR,127 \?CCL50
|
|
GETB FDEF,1 >TMP
|
|
GETB FDEF,0
|
|
EQUAL? TMP,STACK \?CCL55
|
|
SOUND S-BEEP
|
|
JUMP ?CND25
|
|
?CCL55: ADD FDEF,2 >?TMP1
|
|
GETB FDEF,1
|
|
INTBL? 13,?TMP1,STACK,1 \?CCL57
|
|
SOUND S-BEEP
|
|
JUMP ?CND25
|
|
?CCL57: EQUAL? CHR,124,33 \?CND58
|
|
SET 'CHR,13
|
|
?CND58: ADD TMP,1
|
|
PUTB FDEF,1,STACK
|
|
LESS? CHR,65 /?CND60
|
|
GRTR? CHR,90 /?CND60
|
|
ADD CHR,32 >CHR
|
|
?CND60: ADD TMP,2
|
|
PUTB FDEF,STACK,CHR
|
|
EQUAL? CHR,13 \?CCL66
|
|
PRINTC 124
|
|
JUMP ?CND25
|
|
?CCL66: PRINTC CHR
|
|
JUMP ?CND25
|
|
?CCL50: SOUND S-BEEP
|
|
?CND25: EQUAL? LINE,NLINE /?PRG9
|
|
ICALL DISPLAY-SOFT,FKEY,LINE,TRUE-VALUE
|
|
MUL 4,NLINE
|
|
ADD 2,STACK
|
|
ADD FKEYS,STACK
|
|
ICALL DISPLAY-SOFT,STACK,NLINE,FALSE-VALUE
|
|
SET 'LINE,NLINE
|
|
MUL 4,LINE
|
|
ADD 2,STACK
|
|
ADD FKEYS,STACK >FKEY
|
|
GET FKEY,1 >FDEF
|
|
JUMP ?PRG9
|
|
|
|
|
|
.FUNCT IN-WINDOW?,W,X,Y,TOP,LEFT
|
|
GET 0,27
|
|
GET STACK,2 >Y
|
|
GET 0,27
|
|
GET STACK,1 >X
|
|
WINGET W,WTOP >TOP
|
|
LESS? Y,TOP /FALSE
|
|
WINGET W,WLEFT >LEFT
|
|
LESS? X,LEFT /FALSE
|
|
SUB Y,TOP >Y
|
|
SUB X,LEFT >X
|
|
WINGET W,WHIGH
|
|
GRTR? Y,STACK /FALSE
|
|
WINGET W,WWIDE
|
|
GRTR? X,STACK /FALSE
|
|
DIV Y,FONT-Y
|
|
ADD 1,STACK >Y
|
|
RETURN Y
|
|
|
|
|
|
.FUNCT DISPLAY-SOFTS,LINE,L,F,N,FKEY,CNT
|
|
GET FKEYS,0 >L
|
|
DIV L,2 >L
|
|
SCREEN SOFT-WINDOW
|
|
CURSET 1,1
|
|
DIROUT D-TABLE-ON,DIROUT-TABLE
|
|
FONT 1
|
|
PRINTI "Function Keys"
|
|
ICALL1 PRINT-CENTER-TABLE
|
|
FONT 4
|
|
ADD FKEYS,2 >FKEY
|
|
?PRG1: LESS? CNT,L \TRUE
|
|
EQUAL? CNT,LINE \?CCL8
|
|
PUSH FALSE-VALUE
|
|
JUMP ?CND6
|
|
?CCL8: PUSH TRUE-VALUE
|
|
?CND6: ICALL DISPLAY-SOFT,FKEY,CNT,STACK
|
|
ADD FKEY,4 >FKEY
|
|
INC 'CNT
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT DISPLAY-SOFT,FKEY,CNT,INV?,FDEF,S,N,M,TMP,Y,X,?TMP1
|
|
GET FKEY,1 >FDEF
|
|
ADD CNT,2 >Y
|
|
GET FKEY,0
|
|
LESS? STACK,0 \?CCL3
|
|
ICALL CCURSET,Y,1
|
|
ZERO? INV? /?CND4
|
|
HLIGHT H-INVERSE
|
|
?CND4: FONT 1
|
|
DIROUT D-TABLE-ON,DIROUT-TABLE
|
|
GET FDEF,0
|
|
PRINT STACK
|
|
ICALL1 PRINT-CENTER-TABLE
|
|
FONT 4
|
|
JUMP ?CND1
|
|
?CCL3: GETB FDEF,0 >S
|
|
GETB FDEF,1 >N
|
|
ICALL CCURSET,Y,1
|
|
GET FKEY,0 >?TMP1
|
|
GET FNAMES,0
|
|
INTBL? ?TMP1,FNAMES+2,STACK >TMP \?CND6
|
|
ZERO? INV? /?CCL10
|
|
HLIGHT H-NORMAL
|
|
JUMP ?CND8
|
|
?CCL10: HLIGHT H-INVERSE
|
|
?CND8: GET TMP,1
|
|
PRINT STACK
|
|
HLIGHT H-NORMAL
|
|
PRINTC 32
|
|
ZERO? INV? /?CCL13
|
|
HLIGHT H-INVERSE
|
|
JUMP ?CND6
|
|
?CCL13: HLIGHT H-NORMAL
|
|
?CND6: ADD FDEF,2 >FDEF
|
|
ZERO? N /?CND14
|
|
SUB N,1 >M
|
|
GETB FDEF,M
|
|
EQUAL? STACK,13 \?CND14
|
|
PRINTT FDEF,M
|
|
PRINTC 124
|
|
ADD FDEF,N >FDEF
|
|
SUB S,N >S
|
|
?CND14: PRINTT FDEF,S
|
|
ZERO? INV? \?CND1
|
|
ADD N,5
|
|
ICALL CCURSET,Y,STACK
|
|
?CND1: HLIGHT H-NORMAL
|
|
RTRUE
|
|
|
|
|
|
.FUNCT SOFT-RESET-DEFAULTS,K,L,KEYS,DEF,KL,TMP,?TMP1
|
|
GET FKEYS,0 >KL
|
|
SET 'DEF,DEFAULT-FKEYS
|
|
?PRG1: GETB DEF,0 >K
|
|
ZERO? K /FALSE
|
|
INC 'DEF
|
|
GETB DEF,0
|
|
ADD 1,STACK >L
|
|
ADD FKEYS,2
|
|
INTBL? K,STACK,KL >KEYS \?CND5
|
|
GET KEYS,1 >KEYS
|
|
ADD 1,KEYS >TMP
|
|
PUTB TMP,0,32
|
|
ADD 1,TMP >?TMP1
|
|
GETB KEYS,0
|
|
SUB 0,STACK
|
|
COPYT TMP,?TMP1,STACK
|
|
ADD 1,KEYS
|
|
COPYT DEF,STACK,L
|
|
?CND5: ADD DEF,L >DEF
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT SOFT-SAVE-DEFS
|
|
CLEAR 0
|
|
SCREEN 0
|
|
SAVE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
|
|
ZERO? STACK \?CND1
|
|
PRINTI "Failed."
|
|
?CND1: CLEAR 0
|
|
SCREEN SOFT-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SOFT-RESTORE-DEFS
|
|
CLEAR 0
|
|
SCREEN 0
|
|
RESTORE FKEY-TBL,FKEYS-STRTABLE-LEN,DEFS-NAME
|
|
ZERO? STACK \?CND1
|
|
PRINTI "Failed."
|
|
?CND1: CLEAR 0
|
|
SCREEN SOFT-WINDOW
|
|
RFALSE
|
|
|
|
|
|
.FUNCT SOFT-EXIT
|
|
RTRUE
|
|
|
|
.ENDSEG
|
|
|
|
.SEGMENT "0"
|
|
|
|
|
|
.FUNCT Y?,X
|
|
?PRG1: ZERO? DEMO-VERSION? /?CCL5
|
|
CALL2 INPUT-DEMO,1 >X
|
|
JUMP ?CND3
|
|
?CCL5: INPUT 1 >X
|
|
?CND3: EQUAL? X,89,121,CLICK1 /?CTR7
|
|
EQUAL? X,CLICK2 \?CCL8
|
|
?CTR7: SET 'X,TRUE-VALUE
|
|
JUMP ?REP2
|
|
?CCL8: EQUAL? X,78,110 \?CCL12
|
|
SET 'X,FALSE-VALUE
|
|
?REP2: CRLF
|
|
RETURN X
|
|
?CCL12: CRLF
|
|
PRINTI "[Please type Y or N] >"
|
|
JUMP ?PRG1
|
|
|
|
|
|
.FUNCT BLINK,PIC1,PIC2,Y,X,SCR,CHAR,LAST,CNT
|
|
SCREEN SCR
|
|
DISPLAY PIC2,Y,X
|
|
SCREEN S-TEXT
|
|
SET 'LAST,PIC2
|
|
?PRG1: SET 'TYPED-TIMED-OUT,FALSE-VALUE
|
|
INPUT 1,3,TYPED? >CHAR
|
|
ICALL1 MOUSE-INPUT?
|
|
ZERO? TYPED-TIMED-OUT /?CCL5
|
|
SCREEN SCR
|
|
EQUAL? LAST,PIC1 \?CCL8
|
|
SET 'LAST,PIC2
|
|
PUSH PIC2
|
|
JUMP ?CND6
|
|
?CCL8: SET 'LAST,PIC1
|
|
PUSH PIC1
|
|
?CND6: DISPLAY STACK,Y,X
|
|
INC 'CNT
|
|
EQUAL? CNT,4 \?CND9
|
|
ZERO? ROSE-NEEDS-UPDATING /?CND9
|
|
EQUAL? CURRENT-SPLIT,MAP-TOP-LEFT-LOC \?CND9
|
|
ICALL1 UPDATE-MAP-ROSE
|
|
?CND9: SCREEN S-TEXT
|
|
JUMP ?PRG1
|
|
?CCL5: EQUAL? LAST,PIC2 /?CCL15
|
|
RETURN CHAR
|
|
?CCL15: SCREEN SCR
|
|
DISPLAY PIC1,Y,X
|
|
SCREEN S-TEXT
|
|
RETURN CHAR
|
|
|
|
|
|
.FUNCT TYPED?
|
|
SET 'TYPED-TIMED-OUT,TRUE-VALUE
|
|
RTRUE
|
|
|
|
|
|
.FUNCT PICINF-PLUS-ONE,PIC
|
|
PICINF PIC,PICINF-TBL /?BOGUS1
|
|
?BOGUS1: GET PICINF-TBL,0
|
|
ADD STACK,1
|
|
PUT PICINF-TBL,0,STACK
|
|
GET PICINF-TBL,1
|
|
ADD STACK,1
|
|
PUT PICINF-TBL,1,STACK
|
|
RTRUE
|
|
|
|
|
|
.FUNCT MOUSE-INPUT?
|
|
GET 0,27
|
|
GET STACK,1 >MOUSE-LOC-X
|
|
GET 0,27
|
|
GET STACK,2 >MOUSE-LOC-Y
|
|
RETURN MOUSE-LOC-Y
|
|
|
|
.ENDSEG
|
|
|
|
.ENDI
|