anew --DSOUTPUT-- \ Wil Baden 2003-02-07 \ ******************************************************************* \ * * \ * Wil Baden 2003-02-07 * \ * * \ * VOCABULARY Dataspace-Output * \ * * \ * [READY] ... [SET] ... [GO] * \ * * \ * [READY] ( -- ) * \ * Do setup for dataspace output. Save HERE for later * \ * restoration. * \ * * \ * [SET] ( -- ) * \ * Start storing output in data space, * \ * * \ * [GO] ( -- ) * \ * Display the output from data space. Restore HERE. * \ * * \ ******************************************************************* VOCABULARY Dataspace-Output ONLY FORTH ALSO Dataspace-Output DEFINITIONS S" /PAD" ENVIRONMENT? NOT [IF] 84 [THEN] CONSTANT /PAD : Output-Start PAD /PAD + ; VARIABLE Output-End VARIABLE C# \ Column number. : EMIT Output-End @ HERE UNUSED + 384 - U> ABORT" Data Space Exhausted " Output-End dup >R @ C! 1 R> +! 1 C# +! ; : CR #EOL-CHAR EMIT 0 C# ! ; : SPACE BL EMIT ; : SPACES 0 ?DO SPACE LOOP ; : TYPE BOUNDS ?DO I C@ EMIT LOOP ; \ Definitions for the rest of the Core and Core Ext display words. CREATE PAD 84 chars ALLOT \ *************************** Interface *************************** ONLY FORTH DEFINITIONS : [READY] S" HERE >R align " EVALUATE ; IMMEDIATE : [SET] S" [ ALSO Dataspace-Output ] Output-Start Output-End ! 0 C# ! " EVALUATE ; IMMEDIATE ; : [GO] S" Output-Start Output-End @ [ PREVIOUS ] OVER - TYPE R> HERE - ALLOT " EVALUATE ; IMMEDIATE \ ************************ Implementation ************************* \ Digit>Char ( n -- char ) \ Convert digit from binary number to character. \ Number>Length ( u -- len ) \ Get the display length of an unsigned number. : Digit>Char ( n -- char ) dup 10 < IF [char] 0 + ELSE 10 - [char] A + THEN ; : Number>Length ( u -- len ) 0 >R BEGIN R> 1+ >R 0 BASE @ UM/MOD NIP dup 0= UNTIL DROP ( ) R> ; \ *********** Numeric and String-Literal Implementation *********** ONLY FORTH ALSO Dataspace-Output DEFINITIONS \ Since the HOLD area - the pictured numeric output stream buffer - \ may be over-written, the stack is used for numeric output. : Recurse-for-Digits ( u -- ) 0 BASE @ UM/MOD ?dup IF RECURSE THEN Digit>Char EMIT ; : U. ( u -- ) Recurse-for-Digits SPACE ; : . ( n -- ) dup 0< IF BASE @ 10 = IF [char] - EMIT NEGATE THEN THEN U. ; : U.R ( u w -- ) over Number>Length ( u w len) - 0 MAX SPACES ( u) Recurse-for-Digits ; : .R ( n w -- ) over 0< IF over NEGATE Number>Length ( n w len) - 1- 0 MAX SPACES ( n) [char] - EMIT NEGATE Recurse-for-Digits ELSE U.R THEN ; : ." ( "ccc" -- ) postpone S" postpone TYPE ; IMMEDIATE \ ************************** Char-Break *************************** VARIABLE Initial-Char-in-Item : Char-Break ( char -- ) Char>Upper Initial-Char-in-Item ( char addr) 2dup @ <> IF C# @ IF CR 0 C# ! THEN CR THEN ! ; \ ******************* Implementation Completed ******************** ONLY FORTH DEFINITIONS \\ Experiment. : ?CR S" C# @ + #Chars/Line > IF CR 0 C# ! THEN " EVALUATE ; IMMEDIATE : ? S" @ . " EVALUATE ; IMMEDIATE \\ // \\ // \\ // \\ // \\ // \\ // \\ // \\