FILMAT11.BLK

\ filmat11                                  \ 18:37 29Jan88 b0b                                                                                                                                   "Film At Eleven", in which we wait for a time, then go bye.                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                   \ LOAD screen                               \ 19:34 27Jun88 b0b                                                                 : CLS                                                               27 EMIT ASCII b EMIT 0 EMIT    \ white letters                  27 EMIT ASCII c EMIT 1 EMIT    \ black background               27 EMIT ASCII E EMIT  ;        \ clear screen                                                                                2 CAPACITY 1- THRU                                                                                                                                                                              ' DOIT IS BOOT                                                                                                                  SAVE-SYSTEM  FILMAT11.TOS                                                                                                                                                                                                                                      \ ?ESC WAIT.TIL                             \ 18:50 29Jan88 b0b                                                                 : ?ESC  ( -- f )        \ TRUE if ESC key pressed                   KEY?                                                              IF   KEY 27 =                                                   ELSE FALSE                                                      THEN  ;                                                                                                                   : WAIT.TIL  ( time -- )   \ loops til time or ESC key pressed         BEGIN GETTIME OVER =                                                  ?ESC OR                                                   UNTIL                                                         DROP  ;                                                                                                                                                                                                                                                     \ ?PM                                       \ 19:46 10Apr88 b0b                                                                 : ?P  ( c -- flag )   \ TRUE if char is P or p                     DUP  ASCII P =                                                  SWAP ASCII p = OR  ;                                                                                                         : ?PM  ( adr -- flag )   \ TRUE if there's a P in the string       FALSE  SWAP  8 0                                                DO    COUNT ?P                                                        ROT OR SWAP                                               LOOP                                                            DROP  ;                                                                                                                                                                                                                                                                                                                      \ SET.11                                    \ 19:53 10Apr88 b0b VARIABLE HOUR  VARIABLE MINUTE  VARIABLE SECOND                                                                                 : SET.11  ( -- )  \ prompt user, set vars to target time            CLS   PAD 10 ERASE  CR CR                                       CR ."   Input target time: "                                    PAD 1+ 8 EXPECT                                                 0. PAD CONVERT  >R DROP  HOUR !                                 0. R>  CONVERT  >R DROP  MINUTE !                               0. R>  CONVERT    2DROP  SECOND !                               PAD 1+ ?PM  HOUR @ 12 <>  AND                                     IF  12 HOUR +!  THEN                                          HOUR @ 24 >  MINUTE @ 59 > OR SECOND @ 59 > OR                    IF  RECURSE  THEN  ;                                                                                                                                                                      \ ELEVEN                                    \ 19:50 29Jan88 b0b                                                                 : ELEVEN  ( -- time )  \ makes binary time                          HOUR @ 24 =                                                       IF 0 HOUR ! THEN                                              HOUR @    11 0 DO 2* LOOP                                       MINUTE @   5 0 DO 2* LOOP                                       SECOND @  2/  OR OR ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       \ EXPLAIN                                   \ 20:26 29Jan88 b0b : ":"  BS EMIT ASCII : EMIT ;                                                                                                   : EXPLAIN  ( -- )  \ a happy prompt                                 27 EMIT ASCII f EMIT        \ turn off cursor                   CR CR                                                           CR ."   Unless you press the Escape key first,"                 CR ."   this program will wait until"                           CR CR 8 SPACES                                                  HOUR @ DUP 12 > >R  R@ IF 12 - THEN  . ":"                      MINUTE @ .                                                      SECOND @ ?DUP                                                     IF ":" . THEN                                                 R> IF ." pm" THEN                                               CR CR ."   and then terminate."  ;                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                          \ DOIT                                      \ 20:13 29Jan88 b0b                                                                 : DOIT  ( -- )                                                      SET.11                                                          EXPLAIN                                                         ELEVEN WAIT.TIL                                                 CR CR ." Yeah!"                                                 BYE  ;