stk/Demos/calc.stklos

83 lines
2.6 KiB
Plaintext
Raw Normal View History

1996-09-27 06:29:02 -04:00
#!/bin/sh
:;exec /usr/local/bin/stk -f "$0" "$@"
;;;;
;;;; c a l c . s t k l o s -- A very simplistic calculator
;;;;
1999-09-05 07:16:41 -04:00
;;;; Copyright <20> 1995-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
1996-09-27 06:29:02 -04:00
;;;;
1999-09-05 07:16:41 -04:00
;;;; Permission to use, copy, modify, distribute,and license this
;;;; software and its documentation for any purpose is hereby granted,
;;;; provided that existing copyright notices are retained in all
;;;; copies and that this notice is included verbatim in any
;;;; distributions. No written agreement, license, or royalty fee is
;;;; required for any of the authorized uses.
1996-09-27 06:29:02 -04:00
;;;;
1999-09-05 07:16:41 -04:00
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
1998-04-10 06:59:06 -04:00
;;;;
1996-09-27 06:29:02 -04:00
;;;; Author: Erick Gallesio [eg@unice.fr]
;;;; Creation date: 6-Apr-1995 18:11
1999-09-05 07:16:41 -04:00
;;;; Last file update: 3-Sep-1999 19:13 (eg)
1996-09-27 06:29:02 -04:00
(require "Tk-classes")
(define Result 0)
(define (get-Screen)
(string->number (value Screen)))
(define (digit? s)
(or (string->number s) (string=? s ".")))
(define execute-action
(let ((previous-action "") (Acc 0) (operator +))
(lambda (str)
(cond
((string=? str "Off") (exit 0))
((string=? str "Sqrt") (set! Result (sqrt (get-screen))))
((string=? str "C") (set! Result 0))
((string=? str "/") (set! operator /))
((string=? str "*") (set! operator *))
((string=? str "-") (set! operator -))
((string=? str "+") (set! operator +))
((string=? str "+/-") (set! Result (- (get-screen))))
((string=? str "=") (set! Result (operator Acc (get-screen))))
(ELSE (if (digit? previous-action)
(set! Result (string-append (value Screen) str))
(begin
(set! Acc (get-screen))
(set! Result str)))))
(set! previous-action str))))
;;;;
;;;; Make the interface
;;;;
(define Screen (make <Entry> :text-variable 'Result :border-width 3
:relief 'ridge :foreground "Blue"))
(define rows ;; Rows is a vector of 5 frames
(vector (make <Frame>)(make <Frame>)(make <Frame>)(make <Frame>)(make <Frame>)))
(for-each (let ((count 0))
(lambda (text)
(pack (make <Button>
:text text
:parent (vector-ref rows (quotient count 4))
:width 6
:command (lambda () (execute-action text)))
:side "left" :padx 4 :pady 2)
(set! count (+ 1 count))))
'("Off" "Sqrt" "C" "/"
"7" "8" "9" "*"
"4" "5" "6" "-"
"1" "2" "3" "+"
"0" "." "+/-" "="))
;;;
;;; And pack its components
;;;
(pack Screen :expand #t :fill "x" :padx 5 :pady 5 :ipadx 5 :ipady 5)
(for-each (lambda (row) (pack row :expand #t :fill "x"))
(vector->list rows))