clock.blk

                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ System Support 1   Load screen                      13Apr84map1 4  +THRU                                                      CR .( Clock Loaded )                                            EXIT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                            \ Months and Days                                     07Apr84map: "ARRAY   ( compile: string-length -- ) ( run: -- a n )           CREATE  C,  ASCII " WORD  COUNT >R HERE R@ MOVE R> ALLOT        DOES>   COUNT >R SWAP R@ * + R> ;                                                                                            3 "ARRAY "MONTH "JanFebMarAprMayJunJulAugSepOctNovDec"          3 "ARRAY "DAY "SunMonTueWedThuFriSat"                                                                                           HEX   5A CONSTANT CLK-C          CLK-C 1+ CONSTANT CLK-D        : CLK@   (S n -- nib )  10 OR CLK-C PC! CLK-D PC@ ;             : CLK!   (S n a -- )   40 CLK-C PC!  40 OR DUP CLK-C PC!           SWAP CLK-D PC!  DUP 60 OR CLK-C PC!  CLK-C PC! ;             : CLOCK?   (S -- f )   0 CLK@ 0F0 AND 0= ;                      DECIMAL                                                                                                                                                                                         \ Clock                                               07Apr84map: CLK#   (S n -- )   CLK@ 48 OR HOLD ;                          : (DATE)   (S -- a n )                                            <# 11 CLK# 12 CLK# 9 CLK@ 10 CLK@ 10 * + 1- "MONTH               DUP NEGATE HLD +! HLD @ SWAP CMOVE  7 CLK# 8 CLK# 0 0 #> ;   : (TIME)   (S -- a n )                                             0. <# 0 CLK# 1 CLK# ASCII : HOLD 2 CLK# 3 CLK# ASCII : HOLD     4 CLK# 5 CLK@ 3 AND 48 OR HOLD #> ;                          : ?AM/PM   (S -- )   5 CLK@ DUP 8 AND 0=                           IF  4 AND IF ." PM" ELSE ." AM" THEN  ELSE DROP THEN  ;      : DAY    (S -- )   6 CLK@ "DAY TYPE SPACE ;                     : DATE   (S -- )   (DATE) TYPE SPACE ;                          : TIME   (S -- )   (TIME) TYPE SPACE ;                          : NOW    (S -- )   CLOCK? IF   DAY DATE TIME ?AM/PM  THEN  ;                                                                                                                                    \ Set Time                                            07Apr84map: INPUT?   ( -- [n] f )                                            QUERY BL WORD NUMBER? NIP DUP 0= IF NIP THEN  ;                                                                              : SET-TIME   (S -- )                                               CR ." Day of week? ( 0 to 6 ) " INPUT? IF  6 CLK!  THEN         CR ." Day of month? " INPUT? IF  10 /MOD 8 CLK! 7 CLK!  THEN    CR ." Month? " INPUT? IF  10 /MOD 10 CLK! 9 CLK!  THEN          CR ." Year? " INPUT? IF  10 /MOD 12 CLK! 11 CLK!  THEN          CR ." Hour? " INPUT? IF  DUP 12 > IF 12 - 4 ELSE 0 THEN SWAP    10 /MOD ROT OR 5 CLK! 4 CLK!  THEN                              CR ." Minute? " INPUT? IF  10 /MOD 3 CLK! 2 CLK!  THEN          0 1 CLK! 0 0 CLK!                                               CR ." Hit any key to start." CR  KEY DROP 0 CLK-C PC! ;                                                                                                                                      \ Automatic EDITOR ID                                 10Apr84map: (WHO)   (S -- )   " map" ;                                    : WHO   (S -- )   (WHO) TYPE SPACE ;                            : SET-ID   (S -- )                                                 CLOCK?                                                          IF  (DATE) [ EDITOR ] ID SWAP CMOVE  (WHO) ID 7 + SWAP CMOVE    THEN   HELLO  ;                                              ' SET-ID IS BOOT                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Months and Days                                     07Apr84map"ARRAY   ( compile: string-length -- ) ( run: -- a n )            Defining word for string arrays.                                                                                                                                                              "MONTH Array of the names of the months.                        "DAY   Array of the names of the days of the week.                                                                              CLK-C  CLK-D   addresses of the clock IO ports.                 CLK@   get a byte from the clock.                               CLK!   give a byte to the clock.                                                                                                CLOCK?   test for presence of the clock.                                                                                                                                                                                                                        \ Clock                                               07Apr84mapCLK#   (S n -- )   prefix a number from the clock to the output.(DATE)   (S -- a n )                                              Build an output string representing the date. Leave its         address and length.                                           (TIME)   (S -- a n )                                              Build an output string representing the time. Leave its         address and length.                                           ?AM/PM   (S -- )                                                  If in 12 hour mode, print AM or PM.                           DAY    (S -- )   print the name of the day.                     DATE   (S -- )   print the date.                                TIME   (S -- )   print the time.                                NOW    (S -- )   if there is a clock,                             print the day, date, and time.                                                                                                \ Set Time                                            07Apr84mapINPUT?   ( -- [n] f )                                             wait for user to type a number. Leave number and true,          or just false if no input.                                    SET-TIME                                                          Set the clock. Prompt for input. Entering just a Carraige       Return will leave the present value unchanged.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                \ Automatic EDITOR ID                                 07Apr84map(WHO)   leave address and length of string containing user id.    Change this if your initials happen to be different.          WHO   print user id.                                            SET-ID   This replaces the usual cold boot routine.               After the usual HELLO, if there is a clock, the EDITOR ID is    set to contain the present date and user initials.                                                                            Set BOOT to use SET-ID. If the executable image of the system     is now saved, then when it is run COLD will use SET-ID.