REBOL [ Title: "Calculese" Date: 9-OCT-2004 Version: 1.0.0 File: %calculese.r Author: "Ryan S. Cole" Purpose: "A dialect for creating calculators." Email: %ryan--skurunner--com library: [ level: 'intermediate platform: 'all type: 'dialect domain: 'math tested-under: none support: none license: 'pd see-also: none ] ] comment [ >> calculese "4 * 55 =" == "120." >> calculese "1" == "1." >> calculese "+" == "1." >> calculese "2" == "2." >> calculese "=" == "3." ] calc-engine: make object! [ op: none reg: [] acc: none error: none error-message: "ERROR!" memory: none stack: [] begin-paren: does [ insert/only stack reduce [op reg] acc: op: none reg: copy [] ] end-paren: does [ op: stack/1/1 reg: stack/1/2 remove stack if none? pick reg not op [insert reg copy ""] reg/1: any [acc form 0] ] ; For working with the displayed number... ;cur-str: does [any [reg/1 acc form 0]] ;cur-num: does [to-decimal cur-str] cur-set: func [val] [ either not either :op [reg/2][reg/1] [ insert reg form val ] [ reg/1: form val ] ] op-defs: reduce [ "+" :add "-" :subtract "*" :multiply "x" :multiply "×" :multiply "·" :multiply "/" :divide "÷" :divide "And" func [a b] [and to-integer a to-integer b] "Or" func [a b] [or to-integer a to-integer b] "Xor" func [a b] [xor to-integer a to-integer b] "Mod" :remainder "^^" :power "Exp" :power ] func-defs: reduce [ "Neg" :negate "±" :negate "Abs" :absolute "Arccos" :Arccosine "Arcsin" :Arcsine "Arctan" :Arctangent "Cos" :cosine "Sin" :sine "Tan" :Tangent "Not" :complement "Exp-E" :exp "Log-10" :log-10 "Log-2" :log-2 "Log-E" :log-E "Rnd" :random "SqR" :square-root "Pi" func [arg] [Pi] "%" func [arg] [arg * .01] "¹/x" func [arg] [1 / arg] "²" func [arg] [arg * arg] "³" func [arg] [arg * arg * arg] "++" func [arg] [arg + 1] "--" func [arg] [arg - 1] "MR" func [arg] [any [memory 0]] ] null-func-defs: reduce [ "MC" func [arg] [memory: none arg] "M+" func [arg] [memory: (any [memory 0]) + arg] "M-" func [arg] [memory: (any [memory 0]) - arg] "M*" func [arg] [memory: (any [memory 0]) * arg] "Mx" func [arg] [memory: (any [memory 0]) * arg] "M×" func [arg] [memory: (any [memory 0]) * arg] "M·" func [arg] [memory: (any [memory 0]) * arg] "M/" func [arg] [memory: (any [memory 0]) / arg] "M÷" func [arg] [memory: (any [memory 0]) / arg] ] display: has [txt] [ if error [return error-message] txt: form any [reg/1 reg/2 acc 0] if not find txt "." [append txt "."] return txt ] ;does double argument operations solve-op: has [tmp] [ tmp: load form any [reg/2 acc reg/1 0] acc: none op: select op-defs op if :op [ error: error? try [acc: do [ op (to-decimal tmp) (to-decimal reg/1) ] ] ] reg: copy [] op: no ] ;does single argument in place operations solve-func: function [funx] [tmp] [ tmp: to-decimal any [reg/1 acc 0] clear-entry error: error? try [acc: do [funx tmp]] ] ;does single argument null operations solve-null-func: function [funx] [tmp] [ tmp: to-decimal any [reg/1 acc 0] error: error? try [funx tmp] ] all-clear: does [ acc: op: none reg: copy [] stack: copy [] ] clear-entry: does [ acc: none remove either reg/2 [next reg][reg] ] press: function [key] [def old-op] [ error: none ;print ["key: " key " reg: " reg " acc: " acc " mem: " memory] if find ".0123456789" key [ if none? pick reg not op [insert reg copy ""] if all ["." = key find reg/1 key] [exit] if all ["0" = key reg/1/1 = key] [exit] append reg/1 key acc: none ] if select op-defs key [ if reg/2 [solve-op] any [reg/1 insert reg any [acc 0]] op: key ] if selected: select func-defs key [solve-func :selected] if selected: select null-func-defs key [solve-null-func :selected] if find "^M=" key [solve-op] if "AC" = key [all-clear] if "CE" = key [clear-entry] if "(" = key [ if reg/2 [solve-op] ;any [reg/1 insert reg any [acc 0]] begin-paren ] if ")" = key [ if not empty? stack [ if reg/2 [solve-op] end-paren ] ] ;print ["key: " key " reg: " reg " acc: " acc " mem: " memory] ] ] calculese: function [calc [string! block!]] [] [ if block? calc [calc: form calc] characters: complement charset [".0123456789"] foreach token parse/all calc " " [ either find token characters [ calc-engine/press to-string token ] [ foreach digit to-string token [ calc-engine/press to-string digit ] ] ] calc-engine/display ]