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))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
