#!/bin/sh :;exec /usr/local/bin/stk -f "$0" "$@" ;;;; ;;;; c a l c . s t k l o s -- A very simplistic calculator ;;;; ;;;; Copyright © 1993-1996 Erick Gallesio - I3S-CNRS/ESSI ;;;; ;;;; Permission to use, copy, and/or distribute this software and its ;;;; documentation for any purpose and without fee is hereby granted, provided ;;;; that both the above copyright notice and this permission notice appear in ;;;; all copies and derived works. Fees for distribution or use of this ;;;; software or derived works may only be charged with express written ;;;; permission of the copyright holder. ;;;; 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: 18-Sep-1995 14:25 (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 :text-variable 'Result :border-width 3 :relief 'ridge :foreground "Blue")) (define rows ;; Rows is a vector of 5 frames (vector (make )(make )(make )(make )(make ))) (for-each (let ((count 0)) (lambda (text) (pack (make