(ql:quickload "ltk") (defpackage :cconv (:use :common-lisp :ltk) (:export #:main)) (in-package :cconv) ;; (defun main () ;; (setf *debug-tk* nil) ;; (with-ltk () ;; (wm-title *tk* "Feet to Meters") ;; (let ((mainframe (make-instance 'frame))) ;; (configure mainframe :padding "3 3 12 12") ;; ()))) (defun calculate (feet-widget meter-widget) (setf (text meter-widget) (format nil "~,2F" (* (read-from-string (text feet-widget)) 0.3048d0)))) (defun gui () (setf *debug-tk* nil) (with-ltk () (wm-title *tk* "Feet to Meters") (let ((c (make-instance 'frame))) (grid c 0 0 :sticky "ne") (grid-columnconfigure *tk* 0 :weight 1) (grid-rowconfigure *tk* 0 :weight 1) (let* ((c.feet (grid (make-instance 'entry :width 7) 1 2 :sticky "we" :padx 5 :pady 5)) (c.meters (grid (make-instance 'entry :state "readonly") 2 2 :sticky "we" :padx 5 :pady 5))) (grid (make-instance 'button :text "Calculate" :command (lambda () (calculate c.feet c.meters))) 3 3 :sticky "w" :padx 5 :pady 5) (grid (make-instance 'label :text "feet") 1 3 :sticky "w" :padx 5 :pady 5) (grid (make-instance 'label :text "is equivalent to") 2 1 :sticky "w" :padx 5 :pady 5) (grid (make-instance 'label :text "meters") 2 3 :sticky "w" :padx 5 :pady 5))))) (provide "cconv")