[mcclim-devel] A new example application for CLIM (town-example.lisp)
Max-Gerd Retzlaff
m.retzlaff at gmx.net
Thu Aug 18 02:27:30 UTC 2005
And again..
I had quite a productive day regarding clim programming yesterday; one
of the outcomes is the following example for CLIM programming. It
tries to demonstrate the following topics:
custom view classes, different present presentation methods for
different views, completion for accept presentation methods,
accepting-values dialogues, presentation to command translators,
partial commands in menus, automatically generated menus,
and keystroke gestures for commands.
At the same time I tried to make the application as simple as
possible. As in: Not doing fancy stuff to make the application
less senseless (as an application) or more visually appealing.
You'll find a screenshot at: http://bl0rg.net/~mgr/flux/town-example.png
The code is located at http://bl0rg.net/~mgr/flux/town-example.lisp and
also attached to this email.
Any comments and proposals for changes are welcome! Did I do something
that would better have been done in a different way? Then, please,
enlighten me! I currently think about expanding it to a real tutorial
with some explanations. But I don't know whether I'll have the time to
do it.
Regards,
Max
--
Max-Gerd Retzlaff <m.retzlaff at gmx.net>
For your amusement:
aphorism, n.:
A concise, clever statement.
afterism, n.:
A concise, clever statement you don't think of until too late.
-- James Alexander Thom
-------------- next part --------------
;;; -*- Mode: Lisp; Syntax: Common-Lisp; Package: TOWN-EXAMPLE; -*-
;;; ---------------------------------------------------------------------------
;;; Title: Example CLIM Application: Large Cities of Germany
;;; Topics: custom view classes, different present presentation methods for
;;; different views, completion for accept presentation methods,
;;; accepting-values dialogues, presentation to command translators,
;;; partial commands in menus, automatically generated menus,
;;; and keystroke gestures for commands.
;;; Usage: Compile and load the file and call (town-example:run) afterwards.
;;; Created: 2005-08-17, Version 1.3 (same date)
;;; Author: Max-Gerd Retzlaff <m.retzlaff at gmx.net>, http://bl0rg.net/~mgr
;;; ---------------------------------------------------------------------------
;;; (c) copyright 2005 by Max-Gerd Retzlaff
;;; define the package
(in-package :cl-user)
(defpackage :town-example
(:use :clim :clim-lisp)
(:export :run))
(in-package :town-example)
;;; view class for graphical presentations
(defclass graphical-view (view)
())
(defparameter +graphical-view+ (make-instance 'graphical-view))
;;; an application frame consistiong of one pane
(define-application-frame town-example ()
()
(:panes
(map :application :height 500 :width 500 :scroll-bars nil
:background +dark-blue+ :display-function #'draw-map
:default-view +graphical-view+)
(pointer-doc :pointer-documentation)
(interactor :interactor :height 163 ;; 130 105 95
:scroll-bars nil))
(:layouts
(default (vertically ()
map
interactor
pointer-doc)))
(:top-level (default-frame-top-level :prompt #'town-example-prompt)))
(defun town-example-prompt (pane frame)
(declare (ignore frame))
(window-clear pane)
(with-text-face (pane :roman)
(write-string "> " pane)))
(defun draw-map (frame pane)
"Draws a stylized map of Germany"
(declare (ignore frame))
(draw-polygon* pane '(172 22 228 40 227 59 264 60 256 80 277 88
319 54 336 58 345 43 353 55 345 71 370 86
384 124 375 141 393 159 398 208 416 237 410 258
397 252 314 302 333 351 380 389 341 426 350 461
324 452 280 471 252 462 240 474 172 448 166 460
132 457 140 410 160 378 116 368 92 346 79 307
94 295 82 252 90 229 84 204 113 201 112 162
129 142 130 104 157 102 174 118 182 96 204 96
186 58 196 50)
:ink +dark-green+)
;; present all towns (later..)
(com-present-towns))
;;; a function to start the demonstration
(defun run ()
(run-frame-top-level (make-application-frame 'town-example)))
;;; a command to quit the program
(define-town-example-command (com-quit :name t :menu t ;; show in menu
:keystroke (#\q :meta)) ;; a keystroke
()
(frame-exit *application-frame*))
;;; a class for towns
(defclass town ()
((name :initarg :name :accessor town-name)
(coordinates :initarg :coordinates :accessor town-coordinates
:initform (make-point 156 68)) ;; Helogoland..
(population :initarg :population :accessor town-population
:initform nil)))
;;; a hash to store the towns
(defvar *towns* (make-hash-table :test #'equal))
;;; slightly nicer function to create new town instances
(defun make-town (name x y &optional population)
(let ((town (make-instance 'town :name name
:coordinates (make-point x y))))
(when population
(setf (town-population town) population))
town))
;;; clos magic to automatically store all created towns in the hash
(defmethod initialize-instance :after ((town town) &key)
(setf (gethash (town-name town) *towns*) town))
;;; function to find a town
(defun find-town (name &optional (errorp t))
(or (gethash name *towns*) ;; not the best style..
(and errorp (error "~&No town named ~S in the database." name))))
;;; printer method for town instances
(defun slot-value-or-something (object &key (slot 'name) (something "without name"))
(if (slot-boundp object slot)
(slot-value object slot)
something))
(defmethod print-object ((town town) stream)
(print-unreadable-object (town stream :type t)
(write-string (slot-value-or-something town) stream)))
;;; create some towns.. (21th biggest cities of Germany on 12-31-2003)
(make-town "Berlin" 353 166 3390000)
(make-town "Hamburg" 229 106 1730000)
(make-town "Munich" 292 427 1250000)
(make-town "Cologne" 116 260 970000)
(make-town "Frankfurt" 179 310 640000)
(make-town "Dortmund" 136 226 590000)
(make-town "Essen" 120 228 590000)
(make-town "Stuttgart" 196 392 590000)
(make-town "Duesseldorf" 110 242 570000)
(make-town "Bremen" 187 134 540000)
(make-town "Hanover" 222 177 520000)
(make-town "Duisburg" 108 231 510000)
(make-town "Leipzig" 318 238 500000)
(make-town "Nuremberg" 272 352 490000)
(make-town "Dresden" 370 252 480000)
(make-town "Bochum" 130 228 390000)
(make-town "Wuppertal" 130 238 360000)
(make-town "Bielefeld" 176 198 330000)
(make-town "Bonn" 120 276 310000)
(make-town "Mannheim" 172 349 310000)
(make-town "Karlsruhe" 168 377 280000)
;;; a presantation type for town would look like this:
;;;
;;; (clim:define-presentation-type town ())
;;;
;;; But we don't have to specify it as clim-spec 8.6.2 says:
;;; "If your presentation type has the same name as a class, doesn't
;;; have any parameters or options, doesn't have a history, and
;;; doesn't need a special description, you do not need to call
;;; define-presentation-type."
;;; accept method for a town presentation (in any view mode):
(define-presentation-method accept ((type town) stream view &key)
(values ;suppress values after the first
;; provide completion over the names of the towns
(completing-from-suggestions (Stream :partial-completers '(#\Space))
(maphash #'suggest *towns*))))
;;; how to present a town in CLIM in text-mode:
(define-presentation-method present (town (type town) stream
(view textual-view) &key)
(write-string (town-name town) stream))
;;; .. and graphically:
(defparameter *population->town-circle-factor* 20000
"Towns are graphically represented as circles.
Factor to reduce the size of the circles")
(defun population->town-circle-diameter (town)
"Towns are graphically represented as circles."
;;;; first version: diameter is linearly proportional to the population
;;; (round (/ (or (town-population town) 150000)
;;; *population->town-circle-factor*))) ;; 100000
;;;
;;;; second version: area of the circle is linearly proportional to the population
;;; (round (sqrt (/ (or (town-population town) 15000)
;;; *population->town-circle-factor* ;; 8000
;;; pi))))
;;;
;;;; third version: produces pleasant proportions
(round (expt (/ (or (town-population town) 150000)
*population->town-circle-factor* ;; 20000
pi)
3/4)))
(define-presentation-method present (town (type town) stream
(view graphical-view) &key)
(clim:draw-circle stream
(town-coordinates town)
(population->town-circle-diameter town)
:ink +dark-red+))
;;; command that presents all towns (used in #'draw-map)
;;; This could be a normal function instead, just replace the first line by:
;;; (defun com-present-towns
(define-town-example-command (com-present-towns)
()
(maphash (lambda (key value)
(declare (ignore key))
(clim:present value 'town))
*towns*))
;;; accepting-values macro with a nice text-style
(defmacro accepting-values-with-style-and-title ((stream) title &rest body)
`(let ((,stream *query-io*))
(window-clear ,stream)
(accepting-values (,stream :initially-select-query-identifier 'tag); :own-window t)
(with-text-style (,stream '(:sans-serif :bold 20))
,title)
(with-text-style (,stream '(:serif :roman 15))
, at body))))
;;; show info about a town (using a pop-up window or embedded in the interactor-pane)
(define-town-example-command (com-show-town-info :name t :menu t
:keystroke (#\i :meta))
((town 'town :prompt " Which town? "))
;; (present town 'town :view +textual-view+)
(accepting-values-with-style-and-title (stream)
(format stream "~&Information on ~a~%" (town-name town))
(format stream "~%~A has ~:d inhabitants.~%~%"
(town-name town)
(or (town-population town) "some"))))
;;; show info on town :select gesture (left click)
(define-presentation-to-command-translator info-for-town
(town com-show-town-info town-example
:gesture :select
:documentation "Show info for this town.")
(object)
(list object))
;;; get distance between two towns
(defun get-distance-between-points (a b)
"Ask Pythagoras or Euclid."
(round (sqrt (+ (expt (- (point-x a)
(point-x b))
2)
(expt (- (point-y a)
(point-y b))
2)))))
(define-town-example-command (com-get-distance :name t :menu t
:keystroke (#\d :meta))
((town-a 'town :prompt "Town a")
(town-b 'town :prompt "Town b"))
(accepting-values-with-style-and-title (stream)
(format stream "~&Distance~%")
(format stream "~%It's ~d pixels from ~a to ~a.~%~%"
(get-distance-between-points (town-coordinates town-a)
(town-coordinates town-b))
(town-name town-a)
(town-name town-b))))
;;; get distance on :describe gesture (middle click)
;;; (ask via accept for the second town)
;;; Defunct and not really nice. Note that the version below is simpler,
;;; working, more elegant, and more intuitive, as the user sees the same
;;; as if he had entered the com-get-distance command via the keyboard.
;;;
;;; (define-presentation-to-command-translator distance-between-two-towns
;;; (town com-get-distance town-example
;;; :gesture :describe
;;; :documentation "Get distance from this town to another.")
;;; (object)
;;; (list object
;;; (let (town-b)
;;; (accepting-values-with-style-and-title (stream)
;;; (format stream "~&Get distance~%")
;;; (format stream "~%From ~a to: " (town-name object))
;;; (setf town-b (accept 'town :prompt nil :stream stream :query-identifier 'tag)))
;;; town-b)))
(define-presentation-to-command-translator distance-between-two-towns
(town com-get-distance town-example
:gesture :describe
:documentation "Get distance from this town to another.")
(object)
(list object
(let ((stream *query-io*))
(format stream " Get distance (Town a) ~a (Town b) " (town-name object))
(accept 'town :prompt nil :stream stream :query-identifier 'tag))))
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/mcclim-devel/attachments/20050818/aabdaeba/attachment.sig>
More information about the mcclim-devel
mailing list