-------------8<---------------------------------------------
WANT 2>R
WANT NO-SECURITY
WANT DH.

NO-SECURITY
\ Basically an alias. Linux 64 has trouble printing strings from
\ $8000,0000,0000,0000 and higher.
: $.   PAD $! PAD $@ TYPE ;

\ Print the first part of STRING, up till format sign, leave REMAINDER.
: plain    &# $/ $. ;

\ Print X using the first word of STRING, up till blank, leave REMAINDER.
: format   BL $/ 2SWAP 2>R EVALUATE 2R> ;

\ Print X1 .. Xn using the format STRING.
: .format   BEGIN plain OVER WHILE format OVER WHILE REPEAT THEN 2DROP ;

12345.6788 "ROME"     "we go to #$.  with #D.  cows #CR" .format

: doit
    12345.6788 "ROME"     "we go to #$.  with $#DH. cows #CR" .format
;

: english  "we go to #$.  with $#DH. cows#CR" ;
: spanish  "vamos a #$.  con  $#DH.  vacas#CR" ;

: test   1 ARG[] EVALUATE 0 DO doit LOOP
   CR CR
   12345.6788 "ROME"   2 ARG[] EVALUATE IF english ELSE spanish THEN .format
;

-------------8<---------------------------------------------

lina64 -c format.frt

printed during compilation
we go to ROME with 123456788 cows

format 5 0 results in:
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows

vamos a ROME con  $0000,0000,0000,0000,0000,0000,075B,CD14 vacas

format 5 1 results in:
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows
we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows

we go to ROME with $0000,0000,0000,0000,0000,0000,075B,CD14cows

If you prefer one liners.

\ Print X1 .. Xn using the format STRING.
: .format   BEGIN &# $/ $. OVER WHILE BL $/ 2SWAP 2>R EVALUATE 2R>
    OVER WHILE REPEAT THEN 2DROP ;

String-slash $/ has been introduced many times. You can steal it from
ciforth, there is a reference implementation in the library forth.lab.
Beware for counterfeit. If you use your garden variety string SPLIT, you
will be in for nasty surprises w.r.t. empty strings.

Groetjes Albert

Hugh, chalk me up for posting real Forth code.

