Numeric Output functions

Revision 2016-11-13

A collection of integer numeric output functions suitable for Forth application writers and system developers.

\ Library of integer numeric output functions (public domain)

\ Useful factors
\ Display string right-aligned in a field +n characters wide
: S.R ( c-addr u +n -- )  over - spaces type ;

\ Add char to pictured numeric output string +n times
: NHOLD ( +n char -- )  swap 0 ?do dup hold loop drop ;

\ Basic numeric string output
: (D.) ( d -- c-addr u )  tuck dabs <# #s rot sign #> ;
: (U.) ( u -- c-addr u )  0 (d.) ;
: (.) ( n -- c-addr u )  s>d (d.) ;

\ Forth-79/83/94
: D. ( d -- )  (d.) type space ;
: D.R ( d +n -- )  >r (d.) r> s.r ;
: U. ( u -- )  0 d. ;
: U.R ( u +n -- )  0 swap d.r ;
: .R ( n +n -- )  >r s>d r> d.r ;
: . ( n -- )  s>d d. ;

\ Miscellaneous
: (UD.) ( ud -- c-addr u )  <# #s #> ;
: UD. ( ud -- )  (ud.) type space ;
: UD.R ( ud +n -- )  >r (ud.) r> s.r ;

\ Right-aligned numeric string. Method may not work on
\ all systems.
: (D.R) ( d +n -- c-addr u )
  >r (d.) r@ over - 0 max bl nhold #> r> min ;
: (U.R) ( u +n -- c-addr u )  0 swap (d.r) ;

\ Comma-separated
: #,S ( ud -- 0. )
  0 begin  >r # 2dup or
  while  r> 1+ dup 3 = if [char] , hold drop 0 then
  repeat  r> drop ;

\ Elegant version from Greenarrays pF using R> DROP
\ : ?# ( ud -- ud )  # 2dup d0= if r> drop then ;
\ : #,S ( ud -- 0. )  begin ?# ?# ?# [char] , hold again ;

: (D,.) ( d -- c-addr u )  tuck dabs <# #,s rot sign #> ;
: D,. ( d -- )  (d,.) type space ;
: D,.R ( d +n -- )  >r (d,.) r> s.r ;

: (UD,.) ( ud -- c-addr u )  <# #,s #> ;
: UD,. ( ud -- )  (ud,.) type space ;
: UD,.R ( ud +n -- )  >r (ud,.) r> s.r ;

\ Hex formatted
: (DH.N) ( ud +n -- c-addr u )
  base @ >r hex <# 0 do # loop #> r> base ! ;
: (DH.) ( ud -- c-addr u )  4 cells (dh.n) ;
: (H.) ( u -- c-addr u )  0 2 cells (dh.n) ;
: (HW.) ( u -- c-addr u )  0 4 (dh.n) ;
: (HB.) ( u -- c-addr u )  0 2 (dh.n) ;
: DH. ( ud -- )  (dh.) type space ;
: H.  ( u -- )  (h.) type space ;
: HW. ( u -- )  (hw.) type space ;
: HB. ( u -- )  (hb.) type space ;

\ Hex dot-separated
: (DH..) ( ud -- c-addr u )
  base @ >r hex <# 1 cells 0 do # # # #
  [char] . hold loop #> 1 /string r> base ! ;

\ end

History

2016-09-24 First release
2016-11-13 Clarify stack notation

Top    Home    Forth

Page updated: 2016-11-13