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

re: clim 1.0 code for displaying bitmap files

    Date: Tue, 7 Apr 1992 11:20 EDT
    From: Greg Siegle <siegle@aristotle.ils.nwu.edu>

    Hi Mark,
       Here's a start at some routines to display xbm bitmaps.
       "load-bmap" takes the filename of an xbm bitmap and spits
    back a list which draw-bitmap can deal with. Draw bitmap 
    is slow but does the trick.
	    -- Greg


Better is to call MAKE-PATTERN on the bitmap to create an ink, using
(LIST +BACKGROUND+ +FOREGROUND+) as the pattern's designs.  Then just
call DRAW-RECTANGLE using that ink.

    ; ******************************************************************
    ;;; routines to use bitmap icons
    ; ******************************************************************

    ;;; use this to create a lisp vector from an x bitmap file.
    ;;; Then cut and paste the result into an icon file.
    (defun load-bmap (&optional (filname nil) &aux d)
      (let ((fname filename))
	(with-open-file
	 (file fname :direction :input)
	 (dotimes (i 50)
		  (push (read-line file nil 'eof) d))
	 (setf d (reverse (remove 'eof d)))))
      (list (third (read-from-string 
		    (format nil "(~A)" (string-trim '(#\#) (first d)))))
	    (third (read-from-string 
		    (format nil "(~A)" (string-trim '(#\#) (second d)))))
	    (mapcar 
	     #'(lambda (s) 
		(read-from-string 
		 (format nil "#~A" (string-left-trim '(#\0) (format nil "~A" s)))))
	     (read-from-string 
	      (remove #\} (remove #\; (remove #\, (format nil "~A" (cdddr d))))))))
      )

    (defun draw-bitmap (stream x y2 btmap &optional (ink clim:+black+) (scale 1) 
			       &aux y xpos bmap bytes)
      (setf y y2)
      (decf y) (setf bmap (copy-tree btmap))
      (setf bytes (round (+ 0.5 (/ (car bmap) 8))))
      (dotimes (i (round (/ (* 8 (length (third bmap))) (car bmap))))
	       (incf y) (setf xpos x)
	       (dotimes (j bytes)
			(let ((curpt (format nil "~8b" (pop (third bmap)))))
			  (unless (or (equal "NIL" curpt) (null curpt))
			   (setf xpos (+ (* 8 scale) xpos))
			   (dotimes (k 8)
				    (decf xpos scale)
				    (when (equal #\1 (elt curpt k))
					  (clim:draw-rectangle* 
					   stream xpos (* y scale)
					   (+ xpos scale) (+ scale (* y scale))
					   :ink ink)))
			   (setf xpos (+ (* 8 scale) xpos)))))))
References:
Main Index | Thread Index