home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / package / calc.mut < prev    next >
Text File  |  1995-01-14  |  4KB  |  140 lines
  1.   ;; calc.mut : a popup programmers calculator for ME
  2.   ;; C Durland    Public Domain
  3.  
  4. (include me.mh)
  5. (include tobase.mut)
  6.  
  7. (int RV TV mem)
  8. (small-int base)
  9.  
  10. (defun
  11.   doc HIDDEN    ; popup a window with documentation
  12.   {
  13.     (xmenu-box
  14.       ">Mutt CALC - RPN Calculator"
  15.       "Enter     : Move x to total"
  16.       'Backspace : Erase last digit of x'
  17.       " "
  18.       "+  -  * (or x)  /"
  19.       '|  &  ^   : Bitwise OR, AND, XOR total and x'
  20.       "~         : 1's compliment x"
  21.       "<  >      : Shift total left or right"
  22.       "%         : Total mod x"
  23.       "m         : Negate x"
  24.       " "
  25.       "=         : Insert total at dot"
  26.       "' (quote) : Insert x at dot (as a character)"
  27.       " "
  28.       "#         : Toggle between decimal and hex"
  29.       "B         : Change the radix"
  30.       " "
  31.       "k         : Put next key pressed into total"
  32.       "K         : Put a ME key into total"
  33.       " "
  34.       "s         : Store total in memory"
  35.       "r         : Recall memory to x"
  36.       " "
  37.       'C-l (ell) : Redraw the screen'
  38.       'q  C-g    : Quit')
  39.   }
  40.   MAIN
  41.   {
  42.     (base 10)                ;; initialize base to decimal
  43.     (require "menu-box" "popup.mut")    ;; for (doc)
  44.   }
  45.   inc (int n) HIDDEN        ; increment TV by n
  46.   {
  47.     (if (< n base) (TV (+ (* TV base) n)) )
  48.   }
  49.   vert (int n)    HIDDEN    ; convert n to proper base for display
  50.   {
  51.     (if (== base 10) { n (done) } )
  52.     (if (< n 0) (concat "-" (tobase (- 0 n) base)) (tobase n base))
  53.   }
  54. ;  odd (int n) HIDDEN { (!= n (* (/ n 2) 2)) }    ; TRUE if n is odd
  55. ;  bitwise (pointer defun op)(int x y) HIDDEN    ; (bitwise-op x y)
  56. ;  {
  57. ;    (int bit result a b)
  58. ;
  59. ;    (result 0)(bit 1)(a x)(b y)
  60. ;    (while (or (!= 0 a)(!= 0 b))
  61. ;    {
  62. ;      (if (op a b) (+= result bit))
  63. ;      (*= bit 2)    ; next bit
  64. ;      (/= a 2)(/= b 2)
  65. ;    })
  66. ;    result
  67. ;  }
  68. ;  bor  (int a b) HIDDEN { (or (odd a)(odd b)) }  ;TRUE if ((a&1) OR (b&1))==1
  69. ;  band (int a b) HIDDEN { (and (odd a)(odd b)) } ;TRUE if ((a&1) AND (b&1))==1
  70. ;  bxor (int a b) HIDDEN { (odd (+ a b)) }     ;TRUE if ((a&1) XOR (b&1))==1
  71. ;  bit-or  (int x y) HIDDEN { (bitwise (floc bor)  x y) }
  72. ;  bit-and (int x y) HIDDEN { (bitwise (floc band) x y) }
  73. ;  bit-xor (int x y) HIDDEN { (bitwise (floc bxor) x y) }
  74.   calculator
  75.   {
  76.     (int n)
  77.  
  78.     (while TRUE
  79.     {
  80.       (msg "RPN CALC>" base " Memory: " (vert mem base)
  81.     " Total: " (vert RV) "  x: " (vert TV) )
  82.       (switch (getchar)
  83.     "0" (inc 0)
  84.     "1" (inc 1)
  85.     "2" (inc 2)
  86.     "3" (inc 3)
  87.     "4" (inc 4)
  88.     "5" (inc 5)
  89.     "6" (inc 6)
  90.     "7" (inc 7)
  91.     "8" (inc 8)
  92.     "9" (inc 9)
  93.         "+" { (+= RV TV)(TV 0) }
  94.         "-" { (-= RV TV)(TV 0) }
  95.         "*" { (*= RV TV)(TV 0) }
  96.         "x" { (*= RV TV)(TV 0) }
  97.         "/" { (if (== 0 TV)(RV 0)(/= RV TV)) (TV 0) } 
  98.     "a" (inc 10)
  99.     "b" (inc 11)
  100.     "c" (inc 12)
  101.     "d" (inc 13)
  102.     "e" (inc 14)
  103.     "f" (inc 15)
  104.     "=" { (insert-text (vert RV))(update) }
  105.     "^M" { (RV TV)(TV 0) }            ; enter
  106.     "m" (*= TV -1)                ; change sign
  107.     "|" { (RV (bit-or RV  TV)) (TV 0) }
  108.     "&" { (RV (bit-and RV TV)) (TV 0) }
  109.     '^' { (RV (bit-xor RV TV)) (TV 0) }
  110.     '~' (TV (bit-not TV))
  111.     '%' { (if (== 0 TV)(RV 0)(RV (mod RV TV))) (TV 0) }
  112.     "^H" (/= TV base)
  113.     "s" (mem RV)                ; store
  114.     "r" (TV mem)                ; recall
  115. ;    "^L" { (refresh-screen)(update) }    ; refresh screen
  116.     "^L" (update)                 ; refresh screen
  117.     ">" (/= RV 2)                ; shift right
  118.     "<" (*= RV 2)                ; shift left
  119.     "#" (if (== base 10)(base 16)(base 10))    ; toggle radix
  120.     "B"                    ; change radix
  121.       {
  122.         (n (convert-to NUMBER (ask "base = ")))
  123.         (if (and (<= 2 n)(<= n 16)) (base n))
  124.       }
  125.     "k"
  126.       {
  127.         (msg "Press key to convert")
  128.         (RV (convert-to CHARACTER (getchar)))
  129.       }
  130.     "K" { (msg "Press ME key to convert")(RV (get-key)) }
  131.     "'" { (insert-text (convert-to CHARACTER TV))(update) }
  132.     "?" (doc)
  133.  
  134.     "q" (break)            ; quit
  135.     "^G" (abort)            ; quit
  136.       )
  137.     })
  138.   }
  139. )
  140.