CLIM mail archive
[Prev][Next][Index][Thread]
further clim questions
Thank you for answering my questions (three weeks ago)
Here are some further questions
I'm using clim1.0 with genera 8.1 and with allegro
1. I have two clim-panes. The first one (*map-pane*) displays a viewport of the
second one (*mapper-pane*). On the *mapper-pane* I print a frame to show which part
of the picture is presented in the *map-pane* (the *map-pane* has got scrollbars).
Both panes use incremental-redisplay.
The description of the frame is a object. This object contains a mark to detect
whether the viewport in the *map-pane* has changed (this is controlled by an after
method to the function "window-set-viewport-position*"). The frame will be displayed
in an updating-output environment with the cache-value "mark".
When I change the viewport of the *map-pane*, the object of the frame will
change correctly, but the frame in the *mapper-pane* don't change.
(In the example at the bottom the frame changes when you click on a displayed section)
What's the way to refresh the display-pane when changing the viewport of the
view-pane?
I tried to save the updating-output-record and to use redisplay in the function
"window-set-viewport-position*". But this failed too.
What is the right way to save an updating-output-record and redisplay it.
2. When using the color +black+ for displaying the sections (see example) and scrolling
the pane the sections will not be refreshed. When moving the cursor over such a not
refreshed line the area will be highlighted correctly.
When using another color e.g. +red+ oll works fine.
3. I (now) use WITH-MENU for displaying some text.
a. When scrolling to the right (example) in the *map-pane*
and displaying some text with "with-menu" clicking on
a section, the pane changes its viewport while deexposing the window
Why??
b. When displaying some text in the window (with-menu) the lines are wrapped around
wrongly. When I use
(clim::window-set-inside-edges WITH_MENU_WINDOW 0 0 500 500)
all works fine. Is there an elegant solution for getting the size of the window
according to the size of the displayed text.
c. How can I create a temporary window with a "deexpose" button which is exposed
as long as the user likes it. The application from which the window was created
should run in parallel.
Rainer
--
Rainer Koenig email: rkoenig@fzi.de
Forschungszentrum Informatik king@fzi.de
Abtl. Technische Expertensysteme und Robotik
Haid-und-Neu-Strasse 10-14 Fax : +49-721-6906-309
D - 7500 Karlsruhe 1 Tel.: +49-721-6906-313
;;;;example tested on genera 8.1 and on allegro with clim1.0
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: COMMON-LISP-USER; Base: 10 -*-
(clim-lisp:defpackage proroad-interface
(:nicknames pi proroad)
#-symbolics
(:shadowing-import-from common-lisp INTERACTIVE-STREAM-P TRUENAME PATHNAME)
#-symbolics
(:use clos clim common-lisp)
#+symbolics
(:use clim clim-lisp)
(:export proroad)
)
(in-package 'proroad-interface)
(defvar *proroad* nil)
(defvar *initial-width* 1000)
(defvar *initial-height* 700)
(defparameter *map-scale* 0.05)
(defparameter *mapper-scale* 0.001)
(defparameter *border-map* nil)
(defparameter *update-card* nil)
(defparameter *update-mini-card* nil)
(defparameter hash-table-sections (make-hash-table :size 30))
(defclass margin-class ()
((left :accessor left
:initform 0)
(top :accessor top
:initform 0)
(right :accessor right
:initform 0)
(bottom :accessor bottom
:initform 0)
(mark :accessor mark
:initform 0)))
(unless *border-map*
(setf *border-map* (make-instance 'margin-class)))
(setq *data* '((1 1233 19856 888 19357)
(2 639 20238 1233 19856)
(3 12219 11047 4901 13284)
(4 4901 13284 888 19357)
(5 4901 13284 3202 10852)
(6 4901 13284 6565 13915)
(7 460 8657 0 9673)
(8 3202 10852 0 9673)
(9 16011 9572 12219 11047)
(10 11953 12957 12219 11047)
(11 12219 11047 12965 9558)
(12 13366 18808 13634 19481)
(13 13366 18808 12851 19150)
(14 12691 18106 13366 18808)
(15 11953 12957 13366 18808)
(16 13634 19481 13090 19750)
(17 12851 19150 13090 19750)
(18 12691 18106 12851 19150)
(19 8463 16864 12691 18106)
(20 16011 9572 15866 7968)
(21 21197 9819 16011 9572)
(22 16910 3855 16582 6260)
(23 12965 9558 16582 6260)
(24 15866 7968 16582 6260)
(25 16910 3855 18846 0)
(26 24318 2431 18846 0)
(27 6565 13915 7673 14777)
(28 7673 14777 8463 16864)
(29 146 20336 639 20238)))
(defparameter *delta-x* 24318)
(defparameter *delta-y* 20336)
(defclass section-class ()
((number :reader number
:initarg :number
:type integer)
(x1 :reader x1
:initarg :x1
:type integer)
(y1 :reader y1
:initarg :y1
:type integer)
(x2 :reader x2
:initarg :x2
:type integer)
(y2 :reader y2
:initarg :y2
:type integer)))
(defun make-sections (number x1 y1 x2 y2)
(setf (gethash number hash-table-sections)
(make-instance 'section-class
:number number
:x1 x1
:y1 y1
:x2 x2
:y2 y2)))
(defun make-all-sections ()
(dolist (item *data*)
(apply #'make-sections item)))
(defmethod display-description (object stream)
(format stream "The selected object has the~%~
following description: .......~%~%"))
(clim::define-application-frame proroad
()
()
(:panes ((title-pane :title
:display-string "PROROAD"
:default-text-style '(:eurex :italic :huge))
(card-pane :application
:scroll-bars :both
:incremental-redisplay t
:display-function 'draw-map)
(mini-card-pane :application
:scroll-bars nil
:incremental-redisplay t
:display-function 'draw-mapper)
(legend-pane :application :scroll-bars :both)
(interaction-pane :interactor)
(command-pane :command-menu)
(documentation-pane :pointer-documentation))
)
(:layout ((default
(:column 1
(title-pane :compute)
(:row :rest
(card-pane :rest)
(:column 1/4
(mini-card-pane 9/16)
(legend-pane :rest)))
(command-pane :compute)
(interaction-pane 1/6)
(documentation-pane :compute)))))
;; (:command-definer T) indicates that we will be defining commands for this frame.
(:command-definer T)
#-symbolics
(:menu-group proroad-menu)
)
(define-presentation-type section ())
(defun present-section-as-line (section stream x1 y1 x2 y2)
(with-output-as-presentation (:type 'section
:object section
:stream stream)
(draw-line* stream x1 y1 x2 y2
:ink +red+)))
(defun present-all-sections (stream scale)
(maphash #'(lambda (number object)
(updating-output (stream :unique-id number
:cache-value scale)
(present-section-as-line object
stream
(x1 object)
(y1 object)
(x2 object)
(y2 object))))
hash-table-sections))
(defmacro my-map (stream scale record
&optional &key (borderp nil) (border-stream t))
`(let ((transform (make-scaling-transformation ,scale ,scale)))
(with-end-of-page-action (:allow ,stream)
(setf ,record
(updating-output (,stream)
(with-drawing-options (,stream :transformation transform)
(present-all-sections ,stream ,scale)
(if ,borderp
(draw-margin-border ,border-stream))))))))
(defun print-map (*map-window*)
(my-map *map-window* *map-scale* *update-card*)
)
(defun print-little-map (*mapper-window*)
(let ((ratio-x 0)
(ratio-y 0))
(multiple-value-bind (width height)
(window-inside-size *mapper-window*)
(setq ratio-x (/ (- width 20) *delta-x*))
(setq ratio-y (/ (- height 20) *delta-y*))
(if (< ratio-x ratio-y)
(setq *mapper-scale* ratio-x)
(setq *mapper-scale* ratio-y))
(my-map *mapper-window* *mapper-scale* *update-mini-card*
:borderp t :border-stream *mapper-window*))))
(define-presentation-type margin ())
(defun compute-viewport-edges-map-pane (stream)
(let ((height (window-inside-height stream))
(width (window-inside-width stream)))
(with-accessors ((left left)
(top top)
(right right)
(bottom bottom)
(mark mark))
*border-map*
(multiple-value-bind (x y)
(window-viewport-position* stream)
(setf left (round (/ x *map-scale*)))
(setf top (round (/ y *map-scale*)))
(setf right (round (/ (+ x width) *map-scale*)))
(setf bottom (round (/ (+ y height) *map-scale*)))
(incf mark)))))
(defun draw-margin-border (mapper)
(draw-margin mapper *border-map*))
(defun draw-margin (stream object)
(updating-output (stream :unique-id object
:cache-value (mark object))
(with-output-as-presentation (:type 'margin
:object object
:stream stream)
(draw-rectangle* stream
(left object)
(top object)
(right object)
(bottom object)
:ink +black+
:filled nil))))
(defmethod window-set-viewport-position* :after (class x y)
(let ((map (get-frame-pane *proroad* 'card-pane)))
(if (eq class
map)
(compute-viewport-edges-map-pane map))))
(defmethod initialize-instance :after ((class proroad) &key)
(let ((map (get-frame-pane class 'card-pane))
(mapper (get-frame-pane class 'mini-card-pane))
(legend (get-frame-pane class 'legend-pane))
)
(make-window-visible-and-empty map)
(make-window-visible-and-empty mapper)
(make-window-visible-and-empty legend)))
(defun make-window-visible-and-empty (stream)
(window-expose stream)
(window-clear stream))
(define-proroad-command (com-quit-proroad :menu "Exit" :name "Exit")
()
(let ((window (frame-top-level-window *application-frame*)))
(window-clear window)
(setf (window-visibility window) nil)
(window-visibility window)
(frame-exit *application-frame*)))
(defmethod draw-mapper ((proroad proroad) stream)
(declare (ignore stream))
(let ((*mapper* (get-frame-pane proroad 'mini-card-pane))
(*map* (get-frame-pane proroad 'card-pane)))
(print-little-map *mapper*)))
(defmethod draw-map ((proroad proroad) stream)
(declare (ignore stream))
(let ((*map* (get-frame-pane proroad 'card-pane)))
(print-map *map*)))
(defmacro print-temporal (object function &optional (only-output t))
`(let ((input (get-frame-pane *application-frame* 'card-pane)))
(labels ((internal-print (stream ptype)
(if ,only-output
(progn
(,function ,object stream)
(format stream "~%~%")
(with-output-as-presentation (:stream stream
:object 'test
:type ptype)
(format stream "Click on me")))
(,function ,object stream :ptype ptype))))
(with-menu (output input)
(clim::window-set-inside-edges output 0 0 500 500)
(menu-choose-from-drawer output 'menu-item #'internal-print)))))
(define-proroad-command (com-show-sections :name "Show Section")
((object 'section :gesture :select))
(print-temporal object display-description))
(defun proroad (&optional (host "ossi"))
(unless *proroad*
(setf *proroad*
(make-application-frame
'proroad
:parent (open-root-window :clx :host host)
:width *initial-width*
:height *initial-height*)))
#-symbolics
(mp:process-run-function "proroad" #'clim:run-frame-top-level *proroad*)
#+symbolics
(process:process-run-function "proroad" #'clim:run-frame-top-level *proroad*)
)
(defun reset (&optional (host "ossi"))
(setf *proroad* nil)
(proroad host))
;;*****************
(make-all-sections)
(reset)
0,,
Main Index |
Thread Index