\ UTILS.SEQ     Some basic utilities


: ?             ( adr -- )
                @ .   ;

: YCOUNT        ( a1 --- a2 n1 )
                DUP 1+ SWAP YC@ ;

: ?ENOUGH       ( n -- )
                DEPTH 1- > ABORT" Not enough Parameters" ;

: BS'S          ( n1 --- )
                0 MAX 80 MIN 0 ?DO 8 EMIT -2 #OUT +! LOOP ;

: .FREE         ( -- )
                ." Free Bytes:"
                 ."  CODE = "       SP@       HERE - (U.) TYPE
                ." , LIST = " #LISTSEGS XHERE DROP XSEG @ - - 16 *D 1 D.R
                ." , HEAD = " #HEADSEGS 16 * YHERE - (U.) TYPE ;

: @REL>ABS      ( A1 --- A2 )         \ CONVERT CONTENTS OF A1
                DUP 1+ @ SWAP 3 + + ;     \ FROM RELATIVE TO ABSOLUTE

: DRIVE?        ( -- )   0 25 BDOS ASCII A + EMIT ." : "  ;

                \ These are needed by later utilities

DEFER CCR       ' CR IS CCR             \ Carraige Carraige return?

DEFER .DEFSRC   ' NOOP IS .DEFSRC       \ Nothing for now, may be set
                                        \ to display the source for the
                                        \ current definition.

VARIABLE DEFCFA                         \ Holds the CFA of the current word.
VARIABLE PFASAV                         \ Current offset into definition.

2VARIABLE CTIME         GETTIME CTIME 2!
2VARIABLE CDATE         GETDATE CDATE 2!

: LARGEST       ( addr n -- addr' val )
                OVER 0 SWAP ROT 0
                DO      2DUP @ U<
                        IF      -ROT 2DROP    DUP @ OVER
                        THEN    2+
                LOOP    DROP   ;

\ : LABEL   PRECODE CREATE ASSEMBLER   ;

: DOES?         ( IP -- IP' F )  \ IP IS ACTUALLY CFA, IP' IS PFA
                DUP >BODY SWAP @REL>ABS @REL>ABS
                ['] FORTH      @REL>ABS @REL>ABS = ;

' HEX @REL>ABS CONSTANT 'DOCOL

: >.ID          ( A1 --- )
                DUP 200 U< IF DROP EXIT THEN
                128 0
                DO      DUP @REL>ABS 'DOCOL =
                        IF  LEAVE ELSE 1- THEN
                LOOP    >NAME .ID ;

VARIABLE FUDGE   65  FUDGE !            \  65 =  8Mhz AT Clone
                                        \ 100 = 10Mhz AT Clone
: MS   ( n -- )
   0 ?DO   FUDGE @ 0 ?DO PAUSE LOOP  LOOP  ;

HEX
: setfudge      ( --- )
                ( DEFERS INITSTUFF )
                SEQINIT                 \ Should use above line. but DEFERS
                                        \ is defined later.
                F000 FFFE c@l 00FC =         \ 00FC = PCAT
                if 41 else 0F then fudge ! ; \ 00FF = PC
                                             \ 00FE = XT
' SETFUDGE IS INITSTUFF                      \ 00FD = PCjr
                                             \ 002D = Compaq PC
                                             \ 009A = Compaq XT
DECIMAL

: U<=   ( u1 u2 -- f )   U> NOT   ;
: U>=   ( u1 u2 -- f )   U< NOT   ;
: <=    ( n1 n2 -- f )   > NOT    ;
: >=    ( n1 n2 -- f )   < NOT    ;
: 0>=   ( n1 n2 -- f )   0< NOT   ;
: 0<=   ( n1 n2 -- f )   0> NOT   ;

VARIABLE #TIMES   ( # times already performed )   1 #TIMES !

: TIMES   ( n -- )
   1 #TIMES +!  #TIMES @
   < IF  1 #TIMES !  ELSE  >IN OFF  THEN   ;

: MANY   ( -- )
   KEY? NOT IF   >IN OFF   THEN   ;



: AT            ( col row -- )  ( 0 0 is upper left )
                DOES>  >R 2DUP R> PERFORM  #LINE !  #OUT ! ; AT

' 2DROP IS AT

: DARK          ( -- )
                DOES>  PERFORM   #LINE OFF  #OUT OFF   ; DARK

' NOOP IS DARK

: ?DARK         ( -- )
                KEY? 0= IF DARK CR THEN ;

DEFER -LINE

VARIABLE #PAGE

: PAGE   ( -- )
   DOES> PERFORM   1 #PAGE +!   #LINE OFF   #OUT OFF   ; PAGE

: FORM-FEED   ( -- )   CONTROL M EMIT   CONTROL L EMIT  ;

' FORM-FEED IS PAGE

: ?PAGE         ( --- )         \ PAGE IF LINE CNT NOT ZERO
                #LINE @
                IF      PAGE
                THEN    ;

: ALIAS         ( A1 | alias_NAME --- ) \ creates alias_NAME pointing
                >R CREATE -3 ALLOT YHERE 2-        \ A1=CFA OF REAL NAME
                R> >NAME YCOUNT 31 AND + Y@
                SWAP Y! ;


VARIABLE NLEN

: >NAME.ID      ( CFA --- )
                >NAME DUP YC@ 31 AND DUP ?LINE NLEN ! .ID ;

DEFER (SEE)

DEFER INSTALLSTUFF      ' NOOP IS INSTALLSTUFF
DEFER UNINSTALLSTUFF    ' NOOP IS UNINSTALLSTUFF

DEFER >ATTRIB1          ' NOOP IS >ATTRIB1
DEFER >ATTRIB2          ' NOOP IS >ATTRIB2
DEFER >ATTRIB3          ' NOOP IS >ATTRIB3
DEFER >ATTRIB4          ' NOOP IS >ATTRIB4
DEFER >NORM             ' NOOP IS >NORM

DECIMAL

VARIABLE RESTBASE       10 RESTBASE !
VARIABLE RESTCAPS       RESTCAPS ON
VARIABLE RESTTABS       8 RESTTABS !
VARIABLE RESTLMRG       RESTLMRG OFF
VARIABLE RESTRMRG       70 RESTRMRG !
VARIABLE RESTSTAT       RESTSTAT OFF
VARIABLE STATV          STATV OFF

: SAVESTATE     ( --- )
                BASE @ RESTBASE !
                CAPS @ RESTCAPS !
                LMARGIN @ RESTLMRG !
                RMARGIN @ RESTRMRG !
                TABSIZE @ RESTTABS !
                STATV   @ RESTSTAT ! ;

: RESTORESTATE  ( --- )
                RESTSTAT @ STATV !
                RESTBASE @ BASE !
                RESTCAPS @ CAPS !
                RESTLMRG @ LMARGIN !
                RESTRMRG @ RMARGIN !
                RESTTABS @ TABSIZE ! ;

: DEFAULTSTATE  ( --- )
                RESTSTAT ON
                10 RESTBASE !
                RESTCAPS ON
                8 RESTTABS !
                RESTLMRG OFF
                70 RESTRMRG !
                RESTORESTATE ;

: ?DOSTOP       ( F1 --- )
                IF      RESTORESTATE
                        TRUE ABORT" Stopped"
                THEN    ;

: ?KEYPAUSE     ( --- )         \ Pause if key pressed
                KEY?
                IF      KEY 27 = ?DOSTOP
                        KEY 27 = ?DOSTOP
                THEN    ;

: $>TIB         ( a1 --- )
                COUNT >R TIB R@ CMOVE R@ SPAN ! R> #TIB ! >IN OFF  ;