REBOL [
    Title: "Calculation"
    Date: 14-Mar-2002
    Version: 0.9.3
    File: %calc-engine.r
    Author: "Ryan Cole"
    Purpose: "A dialect for creating calculators."
    Email: ryancole@usa.com
    Category: [math 3 view]
]

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]
        all-clear
    ]
    
    end-paren: does [
        either empty? stack [
            error: on
            arg
        ] [
                if reg/2 [solve-op]
            op: stack/1/1
            reg: stack/1/2
            remove stack
            cur-set acc
        ]
    ]


    ; 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]
        "MC" func [arg] [memory: none arg]
        "MR" func [arg] [any [memory 0]]
        "M+" func [arg] [memory: (any [memory 0]) + arg  arg]
        "M-" func [arg] [memory: (any [memory 0]) - arg  arg]
        "M*" func [arg] [memory: (any [memory 0]) * arg  arg]
        "Mx" func [arg] [memory: (any [memory 0]) * arg  arg]
        "M×" func [arg] [memory: (any [memory 0]) * arg  arg]
        "M·" func [arg] [memory: (any [memory 0]) * arg  arg]
        "M/" func [arg] [memory: (any [memory 0]) / arg  arg]
        "M÷" func [arg] [memory: (any [memory 0]) / arg  arg]
        "¹/x" func [arg] [1 / arg]
        "²" func [arg] [arg * arg]
        "³" func [arg] [arg * arg * 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: any [reg/2 acc 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]]
    ]

    all-clear: does [
        acc: op: none
        reg: copy []
    ]

    clear-entry: does [
        acc: none
        remove either reg/2 [next reg][reg]
    ]

    press: function [key] [def old-op] [
        error: none
        if find ".0123456789" key [
            if none? pick reg not op [insert reg copy ""]
            if not all ["." = key  find reg/1 key] [append reg/1 key]
        ]
        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 find "^M=" key [solve-op]
        if "AC" = key [all-clear]
        if "CE" = key [clear-entry]

        if "(" = key [begin-paren]
        if ")" = key [end-paren]
    ]
]

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
]