home *** CD-ROM | disk | FTP | other *** search
/ Oakland CPM Archive / oakcpm.iso / sigm / vol132 / writnum.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1984-04-29  |  2.5 KB  |  115 lines
  1.           {Modified from Z/PUG Vol. 16 by John A. McCulloch}
  2. {    This was part of a Pascal Course, as program listing #5 of Welsh &}  
  3. {Elder, Page 101. It has been modified from the listing in Volume 16 as   }
  4. {formatted by Gerald Hewett. Furthur changes may be made to expand the    }
  5. {range of amounts handled. As set up it will handle amounts to $9,999.99. }
  6. {    Addition of the fixed point package, or conversion of numerical   }
  7. {data to strings will allow this to work within a computational package.  }
  8.  
  9. Program Writnum;
  10.  
  11.  
  12. Var
  13.          k,h,t,u : char;
  14.              i,ct,cu : char;
  15.           amount : array [1..7] of char;
  16.            x : integer;
  17.  
  18. Procedure units (i : char);
  19.     Begin
  20.         Case i of
  21.             '0' : write( 'NO ');
  22.             '1' : write( 'One ');
  23.             '2' : write( 'Two ');
  24.             '3' : write( 'Three ');
  25.             '4' : write( 'Four ');
  26.             '5' : write( 'Five ');
  27.             '6' : write( 'Six ');
  28.             '7' : write( 'Seven ');
  29.             '8' : write( 'Eight ');
  30.             '9' : write( 'Nine ');
  31.         end;
  32.     end;        {units}
  33.  
  34. Procedure teens (i : char);
  35.     Begin    
  36.         Case i of
  37.             '0' : write( 'Ten ');
  38.             '1' : write( 'Eleven ');
  39.             '2' : write( 'Twelve ');
  40.             '3' : write( 'Thirteen ');
  41.             '4' : write( 'Fourteen ');
  42.             '5' : write( 'Fifteen ');
  43.             '6' : write( 'Sixteen ');
  44.             '7' : write( 'Seventeen ');
  45.             '8' : write( 'Eighteen ');
  46.             '9' : write( 'Nineteen ');
  47.         end;
  48.     end;        {teens}
  49.  
  50. Procedure tens (i : char);
  51.     Begin
  52.         Case i of
  53.             '0' : ;
  54.             '2' : write( 'Twenty');
  55.             '3' : write( 'Thirty');
  56.             '4' : write( 'Forty');
  57.             '5' : write( 'Fifty');
  58.             '6' : write( 'Sixty');
  59.             '7' : write( 'Seventy');
  60.             '8' : write( 'Eighty');
  61.             '9' : write( 'Ninety');
  62.         end;
  63.         if (u > '0') and (t > '1') then write( '-')
  64.             else write( ' ');
  65.     end;        {tens}
  66.  
  67. Procedure convert;
  68.     Begin
  69.     x := 0;
  70.     u := '0';
  71.     t := '0';
  72.     h := '0';
  73.     k := '0';
  74.     If amount <> '       ' then Repeat
  75.         x := x + 1;
  76.     Until (amount[x] = '.') or (x = 7);
  77.     if (x-1) > 0 then u := amount[x-1];
  78.     if (x-2) > 0 then t := amount[x-2];
  79.     if (x-3) > 0 then h := amount[x-3];
  80.     if (x-4) > 0 then k := amount[x-4];
  81.     ct := amount[x+1];
  82.     cu := amount[x+2];
  83.     end;         {convert}
  84.  
  85. Procedure listout;
  86.     Begin
  87.     if k > '0' then Begin
  88.         units(k);
  89.         write( 'Thousand ');
  90.         end;
  91.      if h > '0' then Begin
  92.         units(h);
  93.         write( 'Hundred ');
  94.         end;
  95.     if t = '1' then teens(u)
  96.         else begin
  97.             tens(t);
  98.             units(u);
  99.             end;
  100.     end;        {convert}
  101.  
  102. begin
  103.     Writeln; Writeln;
  104.     Repeat
  105.         Write( 'Enter amount to be written out....$');
  106.         Readln( amount);
  107.         if amount <> '       ' then Begin
  108.             convert;
  109.             listout;
  110.             writeln( 'Dollars and ', ct:1, cu:1, ' cents.');
  111.             end;
  112.         Writeln; Writeln;
  113.     Until amount = '       ';
  114. end.
  115.