From 70c363f0429e8d137ff38dd9bdab572380dc0f6c Mon Sep 17 00:00:00 2001 From: frese Date: Mon, 28 Jan 2002 00:21:16 +0000 Subject: [PATCH] - implemented read-file-to-pixmap and create-pixmap-from-data. --- c/libs/xpm.c | 114 ++++++++++++++++++++++++++++++++++++++++++++ scheme/libs/xpm.scm | 92 +++++++++++++++++++++++++++++++++++ 2 files changed, 206 insertions(+) create mode 100644 c/libs/xpm.c create mode 100644 scheme/libs/xpm.scm diff --git a/c/libs/xpm.c b/c/libs/xpm.c new file mode 100644 index 0000000..9b8f593 --- /dev/null +++ b/c/libs/xpm.c @@ -0,0 +1,114 @@ +#include "../xlib/xlib.h" +#include + +/*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); +} diff --git a/scheme/libs/xpm.scm b/scheme/libs/xpm.scm new file mode 100644 index 0000000..d051272 --- /dev/null +++ b/scheme/libs/xpm.scm @@ -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 ...))