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

Text display problems in CLIM 2 ...

CLIM 2.1, Genera 8.3

I'm including an example. I'm having difficulty precisely isolating
an example, or coming up with anything predictable in my real problem
environment. This example demonstrates that things are at least weird
in some ways similar to my problem environment.

It would be helpful if someone who has another CLIM 2 enviroment could
evaluate this code and see if the demo does the same strange things - or
different ones - or if it all works just fine. Thanks, if you can.

I'm trying to create a stack of cards, the top most of which is visible, and
the remaining are partially obscured - just the tops are visible, showing a
title. The user can click an obscured card and the stack is "rotated" making
is the top card and completely visible. The top card has two pieces of
information displayed on it - two presentations. When the stack is initially
display, everything is fine. The problem I have is that when the stack is
redisplayed to show a different card on top, the first presentation is not
shown (though space is left for it - and the presentation code is called), and
if the second presentation is composed of multiple strings being presented,
only the last of these is presented, though again space is left for the text
not actually printed. The identical code is being called to make the initial
display, but ALL subsequent displays have this damaged appearence.

The example I created is considerably simpler than the code being run, but it
has some similar problems. Look at the comments before the macro
present-within-rectangle and before  text-obkj-pane-display.

In the meantime, I'll likely try using features available in CLIM 2 that were
not present in CLIM 1 and caused me to implement these "sub-panes" - I think I
can do away with them under CLIM 2 and make them full panes.

Here's the example:

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

;;;; FakeTeX Package

(defpackage FakeTeX (:nicknames FT)
	    (:use clim-lisp clim))

