FORTH FACTORY

New Words

by John Peters

The following Forth words were compiled by John Peters, an active Forth user in San Francisco. When screen 50 is loaded, a 25th line will appear at the top of your television screen showing the stack contents. As with all Forth words, they can be adapted, enhanced, or altered in any way suitable to end-users. If these words suggest other ideas, let us know. We encourage the entire Forth community to share their discoveries and ideas in Forth Factory.

\ 50 25th line a.k.a. DISPLAY STACK
    DECIMAL

: DO-THRU ( from thru --- )
        compile 1+ compile swap
        compile (do) here 3 ; immediate 

: PRE ( pre get-screen to buffers )
      8 * DUP 9 + SWAP
      DO I BLOCK DROP LOOP ;
: PRES DO-THRU I PRE LOOP ;
   71 75 PRES
51 LOAD
52 LOAD
53 LOAD
54 LOAD
55 LOAD

: DON info-line install ;
: DOFF info-line remove ;
: 25th_LINE_/ ; ( Dictionary marker )

  DON ;S

\ 51 25th LINE NORMAL WINDOW COLORS   A

VOCABULARY INFO-LINE IMMEDIATE

INFO-LINE DEFINITIONS HEX

VIDEO-BASE CONSTANT NORMAL
  ( beginning of screen RAM for )
  ( OS graphics mode 0 )

: WINDOW ( addr -- )
  ( makes OS think screen RAH is at )
  ( addr. )
  58 ! 0 0 POSITION ;

55 CONSTANT COLCRS
  ( OS aodress of cursor column # )

FORTH DEFINITIONS DECIMAL


\ 52 25th line CLEAR25 DLIST B

INFO-LINE DEFINITIONS HEX

HERE DUP 3F + FFC0 AND SWAP - ALLOT 

LABEL BUFF25 DECIMAL 40 ALLOT
  ( Screen RAH for info line )

: CLEAR25
BUFF25 40 ERASE ;

LABEL DLIST HEX
  ( Part of a display list which gets )
  ( patched into the OS one to create )
  ( the info line. )
  70 C, 70 C,    ( some blank lines )
  42 C, BUFF25 , ( mode 0 w/LMS )
  01 C, O,       ( ANTIC JMP back )
                 ( to the OS )
                 ( display list )

FORTH DEFINITIONS DECIMAL


\ 53 25th DEC# HEX# BIN# BASE# C

INFO-LINE DEFINITIONS DECIMAL

: DEC# ( n1 --- addr n )
  DUP ABS 0 <# #S SIGN #> ;

: HEX# ( u --- addr n )
  0 <# # # # # #> ;

: BLW ( u --- addr n )
  0 <# 16 0 DO # LOOP #> ;

: U# ( u --- addr n )
  0 <# #S #> ;

: BASE# ( n1 --- addr n )
       BASE @ CASE
  10 OF DEC# ENDOF
  16 OF HEX# ENDOF
   2 OF BIN# ENDOF
  >R U# R> ENDCASE ;


\ 54 25th Line BAC< .STACK DISPLAY D

INFO-LINE DEFINITIONS DECIMAL

: BAC< ( n --- )
  MINUS COLCRS +! ;

: .STACK ( --- )
                        DEPTH 2 > IF
                      DEPTH l+ 3 DO
                    I (PICK) BASE#
                 DUP COLCRS @ < IF
  >R R BAC< R TYPE R> l+ BAC< ELSE
              DROP DROP LEAVE THEN
                               LOOP
                                THEN ;

: DISPLAY ( --- )
      LOCATION CURSOR-OFF
    CLEAR25 BUFF25 WINDOW
  34 0 POSITION ." <-TOS"
     33 0 POSITION .STACK
            NORMAL WINDOW
       POSITION CURSOR-ON ;


\ 55 25th Line PATCH- ROUTINE INSTALL E

INFO-LINE DEFINITIONS HEX

: PATCH- ( --- )
       0230 @ DUP C@ 01 = NOT IF
  DUP 3 + DLIST 6 + ! 01 OVER C!
            DLIST SWAP l+ ! ELSE
                       DROP THEN ; 

: ROUTINE ( --- )
  PATCH- DISPLAY CR ;

: INSTALL
  ' ROUTINE CFA ' ABORT 6 + !
  ' ROUTINE CFA ' QUIT 0A + !
              [COMPILE] FORTH ; 

: REMOVE
       ' CR CFA ' ABORT 6 + !
       ' CR CFA ' QUIT 0A + !
   0 022F C! 0230 @ 3 70 FILL
  22 022F C!  [COMPILE] FORTH ;

FORTH DEFFINITIONS DECIMAL