diff options
Diffstat (limited to 'otherlibs/graph')
| -rw-r--r-- | otherlibs/graph/.cvsignore | 1 | ||||
| -rw-r--r-- | otherlibs/graph/.depend | 48 | ||||
| -rw-r--r-- | otherlibs/graph/Makefile | 75 | ||||
| -rw-r--r-- | otherlibs/graph/Makefile.Mac | 40 | ||||
| -rw-r--r-- | otherlibs/graph/Makefile.Mac.depend | 4 | ||||
| -rw-r--r-- | otherlibs/graph/color.c | 230 | ||||
| -rw-r--r-- | otherlibs/graph/draw.c | 131 | ||||
| -rw-r--r-- | otherlibs/graph/dump_img.c | 55 | ||||
| -rw-r--r-- | otherlibs/graph/events.c | 287 | ||||
| -rw-r--r-- | otherlibs/graph/fill.c | 88 | ||||
| -rw-r--r-- | otherlibs/graph/graphics.ml | 228 | ||||
| -rw-r--r-- | otherlibs/graph/graphics.mli | 374 | ||||
| -rw-r--r-- | otherlibs/graph/graphicsX11.ml | 42 | ||||
| -rw-r--r-- | otherlibs/graph/graphicsX11.mli | 31 | ||||
| -rw-r--r-- | otherlibs/graph/image.c | 105 | ||||
| -rw-r--r-- | otherlibs/graph/image.h | 29 | ||||
| -rw-r--r-- | otherlibs/graph/libgraph.h | 84 | ||||
| -rw-r--r-- | otherlibs/graph/make_img.c | 95 | ||||
| -rw-r--r-- | otherlibs/graph/open.c | 366 | ||||
| -rw-r--r-- | otherlibs/graph/point_col.c | 32 | ||||
| -rw-r--r-- | otherlibs/graph/sound.c | 34 | ||||
| -rw-r--r-- | otherlibs/graph/subwindow.c | 45 | ||||
| -rw-r--r-- | otherlibs/graph/text.c | 84 |
23 files changed, 0 insertions, 2508 deletions
diff --git a/otherlibs/graph/.cvsignore b/otherlibs/graph/.cvsignore deleted file mode 100644 index 074dd28a45..0000000000 --- a/otherlibs/graph/.cvsignore +++ /dev/null @@ -1 +0,0 @@ -so_locations diff --git a/otherlibs/graph/.depend b/otherlibs/graph/.depend deleted file mode 100644 index 1bc2b88109..0000000000 --- a/otherlibs/graph/.depend +++ /dev/null @@ -1,48 +0,0 @@ -color.o: color.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h -draw.o: draw.c libgraph.h ../../byterun/mlvalues.h ../../byterun/config.h \ - ../../config/m.h ../../config/s.h ../../byterun/misc.h \ - ../../byterun/alloc.h -dump_img.o: dump_img.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h image.h ../../byterun/alloc.h \ - ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ - ../../byterun/freelist.h ../../byterun/minor_gc.h -events.o: events.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h ../../byterun/alloc.h ../../byterun/signals.h -fill.o: fill.c libgraph.h ../../byterun/mlvalues.h ../../byterun/config.h \ - ../../config/m.h ../../config/s.h ../../byterun/misc.h \ - ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ - ../../byterun/freelist.h ../../byterun/minor_gc.h -image.o: image.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h image.h ../../byterun/alloc.h \ - ../../byterun/custom.h -make_img.o: make_img.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h image.h ../../byterun/memory.h ../../byterun/gc.h \ - ../../byterun/major_gc.h ../../byterun/freelist.h \ - ../../byterun/minor_gc.h -open.o: open.c libgraph.h ../../byterun/mlvalues.h ../../byterun/config.h \ - ../../config/m.h ../../config/s.h ../../byterun/misc.h \ - ../../byterun/alloc.h ../../byterun/callback.h ../../byterun/fail.h \ - ../../byterun/memory.h ../../byterun/gc.h ../../byterun/major_gc.h \ - ../../byterun/freelist.h ../../byterun/minor_gc.h -point_col.o: point_col.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h -sound.o: sound.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h -subwindow.o: subwindow.c libgraph.h ../../byterun/mlvalues.h \ - ../../byterun/config.h ../../config/m.h ../../config/s.h \ - ../../byterun/misc.h -text.o: text.c libgraph.h ../../byterun/mlvalues.h ../../byterun/config.h \ - ../../config/m.h ../../config/s.h ../../byterun/misc.h \ - ../../byterun/alloc.h -graphics.cmo: graphics.cmi -graphics.cmx: graphics.cmi -graphicsX11.cmo: graphics.cmi graphicsX11.cmi -graphicsX11.cmx: graphics.cmx graphicsX11.cmi diff --git a/otherlibs/graph/Makefile b/otherlibs/graph/Makefile deleted file mode 100644 index a35e1d3bae..0000000000 --- a/otherlibs/graph/Makefile +++ /dev/null @@ -1,75 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Xavier Leroy, projet Cristal, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../LICENSE. # -# # -######################################################################### - -# $Id$ - -# Makefile for the portable graphics library - -include ../../config/Makefile - -CC=$(BYTECC) -CFLAGS=-I../../byterun $(X11_INCLUDES) -O $(BYTECCCOMPOPTS) $(SHAREDCCCOMPOPTS) -CAMLC=../../ocamlcomp.sh -CAMLOPT=../../ocamlcompopt.sh -MKLIB=../../boot/ocamlrun ../../tools/ocamlmklib -COMPFLAGS=-warn-error A - -OBJS=open.o draw.o fill.o color.o text.o \ - image.o make_img.o dump_img.o point_col.o sound.o events.o \ - subwindow.o - -CAMLOBJS=graphics.cmo graphicsX11.cmo - -all: libgraphics.a graphics.cmi graphics.cma - -allopt: libgraphics.a graphics.cmi graphics.cmxa - -libgraphics.a: $(OBJS) - $(MKLIB) -o graphics $(OBJS) $(X11_LINK) - -graphics.cma: $(CAMLOBJS) - $(MKLIB) -ocamlc '$(CAMLC)' -o graphics $(CAMLOBJS) $(X11_LINK) - -graphics.cmxa: $(CAMLOBJS:.cmo=.cmx) - $(MKLIB) -ocamlopt '$(CAMLOPT)' -o graphics $(CAMLOBJS:.cmo=.cmx) $(X11_LINK) - -partialclean: - rm -f *.cm* - -clean: partialclean - rm -f *.a *.so *.o - -install: - if test -f dllgraphics.so; then cp dllgraphics.so $(STUBLIBDIR)/dllgraphics.so; fi - cp libgraphics.a $(LIBDIR)/libgraphics.a - cd $(LIBDIR); $(RANLIB) libgraphics.a - cp graphics.cm[ia] graphicsX11.cmi graphics.mli graphicsX11.mli $(LIBDIR) - -installopt: - cp graphics.cmx graphics.cmxa graphics.a $(LIBDIR) - cd $(LIBDIR); $(RANLIB) graphics.a - -.SUFFIXES: .ml .mli .cmo .cmi .cmx - -.mli.cmi: - $(CAMLC) -c $(COMPFLAGS) $< -.ml.cmo: - $(CAMLC) -c $(COMPFLAGS) $< -.ml.cmx: - $(CAMLOPT) -c $(COMPFLAGS) $< - -depend: - gcc -MM $(CFLAGS) *.c > .depend - ../../boot/ocamlrun ../../tools/ocamldep *.mli *.ml >> .depend - -include .depend diff --git a/otherlibs/graph/Makefile.Mac b/otherlibs/graph/Makefile.Mac deleted file mode 100644 index 7269595e68..0000000000 --- a/otherlibs/graph/Makefile.Mac +++ /dev/null @@ -1,40 +0,0 @@ -######################################################################### -# # -# Objective Caml # -# # -# Damien Doligez, projet Para, INRIA Rocquencourt # -# # -# Copyright 1999 Institut National de Recherche en Informatique et # -# en Automatique. All rights reserved. This file is distributed # -# under the terms of the GNU Library General Public License, with # -# the special exception on linking described in file ../../LICENSE. # -# # -######################################################################### - -# $Id$ - -CAMLC = :::boot:ocamlrun :::ocamlc -I :::stdlib: - -all Ä graphics.cmi graphics.cma - set status 0 - -graphics.cma Ä graphics.cmo - {CAMLC} -a -o graphics.cma graphics.cmo - -partialclean Ä - delete -i Å.cm[aio] || set status 0 - -clean Ä partialclean - set status 0 - -install Ä - duplicate -y graphics.cm[ia] graphics.mli "{LIBDIR}" - -.cmi Ä .mli - {CAMLC} -c {default}.mli - -.cmo Ä .ml - {CAMLC} -c {default}.ml - -depend Ä - :::boot:ocamlrun :::tools:ocamldep Å.mli Å.ml > Makefile.Mac.depend diff --git a/otherlibs/graph/Makefile.Mac.depend b/otherlibs/graph/Makefile.Mac.depend deleted file mode 100644 index 2877a11eb5..0000000000 --- a/otherlibs/graph/Makefile.Mac.depend +++ /dev/null @@ -1,4 +0,0 @@ -graphics.cmoÄ graphics.cmi -graphics.cmxÄ graphics.cmi -graphicsX11.cmoÄ graphics.cmi graphicsX11.cmi -graphicsX11.cmxÄ graphics.cmx graphicsX11.cmi diff --git a/otherlibs/graph/color.c b/otherlibs/graph/color.c deleted file mode 100644 index f47fa58147..0000000000 --- a/otherlibs/graph/color.c +++ /dev/null @@ -1,230 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include <X11/Xatom.h> - -/* Cache to speed up the translation rgb -> pixel value. */ - -struct color_cache_entry { - int rgb; /* RGB value with format 0xRRGGBB */ - unsigned long pixel; /* Pixel value */ -}; - -#define Color_cache_size 512 -static struct color_cache_entry color_cache[Color_cache_size]; -#define Empty (-1) -#define Hash_rgb(r,g,b) \ - ((((r) & 0xE0) << 1) + (((g) & 0xE0) >> 2) + (((b) & 0xE0) >> 5)) -#define Color_cache_slack 16 - -static int num_overflows = 0; - -/* rgb -> pixel conversion *without* display connection */ - -Bool direct_rgb = False; -int red_l, red_r; -int green_l, green_r; -int blue_l, blue_r; -unsigned long red_mask, green_mask, blue_mask; - -/* rgb -> pixel table */ -unsigned long red_vals[256]; -unsigned long green_vals[256]; -unsigned long blue_vals[256]; - -void get_shifts( unsigned long mask, int *lsl, int *lsr ) -{ - int l = 0; - int r = 0; - int bit = 1; - if ( mask == 0 ){ *lsl = -1; *lsr = -1; return; } - - for( l = 0; l < 32; l++ ){ - if( bit & mask ){ break; } - bit = bit << 1; - } - for( r = l; r < 32; r++ ){ - if( ! (bit & mask) ){ break; } - bit = bit << 1; - } - /* fix r */ - if ( r == 32 ) { r = 31; } - *lsl = l; - *lsr = 16 - (r - l); -} - -void gr_init_direct_rgb_to_pixel(void) -{ - Visual *visual; - int i; - - visual = DefaultVisual(grdisplay,grscreen); - - if ( visual->class == TrueColor || visual->class == DirectColor ){ - int lsl, lsr; - - red_mask = visual->red_mask; - green_mask = visual->green_mask; - blue_mask = visual->blue_mask; - -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "visual %lx %lx %lx\n", - red_mask, - green_mask, - blue_mask); -#endif - - get_shifts(red_mask, &red_l, &red_r); -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "red %d %d\n", red_l, red_r); -#endif - for(i=0; i<256; i++){ - red_vals[i] = (((i << 8) + i) >> red_r) << red_l; - } - - get_shifts(green_mask, &green_l, &green_r); -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "green %d %d\n", green_l, green_r); -#endif - for(i=0; i<256; i++){ - green_vals[i] = (((i << 8) + i) >> green_r) << green_l; - } - - get_shifts(blue_mask, &blue_l, &blue_r); -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "blue %d %d\n", blue_l, blue_r); -#endif - for(i=0; i<256; i++){ - blue_vals[i] = (((i << 8) + i) >> blue_r) << blue_l; - } - - if( red_l < 0 || red_r < 0 || - green_l < 0 || green_r < 0 || - blue_l < 0 || blue_r < 0 ){ -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "Damn, boost failed\n"); -#endif - direct_rgb = False; - } else { -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "Boost ok\n"); -#endif - direct_rgb = True; - } - } else { - /* we cannot use direct_rgb_to_pixel */ -#ifdef QUICKCOLORDEBUG - fprintf(stderr, "No boost!\n"); -#endif - direct_rgb = False; - } -} - -void gr_init_color_cache(void) -{ - int i; - for (i = 0; i < Color_cache_size; i++) color_cache[i].rgb = Empty; - i = Hash_rgb(0, 0, 0); - color_cache[i].rgb = 0; - color_cache[i].pixel = grblack; - i = Hash_rgb(0xFF, 0xFF, 0xFF); - color_cache[i].rgb = 0xFFFFFF; - color_cache[i].pixel = grwhite; -} - -unsigned long gr_pixel_rgb(int rgb) -{ - unsigned int r, g, b; - int h, i; - XColor color; - unsigned short tmp; - - r = (rgb >> 16) & 0xFF; - g = (rgb >> 8) & 0xFF; - b = rgb & 0xFF; - - if (direct_rgb){ - return red_vals[r] | green_vals[g] | blue_vals[b]; - } - - h = Hash_rgb(r, g, b); - i = h; - while(1) { - if (color_cache[i].rgb == Empty) break; - if (color_cache[i].rgb == rgb) return color_cache[i].pixel; - i = (i + 1) & (Color_cache_size - 1); - if (i == h) { - /* Cache is full. Instead of inserting at slot h, which causes - thrashing if many colors hash to the same value, - insert at h + n where n is pseudo-random and - smaller than Color_cache_slack */ - int slack = num_overflows++ & (Color_cache_slack - 1); - i = (i + slack) & (Color_cache_size - 1); - break; - } - } - color.red = r * 0x101; - color.green = g * 0x101; - color.blue = b * 0x101; - XAllocColor(grdisplay, grcolormap, &color); - color_cache[i].rgb = rgb; - color_cache[i].pixel = color.pixel; - return color.pixel; -} - -int gr_rgb_pixel(long unsigned int pixel) -{ - register int r,g,b; - - XColor color; - int i; - - if (direct_rgb) { - r = (((pixel & red_mask) >> red_l) << 8) >> (16 - red_r); - g = (((pixel & green_mask) >> green_l) << 8) >> (16 - green_r); - b = (((pixel & blue_mask) >> blue_l) << 8) >> (16 - blue_r); - return (r << 16) + (g << 8) + b; - } - - if (pixel == grblack) return 0; - if (pixel == grwhite) return 0xFFFFFF; - - /* Probably faster to do a linear search than to query the X server. */ - for (i = 0; i < Color_cache_size; i++) { - if (color_cache[i].rgb != Empty && color_cache[i].pixel == pixel) - return color_cache[i].rgb; - } - color.pixel = pixel; - XQueryColor(grdisplay, grcolormap, &color); - return - ((color.red >> 8) << 16) + ((color.green >> 8) << 8) + (color.blue >> 8); -} - -value gr_set_color(value vrgb) -{ - int xcolor; - gr_check_open(); - grcolor = Int_val(vrgb); - if (grcolor >= 0 ){ - xcolor = gr_pixel_rgb(Int_val(vrgb)); - XSetForeground(grdisplay, grwindow.gc, xcolor); - XSetForeground(grdisplay, grbstore.gc, xcolor); - } else { - XSetForeground(grdisplay, grwindow.gc, grbackground); - XSetForeground(grdisplay, grbstore.gc, grbackground); - } - return Val_unit; -} diff --git a/otherlibs/graph/draw.c b/otherlibs/graph/draw.c deleted file mode 100644 index 18166168bf..0000000000 --- a/otherlibs/graph/draw.c +++ /dev/null @@ -1,131 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include <alloc.h> - -value gr_plot(value vx, value vy) -{ - int x = Int_val(vx); - int y = Int_val(vy); - gr_check_open(); - if(grremember_mode) - XDrawPoint(grdisplay, grbstore.win, grbstore.gc, x, Bcvt(y)); - if(grdisplay_mode) { - XDrawPoint(grdisplay, grwindow.win, grwindow.gc, x, Wcvt(y)); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_moveto(value vx, value vy) -{ - grx = Int_val(vx); - gry = Int_val(vy); - return Val_unit; -} - -value gr_current_x(void) -{ - return Val_int(grx); -} - -value gr_current_y(void) -{ - return Val_int(gry); -} - -value gr_lineto(value vx, value vy) -{ - int x = Int_val(vx); - int y = Int_val(vy); - gr_check_open(); - if(grremember_mode) - XDrawLine(grdisplay, grbstore.win, grbstore.gc, - grx, Bcvt(gry), x, Bcvt(y)); - if(grdisplay_mode) { - XDrawLine(grdisplay, grwindow.win, grwindow.gc, - grx, Wcvt(gry), x, Wcvt(y)); - XFlush(grdisplay); - } - grx = x; - gry = y; - return Val_unit; -} - -value gr_draw_rect(value vx, value vy, value vw, value vh) -{ - int x = Int_val(vx); - int y = Int_val(vy); - int w = Int_val(vw); - int h = Int_val(vh); - - gr_check_open(); - y = Bcvt(y) - h + 1; - /* Correct for XDrawRectangle irritating habit of drawing a larger - rectangle hanging out one pixel below and to the right of the - expected rectangle */ - if (w == 0 || h == 0) return Val_unit; - y += 1; - w -= 1; - h -= 1; - if(grremember_mode) - XDrawRectangle(grdisplay, grbstore.win, grbstore.gc, - x, y, w, h); - if(grdisplay_mode) { - XDrawRectangle(grdisplay, grwindow.win, grwindow.gc, - x, y, w, h); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_draw_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2) -{ - int x = Int_val(vx); - int y = Int_val(vy); - int rx = Int_val(vrx); - int ry = Int_val(vry); - int a1 = Int_val(va1); - int a2 = Int_val(va2); - - gr_check_open(); - if(grremember_mode) - XDrawArc(grdisplay, grbstore.win, grbstore.gc, - x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); - if(grdisplay_mode) { - XDrawArc(grdisplay, grwindow.win, grwindow.gc, - x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_draw_arc(value *argv, int argc) -{ - return gr_draw_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); -} - -value gr_set_line_width(value vwidth) -{ - int width = Int_val(vwidth); - - gr_check_open(); - XSetLineAttributes(grdisplay, grwindow.gc, - width, LineSolid, CapRound, JoinRound); - XSetLineAttributes(grdisplay, grbstore.gc, - width, LineSolid, CapRound, JoinRound); - return Val_unit; -} diff --git a/otherlibs/graph/dump_img.c b/otherlibs/graph/dump_img.c deleted file mode 100644 index 75a9dce43e..0000000000 --- a/otherlibs/graph/dump_img.c +++ /dev/null @@ -1,55 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include "image.h" -#include <alloc.h> -#include <memory.h> - -value gr_dump_image(value image) -{ - int width, height, i, j; - XImage * idata, * imask; - value m = Val_unit; - - Begin_roots2(image, m); - gr_check_open(); - width = Width_im(image); - height = Height_im(image); - m = alloc(height, 0); - for (i = 0; i < height; i++) { - value v = alloc(width, 0); - modify(&Field(m, i), v); - } - - idata = - XGetImage(grdisplay, Data_im(image), 0, 0, width, height, (-1), ZPixmap); - for (i = 0; i < height; i++) - for (j = 0; j < width; j++) - Field(Field(m, i), j) = Val_int(gr_rgb_pixel(XGetPixel(idata, j, i))); - XDestroyImage(idata); - - if (Mask_im(image) != None) { - imask = - XGetImage(grdisplay, Mask_im(image), 0, 0, width, height, 1, ZPixmap); - for (i = 0; i < height; i++) - for (j = 0; j < width; j++) - if (XGetPixel(imask, j, i) == 0) - Field(Field(m, i), j) = Val_int(Transparent); - XDestroyImage(imask); - } - End_roots(); - return m; -} diff --git a/otherlibs/graph/events.c b/otherlibs/graph/events.c deleted file mode 100644 index 1f0029d25f..0000000000 --- a/otherlibs/graph/events.c +++ /dev/null @@ -1,287 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <signal.h> -#include "libgraph.h" -#include <alloc.h> -#include <signals.h> -#include <sys/types.h> -#include <sys/time.h> -#ifdef HAS_SYS_SELECT_H -#include <sys/select.h> -#endif -#include <string.h> -#include <unistd.h> - -struct event_data { - short kind; - short mouse_x, mouse_y; - unsigned char button; - unsigned char key; -}; - -static struct event_data gr_queue[SIZE_QUEUE]; -static unsigned int gr_head = 0; /* position of next read */ -static unsigned int gr_tail = 0; /* position of next write */ - -#define QueueIsEmpty (gr_tail == gr_head) - -static void gr_enqueue_event(int kind, int mouse_x, int mouse_y, - int button, int key) -{ - struct event_data * ev; - - ev = &(gr_queue[gr_tail]); - ev->kind = kind; - ev->mouse_x = mouse_x; - ev->mouse_y = mouse_y; - ev->button = (button != 0); - ev->key = key; - gr_tail = (gr_tail + 1) % SIZE_QUEUE; - /* If queue was full, it now appears empty; drop oldest entry from queue. */ - if (QueueIsEmpty) gr_head = (gr_head + 1) % SIZE_QUEUE; -} - -#define BUTTON_STATE(state) \ - ((state) & (Button1Mask|Button2Mask|Button3Mask|Button4Mask|Button5Mask)) - -void gr_handle_event(XEvent * event) -{ - switch (event->type) { - - case Expose: - XCopyArea(grdisplay, grbstore.win, grwindow.win, grwindow.gc, - event->xexpose.x, event->xexpose.y + grbstore.h - grwindow.h, - event->xexpose.width, event->xexpose.height, - event->xexpose.x, event->xexpose.y); - XFlush(grdisplay); - break; - - case ConfigureNotify: - grwindow.w = event->xconfigure.width; - grwindow.h = event->xconfigure.height; - if (grwindow.w > grbstore.w || grwindow.h > grbstore.h) { - - /* Allocate a new backing store large enough to accomodate - both the old backing store and the current window. */ - struct canvas newbstore; - newbstore.w = max(grwindow.w, grbstore.w); - newbstore.h = max(grwindow.h, grbstore.h); - newbstore.win = - XCreatePixmap(grdisplay, grwindow.win, newbstore.w, newbstore.h, - XDefaultDepth(grdisplay, grscreen)); - newbstore.gc = XCreateGC(grdisplay, newbstore.win, 0, NULL); - XSetBackground(grdisplay, newbstore.gc, grwhite); - XSetForeground(grdisplay, newbstore.gc, grwhite); - XFillRectangle(grdisplay, newbstore.win, newbstore.gc, - 0, 0, newbstore.w, newbstore.h); - XSetForeground(grdisplay, newbstore.gc, grcolor); - if (grfont != NULL) - XSetFont(grdisplay, newbstore.gc, grfont->fid); - - /* Copy the old backing store into the new one */ - XCopyArea(grdisplay, grbstore.win, newbstore.win, newbstore.gc, - 0, 0, grbstore.w, grbstore.h, 0, newbstore.h - grbstore.h); - - /* Free the old backing store */ - XFreeGC(grdisplay, grbstore.gc); - XFreePixmap(grdisplay, grbstore.win); - - /* Use the new backing store */ - grbstore = newbstore; - XFlush(grdisplay); - } - break; - - case MappingNotify: - XRefreshKeyboardMapping(&(event->xmapping)); - break; - - case KeyPress: - { KeySym thekey; - char keytxt[256]; - int nchars; - char * p; - nchars = XLookupString(&(event->xkey), keytxt, sizeof(keytxt), - &thekey, 0); - for (p = keytxt; nchars > 0; p++, nchars--) - gr_enqueue_event(event->type, event->xkey.x, event->xkey.y, - BUTTON_STATE(event->xkey.state), *p); - break; - } - - case ButtonPress: - case ButtonRelease: - gr_enqueue_event(event->type, event->xbutton.x, event->xbutton.y, - event->type == ButtonPress, 0); - break; - - case MotionNotify: - gr_enqueue_event(event->type, event->xmotion.x, event->xmotion.y, - BUTTON_STATE(event->xmotion.state), 0); - break; - } -} - -static value gr_wait_allocate_result(int mouse_x, int mouse_y, int button, - int keypressed, int key) -{ - value res = alloc_small(5, 0); - Field(res, 0) = Val_int(mouse_x); - Field(res, 1) = Val_int(mouse_y == -1 ? -1 : Wcvt(mouse_y)); - Field(res, 2) = Val_bool(button); - Field(res, 3) = Val_bool(keypressed); - Field(res, 4) = Val_int(key & 0xFF); - return res; -} - -static value gr_wait_event_poll(void) -{ - int mouse_x, mouse_y, button, key, keypressed; - Window rootwin, childwin; - int root_x, root_y, win_x, win_y; - unsigned int modifiers; - unsigned int i; - - if (XQueryPointer(grdisplay, grwindow.win, - &rootwin, &childwin, - &root_x, &root_y, &win_x, &win_y, - &modifiers)) { - mouse_x = win_x; - mouse_y = win_y; - } else { - mouse_x = -1; - mouse_y = -1; - } - button = modifiers & (Button1Mask | Button2Mask | Button3Mask - | Button4Mask | Button5Mask); - /* Look inside event queue for pending KeyPress events */ - key = 0; - keypressed = False; - for (i = gr_head; i != gr_tail; i = (i + 1) % SIZE_QUEUE) { - if (gr_queue[i].kind == KeyPress) { - keypressed = True; - key = gr_queue[i].key; - break; - } - } - return gr_wait_allocate_result(mouse_x, mouse_y, button, keypressed, key); -} - -static value gr_wait_event_in_queue(long mask) -{ - struct event_data * ev; - /* Pop events in queue until one matches mask. */ - while (gr_head != gr_tail) { - ev = &(gr_queue[gr_head]); - gr_head = (gr_head + 1) % SIZE_QUEUE; - if ((ev->kind == KeyPress && (mask & KeyPressMask)) - || (ev->kind == ButtonPress && (mask & ButtonPressMask)) - || (ev->kind == ButtonRelease && (mask & ButtonReleaseMask)) - || (ev->kind == MotionNotify && (mask & PointerMotionMask))) - return gr_wait_allocate_result(ev->mouse_x, ev->mouse_y, - ev->button, ev->kind == KeyPress, - ev->key); - } - return Val_false; -} - -static value gr_wait_event_blocking(long mask) -{ -#ifdef POSIX_SIGNALS - sigset_t sigset; -#else - void (*oldsig)(); -#endif - XEvent event; - fd_set readfds; - value res; - - /* First see if we have a matching event in the queue */ - res = gr_wait_event_in_queue(mask); - if (res != Val_false) return res; - - /* Increase the selected events if required */ - if ((mask & ~grselected_events) != 0) { - grselected_events |= mask; - XSelectInput(grdisplay, grwindow.win, grselected_events); - } - - /* Block or deactivate the EVENT signal */ -#ifdef POSIX_SIGNALS - sigemptyset(&sigset); - sigaddset(&sigset, EVENT_SIGNAL); - sigprocmask(SIG_BLOCK, &sigset, NULL); -#else - oldsig = signal(EVENT_SIGNAL, SIG_IGN); -#endif - - /* Replenish our event queue from that of X11 */ - while (1) { - if (XCheckMaskEvent(grdisplay, -1 /*all events*/, &event)) { - /* One event available: add it to our queue */ - gr_handle_event(&event); - /* See if we now have a matching event */ - res = gr_wait_event_in_queue(mask); - if (res != Val_false) break; - } else { - /* No event available: block on input socket until one is */ - FD_ZERO(&readfds); - FD_SET(ConnectionNumber(grdisplay), &readfds); - enter_blocking_section(); - select(FD_SETSIZE, &readfds, NULL, NULL, NULL); - leave_blocking_section(); - } - } - - /* Restore the EVENT signal to its initial state */ -#ifdef POSIX_SIGNALS - sigprocmask(SIG_UNBLOCK, &sigset, NULL); -#else - signal(EVENT_SIGNAL, oldsig); -#endif - - /* Return result */ - return res; -} - -value gr_wait_event(value eventlist) /* ML */ -{ - int mask; - Bool poll; - - gr_check_open(); - mask = 0; - poll = False; - while (eventlist != Val_int(0)) { - switch (Int_val(Field(eventlist, 0))) { - case 0: /* Button_down */ - mask |= ButtonPressMask | OwnerGrabButtonMask; break; - case 1: /* Button_up */ - mask |= ButtonReleaseMask | OwnerGrabButtonMask; break; - case 2: /* Key_pressed */ - mask |= KeyPressMask; break; - case 3: /* Mouse_motion */ - mask |= PointerMotionMask; break; - case 4: /* Poll */ - poll = True; break; - } - eventlist = Field(eventlist, 1); - } - if (poll) - return gr_wait_event_poll(); - else - return gr_wait_event_blocking(mask); -} diff --git a/otherlibs/graph/fill.c b/otherlibs/graph/fill.c deleted file mode 100644 index faaa3c4cf3..0000000000 --- a/otherlibs/graph/fill.c +++ /dev/null @@ -1,88 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include <memory.h> - -value gr_fill_rect(value vx, value vy, value vw, value vh) -{ - int x = Int_val(vx); - int y = Int_val(vy); - int w = Int_val(vw); - int h = Int_val(vh); - - gr_check_open(); - if(grremember_mode) - XFillRectangle(grdisplay, grbstore.win, grbstore.gc, - x, Bcvt(y) - h + 1, w, h); - if(grdisplay_mode) { - XFillRectangle(grdisplay, grwindow.win, grwindow.gc, - x, Wcvt(y) - h + 1, w, h); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_fill_poly(value array) -{ - XPoint * points; - int npoints, i; - - gr_check_open(); - npoints = Wosize_val(array); - points = (XPoint *) stat_alloc(npoints * sizeof(XPoint)); - for (i = 0; i < npoints; i++) { - points[i].x = Int_val(Field(Field(array, i), 0)); - points[i].y = Bcvt(Int_val(Field(Field(array, i), 1))); - } - if(grremember_mode) - XFillPolygon(grdisplay, grbstore.win, grbstore.gc, points, - npoints, Complex, CoordModeOrigin); - if(grdisplay_mode) { - for (i = 0; i < npoints; i++) - points[i].y = BtoW(points[i].y); - XFillPolygon(grdisplay, grwindow.win, grwindow.gc, points, - npoints, Complex, CoordModeOrigin); - XFlush(grdisplay); - } - stat_free((char *) points); - return Val_unit; -} - -value gr_fill_arc_nat(value vx, value vy, value vrx, value vry, value va1, value va2) -{ - int x = Int_val(vx); - int y = Int_val(vy); - int rx = Int_val(vrx); - int ry = Int_val(vry); - int a1 = Int_val(va1); - int a2 = Int_val(va2); - - gr_check_open(); - if(grremember_mode) - XFillArc(grdisplay, grbstore.win, grbstore.gc, - x - rx, Bcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); - if(grdisplay_mode) { - XFillArc(grdisplay, grwindow.win, grwindow.gc, - x - rx, Wcvt(y) - ry, rx * 2, ry * 2, a1 * 64, (a2 - a1) * 64); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_fill_arc(value *argv, int argc) -{ - return gr_fill_arc_nat(argv[0], argv[1], argv[2], argv[3], argv[4], argv[5]); -} diff --git a/otherlibs/graph/graphics.ml b/otherlibs/graph/graphics.ml deleted file mode 100644 index 88e7450e0a..0000000000 --- a/otherlibs/graph/graphics.ml +++ /dev/null @@ -1,228 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -exception Graphic_failure of string - -(* Initializations *) - -let _ = - Callback.register_exception "Graphics.Graphic_failure" (Graphic_failure "") - -external raw_open_graph: string -> unit = "gr_open_graph" -external raw_close_graph: unit -> unit = "gr_close_graph" -external sigio_signal: unit -> int = "gr_sigio_signal" -external sigio_handler: int -> unit = "gr_sigio_handler" - -let unix_open_graph arg = - Sys.set_signal (sigio_signal()) (Sys.Signal_handle sigio_handler); - raw_open_graph arg - -let unix_close_graph () = - Sys.set_signal (sigio_signal()) Sys.Signal_ignore; - raw_close_graph () - -let (open_graph, close_graph) = - match Sys.os_type with - | "Unix" | "Cygwin" -> (unix_open_graph, unix_close_graph) - | "Win32" -> (raw_open_graph, raw_close_graph) - | "MacOS" -> (raw_open_graph, raw_close_graph) - | _ -> invalid_arg ("Graphics: unknown OS type: " ^ Sys.os_type) - -external set_window_title : string -> unit = "gr_set_window_title" -external clear_graph : unit -> unit = "gr_clear_graph" -external size_x : unit -> int = "gr_size_x" -external size_y : unit -> int = "gr_size_y" - -(* Double-buffering *) - -external display_mode : bool -> unit = "gr_display_mode" -external remember_mode : bool -> unit = "gr_remember_mode" -external synchronize : unit -> unit = "gr_synchronize" - -let auto_synchronize = function - | true -> display_mode true; remember_mode true; synchronize () - | false -> display_mode false; remember_mode true -;; - - -(* Colors *) - -type color = int - -let rgb r g b = (r lsl 16) + (g lsl 8) + b - -external set_color : color -> unit = "gr_set_color" - -let black = 0x000000 -and white = 0xFFFFFF -and red = 0xFF0000 -and green = 0x00FF00 -and blue = 0x0000FF -and yellow = 0xFFFF00 -and cyan = 0x00FFFF -and magenta = 0xFF00FF - -let background = white -and foreground = black - -(* Drawing *) - -external plot : int -> int -> unit = "gr_plot" -let plots points = - for i = 0 to Array.length points - 1 do - let (x, y) = points.(i) in - plot x y; - done -;; -external point_color : int -> int -> color = "gr_point_color" -external moveto : int -> int -> unit = "gr_moveto" -external current_x : unit -> int = "gr_current_x" -external current_y : unit -> int = "gr_current_y" -let current_point () = current_x (), current_y () -external lineto : int -> int -> unit = "gr_lineto" -let rlineto x y = lineto (current_x () + x) (current_y () + y) -let rmoveto x y = moveto (current_x () + x) (current_y () + y) -external draw_rect : int -> int -> int -> int -> unit = "gr_draw_rect" -let draw_poly, draw_poly_line = - let dodraw close_flag points = - if Array.length points > 0 then begin - let (savex, savey) = current_point () in - moveto (fst points.(0)) (snd points.(0)); - for i = 1 to Array.length points - 1 do - let (x, y) = points.(i) in - lineto x y; - done; - if close_flag then lineto (fst points.(0)) (snd points.(0)); - moveto savex savey; - end; - in dodraw true, dodraw false -;; -let draw_segments segs = - let (savex, savey) = current_point () in - for i = 0 to Array.length segs - 1 do - let (x1, y1, x2, y2) = segs.(i) in - moveto x1 y1; - lineto x2 y2; - done; - moveto savex savey; -;; -external draw_arc : int -> int -> int -> int -> int -> int -> unit - = "gr_draw_arc" "gr_draw_arc_nat" -let draw_ellipse x y rx ry = draw_arc x y rx ry 0 360 -let draw_circle x y r = draw_arc x y r r 0 360 -external set_line_width : int -> unit = "gr_set_line_width" - -external fill_rect : int -> int -> int -> int -> unit = "gr_fill_rect" -external fill_poly : (int * int) array -> unit = "gr_fill_poly" -external fill_arc : int -> int -> int -> int -> int -> int -> unit - = "gr_fill_arc" "gr_fill_arc_nat" -let fill_ellipse x y rx ry = fill_arc x y rx ry 0 360 -let fill_circle x y r = fill_arc x y r r 0 360 - -(* Text *) - -external draw_char : char -> unit = "gr_draw_char" -external draw_string : string -> unit = "gr_draw_string" -external set_font : string -> unit = "gr_set_font" -external set_text_size : int -> unit = "gr_set_text_size" -external text_size : string -> int * int = "gr_text_size" - -(* Images *) - -type image - -let transp = -1 - -external make_image : color array array -> image = "gr_make_image" -external dump_image : image -> color array array = "gr_dump_image" -external draw_image : image -> int -> int -> unit = "gr_draw_image" -external create_image : int -> int -> image = "gr_create_image" -external blit_image : image -> int -> int -> unit = "gr_blit_image" - -let get_image x y w h = - let image = create_image w h in - blit_image image x y; - image - -(* Events *) - -type status = - { mouse_x : int; - mouse_y : int; - button : bool; - keypressed : bool; - key : char } - -type event = - Button_down - | Button_up - | Key_pressed - | Mouse_motion - | Poll - -external wait_next_event : event list -> status = "gr_wait_event" - -let mouse_pos () = - let e = wait_next_event [Poll] in (e.mouse_x, e.mouse_y) - -let button_down () = - let e = wait_next_event [Poll] in e.button - -let read_key () = - let e = wait_next_event [Key_pressed] in e.key - -let key_pressed () = - let e = wait_next_event [Poll] in e.keypressed - -(*** Sound *) - -external sound : int -> int -> unit = "gr_sound" - -(* Splines *) -let add (x1, y1) (x2, y2) = (x1 +. x2, y1 +. y2) -and sub (x1, y1) (x2, y2) = (x1 -. x2, y1 -. y2) -and middle (x1, y1) (x2, y2) = ((x1 +. x2) /. 2.0, (y1 +. y2) /. 2.0) -and area (x1, y1) (x2, y2) = abs_float (x1 *. y2 -. x2 *. y1) -and norm (x1, y1) = sqrt (x1 *. x1 +. y1 *. y1);; - -let test a b c d = - let v = sub d a in - let s = norm v in - area v (sub a b) <= s && area v (sub a c) <= s;; - -let spline a b c d = - let rec spl accu a b c d = - if test a b c d then d :: accu else - let a' = middle a b - and o = middle b c in - let b' = middle a' o - and d' = middle c d in - let c' = middle o d' in - let i = middle b' c' in - spl (spl accu a a' b' i) i c' d' d in - spl [a] a b c d;; - -let curveto b c (x, y as d) = - let float_point (x, y) = (float_of_int x, float_of_int y) in - let round f = int_of_float (f +. 0.5) in - let int_point (x, y) = (round x, round y) in - let points = - spline - (float_point (current_point ())) - (float_point b) (float_point c) (float_point d) in - draw_poly_line - (Array.of_list (List.map int_point points)); - moveto x y;; - diff --git a/otherlibs/graph/graphics.mli b/otherlibs/graph/graphics.mli deleted file mode 100644 index ff271ce556..0000000000 --- a/otherlibs/graph/graphics.mli +++ /dev/null @@ -1,374 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Xavier Leroy, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 1996 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(** Machine-independent graphics primitives. *) - -exception Graphic_failure of string -(** Raised by the functions below when they encounter an error. *) - - -(** {6 Initializations} *) - -val open_graph : string -> unit -(** Show the graphics window or switch the screen to graphic mode. - The graphics window is cleared and the current point is set - to (0, 0). The string argument is used to pass optional - information on the desired graphics mode, the graphics window - size, and so on. Its interpretation is implementation-dependent. - If the empty string is given, a sensible default is selected. *) - -val close_graph : unit -> unit -(** Delete the graphics window or switch the screen back to text mode. *) - -val set_window_title : string -> unit -(** Set the title of the graphics window. *) - -external clear_graph : unit -> unit = "gr_clear_graph" -(** Erase the graphics window. *) - -external size_x : unit -> int = "gr_size_x" -(** See {!Graphics.size_y}. *) - -external size_y : unit -> int = "gr_size_y" -(** Return the size of the graphics window. Coordinates of the screen - pixels range over [0 .. size_x()-1] and [0 .. size_y()-1]. - Drawings outside of this rectangle are clipped, without causing - an error. The origin (0,0) is at the lower left corner. *) - -(** {6 Colors} *) - -type color = int -(** A color is specified by its R, G, B components. Each component - is in the range [0..255]. The three components are packed in - an [int]: [0xRRGGBB], where [RR] are the two hexadecimal digits for - the red component, [GG] for the green component, [BB] for the - blue component. *) - -val rgb : int -> int -> int -> color -(** [rgb r g b] returns the integer encoding the color with red - component [r], green component [g], and blue component [b]. - [r], [g] and [b] are in the range [0..255]. *) - -external set_color : color -> unit = "gr_set_color" -(** Set the current drawing color. *) - -val background : color -(** See {!Graphics.foreground}.*) - -val foreground : color -(** Default background and foreground colors (usually, either black - foreground on a white background or white foreground on a - black background). - {!Graphics.clear_graph} fills the screen with the [background] color. - The initial drawing color is [foreground]. *) - - -(** {7 Some predefined colors} *) - -val black : color -val white : color -val red : color -val green : color -val blue : color -val yellow : color -val cyan : color -val magenta : color - - -(** {6 Point and line drawing} *) - -external plot : int -> int -> unit = "gr_plot" -(** Plot the given point with the current drawing color. *) - -val plots : (int * int) array -> unit -(** Plot the given points with the current drawing color. *) - -external point_color : int -> int -> color = "gr_point_color" -(** Return the color of the given point in the backing store - (see "Double buffering" below). *) - -external moveto : int -> int -> unit = "gr_moveto" -(** Position the current point. *) - -val rmoveto : int -> int -> unit -(** [rmoveto dx dy] translates the current point by the given vector. *) - -external current_x : unit -> int = "gr_current_x" -(** Return the abscissa of the current point. *) - -external current_y : unit -> int = "gr_current_y" -(** Return the ordinate of the current point. *) - -val current_point : unit -> int * int -(** Return the position of the current point. *) - -external lineto : int -> int -> unit = "gr_lineto" -(** Draw a line with endpoints the current point and the given point, - and move the current point to the given point. *) - -val rlineto : int -> int -> unit -(** Draw a line with endpoints the current point and the - current point translated of the given vector, - and move the current point to this point. *) - -val curveto : int * int -> int * int -> int * int -> unit -(** [curveto b c d] draws a cubic Bezier curve starting from - the current point to point [d], with control points [b] and - [c], and moves the current point to [d]. *) - -external draw_rect : int -> int -> int -> int -> unit = "gr_draw_rect" -(** [draw_rect x y w h] draws the rectangle with lower left corner - at [x,y], width [w] and height [h]. - The current point is unchanged. *) - -val draw_poly_line : (int * int) array -> unit -(** [draw_poly_line points] draws the line that joins the - points given by the array argument. - The array contains the coordinates of the vertices of the - polygonal line, which need not be closed. - The current point is unchanged. *) - -val draw_poly : (int * int) array -> unit -(** [draw_poly polygon] draws the given polygon. - The array contains the coordinates of the vertices of the - polygon. - The current point is unchanged. *) - -val draw_segments : (int * int * int * int) array -> unit -(** [draw_segments segments] draws the segments given in the array - argument. Each segment is specified as a quadruple - [(x0, y0, x1, y1)] where [(x0, y0)] and [(x1, y1)] are - the coordinates of the end points of the segment. - The current point is unchanged. *) - -external draw_arc : - int -> int -> int -> int -> int -> int -> - unit = "gr_draw_arc" "gr_draw_arc_nat" -(** [draw_arc x y rx ry a1 a2] draws an elliptical arc with center - [x,y], horizontal radius [rx], vertical radius [ry], from angle - [a1] to angle [a2] (in degrees). The current point is unchanged. *) - -val draw_ellipse : int -> int -> int -> int -> unit -(** [draw_ellipse x y rx ry] draws an ellipse with center - [x,y], horizontal radius [rx] and vertical radius [ry]. - The current point is unchanged. *) - -val draw_circle : int -> int -> int -> unit -(** [draw_circle x y r] draws a circle with center [x,y] and - radius [r]. The current point is unchanged. *) - -external set_line_width : int -> unit = "gr_set_line_width" -(** Set the width of points and lines drawn with the functions above. - Under X Windows, [set_line_width 0] selects a width of 1 pixel - and a faster, but less precise drawing algorithm than the one - used when [set_line_width 1] is specified. *) - -(** {6 Text drawing} *) - -external draw_char : char -> unit = "gr_draw_char" -(** See {!Graphics.draw_string}.*) - -external draw_string : string -> unit = "gr_draw_string" -(** Draw a character or a character string with lower left corner - at current position. After drawing, the current position is set - to the lower right corner of the text drawn. *) - -external set_font : string -> unit = "gr_set_font" -(** Set the font used for drawing text. - The interpretation of the arguments to [set_font] - is implementation-dependent. *) - -val set_text_size : int -> unit -(** Set the character size used for drawing text. - The interpretation of the arguments to [set_text_size] - is implementation-dependent. *) - -external text_size : string -> int * int = "gr_text_size" -(** Return the dimensions of the given text, if it were drawn with - the current font and size. *) - - -(** {6 Filling} *) - -external fill_rect : int -> int -> int -> int -> unit = "gr_fill_rect" -(** [fill_rect x y w h] fills the rectangle with lower left corner - at [x,y], width [w] and height [h], with the current color. *) - -external fill_poly : (int * int) array -> unit = "gr_fill_poly" -(** Fill the given polygon with the current color. The array - contains the coordinates of the vertices of the polygon. *) - -external fill_arc : - int -> int -> int -> int -> int -> int -> - unit = "gr_fill_arc" "gr_fill_arc_nat" -(** Fill an elliptical pie slice with the current color. The - parameters are the same as for {!Graphics.draw_arc}. *) - -val fill_ellipse : int -> int -> int -> int -> unit -(** Fill an ellipse with the current color. The - parameters are the same as for {!Graphics.draw_ellipse}. *) - -val fill_circle : int -> int -> int -> unit -(** Fill a circle with the current color. The - parameters are the same as for {!Graphics.draw_circle}. *) - - -(** {6 Images} *) - -type image -(** The abstract type for images, in internal representation. - Externally, images are represented as matrices of colors. *) - -val transp : color -(** In matrices of colors, this color represent a ``transparent'' - point: when drawing the corresponding image, all pixels on the - screen corresponding to a transparent pixel in the image will - not be modified, while other points will be set to the color - of the corresponding point in the image. This allows superimposing - an image over an existing background. *) - -external make_image : color array array -> image = "gr_make_image" -(** Convert the given color matrix to an image. - Each sub-array represents one horizontal line. All sub-arrays - must have the same length; otherwise, exception [Graphic_failure] - is raised. *) - -external dump_image : image -> color array array = "gr_dump_image" -(** Convert an image to a color matrix. *) - -external draw_image : image -> int -> int -> unit = "gr_draw_image" -(** Draw the given image with lower left corner at the given point. *) - -val get_image : int -> int -> int -> int -> image -(** Capture the contents of a rectangle on the screen as an image. - The parameters are the same as for {!Graphics.fill_rect}. *) - -external create_image : int -> int -> image = "gr_create_image" -(** [create_image w h] returns a new image [w] pixels wide and [h] - pixels tall, to be used in conjunction with [blit_image]. - The initial image contents are random, except that no point - is transparent. *) - -external blit_image : image -> int -> int -> unit = "gr_blit_image" -(** [blit_image img x y] copies screen pixels into the image [img], - modifying [img] in-place. The pixels copied are those inside the - rectangle with lower left corner at [x,y], and width and height - equal to those of the image. Pixels that were transparent in - [img] are left unchanged. *) - - -(** {6 Mouse and keyboard events} *) - -type status = - { mouse_x : int; (** X coordinate of the mouse *) - mouse_y : int; (** Y coordinate of the mouse *) - button : bool; (** true if a mouse button is pressed *) - keypressed : bool; (** true if a key has been pressed *) - key : char; (** the character for the key pressed *) - } -(** To report events. *) - - -type event = - Button_down (** A mouse button is pressed *) - | Button_up (** A mouse button is released *) - | Key_pressed (** A key is pressed *) - | Mouse_motion (** The mouse is moved *) - | Poll (** Don't wait; return immediately *) -(** To specify events to wait for. *) - - -external wait_next_event : event list -> status = "gr_wait_event" -(** Wait until one of the events specified in the given event list - occurs, and return the status of the mouse and keyboard at - that time. If [Poll] is given in the event list, return immediately - with the current status. If the mouse cursor is outside of the - graphics window, the [mouse_x] and [mouse_y] fields of the event are - outside the range [0..size_x()-1, 0..size_y()-1]. Keypresses - are queued, and dequeued one by one when the [Key_pressed] - event is specified. *) - -(** {6 Mouse and keyboard polling} *) - -val mouse_pos : unit -> int * int -(** Return the position of the mouse cursor, relative to the - graphics window. If the mouse cursor is outside of the graphics - window, [mouse_pos()] returns a point outside of the range - [0..size_x()-1, 0..size_y()-1]. *) - -val button_down : unit -> bool -(** Return [true] if the mouse button is pressed, [false] otherwise. *) - -val read_key : unit -> char -(** Wait for a key to be pressed, and return the corresponding - character. Keypresses are queued. *) - -val key_pressed : unit -> bool -(** Return [true] if a keypress is available; that is, if [read_key] - would not block. *) - - -(** {6 Sound} *) - -external sound : int -> int -> unit = "gr_sound" -(** [sound freq dur] plays a sound at frequency [freq] (in hertz) - for a duration [dur] (in milliseconds). *) - -(** {6 Double buffering} *) - -val auto_synchronize : bool -> unit -(** By default, drawing takes place both on the window displayed - on screen, and in a memory area (the ``backing store''). - The backing store image is used to re-paint the on-screen - window when necessary. - - To avoid flicker during animations, it is possible to turn - off on-screen drawing, perform a number of drawing operations - in the backing store only, then refresh the on-screen window - explicitly. - - [auto_synchronize false] turns on-screen drawing off. All - subsequent drawing commands are performed on the backing store - only. - - [auto_synchronize true] refreshes the on-screen window from - the backing store (as per [synchronize]), then turns on-screen - drawing back on. All subsequent drawing commands are performed - both on screen and in the backing store. - - The default drawing mode corresponds to [auto_synchronize true]. *) - -external synchronize : unit -> unit = "gr_synchronize" -(** Synchronize the backing store and the on-screen window, by - copying the contents of the backing store onto the graphics - window. *) - - -external display_mode : bool -> unit = "gr_display_mode" -(** Set display mode on or off. When turned on, drawings are done - in the graphics window; when turned off, drawings do not affect - the graphics window. This occurs independently of - drawing into the backing store (see the function {!Graphics.remember_mode} - below). Default display mode is on. *) - - -external remember_mode : bool -> unit = "gr_remember_mode" -(** Set remember mode on or off. When turned on, drawings are done - in the backing store; when turned off, the backing store is - unaffected by drawings. This occurs independently of drawing - onto the graphics window (see the function {!Graphics.display_mode} above). - Default remember mode is on. *) - - diff --git a/otherlibs/graph/graphicsX11.ml b/otherlibs/graph/graphicsX11.ml deleted file mode 100644 index 69f7b718d6..0000000000 --- a/otherlibs/graph/graphicsX11.ml +++ /dev/null @@ -1,42 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(* Module [GraphicsX11]: additional graphics primitives for the X Windows system *) - -type window_id = string - -external window_id : unit -> window_id = "gr_window_id" - -let subwindows = Hashtbl.create 13 - -external open_subwindow : int -> int -> int -> int -> window_id - = "gr_open_subwindow" -external close_subwindow : window_id -> unit - = "gr_close_subwindow" - -let open_subwindow ~x ~y ~width ~height = - let wid = open_subwindow x y width height in - Hashtbl.add subwindows wid (); - wid -;; - -let close_subwindow wid = - if Hashtbl.mem subwindows wid then begin - close_subwindow wid; - Hashtbl.remove subwindows wid - end else - raise (Graphics.Graphic_failure ("close_subwindow: no such subwindow: " ^ wid)) -;; - diff --git a/otherlibs/graph/graphicsX11.mli b/otherlibs/graph/graphicsX11.mli deleted file mode 100644 index ff55adf668..0000000000 --- a/otherlibs/graph/graphicsX11.mli +++ /dev/null @@ -1,31 +0,0 @@ -(***********************************************************************) -(* *) -(* Objective Caml *) -(* *) -(* Pierre Weis and Jun Furuse, projet Cristal, INRIA Rocquencourt *) -(* *) -(* Copyright 2001 Institut National de Recherche en Informatique et *) -(* en Automatique. All rights reserved. This file is distributed *) -(* under the terms of the GNU Library General Public License, with *) -(* the special exception on linking described in file ../../LICENSE. *) -(* *) -(***********************************************************************) - -(* $Id$ *) - -(** Additional graphics primitives for the X Windows system. *) - -type window_id = string - -val window_id : unit -> window_id -(** Return the unique identifier of the Caml graphics window. - The returned string is an unsigned 32 bits integer - in decimal form. *) - -val open_subwindow : x:int -> y:int -> width:int -> height:int -> window_id -(** Create a sub-window of the current Caml graphics window - and return its identifier. *) - -val close_subwindow : window_id -> unit -(** Close the sub-window having the given identifier. *) - diff --git a/otherlibs/graph/image.c b/otherlibs/graph/image.c deleted file mode 100644 index 8d47fc4e58..0000000000 --- a/otherlibs/graph/image.c +++ /dev/null @@ -1,105 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include "image.h" -#include <alloc.h> -#include <custom.h> - -static void gr_free_image(value im) -{ - XFreePixmap(grdisplay, Data_im(im)); - if (Mask_im(im) != None) XFreePixmap(grdisplay, Mask_im(im)); -} - -static struct custom_operations image_ops = { - "_image", - gr_free_image, - custom_compare_default, - custom_hash_default, - custom_serialize_default, - custom_deserialize_default -}; - -#define Max_image_mem 2000000 - -value gr_new_image(int w, int h) -{ - value res = alloc_custom(&image_ops, sizeof(struct grimage), - w * h, Max_image_mem); - Width_im(res) = w; - Height_im(res) = h; - Data_im(res) = XCreatePixmap(grdisplay, grwindow.win, w, h, - XDefaultDepth(grdisplay, grscreen)); - Mask_im(res) = None; - return res; -} - -value gr_create_image(value vw, value vh) -{ - gr_check_open(); - return gr_new_image(Int_val(vw), Int_val(vh)); -} - -value gr_blit_image(value im, value vx, value vy) -{ - int x = Int_val(vx); - int y = Int_val(vy); - gr_check_open(); - XCopyArea(grdisplay, grbstore.win, Data_im(im), grbstore.gc, - x, Bcvt(y) + 1 - Height_im(im), - Width_im(im), Height_im(im), - 0, 0); - return Val_unit; -} - -value gr_draw_image(value im, value vx, value vy) -{ - int x = Int_val(vx); - int y = Int_val(vy); - int wy = Wcvt(y) + 1 - Height_im(im); - int by = Bcvt(y) + 1 - Height_im(im); - - gr_check_open(); - if (Mask_im(im) != None) { - if(grremember_mode) { - XSetClipOrigin(grdisplay, grbstore.gc, x, by); - XSetClipMask(grdisplay, grbstore.gc, Mask_im(im)); - } - if(grdisplay_mode) { - XSetClipOrigin(grdisplay, grwindow.gc, x, wy); - XSetClipMask(grdisplay, grwindow.gc, Mask_im(im)); - } - } - if(grremember_mode) - XCopyArea(grdisplay, Data_im(im), grbstore.win, grbstore.gc, - 0, 0, - Width_im(im), Height_im(im), - x, by); - if(grdisplay_mode) - XCopyArea(grdisplay, Data_im(im), grwindow.win, grwindow.gc, - 0, 0, - Width_im(im), Height_im(im), - x, wy); - if (Mask_im(im) != None) { - if(grremember_mode) - XSetClipMask(grdisplay, grbstore.gc, None); - if(grdisplay_mode) - XSetClipMask(grdisplay, grwindow.gc, None); - } - if(grdisplay_mode) - XFlush(grdisplay); - return Val_unit; -} diff --git a/otherlibs/graph/image.h b/otherlibs/graph/image.h deleted file mode 100644 index 441da97fbc..0000000000 --- a/otherlibs/graph/image.h +++ /dev/null @@ -1,29 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -struct grimage { - int width, height; /* Dimensions of the image */ - Pixmap data; /* Pixels */ - Pixmap mask; /* Mask for transparent points, or None */ -}; - -#define Width_im(i) (((struct grimage *)Data_custom_val(i))->width) -#define Height_im(i) (((struct grimage *)Data_custom_val(i))->height) -#define Data_im(i) (((struct grimage *)Data_custom_val(i))->data) -#define Mask_im(i) (((struct grimage *)Data_custom_val(i))->mask) - -#define Transparent (-1) - -value gr_new_image(int w, int h); diff --git a/otherlibs/graph/libgraph.h b/otherlibs/graph/libgraph.h deleted file mode 100644 index 605c5a463f..0000000000 --- a/otherlibs/graph/libgraph.h +++ /dev/null @@ -1,84 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <stdio.h> -#include <X11/Xlib.h> -#include <X11/Xutil.h> -#include <mlvalues.h> - -struct canvas { - int w, h; /* Dimensions of the drawable */ - Drawable win; /* The drawable itself */ - GC gc; /* The associated graphics context */ -}; - -extern Display * grdisplay; /* The display connection */ -extern int grscreen; /* The screen number */ -extern Colormap grcolormap; /* The color map */ -extern struct canvas grwindow; /* The graphics window */ -extern struct canvas grbstore; /* The pixmap used for backing store */ -extern int grwhite, grblack; /* Black and white pixels for X */ -extern int grbackground; /* Background color for X - (used for CAML color -1) */ -extern Bool grdisplay_mode; /* Display-mode flag */ -extern Bool grremember_mode; /* Remember-mode flag */ -extern int grx, gry; /* Coordinates of the current point */ -extern int grcolor; /* Current *CAML* drawing color (can be -1) */ -extern XFontStruct * grfont; /* Current font */ -extern long grselected_events; /* Events we are interested in */ - -extern Bool direct_rgb; -extern int byte_order; -extern int bitmap_unit; -extern int bits_per_pixel; - -#define Wcvt(y) (grwindow.h - 1 - (y)) -#define Bcvt(y) (grbstore.h - 1 - (y)) -#define WtoB(y) ((y) + grbstore.h - grwindow.h) -#define BtoW(y) ((y) + grwindow.h - grbstore.h) -#define min(a,b) ((a) < (b) ? (a) : (b)) -#define max(a,b) ((a) > (b) ? (a) : (b)) - -#define DEFAULT_SCREEN_WIDTH 600 -#define DEFAULT_SCREEN_HEIGHT 450 -#define BORDER_WIDTH 2 -#define DEFAULT_WINDOW_NAME "Caml graphics" -#define DEFAULT_SELECTED_EVENTS \ - (ExposureMask | KeyPressMask | StructureNotifyMask) -#define DEFAULT_FONT "fixed" -#define SIZE_QUEUE 256 - -/* To handle events asynchronously */ -#ifdef HAS_ASYNC_IO -#define USE_ASYNC_IO -#define EVENT_SIGNAL SIGIO -#else -#ifdef HAS_SETITIMER -#define USE_INTERVAL_TIMER -#define EVENT_SIGNAL SIGALRM -#else -#define USE_ALARM -#define EVENT_SIGNAL SIGALRM -#endif -#endif - -extern void gr_fail(char *fmt, char *arg); -extern void gr_check_open(void); -extern unsigned long gr_pixel_rgb(int rgb); -extern int gr_rgb_pixel(long unsigned int pixel); -extern void gr_handle_event(XEvent *e); -extern void gr_init_color_cache(void); -extern void gr_init_direct_rgb_to_pixel(void); -extern value id_of_window( Window w ); diff --git a/otherlibs/graph/make_img.c b/otherlibs/graph/make_img.c deleted file mode 100644 index a0d15a824f..0000000000 --- a/otherlibs/graph/make_img.c +++ /dev/null @@ -1,95 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include "image.h" -#include <memory.h> - -value gr_make_image(value m) -{ - int width, height; - value im; - Bool has_transp; - XImage * idata, * imask; - char * bdata, * bmask; - int i, j, rgb; - value line; - GC gc; - - gr_check_open(); - height = Wosize_val(m); - if (height == 0) return gr_new_image(0, 0); - width = Wosize_val(Field(m, 0)); - for (i = 1; i < height; i++) - if (Wosize_val(Field(m, i)) != width) - gr_fail("make_image: lines of different lengths", NULL); - - /* Build an XImage for the data part of the image */ - idata = - XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen), - XDefaultDepth(grdisplay, grscreen), - ZPixmap, 0, NULL, width, height, - BitmapPad(grdisplay), 0); - - bdata = (char *) stat_alloc(height * idata->bytes_per_line); - idata->data = bdata; - has_transp = False; - - for (i = 0; i < height; i++) { - line = Field(m, i); - for (j = 0; j < width; j++) { - rgb = Int_val(Field(line, j)); - if (rgb == Transparent) { has_transp = True; rgb = 0; } - XPutPixel(idata, j, i, gr_pixel_rgb(rgb)); - } - } - - /* If the matrix contains transparent points, - build an XImage for the mask part of the image */ - if (has_transp) { - imask = - XCreateImage(grdisplay, DefaultVisual(grdisplay, grscreen), - 1, ZPixmap, 0, NULL, width, height, - BitmapPad(grdisplay), 0); - bmask = (char *) stat_alloc(height * imask->bytes_per_line); - imask->data = bmask; - - for (i = 0; i < height; i++) { - line = Field(m, i); - for (j = 0; j < width; j++) { - rgb = Int_val(Field(line, j)); - XPutPixel(imask, j, i, rgb != Transparent); - } - } - } else { - imask = NULL; - } - - /* Allocate the image and store the XImages into the Pixmaps */ - im = gr_new_image(width, height); - gc = XCreateGC(grdisplay, Data_im(im), 0, NULL); - XPutImage(grdisplay, Data_im(im), gc, idata, 0, 0, 0, 0, width, height); - XDestroyImage(idata); - XFreeGC(grdisplay, gc); - if (has_transp) { - Mask_im(im) = XCreatePixmap(grdisplay, grwindow.win, width, height, 1); - gc = XCreateGC(grdisplay, Mask_im(im), 0, NULL); - XPutImage(grdisplay, Mask_im(im), gc, imask, 0, 0, 0, 0, width, height); - XDestroyImage(imask); - XFreeGC(grdisplay, gc); - } - XFlush(grdisplay); - return im; -} diff --git a/otherlibs/graph/open.c b/otherlibs/graph/open.c deleted file mode 100644 index 3bc034ec36..0000000000 --- a/otherlibs/graph/open.c +++ /dev/null @@ -1,366 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include <string.h> -#include <fcntl.h> -#include <signal.h> -#include "libgraph.h" -#include <alloc.h> -#include <callback.h> -#include <fail.h> -#include <memory.h> -#ifdef HAS_UNISTD -#include <unistd.h> -#endif -#ifdef HAS_SETITIMER -#include <sys/time.h> -#endif - -Display * grdisplay = NULL; -int grscreen; -Colormap grcolormap; -int grwhite, grblack, grbackground; -struct canvas grwindow; -struct canvas grbstore; -Bool grdisplay_mode; -Bool grremember_mode; -int grx, gry; -int grcolor; -extern XFontStruct * grfont; -long grselected_events; -static Bool gr_initialized = False; -static char * window_name = NULL; - -static int gr_error_handler(Display *display, XErrorEvent *error); -static int gr_ioerror_handler(Display *display); -value gr_clear_graph(void); - -value gr_open_graph(value arg) -{ - char display_name[256], geometry_spec[64]; - char * p, * q; - XSizeHints hints; - int ret; - XEvent event; - int x, y, w, h; - XWindowAttributes attributes; - - if (gr_initialized) { - gr_clear_graph(); - } else { - - /* Parse the argument */ - for (p = String_val(arg), q = display_name; *p != 0 && *p != ' '; p++) - if (q < display_name + sizeof(display_name) - 1) *q++ = *p; - *q = 0; - while (*p == ' ') p++; - for (q = geometry_spec; *p != 0; p++) - if (q < geometry_spec + sizeof(geometry_spec) - 1) *q++ = *p; - *q = 0; - - /* Open the display */ - if (grdisplay == NULL) { - grdisplay = XOpenDisplay(display_name); - if (grdisplay == NULL) - gr_fail("Cannot open display %s", XDisplayName(display_name)); - grscreen = DefaultScreen(grdisplay); - grblack = BlackPixel(grdisplay, grscreen); - grwhite = WhitePixel(grdisplay, grscreen); - grbackground = grwhite; - grcolormap = DefaultColormap(grdisplay, grscreen); - } - - /* Set up the error handlers */ - XSetErrorHandler(gr_error_handler); - XSetIOErrorHandler(gr_ioerror_handler); - - /* Parse the geometry specification */ - hints.x = 0; - hints.y = 0; - hints.width = DEFAULT_SCREEN_WIDTH; - hints.height = DEFAULT_SCREEN_HEIGHT; - hints.flags = PPosition | PSize; - hints.win_gravity = 0; - - ret = XWMGeometry(grdisplay, grscreen, geometry_spec, "", BORDER_WIDTH, - &hints, &x, &y, &w, &h, &hints.win_gravity); - if (ret & (XValue | YValue)) { - hints.x = x; hints.y = y; hints.flags |= USPosition; - } - if (ret & (WidthValue | HeightValue)) { - hints.width = w; hints.height = h; hints.flags |= USSize; - } - - /* Initial drawing color is black */ - grcolor = 0; /* CAML COLOR */ - - /* Create the on-screen window */ - grwindow.w = hints.width; - grwindow.h = hints.height; - grwindow.win = - XCreateSimpleWindow(grdisplay, DefaultRootWindow(grdisplay), - hints.x, hints.y, hints.width, hints.height, - BORDER_WIDTH, grblack, grbackground); - p = window_name; - if (p == NULL) p = DEFAULT_WINDOW_NAME; - XSetStandardProperties(grdisplay, grwindow.win, p, p, - None, NULL, 0, &hints); - grwindow.gc = XCreateGC(grdisplay, grwindow.win, 0, NULL); - XSetBackground(grdisplay, grwindow.gc, grbackground); - XSetForeground(grdisplay, grwindow.gc, grblack); - - /* Require exposure, resize and keyboard events */ - grselected_events = DEFAULT_SELECTED_EVENTS; - XSelectInput(grdisplay, grwindow.win, grselected_events); - - /* Map the window on the screen and wait for the first Expose event */ - XMapWindow(grdisplay, grwindow.win); - do { XNextEvent(grdisplay, &event); } while (event.type != Expose); - - /* Get the actual window dimensions */ - XGetWindowAttributes(grdisplay, grwindow.win, &attributes); - grwindow.w = attributes.width; - grwindow.h = attributes.height; - - /* Create the pixmap used for backing store */ - grbstore.w = grwindow.w; - grbstore.h = grwindow.h; - grbstore.win = - XCreatePixmap(grdisplay, grwindow.win, grbstore.w, grbstore.h, - XDefaultDepth(grdisplay, grscreen)); - grbstore.gc = XCreateGC(grdisplay, grbstore.win, 0, NULL); - XSetBackground(grdisplay, grbstore.gc, grbackground); - - /* Clear the pixmap */ - XSetForeground(grdisplay, grbstore.gc, grbackground); - XFillRectangle(grdisplay, grbstore.win, grbstore.gc, - 0, 0, grbstore.w, grbstore.h); - XSetForeground(grdisplay, grbstore.gc, grblack); - - /* Set the display and remember modes on */ - grdisplay_mode = True ; - grremember_mode = True ; - - /* The global data structures are now correctly initialized. - In particular, gr_sigio_handler can now handle events safely. */ - gr_initialized = True; - - /* If possible, request that system calls be restarted after - the EVENT_SIGNAL signal. */ -#ifdef POSIX_SIGNALS -#ifdef SA_RESTART - { struct sigaction action; - sigaction(EVENT_SIGNAL, NULL, &action); - action.sa_flags |= SA_RESTART; - sigaction(EVENT_SIGNAL, &action, NULL); - } -#endif -#endif - -#ifdef USE_ASYNC_IO - /* If BSD-style asynchronous I/O are supported: - arrange for I/O on the connection to trigger the SIGIO signal */ - ret = fcntl(ConnectionNumber(grdisplay), F_GETFL, 0); - fcntl(ConnectionNumber(grdisplay), F_SETFL, ret | FASYNC); - fcntl(ConnectionNumber(grdisplay), F_SETOWN, getpid()); -#endif - } -#ifdef USE_INTERVAL_TIMER - /* If BSD-style interval timers are provided, use the real-time timer - to poll events. */ - { struct itimerval it; - it.it_interval.tv_sec = 0; - it.it_interval.tv_usec = 250000; - it.it_value.tv_sec = 0; - it.it_value.tv_usec = 250000; - setitimer(ITIMER_REAL, &it, NULL); - } -#endif -#ifdef USE_ALARM - /* The poor man's solution: use alarm to poll events. */ - alarm(1); -#endif - /* Position the current point at origin */ - grx = 0; - gry = 0; - /* Reset the color cache */ - gr_init_color_cache(); - gr_init_direct_rgb_to_pixel(); - return Val_unit; -} - -value gr_close_graph(void) -{ - if (gr_initialized) { -#ifdef USE_INTERVAL_TIMER - struct itimerval it; - it.it_value.tv_sec = 0; - it.it_value.tv_usec = 0; - setitimer(ITIMER_REAL, &it, NULL); -#endif - gr_initialized = False; - if (grfont != NULL) { XFreeFont(grdisplay, grfont); grfont = NULL; } - XFreeGC(grdisplay, grwindow.gc); - XDestroyWindow(grdisplay, grwindow.win); - XFreeGC(grdisplay, grbstore.gc); - XFreePixmap(grdisplay, grbstore.win); - XFlush(grdisplay); - } - return Val_unit; -} - -value id_of_window(Window win) -{ - char tmp[256]; - - sprintf(tmp, "%lu", (unsigned long)win); - return copy_string( tmp ); -} - -value gr_window_id(void) -{ - gr_check_open(); - return id_of_window(grwindow.win); -} - -value gr_set_window_title(value n) -{ - if (window_name != NULL) stat_free(window_name); - window_name = stat_alloc(strlen(String_val(n))); - strcpy(window_name, String_val(n)); - if (gr_initialized) { - XStoreName(grdisplay, grwindow.win, window_name); - XSetIconName(grdisplay, grwindow.win, window_name); - XFlush(grdisplay); - } - return Val_unit; -} - -value gr_clear_graph(void) -{ - gr_check_open(); - if(grremember_mode) { - XSetForeground(grdisplay, grbstore.gc, grwhite); - XFillRectangle(grdisplay, grbstore.win, grbstore.gc, - 0, 0, grbstore.w, grbstore.h); - XSetForeground(grdisplay, grbstore.gc, grcolor); - } - if(grdisplay_mode) { - XSetForeground(grdisplay, grwindow.gc, grwhite); - XFillRectangle(grdisplay, grwindow.win, grwindow.gc, - 0, 0, grwindow.w, grwindow.h); - XSetForeground(grdisplay, grwindow.gc, grcolor); - XFlush(grdisplay); - } - gr_init_color_cache(); - gr_init_direct_rgb_to_pixel(); - return Val_unit; -} - -value gr_size_x(void) -{ - gr_check_open(); - return Val_int(grwindow.w); -} - -value gr_size_y(void) -{ - gr_check_open(); - return Val_int(grwindow.h); -} - -value gr_synchronize(void) -{ - gr_check_open(); - XCopyArea(grdisplay, grbstore.win, grwindow.win, grwindow.gc, - 0, grbstore.h - grwindow.h, - grwindow.w, grwindow.h, - 0, 0); - XFlush(grdisplay); - return Val_unit ; -} - -value gr_display_mode(value flag) -{ - grdisplay_mode = Bool_val (flag); - return Val_unit ; -} - -value gr_remember_mode(value flag) -{ - grremember_mode = Bool_val(flag); - return Val_unit ; -} - -/* The gr_sigio_handler is called via the signal machinery in the bytecode - interpreter. The signal system ensures that this function will be - called either between two bytecode instructions, or during a blocking - primitive. In either case, not in the middle of an Xlib call. */ - -value gr_sigio_signal(value unit) -{ - return Val_int(EVENT_SIGNAL); -} - -value gr_sigio_handler(void) -{ - XEvent grevent; - - if (gr_initialized) { - while (XCheckMaskEvent(grdisplay, -1 /*all events*/, &grevent)) { - gr_handle_event(&grevent); - } - } -#ifdef USE_ALARM - alarm(1); -#endif - return Val_unit; -} - -/* Processing of graphic errors */ - -static value * graphic_failure_exn = NULL; - -void gr_fail(char *fmt, char *arg) -{ - char buffer[1024]; - - if (graphic_failure_exn == NULL) { - graphic_failure_exn = caml_named_value("Graphics.Graphic_failure"); - if (graphic_failure_exn == NULL) - invalid_argument("Exception Graphics.Graphic_failure not initialized, must link graphics.cma"); - } - sprintf(buffer, fmt, arg); - raise_with_string(*graphic_failure_exn, buffer); -} - -void gr_check_open(void) -{ - if (!gr_initialized) gr_fail("graphic screen not opened", NULL); -} - -static int gr_error_handler(Display *display, XErrorEvent *error) -{ - char errmsg[512]; - XGetErrorText(error->display, error->error_code, errmsg, sizeof(errmsg)); - gr_fail("Xlib error: %s", errmsg); - return 0; -} - -static int gr_ioerror_handler(Display *display) -{ - gr_fail("fatal I/O error", NULL); - return 0; -} diff --git a/otherlibs/graph/point_col.c b/otherlibs/graph/point_col.c deleted file mode 100644 index 8df0dfaf01..0000000000 --- a/otherlibs/graph/point_col.c +++ /dev/null @@ -1,32 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" - -value gr_point_color(value vx, value vy) -{ - int x = Int_val(vx); - int y = Int_val(vy); - XImage * im; - int rgb; - - gr_check_open(); - im = XGetImage(grdisplay, grbstore.win, x, Bcvt(y), 1, 1, (-1), ZPixmap); - rgb = gr_rgb_pixel(XGetPixel(im, 0, 0)); - XDestroyImage(im); - return Val_int(rgb); -} - - diff --git a/otherlibs/graph/sound.c b/otherlibs/graph/sound.c deleted file mode 100644 index 4b30622068..0000000000 --- a/otherlibs/graph/sound.c +++ /dev/null @@ -1,34 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" - -value gr_sound(value vfreq, value vdur) -{ - XKeyboardControl kbdcontrol; - - gr_check_open(); - kbdcontrol.bell_pitch = Int_val(vfreq); - kbdcontrol.bell_duration = Int_val(vdur); - XChangeKeyboardControl(grdisplay, KBBellPitch | KBBellDuration, - &kbdcontrol); - XBell(grdisplay, 0); - kbdcontrol.bell_pitch = -1; /* restore default value */ - kbdcontrol.bell_duration = -1; /* restore default value */ - XChangeKeyboardControl(grdisplay, KBBellPitch | KBBellDuration, - &kbdcontrol); - XFlush(grdisplay); - return Val_unit; -} diff --git a/otherlibs/graph/subwindow.c b/otherlibs/graph/subwindow.c deleted file mode 100644 index a97242de0b..0000000000 --- a/otherlibs/graph/subwindow.c +++ /dev/null @@ -1,45 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Jun Furuse, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 2001 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" - -value gr_open_subwindow(value vx, value vy, value width, value height) -{ - Window win; - - int h = Int_val(height); - int w = Int_val(width); - int x = Int_val(vx); - int y = Int_val(vy); - - gr_check_open(); - win = XCreateSimpleWindow(grdisplay, grwindow.win, - x, Wcvt(y + h), w, h, - 0, grblack, grbackground); - XMapWindow(grdisplay, win); - XFlush(grdisplay); - return (id_of_window (win)); -} - -value gr_close_subwindow(value wid) -{ - Window win; - - gr_check_open(); - sscanf( String_val(wid), "%lu", (unsigned long *)(&win) ); - XDestroyWindow(grdisplay, win); - XFlush(grdisplay); - return Val_unit; -} diff --git a/otherlibs/graph/text.c b/otherlibs/graph/text.c deleted file mode 100644 index ad41f2ff2a..0000000000 --- a/otherlibs/graph/text.c +++ /dev/null @@ -1,84 +0,0 @@ -/***********************************************************************/ -/* */ -/* Objective Caml */ -/* */ -/* Xavier Leroy, projet Cristal, INRIA Rocquencourt */ -/* */ -/* Copyright 1996 Institut National de Recherche en Informatique et */ -/* en Automatique. All rights reserved. This file is distributed */ -/* under the terms of the GNU Library General Public License, with */ -/* the special exception on linking described in file ../../LICENSE. */ -/* */ -/***********************************************************************/ - -/* $Id$ */ - -#include "libgraph.h" -#include <alloc.h> - -XFontStruct * grfont = NULL; - -static void gr_font(char *fontname) -{ - XFontStruct * font = XLoadQueryFont(grdisplay, fontname); - if (font == NULL) gr_fail("cannot find font %s", fontname); - if (grfont != NULL) XFreeFont(grdisplay, grfont); - grfont = font; - XSetFont(grdisplay, grwindow.gc, grfont->fid); - XSetFont(grdisplay, grbstore.gc, grfont->fid); -} - -value gr_set_font(value fontname) -{ - gr_check_open(); - gr_font(String_val(fontname)); - return Val_unit; -} - -value gr_set_text_size (value sz) -{ - return Val_unit; -} - -static void gr_draw_text(char *txt, int len) -{ - if (grfont == NULL) gr_font(DEFAULT_FONT); - if (grremember_mode) - XDrawString(grdisplay, grbstore.win, grbstore.gc, - grx, Bcvt(gry) - grfont->descent + 1, txt, len); - if (grdisplay_mode) { - XDrawString(grdisplay, grwindow.win, grwindow.gc, - grx, Wcvt(gry) - grfont->descent + 1, txt, len); - XFlush(grdisplay); - } - grx += XTextWidth(grfont, txt, len); -} - -value gr_draw_char(value chr) -{ - char str[1]; - gr_check_open(); - str[0] = Int_val(chr); - gr_draw_text(str, 1); - return Val_unit; -} - -value gr_draw_string(value str) -{ - gr_check_open(); - gr_draw_text(String_val(str), string_length(str)); - return Val_unit; -} - -value gr_text_size(value str) -{ - int width; - value res; - gr_check_open(); - if (grfont == NULL) gr_font(DEFAULT_FONT); - width = XTextWidth(grfont, String_val(str), string_length(str)); - res = alloc_small(2, 0); - Field(res, 0) = Val_int(width); - Field(res, 1) = Val_int(grfont->ascent + grfont->descent); - return res; -} |