{Modified from Z/PUG Vol. 16 by John A. McCulloch} { This was part of a Pascal Course, as program listing #5 of Welsh &} {Elder, Page 101. It has been modified from the listing in Volume 16 as } {formatted by Gerald Hewett. Furthur changes may be made to expand the } {range of amounts handled. As set up it will handle amounts to $9,999.99. } { Addition of the fixed point package, or conversion of numerical } {data to strings will allow this to work within a computational package. } Program Writnum; Var k,h,t,u : char; i,ct,cu : char; amount : array [1..7] of char; x : integer; Procedure units (i : char); Begin Case i of '0' : write( 'NO '); '1' : write( 'One '); '2' : write( 'Two '); '3' : write( 'Three '); '4' : write( 'Four '); '5' : write( 'Five '); '6' : write( 'Six '); '7' : write( 'Seven '); '8' : write( 'Eight '); '9' : write( 'Nine '); end; end; {units} Procedure teens (i : char); Begin Case i of '0' : write( 'Ten '); '1' : write( 'Eleven '); '2' : write( 'Twelve '); '3' : write( 'Thirteen '); '4' : write( 'Fourteen '); '5' : write( 'Fifteen '); '6' : write( 'Sixteen '); '7' : write( 'Seventeen '); '8' : write( 'Eighteen '); '9' : write( 'Nineteen '); end; end; {teens} Procedure tens (i : char); Begin Case i of '0' : ; '2' : write( 'Twenty'); '3' : write( 'Thirty'); '4' : write( 'Forty'); '5' : write( 'Fifty'); '6' : write( 'Sixty'); '7' : write( 'Seventy'); '8' : write( 'Eighty'); '9' : write( 'Ninety'); end; if (u > '0') and (t > '1') then write( '-') else write( ' '); end; {tens} Procedure convert; Begin x := 0; u := '0'; t := '0'; h := '0'; k := '0'; If amount <> ' ' then Repeat x := x + 1; Until (amount[x] = '.') or (x = 7); if (x-1) > 0 then u := amount[x-1]; if (x-2) > 0 then t := amount[x-2]; if (x-3) > 0 then h := amount[x-3]; if (x-4) > 0 then k := amount[x-4]; ct := amount[x+1]; cu := amount[x+2]; end; {convert} Procedure listout; Begin if k > '0' then Begin units(k); write( 'Thousand '); end; if h > '0' then Begin units(h); write( 'Hundred '); end; if t = '1' then teens(u) else begin tens(t); units(u); end; end; {convert} begin Writeln; Writeln; Repeat Write( 'Enter amount to be written out....$'); Readln( amount); if amount <> ' ' then Begin convert; listout; writeln( 'Dollars and ', ct:1, cu:1, ' cents.'); end; Writeln; Writeln; Until amount = ' '; end.