picolisp

Unnamed repository; edit this file to name it for gitweb.
git clone https://logand.com/git/picolisp.git/
Log | Files | Refs | README | LICENSE

calc.l (2153B)

      1 # 14may11abu
      2 # (c) Software Lab. Alexander Burger
      3 
      4 # *Init *Accu *Stack
      5 
      6 (allowed NIL "!calculator" "@lib.css")
      7 (load "@lib/http.l" "@lib/xhtml.l" "@lib/form.l")
      8 
      9 # Calculator logic
     10 (de digit (N)
     11    (when *Init (zero *Accu) (off *Init))
     12    (setq *Accu (+ N (* 10 *Accu))) )
     13 
     14 (de calc ()
     15    (let (Fun (caar *Stack)  Val (cddr (pop '*Stack)))
     16       (setq *Accu
     17          (if (and (== '/ Fun) (=0 *Accu))
     18             (alert "Div / 0")
     19             (Fun Val *Accu) ) ) ) )
     20 
     21 (de operand (Fun Prio)
     22    (when (>= (cadar *Stack) Prio) (calc))
     23    (push '*Stack (cons Fun Prio *Accu))
     24    (on *Init) )
     25 
     26 (de finish ()
     27    (while *Stack (calc))
     28    (on *Init) )
     29 
     30 # Calculator GUI
     31 (de calculator ()
     32    (app)
     33    (action
     34       (html 0 "Bignum Calculator" "@lib.css" NIL
     35          (<h2> NIL "Bignum Calculator")
     36          (form NIL
     37             (<br> (gui '(+Var +NumField) '*Accu 60))
     38             (<grid> 4
     39                (gui '(+JS +Button) "±" '(setq *Accu (- *Accu)))
     40                (gui '(+Able +JS +Button) '(ge0 *Accu) (char 8730)
     41                   '(setq *Accu (sqrt *Accu)) )
     42                (gui '(+JS +Button) "\^" '(operand '** 3))
     43                (gui '(+JS +Button) "/" '(operand '/ 2))
     44 
     45                (gui '(+JS +Button) "7" '(digit 7))
     46                (gui '(+JS +Button) "8" '(digit 8))
     47                (gui '(+JS +Button) "9" '(digit 9))
     48                (gui '(+JS +Button) "*" '(operand '* 2))
     49 
     50                (gui '(+JS +Button) "4" '(digit 4))
     51                (gui '(+JS +Button) "5" '(digit 5))
     52                (gui '(+JS +Button) "6" '(digit 6))
     53                (gui '(+JS +Button) "-" '(operand '- 1))
     54 
     55                (gui '(+JS +Button) "1" '(digit 1))
     56                (gui '(+JS +Button) "2" '(digit 2))
     57                (gui '(+JS +Button) "3" '(digit 3))
     58                (gui '(+JS +Button) "+" '(operand '+ 1))
     59 
     60                (gui '(+JS +Button) "0" '(digit 0))
     61                (gui '(+JS +Button) "C" '(zero *Accu))
     62                (gui '(+JS +Button) "A" '(main))
     63                (gui '(+JS +Button) "=" '(finish)) ) ) ) ) )
     64 
     65 # Initialize
     66 (de main ()
     67    (on *Init)
     68    (zero *Accu)
     69    (off *Stack) )
     70 
     71 # Start server
     72 (de go ()
     73    (server 8080 "!calculator") )