448 lines
12 KiB
Plaintext
448 lines
12 KiB
Plaintext
; "clock constants"
|
|
|
|
; "offsets into time tables"
|
|
|
|
<CONSTANT K-SEC 0> ; "sec"
|
|
<CONSTANT K-MIN 1> ; "min"
|
|
<CONSTANT K-HRS 2> ; "hrs"
|
|
<CONSTANT K-DAY 3> ; "day"
|
|
<CONSTANT K-DOW-BASE 12> ; "Known to be Sunday (dow = 0)"
|
|
|
|
; "alarm constants"
|
|
|
|
<CONSTANT K-A-RSIZE 30> ; "size of alarm routine table in words"
|
|
<CONSTANT K-A-TWDTH 4> ; "size of alarm time table entry in bytes"
|
|
<CONSTANT K-A-TSIZE <* ,K-A-TWDTH 30>> ; "size of alarm time table in bytes"
|
|
|
|
|
|
; "event constants"
|
|
|
|
; "clock globals"
|
|
|
|
<GLOBAL GL-CLOCK-WAIT:FLAG <>> ; "flag to inhibit clock update"
|
|
<GLOBAL GL-CLOCK-STOP:FLAG <>> ; "flag to stop clock update"
|
|
|
|
<CONSTANT GL-TIME:TABLE ; "pri game time table"
|
|
<TABLE (BYTE)
|
|
0 ; "sec 00-59"
|
|
0 ; "min 00-59"
|
|
0 ; "hrs 00-23"
|
|
0 ; "day 01-31">>
|
|
|
|
<CONSTANT GL-TEMP-TIME:TABLE <ITABLE ,K-A-TWDTH (BYTE) 0>>
|
|
; "table to hold time temporarily"
|
|
|
|
<CONSTANT GL-TIME-PARM:TABLE <ITABLE ,K-A-TWDTH (BYTE) 0>>
|
|
; "Parameter table to all time routines"
|
|
|
|
<CONSTANT GL-TIME-UPDT-INC:TABLE ; "next time inc is kept here"
|
|
<TABLE (BYTE)
|
|
0 ; "sec"
|
|
0 ; "min"
|
|
0 ; "hrs"
|
|
0 ; "day">>
|
|
|
|
<CONSTANT GL-TIME-UPDT-DEF:TABLE ; "default time inc is kept here"
|
|
<TABLE (BYTE)
|
|
0 ; "sec"
|
|
0 ; "min"
|
|
0 ; "hrs"
|
|
0 ; "day">>
|
|
|
|
<CONSTANT GL-DAY-NAME:TABLE ; "long and short day names"
|
|
<PTABLE
|
|
"Sunday" ; "offset of 0"
|
|
"Monday"
|
|
"Tuesday"
|
|
"Wednesday"
|
|
"Thursday"
|
|
"Friday"
|
|
"Saturday"
|
|
"Sun" ; "offset of 7"
|
|
"Mon"
|
|
"Tue"
|
|
"Wed"
|
|
"Thu"
|
|
"Fri"
|
|
"Sat"
|
|
"Sunday " ; "offset of 14"
|
|
"Monday "
|
|
"Tuesday "
|
|
"Wednesday"
|
|
"Thursday "
|
|
"Friday "
|
|
"Saturday "
|
|
>
|
|
>
|
|
|
|
; "alarm globals"
|
|
|
|
<GLOBAL GL-ALARM-WAIT:FLAG <>> ; "flag to inhibit alarm check"
|
|
<GLOBAL GL-ALARM-STOP:FLAG <>> ; "flag to stop alarm check"
|
|
<GLOBAL GL-ALARM-EXEC:FLAG <>> ; "flag to show an alarm is executing"
|
|
|
|
<CONSTANT GL-A-ROUT:TABLE <ITABLE ,K-A-RSIZE 0>> ; "table of routines"
|
|
<CONSTANT GL-A-TIME:TABLE <ITABLE ,K-A-TSIZE (BYTE) 0>>
|
|
; "table of times (6 words)"
|
|
|
|
; "event globals"
|
|
|
|
; "support routines use by clock/event/alarm"
|
|
|
|
; "RT-COPY-TIME"
|
|
; "Copy time table 1 to time table 2"
|
|
|
|
<ROUTINE RT-COPY-TIME (TBL1 TBL2)
|
|
<COPYT .TBL1 .TBL2 ,K-A-TWDTH>>
|
|
|
|
; "RT-NORM-TIME"
|
|
|
|
<ROUTINE RT-NORM-TIME (TIME-TABLE "AUX" TEMP M-LEN)
|
|
; "normalize seconds"
|
|
<SET TEMP <GETB .TIME-TABLE ,K-SEC>>
|
|
<PUTB .TIME-TABLE ,K-SEC <MOD .TEMP 60>>
|
|
; "This is the new minutes value"
|
|
<SET TEMP <+ <GETB .TIME-TABLE ,K-MIN> </ .TEMP 60>>>
|
|
; "normalize minutes"
|
|
<PUTB .TIME-TABLE ,K-MIN <MOD .TEMP 60>>
|
|
<SET TEMP <+ <GETB .TIME-TABLE ,K-HRS> </ .TEMP 60>>>
|
|
; "normalize hours"
|
|
<PUTB .TIME-TABLE ,K-HRS <MOD .TEMP 24>>
|
|
; "Update day of month"
|
|
<PUTB .TIME-TABLE ,K-DAY <+ <GETB .TIME-TABLE ,K-DAY>
|
|
<SET TEMP </ .TEMP 24>>>>
|
|
; "normalize day, month, and year (including leap years)"
|
|
; "Given that the game takes place in the middle of June in 1887,
|
|
this is a complete waste of time..."
|
|
;<REPEAT ()
|
|
<SET M-LEN <GETB ,GL-MONTH-LEN <GETB .TIME-TABLE ,K-MON>>>
|
|
<COND (<NOT <EQUAL? <GETB .TIME-TABLE ,K-MON> 2>>
|
|
T)
|
|
(<ZERO? <MOD <GETB .TIME-TABLE ,K-YRS> 100>>
|
|
T)
|
|
(<ZERO? <MOD <GETB .TIME-TABLE ,K-YRS> 4>>
|
|
<INC M-LEN>)>
|
|
<SET TEMP <GETB .TIME-TABLE ,K-DAY>>
|
|
<COND (<G? .TEMP .M-LEN>
|
|
<PUTB .TIME-TABLE ,K-DAY <- .TEMP .M-LEN>>
|
|
<PUTB .TIME-TABLE ,K-MON <+ <GETB .TIME-TABLE ,K-MON> 1>>
|
|
<SET TEMP <GETB .TIME-TABLE ,K-MON>>
|
|
<COND (<G? .TEMP 12>
|
|
<PUTB .TIME-TABLE ,K-MON <- .TEMP 12>>
|
|
<PUTB .TIME-TABLE ,K-YRS
|
|
<+ <GETB .TIME-TABLE ,K-YRS> 1>>)>)
|
|
(T <RETURN>)>>>
|
|
|
|
; "clock routines"
|
|
|
|
; "RT-CLOCK-INC-SET. Made a macro that calls RT-DO-CLOCK-SET"
|
|
|
|
<ROUTINE RT-DO-CLOCK-SET (TBL HRS MIN SEC
|
|
"OPTIONAL" (DAY 0))
|
|
<PUTB .TBL ,K-SEC .SEC>
|
|
<PUTB .TBL ,K-MIN .MIN>
|
|
<PUTB .TBL ,K-HRS .HRS>
|
|
<PUTB .TBL ,K-DAY .DAY>
|
|
.TBL>
|
|
|
|
; "RT-CLOCK-DEF-SET. Moved to MACROS"
|
|
|
|
; "RT-CLOCK-SET. MOVED TO MACROS"
|
|
|
|
; "RT-CLOCK-INC"
|
|
|
|
<ROUTINE RT-CLOCK-INC ()
|
|
<COND (<MC-T? ,GL-CLOCK-WAIT>
|
|
<SETG GL-CLOCK-WAIT <>>
|
|
<RFALSE>)
|
|
(<MC-T? ,GL-CLOCK-STOP>
|
|
<RFALSE>)>
|
|
; "add gl-time-updt-inc to gl-time"
|
|
<REPEAT ((N 0))
|
|
<PUTB ,GL-TIME .N
|
|
<+ <GETB ,GL-TIME .N>
|
|
<GETB ,GL-TIME-UPDT-INC .N>>>
|
|
<COND (<G? <SET N <+ .N 1>>
|
|
<- ,K-A-TWDTH 1>> <RETURN>)>>
|
|
; "copy gl-time-updt-def into gl-time-updt-inc"
|
|
<COPYT ,GL-TIME-UPDT-DEF ,GL-TIME-UPDT-INC ,K-A-TWDTH>
|
|
; "normalize the time in gl-time"
|
|
<RT-NORM-TIME ,GL-TIME>>
|
|
|
|
; "RT-PARM-SET MOVED TO MACROS"
|
|
|
|
; "RT-CLOCK-CMP"
|
|
; "Returns -1 if arg time < current time."
|
|
; "Returns 0 if arg time = current time."
|
|
; "Returns 1 if arg time > current time."
|
|
|
|
<ROUTINE RT-CLOCK-CMP (HRS MIN SEC "OPTIONAL" (DAY 0)
|
|
"AUX" TMP)
|
|
<COND (<ZERO? .DAY>
|
|
T)
|
|
(<G? .DAY <SET TMP <GETB ,GL-TIME ,K-DAY>>>
|
|
<RETURN 1>)
|
|
(<L? .DAY .TMP>
|
|
<RETURN -1>)>
|
|
<COND (<G? .HRS <SET TMP <GETB ,GL-TIME ,K-HRS>>>
|
|
<RETURN 1>)
|
|
(<L? .HRS .TMP>
|
|
<RETURN -1>)
|
|
(<G? .MIN <SET TMP <GETB ,GL-TIME ,K-MIN>>>
|
|
<RETURN 1>)
|
|
(<L? .MIN .TMP>
|
|
<RETURN -1>)
|
|
(<G? .SEC <SET TMP <GETB ,GL-TIME ,K-SEC>>>
|
|
<RETURN 1>)
|
|
(<L? .SEC .TMP>
|
|
<RETURN -1>)
|
|
(T
|
|
<RETURN 0>)>>
|
|
|
|
; "RT-CLOCK-JMP"
|
|
|
|
<ROUTINE RT-CLOCK-JMP (HRS MIN SEC "OPTIONAL" (DAY 0))
|
|
<RT-CLOCK-INC-SET .HRS .MIN .SEC .DAY>
|
|
<RT-CLOCK-INC>
|
|
<RT-ALARM-CHK
|
|
<COND (<MC-VERB? WAIT WAIT-FOR>
|
|
2)
|
|
(T 1)>>
|
|
<SETG GL-CLOCK-WAIT T>>
|
|
|
|
; "RT-CLK-NTI-MSG"
|
|
|
|
<ROUTINE RT-CLK-NTI-MSG ("OPTIONAL" (FMT 7) "AUX" HRS MIN SEC MSD MER
|
|
(AM-PM? 0))
|
|
<SET HRS <GETB ,GL-TIME ,K-HRS>>
|
|
<SET MIN <GETB ,GL-TIME ,K-MIN>>
|
|
<SET SEC <GETB ,GL-TIME ,K-SEC>>
|
|
<COND (<BAND .FMT ,K-NTI-HH>
|
|
<COND (<BAND .FMT ,K-NTI-MT>
|
|
<SET MSD "0">)
|
|
(<EQUAL? .HRS 0>
|
|
<SET HRS <+ .HRS 12>>
|
|
<SET MSD " ">
|
|
<SET AM-PM? 1>)
|
|
(<L? .HRS 12>
|
|
<SET MSD " ">
|
|
<SET AM-PM? 1>)
|
|
(<EQUAL? .HRS 12>
|
|
<SET MSD " ">
|
|
<SET AM-PM? 2>)
|
|
(T
|
|
<SET HRS <- .HRS 12>>
|
|
<SET MSD " ">
|
|
<SET AM-PM? 2>)>
|
|
<COND (<==? .AM-PM? 1>
|
|
<COND (<BAND .FMT ,K-NTI-SM>
|
|
<SET MER " AM">)
|
|
(T
|
|
<SET MER " a.m.">)>)
|
|
(<==? .AM-PM? 2>
|
|
<COND (<BAND .FMT ,K-NTI-SM>
|
|
<SET MER " PM">)
|
|
(T
|
|
<SET MER " p.m.">)>)
|
|
(T
|
|
<SET MER " ">)>
|
|
<COND (<L? .HRS 10>
|
|
<TELL .MSD>)>
|
|
<TELL N .HRS>)>
|
|
<COND (<BAND .FMT ,K-NTI-MM>
|
|
<COND (<BAND .FMT ,K-NTI-HH>
|
|
<TELL ":">)>
|
|
<COND (<L? .MIN 10>
|
|
<TELL "0">)>
|
|
<TELL N .MIN>)>
|
|
<COND (<BAND .FMT ,K-NTI-SS>
|
|
<COND (<OR <BAND .FMT ,K-NTI-HH>
|
|
<BAND .FMT ,K-NTI-MM>>
|
|
<TELL ":">)>
|
|
<COND (<L? .SEC 10>
|
|
<TELL "0">)>
|
|
<TELL N .SEC>)>
|
|
<COND (<BAND .FMT ,K-NTI-HH>
|
|
<TELL .MER>)>>
|
|
|
|
; "RT-CLK-DOW-MSG"
|
|
|
|
<ROUTINE RT-CLK-DOW-MSG ("OPTIONAL" (FMT 1) "AUX" DOW WDOW)
|
|
<SET DOW <MOD <- <GETB ,GL-TIME ,K-DAY> ,K-DOW-BASE> 7>>
|
|
<COND (<BAND .FMT ,K-DOW-DW>
|
|
<COND (<BAND .FMT ,K-DOW-EN>
|
|
<SET WDOW <GET ,GL-DAY-NAME <+ .DOW 14>>>)
|
|
(<BAND .FMT ,K-DOW-SN>
|
|
<SET WDOW <GET ,GL-DAY-NAME <+ .DOW 7>>>)
|
|
(T
|
|
<SET WDOW <GET ,GL-DAY-NAME .DOW>>)>
|
|
<TELL .WDOW>)>>
|
|
|
|
; "alarm routines"
|
|
|
|
; "RT-ALARM-SET?"
|
|
|
|
<ROUTINE RT-ALARM-SET? (RTN "AUX" (R-PTR 0) T-PTR)
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<RFALSE>)
|
|
(<EQUAL? .RTN <GET ,GL-A-ROUT .R-PTR>>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<RT-COPY-TIME <REST ,GL-A-TIME .T-PTR> ,GL-TIME-PARM>
|
|
<RTRUE>)
|
|
(T
|
|
<INC R-PTR>)>>>
|
|
|
|
; "RT-ALARM-SET-REL"
|
|
|
|
<ROUTINE RT-ALARM-SET-REL (RTN TIME "AUX" (R-PTR 0) T-PTR)
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<TELL CR "*** TOO MANY ALARMS (REL) ***" CR CR>
|
|
<RFALSE>)>
|
|
;<DEBUGGING? <COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<TELL CR "*** TOO MANY ALARMS (REL) ***" CR CR>
|
|
<RFALSE>)>>
|
|
<COND (<ZERO? <GET ,GL-A-ROUT .R-PTR>>
|
|
<PUT ,GL-A-ROUT .R-PTR .RTN>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<COND (<MC-T? ,GL-ALARM-EXEC>
|
|
<REPEAT ((N 0))
|
|
<PUTB ,GL-A-TIME <+ .T-PTR .N>
|
|
<+ <GETB ,GL-TIME .N>
|
|
<GETB .TIME .N>>>
|
|
<COND (<G? <SET N <+ .N 1>>
|
|
<- ,K-A-TWDTH 1>>
|
|
<RETURN>)>>)
|
|
(T
|
|
<REPEAT ((N 0))
|
|
<PUTB ,GL-A-TIME <+ .T-PTR .N>
|
|
<+ <GETB ,GL-TIME .N>
|
|
<GETB .TIME .N>
|
|
<GETB ,GL-TIME-UPDT-INC .N>>>
|
|
<COND (<G? <SET N <+ .N 1>>
|
|
<- ,K-A-TWDTH 1>>
|
|
<RETURN>)>>)>
|
|
<RT-NORM-TIME <REST ,GL-A-TIME .T-PTR>>
|
|
<RTRUE>)
|
|
(T
|
|
<INC R-PTR>)>>>
|
|
|
|
; "RT-ALARM-SET-ABS"
|
|
|
|
<ROUTINE RT-ALARM-SET-ABS (RTN TIME "AUX" (R-PTR 0) T-PTR)
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<TELL CR "*** TOO MANY (ABS) ALARMS ***" CR CR>
|
|
<RFALSE>)>
|
|
;<DEBUGGING? <COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<TELL CR "*** TOO MANY (ABS) ALARMS ***" CR CR>
|
|
<RFALSE>)>>
|
|
<COND (<ZERO? <GET ,GL-A-ROUT .R-PTR>>
|
|
<PUT ,GL-A-ROUT .R-PTR .RTN>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<COPYT .TIME <REST ,GL-A-TIME .T-PTR> ,K-A-TWDTH>
|
|
<RTRUE>)
|
|
(T
|
|
<INC R-PTR>)>>>
|
|
|
|
; "RT-ALARM-CLR"
|
|
|
|
<ROUTINE RT-ALARM-CLR (RTN "AUX" (R-PTR 0) T-PTR)
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<RFALSE>)
|
|
(<EQUAL? .RTN <GET ,GL-A-ROUT .R-PTR>>
|
|
<PUT ,GL-A-ROUT .R-PTR 0>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<COPYT <REST ,GL-A-TIME .T-PTR> 0 ,K-A-TWDTH>)>
|
|
<INC R-PTR>>>
|
|
|
|
; "RT-ALARM-CHK"
|
|
|
|
<GLOBAL RUN-SMELL-ETHERIUM? <>>
|
|
|
|
<ROUTINE RT-ALARM-CHK ("OPTIONAL" (PARM 0)
|
|
"AUX" VAL (RTN -1) (R-PTR 0) (R-CNT 0)
|
|
T-PTR HRS MIN SEC DAY T-TIME)
|
|
<SETG RUN-SMELL-ETHERIUM? <>>
|
|
<COND (<MC-T? ,GL-ALARM-WAIT>
|
|
<SETG GL-ALARM-WAIT <>>
|
|
<RFALSE>)
|
|
(<MC-T? ,GL-ALARM-STOP>
|
|
<RFALSE>)>
|
|
<RT-COPY-TIME ,GL-TIME ,GL-TEMP-TIME>
|
|
<REPEAT ()
|
|
<COND (<EQUAL? .R-PTR ,K-A-RSIZE>
|
|
<COND (<EQUAL? .RTN -1>
|
|
<COND (,RUN-SMELL-ETHERIUM? <RETURN>)>
|
|
<RETURN .R-CNT>)
|
|
(T
|
|
; "Time to run it"
|
|
<SET R-PTR .RTN> ; "Get the offset stored in RTN"
|
|
<SET RTN <GET ,GL-A-ROUT .R-PTR>>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<PUT ,GL-A-ROUT .R-PTR 0>
|
|
<SET T-TIME <ZREST ,GL-A-TIME .T-PTR>>
|
|
<SET SEC <GETB .T-TIME ,K-SEC>>
|
|
<SET MIN <GETB .T-TIME ,K-MIN>>
|
|
<SET HRS <GETB .T-TIME ,K-HRS>>
|
|
<SET DAY <GETB .T-TIME ,K-DAY>>
|
|
<COPYT .T-TIME 0 ,K-A-TWDTH>
|
|
<COND (<MC-ISNOT? ,CH-PLAYER ,FL-ASLEEP>
|
|
<RT-UPDATE-STATUS-LINE>)>
|
|
<SETG GL-ALARM-EXEC T>
|
|
<SET VAL <APPLY .RTN>>
|
|
<COND (,RUN-SMELL-ETHERIUM? <RETURN>)>
|
|
<SETG GL-ALARM-EXEC <>>
|
|
<RT-COPY-TIME ,GL-TEMP-TIME ,GL-TIME>
|
|
<INC R-CNT>
|
|
; "If alarm time != new time, ask for key to cont."
|
|
<COND (<AND <MC-T? .VAL>
|
|
<EQUAL? <RT-CLOCK-CMP .HRS .MIN .SEC
|
|
.DAY> -1>>
|
|
<COND (<EQUAL? .PARM 1>
|
|
<TELL "[Press any key to continue.]" CR>
|
|
<INPUT 1>)
|
|
(<EQUAL? .PARM 2>
|
|
<REPEAT ()
|
|
<TELL CR
|
|
"Do you want to continue waiting?" CR
|
|
"Please press Y or N > ">
|
|
<SET VAL <INPUT 1>>
|
|
<PRINTC .VAL>
|
|
<CRLF>
|
|
<COND
|
|
(<EQUAL? .VAL !\N !\n>
|
|
<SET RTN -1>
|
|
<SET R-PTR ,K-A-RSIZE>
|
|
<RT-CLOCK-SET .HRS .MIN .SEC
|
|
.DAY>
|
|
<RETURN>)
|
|
(<EQUAL? .VAL !\Y !\y>
|
|
<RETURN>)>>)>)>
|
|
; "Reset and start loop again."
|
|
<COND (<EQUAL? .RTN -1>
|
|
<AGAIN>)>
|
|
<SET RTN -1>
|
|
<SET R-PTR 0>
|
|
<AGAIN>)>)>
|
|
<COND (<MC-T? <GET ,GL-A-ROUT .R-PTR>>
|
|
<SET T-PTR <* .R-PTR ,K-A-TWDTH>>
|
|
<SET SEC <GETB ,GL-A-TIME <+ .T-PTR ,K-SEC>>>
|
|
<SET MIN <GETB ,GL-A-TIME <+ .T-PTR ,K-MIN>>>
|
|
<SET HRS <GETB ,GL-A-TIME <+ .T-PTR ,K-HRS>>>
|
|
<SET DAY <GETB ,GL-A-TIME <+ .T-PTR ,K-DAY>>>
|
|
<COND (<OR <AND <MC-T? .PARM>
|
|
<EQUAL? <RT-CLOCK-CMP .HRS .MIN .SEC
|
|
.DAY> -1>>
|
|
<AND <MC-F? .PARM>
|
|
<EQUAL? <RT-CLOCK-CMP .HRS .MIN .SEC
|
|
.DAY> -1 0>>>
|
|
<RT-CLOCK-SET .HRS .MIN .SEC .DAY>
|
|
<SET RTN .R-PTR>)>)>
|
|
<INC R-PTR>>
|
|
<COND (,RUN-SMELL-ETHERIUM?
|
|
<RT-SMELL-ETHERIUM?>
|
|
.R-CNT)>>
|