\
\ autodoc.4th
\   95 jun 26
\
\ Words that I used to document the examples.
\ WARNING: this is ugly, unpolished code.
\

\
\ First, the words that make the box schemes.
\

DECIMAL

0 VALUE B-H             \ like CR-H

: B-HERE ( -- adr ) B-H CRIM-BEGMEM + ;
: B@U1, ( -- u1 ) B-HERE C@ 1 +TO B-H ;
: B@U4, ( -- u4 ) B-HERE @ 4 +TO B-H ;

CREATE STR1  200 ALLOT
CREATE STR2  200 ALLOT
CREATE STR3  200 ALLOT
CREATE STR4  200 ALLOT

0 VALUE BPOS

: B->1 ( -- adr ) STR1 BPOS + ;
: B->2 ( -- adr ) STR2 BPOS + ;
: B->3 ( -- adr ) STR3 BPOS + ;
: B->4 ( -- adr ) STR4 BPOS + ;

: CLRSTRS ( -- )
    STR1 200 BL FILL
    STR2 200 BL FILL
    STR3 200 BL FILL
    STR4 200 BL FILL
    0 TO BPOS ;

: U>D ( u -- d ) 0 ;
: <##> ( d -- $adr $len ) <# # # #> ;
: <########> ( d -- $adr $len ) <# # # # # # # # # #> ;


\
\ Logic: BPOS is advanced by the words that write on STR1 and STR3,
\ B-H is avanced by the words that read it.
\

ASCII - VALUE FLOORCHAR

: ROOFLO ( -- )
    B->1 2 ASCII - FILL
    B->3 2 FLOORCHAR FILL  2 +TO BPOS ;
: PLUS ( -- ) ASCII + B->1 C!   ASCII + B->3 C!  1 +TO BPOS ;
: _BAR ( -- ) ASCII | B->2 C! ;
: BAR ( -- ) _BAR PLUS ;
: ROOFLO4 ( -- ) ROOFLO PLUS ROOFLO PLUS ROOFLO PLUS ROOFLO ;

: _2ADR ( -- ) B-H U>D <##> B->4 SWAP MOVE ;
: U1 ( -- ) B@U1, U>D <##> B->2 SWAP MOVE           ROOFLO ;
: U4 ( -- ) B@U4, U>D <########> B->2 2+ SWAP MOVE  ROOFLO4 ;

: FL= ( -- ) ASCII = TO FLOORCHAR ;
: FL- ( -- ) ASCII - TO FLOORCHAR ;
: FL. ( -- ) ASCII . TO FLOORCHAR ;
: FL$ ( -- ) ASCII $ TO FLOORCHAR ;
: FL> ( -- ) ASCII > TO FLOORCHAR ;

: ADRBAR ( -- ) _2ADR BAR ;

: NPLUS ( n -- ) 0 DO PLUS U1 LOOP ;
: DOSTR ( -- ) B-HERE C@   BAR  FL$ U1  BAR FL. U1  1- NPLUS ;

\
\ supported commands: " |=-$>.HhSsLlQquj"
\
: BOXCHAR-RUN ( c -- )
    CASE
           BL OF  1 +TO BPOS       	   ENDOF
      ASCII = OF  FL=		           ENDOF
      ASCII - OF  FL-		           ENDOF
      ASCII . OF  FL.		           ENDOF
      ASCII $ OF  DOSTR                    ENDOF
      ASCII > OF  DOSTR                    ENDOF
      ASCII H OF  ADRBAR  FL=  U1	   ENDOF
      ASCII h OF     BAR  FL=  U1	   ENDOF
      ASCII S OF  ADRBAR  FL-  U1	   ENDOF
      ASCII s OF     BAR  FL-  U1	   ENDOF
      ASCII L OF  ADRBAR  FL-  U1 PLUS U1  ENDOF
      ASCII l OF     BAR  FL-  U1 PLUS U1  ENDOF
      ASCII Q OF  ADRBAR       U4	   ENDOF
      ASCII q OF     BAR       U4	   ENDOF
      ASCII u OF     BAR       U1          ENDOF
      ASCII j OF     BAR  FL>  U1          ENDOF
      ASCII | OF     BAR		   ENDOF
        EMIT ." -> unacceptable char" ABORT
    ENDCASE ;

: PRB ( $adr -- ) CR BPOS TYPE ;
: .BOX ( -- ) STR1 PRB  STR2 PRB  STR3 PRB  STR4 PRB  CR ;

: BOX" ( -- ;" ) CLRSTRS
    ASCII " PARSE  ( $adr $len )
    0 DO DUP I + C@ BOXCHAR-RUN LOOP DROP
    .BOX ;



\
\ Tilde words and \\, used for the "symbolic" schemes.
\

CREATE TARR1 600 ALLOT
  TARR1 VALUE TARR1-W
  TARR1 VALUE TARR1-R
  : TARR1!, ( w -- ) TARR1-W !  4 +TO TARR1-W ;
  : TARR1@, ( -- w ) TARR1-R @  4 +TO TARR1-R ;
  : TARR1-CLR ( -- ) TARR1 TO TARR1-W  TARR1 TO TARR1-R ;

CREATE TARR2 600 ALLOT
  TARR2 VALUE TARR2-W
  TARR2 VALUE TARR2-R
  : TARR2!, ( w -- ) TARR2-W !  4 +TO TARR2-W ;
  : TARR2@, ( -- w ) TARR2-R @  4 +TO TARR2-R ;
  : TARR2-CLR ( -- ) TARR2 TO TARR2-W  TARR2 TO TARR2-R ;

: N~ ( n -- ) TARR1!, ;
: ~  ( -- ) CR-H N~ ;
: ~1 ( -- ) ~  CR-H 1+ N~ ;
: ~3 ( -- ) ~1  CR-H 2 + N~  CR-H 3 + N~ ;

: ~~ ( -- )  CR-H TARR2!,  ~  ;
: ~~1 ( -- ) CR-H TARR2!,  ~1 ;
: ~~3 ( -- ) CR-H 2 + TARR2!,  ~3 ; 

\ we use BPOS, STR1, STR2...

: TILDE-BELOW ( -- ) BL B->1 C!   TARR1@, U>D <##> B->2 1+ SWAP MOVE ;
: TILDE-SAMELINE ( -- ) TARR2@, U>D <##> B->1 SWAP MOVE ;

: B->TILDEDO ( -- ) 
    B->1 C@ ASCII ~ =
    IF  B->1 1+ C@ BL = IF TILDE-SAMELINE 
                        ELSE TILDE-BELOW
                        THEN
    THEN ;

: .SYMB ( -- ) STR1 PRB  STR2 PRB  CR ;
: \\ ( -- ;\ ) CLRSTRS
    127 PARSE -TRAILING  2DUP STR1 SWAP MOVE  ( adr len -- )
    NIP 3 + 0 DO  B->TILDEDO  1 +TO BPOS  LOOP
    .SYMB ;



\
\ Turn on single-stepping
\

: MY-STEPPER ( -- ) CR SHOW-STACKS ;
' MY-STEPPER CRIM-STEPPER!