- implemented read-file-to-pixmap and create-pixmap-from-data.
This commit is contained in:
frese
parent
689134ea02
commit
70c363f042
|
|
@ -0,0 +1,114 @@
|
||||||
|
#include "../xlib/xlib.h"
|
||||||
|
#include <X11/xpm.h>
|
||||||
|
|
||||||
|
/*void ExtractColorsymbols(s48_value v, XpmColorSymbols** CS, unsigned int* n) {
|
||||||
|
int i; int len = S48_VECTOR_LENGTH
|
||||||
|
*/
|
||||||
|
|
||||||
|
void Attribs_To_XpmAttributes(s48_value attribs,
|
||||||
|
XpmAttributes* XA) {
|
||||||
|
int i; unsigned long mask = 0;
|
||||||
|
for (i=0; i<9; i++) {
|
||||||
|
s48_value v = S48_VECTOR_REF(attribs, i);
|
||||||
|
if (S48_FALSE != v) {
|
||||||
|
switch (i) {
|
||||||
|
case 0: mask |= XpmVisual;
|
||||||
|
XA->visual = SCX_EXTRACT_VISUAL(v);
|
||||||
|
break;
|
||||||
|
case 1: mask |= XpmColormap;
|
||||||
|
XA->colormap = SCX_EXTRACT_COLORMAP(v);
|
||||||
|
break;
|
||||||
|
case 2: mask |= XpmDepth;
|
||||||
|
XA->depth = s48_extract_integer(v);
|
||||||
|
break;
|
||||||
|
case 3: break; /*mask |= XpmColorSymbols;
|
||||||
|
ExtractColorsymbols(v, XA->colorsymbols, XA->numsymbols);
|
||||||
|
break;*/
|
||||||
|
case 4: mask |= XpmReturnPixels; break;
|
||||||
|
case 5: mask |= XpmExactColors;
|
||||||
|
XA->exactColors = s48_extract_integer(v);
|
||||||
|
break;
|
||||||
|
case 6: mask |= XpmReturnAllocPixels; break;
|
||||||
|
case 7: mask |= XpmAllocCloseColors;
|
||||||
|
XA->alloc_close_colors = s48_extract_integer(v);
|
||||||
|
break;
|
||||||
|
case 8: mask |= XpmBitmapFormat;
|
||||||
|
XA->bitmap_format = s48_extract_integer(v) ? XYBitmap : ZPixmap;
|
||||||
|
break;
|
||||||
|
}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
XA->valuemask = mask;
|
||||||
|
return;
|
||||||
|
}
|
||||||
|
|
||||||
|
s48_value Make_XPM_Result(Pixmap* pixmap, Pixmap* shapemask,
|
||||||
|
XpmAttributes* XA) {
|
||||||
|
|
||||||
|
s48_value res = s48_make_vector(6, S48_FALSE);
|
||||||
|
S48_DECLARE_GC_PROTECT(1);
|
||||||
|
S48_GC_PROTECT_1(res);
|
||||||
|
|
||||||
|
S48_VECTOR_SET(res, 0, SCX_ENTER_PIXMAP(*pixmap));
|
||||||
|
S48_VECTOR_SET(res, 1, s48_cons(s48_enter_integer(XA->width),
|
||||||
|
s48_enter_integer(XA->height)));
|
||||||
|
if (XA->valuemask & XpmHotspot != 0)
|
||||||
|
S48_VECTOR_SET(res, 2, s48_cons(s48_enter_integer(XA->x_hotspot),
|
||||||
|
s48_enter_integer(XA->y_hotspot)));
|
||||||
|
S48_VECTOR_SET(res, 3, SCX_ENTER_PIXMAP(*shapemask));
|
||||||
|
|
||||||
|
S48_GC_UNPROTECT();
|
||||||
|
return res;
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
s48_value scx_Create_Pixmap_From_Data(s48_value Xdisplay, s48_value Xdrawable,
|
||||||
|
s48_value data,
|
||||||
|
s48_value attribute_vector) {
|
||||||
|
Pixmap pixmap, shapemask;
|
||||||
|
XpmAttributes XA;
|
||||||
|
int r, i, n = S48_VECTOR_LENGTH(data);
|
||||||
|
char* d[n];
|
||||||
|
|
||||||
|
for (i=0; i < n; i++)
|
||||||
|
d[i] = s48_extract_string(S48_VECTOR_REF(data, i));
|
||||||
|
|
||||||
|
Attribs_To_XpmAttributes(attribute_vector, &XA);
|
||||||
|
|
||||||
|
r = XpmCreatePixmapFromData( SCX_EXTRACT_DISPLAY(Xdisplay),
|
||||||
|
SCX_EXTRACT_DRAWABLE(Xdrawable),
|
||||||
|
d,
|
||||||
|
&pixmap, &shapemask,
|
||||||
|
&XA );
|
||||||
|
if (r == XpmNoMemory) return s48_enter_integer(0);
|
||||||
|
else if (r == XpmFileInvalid) return s48_enter_integer(1);
|
||||||
|
else if (r == XpmSuccess)
|
||||||
|
return Make_XPM_Result(&pixmap, &shapemask, &XA);
|
||||||
|
}
|
||||||
|
|
||||||
|
s48_value scx_Read_File_To_Pixmap(s48_value Xdisplay, s48_value Xdrawable,
|
||||||
|
s48_value filename,
|
||||||
|
s48_value attribute_vector) {
|
||||||
|
Pixmap pixmap, shapemask;
|
||||||
|
XpmAttributes XA;
|
||||||
|
int r;
|
||||||
|
|
||||||
|
Attribs_To_XpmAttributes(attribute_vector, &XA);
|
||||||
|
|
||||||
|
r = XpmReadFileToPixmap( SCX_EXTRACT_DISPLAY(Xdisplay),
|
||||||
|
SCX_EXTRACT_DRAWABLE(Xdrawable),
|
||||||
|
s48_extract_string(filename),
|
||||||
|
&pixmap, &shapemask,
|
||||||
|
&XA );
|
||||||
|
if (r == XpmNoMemory) return s48_enter_integer(0);
|
||||||
|
else if (r == XpmFileInvalid) return s48_enter_integer(1);
|
||||||
|
else if (r == XpmOpenFailed) return s48_enter_integer(2);
|
||||||
|
else if (r == XpmSuccess)
|
||||||
|
return Make_XPM_Result(&pixmap, &shapemask, &XA);
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
void scx_init_xpm(void) {
|
||||||
|
S48_EXPORT_FUNCTION(scx_Create_Pixmap_From_Data);
|
||||||
|
S48_EXPORT_FUNCTION(scx_Read_File_To_Pixmap);
|
||||||
|
}
|
||||||
|
|
@ -0,0 +1,92 @@
|
||||||
|
; 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 ...))
|
||||||
Loading…
Reference in New Issue