From a06dbcc4118b27dd445520ea0ef16d991287c2a5 Mon Sep 17 00:00:00 2001 From: colin <colin> Date: Fri, 20 Oct 1995 17:38:02 +0000 Subject: [PATCH] see ChangeLog.n for Fri Oct 20 10:35:00 PDT 1995 See ChangeLog.n for Fri Oct 20 10:35:00 PDT 1995 See ChangeLog.n for Fri Oct 20 10:35:00 PDT 1995 --- demo/japanese-graphics-editor.lisp | 646 +++++++++++++++++++++++++++++ demo/packages.lisp | 14 +- demo/sysdcl.lisp | 3 +- 3 files changed, 660 insertions(+), 3 deletions(-) create mode 100644 demo/japanese-graphics-editor.lisp diff --git a/demo/japanese-graphics-editor.lisp b/demo/japanese-graphics-editor.lisp new file mode 100644 index 00000000..ce786bad --- /dev/null +++ b/demo/japanese-graphics-editor.lisp @@ -0,0 +1,646 @@ +;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: JAPANESE-GRAPHICS-EDITOR; Base: 10; Lowercase: Yes -*- + +;; $fiHeader: $ + +(in-package :japanese-graphics-editor) + +"Copyright (c) 1992 Symbolics, Inc. All rights reserved. + Portions copyright (c) 1991, 1992 Franz, Inc. All rights reserved." + +(progn + +;;; Define a "mix-in" frame class that manages a selected object + +;;--- This facility is not part of CLIM itself, but is part of a +;;--- graphical editing system that I have been developing privately, +;;--- which I call Zdrava. --SWM + +(define-application-frame selected-object-mixin () + ((selected-object :accessor frame-selected-object + :initform nil)) + (:command-definer nil)) + +(defmethod object-selected-p ((frame selected-object-mixin) object) + (eql object (frame-selected-object frame))) + +;; Deselect the current object and select the new one. Tick the redisplay +;; tick to force the handles to be displayed. +(defmethod select-object ((frame selected-object-mixin) object) + (when (frame-selected-object frame) + (deselect-object frame (frame-selected-object frame))) + (setf (frame-selected-object frame) object) + (tick-object object)) + +;; Deselect the current object and tick the redisplay tick. +(defmethod deselect-object ((frame selected-object-mixin) object) + (setf (frame-selected-object frame) nil) + (tick-object object)) + + +;;; Define the basic object handle class + +;;--- This facility is part of Zdrava. + +(defclass object-handle (standard-point) + ((object :initarg :object :reader handle-object) + (type :initarg :type :reader handle-type))) + +;; Moving a handle causes tha object it is attached to to be reshaped. +(defmethod move-handle ((handle object-handle) x y) + (setf (point-x handle) x) + (setf (point-y handle) y) + (reshape-object (handle-object handle) x y (handle-type handle))) + + +;;; Define the basic object classes + +;;--- This facility is part of Zdrava. + +(defclass basic-object (standard-bounding-rectangle) + ((style :accessor object-style ;all objects have a line style + :initarg :style) + (redisplay-tick :initform 0))) ;redisplay when this changes + +;; Ticking the object causes it to be redisplayed +(defmethod tick-object ((object basic-object)) + (incf (slot-value object 'redisplay-tick))) + +;; All objects participate in redisplay... +(defmethod draw-object :around ((object basic-object) stream) + (updating-output (stream :unique-id object + :cache-value (slot-value object 'redisplay-tick)) + (call-next-method) + (when (object-selected-p *application-frame* object) + (draw-object-handles object stream)))) + +(defmethod draw-object ((object basic-object) stream) + (declare (ignore stream ink))) + +(defmethod draw-object-handles ((object basic-object) stream) + (declare (ignore stream ink))) + +;; For simplicity, moving an object entails moving its bounding box. +(defmethod move-object ((object basic-object) x y) + (multiple-value-bind (width height) (bounding-rectangle-size object) + (clim-utils:bounding-rectangle-set-edges object x y (+ x width) (+ y height)))) + +;; Moving (or reshaping) requires redisplay +(defmethod move-object :after ((object basic-object) x y) + (declare (ignore x y)) + (tick-object object)) + +(defmethod reshape-object :after ((object basic-object) x y type) + (declare (ignore x y type)) + (tick-object object)) + + +(defclass object-with-handles-mixin () + ((handles :initform nil))) + +(defmethod object-handles ((object object-with-handles-mixin)) + (when (null (slot-value object 'handles)) + (setf (slot-value object 'handles) (compute-object-handles object))) + (slot-value object 'handles)) + +(defun make-handle (object x y type) + (make-instance 'object-handle :x x :y y :object object :type type)) + +(defmethod draw-object-handles ((object object-with-handles-mixin) stream) + (dolist (handle (object-handles object)) + (multiple-value-bind (x y) (point-position handle) + ;; Present the object as an OBJECT-HANDLE so that commands in the + ;; application can be written using that presentation type. + (with-output-as-presentation (stream handle 'object-handle) + (draw-rectangle* stream (- x 2) (- y 2) (+ x 2) (+ y 2) + :filled t))))) + +;; Moving (or reshaping) an object changes its handle locations +(defmethod move-object :after ((object object-with-handles-mixin) x y) + (declare (ignore x y)) + (setf (slot-value object 'handles) nil)) + +(defmethod reshape-object :after ((object object-with-handles-mixin) x y type) + (declare (ignore x y type)) + (setf (slot-value object 'handles) nil)) + + +;;; Define the box and arrow classes + +;;--- Using Zdrava, a programmer would build these classes out of the +;;--- classes supplied by Zdrava. + +(defclass box (object-with-handles-mixin basic-object) + ((label :initarg :label :reader box-label) + (arrow-in :initform nil :accessor box-arrow-in) + (arrow-out :initform nil :accessor box-arrow-out) + (shape :initarg :shape :accessor box-shape))) + +(defun make-box (left top right bottom label style &optional (shape :rectangle)) + (make-instance 'box :left left :top top :right right :bottom bottom + :label label :style style :shape shape)) + +(defmethod compute-object-handles ((object box)) + (with-bounding-rectangle* (left top right bottom) object + (list (make-handle object left top :nw) + (make-handle object right top :ne) + (make-handle object left bottom :sw) + (make-handle object right bottom :se)))) + +(defmethod draw-object ((object box) stream) + (with-bounding-rectangle* (left top right bottom) object + ;; Present the object as a BOX so that commands in the application + ;; can be written using that presentation type. + (with-output-as-presentation (stream object 'box :single-box t) + (ecase (box-shape object) + (:oval + (draw-oval* stream + (/ (+ left right) 2) (/ (+ top bottom) 2) + (/ (abs (- right left)) 2) (/ (abs (- bottom top)) 2) + :filled nil :line-style (object-style object))) + (:rectangle + (draw-rectangle* stream left top right bottom + :filled nil :line-style (object-style object)))) + (draw-text* stream + (box-label object) (+ left (floor (- right left) 2)) + (+ top 2) :align-x :center :align-y :top)))) + +#+allegro +(define-presentation-method highlight-presentation ((type box) record stream state) + (declare (ignore state)) + (multiple-value-bind (xoff yoff) + (convert-from-relative-to-absolute-coordinates + stream (output-record-parent record)) + (with-bounding-rectangle* (left top right bottom) record + (draw-rectangle* stream + (+ xoff (- left 3)) (+ yoff (- top 3)) + (+ xoff right 3) (+ yoff bottom 3) + :ink (make-flipping-ink + (if (palette-color-p + (frame-palette (pane-frame stream))) + +red+ + +foreground-ink+) + +background-ink+) + :line-style (make-line-style :thickness 2) + :filled nil)))) + +(defmethod move-object :after ((object box) x y) + (declare (ignore x y)) + (when (box-arrow-in object) + (tick-object (box-arrow-in object))) + (when (box-arrow-out object) + (tick-object (box-arrow-out object)))) + +(defmethod reshape-object ((object box) x y type) + (with-bounding-rectangle* (left top right bottom) object + (ecase type + (:nw (setq left x + top y)) + (:ne (setq right x + top y)) + (:sw (setq left x + bottom y)) + (:se (setq right x + bottom y))) + (clim-utils:bounding-rectangle-set-edges object left top right bottom))) + +(defmethod reshape-object :after ((object box) x y type) + (declare (ignore x y type)) + (when (box-arrow-in object) + (tick-object (box-arrow-in object))) + (when (box-arrow-out object) + (tick-object (box-arrow-out object)))) + + +(defclass arrow (object-with-handles-mixin basic-object) + ((box1 :initarg :box1) + (box2 :initarg :box2))) + +(defun make-arrow (box1 box2 style) + (let ((arrow (make-instance 'arrow :box1 box1 :box2 box2 + :style style))) + (setf (box-arrow-out box1) arrow) + (setf (box-arrow-in box2) arrow) + arrow)) + +(defmethod draw-object ((object arrow) stream) + (with-slots (box1 box2) object + (multiple-value-bind (x1 y1) (bounding-rectangle-center* box1) + (multiple-value-bind (x2 y2) (bounding-rectangle-center* box2) + (with-output-as-presentation (stream object 'arrow) + (draw-arrow* stream x1 y1 x2 y2 + :line-style (object-style object))))))) + +(defmethod compute-object-handles ((object arrow)) + (with-slots (box1 box2) object + (multiple-value-bind (x1 y1) (bounding-rectangle-center* box1) + (multiple-value-bind (x2 y2) (bounding-rectangle-center* box2) + (list (make-handle object x1 y1 nil) + (make-handle object x2 y2 nil)))))) + + +;;; The application itself + +(define-command-table graphics-editor-file-commands) + +(define-command-table graphics-editor-edit-commands + :menu (("取り消し" :command (com-deselect-object)) + ("divide1" :divider nil) + ("クリアー" :command (com-clear)) + ("divide2" :divider nil) + ("再表示" :command (com-redisplay)))) + +(define-command-table graphics-editor-option-commands) + +(define-application-frame graphics-editor (selected-object-mixin) + ((objects :initform nil) + (counter :initform 0) + (last-box :initform nil) + (style :initform (make-line-style :thickness 1 :dashes nil)) + (shape :initform :rectangle)) + (:command-definer define-graphics-editor-command) + (:command-table (graphics-editor + :inherit-from (accept-values-pane + graphics-editor-file-commands + graphics-editor-edit-commands + graphics-editor-option-commands) + :inherit-menu :keystrokes + :menu (("ファイル" :menu graphics-editor-file-commands :mnemonic #\F :documentation "ファイル") + ("編集" :menu graphics-editor-edit-commands :mnemonic #\E ) + ("オプション" :menu graphics-editor-option-commands :mnemonic #\O)))) + (:pointer-documentation t) + ;; Three panes: a display pane, and command menu, and a modeless + ;; dialog containing the line style options + (:panes + (display :application + :incremental-redisplay t + :display-after-commands t + :display-function 'display-objects + :scroll-bars :both + :initial-cursor-visibility nil) + (horizontal-options :accept-values + :min-height :compute :height :compute :max-height :compute + :display-function + `(accept-values-pane-displayer + :displayer ,#'(lambda (frame stream) + (accept-graphics-editor-options + frame stream + :orientation :horizontal)))) + (vertical-options :accept-values + :min-width :compute :width :compute :max-width :compute + :display-function + `(accept-values-pane-displayer + :displayer ,#'(lambda (frame stream) + (accept-graphics-editor-options + frame stream + :orientation :vertical))))) + (:layouts + (default + (vertically () + horizontal-options + (:fill display))) + (other + (horizontally () + vertical-options + (:fill display))))) + +(defmethod frame-menu-translator-documentation ((frame graphics-editor)) + "メニュー") + +(defmethod frame-pointer-buttons-documentation ((frame graphics-editor)) + '("左" "中" "右")) + +(defmethod frame-modifier-keys-documentation ((frame graphics-editor)) + '("h" "s" "m" "c" "sh")) + +(defmethod read-frame-command ((frame graphics-editor) &key (stream *standard-input*)) + (read-command (frame-command-table frame) :use-keystrokes t :stream stream)) + +;;; Presentation types + +(define-presentation-type line-thickness () + :inherit-from `((completion (1 2 3 4)) + :name-key identity + :printer present-line-thickness + :highlighter highlight-line-thickness)) + +(define-presentation-method describe-presentation-type ((type line-thickness) stream plural-count) + (declare (ignore plural-count)) + (write-string "太さ" stream)) + +(defun present-line-thickness (object stream &key acceptably) + (declare (ignore acceptably)) + (let ((y (stream-line-height stream))) + (with-room-for-graphics (stream) + (draw-rectangle* stream 0 2 16 (- y 2) + :filled nil :ink +background-ink+) + (draw-line* stream 0 (floor y 2) 16 (floor y 2) + :line-thickness object)))) + +(defun highlight-line-thickness (continuation object stream) + (surrounding-output-with-border (stream) + (funcall continuation object stream))) + +(define-presentation-type line-style-type () + :inherit-from `((completion (:solid :dashed)) + :name-key identity + :printer present-line-style + :highlighter highlight-line-style)) + +(define-presentation-method describe-presentation-type ((type line-style-type) stream plural-count) + (declare (ignore plural-count)) + (write-string "ラインタイプ" stream)) + +(defun present-line-style (object stream &key acceptably) + (declare (ignore acceptably)) + (let ((y (stream-line-height stream))) + (with-room-for-graphics (stream) + (draw-rectangle* stream 0 2 16 (- y 2) + :filled nil :ink +background-ink+) + (draw-line* stream 0 (floor y 2) 16 (floor y 2) + :line-dashes (and (eq object :dashed) + #(2 2)))))) + +(defun highlight-line-style (continuation object stream) + (surrounding-output-with-border (stream) + (funcall continuation object stream))) + +(define-presentation-type-abbreviation object-shape () + '((member :oval :rectangle) :name-key identity + :printer present-object-shape + :highlighter highlight-object-shape)) + +(define-presentation-type object-shape () + :inherit-from `((completion (:oval :rectangle)) + :name-key identity + :printer present-object-shape + :highlighter highlight-object-shape)) + +(define-presentation-method describe-presentation-type ((type object-shape) stream plural-count) + (declare (ignore plural-count)) + (write-string "形" stream)) + +(defun present-object-shape (object stream &key acceptably) + (declare (ignore acceptably)) + (let ((y (stream-line-height stream))) + (multiple-value-bind (left top bottom right) + (values 0 2 16 (- y 2)) + (with-room-for-graphics (stream) + (ecase object + (:rectangle + (draw-rectangle* stream left top (* 2 bottom) (* 2 right) :filled nil)) + (:oval + (draw-oval* stream + (/ (+ left right) 2) + (/ (+ top bottom) 2) + (/ (abs (- right left)) 2) + (/ (abs (- bottom top)) 2) :filled nil))))))) + +(defun highlight-object-shape (continuation object stream) + (surrounding-output-with-border (stream) + (funcall continuation object stream))) + +(defmethod accept-graphics-editor-options ((frame graphics-editor) stream + &key (orientation :horizontal)) + (with-slots (style shape) frame + (flet ((accept (stream type default prompt query-id) + (let (object ptype changed) + (formatting-cell (stream :align-x (ecase orientation + (:horizontal :center) + (:vertical :left))) + (multiple-value-setq (object ptype changed) + (accept type + :stream stream :default default + :query-identifier query-id :prompt prompt))) + ptype + (values object changed)))) + (declare (dynamic-extent #'accept)) + (terpri stream) + (formatting-table (stream :x-spacing '(3 :character)) + (flet ((do-body (stream) + (let ((thickness (line-style-thickness style)) + (dashes (line-style-dashes style))) + (multiple-value-bind (thickness thickness-changed) + (accept stream 'line-thickness thickness + "太さ" 'thickness) + (declare (ignore ignore)) + (multiple-value-bind (dashes dashes-changed) + (accept stream 'line-style-type (if dashes :dashed :solid) + "ラインタイプ" 'dashes) + (declare (ignore ignore)) + (setq dashes (eq dashes :dashed)) + (multiple-value-bind (new-shape shape-changed) + (accept stream 'object-shape shape + "形" 'shape) + (when (or thickness-changed dashes-changed shape-changed) + (setq style (make-line-style :thickness thickness + :dashes dashes)) + (setq shape new-shape) + (when (frame-selected-object frame) + (setf (object-style (frame-selected-object frame)) + (slot-value frame 'style)) + (setf (box-shape (frame-selected-object frame)) + (slot-value frame 'shape)) + (tick-object (frame-selected-object frame)) + (redisplay-frame-pane frame 'display))))))))) + (ecase orientation + (:horizontal + (formatting-row (stream) (do-body stream))) + (:vertical + (formatting-column (stream) (do-body stream))))))))) + +(defmethod display-objects ((frame graphics-editor) stream) + (dolist (object (slot-value frame 'objects)) + (draw-object object stream))) + +(define-graphics-editor-command (com-ボックスの成作) + ((left 'integer) + (top 'integer)) + (com-deselect-object) + (let ((stream (get-frame-pane *application-frame* 'display)) + (right left) + (bottom top) + (rectangle-drawn nil) + (box nil) + (label (format nil "ボックス ~D" (slot-value *application-frame* 'counter))) + (last-box (slot-value *application-frame* 'last-box)) + (style (slot-value *application-frame* 'style)) + (shape (slot-value *application-frame* 'shape)) + (flipping-ink #+allegro (make-flipping-ink + (if (palette-color-p + (frame-palette *application-frame*)) + +blue+ + +foreground-ink+) + +background-ink+) + #-allegro +flipping-ink+)) + ;;--- Zdrava supplies primitives to input basic objects such as + ;;--- points, lines, rectangles and polygons, circles and ellipses, + ;;--- and so forth. Using Zdrava, the following code would be a + ;;--- replaced by 3 or 4 lines of code. + (block track-pointer + (with-output-recording-options (stream :draw t :record nil) + (tracking-pointer (stream :multiple-window t) + (:pointer-motion (window x y) + (when rectangle-drawn + (draw-rectangle* stream left top right bottom + :filled nil :ink flipping-ink) + (setq rectangle-drawn nil)) + (when (eql window stream) + (setq right x + bottom y) + (draw-rectangle* stream left top right bottom + :filled nil :ink flipping-ink) + (setq rectangle-drawn t))) + (:pointer-button-release (event) + (when (eql (event-sheet event) stream) + (when rectangle-drawn + (draw-rectangle* stream left top right bottom + :filled nil :ink flipping-ink) + (setq rectangle-drawn nil)) + ;; If the mouse didn't move very far, don't bother + ;; creating a box. Just deselect the current object. + (when (or (> (abs (- right left)) 3) + (> (abs (- bottom top)) 3)) + (multiple-value-bind (width height) + (text-size stream label) + (when (< (- right left) width) + (setq right (+ left width 8))) + (when (< (- bottom top) height) + (setq bottom (+ top height 4)))) + (setq box (make-box left top right bottom label style shape)) + (return-from track-pointer))) + (beep stream) + (return-from com-ボックスの成作))))) + (when box + (setf (slot-value *application-frame* 'objects) + (append (slot-value *application-frame* 'objects) (list box))) + (setf (slot-value *application-frame* 'last-box) box) + (incf (slot-value *application-frame* 'counter)) + (when last-box + (let ((arrow (make-arrow last-box box style))) + (setf (slot-value *application-frame* 'objects) + (append (slot-value *application-frame* 'objects) (list arrow)))))))) + +;; A mouse click over blank area creates a new box. +(define-presentation-to-command-translator create-box + (blank-area com-ボックスの成作 graphics-editor + :gesture :select :menu nil) + (x y) + (list x y)) + +;; Select an object by clicking "select" (Mouse-Left) on it. +(define-graphics-editor-command com-ボックスの選択 + ((object 'box :gesture :select)) + (select-object *application-frame* object) + (setf (slot-value *application-frame* 'style) (object-style object) + (slot-value *application-frame* 'shape) (box-shape object))) + +;; Deselect an object by clicking the Deselect menu button, or by +;; clicking over blank area without moving the mouse. +(define-command (com-deselect-object :command-table graphics-editor-edit-commands + :menu ("取り消し" + :documentation "選択したボックスをキャンセルする。")) + () + (when (frame-selected-object *application-frame*) + (deselect-object *application-frame* (frame-selected-object *application-frame*)))) + +;; Move an object by clicking Mouse-Middle on it and dragging the mouse. +(define-graphics-editor-command com-ボックスの移動 + ((object 'box :gesture :describe)) + (let ((stream (get-frame-pane *application-frame* 'display))) + (with-bounding-rectangle* (left top right bottom) object + (multiple-value-bind (x y dx dy) + (dragging-output (stream :repaint t :finish-on-release t) + ;; Use a rectangle as feedback + (draw-rectangle* stream left top right bottom + :filled nil)) + (move-object object (- x dx) (- y dy)))))) + +;; Delete an object by clicking "delete" (shift-Mouse-Middle) on it. +(define-graphics-editor-command com-delete-object + ((object 'basic-object :gesture :delete)) + (delete-object *application-frame* object) + (when (eql object (slot-value *application-frame* 'last-box)) + (setf (slot-value *application-frame* 'last-box) nil))) + +(defmethod delete-object ((frame graphics-editor) (object basic-object)) + (setf (slot-value frame 'objects) + (delete object (slot-value frame 'objects)))) + +(defmethod delete-object :after ((frame graphics-editor) (object box)) + (when (box-arrow-in object) + (delete-object frame (box-arrow-in object))) + (when (box-arrow-out object) + (delete-object frame (box-arrow-out object)))) + +(defmethod delete-object :after ((frame graphics-editor) (object arrow)) + (with-slots (box1 box2) object + (setf (box-arrow-out box1) nil) + (setf (box-arrow-in box2) nil))) + +;; Add a menu item that deletes the selected object +(add-menu-item-to-command-table 'graphics-editor "削除" + :function 'delete-selected-object + :keystroke '(#\d :control)) + +(defun delete-selected-object (gesture numeric-arg) + (declare (ignore gesture numeric-arg)) + (and (frame-selected-object *application-frame*) + `(com-delete-object ,(frame-selected-object *application-frame*)))) + +;; Move a handle by clicking Mouse-Middle on it and dragging the mouse. +(define-graphics-editor-command com-move-handle + ((handle 'object-handle :gesture :describe)) + (let ((stream (get-frame-pane *application-frame* 'display))) + (multiple-value-bind (x y) (point-position handle) + (multiple-value-bind (x y dx dy) + (dragging-output (stream :repaint t :finish-on-release t) + (draw-rectangle* stream (- x 2) (- y 2) (+ x 2) (+ y 2) + :filled t)) + (move-handle handle (- x dx) (- y dy)))))) + +;; OK, I added a menu button to clear the window. +(define-command (com-clear :command-table + graphics-editor-edit-commands + :keystroke (#\\ :control) + :menu ("クリアー" + :documentation "スクリーンをクリヤーにする。")) + () + (with-slots (objects selected-object last-box) *application-frame* + (setq objects nil + selected-object nil + last-box nil) + (window-clear (get-frame-pane *application-frame* 'display)))) + +;; OK, I added a menu button to redisplay the window, too, although +;; it's only here for debugging. +(define-command (com-redisplay :command-table graphics-editor-edit-commands + :keystroke (:r :meta) + :menu ("再表示" + :documentation + "ボックスをもう一度表示する")) + + () + (redisplay-frame-pane *application-frame* 'display :force-p t)) + +(define-command (com-quit :command-table graphics-editor-file-commands + :keystroke (:x :meta) + :menu ("閉じる" :documentation "プログラムを終了します。")) () + (frame-exit *application-frame*)) + +(define-command (com-change-layout :command-table graphics-editor-option-commands + :keystroke (:l :meta) + :menu ("レイアウトの選択" + :documentation "レイアウトの選択")) + () + (let ((layouts (frame-all-layouts *application-frame*))) + (setf (frame-current-layout *application-frame*) + (or (second (member (frame-current-layout *application-frame*) layouts)) + (car layouts))))) + + + + +(define-demo "グラフ編集" graphics-editor + :left 100 :top 100 :width 800 :height 500) + +) ;; progn diff --git a/demo/packages.lisp b/demo/packages.lisp index 5847844b..f13de87a 100644 --- a/demo/packages.lisp +++ b/demo/packages.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: packages.lisp,v 1.9 92/10/07 14:43:42 cer Exp $ +;; $fiHeader: packages.lisp,v 1.11 1994/06/08 06:56:41 duane Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) @@ -17,7 +17,7 @@ #+(and allegro (not (version>= 4 1))) with-slots dynamic-extent non-dynamic-extent) - (:export + (:export *demo-root* define-demo start-demo)) @@ -33,6 +33,16 @@ #+(and allegro (not (version>= 4 1))) with-slots dynamic-extent non-dynamic-extent)) +#+ics +(#-ansi-90 clim-lisp::defpackage #+ansi-90 defpackage japanese-graphics-editor + (:use clim-lisp clim clim-demo) + + (:shadowing-import-from clim-utils + defun + flet labels + defgeneric defmethod + #+(and allegro (not (version>= 4 1))) with-slots + dynamic-extent non-dynamic-extent)) (#-ansi-90 clim-lisp::defpackage #+ansi-90 defpackage clim-browser diff --git a/demo/sysdcl.lisp b/demo/sysdcl.lisp index 725faa27..e054880c 100644 --- a/demo/sysdcl.lisp +++ b/demo/sysdcl.lisp @@ -1,6 +1,6 @@ ;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Package: CL-USER; Base: 10; Lowercase: Yes -*- -;; $fiHeader: sysdcl.lisp,v 1.21 1993/07/27 01:46:08 colin Exp $ +;; $fiHeader: sysdcl.lisp,v 1.23 1994/11/23 23:28:39 smh Exp $ (in-package #-ansi-90 :user #+ansi-90 :common-lisp-user) @@ -23,6 +23,7 @@ ("plot" (:load-before-compile "demo-driver" "packages")) ("color-editor" (:load-before-compile "demo-driver" "packages")) ("graphics-editor" (:load-before-compile "demo-driver" "packages")) + #+ics ("japanese-graphics-editor" (:load-before-compile "demo-driver" "packages")) ("bitmap-editor" (:load-before-compile "demo-driver" "packages")) ("ico" (:load-before-compile "demo-driver" "packages")) ("browser" (:load-before-compile "demo-driver" "packages")) -- GitLab