#!/bin/sh
:;exec /usr/local/bin/stk -f "$0" "$@"
;;;;
;;;; c a l c . s t k l o s  --  A very simplistic calculator
;;;;
;;;; Copyright © 1995-1999 Erick Gallesio - I3S-CNRS/ESSI <eg@unice.fr>
;;;; 
;;;; 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.
;;;;
;;;; This software is provided ``AS IS'' without express or implied
;;;; warranty.
;;;;
;;;;           Author: Erick Gallesio [eg@unice.fr]
;;;;    Creation date:  6-Apr-1995 18:11
;;;; Last file update:  3-Sep-1999 19:13 (eg)

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