(in-package 'FT)


;;;; Fake TeX - my attempt at SIMPLE text formatting for CLIM

(defvar *indentation* 0
  "Current indentation level for HyperTeX objects.")

;;; used to establish a base left margin in device units,
;;; in distinction to an indentation level in characters.
(defvar *left-margin* 0)

;;; works better to put cursor at <0,rectangle-min-y> than
;;; at <rectangle-min-x, rectangle-min-y). In the example,
;;; using the latter results in:
;;; 
;;;   the left sub-pane's text begins slightly to the right
;;;   of the margin, rather than directly at it (as subsequent
;;;   lines in that pane do);
;;;
;;;   the right sub-pane's display, the first line is not
;;;   printed (though room is left for it).
(defmacro present-within-rectangle ((rectangle stream) &body body)
  #+genera (declare (zwei:indentation 0 3 1 1))
  `(progn
     (setf (stream-text-margin ,stream) (rectangle-max-x ,rectangle))
     (setf (stream-cursor-position ,stream)
	   (values
;;;  	     (rectangle-min-x ,rectangle)	; uncomment for above effect ...
  	     0					; and comment out for above effect
	     (rectangle-min-y ,rectangle)))
     (let ((*left-margin* (rectangle-min-x ,rectangle)))
       (with-drawing-options (,stream :clipping-region ,rectangle)
	 ,@body))))

(defmacro fill-and-indent ((stream indentation &optional (fresh-line T)) &body body)
  `(let* ((indent (+ *left-margin*
		       (* ,indentation
			  (clim:stream-character-width ,stream #\M))))
	  (width (- (stream-text-margin ,stream) indent)))
     (clim:indenting-output (,stream `(,indent :pixel))
       (clim:filling-output (,stream :fill-width `(,width :pixel))
	 (when ,fresh-line (fresh-line ,stream))
	 ,@body))))

(clim:define-presentation-type fake-tex-object () :options ((fresh-line T))
  :description "HyperTeX: a formatted text presentation using LaTeX conventions")

;;; Fake-Tex's Printer Function, CLIM-style
(define-presentation-method clim:present (object (type fake-tex-object) stream view &key)
  (let ((*indentation* *indentation*))
    (fake-tex-helper object stream view fresh-line)))

;;; Simplified (e.g. itemize and enumerate are left out)
(defun fake-tex-helper (object stream view &optional (fresh-line T)) 
  (case object
    (\par (format stream "~%~%"))
    (\nl (format stream "~%"))
    (otherwise
      (typecase object
	((string)  (present-string object stream fresh-line))
	((or list cons)
	 (case (first object)
	   (nil          t)
	   (\null        t)
	   ;; other items deleted for simplicity
	   (otherwise
	     (loop for item in object
		   do (fake-tex-helper item stream view)))))
	(otherwise
	  (clim:with-text-style
	    (stream (clim:make-text-style :fix :italic :normal))
	    (format stream "[error:~A]~%" object)))))))

(defun present-string (string stream &optional (fresh-line T))
    (fill-and-indent (stream *indentation* fresh-line)
      (write-string string stream)))


;;;; Text Obj Pane

(defclass text-obj-pane (clim-stream-pane)
    ((left-pane-rect :accessor left-pane-rect)
     (right-pane-rect :accessor right-pane-rect)
     (left-pane-obj :accessor left-pane-obj)
     (right-pane-obj :accessor right-pane-obj)))

(defmethod initialize-rectangles ((pane clim-stream-pane))
  (let* ((pane-width (window-inside-width pane))
	 (pane-height (window-inside-height pane)))
    (setf (left-pane-rect pane)
	  (make-bounding-rectangle 5 5 (- (/ pane-width 2) 5) (- (/ pane-height 2) 5)))
    (setf (right-pane-rect pane)
	  (make-bounding-rectangle (+ (/ pane-width 2) 5) (+ (/ pane-height 2) 5)
				   (- pane-width 5) (- pane-height 5)))))

(defmethod draw-sub-pane (pane rect)
  (multiple-value-bind (left top right bottom)
      (rectangle-edges* rect)
    (draw-rectangle* pane left top right bottom :filled nil)))

;;; Commenting out the superfluous (I think) fresh-line calls below
;;; results in the second presentation being improperly printed:
;;;
;;;   in the left sub-pane, the second presentation is not started
;;;   on a fresh-line (which it should be, if you examine the macro
;;;   fill-and-indent above - which is why I think the additional
;;;   call is superfluous);
;;;
;;;   in the right sub-pane, the second presentation is started on
;;;   its own line, but is arbitrarily shifted to the left (i.e. the
;;;   first few words are dropped off). Commenting out the :clipping-region
;;;   argument in the present-within-rectangle macro does NOT cause
;;;   the "shifted" text to appear to the left of the sub-pane - it is
;;;   simply being ignored.
(defmethod text-obj-pane-display (frame pane)
  (with-slots (left-pane-rect right-pane-rect left-pane-obj right-pane-obj) pane
    (updating-output (pane
		       :cache-value `(,(window-inside-width pane) ,(window-inside-height pane))
		       :cache-test #'equal)
      (initialize-rectangles pane)
      (draw-sub-pane pane left-pane-rect)
      (draw-sub-pane pane right-pane-rect))
    (updating-output (pane :cache-value `(,left-pane-obj ,right-pane-obj) :cache-test #'equal)
      (present-within-rectangle (left-pane-rect pane)
	(present left-pane-obj '((fake-tex-object) :fresh-line nil) :stream pane)
	(fresh-line pane)			; comment out for above effect
 	(present left-pane-obj '((fake-tex-object) :fresh-line nil) :stream pane)
	)					
      (present-within-rectangle (right-pane-rect pane)
	(present right-pane-obj 'fake-tex-object :stream pane)
	(fresh-line pane)			; comment out for above effect
 	(present right-pane-obj 'fake-tex-object :stream pane)
	))))


;;;; Text Obj Pane Test Frame

(define-application-frame text-test-frame () ()
  (:menu-bar T)
  (:panes (text-pane
	     (make-clim-stream-pane
	       :borders nil
	       :scroll-bars nil
	       :display-function 'text-obj-pane-display
	       :type 'text-obj-pane))))

(defvar *obj1* '("(1) This is one string."
		 \nl "(2) This is a second string."
		 \nl "(3) Third string"))

(defvar *obj2* '("(4) This is a string."
		 \nl "(5) This is another string."))

(defun run-it (&optional (obj1 *obj1*) (obj2 *obj2*) (width 400) (height 300))
  (let* ((frame (make-application-frame 'text-test-frame :width width :height height))
	 (pane (get-frame-pane frame 'text-pane)))
    (setf (left-pane-obj pane) obj1)
    (setf (right-pane-obj pane) obj2)
    (run-frame-top-level frame)))

(define-text-test-frame-command (switcheroo :menu T) ()
  (with-slots (left-pane-obj right-pane-obj) (get-frame-pane *application-frame* 'text-pane)
    (rotatef left-pane-obj right-pane-obj)))

(define-text-test-frame-command (exit :menu T) ()
  (frame-exit *application-frame*))
Main Index | Thread Index