home *** CD-ROM | disk | FTP | other *** search
/ FM Towns: Free Software Collection 10 / FM Towns Free Software Collection 10.iso / ms_dos / lib / happyps3 / calc.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1995-02-07  |  8.7 KB  |  256 lines
  1. (*********************************************************************
  2.  *  *** 電卓 ***                                                     *
  3.  *                                                                   *
  4.  *        HAPPyのサンプルプログラム                                  *
  5.  *          (作者  浅野比富美 Public Domain Software)                *
  6.  *********************************************************************)
  7.  
  8. program calculator(input,output) ;
  9.  
  10.   label 1 ;
  11.  
  12.   const SYNe      = '式が誤っている      '      ;
  13.         DIVe      = '0で割ろうとしている '      ;
  14.  
  15.         LimitInt  = 99999999                    ; { 整数演算の最大値        }
  16.  
  17.   type  kindType  = (int,rea)                   ; { 整数  実数              }
  18.         valueType = record                        { 演算結果 の 型          }
  19.                       kind : kindType           ; {   結果の型              }
  20.                       vi   : integer            ; {   整数の値              }
  21.                       vr   : real                 {   実数の値              }
  22.                     end                         ;
  23.         string20  = packed array[1..20] of char ; { エラーメッセージの型    }
  24.  
  25.   var   ch         : char                       ; { 読んだ文字              }
  26.         val,oldVal : valueType                  ; { 演算結果                }
  27.  
  28. (****************************)
  29. (* エラーメッセージ出力処理 *)
  30. (****************************)
  31.   procedure error(message : string20) ;
  32.   begin
  33.     writeln(message) ;
  34.     readln           ;                       { 以降改行までの入力を無視する }
  35.     goto 1                                   { 次の式の処理(メイン処理)へ   }
  36.   end ;
  37.  
  38. (****************************)
  39. (*      実数変換処理        *)
  40. (****************************)
  41.   procedure cnvFloat(var val : valueType; r : real) ;
  42.   begin
  43.     val.kind := rea ;
  44.     val.vr   := r
  45.   end ;
  46.  
  47. (****************************)
  48. (*      数の入力処理        *)
  49. (****************************)
  50.   procedure inputNumber(var val : valueType) ;
  51.     label 8         ;
  52.     var p    : real ;
  53.         sign : char ;
  54.   begin
  55.     with val do
  56.     begin
  57.       kind := int ;                          { とりあえず整数としておく     }
  58.       vi   := 0   ;
  59.  
  60.       if (ch = '+') or (ch ='-') then        { 符号がある時                 }
  61.       begin
  62.         sign := ch ;                         { 符号を記憶しておく           }
  63.         read(ch)
  64.       end
  65.       else sign := ' ' ;
  66.  
  67.       if (ch = 'x') or (ch = 'X') then       { 前回の答え数値の指示の時     }
  68.       begin
  69.         val := oldVal ;                      { 前回の答えを 値 とする       }
  70.         read(ch)      ;
  71.         goto 8                               { 符号の処理へ                 }
  72.       end ;
  73.  
  74.       if ('0' <= ch) and (ch <= '9') then
  75.       begin
  76.         vi := ord(ch) - ord('0') ;
  77.         read(ch) ;
  78.         while ('0' <= ch) and (ch <= '9') do
  79.         begin
  80.           if kind = int then
  81.           begin
  82.             vi  := 10 * vi + (ord(ch)-ord('0')) ;
  83.             if vi > LimitInt then            { 整数オーバーフローしている時 }
  84.               cnvFloat(val,vi)               {   以降の演算は実数で行う     }
  85.           end
  86.           else vr := 10 * vr + (ord(ch)-ord('0')) ;
  87.           read(ch)
  88.         end ;
  89.         if ch = '.' then                     { 小数点がある時               }
  90.         begin
  91.           cnvFloat(val,vi) ;                 { 以降の演算は実数で行う       }
  92.           p    := 0.1 ;
  93.           read(ch)    ;
  94.           if ('0' <= ch) and (ch <= '9') then
  95.             repeat
  96.               vr := vr + p * (ord(ch)-ord('0')) ;
  97.               p  := 0.1 * p ;
  98.               read(ch)
  99.             until ('0' > ch) or (ch > '9')
  100.           else error(SYNe)
  101.         end
  102.       end
  103.       else error(SYNe) ;
  104.  
  105.    8: if sign = '-' then                     { 負の符号の時                 }
  106.       if kind = int then vi := -vi           {   値を反転する               }
  107.                     else vr := -vr
  108.     end {with val}
  109.   end ;
  110.  
  111. (******************************)
  112. (* オーバーフローチェック処理 *
  113. (******************************)
  114.   procedure checkOverflow(var val : valueType ; rr : real; ii : integer) ;
  115.   begin
  116.     if abs(rr) > LimitInt then cnvFloat(val,rr) { 整数演算限界 ･･･>実数演算 }
  117.                           else val.vi := ii
  118.   end ;
  119.  
  120. (*****************************)
  121. (*         加算処理          *)
  122. (*****************************)
  123.   procedure add(var val1 : valueType; val2 : valueType) ;
  124.   begin
  125.     if val1.kind = int then
  126.       if val2.kind = int then
  127.         checkOverflow(val1, val1.vi+val2.vi, val1.vi+val2.vi)
  128.       else   cnvFloat(val1, val1.vi+val2.vr)
  129.     else
  130.       if val2.kind = int then val1.vr := val1.vr + val2.vi
  131.                          else val1.vr := val1.vr + val2.vr
  132.   end ;
  133.  
  134. (*****************************)
  135. (*         減算処理          *)
  136. (*****************************)
  137.   procedure sub(var val1 : valueType; val2 : valueType) ;
  138.   begin
  139.     if val1.kind = int then
  140.       if val2.kind = int then
  141.         checkOverflow(val1, val1.vi-val2.vi, val1.vi-val2.vi)
  142.       else   cnvFloat(val1, val1.vi-val2.vr)
  143.     else
  144.       if val2.kind = int then val1.vr := val1.vr - val2.vi
  145.                          else val1.vr := val1.vr - val2.vr
  146.   end ;
  147.  
  148. (*****************************)
  149. (*         乗算処理          *)
  150. (*****************************)
  151.   procedure mul(var val1 : valueType; val2 : valueType) ;
  152.   begin
  153.     if val1.kind = int then
  154.       if val2.kind = int then
  155.         checkOverflow(val1, val1.vi*val2.vi, val1.vi*val2.vi)
  156.       else   cnvFloat(val1, val1.vi*val2.vr)
  157.     else
  158.       if val2.kind = int then val1.vr := val1.vr * val2.vi
  159.                          else val1.vr := val1.vr * val2.vr
  160.   end ;
  161.  
  162. (****************************)
  163. (*        式の処理          *)
  164. (****************************)
  165.   procedure expression(var val : valueType) ;
  166.     var eVal : valueType ;
  167.  
  168.   (**************************)
  169.   (*         項の処理       *)
  170.   (**************************)
  171.     procedure term(var Val : valueType) ;
  172.       var tVal : valueType ;
  173.  
  174.      (***********************)
  175.      (*     因子の処理      *)
  176.      (***********************)
  177.       procedure factor(var val : valueType) ;
  178.       begin
  179.         if ch = '(' then                     { 括弧記法の時                 }
  180.         begin                                {   ( 式 ) の 処理を行う       }
  181.           read(ch)        ;
  182.           expression(val) ;
  183.           if ch = ')' then read(ch)
  184.                       else error(SYNe)       { 式の誤り                     }
  185.         end
  186.         else inputNumber(val)
  187.       end {factor} ;
  188.  
  189.     begin { term }
  190.       factor(val) ;
  191.       while (ch = '*') or (ch = '/') do
  192.         if ch = '*' then
  193.         begin
  194.           read(ch)     ;
  195.           factor(tVal) ;
  196.           mul(val,tval)                      { val := val * tVal            }
  197.         end
  198.         else { ch = '/' }
  199.         begin
  200.           read(ch)     ;
  201.           factor(tVal) ;
  202.           if ((tVal.kind = int) and (tVal.vi = 0)) or      { 0 除算チェック }
  203.               (tVal.kind = rea) and (tVal.vr = 0.0) then error(DIVe) ;
  204.           if val.kind = int then
  205.             if tVal.kind = int then cnvFloat(val, val.vi / tVal.vi)
  206.                                else cnvFloat(val, val.vi / tVal.vr)
  207.           else
  208.             if tVal.kind = int then val.vr := val.vr / tVal.vi
  209.                                else val.vr := val.vr / tVal.vr
  210.         end
  211.     end {term} ;
  212.  
  213.   begin { expression }
  214.     term(val) ;
  215.     while (ch = '+') or (ch = '-') do
  216.       if ch = '+' then
  217.       begin
  218.         read(ch)   ;
  219.         term(eVal) ;
  220.         add(val,eVal)                        { val := val + eVval           }
  221.       end
  222.       else { ch = '-' }
  223.       begin
  224.         read(ch)   ;
  225.         term(eVal) ;
  226.         sub(val,eval)                        { val := val - eVval           }
  227.       end
  228.   end {expression} ;
  229.  
  230. (****************************)
  231. (*        開始処理          *)
  232. (****************************)
  233.   procedure start ;
  234.   begin
  235.     write('# ') ;                            { プロンプト出力               }
  236.     read(ch)                                 { 最初の文字を読み込む         }
  237.   end ;
  238.  
  239. (****************************)
  240. (*       メイン処理         *)
  241. (****************************)
  242. begin
  243. 1:
  244.   start ;
  245.   while (ch <> 'q') and (ch <> 'Q') do       { q または Q で 電卓終了       }
  246.   begin
  247.     expression(val)  ;
  248.     if ch <> '=' then writeln('式の最後は''=''で終わってね.') ;
  249.     if val.kind = int then writeln(val.vi)
  250.                       else writeln(val.vr) ;
  251.     readln        ;                          { 以降改行までの入力を無視する }
  252.     oldVal := val ;                          { 変数x のために 今の値を退避  }
  253.     start
  254.   end
  255. end.
  256.