From: Chris Hanson Date: Tue, 23 Jul 1991 08:18:07 +0000 (+0000) Subject: Editing of X11 image, visual, and colormap support to regularize X-Git-Tag: 20090517-FFI~10437 X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=29343da7c5fd0f563883ee3f249e912ea71ef439;p=mit-scheme.git Editing of X11 image, visual, and colormap support to regularize interface, provide better type and error checking, and simplify handling of colormaps by associating a display object with them. Requires runtime 14.126 or later. --- diff --git a/v7/src/microcode/version.h b/v7/src/microcode/version.h index eed775714..2c42a268c 100644 --- a/v7/src/microcode/version.h +++ b/v7/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.88 1991/07/12 23:18:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/Attic/version.h,v 11.89 1991/07/23 08:18:07 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -46,5 +46,5 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 88 +#define SUBVERSION 89 #endif diff --git a/v7/src/microcode/x11.h b/v7/src/microcode/x11.h index 530a2a737..592452370 100644 --- a/v7/src/microcode/x11.h +++ b/v7/src/microcode/x11.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11.h,v 1.9 1991/07/02 18:18:29 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11.h,v 1.10 1991/07/23 08:16:09 cph Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -52,6 +52,8 @@ struct xdisplay #define XD_CACHED_EVENT_P(xd) ((xd) -> cached_event_p) #define XD_TO_OBJECT(xd) (LONG_TO_UNSIGNED_FIXNUM (XD_ALLOCATION_INDEX (xd))) +extern struct xdisplay * EXFUN (x_display_arg, (unsigned int arg)); + struct drawing_attributes { /* Width of the borders, in pixels. */ @@ -164,28 +166,62 @@ struct xwindow #define FONT_WIDTH(f) (((f) -> max_bounds) . width) #define FONT_HEIGHT(f) (((f) -> ascent) + ((f) -> descent)) #define FONT_BASE(f) ((f) -> ascent) + +extern struct xwindow * EXFUN (x_window_arg, (unsigned int arg)); struct ximage { unsigned int allocation_index; - XImage *image; + XImage * image; }; #define XI_ALLOCATION_INDEX(xi) ((xi) -> allocation_index) -#define XI_IMAGE(xi) ((xi -> image)) +#define XI_IMAGE(xi) ((xi) -> image) +#define X_IMAGE_TO_OBJECT(image) \ + (LONG_TO_UNSIGNED_FIXNUM (allocate_x_image (image))) -#define XI_TO_OBJECT(xi) (LONG_TO_UNSIGNED_FIXNUM (XI_ALLOCATION_INDEX (xi))) +extern struct ximage * EXFUN (x_image_arg, (unsigned int arg)); +extern unsigned int EXFUN (allocate_x_image, (XImage * image)); +extern void EXFUN (deallocate_x_image, (struct ximage * xi)); + +struct xvisual +{ + unsigned int allocation_index; + Visual * visual; +}; + +#define XV_ALLOCATION_INDEX(xv) ((xv) -> allocation_index) +#define XV_VISUAL(xv) ((xv) -> visual) +#define X_VISUAL_TO_OBJECT(visual) \ + (LONG_TO_UNSIGNED_FIXNUM (allocate_x_visual (visual))) + +extern struct xvisual * EXFUN (x_visual_arg, (unsigned int arg)); +extern unsigned int EXFUN (allocate_x_visual, (Visual * visual)); +extern void EXFUN (deallocate_x_visual, (struct xvisual * xv)); + +struct xcolormap +{ + unsigned int allocation_index; + Colormap colormap; + struct xdisplay * xd; +}; + +#define XCM_ALLOCATION_INDEX(xcm) ((xcm) -> allocation_index) +#define XCM_COLORMAP(xcm) ((xcm) -> colormap) +#define XCM_XD(xcm) ((xcm) -> xd) +#define X_COLORMAP_TO_OBJECT(colormap, xd) \ + (LONG_TO_UNSIGNED_FIXNUM (allocate_x_colormap ((colormap), (xd)))) +#define XCM_DISPLAY(xcm) (XD_DISPLAY (XCM_XD (xcm))) + +extern struct xcolormap * EXFUN (x_colormap_arg, (unsigned int arg)); +extern unsigned int EXFUN + (allocate_x_colormap, (Colormap colormap, struct xdisplay * xd)); +extern void EXFUN (deallocate_x_colormap, (struct xcolormap * xcm)); -#define XV_TO_OBJECT(xv) (LONG_TO_UNSIGNED_FIXNUM (xv)) - extern int x_debug; -extern struct xdisplay * EXFUN (x_display_arg, (unsigned int arg)); -extern struct xwindow * EXFUN (x_window_arg, (unsigned int arg)); -extern struct ximage * EXFUN (x_image_arg, (unsigned int arg)); extern PTR EXFUN (x_malloc, (unsigned int size)); extern PTR EXFUN (x_realloc, (PTR ptr, unsigned int size)); -extern SCHEME_OBJECT EXFUN (x_window_to_object, (struct xwindow * xw)); extern char * EXFUN (x_get_default, @@ -210,6 +246,3 @@ extern struct xwindow * EXFUN struct drawing_attributes * attributes, struct xwindow_methods * methods, unsigned int extra)); - -extern Visual * EXFUN (x_visual_arg, (unsigned int arg)); -extern struct ximage * EXFUN (x_image_arg, (unsigned int arg)); diff --git a/v7/src/microcode/x11base.c b/v7/src/microcode/x11base.c index 329365d7e..156125bf3 100644 --- a/v7/src/microcode/x11base.c +++ b/v7/src/microcode/x11base.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.22 1991/07/02 18:18:34 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.23 1991/07/23 08:16:24 cph Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -79,6 +79,7 @@ static struct allocation_table x_display_table; static struct allocation_table x_window_table; static struct allocation_table x_image_table; static struct allocation_table x_visual_table; +static struct allocation_table x_colormap_table; static void DEFUN (allocation_table_initialize, (table), struct allocation_table * table) @@ -124,7 +125,7 @@ DEFUN (allocate_table_index, (table, item), (table -> length) = new_length; return (length); } - + static PTR DEFUN (allocation_item_arg, (arg, table), unsigned int arg AND @@ -158,12 +159,19 @@ DEFUN (x_image_arg, (arg), unsigned int arg) return (allocation_item_arg (arg, (&x_image_table))); } -Visual * +struct xvisual * DEFUN (x_visual_arg, (arg), unsigned int arg) { INITIALIZE_ONCE (); return (allocation_item_arg (arg, (&x_visual_table))); } + +struct xcolormap * +DEFUN (x_colormap_arg, (arg), unsigned int arg) +{ + INITIALIZE_ONCE (); + return (allocation_item_arg (arg, (&x_colormap_table))); +} static int DEFUN (x_io_error_handler, (display), Display * display) @@ -1201,28 +1209,56 @@ DEFINE_PRIMITIVE ("X-WINDOW-SET-ICON-NAME", Prim_x_window_set_icon_name, 2, 2, PRIMITIVE_RETURN (UNSPECIFIC); } -/* Support routines for visual and image handling */ +unsigned int +DEFUN (allocate_x_image, (image), XImage * image) +{ + struct ximage * xi = (x_malloc (sizeof (struct ximage))); + unsigned int index = (allocate_table_index ((&x_image_table), xi)); + (XI_ALLOCATION_INDEX (xi)) = index; + (XI_IMAGE (xi)) = image; + return (index); +} + +void +DEFUN (deallocate_x_image, (xi), struct ximage * xi) +{ + ((x_image_table . items) [XI_ALLOCATION_INDEX (xi)]) = 0; + free (xi); +} -extern unsigned int allocate_x_window (xw) -struct xwindow * xw; -{ return allocate_table_index((&x_window_table), xw); +unsigned int +DEFUN (allocate_x_visual, (visual), Visual * visual) +{ + struct xvisual * xv = (x_malloc (sizeof (struct xvisual))); + unsigned int index = (allocate_table_index ((&x_visual_table), xv)); + (XV_ALLOCATION_INDEX (xv)) = index; + (XV_VISUAL (xv)) = visual; + return (index); } -extern unsigned int allocate_x_visual (xv) -Visual * xv; -{ return allocate_table_index((&x_visual_table), xv); +void +DEFUN (deallocate_x_visual, (xv), struct xvisual * xv) +{ + ((x_visual_table . items) [XV_ALLOCATION_INDEX (xv)]) = 0; + free (xv); } -extern unsigned int allocate_x_image (xi) -struct ximage * xi; -{ return allocate_table_index((&x_image_table), xi); +unsigned int +DEFUN (allocate_x_colormap, (colormap, xd), + Colormap colormap AND + struct xdisplay * xd) +{ + struct xcolormap * xcm = (x_malloc (sizeof (struct xcolormap))); + unsigned int index = (allocate_table_index ((&x_colormap_table), xcm)); + (XCM_ALLOCATION_INDEX (xcm)) = index; + (XCM_COLORMAP (xcm)) = colormap; + (XCM_XD (xcm)) = xd; + return (index); } -void x_destroy_image (xi) -struct ximage * xi; -{ XImage * image = XI_IMAGE (xi); - ((x_image_table . items) [XI_ALLOCATION_INDEX (xi)]) = 0; - free (image -> data); - XDestroyImage (image); - free (xi); +void +DEFUN (deallocate_x_colormap, (xcm), struct xcolormap * xcm) +{ + ((x_colormap_table . items) [XCM_ALLOCATION_INDEX (xcm)]) = 0; + free (xcm); } diff --git a/v7/src/microcode/x11color.c b/v7/src/microcode/x11color.c index dbd10932b..f2efab427 100644 --- a/v7/src/microcode/x11color.c +++ b/v7/src/microcode/x11color.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11color.c,v 1.2 1991/07/11 03:57:36 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11color.c,v 1.3 1991/07/23 08:16:51 cph Exp $ Copyright (c) 1991 Massachusetts Institute of Technology @@ -37,74 +37,75 @@ MIT in each case. */ #include "scheme.h" #include "prims.h" #include "x11.h" - -extern unsigned int allocate_x_visual (); -DEFINE_PRIMITIVE("X-GET-WINDOW-ATTRIBUTES", Prim_x_get_window_attributes, 1, 1, 0) -{ PRIMITIVE_HEADER(1); - { XWindowAttributes attrs; - struct xwindow * xw = x_window_arg(1); - - if (XGetWindowAttributes(XW_DISPLAY(xw), XW_WINDOW(xw), &attrs) == 0) - { PRIMITIVE_RETURN (SHARP_F); - } - else - { SCHEME_OBJECT Result = allocate_marked_vector(TC_VECTOR, 23, true); - VECTOR_SET(Result, 0, long_to_integer(attrs.x)); - VECTOR_SET(Result, 1, long_to_integer(attrs.y)); - VECTOR_SET(Result, 2, long_to_integer(attrs.width)); - VECTOR_SET(Result, 3, long_to_integer(attrs.height)); - VECTOR_SET(Result, 4, long_to_integer(attrs.border_width)); - VECTOR_SET(Result, 5, long_to_integer(attrs.depth)); - VECTOR_SET(Result, 6, XV_TO_OBJECT(allocate_x_visual(attrs.visual))); - VECTOR_SET(Result, 7, long_to_integer(attrs.root)); - VECTOR_SET(Result, 8, long_to_integer(attrs.class)); - VECTOR_SET(Result, 9, long_to_integer(attrs.bit_gravity)); - VECTOR_SET(Result, 10, long_to_integer(attrs.win_gravity)); - VECTOR_SET(Result, 11, long_to_integer(attrs.backing_store)); - VECTOR_SET(Result, 12, long_to_integer(attrs.backing_planes)); - VECTOR_SET(Result, 13, long_to_integer(attrs.backing_pixel)); - VECTOR_SET(Result, 14, BOOLEAN_TO_OBJECT(attrs.save_under)); - VECTOR_SET(Result, 15, long_to_integer(attrs.colormap)); - VECTOR_SET(Result, 16, BOOLEAN_TO_OBJECT(attrs.map_installed)); - VECTOR_SET(Result, 17, long_to_integer(attrs.map_state)); - VECTOR_SET(Result, 18, long_to_integer(attrs.all_event_masks)); - VECTOR_SET(Result, 19, long_to_integer(attrs.your_event_mask)); - VECTOR_SET(Result, 20, long_to_integer(attrs.do_not_propagate_mask)); - VECTOR_SET(Result, 21, BOOLEAN_TO_OBJECT(attrs.override_redirect)); - VECTOR_SET(Result, 22, - long_to_integer(XScreenNumberOfScreen(attrs.screen))); - PRIMITIVE_RETURN(Result); +DEFINE_PRIMITIVE ("X-GET-WINDOW-ATTRIBUTES", Prim_x_get_window_attributes, 1, 1, 0) +{ + PRIMITIVE_HEADER(1); + { + struct xwindow * xw = (x_window_arg (1)); + XWindowAttributes a; + if (! (XGetWindowAttributes ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&a)))) + error_external_return (); + { + SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 23, true)); + VECTOR_SET (result, 0, (long_to_integer (a . x))); + VECTOR_SET (result, 1, (long_to_integer (a . y))); + VECTOR_SET (result, 2, (long_to_integer (a . width))); + VECTOR_SET (result, 3, (long_to_integer (a . height))); + VECTOR_SET (result, 4, (long_to_integer (a . border_width))); + VECTOR_SET (result, 5, (long_to_integer (a . depth))); + VECTOR_SET (result, 6, (X_VISUAL_TO_OBJECT (a . visual))); + VECTOR_SET (result, 7, (long_to_integer (a . root))); + VECTOR_SET (result, 8, (long_to_integer (a . class))); + VECTOR_SET (result, 9, (long_to_integer (a . bit_gravity))); + VECTOR_SET (result, 10, (long_to_integer (a . win_gravity))); + VECTOR_SET (result, 11, (long_to_integer (a . backing_store))); + VECTOR_SET (result, 12, (long_to_integer (a . backing_planes))); + VECTOR_SET (result, 13, (long_to_integer (a . backing_pixel))); + VECTOR_SET (result, 14, (BOOLEAN_TO_OBJECT (a . save_under))); + VECTOR_SET (result, 15, + (X_COLORMAP_TO_OBJECT ((a . colormap), (XW_XD (xw))))); + VECTOR_SET (result, 16, (BOOLEAN_TO_OBJECT (a . map_installed))); + VECTOR_SET (result, 17, (long_to_integer (a . map_state))); + VECTOR_SET (result, 18, (long_to_integer (a . all_event_masks))); + VECTOR_SET (result, 19, (long_to_integer (a . your_event_mask))); + VECTOR_SET (result, 20, (long_to_integer (a . do_not_propagate_mask))); + VECTOR_SET (result, 21, (BOOLEAN_TO_OBJECT (a . override_redirect))); + VECTOR_SET (result, 22, + (long_to_integer (XScreenNumberOfScreen (a . screen)))); + PRIMITIVE_RETURN (result); } } } + +/* Visuals */ -DEFINE_PRIMITIVE("X-GET-DEFAULT-VISUAL", Prim_x_get_default_visual, 2, 2, 0) -/* Inputs: (Scheme window and #F) or (Scheme display and screen number) - Returns: Scheme visual -*/ -{ PRIMITIVE_HEADER(2); - { Display *dpy; - long ScreenNumber; - Visual *answer; +DEFINE_PRIMITIVE ("X-GET-DEFAULT-VISUAL", Prim_x_get_default_visual, 2, 2, 0) +{ + PRIMITIVE_HEADER (2); + PRIMITIVE_RETURN + (X_VISUAL_TO_OBJECT + (XDefaultVisual ((XD_DISPLAY (x_display_arg (1))), (arg_integer (2))))); +} - if (ARG_REF(2) == SHARP_F) - { struct xwindow * xw = x_window_arg (1); - XWindowAttributes attrs; - - dpy = XW_DISPLAY(xw); - XGetWindowAttributes(dpy, XW_WINDOW(xw), &attrs); - ScreenNumber = XScreenNumberOfScreen(attrs.screen); - } - else - { struct xdisplay * xd = x_display_arg (1); - ScreenNumber = arg_integer(2); - dpy = XD_DISPLAY(xd); - } - answer = XDefaultVisual(dpy, ScreenNumber); - PRIMITIVE_RETURN(XV_TO_OBJECT(allocate_x_visual(answer))); +DEFINE_PRIMITIVE ("X-WINDOW-VISUAL", Prim_x_window_visual, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + { + struct xwindow * xw = (x_window_arg (1)); + XWindowAttributes a; + if (! (XGetWindowAttributes ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&a)))) + error_external_return (); + PRIMITIVE_RETURN (X_VISUAL_TO_OBJECT (a . visual)); } } + +DEFINE_PRIMITIVE ("X-VISUAL-DEALLOCATE", Prim_x_visual_deallocate, 1, 1, 0) +{ + PRIMITIVE_HEADER (1); + deallocate_x_visual (x_visual_arg (1)); + PRIMITIVE_RETURN (UNSPECIFIC); +} DEFINE_PRIMITIVE("X-GET-VISUAL-INFO", Prim_x_get_visual_info, 10, 10, 0) /* Inputs: Scheme window or display @@ -176,7 +177,7 @@ DEFINE_PRIMITIVE("X-GET-VISUAL-INFO", Prim_x_get_visual_info, 10, 10, 0) Result = allocate_marked_vector (TC_VECTOR, AnswerCount, false); for (i=0, ThisVI=VIList; i < AnswerCount; i++, ThisVI++) { This_Vector = allocate_marked_vector(TC_VECTOR, 10, false); - VECTOR_SET(This_Vector, 0, XV_TO_OBJECT(allocate_x_visual(ThisVI->visual))); + VECTOR_SET(This_Vector, 0, (X_VISUAL_TO_OBJECT (ThisVI->visual))); VECTOR_SET(This_Vector, 1, long_to_integer((long) ThisVI->visualid)); VECTOR_SET(This_Vector, 2, long_to_integer(ThisVI->screen)); VECTOR_SET(This_Vector, 3, long_to_integer(ThisVI->depth)); @@ -193,176 +194,134 @@ DEFINE_PRIMITIVE("X-GET-VISUAL-INFO", Prim_x_get_visual_info, 10, 10, 0) } } -DEFINE_PRIMITIVE("X-GET-DEFAULT-COLORMAP", Prim_x_get_default_colormap, 2, 2, 0) -{ /* Input: (Scheme) display, screen number */ +/* Colormaps */ + +DEFINE_PRIMITIVE ("X-GET-DEFAULT-COLORMAP", Prim_x_get_default_colormap, 2, 2, + "Given DISPLAY and SCREEN-NUMBER, return default colormap for screen.") +{ PRIMITIVE_HEADER (2); - PRIMITIVE_RETURN( - long_to_integer( - XDefaultColormap(XD_DISPLAY(x_display_arg(1)), arg_integer(2)))); + { + struct xdisplay * xd = (x_display_arg (1)); + PRIMITIVE_RETURN + (X_COLORMAP_TO_OBJECT + ((XDefaultColormap ((XD_DISPLAY (xd)), (arg_integer (2)))), xd)); + } } -DEFINE_PRIMITIVE("X-PARSE-COLOR", Prim_x_parse_color, 3, 3, 0) -{ /* Input: (Scheme) display, colormap, string - Output: vector of pixel, red, green, blue - */ - PRIMITIVE_HEADER (3); - { XColor TheColor; - if (XParseColor(XD_DISPLAY(x_display_arg(1)), - arg_integer(2), STRING_ARG(3), &TheColor) == 0) - { PRIMITIVE_RETURN(SHARP_F); - } - else - { SCHEME_OBJECT Result; - - Result = allocate_marked_vector(TC_VECTOR, 4, true); - VECTOR_SET(Result, 0, long_to_integer(TheColor.pixel)); - VECTOR_SET(Result, 1, long_to_integer(TheColor.red)); - VECTOR_SET(Result, 2, long_to_integer(TheColor.green)); - VECTOR_SET(Result, 3, long_to_integer(TheColor.blue)); - PRIMITIVE_RETURN(Result); - } +DEFINE_PRIMITIVE ("X-WINDOW-COLORMAP", Prim_x_window_colormap, 1, 1, + "Return WINDOW's colormap.") +{ + PRIMITIVE_HEADER (1); + { + struct xwindow * xw = (x_window_arg (1)); + XWindowAttributes a; + if (! (XGetWindowAttributes ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&a)))) + error_external_return (); + PRIMITIVE_RETURN (X_COLORMAP_TO_OBJECT ((a . colormap), (XW_XD (xw)))); } } -DEFINE_PRIMITIVE("X-CREATE-COLORMAP", Prim_x_create_colormap, 3, 3, 0) -{ /* Input: (Scheme) window, (Scheme) Visual, Allocate? */ - - PRIMITIVE_HEADER(3); - { struct xwindow * xw = x_window_arg (1); - Display * dpy = XW_DISPLAY(xw); - Visual * v = x_visual_arg (2); - SCHEME_OBJECT Allocate = BOOLEAN_ARG (3); - - PRIMITIVE_RETURN( - long_to_integer(XCreateColormap(dpy, XW_WINDOW(xw), v, Allocate))); - } +DEFINE_PRIMITIVE ("X-SET-WINDOW-COLORMAP", Prim_x_set_window_colormap, 2, 2, + "Set WINDOW's colormap to COLORMAP.") +{ + PRIMITIVE_HEADER (2); + { + struct xwindow * xw = (x_window_arg (1)); + XSetWindowColormap ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), + (XCM_COLORMAP (x_colormap_arg (2)))); + } + PRIMITIVE_RETURN (UNSPECIFIC); } -DEFINE_PRIMITIVE("X-COPY-COLORMAP-AND-FREE", Prim_x_copy_colormap_and_free, 2, 2, 0) -{ /* Input: (Scheme) display, colormap */ - PRIMITIVE_HEADER(2); - PRIMITIVE_RETURN( - long_to_integer( - XCopyColormapAndFree(XD_DISPLAY(x_display_arg(1)), arg_integer(2)))); +DEFINE_PRIMITIVE ("X-CREATE-COLORMAP", Prim_x_create_colormap, 3, 3, + "Given WINDOW, and VISUAL, create and return a colormap.\n\ +If third arg WRITEABLE is true, returned colormap may be modified.") +{ + PRIMITIVE_HEADER (3); + { + struct xwindow * xw = (x_window_arg (1)); + PRIMITIVE_RETURN + (X_COLORMAP_TO_OBJECT + ((XCreateColormap ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), + (XV_VISUAL (x_visual_arg (2))), (BOOLEAN_ARG (3)))), + (XW_XD (xw)))); + } } -DEFINE_PRIMITIVE("X-SET-WINDOW-COLORMAP", Prim_x_set_window_colormap, 2, 2, 0) -{ /* Input: (Scheme) window, colormap */ - struct xwindow * xw = x_window_arg (1); - - PRIMITIVE_HEADER(2); - XSetWindowColormap(XW_DISPLAY(xw), XW_WINDOW(xw), arg_integer(2)); - PRIMITIVE_RETURN(UNSPECIFIC); +DEFINE_PRIMITIVE ("X-COPY-COLORMAP-AND-FREE", Prim_x_copy_colormap_and_free, 1, 1, + "Return a new copy of COLORMAP.") +{ + PRIMITIVE_HEADER (1); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + PRIMITIVE_RETURN + (X_COLORMAP_TO_OBJECT + ((XCopyColormapAndFree ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)))), + (XCM_XD (xcm)))); + } } -DEFINE_PRIMITIVE("X-FREE-COLORMAP", Prim_x_free_colormap, 2, 2, 0) -{ /* Input: (Scheme) display, colormap */ - PRIMITIVE_HEADER (2); - XFreeColormap(XD_DISPLAY(x_display_arg(1)), arg_integer(2)); - PRIMITIVE_RETURN(UNSPECIFIC); +DEFINE_PRIMITIVE ("X-FREE-COLORMAP", Prim_x_free_colormap, 1, 1, + "Deallocate COLORMAP.") +{ + PRIMITIVE_HEADER (1); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + XFreeColormap ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm))); + deallocate_x_colormap (xcm); + } + PRIMITIVE_RETURN (UNSPECIFIC); } -DEFINE_PRIMITIVE("X-ALLOCATE-COLOR", Prim_x_allocate_color, 5, 5, 0) -{ /* Input: (Scheme) display, colormap, red, green, blue - Returns: vector with pixel, red, green, blue - */ - XColor ColorObj; - SCHEME_OBJECT Result; - - PRIMITIVE_HEADER(5); - ColorObj.red = arg_integer(3); - ColorObj.green = arg_integer(4); - ColorObj.blue = arg_integer(5); - XAllocColor(XD_DISPLAY(x_display_arg(1)), arg_integer(2), &ColorObj); - Result = allocate_marked_vector(TC_VECTOR, 4, true); - VECTOR_SET(Result, 0, long_to_integer(ColorObj.pixel)); - VECTOR_SET(Result, 1, long_to_integer(ColorObj.red)); - VECTOR_SET(Result, 2, long_to_integer(ColorObj.green)); - VECTOR_SET(Result, 3, long_to_integer(ColorObj.blue)); - PRIMITIVE_RETURN(Result); -} +#define ARG_RGB_VALUE(argno) (arg_index_integer ((argno), 65536)) -DEFINE_PRIMITIVE("X-ALLOCATE-NAMED-COLOR", Prim_x_allocate_named_color, 3, 3, 0) -{ /* Input: (Scheme) display, colormap, name - Returns: vector of closest pixel, red, green, blue - exact pixel, red, green, blue - */ - - SCHEME_OBJECT Result; - XColor Exact, Closest; - - PRIMITIVE_HEADER(3); - XAllocNamedColor(XD_DISPLAY(x_display_arg (1)), - arg_integer(2), STRING_ARG(3), &Exact, &Closest); - Result = allocate_marked_vector(TC_VECTOR, 8, true); - VECTOR_SET(Result, 0, long_to_integer(Closest.pixel)); - VECTOR_SET(Result, 1, long_to_integer(Closest.red)); - VECTOR_SET(Result, 2, long_to_integer(Closest.green)); - VECTOR_SET(Result, 3, long_to_integer(Closest.blue)); - VECTOR_SET(Result, 4, long_to_integer(Exact.pixel)); - VECTOR_SET(Result, 5, long_to_integer(Exact.red)); - VECTOR_SET(Result, 6, long_to_integer(Exact.green)); - VECTOR_SET(Result, 7, long_to_integer(Exact.blue)); - PRIMITIVE_RETURN(Result); -} - -DEFINE_PRIMITIVE("X-LOOKUP-COLOR", Prim_x_lookup_color, 3, 3, 0) -{ /* Input: (Scheme) display, colormap, name - Returns: vector of closest pixel, red, green, blue - exact pixel, red, green, blue - */ - - SCHEME_OBJECT Result; - XColor Exact, Closest; - long Stat; - - PRIMITIVE_HEADER(3); - Stat = XAllocNamedColor(XD_DISPLAY(x_display_arg (1)), - arg_integer(2), STRING_ARG(3), &Exact, &Closest); - if (Stat == 0) - { PRIMITIVE_RETURN (SHARP_F); - } - else - { Result = allocate_marked_vector(TC_VECTOR, 8, true); - VECTOR_SET(Result, 0, long_to_integer(Closest.pixel)); - VECTOR_SET(Result, 1, long_to_integer(Closest.red)); - VECTOR_SET(Result, 2, long_to_integer(Closest.green)); - VECTOR_SET(Result, 3, long_to_integer(Closest.blue)); - VECTOR_SET(Result, 4, long_to_integer(Exact.pixel)); - VECTOR_SET(Result, 5, long_to_integer(Exact.red)); - VECTOR_SET(Result, 6, long_to_integer(Exact.green)); - VECTOR_SET(Result, 7, long_to_integer(Exact.blue)); - PRIMITIVE_RETURN(Result); +DEFINE_PRIMITIVE ("X-ALLOCATE-COLOR", Prim_x_allocate_color, 4, 4, 0) +{ + /* Input: colormap, red, green, blue + Returns: pixel, or #F if unable to allocate color cell. */ + PRIMITIVE_HEADER (4); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + XColor c; + (c . red) = (ARG_RGB_VALUE (2)); + (c . green) = (ARG_RGB_VALUE (3)); + (c . blue) = (ARG_RGB_VALUE (4)); + PRIMITIVE_RETURN + ((XAllocColor ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), (&c))) + ? (long_to_integer (c . pixel)) + : SHARP_F); } } - -DEFINE_PRIMITIVE ("X-STORE-COLOR", Prim_x_store_color, 6, 6, - "Input: (Scheme) display, colormap, pixel, r, g, b (r/g/b may be #f).") -{ - XColor c; - PRIMITIVE_HEADER (6); - (c . pixel) = (arg_nonnegative_integer (3)); - (c . flags) = 0; - if ((ARG_REF (4)) != SHARP_F) - { - (c . red) = (arg_index_integer (4, 65536)); - (c . flags) |= DoRed; - } - if ((ARG_REF (5)) != SHARP_F) - { - (c . green) = (arg_index_integer (5, 65536)); - (c . flags) |= DoGreen; - } - if ((ARG_REF (6)) != SHARP_F) - { - (c . blue) = (arg_index_integer (6, 65536)); - (c . flags) |= DoBlue; - } - XStoreColor ((XD_DISPLAY (x_display_arg (1))), (arg_integer (2)), (&c)); +DEFINE_PRIMITIVE ("X-STORE-COLOR", Prim_x_store_color, 5, 5, + "Input: colormap, pixel, r, g, b (r/g/b may be #f).") +{ + PRIMITIVE_HEADER (5); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + XColor c; + (c . pixel) = (arg_nonnegative_integer (2)); + (c . flags) = 0; + if ((ARG_REF (3)) != SHARP_F) + { + (c . red) = (arg_index_integer (3, 65536)); + (c . flags) |= DoRed; + } + if ((ARG_REF (4)) != SHARP_F) + { + (c . green) = (arg_index_integer (4, 65536)); + (c . flags) |= DoGreen; + } + if ((ARG_REF (5)) != SHARP_F) + { + (c . blue) = (arg_index_integer (5, 65536)); + (c . flags) |= DoBlue; + } + XStoreColor ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), (&c)); + } PRIMITIVE_RETURN (UNSPECIFIC); } - + #define CONVERT_COLOR_OBJECT(index, color, flag) \ { \ SCHEME_OBJECT object = (VECTOR_REF (color_object, (index))); \ @@ -380,13 +339,14 @@ DEFINE_PRIMITIVE ("X-STORE-COLOR", Prim_x_store_color, 6, 6, } \ } -DEFINE_PRIMITIVE ("X-STORE-COLORS", Prim_x_store_colors, 3, 3, - "Input: (Scheme) display, colormap, vector of vectors, each of\n\ +DEFINE_PRIMITIVE ("X-STORE-COLORS", Prim_x_store_colors, 2, 2, + "Input: colormap, vector of vectors, each of\n\ which contains pixel, r, g, b (where r/g/b can be #f or integer).") { - PRIMITIVE_HEADER (3); + PRIMITIVE_HEADER (2); { - SCHEME_OBJECT color_vector = (VECTOR_ARG (3)); + struct xcolormap * xcm = (x_colormap_arg (1)); + SCHEME_OBJECT color_vector = (VECTOR_ARG (2)); unsigned long n_colors = (VECTOR_LENGTH (color_vector)); XColor * colors = (dstack_alloc ((sizeof (XColor)) * n_colors)); { @@ -416,91 +376,171 @@ which contains pixel, r, g, b (where r/g/b can be #f or integer).") colors_scan += 1; } } - XStoreColors - ((XD_DISPLAY (x_display_arg (1))), - (arg_integer (2)), - colors, - n_colors); + XStoreColors ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), colors, n_colors); } PRIMITIVE_RETURN (UNSPECIFIC); } -DEFINE_PRIMITIVE("X-STORE-NAMED-COLOR", Prim_x_store_named_color, 7, 7, 0) -{ /* Input: (Scheme) display, colormap, color name, pixel, DoRed, DoGreen, - DoBlue */ - PRIMITIVE_HEADER(7); - { long flags = 0; - if (BOOLEAN_ARG(5)) flags |= DoRed; - if (BOOLEAN_ARG(6)) flags |= DoGreen; - if (BOOLEAN_ARG(7)) flags |= DoBlue; - XStoreNamedColor(XD_DISPLAY(x_display_arg(1)), arg_integer(2), - STRING_ARG(3), arg_integer(4), flags); +DEFINE_PRIMITIVE ("X-FREE-COLORS", Prim_x_free_colors, 1, -1, 0) +{ + /* Input: colormap, pixel ... */ + PRIMITIVE_HEADER (LEXPR); + if ((LEXPR_N_ARGUMENTS ()) < 1) + signal_error_from_primitive (ERR_WRONG_NUMBER_OF_ARGUMENTS); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + unsigned int n_pixels = ((LEXPR_N_ARGUMENTS ()) - 1); + unsigned long * pixels = + (dstack_alloc ((sizeof (unsigned long)) * n_pixels)); + unsigned int i; + for (i = 0; (i < n_pixels); i += 1) + (pixels[i]) = (arg_integer (i + 2)); + XFreeColors ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), + pixels, n_pixels, 0); } PRIMITIVE_RETURN(UNSPECIFIC); } -DEFINE_PRIMITIVE("X-FREE-COLORS", Prim_x_free_colors, 2, -1, 0) -{ /* Input: (Scheme) display, colormap, pixel ... */ - PRIMITIVE_HEADER(LEXPR); - { long npixels = (LEXPR_N_ARGUMENTS()) - 2; - long * First_Pixel = (long *) Free; - long i, *This_Pixel; +DEFINE_PRIMITIVE ("X-QUERY-COLOR", Prim_x_query_color, 2, 2, 0) +{ + /* Input: colormap, pixel + Output: vector of red, green, blue */ + PRIMITIVE_HEADER (2); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 3, true)); + XColor c; + c . pixel = (arg_integer (2)); + XQueryColor ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), (&c)); + VECTOR_SET (result, 0, (long_to_integer (c . red))); + VECTOR_SET (result, 1, (long_to_integer (c . green))); + VECTOR_SET (result, 2, (long_to_integer (c . blue))); + PRIMITIVE_RETURN (result); + } +} - Primitive_GC_If_Needed (npixels); - for (i=0, This_Pixel=First_Pixel; i < npixels; i++) - { *This_Pixel++ = integer_to_long(ARG_REF(i+3)); +DEFINE_PRIMITIVE ("X-QUERY-COLORS", Prim_x_query_colors, 1, -1, 0) +{ + /* Input: colormap, pixel ... + Output: a vector of vectors, each with #(red, green, blue) */ + PRIMITIVE_HEADER (LEXPR); + if ((LEXPR_N_ARGUMENTS ()) < 1) + signal_error_from_primitive (ERR_WRONG_NUMBER_OF_ARGUMENTS); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + unsigned int n_colors = ((LEXPR_N_ARGUMENTS ()) - 1); + XColor * colors = (dstack_alloc ((sizeof (XColor)) * n_colors)); + unsigned int i; + for (i = 0; (i < n_colors); i += 1) + ((colors[i]) . pixel) = (arg_integer (i + 2)); + XQueryColors ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), colors, n_colors); + { + SCHEME_OBJECT result = + (allocate_marked_vector (TC_VECTOR, n_colors, true)); + for (i = 0; (i < n_colors); i += 1) + { + SCHEME_OBJECT cv = (allocate_marked_vector (TC_VECTOR, 3, true)); + VECTOR_SET (cv, 0, (long_to_integer ((colors[i]) . red))); + VECTOR_SET (cv, 1, (long_to_integer ((colors[i]) . green))); + VECTOR_SET (cv, 2, (long_to_integer ((colors[i]) . blue))); + VECTOR_SET (result, i, cv); + } + PRIMITIVE_RETURN (result); } - XFreeColors(XD_DISPLAY(x_display_arg(1)), arg_integer(2), - ((unsigned long *) First_Pixel), npixels, 0); } - PRIMITIVE_RETURN(UNSPECIFIC); } + +/* Named colors */ -DEFINE_PRIMITIVE("X-QUERY-COLOR", Prim_x_query_color, 3, 3, 0) -{ /* Input: (Scheme) display, colormap, pixel - Output: vector of red, green, blue +DEFINE_PRIMITIVE ("X-PARSE-COLOR", Prim_x_parse_color, 2, 2, 0) +{ /* Input: colormap, string + Output: vector of pixel, red, green, blue */ - PRIMITIVE_HEADER(3); - { XColor ThisColor; - SCHEME_OBJECT Result = allocate_marked_vector(TC_VECTOR, 3, true); - - ThisColor.pixel = arg_integer(3); - XQueryColor(XD_DISPLAY(x_display_arg(1)), arg_integer(2), &ThisColor); - VECTOR_SET(Result, 0, long_to_integer(ThisColor.red)); - VECTOR_SET(Result, 1, long_to_integer(ThisColor.green)); - VECTOR_SET(Result, 2, long_to_integer(ThisColor.blue)); - PRIMITIVE_RETURN(Result); + PRIMITIVE_HEADER (2); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + XColor TheColor; + if (! (XParseColor ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), + (STRING_ARG (2)), (&TheColor)))) + PRIMITIVE_RETURN (SHARP_F); + { + SCHEME_OBJECT result = (allocate_marked_vector (TC_VECTOR, 4, true)); + VECTOR_SET(result, 0, long_to_integer(TheColor.pixel)); + VECTOR_SET(result, 1, long_to_integer(TheColor.red)); + VECTOR_SET(result, 2, long_to_integer(TheColor.green)); + VECTOR_SET(result, 3, long_to_integer(TheColor.blue)); + PRIMITIVE_RETURN (result); + } } } - -DEFINE_PRIMITIVE("X-QUERY-COLORS", Prim_x_query_colors, 2, -1, 0) -{ /* Input: (Scheme) display, colormap, pixel ... - Output: a vector of vectors, each with (red, green, blue) + +DEFINE_PRIMITIVE ("X-ALLOCATE-NAMED-COLOR", Prim_x_allocate_named_color, 2, 2, 0) +{ /* Input: colormap, name + Returns: vector of closest pixel, red, green, blue + exact pixel, red, green, blue */ - PRIMITIVE_HEADER(LEXPR); - { long npixels = (LEXPR_N_ARGUMENTS()) - 2; - XColor * First_Color = (XColor *) Free; - long i; - XColor *This_Color; - SCHEME_OBJECT Result, *Next_Result; + SCHEME_OBJECT Result; + XColor Exact, Closest; + struct xcolormap * xcm; + PRIMITIVE_HEADER (2); - Primitive_GC_If_Needed(npixels * (BYTES_TO_WORDS(sizeof(XColor)))); - for (i=0, This_Color=First_Color; i < npixels; i++, This_Color++) - { This_Color->pixel = integer_to_long(ARG_REF(i+3)); - } - Free = (SCHEME_OBJECT *) This_Color; - XQueryColors(XD_DISPLAY(x_display_arg(1)), arg_integer(2), - First_Color, npixels); - Result = allocate_marked_vector(TC_VECTOR, npixels, true); - for (i=0, This_Color=First_Color, Next_Result=VECTOR_LOC(Result, 0); - i < npixels; i++, This_Color++) - { SCHEME_OBJECT This_Vector = allocate_marked_vector(TC_VECTOR, 3, true); - *Next_Result++ = This_Vector; - VECTOR_SET(This_Vector, 0, long_to_integer(This_Color->red)); - VECTOR_SET(This_Vector, 1, long_to_integer(This_Color->green)); - VECTOR_SET(This_Vector, 2, long_to_integer(This_Color->blue)); - } - PRIMITIVE_RETURN(Result); + xcm = (x_colormap_arg (1)); + XAllocNamedColor + ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), + (STRING_ARG (2)), &Exact, &Closest); + Result = allocate_marked_vector(TC_VECTOR, 8, true); + VECTOR_SET(Result, 0, long_to_integer(Closest.pixel)); + VECTOR_SET(Result, 1, long_to_integer(Closest.red)); + VECTOR_SET(Result, 2, long_to_integer(Closest.green)); + VECTOR_SET(Result, 3, long_to_integer(Closest.blue)); + VECTOR_SET(Result, 4, long_to_integer(Exact.pixel)); + VECTOR_SET(Result, 5, long_to_integer(Exact.red)); + VECTOR_SET(Result, 6, long_to_integer(Exact.green)); + VECTOR_SET(Result, 7, long_to_integer(Exact.blue)); + PRIMITIVE_RETURN(Result); +} + +DEFINE_PRIMITIVE("X-STORE-NAMED-COLOR", Prim_x_store_named_color, 6, 6, 0) +{ + /* Input: colormap, color name, pixel, DoRed, DoGreen, DoBlue */ + PRIMITIVE_HEADER(6); + { + struct xcolormap * xcm = (x_colormap_arg (1)); + XStoreNamedColor ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), + (STRING_ARG (2)), (arg_integer (4)), + (((BOOLEAN_ARG (4)) ? DoRed : 0) + | ((BOOLEAN_ARG (5)) ? DoGreen : 0) + | ((BOOLEAN_ARG (6)) ? DoBlue : 0))); } + PRIMITIVE_RETURN(UNSPECIFIC); +} + +DEFINE_PRIMITIVE("X-LOOKUP-COLOR", Prim_x_lookup_color, 2, 2, 0) +{ + /* Input: colormap, name + Returns: vector of closest pixel, red, green, blue + exact pixel, red, green, blue + */ + + SCHEME_OBJECT Result; + XColor Exact, Closest; + struct xcolormap * xcm; + PRIMITIVE_HEADER (2); + + xcm = (x_colormap_arg (1)); + if (! (XAllocNamedColor + ((XCM_DISPLAY (xcm)), (XCM_COLORMAP (xcm)), + (STRING_ARG (2)), &Exact, &Closest))) + PRIMITIVE_RETURN (SHARP_F); + Result = allocate_marked_vector(TC_VECTOR, 8, true); + VECTOR_SET(Result, 0, long_to_integer(Closest.pixel)); + VECTOR_SET(Result, 1, long_to_integer(Closest.red)); + VECTOR_SET(Result, 2, long_to_integer(Closest.green)); + VECTOR_SET(Result, 3, long_to_integer(Closest.blue)); + VECTOR_SET(Result, 4, long_to_integer(Exact.pixel)); + VECTOR_SET(Result, 5, long_to_integer(Exact.red)); + VECTOR_SET(Result, 6, long_to_integer(Exact.green)); + VECTOR_SET(Result, 7, long_to_integer(Exact.blue)); + PRIMITIVE_RETURN(Result); } diff --git a/v7/src/microcode/x11graph.c b/v7/src/microcode/x11graph.c index 30f2e2efd..783f5aecf 100644 --- a/v7/src/microcode/x11graph.c +++ b/v7/src/microcode/x11graph.c @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.14 1991/07/08 17:39:44 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.15 1991/07/23 08:16:38 cph Exp $ Copyright (c) 1989-91 Massachusetts Institute of Technology @@ -520,13 +520,12 @@ DEFINE_PRIMITIVE ("X-GRAPHICS-SET-DASHES", Prim_x_graphics_set_dashes, 3, 3, 0) } DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3, - " Arguments: Window, width, height\ - Returns: A Scheme image\ -\ - The window is used to find the Display, Visual, and Depth\ - information needed to crate an XImage structure.") + "Arguments: Window, width, height\n\ +Returns: A Scheme image\n\ +\n\ +The window is used to find the Display, Visual, and Depth\n\ +information needed to crate an XImage structure.") { - extern allocate_x_image (); PRIMITIVE_HEADER (3); { struct xwindow * xw = (x_window_arg (1)); @@ -540,26 +539,22 @@ DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3, (((width + (byte_pad - 1)) / byte_pad) * byte_pad); XWindowAttributes attrs; XGetWindowAttributes (dpy, window, (&attrs)); - { - struct ximage * xi = (x_malloc (sizeof (struct ximage))); - (XI_ALLOCATION_INDEX (xi)) = (allocate_x_image (xi)); - (XI_IMAGE (xi)) = - (XCreateImage - (dpy, - (DefaultVisualOfScreen (attrs . screen)), - (attrs . depth), - ZPixmap, - 0, - ((char *) - (x_malloc (height - * bytes_per_line - * ((((attrs . depth) - 1) / 8) + 1)))), - width, - height, - bitmap_pad, - bytes_per_line)); - return (XI_TO_OBJECT (xi)); - } + PRIMITIVE_RETURN + (X_IMAGE_TO_OBJECT + (XCreateImage + (dpy, + (DefaultVisualOfScreen (attrs . screen)), + (attrs . depth), + ZPixmap, + 0, + ((char *) + (x_malloc (height + * bytes_per_line + * ((((attrs . depth) - 1) / 8) + 1)))), + width, + height, + bitmap_pad, + bytes_per_line))); } } @@ -587,66 +582,73 @@ DEFINE_PRIMITIVE ("X-BYTES-INTO-IMAGE", Prim_x_bytes_into_image, 2, 2, PRIMITIVE_RETURN (UNSPECIFIC); } } - + DEFINE_PRIMITIVE("X-GET-PIXEL-FROM-IMAGE", Prim_x_get_image_pixel, 3, 3, 0) { PRIMITIVE_HEADER (3); - PRIMITIVE_RETURN - (long_to_integer - (XGetPixel ((XI_IMAGE (x_image_arg (1))), - (arg_nonnegative_integer (2)), - (arg_nonnegative_integer (3))))); + { + XImage * image = (XI_IMAGE (x_image_arg (1))); + PRIMITIVE_RETURN + (long_to_integer + (XGetPixel (image, + (arg_index_integer (2, (image -> width))), + (arg_index_integer (3, (image -> height)))))); + } } DEFINE_PRIMITIVE("X-SET-PIXEL-IN-IMAGE", Prim_x_set_image_pixel, 4, 4, 0) -{ PRIMITIVE_HEADER (4); - { struct ximage * xi = x_image_arg(1); - long XCoord = arg_integer(2); - long YCoord = arg_integer(3); - long Pixel = arg_integer(4); - - XPutPixel (XI_IMAGE(xi), XCoord, YCoord, Pixel); +{ + PRIMITIVE_HEADER (4); + { + XImage * image = (XI_IMAGE (x_image_arg (1))); + XPutPixel (image, + (arg_index_integer (2, (image -> width))), + (arg_index_integer (3, (image -> height))), + (arg_integer (4))); PRIMITIVE_RETURN (UNSPECIFIC); } } DEFINE_PRIMITIVE ("X-DESTROY-IMAGE", Prim_x_destroy_image, 1, 1, 0) -{ extern void x_destroy_image (); +{ PRIMITIVE_HEADER (1); - { struct ximage * xi = x_image_arg (1); - x_destroy_image (xi); + { + struct ximage * xi = (x_image_arg (1)); + XDestroyImage (XI_IMAGE (xi)); + deallocate_x_image (xi); PRIMITIVE_RETURN (UNSPECIFIC); } } DEFINE_PRIMITIVE ("X-DISPLAY-IMAGE", Prim_x_display_image, 8, 8, 0) -{ /* Called with Image, X-offset in image, Y-offset in image, +{ + /* Called with Image, X-offset in image, Y-offset in image, Window, X-offset in window, Y-offset in window, - Width, Height - */ + Width, Height */ PRIMITIVE_HEADER (8); - { struct ximage * xi = x_image_arg (1); - long XImageOffset = arg_integer(2); - long YImageOffset = arg_integer(3); - struct xwindow * xw = x_window_arg (4); - long XWindowOffset = arg_integer(5); - long YWindowOffset = arg_integer(6); - long Width = arg_integer(7); - long Height = arg_integer(8); - - XPutImage(XW_DISPLAY(xw), XW_WINDOW(xw), XW_NORMAL_GC(xw), - XI_IMAGE(xi), XImageOffset, YImageOffset, - XWindowOffset, YWindowOffset, - Width, Height); + { + XImage * image = (XI_IMAGE (x_image_arg (1))); + unsigned int image_width = (image -> width); + unsigned int image_height = (image -> height); + unsigned int x_offset = (arg_index_integer (2, image_width)); + unsigned int y_offset = (arg_index_integer (3, image_height)); + struct xwindow * xw = (x_window_arg (4)); + XPutImage + ((XW_DISPLAY (xw)),(XW_WINDOW (xw)),(XW_NORMAL_GC (xw)), + image, x_offset, y_offset, + (arg_x_coordinate (5, xw)), + (arg_y_coordinate (6, xw)), + (arg_index_integer (7, ((image_width - x_offset) + 1))), + (arg_index_integer (8, ((image_height - y_offset) + 1)))); PRIMITIVE_RETURN (UNSPECIFIC); } } - + DEFINE_PRIMITIVE ("X-READ-IMAGE", Prim_x_read_image, 8, 8, 0) -{ /* Called with Image, X-offset in image, Y-offset in image, +{ + /* Called with Image, X-offset in image, Y-offset in image, Window, X-offset in window, Y-offset in window, - Width, Height - */ + Width, Height */ PRIMITIVE_HEADER (8); { struct ximage * xi = x_image_arg (1); long XImageOffset = arg_integer(2); @@ -665,12 +667,14 @@ DEFINE_PRIMITIVE ("X-READ-IMAGE", Prim_x_read_image, 8, 8, 0) } DEFINE_PRIMITIVE ("X-WINDOW-DEPTH", Prim_x_window_depth, 1, 1, 0) -{ struct xwindow * xw = x_window_arg (1); - XWindowAttributes attrs; - +{ PRIMITIVE_HEADER (1); - XGetWindowAttributes(XW_DISPLAY(xw), XW_WINDOW(xw), &attrs); - PRIMITIVE_RETURN (long_to_integer (attrs.depth)); + { + struct xwindow * xw = (x_window_arg (1)); + XWindowAttributes attrs; + XGetWindowAttributes ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&attrs)); + PRIMITIVE_RETURN (long_to_integer (attrs . depth)); + } } DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-X-COORDINATE", Prim_x_graphics_map_x_coordinate, 2, 2, 0) diff --git a/v8/src/microcode/version.h b/v8/src/microcode/version.h index d16614c11..ba6b0d38e 100644 --- a/v8/src/microcode/version.h +++ b/v8/src/microcode/version.h @@ -1,6 +1,6 @@ /* -*-C-*- -$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.88 1991/07/12 23:18:56 cph Exp $ +$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v8/src/microcode/version.h,v 11.89 1991/07/23 08:18:07 cph Exp $ Copyright (c) 1988-91 Massachusetts Institute of Technology @@ -46,5 +46,5 @@ MIT in each case. */ #define VERSION 11 #endif #ifndef SUBVERSION -#define SUBVERSION 88 +#define SUBVERSION 89 #endif