Antic Magazine 1983 April/Antic_April_1983_Vol_2_No_1.atr/forth483.txt

Text File | 2021-01-21 | 3KB | 1 lines

\ 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¢