(ql:quickload :ltk)

;; http://kaolin.unice.fr/STk/STk.html
;; STk-4.0.1/Demos/calc.stklos を参考にLTkへ移植
(in-package :ltk-user)

(defun digit? (s)
  (or (parse-integer s :junk-allowed T)
      (string= s ".")))

(defclass screen (entry)
  ;;LTkのentryでは -textvariable は直接アクセスさせないようなので、
  ;; screenというラッパークラスを定義
  ((result :initform 0 :accessor result)
   (previous-action :initform "" :accessor previous-action)
   (acc :initform 0 :accessor acc)
   (operator :initform #'+ :accessor operator)))

(defmethod (setf result) :after (val (obj screen))
  (setf (text obj) (slot-value obj 'result)))

(defmethod value ((obj screen))
  (read-from-string (text obj) nil 0))

(defmethod execute-action ((obj screen) str)
  (with-accessors ((operator operator)
                   (result result)
                   (acc acc)
                   (previous-action previous-action)
                   (value value)
                   (text text))
                  obj
    (cond ((string= str "Off")  (setq *exit-mainloop* T))
          ((string= str "Sqrt") (setq result (sqrt value)))
          ((string= str "C")    (setq result 0))
          ((string= str "/")    (setq operator #'/))
          ((string= str "*")    (setq operator #'*))
          ((string= str "-")    (setq operator #'-))
          ((string= str "+")    (setq operator #'+))
          ((string= str "+/-")  (setq result (- value)))
          ((string= str "=")
           (setf result (funcall operator acc value)))
          ('ELSE
           (setq result (if (digit? previous-action)
                            (concatenate 'string text str)
                            (progn
                              (setq acc value)
                              str)))))
    (setq previous-action str)))

(defun calc ()
  (with-ltk ()
    (let ((screen (make-instance 'screen :text "0"))
          ;; Rows is a vector of 5 frames
          (rows (map-into (make-sequence 'vector 5)
                          (lambda () (make-instance 'frame)))))
      (mapc (let ((count 0))
              (lambda (text)
                (pack (make-instance 'button
                                     :text text 
                                     :master (aref rows (floor count 4))
                                     :width  6
                                     :command (lambda () 
                                                (execute-action screen text)))
                      :side :left :padx 4 :pady 2)
                (incf count)))
            '("Off"  "Sqrt"  "C"  "/"
              "7"    "8"    "9"  "*"
              "4"    "5"    "6"  "-"
              "1"    "2"    "3"  "+"
              "0"    "."   "+/-" "="))
      (pack screen :fill :x :padx 5 :pady 5 :ipadx 5 :ipady 5)
      (map nil 
           (lambda (row)
             (pack row :fill :x))
           rows))))

;; 実行
(calc)

参考

• CAPI:電卓アプリ(ボタン応用)