Re: Using a clip mask in CLX

Bill writes:

> Can anyone explain to me how you enter a clip-mask rectangle
> definition in CLX.?  I understand the concept of the clip mask.  What
> I don't understand is how you describe the clip mask.
> 
> The code looks something like
>                             (setf (xlib:gcontext-clip-mask gc) ????)
> 
> What should go where ???? is?

According to the documentation a pixmap or a rect-seq.  I don't know how
it works for pixmaps work yet, but a rect-seq is a flat CL sequence of
x-origin, y-origin, width, height values.

Below is a slightly modified version of the hello-world demo, which you
should be able to call as shown:

> (clipped-hello-world #(0 0 40 40 50 50 40 40))
> (clipped-hello-world (list 0 0 40 40 50 50 40 40))

For this demo you'll have to be in the xlib package; play around with
the window size to see the message within the clip path.

--
RmK

--
(in-package :xlib)

(defun clipped-hello-world (rect-seq &rest args
			    &key (string "Hello World") (font "fixed") (host nil))
  ;; CLX demo, says STRING using FONT in its own window on HOST
  (let ((display nil)
	(abort t))
    (unwind-protect
	(progn 
	  (setq display (open-default-display host))
	  (multiple-value-prog1
	    (let* ((screen (display-default-screen display))
		   (black (screen-black-pixel screen))
		   (white (screen-white-pixel screen))
		   (font (open-font display font))
		   (border 1)			; Minimum margin around the text
		   (width (+ (text-width font string) (* 2 border)))
		   (height (+ (max-char-ascent font) (max-char-descent font) (* 2 border)))
		   (x (truncate (- (screen-width screen) width) 2))
		   (y (truncate (- (screen-height screen) height) 2))
		   (window (create-window :parent (screen-root screen)
					  :x x :y y :width width :height height
					  :background black
					  :border white
					  :border-width 1
					  :colormap (screen-default-colormap screen)
					  :bit-gravity :center
					  :event-mask '(:exposure :button-press)))
		   (gcontext (create-gcontext :drawable window
					      :background black
					      :foreground white
					      :font font))
		   (clipped-gcontext (create-gcontext :drawable window
						      :background black
						      :foreground white
						      :font font)))
	      (setf (gcontext-clip-mask clipped-gcontext) rect-seq)
	      ;; Set window manager hints
	      (set-wm-properties window
				 :name 'hello-world
				 :icon-name string
				 :resource-name string
				 :resource-class 'hello-world
				 :command (list* 'hello-world host args)
				 :x x :y y :width width :height height
				 :min-width width :min-height height
				 :input :off :initial-state :normal)
	      (map-window window)		; Map the window
	      ;; Handle events
	      (event-case (display :discard-p t :force-output-p t)
		(exposure  ;; Come here on exposure events
		  (window count)
		  (when (zerop count) ;; Ignore all but the last exposure event
		    (with-state (window)
		      (let ((x (truncate (- (drawable-width window) width) 2))
			    (y (truncate (- (+ (drawable-height window)
					       (max-char-ascent font))
					    (max-char-descent font))
					 2)))
			;; Draw text centered in widnow
			(clear-area window)
			(draw-rectangles window gcontext rect-seq)
			(draw-glyphs window clipped-gcontext x y string)))
		    ;; Returning non-nil causes event-case to exit
		    nil))
		(button-press () t)))  ;; Pressing any mouse-button exits
	    (setq abort nil)))
      ;; Ensure display is closed when done
      (when display
	(close-display display :abort abort)))))

_______________________________________________
Portable-clx mailing list
[email protected]
http://lists.metacircles.com/cgi-bin/mailman/listinfo/portable-clx
See http://www.cliki.net/clx for darcs URL(s)