CLIM mail archive
[Prev][Next][Index][Thread]

REPLAY-OUTPUT-RECORD question -- bitmap editor example

    Date: Wed, 13 Jul 1994 11:02 PDT
    From: Scott McKay <swm@harlequin.com>

       Date: Fri, 1 Jul 1994 11:19-0700
       From: Gregory M Anderson <gma@BITTERROOT.apl.washington.edu>
       Character-Type-Mappings: (1 0 (NIL 0) (:FIX :ITALIC :NORMAL) "CPTFONTI")
				(2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")
       Fonts: CPTFONT, CPTFONTI, CPTFONTI

       Can you tell me if convert-from-relative-to-absolute-coordinates and 
       output-record-position are working correctly?  If they are, what is the
       right way to compute an output record's position in order to redisplay 
       it?

    If you have the Symbolics CLIM 2.0/2.1 manual, check out the examples
    on page 370.

I have -- and I've tried that code exactly, calling 
(map-over-output-record-tree #'(lambda (x) (clim::redisplay x stream)) record)
to implement selected redisplay -- without luck.

The following code captures the essence of the redisplay question.  The application
is like a bitmap editor.  If you run it the way it is, clicking on a box toggles 
the color, but the redisplay doesn't change it's display.  If you uncomment 
the ;; REMOVE lines in the functions draw-data-navigator-display and 
highlite-spot, the redisplay works, but why must the redisplay do so much work 
(i.e. take so much time).  And why must the redisplay operate on the 
output-record-parent instead of the output-record itself?
(By the way, I've tried all sorts of other combinations of redisplay on records
and parents.)





;;; -*- Mode: LISP; Syntax: Common-lisp; Package: :USER; Base: 10 -*-

(defpackage :fast-table
  (:use CLIM-LISP CLIM))

(in-package :fast-table)

(defun table (&key (port (clim:find-port)))
  (let*
    ((framem (find-frame-manager :port port))
     (frame (make-application-frame 'table-frame
				    :pretty-name "ASAPS Frame"
				    :frame-manager framem
				    :height 800
				    :width 800
				    )))
    (run-frame-top-level frame)))


(define-application-frame table-frame ()
    ((cache :initform (make-array '(10 40) :initial-element nil)
	    :accessor cache))
  (:command-table (table-frame :inherit-from (accept-values-pane)))
  (:panes 
    (title-nav   :title
		 :display-string "Data Navigator")
    (nav         :application
		 :name :navigation
		 :display-function 'draw-data-navigator-display
		 :incremental-redisplay nil	;Supplies outermost updating-output for nav pane
		 :display-after-commands nil
		 :scroll-bars :both
		 :end-of-page-action :scroll
		 :initial-cursor-visibility :inactive
		 )
    (pointer     :pointer-documentation)
    (menu     :command-menu))
  (:menu-bar nil)				; Suppress menu bar at the top
  (:layouts
    (default
      (vertically ()
	(.05 title-nav)				;(:compute title-nav)
	(:fill nav)
	(.05 menu)				;(:compute menu)
	(.04 pointer)				;(:compute pointer)
	))))


(define-table-frame-command (com-exit-table-frame
				:menu "Exit"
				:name "Exit table formatter")
    ()
  (frame-exit *application-frame*)
  )

(defclass spot ()
    ((beam :initarg :beam)
     (ping :initarg :ping)
     (x-scaled
       :initarg :x-scaled)
     (x-size
       :initarg :x-size)
     (y-scaled
       :initarg :y-scaled)
     (y-size
       :initarg :y-size)
     (color
       :initarg :color
       :accessor color)
     (output-record
       :initform nil
       :accessor output-record)
     )
  )

(defclass data-navigator-view (textual-view) ())
(defparameter +data-navigator-view+ (make-instance 'data-navigator-view))

(defvar *standard-gray*
	      +green+
	      )

(defmethod draw-data-navigator-display ((frame table-frame) stream)
  (updating-output (stream)
    (with-translation (stream 20 20)
    (stream-set-cursor-position stream 0 0)
      (loop with cache = (cache frame)
	    for sector from 0 below (elt (array-dimensions cache) 0)
	    with y-size = 10
	    for y-scaled = (* sector y-size)
	    do
	(loop for beam from 0 below (elt (array-dimensions cache) 1)
	      with x-size = 10
	      for x-scaled = (* beam x-size)
	      for spot = (if (aref cache sector beam)
			     (aref cache sector beam)
			     (setf (aref cache sector beam)
				   (make-instance 'spot :beam beam :ping sector
						  :x-scaled x-scaled :y-scaled y-scaled
						  :x-size x-size :y-size y-size :color *standard-gray*)))
	      do
	  (setf (output-record spot)
;; REMOVE		(UPDATING-OUTPUT (STREAM)
		  (updating-output (stream :unique-id spot :cache-value (color spot))
		    (present spot (type-of spot) 
			     :stream stream :view +data-navigator-view+))
;; REMOVE		  )
		  ))))))

(define-table-frame-command (highlite-spot :name "Show")
			    ((spot 'spot) (stream 'application-pane))
  (if (eq (color spot) *standard-gray*)
      (setf (color spot) +red+)
      (setf (color spot) *standard-gray*))
  (multiple-value-bind (x-offset y-offset)
      (convert-from-relative-to-absolute-coordinates
	stream (output-record-parent (output-record spot)))
    (with-translation (stream x-offset y-offset)
		      (redisplay 
;; REMOVE	(output-record-parent
			(output-record spot)
;; REMOVE	  )
		stream)
		      ))  )

(define-presentation-to-command-translator highlite-spot
    (spot highlite-spot table-frame
	  :gesture :select
	  :pointer-documentation ((stream object)
				  (format-loc stream (if (typep object 'Spot) "Open" "Show") object))
	  )
    (object window)
  `(,object ,window))

(define-presentation-method present
			    (spot (type spot) stream
				  (view data-navigator-view) &key)
  (with-slots (x-scaled x-size y-scaled y-size color) spot
    (let ((adj (if (eq color *standard-gray*) -1 0)))
      (draw-rectangle* stream x-scaled y-scaled (+ x-scaled x-size adj) (+ y-scaled y-size adj)
		       :filled t :ink color)
      )))

(defmethod format-loc (stream string (object spot))
  (with-slots (x-scaled y-scaled beam ping) object
    (format stream "~:(~A (beam ~d ping ~d) ~A ~A~)" string (1+ beam) (1+ ping)
	    (second (assoc (color object) `((,+red+ "red") (,+green+ "green"))))
	    (type-of object))))

(table)
Follow-Ups: References:
Main Index | Thread Index