|
Allegro CL version 8.0 |
Creating a Shared Class
Since the palette in the Coefficients dialog and the Background palette are going to use the same controls and functions for color, a new shared class called color-mixin will encapsulate their shared behaviors. The -mixin suffix means that you will never create an instance of this class, but that you can create subclasses of it.
(in-package :common-graphics-user) (defclass color-mixin () ())
There is a nickname in the system for the :common-graphics-user package called :cg-user. You may see this in some of the already compiled files in the final directory.
When Are Invisible Controls Being Overlapped?
If you are concerned about overlapping your new button control with the now-invisible multi-picture-button, try dragging it slowly to the left and intentionally overlapping the two. Look for the visual cues.
(defmethod initialize-instance :after ((dialog color-mixin) &rest initargs) (declare (ignore initargs)) (let ((color-list (find-component :color-list dialog))) (when color-list (setf (range color-list) (default-color-range)) (setf (recessed color-list) t)))) (defun default-color-range () (list (make-instance 'button-info :name :black :image #S(rgb red 0 green 0 blue 0)) (make-instance 'button-info :name :red :image #S(rgb red 255 green 0 blue 0)) (make-instance 'button-info :name :green :image #S(rgb red 0 green 255 blue 0)) (make-instance 'button-info :name :blue :image #S(rgb red 0 green 0 blue 255)) (make-instance 'button-info :name :cyan :image #S(rgb red 0 green 255 blue 255)) (make-instance 'button-info :name :magenta :image #S(rgb red 255 green 0 blue 255)) (make-instance 'button-info :name :yellow :image #S(rgb red 255 green 255 blue 0)) (make-instance 'button-info :name :white :image #S(rgb red 255 green 255 blue 255))))
Whats going on?
This enables both the Coefficients and the Background dialogs to fill their multi-picture-button wells with color. You wont see the colors until Step 59 at the end of the Chapter.
initialize-instance Customizes the Two Dialog Palettes
Initially, the list of colors in the Background dialog and the Coefficient dialog palettes are the same. Therefore, whenever you create a subclass of color-mixin, the range of the color list control should be initialized.
In CLOS, you use initialize-instance to customize initialization for all instances of a class. You usually add an :after method to initialize-instance to avoid overriding the default CLOS initialization process.
In this case, the initialize-instance sets the range of the :color-list multi-picture-button and the style of the controls display. Since this multi-picture-button control holds color like a real paint box, youre using recessed wells for the buttons.
(defclass coefficient-dialog (color-mixin dialog) ())
You won't be able to add color to the curve yet, but you can manipulate the control and select different portions of it. The Other Color... button does nothing as yet.
(defmethod draw-curve :around ((window basic-pane) (curve cycloidal-curve)) (with-foreground-color (window (color curve)) (call-next-method)))
(defmethod show-coefficient-dialog ((dialog curve-dialog) &optional (curve (make-instance 'cycloidal-curve))) (let* ((coefficient-dialog (get-coefficient-dialog dialog)) (a-widget (find-component :a-coefficient-control coefficient-dialog)) (b-widget (find-component :b-coefficient-control coefficient-dialog)) (c-widget (find-component :c-coefficient-control coefficient-dialog)) (color-list (find-component :color-list coefficient-dialog)) (color-name (find-color-name coefficient-dialog (color curve)))) (move-window coefficient-dialog (window-to-screen-units dialog (make-position 10 10))) ;; initialize the value of the widgets (setf (value a-widget) (a-coefficient curve)) (setf (value b-widget) (b-coefficient curve)) (setf (value c-widget) (c-coefficient curve)) (setf (value color-list) (when color-name (list color-name))) ;; display the dialog as modal (when (pop-up-modal-dialog coefficient-dialog :stream (owner dialog)) ;; if the user click on OK, change ;; the new curve ;; to reflect the values shown in ;; the dialog (setf (a-coefficient curve) (value a-widget)) (setf (b-coefficient curve) (value b-widget)) (setf (c-coefficient curve) (value c-widget)) (setf (color curve) (current-color coefficient-dialog)) curve)))
(defmethod current-color ((dialog color-mixin)) (let* ((color-list (find-component :color-list dialog)) (value (first (value color-list)))) (if value (color (find value (range color-list) :key #'name)) ;; else black))) (defmethod find-color-name ((dialog color-mixin) &optional (color black)) (let ((color-list (find-component :color-list dialog))) (name (find color (range color-list) :key #'color :test #'rgb-equal))))
(defmethod test-curve ((dialog coefficient-dialog)) (let* ((curve (make-instance 'cycloidal-curve :a-coefficient (value (find-component :a-coefficient-control dialog)) :b-coefficient (value (find-component :b-coefficient-control dialog)) :c-coefficient (value (find-component :c-coefficient-control dialog)) :color (current-color dialog))) (curve-dialog (owner dialog)) (doodler (owner curve-dialog))) (draw-curve (frame-child doodler) curve)))
(defun coefficient-dialog-color-button-on-change (widget new-value old-value) (declare (ignore-if-unused widget new-value old-value)) (when new-value (add-other-color (parent widget))) (not new-value))
(defmethod add-other-color ((dialog color-mixin)) (let* ((new-color (ask-user-for-color :initial-color (current-color dialog))) (color-list (find-component :color-list dialog)) (color-name nil)) ;; do nothing if user canceled (when new-color ;; do not add color if it already ;; is on the list. (when (not (setf color-name (find-color-name dialog new-color))) (setf color-name (new-color-name dialog)) (let* ((colors (range color-list))) (setf (range color-list) (append colors (list (make-instance 'button-info :name color-name :image new-color)))))) ;; change which color is pressed (setf (value color-list) (list color-name))))) (defmethod new-color-name ((dialog color-mixin)) (let ((range (range (find-component :color-list dialog))) (name nil)) (do ((index 1 (1+ index))) (nil) (setf name (intern (format nil "CUSTOM-COLOR-~d" index) (find-package :keyword))) ;; make sure no other colors already have ;; the same name (unless (find name range :key #'name) (return name)))))
Reshape the new form to look like the illustration.
Changing the Location of a Form
At any point, you can choose a new location to display the form by dragging it around on your screen. Once you've saved the project, Lisp will remember the new location of the form. It will display in that location when you run the project. This is true for any non-modal dialog.
Drag the Background dialog over to the right of the Doodler window now and it will reappear there when you reopen the project next time. (You may have to move the Doodler form to the left.)
(defclass background-palette (color-mixin dialog) ())
(defun background-palette-color-list-on-change (widget new-value old-value) (declare (ignore-if-unused widget new-value old-value)) (when new-value (change-background-color (parent widget))) (not new-value))
(defmethod change-background-color ((palette background-palette)) (let ((color (current-color palette)) (doodler (owner palette))) (setf (background-color (frame-child doodler)) color) (erase-window doodler)))
This is exactly like the button you put on the Coefficients dialog (in Step 10) since background-palette also inherits from the colormixin class.
(defun background-palette-color-button-on-change (widget new-value old-value) (declare (ignore-if-unused widget new-value old-value)) (when new-value (add-other-color (parent widget))) (not new-value))
(defmethod initialize-instance :after ((palette background-palette) &rest initargs) (declare (ignore initargs)) (let* ((pane (frame-child (owner palette))) (color-name (find-color-name palette (or (background-color pane) (default-background-color pane))))) (initialize-value (find-component :color-list palette) (list color-name))))
(defmethod initialize-instance :after ((window doodler) &rest initargs) (declare (ignore initargs)) (show-background-palette window) (select-window window))
(defclass doodler (bitmap-window) ((doodler-curve-dialog :accessor doodler-curve-dialog :initform nil) (doodler-background-palette :initform nil :accessor doodler-background-palette)))
(defmethod show-background-palette ((window doodler)) (let ((palette (doodler-background-palette window))) (unless palette (setq palette (make-background-palette :owner window)) (select-window palette) (setf (doodler-background-palette window) palette)) (select-window palette)))
(defmethod close :before ((window doodler) &key) (let ((curve-dialog (doodler-curve-dialog window)) (background-palette (doodler-background-palette window))) (when (and (windowp curve-dialog) curve-dialog) (close curve-dialog)) (setf (doodler-curve-dialog window) nil) (when (and (windowp background-palette) background-palette) (close background-palette)) (setf (doodler-background-palette window) nil)))
Included with this tutorial is the CLOS chapter from this book. Many thanks to Paul Graham and Prentice Hall for their excellent contribution.
This book introduces Common Lisp with special attention to topics that have grown more important recently including macros, optimization, object-oriented programming, and generating HTML. Included are discussions and examples illustrating unique capabilities of Common Lisp. Finally, it has a 100-page reference manual for ANSI CL that most people find sufficient for everyday use.
Provides a good introduction to CLOS and the use of CLOS in object oriented programming. An advanced book that teaches you how to extend CLOS and design your own language using CLOS.
Designed to introduce Common Lisp to readers who have experience with other programming languages.
An excellent advanced book with many detailed real-world examples. Provides an in-depth exposition of advanced AI programming techniques. It focuses on the programming techniques necessary for building large AI systems, including object-oriented programming. This book also serves as an advanced introduction to Common Lisp, with sections on the Loop macro, CLOS and sequences, and some coverage of error handling, series, and the package facility.
A complete reference for almost-ANSI Common Lisp and CLOS.
An introductory text for readers who want to learn the basics of Common Lisp.
An introductory text on the basics of Common Lisp for non-programmers.
Copyright © 2001-2004 Franz Inc. All rights reserved.
|
Allegro CL version 8.0 |