CR .( Loading Traffic Lights ) CR             \ Message as the source loads
                                               \ CR starts a new line on the screen

 \ Declare variables,     set initial value
 VARIABLE     RED-WAIT    10    RED-WAIT !     \ 20 tenths = 2 seconds
 VARIABLE  YELLOW-WAIT    10 YELLOW-WAIT !     \ 10 tenths = 1 second
 VARIABLE   GREEN-WAIT    20  GREEN-WAIT ! 

 VARIABLE  %WAIT   100 %WAIT !                 \ Use 100 to simulate at 1 sec/sec>

 : ESC?          ( -- EscPressed )             \ TRUE if "Esc" key pressed
                 KEY? IF                       \ Has a key been pressed? 
                   KEY 27 =                    \ Return whether it is the "Esc" code or not
                 ELSE FALSE THEN               \ else return FALSE
 ; 
 : WAIT          ( Tenths -- )                 \ Waits for Tenths of a second
                 CR CR %WAIT @ * MS            \ MS waits for 1 milli-second
                 ESC? ABORT" Esc pressed"
 ; 
 : COLOR-SPACES  ( X Y Spaces Color -- )
                 BG-CLR @ >R                   \ Save the background color,
                 BG-CLR !                      \ then change it to Color.
                 ROT ROT AT-XY                 \ Move cursor to position X,Y.
                 SPACES                        \ Draw Spaces in background colour,
                 R> BG-CLR !                   \ then restore it.
 ;

 COLS @ 2/       \ Calculate half-way across screen
 1- CONSTANT  X  \ Traffic-light starts X spaces across screen
  5 CONSTANT  Y  \ Topmost lamp starts Y spaces down screen

 : LAMP          ( Y -- )
                     X OVER  4 GRAY COLOR-SPACES       \ As in XXXX
                 1 + X OVER  4 GRAY COLOR-SPACES       \       XXXX
                 1 + X SWAP  4 GRAY COLOR-SPACES       \       XXXX
 ; 
 : LENS          ( Y Colour -- )
                 X 1 + ROT ROT  2 SWAP COLOR-SPACES    \ As in  OO
 ; 
 : POST          ( Y -- )
                     X 1 + OVER  2 GRAY COLOR-SPACES   \ As in  XX
                 1 + X 1 + OVER  2 GRAY COLOR-SPACES   \        XX
                 1 + X 1 + SWAP  2 GRAY COLOR-SPACES   \        XX
 ; 
 : LAMP-&-POST   ( -- )                                \ As in XXXX
                 PAGE           \ Clears screen        \       XOOX
                 Y     LAMP  Y 1 + DARK-RED    LENS    \       XXXX
                 Y 2 + LAMP  Y 3 + DARK-YELLOW LENS    \       XOOX
                 Y 4 + LAMP  Y 5 + DARK-GREEN  LENS    \       XXXX
                 Y 7 + POST                            \       XOOX
                 0 0 AT-XY                             \       XXXX                  
 ;                                                     \        XX
                                                       \        XX
                                                       \        XX
\ Show bright lens, wait and then dim the lens again
 : RED-&-YELLOW  ( -- )
                 Y 1 +       RED LENS  Y 3 +       YELLOW LENS
                 YELLOW-WAIT @ WAIT
                 Y 1 +  DARK-RED LENS  Y 3 +  DARK-YELLOW LENS
                 CR
 ; 
 : RED           ( -- )
                 Y 1 +  RED LENS       \ Draw the lens with bright color
                 RED-WAIT @ WAIT      
                 Y 1 +  DARK-RED LENS  \ Draw the lens again with dim color
                 CR
 ;
 : YELLOW        ( -- )
                 Y 3 +  YELLOW LENS
                 YELLOW-WAIT @ WAIT
                 Y 3 +  DARK-YELLOW LENS
                 CR
 ; 
 : GREEN         ( -- )
                 Y 5 +  GREEN LENS
                 GREEN-WAIT @ WAIT
                 Y 5 +  DARK-GREEN LENS
                 CR
 ; 

\ Word to show the traffic-light and prompt the user
 : LAMP-POST     ( -- )
                 LAMP-&-POST
                 ." To exit, press Esc key" CR
 ;

 \ Now execute the word
 LAMP-&-POST 

\ ( Traffic-light example - Words for user to enter )
\  : PHASES  ( -- )
\        RED RED-&-YELLOW GREEN YELLOW
\  ;
\  : TRAFFIC-LIGHT  ( -- )
\        LAMP-POST BEGIN PHASES AGAIN
\  ;