Some time ago I wrote this string formatter in lina:
8<---
\ ******************
\ *** nmold$.fs ***
\ ******************
\ *** PROVIDES: ****
\ MOLD$  ( $N .. $1 FORMAT$ BUFFER$ -- BUFFER$.ADDR #BYTES.WRITED
OVERFLOWED? )
\        String Formatter
\ $N - n-th  string constant parameter
\ $1 - first string constant parameter
\ FORMAT$ - string constant for `template' of form "ccc..%S..%S..."
\ BUFFER$ - destination buffer
\ OVERFLOWED? - flag if destination buffer was overflowed
\ ****************

REQUIRE MARKER REQUIRE VALUE
REQUIRE TUCK   REQUIRE NIP
REQUIRE [IF]   REQUIRE [THEN]
MARKER --MOLD$

: -ROT  ROT ROT ;

: 2VARIABLE  CREATE , , ;
: ++@  CELL+ @ ;

: UNDERDUP  ( A B -- A A B )
  OVER SWAP ;

: BOUND  ( A U -- A+U A )
  OVER + SWAP ;

: UMIN  2DUP U< IF DROP ELSE NIP THEN ;

: /STRING  ( CA U U2 -- CA+U2 U-U2 )
  OVER UMIN TUCK - >R + R> ;

: /STRING-AT  ( /LEN a$ -- )
  DUP >R 2@ ROT /STRING R> 2! ;

2 CONSTANT %S.LEN
: /%S/  ( $ -- a|0 )
  0 -ROT 1- 0 MAX BOUND ?DO
    I C@ [CHAR] % = IF I 1+ C@ [CHAR] S = IF DROP I LEAVE THEN THEN
  LOOP ;

0 0 2VARIABLE BUFFER$
0 0 2VARIABLE FORMAT$

: PREPARE  ( FMT$ DESTBUFF$ -- ; DP: ++ )
  BUFFER$ 2! HERE SWAP DUP ALIGNED ALLOT 2DUP FORMAT$ 2! MOVE ;

: UPD-BUFFER  ( U -- )
  BUFFER$ /STRING-AT ;

: UPD-FORMAT  ( U -- )
  %S.LEN + FORMAT$ /STRING-AT ;

: SPLIT-FORMAT  ( -- 1ST.PIECE$ FLAG )
  FORMAT$ 2@ /%S/ DUP
  IF   FORMAT$ ++@ TUCK - -1
  ELSE FORMAT$ 2@ ROT
  THEN ;

0 VALUE OVERFLOWED?

: -OVERFLOW  ( DST.LEN SRC.LEN -- UMIN )
  2DUP < TO OVERFLOWED? UMIN ;

: ADDTO-BUFFER  ( $ -- )
  BUFFER$ 2@ ROT -OVERFLOW
          DUP UPD-BUFFER
  MOVE ;

: MOLD$  ( $N .. $1 FORMAT$ BUFFER$ -- BUFFER$.ADDR #BYTES.WRITED
OVERFLOWED? )
  PREPARE                                           \ DP: ++
    BUFFER$ 2@ DROP >R                     \ R: BUFFER$.ADDR
    FORMAT$ 2@ NIP  >R                     \ R: BUFFER$.ADDR  FORMAT$.LEN
  BEGIN  SPLIT-FORMAT OVER UPD-FORMAT 2DUP OR
  WHILE  -ROT ADDTO-BUFFER
         IF   ADDTO-BUFFER THEN
  REPEAT
  DROP 2DROP
    R> ALIGNED NEGATE ALLOT     \ DP: -- , R: BUFFER$.ADDR
    BUFFER$ 2@ DROP R> TUCK -        \ R:
  OVERFLOWED? ;

-1 [IF]
: S1 "ALFA%SBETA" ;
: S2 "%SALFABETA" ;
: S3 "ALFABETA%S" ;
: S4 "ALFABETA" ;
\ ---
256 CONSTANT ##
HERE 12 ALLOT 12 2VARIABLE b$
HERE ## ALLOT ## 2VARIABLE B$
\ ---
." -------" CR
"CUCU" S1 B$ 2@ HERE . MOLD$ HERE . ." OVERFLOWED:" . .S TYPE CR
"CUCU" S2 B$ 2@ HERE . MOLD$ HERE . ." OVERFLOWED:" . .S TYPE CR
"CUCU" S3 B$ 2@ HERE . MOLD$ HERE . ." OVERFLOWED:" . .S TYPE CR
"CUCU" S4 B$ 2@ HERE . MOLD$ HERE . ." OVERFLOWED:" . .S TYPE .S TYPE
CR
." -------" CR
"CUCU!" "BAU!" "HELLO %S BONK %S" B$ 2@ MOLD$ ." OVERFLOWED:" . .S
TYPE CR
." -------" CR
"CUCU!" "BAU!" "HELLO %S BONK %S" b$ 2@ MOLD$ ." OVERFLOWED:" . .S
TYPE CR BYE
[THEN]
--->8
.. but used mostly in prototyping ...

--
Coos

: .format
  BEGIN
    [char] # split type
    dup
  WHILE
    1 /string
    BL split 2SWAP 2>R EVALUATE 2R>
    1 /string
    dup 0=
  UNTIL  THEN
  2DROP ;

This is exactly what I meant, with my $/ you have no need to
carefully analyse lots of cases. If the address is NULL you
have no string. If the length is 0 there is a string allbeith short.
Use it appropriately and it works.

Groetjes Albert

: .format
  BEGIN
    &# $/ $.
    dup
  WHILE
    BL $/ 2SWAP 2>R EVALUATE 2R>
    dup
  WHILE
  REPEAT THEN
  2DROP ;

The direct equivalent using SPLIT would be

: .format
  BEGIN
    [char] # split type
    dup
  WHILE
    1 /string
    BL split 2SWAP 2>R EVALUATE 2R>
    dup
  WHILE
    1 /string
  REPEAT THEN
  2DROP ;