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

re: clim 1.0 code for displaying bitmap files

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


; ******************************************************************
;;; 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)))))))
Follow-Ups:
Main Index | Thread Index