123 456 <# #S 3DROP <# #S #>

: ZLEN
  >R 0 BEGIN R@ OVER + C@ WHILE 1+ REPEAT  RDROP
;

\ Кстати, может заменить на ASCII ? Как у Броуди?
: CHAR PARSE C@ ;
: [CHAR] PARSE C@ LIT, ; IMMEDIATE



CREATE formats 256 CELLS ALLOT
VARIABLE str-posx

: FPRINT   \ ( str -- ) \ Печать с форматированием
  WHEREX str-posx !
  BEGIN DUP C@ DUP WHILE
    formats OVER -TH @ DUP
      IF
        NIP EXECUTE
      ELSE
        DROP EMIT
      THEN
    1+
  REPEAT
  2DROP
;

: StrFormat  \ ( char -- )
  formats SWAP -TH
  [C]HERE SWAP !
  ]
;

: StrFormat:  \ ( char -> )
  CHAR StrFormat
;

: ;StrFormat [COMPILE] ; ; IMMEDIATE

CREATE abc-nums 256 ALLOT
0xFF abc-nums 256 CFILL

HEX
0 abc-nums CHAR 0 + C!  8 abc-nums CHAR 8 + C!
1 abc-nums CHAR 1 + C!  9 abc-nums CHAR 9 + C!
2 abc-nums CHAR 2 + C!  A abc-nums CHAR A + C!
3 abc-nums CHAR 3 + C!  B abc-nums CHAR B + C!
4 abc-nums CHAR 4 + C!  C abc-nums CHAR C + C!
5 abc-nums CHAR 5 + C!  D abc-nums CHAR D + C!
6 abc-nums CHAR 6 + C!  E abc-nums CHAR E + C!
7 abc-nums CHAR 7 + C!  F abc-nums CHAR F + C!
DECIMAL

: gethex   \ ( addr -- addr1 num )
  0
  BEGIN  OVER C@ abc-nums + C@ DUP 0xFF = NOT WHILE
    SWAP 4 LSHIFT +
    SWAP 1+ SWAP
  REPEAT
  DROP
;

StrFormat: \  \ ( addr -- addr1 ) \ Экранирование символов (всех)
  1+ DUP C@ EMIT
;StrFormat

StrFormat: #  \ ( addr -- addr1 )
  DUP 1+ C@ [CHAR] / =
    IF
      1+ SWAP SETCOLOR
    ELSE
      DUP C@ EMIT
    THEN
;StrFormat

StrFormat: $  \ ( addr -- addr1 )
  DUP 1+ C@ [CHAR] / =
    IF
      1+ SWAP SETBGCOLOR
    ELSE
      DUP C@ EMIT
    THEN
;StrFormat

StrFormat: /  \ ( addr -- addr1 )
  DUP 1+ C@
  [CHAR] # OVER =
    IF
      DROP 2 +
      GETCOLOR SWAP
      gethex SETCOLOR
      1-
    ELSE
      [CHAR] $ =
        IF
          2 +
          GETBGCOLOR SWAP
          gethex SETBGCOLOR
          1-
        ELSE
          DUP C@ EMIT
        THEN
    THEN
;StrFormat

0xA StrFormat
  WHEREXY 1+ GOTOXY
;StrFormat

0xD StrFormat
  str-posx @ WHEREY GOTOXY
;StrFormat



256 ALLOT HERE 4 - VALUE PAD   \ Растет вниз. \ «4 -» - строка оканчивается нулем
VARIABLE PAD#

" 0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ" VALUE nums-abc


: HOLD   \ ( char -- ) \ Вставить символ с кодом char в буфер форматного преобразования чисел.
  PAD PAD# @ - C!
  1 PAD# +!
;

: #   \ ( base num -- base num ) \ Выделить одну цифру с конца и добавить ее в буфер форматного преобразования чисел, оставив частное на стеке.
  OVER /MOD
  nums-abc + C@
  HOLD
;

: HOLDS   \ ( str -- ) \ Вставить строку в буфер форматного преобразования чисел.
  DUP ZLEN DUP ROT    \ len len str
  OVER PAD SWAP PAD# @ + - 1+  \ len len str addr
  ROT CMOVE                \ len str addr len
  PAD# +!
;

: #S   \ ( base num -- base num ) \ Преобразовать оставшуюся часть числа.
  BEGIN  OVER /MOD 2DUP OR  WHILE
    nums-abc + C@ HOLD
  REPEAT
  DROP
;

: {#   \ ( num base -- ? base num ) \ Начать форматное преобразование числа в системе счисления base
  OVER 0 MIN -1 MAX
  ROT ABS ROT SWAP
;

: #}   \ ( ? base num -- ) \ Закончить форматное преобразование числа.
  3DROP
  PAD PAD# @ - 1+
  PAD# OFF
;

: <#   \ ( num -- ? base num ) \ Начать форматное преобразование числа в текущей системе счисления.
  DUP 0 MIN -1 MAX SWAP
  ABS
  BASE @ SWAP
;

: #>   \ ( ? base num -- ) \ Закончить форматное преобразование числа.
  3DROP
  PAD PAD# @ - 1+
  PAD# OFF
;

: SIGN   \ ( ? base num -- ? base num ) \ Если число отрицательное, то вставить знак минуса в буфер форматного преобразования чисел.
  2 PICK IF [CHAR] - HOLD THEN
;

5 3 GOTOXY
" Использование /#FF00FFнескольких#/cr/#0$/цветов/$0#/n /$0055FFв одной$/ строке"
DUP 34 + 0xD OVER C!  1+ 0xA SWAP C!
DUP 52 + 0xA SWAP C!
FPRINT