Anonymous user
$SPELL.REX: Difference between revisions
m
→$SPELL#.REX: added/changed comments and whitespace, reformatted some statements, changed indentations.
m (elided a needless statement.) |
m (→$SPELL#.REX: added/changed comments and whitespace, reformatted some statements, changed indentations.) |
||
Line 1:
==$SPELL#.REX==
This is the '''$SPELL#.REX''' (REXX) program.
The '''$SPELL#.REX''' REXX program makes use of '''$ERR.REX''' REXX program which is used to display error messages (via '''$T.REX'''); error messages are displayed in red if the terminal supports color.
<br>The '''$ERR.REX''' REXX program is included here ──► [[$ERR.REX]].
The '''$SPELL#.REX''' REXX program makes use of '''$T.REX''' REXX program which is used to display text messages.
<br>The '''$T.REX''' REXX program is included here ──► [[$T.REX]].
<lang rexx>♀/*REXX program converts a numeric string into English words, with support for ordinals, */
/*─────────────── some national currency symbols, decimal fractions, and other options. */
trace off /*suppress superfluous return codes. */
parse arg ! /*save the original arguments in ! var.*/
if !all( arg() ) then exit /*exit pgm if user wanted documentation*/
if !cms then address ''
Line 30 ⟶ 36:
british = 0
clear = 0
colors = !cms | !pcrexx | !r4 | !roo
dot =
exponents=
Line 65 ⟶ 71:
do while ops\=='' /*process user arguments and options. */
parse var ops _1 2 1 _ . 1 _o ops /*pull assunder some parts of an option*/
upper _ /*uppercase the _ variable. */
select
when isnum(_) then n=n || _ /*if numeric, then append this digit. */
when _==',' | _=="(" | _==')' then nop /*ignore any commas and parentheses. */
when _1=='.' & pos("=",_)\==0 then tops=tops _o
when abbn('AMERican') then american= no()
Line 131 ⟶ 137:
end
if colors then tops= '.P=1 .A=1 .C=green'
if logs then tops= '.F='gettfid(,"ANS")
tops=space(tops) /*options " " " $T " */
if n=='' then call er 54 /*
if asayear & ordinal then call er 61, 'ASAYEAR ORDINAL'
Line 142 ⟶ 148:
if american & british then call er 61, 'AMERICAN BRITISH'
if \american & \english & \british then american=1
if english then british =1
if clear then !cls /*the terminal screen to be cleared?*/
Line 242 ⟶ 248:
amers=words(_)
do j=1 for amers
a.j=word(_, j)
end /*j*/
maxzlen=amers *3
Line 252 ⟶ 256:
engs =amers*2 - 2
maxzlen=engs *3
do k=1 for 2
_=j*2 - 3
b.
drop a.
end
Line 272 ⟶ 273:
if _=='-' | _=="+" then do /*handle leading sign (+ -). */
if _=='+' then sig= plus
else sig=minus
n=substr(n, 2) /*remove the leading sign. */
Line 293 ⟶ 294:
if zcurrs>2 then call er 59, 'currency symbols'
if zdollar then do; xcurr=dollar; n=changestr("$", n, ''); end
if zeuro then do; xcurr=euro; n=changestr("ε", n, ''); end
if zpound then do; xcurr=pound; n=changestr("£", n, ''); end
if zyen then do; xcurr=yen; n=changestr("¥", n, ''); end
if zpiseta then do; xcurr=piseta; n=changestr("₧", n, ''); end
if zfranc then do; xcurr=franc; n=changestr("ƒ", n, ''); end
if zcent then do; xcurr=cent; n=changestr("¢", n, ''); end
if zpoint then dot=point /*the number has a decimal point. */
_=right(n, 1) /*pick off
if ismix(_) | _=='!' then n=num(n) /*if number has a suffix, convert it. */
parse upper var n
parse var n n '.' fraction
leadzs=compare(n, copies(0, digits()) ) - 1 /*count the leading zeroes in number. */
n=changestr(',', n, "") /*change commas to nulls (delete 'em).*/
if isnum(n) then do /*this DO structure must be presered···*/
Line 344 ⟶ 347:
else #=sig || leadingz || spnte(n)
if ordinal then do
sx=
w=words(#)
p=word(#, w)
oldp=p
pp=
if pos('-', p)\==0 then parse var p pp
if pp\=='' then pp=pp
select /* [↓] adjust some words.
when p=='one' then p= "first"
when p=='two' then p= "second"
when p=='three' then p= "third"
when p=='five' then p= "fifth"
when p=='eight' then p= "eighth"
when p=='nine' then p= "ninth"
when p=='twelve' then p= "twelfth"
when right(p, 1)=='y' then p= left(p, length(p) - 1)"ieth"
otherwise sx= 'th'
end /*select*/
if p\==oldp then if w==1 then #=pp || p
else #=subword(#, 1, w-1) pp || p
#=# || sx
end
if zdollar & (
if fraction\=1 then cent=cent's'
fractions= sp(fraction) cent
Line 377 ⟶ 380:
xcurr=
end
else do j=1 for Lf
_=substr(fraction, j, 1)
fractions= fractions dig._
end /*j*/
if exponent\=='' then do
if \isint(exponent) then call er 53, exponent 'exponent'
if _\=='' then exponents=raised _ power
after=space(dot fractions exponents xcurr)
Line 511 ⟶ 419:
if _>=has_t then zillion=zillion't'
if _>2 then
else if _//2 then zillion=zillion'illion'
else zillion=zillion'illiard'
ttt=reverse( substr(bzz, j, 3))
if ttt==' ' then leave
ttt=right( strip(ttt), 3, 0)
if ttt== 000 then iterate
x=sphtu(ttt) zillion
if en\=='' then en=sep || en
en=x en
end /*j*/
Line 536 ⟶ 442:
/*──────────────────────────────────────────────────────────────────────────────────────*/
sphtu: procedure; parse arg z /*SPell Hundred Tens Units. */
@987= 'nine eight seven six five four three two one'
zm= substr(z, 2, 1)
zr= right(z, 1)
zh= word(@987, 10 - left(z, 1))
if zh\=='' then zh=zh "hundred"
zt= word('ninety eighty seventy sixty fifty forty thirty twenty', 10 - zm)
zu= word(@987, 10 - zr)
@teens= 'ten eleven twelve thir four fif six seven eigh nine'
Line 558 ⟶ 468:
return space(zh zt zu)
/*═════════════════════════════general
!all: !!=!;!=space(!);upper !;call !fid;!nt=right(!var('OS'),2)=='NT';!cls=word('CLS VMFCLEAR CLRSCREEN',1+!cms+!tso*2);if arg(1)\==1 then return 0;if wordpos(!,'? ?SAMPLES ?AUTHOR ?FLOW')==0 then return 0;!call=']$H';call '$H' !fn !;!call=;return 1
!cal: if symbol('!CALL')\=="VAR" then !call=; return !call
!env: !env='ENVIRONMENT'; if !sys==
!fid: parse upper source !sys !fun !fid . 1 . . !fn !ft !fm .; call !sys; if !dos then do; _=lastpos('\', !fn); !fm=left(!fn, _); !fn=substr(!fn, _+1); parse var !fn !fn
!rex: parse upper version !ver !vernum !verdate .; !brexx='BY'==!vernum; !kexx=
!sys: !cms=!sys=='CMS'; !os2=!sys==
!var: call !fid; if !kexx then return space(dosenv(arg(1))); return space(value(arg(1),,!env))
$fact!: procedure; parse arg x _ .;
$fact: procedure; parse arg x _ .; arg ,n ! .; n=p(n 1); if \isint(n) then n=0; if x<-n | \isint(x) | n<1 | _ || !\=='' | arg()>2 then return x || copies("!", max(1, n)); !=1; s=x//n; if s==0 then s=n; do j=s to x by n; !=!*j; end; return !
$sfxa: parse arg ,s,m; arg u,c; if pos( left(s, 2), u)\==0 then do j=length(s) to compare(s,c) -1 by -1; if right(u, j)\==left(c, j) then iterate; _=left(u, length(u) - j); if isnum(_) then return m*_; leave; end; return arg(1)
$sfxf: parse arg y; if right(y, 1)=='!' then y=$fact!(y); if \isnum(y) then y=$sfxz(); if isnum(y) then return y; return $sfxm(y)
$sfxm: parse arg z; arg w; b=1000; if right(w,1)=='I' then do; z=shorten(z); w=z; upper w; b=1024; end; p=pos(right(w,1),'KMGTPEZYXWVU'); if p==0 then return arg(1); n=shorten(z); r=num(n,f,1); if isnum(r) then return r*b**p; return arg(1)
$sfxz: return $sfxa($sfxa($sfxa($sfxa($sfxa($sfxa(y,'PAIRs',2),'DOZens',12),'SCore',20),'GREATGRoss',1728),'GRoss',144),'GOOGOLs',1e100)
$t: !call=']$T'; call "$T" arg(1); !call=; return
abb: arg abbu; parse arg abb; return abbrev(abbu,_,abbl(abb))
abbl: return verify(arg(1)'a',@abc,'M')-1
abbn: parse arg abbn; return abb(abbn) | abb('NO'abbn)
countstr: procedure; parse arg n,h,s; if s=='' then s=1; w=length(n); do r=0 until _==0; _=pos(n, h, s); s=_+w; end; return r
er: parse arg _1,_2; call '$ERR' "14"p(_1) p(word(_1,2) !fid(1)) _2; if _1<0 then return _1; exit result
err: call er '-'arg(1),arg(2); return ''
erx: call er '-'arg(1),arg(2); exit ''
getdtfid: tfid=p( !var("TMP") !var('TEMP') homedrive()"\"); if substr(tfid, 2, 1)==':' & substr(tfid, 3, 1)\=="\" then tfid=insert('\', t, 2); return strip( tfid,
getTFID: if symbol('TFID')=='LIT' then tfid=; if tfid\=='' then return tfid; gfn=word(arg(1) !fn,1); gft=word(arg(2) 'ANS',1);
halt: call er .1
homedrive: if symbol('HOMEDRIVE')\=="VAR" then homedrive=p( !var('HOMEDRIVE') 'C:'); return homedrive
int: int=num( arg(1), arg(2) ); if \isint(int) then call er 92, arg(1) arg(2); return int/1
ishex: return datatype( arg(1), 'X')
isint: return datatype( arg(1), 'W')
ismix: return datatype( arg(1), 'M')
isnum: return datatype( arg(1), 'N')
na: if arg(1)\=='' then call er 01, arg(2); parse var ops na ops; if na=='' then call er 35, _o; return na
nai: return int(na(), _o)
nan: return num(na(), _o)
no: if arg(1)\=='' then call er 01,arg(2); return left(_, 2)\=='NO'
noValue: !sigl=sigl; call er 17, !fid(2) !fid(3) !sigl condition('D') sourceline(!sigl)
num: procedure; parse arg x .,f,q; if x=='' then return x; if isnum(x) then return x/1; x=space( translate(x,,','),0); if \isnum(x) then x=$sfxf(x); if isnum(x) then return x/1;
p: return word(arg(1),1)
shorten: procedure; parse arg a,n; return left(a, max(0, length(a) - p(n 1)))
sp: !call=']'!fn; sp="$SPELL#"(arg(1) 'Q'); !call=; return sp
syntax: !sigl=sigl; call er 13, !fid(2) !fid(3) !sigl !cal() condition('D') sourceline(!sigl)</lang>
Note: The subroutines and functions in the '''══general 1-line subs══''' section were kept to one line, elsewise, the program would be exceedingly long. These functions and subroutines were meant to be brief and not clutter up the main program.
|