Rosetta Code

$SPELL.REX: Difference between revisions

Page Discussion

$SPELL.REX (view source)

Revision as of 19:52, 3 June 2021

856 bytes added ,  2 years ago
m
→‎$SPELL#.REX: added/changed comments and whitespace, simplified some code, aligned some statements or clauses.
m (→‎$SPELL#.REX: elided a DOS glyph.)
m (→‎$SPELL#.REX: added/changed comments and whitespace, simplified some code, aligned some statements or clauses.)
 
Line 14:
The   '''$SPELL#.REX'''   REXX program makes use of   '''$T.REX'''   REXX program which is used to display text messages.
<br>The &nbsp; '''$T.REX''' &nbsp; REXX program is included here &nbsp; ──► &nbsp; [[$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. */
 
Line 76:
 
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()
when abbn('ASAYEAR') |,
abbn('ASYEAR') |,
abbn('YEAR') then asayear= no()
when abb('BEINGRAISed') |,
abb('RAISEd') then raised= na()
when abb('BLANKs') then blanks= na()
Line 102:
abb('LEADINGzeros') then leading= na()
when abbn('LOGs') then logs= no()
when abb('MINUSsigns') |,
abb('MINUSes') then minus= na()'" '"
when abb('NOTHINGs') then nothing= na()
when abbn('ORDinal') then ordinal= no()
when abb('PISETAs') then piseta= na()
when abb('POWer') then power= na()
when abb('PLUSsigns') |,
abb('PLUSes') then plus= na()'" '"
when abb('POINTs') then point= na()
when abb('POUNDs') then pound= na()
Line 116:
when abbn('SINGley') then single= no()
when abb('YENs') then yen= na()
when abb('ZEROs') |,
abb('ZEROes') then zero= na()
otherwise n= n || _o
end /*select*/
 
end /*while ops···*/
 
if sep=='none' then if pos('",'", n)\==0 then sep= ','
if sep=='none' then sep=
ogn=n n /*the original number that was entered. */
_=blanks blanks /*validate the BLANKS= option. */
l=length(_)▼
 
if l >3 then call er 55,_▼
 
▲lL= length(_)
if l==3 then do /*it's a decimal value for BLANKS. */▼
 
▲if lL >3 then call er 55,_
 
▲if lL==3 then do /*it's a decimal value for BLANKS. */
if \isint(_) then call er 92, _ "BLANK="
if _<0 | _>255 then call er 81, 0 255 _ "BLANKS="
blanks= d2c(_)
end
 
if lL==2 then do /*it's a hexadecimal value for BLANKS. */
if \ishex(_) then call er 40,_
blanks= x2c(_)
end
 
 
if colors then tops= '.P=1 .A=1 .C=green' tops /*colors used by the $T program. */
Line 152 ⟶ 155:
if american & english then call er 61, 'AMERICAN ENGLISH'
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?*/
 
dig. =
dig.0 = zero
dig.1 = 'one'
dig.2 = 'two'
Line 168 ⟶ 171:
dig.8 = 'eight'
dig.9 = 'nine'
 
 
_='0 thousand m b tr quadr quint sext sept oct non dec undec duodec tredec quattuordec quinquadec sedec septendec octodec novendec vigin unvigin duovigin tresvigin quattuorvigin quinquavigin sesvigin septemvigin octovigin novemvigin trigin'
Line 252 ⟶ 256:
_=_ 'unnonagintanongen duononagintanongen trenonagintanongen quattuornonagintanongen quinquanonagintanongen senonagintanongen septenonagintanongen novenonagintanongen octononagintanongen'
 
 
amers= words(_)
do j=1 for amers
a.j= word(_, j)
end /*j*/
maxzlen= amers * 3
 
if british then do
engs = amers * 2 - 2
maxzlen= engs * 3
do k=1 for 2
b.k= a.k
end /*k*/
do j=3 to amers
_= j * 2 - 3
b._= a.j
_n= _ + 1
b._n= a.j
end /*j*/
drop a.
end
 
n= space(n)
_= left(n, 1)
sig=
 
if _=='-' | _=="+" then do /*handle leading sign (+ -). */
if _=='+' then sig= plus
else sig= minus
n= substr(n, 2) /*remove the leading sign. */
end
 
numeric digits 80 + maxzlen
 
zpoints = countstr(' .' , n); zpoint = zpoints \==0; if zpoints >1 then call er 59,'decimal-points(.)'
zdollars=countstr('$',n); zdollar=zdollars\==0; if zdollarszpoints >1 then call er 59, 'dollardecimal-signspoints($.)'
zeuroszdollars= =countstr('ε$', n); zeuro zdollar=zeuros zdollars\==0; if zeuros >1 then call er 59,'euro-signs(ε)'
zfrancs =countstr('ƒ',n); zfranc =zfrancs \==0; if zfrancs if zdollars>1 then call er 59, 'francdollar-signs(ƒ$)'
zpoundszeuros = countstr('£ε', n); zpound =zpounds \==0; if zpounds >1zeuro then call= erzeuros 59,'pound-signs(£)' \==0
zyens =countstr('¥',n); zyen =zyens \==0; if zyens if zeuros >1 then call er 59, 'yeneuro-signs(¥ε)'
zpisetaszfrancs = countstr('₧ƒ', n); zpiseta=zpisetas\==0; if zpisetas>1 then call erzfranc 59,'piseta-signs(₧)'= zfrancs \==0
zcents =countstr('¢',n); zcent =zcents \==0; if zcents if zfrancs >1 then call er 59, 'centfranc-signs(¢ƒ)'
zpounds = countstr('£', n); zpound = zpounds \==0
if zpounds >1 then call er 59, 'pound-signs(£)'
zyens = countstr('¥', n); zyen = zyens \==0
if zyens >1 then call er 59, 'yen-signs(¥)'
zpisetas= countstr('₧', n); zpiseta= zpisetas\==0
if zpisetas>1 then call er 59, 'piseta-signs(₧)'
zcents = countstr('¢', n); zcent = zcents \==0
if zcents >1 then call er 59, 'cent-signs(¢)'
 
zcurrs = zdollars + zeuros + zpounds + zyens + zpisetas + zfrancs + zcents
zcurr = zcurrs \== 0
 
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 point /*the number has a decimal point. */
 
_= right(n, 1) /*pick off right─most character of num.*/
if ismix(_) | _=='!' then n= num(n) /*if number has a suffix, convert it. */
 
parse upper var n n 'E' exponent /*parse the exponent, if present. */
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···*/
if \asis then n= n / 1
end /*elsewise the THEN/ELSEs aren't paired.*/
 
else do 1
if n=='' then leave /*this LEAVE is why there is a DO 1 */
expression= n
interpret 'number='expression
n= number % 1 /*reduce NUMBER to an integer. */
end /*1*/ /* [↑] same as TRUNC(number) */
 
if xcurr\=='' & xcurr\==zyen & n\==1 then xcurr= xcurr's' /*need to ba plural? */
 
max#= 10**maxzlen * 1000 - 1
if \asis & isnum(n) then n= n / 1 /*normalize integer. */
 
if n\=='' & isnum(n) then if n>max# then call er 81, -max# max# ogn /*in range ? */
if n\=='' & \isint(n) then call er 53, n /*numeric ? */
if abs(n)>max# then call er 81, -max# max# ogn /*in range ? */
 
if leading\=='' then leadingz= copies(leading' ',leadzs)
 
if asayear & right(n, 3)\==000 then do
#= spnte( left(n, max(0, length(n) - 2) ) )
if #==zero then #=
_2= right(n, 2)
_= spnte(_2)
if _==zero then _= "hundred"
if _2<10 & _2>0 then _= zero _
#= sig || # _
end
 
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 "-" p
if pp\=='' then pp= pp"-"
 
select /* [↓] adjust some words.*/
Line 373 ⟶ 386:
end /*select*/
 
if p\==oldp then if w==1 then #= pp || p
else #= subword(#, 1, w-1) pp || p
#= # || sx
end
 
Lf= length(fraction)
if zdollar & (Lf==1 | Lf==2) then do
if fraction\=1 then cent= cent's'
fractions= sp(fraction) cent
dot= xcurr andcent
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'
_= sp(exponent "ORDINAL")
if _\=='' then exponents= raised _ power
end
 
after= space(dot fractions exponents xcurr)
if after\=='' then after= " "after
#= translate(# || after, , "_")
if blanks\=='' then #= translate(#, blanks, " ")
if \quiet then call $t tops #
return #
Line 406 ⟶ 419:
/*──────────────────────────────────────────────────────────────────────────────────────*/
spnte: parse arg zz
if zz==0 | zz=' ' then return nothing
en=
bzz= reverse(zz)
has_t= 22
if british then has_t= 41
 
if single then do j=1 for length(zz)
_= substr(zz, j, 1)
en= en dig._
end /*j*/
 
else do j=1 to maxzlen by 3
_= (j+2) % 3
if american then zillion= a._
else zillion= b._
if zillion==0 then zillion=
if _>=has_t then zillion= zillion't'
 
if _>2 then if american then zillion= zillion'illion'
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*/
 
en= strip( translate(en, , "_") )
 
if en=='' then if zcurr then do /*this DO structure must be intact.*/
if \zcent then en= " no"
end /*don't simplify this DO~IF~END group*/
 
else en=zero
Line 447 ⟶ 460:
 
/*──────────────────────────────────────────────────────────────────────────────────────*/
sphtu: procedure; parse arg z /*SPell Hundred Tens Units. */
@987= 'nine eight seven six five four three two one'
 
Line 454 ⟶ 467:
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)
Line 461 ⟶ 474:
@teens= 'ten eleven twelve thir four fif six seven eigh nine'
 
if zm==1 then do
zu=
zt= word(@teens, zr + 1)
if zr>2 then zt= zt'teen'
end
 
if zt\=='' & zu\=="" then do
zt= zt'-'zu
zu=
end
return space(zh zt zu)
 
Line 488 ⟶ 501:
$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') homedrivehomeDrive()"\"); if substr(tfid, 2, 1)==':' & substr(tfid, 3, 1)\=="\" then tfid= insert('\', t, 2); return strip( tfid, "T", '\')"\"arg(1)'.'arg(2)
getTFID: if symbol('TFID')=='LIT' then tfid=; if tfid\=='' then return tfid; gfn=word(arg(1) !fn,1); gft=word(arg(2) 'ANS',1);tfid='TEMP'; if !tso then tfid=gfn'.'gft; if !cms then tfid=gfn','gft",A4";if !dos then tfid=getdTFID(gfn,gft);return tfid
halt: call er .1
homedrivehomeDrive: if symbol('HOMEDRIVE')\=="VAR" then homedrivehomeDrive=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)
Line 510 ⟶ 523:
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;if q==1 then return x; if q=='' then call er 53,x f;call erx 53,x f
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>
</lang>
 
Note: &nbsp; The subroutines and functions in the &nbsp; &nbsp; '''══general 1-line subs══''' &nbsp; &nbsp; section were kept to one line, elsewise, the program would be exceedingly long. &nbsp; These functions and subroutines were meant to be brief and not clutter up the main program.
Retrieved from "https://rosettacode.org/wiki/Special:MobileDiff/223773"