CLIM mail archive


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

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

   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 Koenig                                   email:
Forschungszentrum Informatik                 
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)
     (:shadowing-import-from common-lisp INTERACTIVE-STREAM-P TRUENAME PATHNAME)
     (:use clos clim common-lisp)			
     (: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)
  (: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
							 (x1 object)
							 (y1 object)
							 (x2 object)
							 (y2 object))))

(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))
      (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
	(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
			 (,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*
	    :parent (open-root-window :clx :host host)
	    :width *initial-width*
	    :height *initial-height*)))
  (mp:process-run-function "proroad" #'clim:run-frame-top-level *proroad*)
  (process:process-run-function "proroad" #'clim:run-frame-top-level *proroad*)

(defun reset (&optional (host "ossi"))
  (setf *proroad* nil)
  (proroad host))




Main Index | Thread Index