/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11.h,v 1.8 1990/10/02 22:52:22 cph Rel $
+$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 $
-Copyright (c) 1989, 1990 Massachusetts Institute of Technology
+Copyright (c) 1989-91 Massachusetts Institute of Technology
This material was developed by the Scheme project at the Massachusetts
Institute of Technology, Department of Electrical Engineering and
#define FONT_HEIGHT(f) (((f) -> ascent) + ((f) -> descent))
#define FONT_BASE(f) ((f) -> ascent)
\f
+struct ximage
+{
+ unsigned int allocation_index;
+ XImage *image;
+};
+
+#define XI_ALLOCATION_INDEX(xi) ((xi) -> allocation_index)
+#define XI_IMAGE(xi) ((xi -> image))
+
+#define XI_TO_OBJECT(xi) (LONG_TO_UNSIGNED_FIXNUM (XI_ALLOCATION_INDEX (xi)))
+
+#define XV_TO_OBJECT(xv) (LONG_TO_UNSIGNED_FIXNUM (xv))
+\f
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));
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));
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11base.c,v 1.21 1991/05/09 03:49:05 cph Exp $
+$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 $
Copyright (c) 1989-91 Massachusetts Institute of Technology
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 void
DEFUN (allocation_table_initialize, (table), struct allocation_table * table)
INITIALIZE_ONCE ();
return (allocation_item_arg (arg, (&x_window_table)));
}
+
+struct ximage *
+DEFUN (x_image_arg, (arg), unsigned int arg)
+{
+ INITIALIZE_ONCE ();
+ return (allocation_item_arg (arg, (&x_image_table)));
+}
+
+Visual *
+DEFUN (x_visual_arg, (arg), unsigned int arg)
+{
+ INITIALIZE_ONCE ();
+ return (allocation_item_arg (arg, (&x_visual_table)));
+}
\f
static int
DEFUN (x_io_error_handler, (display), Display * display)
}
return (0);
}
-
+extern void x_destroy_image ();
+
static void
DEFUN (x_close_window, (xw), struct xwindow * xw)
{
{
allocation_table_initialize (&x_display_table);
allocation_table_initialize (&x_window_table);
+ allocation_table_initialize (&x_image_table);
XSetErrorHandler (x_error_handler);
XSetIOErrorHandler (x_io_error_handler);
add_reload_cleanup (x_close_all_displays);
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
+\f
+/* Support routines for visual and image handling */
+
+extern unsigned int allocate_x_window (xw)
+struct xwindow * xw;
+{ return allocate_table_index((&x_window_table), xw);
+}
+
+extern unsigned int allocate_x_visual (xv)
+Visual * xv;
+{ return allocate_table_index((&x_visual_table), xv);
+}
+
+extern unsigned int allocate_x_image (xi)
+struct ximage * xi;
+{ return allocate_table_index((&x_image_table), xi);
+}
+
+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);
+}
/* -*-C-*-
-$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.10 1991/06/21 03:40:23 gjs Exp $
+$Header: /Users/cph/tmp/foo/mit-scheme/mit-scheme/v7/src/microcode/x11graph.c,v 1.11 1991/07/02 18:18:43 cph Exp $
Copyright (c) 1989-91 Massachusetts Institute of Technology
(size_hints . min_height) = extra;
XSetNormalHints ((XW_DISPLAY (xw)), (XW_WINDOW (xw)), (&size_hints));
}
-
-#define MAKE_GC(gc, fore, back) \ \
-{ \ \
- XGCValues gcv; \ \
- (gcv . font) = fid; \ \
- (gcv . foreground) = (fore); \ \
- (gcv . background) = (back); \ \
- (gc) = \ \
- (XCreateGC (display, \ \
- window, \ \
- (GCFont | GCForeground | GCBackground), \ \
- (& gcv))); \ \
-}
\f
DEFINE_PRIMITIVE ("X-GRAPHICS-OPEN-WINDOW", Prim_x_graphics_open_window, 3, 3,
"(X-GRAPHICS-OPEN-WINDOW DISPLAY GEOMETRY SUPPRESS-MAP?)\n\
}
PRIMITIVE_RETURN (UNSPECIFIC);
}
+\f
+DEFINE_PRIMITIVE ("X-CREATE-IMAGE", Prim_x_create_image, 3, 3, 0)
+{
+ /* 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. */
+ extern allocate_x_image ();
+ PRIMITIVE_HEADER (3);
+ {
+ struct xwindow * xw = (x_window_arg (1));
+ Window window = (XW_WINDOW (xw));
+ Display * dpy = (XW_DISPLAY (xw));
+ unsigned int width = (arg_nonnegative_integer (2));
+ unsigned int height = (arg_nonnegative_integer (3));
+ unsigned int bitmap_pad = (BitmapPad (dpy));
+ unsigned int byte_pad = (bitmap_pad / CHAR_BIT);
+ unsigned int bytes_per_line =
+ (((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));
+ }
+ }
+}
+
+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)))));
+}
+
+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_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);
+ 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,
+ Window, X-offset in window, Y-offset in window,
+ 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);
+ 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,
+ Window, X-offset in window, Y-offset in window,
+ 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);
+
+ XGetSubImage(XW_DISPLAY(xw), XW_WINDOW(xw), XWindowOffset, YWindowOffset,
+ Width, Height, -1, ZPixmap,
+ XI_IMAGE(xi), XImageOffset, YImageOffset);
+ PRIMITIVE_RETURN (UNSPECIFIC);
+ }
+}
+
+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));
+}
DEFINE_PRIMITIVE ("X-GRAPHICS-MAP-X-COORDINATE", Prim_x_graphics_map_x_coordinate, 2, 2, 0)
{
projects / mit-scheme.git / commitdiff