( START OF FILE 7DISP2 -- 8 July 88 -- MFB )
( ROUTINES FOR CONSOLE OUTPUT FOR BASIC SYSTEM)

SYNONYM ." PUTLIN
SYNONYM .C PUTCHR

: CRLF  ( PRINT A CARRIAGE RETURN, LINE FEED )
  13 .C 10 .C ;

: SPC ( print a space )
  20H .C
;

: SPCS ( print multiple spaces
         input:  tos=number of spaces to print )
  1 DO
      SPC 
    LOOP
;
CODE DOUT  ( CREATE A DIGIT BY SUBTRACTION )
  ( tos,nos = ,sub amt   3os,4os = ,remaining value)
  ( 5os = don't suppress 0 flag)
  H 0 LXI, SP DAD, XCHG, H 4 LXI, D DAD, XCHG,
  ( NOW DE -> REMAINING, HL -> SUBTRACT AMOUNT )
  B PUSH, B -1 MVI, ( B = DIGIT COUNTER)
  BEGIN
    B INR, H PUSH, D PUSH, C 4 MVI, A ORA,
    BEGIN
      D LDAX, M SBB, D STAX, H INX, D INX, C DCR,
    ENDZ
    D POP, H POP, A ORA,
  ENDM ( QUIT IF REMAINING < 0)
  C 4 MVI, A ORA, ( FIX REMAINING)
  BEGIN
    D LDAX, M ADC, D STAX, H INX, D INX, C DCR,
  ENDZ
  XCHG, ( hl -> suppress flag)
  A B MOV,  A ORA, IFNZ M 1 MVI, THEN ( set if non 0 found)
  10 CPI, IFNC 7 ADI, THEN ( if digit was > 9)
  "0" ADI, ( ascii offset)
  L A MOV, H 0 MVI, B POP,
  D POP, DI, XTHL, EI, ( mfb) ( TOS=DIGIT) :ENTER
  ( print digit unless suppressed)
  4 PICK IF .C ELSE DROP THEN  ; 

: %LST2 ( print last 2 digits)
  0 SWAP DOUT
  1 3 POKE ( don't suppress last digit)
  0 1 DOUT 3 KILL ;

( mfb)
: .L  ( PRINT TOP OF STACK )
(  32 .C  ( PRINT SPACE ))
  DUP 0 < IF
    "-" .C
    0 SWAP -  ( NEGATE )
  THEN
  0 SWAP ( suppress leading 0 flag)
  0 SWAP ( MAKE DBL PREC)
  0 10000 DOUT 0 1000 DOUT 0 100 DOUT 10 %LST2 ;

: . 32 .C .L ;

: .H ( HEX PRINT OF STACK TOP)
  32 .C ( PRINT SPACE)
  1 SWAP ( no zero suppress)
  0 SWAP ( MAKE DBL PREC)
  0 4096 DOUT 0 256 DOUT 16 %LST2 ;

: .HB ( PRINT HEX BYTE OF STACK TOP)
  32 .C ( PRINT SPACE)
  255 AND ( MAKE TOS A BYTE VALUE)
  1 SWAP ( don't suppress leading 0)
  0 SWAP ( MAKE TOS DBL PRECISION)
  16 %LST2 ;

: ,. ( DBL PREC DECIMAL PRINT)
  32 .C OVER 0 < IF
    "-" .C :EXIT H 0 LXI, SP DAD, STC, E 4 MVI,
    BEGIN
      A M MOV, CMA, 0 ACI, M A MOV, H INX, E DCR,
    ENDZ
    :ENTER
  THEN
  OVER 0 3 POKE SWAP ( suppress leading 0s is 3OS)
  3B9AH CA00H DOUT 05F5H E100H DOUT 0098H 9680H DOUT
  000FH 4240H DOUT 1 86A0H DOUT 0 10000 DOUT 0 1000 DOUT
  0 100 DOUT 10 %LST2 ;

: ,.H
  SWAP .H  1 SWAP ( no suppress) 0 SWAP
  0 4096 DOUT 0 256 DOUT 16 %LST2 ;

: DISPLAY ( DISPLAY TOP 12 STACK ELEMENTS IN HEX)
  12 BEGIN
    DUP 1+ PICK .H 1 - DUP 0=
  END DROP ;

( END OF FILE 7DISP )