sherlock/sched.zap
historicalsource d327e7626d Release Version
2019-04-16 09:16:28 -04:00

325 lines
6.7 KiB
Plaintext

.FUNCT RT-COPY-TIME,TBL1,TBL2
COPYT TBL1,TBL2,K-A-TWDTH
RTRUE
.FUNCT RT-NORM-TIME,TIME-TABLE,TEMP,M-LEN,?TMP1
GETB TIME-TABLE,K-SEC >TEMP
MOD TEMP,60
PUTB TIME-TABLE,K-SEC,STACK
GETB TIME-TABLE,K-MIN >?TMP1
DIV TEMP,60
ADD ?TMP1,STACK >TEMP
MOD TEMP,60
PUTB TIME-TABLE,K-MIN,STACK
GETB TIME-TABLE,K-HRS >?TMP1
DIV TEMP,60
ADD ?TMP1,STACK >TEMP
MOD TEMP,24
PUTB TIME-TABLE,K-HRS,STACK
GETB TIME-TABLE,K-DAY >?TMP1
DIV TEMP,24 >TEMP
ADD ?TMP1,TEMP
PUTB TIME-TABLE,K-DAY,STACK
RTRUE
.FUNCT RT-DO-CLOCK-SET,TBL,HRS,MIN,SEC,DAY
PUTB TBL,K-SEC,SEC
PUTB TBL,K-MIN,MIN
PUTB TBL,K-HRS,HRS
PUTB TBL,K-DAY,DAY
RETURN TBL
.FUNCT RT-CLOCK-INC,N,?TMP1
ZERO? GL-CLOCK-WAIT /?CCL3
SET 'GL-CLOCK-WAIT,FALSE-VALUE
RFALSE
?CCL3: ZERO? GL-CLOCK-STOP \FALSE
?PRG5: GETB GL-TIME,N >?TMP1
GETB GL-TIME-UPDT-INC,N
ADD ?TMP1,STACK
PUTB GL-TIME,N,STACK
IGRTR? 'N,3 \?PRG5
COPYT GL-TIME-UPDT-DEF,GL-TIME-UPDT-INC,K-A-TWDTH
CALL2 RT-NORM-TIME,GL-TIME
RSTACK
.FUNCT RT-CLOCK-CMP,HRS,MIN,SEC,DAY,TMP
ZERO? DAY /?CND1
GETB GL-TIME,K-DAY >TMP
GRTR? DAY,TMP /TRUE
LESS? DAY,TMP \?CND1
RETURN -1
?CND1: GETB GL-TIME,K-HRS >TMP
GRTR? HRS,TMP /TRUE
LESS? HRS,TMP \?CCL11
RETURN -1
?CCL11: GETB GL-TIME,K-MIN >TMP
GRTR? MIN,TMP /TRUE
LESS? MIN,TMP \?CCL15
RETURN -1
?CCL15: GETB GL-TIME,K-SEC >TMP
GRTR? SEC,TMP /TRUE
LESS? SEC,TMP \FALSE
RETURN -1
.FUNCT RT-CLOCK-JMP,HRS,MIN,SEC,DAY
ICALL RT-DO-CLOCK-SET,GL-TIME-UPDT-INC,HRS,MIN,SEC,DAY
ICALL1 RT-CLOCK-INC
EQUAL? GL-PRSA,V?WAIT,V?WAIT-FOR \?CCL3
PUSH 2
JUMP ?CND1
?CCL3: PUSH 1
?CND1: ICALL2 RT-ALARM-CHK,STACK
SET 'GL-CLOCK-WAIT,TRUE-VALUE
RETURN GL-CLOCK-WAIT
.FUNCT RT-CLK-NTI-MSG,FMT,HRS,MIN,SEC,MSD,MER,AM-PM?
ASSIGNED? 'FMT /?CND1
SET 'FMT,7
?CND1: GETB GL-TIME,K-HRS >HRS
GETB GL-TIME,K-MIN >MIN
GETB GL-TIME,K-SEC >SEC
BTST FMT,4 \?CND3
BTST FMT,8 \?CCL7
SET 'MSD,STR?217
JUMP ?CND5
?CCL7: ZERO? HRS \?CCL9
ADD HRS,12 >HRS
SET 'MSD,STR?218
SET 'AM-PM?,1
JUMP ?CND5
?CCL9: LESS? HRS,12 \?CCL11
SET 'MSD,STR?218
SET 'AM-PM?,1
JUMP ?CND5
?CCL11: EQUAL? HRS,12 \?CCL13
SET 'MSD,STR?218
SET 'AM-PM?,2
JUMP ?CND5
?CCL13: SUB HRS,12 >HRS
SET 'MSD,STR?218
SET 'AM-PM?,2
?CND5: EQUAL? AM-PM?,1 \?CCL16
BTST FMT,16 \?CCL19
SET 'MER,STR?219
JUMP ?CND14
?CCL19: SET 'MER,STR?220
JUMP ?CND14
?CCL16: EQUAL? AM-PM?,2 \?CCL21
BTST FMT,16 \?CCL24
SET 'MER,STR?221
JUMP ?CND14
?CCL24: SET 'MER,STR?222
JUMP ?CND14
?CCL21: SET 'MER,STR?218
?CND14: LESS? HRS,10 \?CND25
PRINT MSD
?CND25: PRINTN HRS
?CND3: BTST FMT,2 \?CND27
BTST FMT,4 \?CND29
PRINTC 58
?CND29: LESS? MIN,10 \?CND31
PRINTC 48
?CND31: PRINTN MIN
?CND27: BTST FMT,1 \?CND33
BTST FMT,4 /?CCL36
BTST FMT,2 \?CND35
?CCL36: PRINTC 58
?CND35: LESS? SEC,10 \?CND39
PRINTC 48
?CND39: PRINTN SEC
?CND33: BTST FMT,4 \FALSE
PRINT MER
RTRUE
.FUNCT RT-CLK-DOW-MSG,FMT,DOW,WDOW
ASSIGNED? 'FMT /?CND1
SET 'FMT,1
?CND1: GETB GL-TIME,K-DAY
SUB STACK,K-DOW-BASE
MOD STACK,7 >DOW
BTST FMT,1 \FALSE
BTST FMT,4 \?CCL8
ADD DOW,14
GET GL-DAY-NAME,STACK >WDOW
JUMP ?CND6
?CCL8: BTST FMT,2 \?CCL10
ADD DOW,7
GET GL-DAY-NAME,STACK >WDOW
JUMP ?CND6
?CCL10: GET GL-DAY-NAME,DOW >WDOW
?CND6: PRINT WDOW
RTRUE
.FUNCT RT-ALARM-SET?,RTN,R-PTR,T-PTR
?PRG1: EQUAL? R-PTR,K-A-RSIZE /FALSE
GET GL-A-ROUT,R-PTR
EQUAL? RTN,STACK \?CCL7
MUL R-PTR,K-A-TWDTH >T-PTR
ADD GL-A-TIME,T-PTR
ICALL RT-COPY-TIME,STACK,GL-TIME-PARM
RTRUE
?CCL7: INC 'R-PTR
JUMP ?PRG1
.FUNCT RT-ALARM-SET-REL,RTN,TIME,R-PTR,T-PTR,N,?TMP3,?TMP2,?TMP1
?PRG1: EQUAL? R-PTR,K-A-RSIZE \?CND3
CRLF
PRINTI "*** TOO MANY ALARMS (REL) ***"
CRLF
CRLF
RFALSE
?CND3: GET GL-A-ROUT,R-PTR
ZERO? STACK \?CCL7
PUT GL-A-ROUT,R-PTR,RTN
MUL R-PTR,K-A-TWDTH >T-PTR
ZERO? GL-ALARM-EXEC /?CCL10
SET 'N,0
?PRG11: ADD T-PTR,N >?TMP1
GETB GL-TIME,N >?TMP2
GETB TIME,N
ADD ?TMP2,STACK
PUTB GL-A-TIME,?TMP1,STACK
IGRTR? 'N,3 /?CND8
JUMP ?PRG11
?CCL10: SET 'N,0
?PRG15: ADD T-PTR,N >?TMP1
GETB GL-TIME,N >?TMP3
GETB TIME,N
ADD ?TMP3,STACK >?TMP2
GETB GL-TIME-UPDT-INC,N
ADD ?TMP2,STACK
PUTB GL-A-TIME,?TMP1,STACK
IGRTR? 'N,3 \?PRG15
?CND8: ADD GL-A-TIME,T-PTR
ICALL2 RT-NORM-TIME,STACK
RTRUE
?CCL7: INC 'R-PTR
JUMP ?PRG1
.FUNCT RT-ALARM-SET-ABS,RTN,TIME,R-PTR,T-PTR
?PRG1: EQUAL? R-PTR,K-A-RSIZE \?CND3
CRLF
PRINTI "*** TOO MANY (ABS) ALARMS ***"
CRLF
CRLF
RFALSE
?CND3: GET GL-A-ROUT,R-PTR
ZERO? STACK \?CCL7
PUT GL-A-ROUT,R-PTR,RTN
MUL R-PTR,K-A-TWDTH >T-PTR
ADD GL-A-TIME,T-PTR
COPYT TIME,STACK,K-A-TWDTH
RTRUE
?CCL7: INC 'R-PTR
JUMP ?PRG1
.FUNCT RT-ALARM-CLR,RTN,R-PTR,T-PTR
?PRG1: EQUAL? R-PTR,K-A-RSIZE /FALSE
GET GL-A-ROUT,R-PTR
EQUAL? RTN,STACK \?CND3
PUT GL-A-ROUT,R-PTR,0
MUL R-PTR,K-A-TWDTH >T-PTR
ADD GL-A-TIME,T-PTR
COPYT STACK,0,K-A-TWDTH
?CND3: INC 'R-PTR
JUMP ?PRG1
.FUNCT RT-ALARM-CHK,PARM,VAL,RTN,R-PTR,R-CNT,T-PTR,HRS,MIN,SEC,DAY,T-TIME
SET 'RTN,-1
SET 'RUN-SMELL-ETHERIUM?,FALSE-VALUE
ZERO? GL-ALARM-WAIT /?CCL3
SET 'GL-ALARM-WAIT,FALSE-VALUE
RFALSE
?CCL3: GET GLOBAL-VARS-TABLE,0
ZERO? STACK \FALSE
ICALL RT-COPY-TIME,GL-TIME,GL-TEMP-TIME
?PRG5: EQUAL? R-PTR,K-A-RSIZE \?CND7
EQUAL? RTN,-1 \?CCL11
ZERO? RUN-SMELL-ETHERIUM? \?REP6
RETURN R-CNT
?CCL11: SET 'R-PTR,RTN
GET GL-A-ROUT,R-PTR >RTN
MUL R-PTR,K-A-TWDTH >T-PTR
PUT GL-A-ROUT,R-PTR,0
ADD GL-A-TIME,T-PTR >T-TIME
GETB T-TIME,K-SEC >SEC
GETB T-TIME,K-MIN >MIN
GETB T-TIME,K-HRS >HRS
GETB T-TIME,K-DAY >DAY
COPYT T-TIME,0,K-A-TWDTH
FSET? CH-PLAYER,FL-ASLEEP /?CND14
ICALL1 RT-UPDATE-STATUS-LINE
?CND14: SET 'GL-ALARM-EXEC,TRUE-VALUE
CALL RTN >VAL
ZERO? RUN-SMELL-ETHERIUM? \?REP6
SET 'GL-ALARM-EXEC,FALSE-VALUE
ICALL RT-COPY-TIME,GL-TEMP-TIME,GL-TIME
INC 'R-CNT
ZERO? VAL /?CND18
CALL RT-CLOCK-CMP,HRS,MIN,SEC,DAY
EQUAL? STACK,-1 \?CND18
EQUAL? PARM,1 \?CCL24
PRINTI "[Press any key to continue.]"
CRLF
INPUT 1
JUMP ?CND18
?CCL24: EQUAL? PARM,2 \?CND18
?PRG26: CRLF
PRINTI "Do you want to continue waiting?"
CRLF
PRINTI "Please press Y or N > "
INPUT 1 >VAL
PRINTC VAL
CRLF
EQUAL? VAL,78,110 \?CCL30
SET 'RTN,-1
SET 'R-PTR,K-A-RSIZE
ICALL RT-DO-CLOCK-SET,GL-TIME,HRS,MIN,SEC,DAY
JUMP ?CND18
?CCL30: EQUAL? VAL,89,121 \?PRG26
?CND18: EQUAL? RTN,-1 /?PRG5
SET 'RTN,-1
SET 'R-PTR,0
JUMP ?PRG5
?CND7: GET GL-A-ROUT,R-PTR
ZERO? STACK /?CND34
MUL R-PTR,K-A-TWDTH >T-PTR
ADD T-PTR,K-SEC
GETB GL-A-TIME,STACK >SEC
ADD T-PTR,K-MIN
GETB GL-A-TIME,STACK >MIN
ADD T-PTR,K-HRS
GETB GL-A-TIME,STACK >HRS
ADD T-PTR,K-DAY
GETB GL-A-TIME,STACK >DAY
ZERO? PARM /?PRD39
CALL RT-CLOCK-CMP,HRS,MIN,SEC,DAY
EQUAL? STACK,-1 /?CCL37
?PRD39: ZERO? PARM \?CND34
CALL RT-CLOCK-CMP,HRS,MIN,SEC,DAY
EQUAL? STACK,-1,0 \?CND34
?CCL37: ICALL RT-DO-CLOCK-SET,GL-TIME,HRS,MIN,SEC,DAY
SET 'RTN,R-PTR
?CND34: INC 'R-PTR
JUMP ?PRG5
?REP6: ZERO? RUN-SMELL-ETHERIUM? /FALSE
ICALL1 RT-SMELL-ETHERIUM?
RETURN R-CNT
.ENDI