; Access to the xpm library

(define-enumerated-type xpm-attribute :xpm-attribute
  xpm-attribute?
  xpm-attributes
  xpm-attribute-name
  xpm-attribute-index
  (visual colormap depth color-symbols return-pixels exact-colors 
   ;closeness rgb-closeness 
   return-alloc-pixels alloc-close-colors
   bitmap-format
   ))

(define (name->string obj)
  (if (symbol? obj)
      (symbol->string obj)
      obj))

(define xpm-attribute-alist->vector
  (make-enum-alist->vector
   xpm-attributes xpm-attribute-index
   (lambda (i)
     (case i
       ((0) visual-Xvisual)
       ((1) colormap-Xcolormap)
       ((2) (lambda (x) x))
       ((3) (lambda (color-symbols)
	      (list->vector
	       (map (lambda (mapping)
		      (list->vector
		       (list (name->string (car mapping))
			     (name->string (cadr mapping))
			     (pixel-Xpixel (caddr mapping)))))
		    color-symbols))))
       ((4 6) (lambda (x) x))
       ((5 7) (lambda (x)
		    (if x 1 0)))
       ((8) (lambda (bitmap-format)
	      (case bitmap-format
		((z-pixmap) 0)
		((xy-bitmap) 1)
		(else (error "illegal bitmap format" bitmap-format)))))
       ))))

(define (make-result display vec)
  (vector-set! vec 0 (make-pixmap (vector-ref vec 0) 
				  display #t))
  (vector-set! vec 3 (make-pixmap (vector-ref vec 3) 
				  display #t))
  (vector->list vec))

(define (create-pixmap-from-data drawable data xpm-attribute-alist)
  (let ((r (%create-pixmap-from-data
	    (display-Xdisplay (drawable-display drawable))
	    (drawable-Xobject drawable)
	    data
	    (xpm-attribute-alist->vector xpm-attribute-alist))))
    (case r
      ((0) (error "Not enough memory!"))
      ((1) (error "Invalid XPM-File data." data))
      (else
       (make-result (drawable-display drawable) r)))))

;-> (pixmap (width . height) (x-hot . y-hot) shape-mask) 

(import-lambda-definition %create-pixmap-from-data
			  (Xdisplay Xdrawable data attribute-vector)
  "scx_Create_Pixmap_From_Data")

;(define (create-data-from-pixmap ...))

(define (read-file-to-pixmap drawable filename xpm-attribute-alist)
  (let ((r (%read-file-to-pixmap
	    (display-Xdisplay (drawable-display drawable))
	    (drawable-Xobject drawable)
	    filename
	    (xpm-attribute-alist->vector xpm-attribute-alist))))
    (case r
      ((0) (error "Not enough memory!"))
      ((1) (error "Invalid XPM-File data." filename))
      ((2) (error "Open failed." filename))
      (else (make-result (drawable-display drawable) r)))))

;-> (pixmap (width . height) (x-hot . y-hot) shape-mask) 


(import-lambda-definition %read-file-to-pixmap
			  (Xdisplay Xdrawable filename attribute-vector)
  "scx_Read_File_To_Pixmap")
  

;(define (write-file-from-pixmap ...))