aboutsummaryrefslogtreecommitdiffstats
path: root/turtlegr.c
diff options
context:
space:
mode:
Diffstat (limited to 'turtlegr.c')
-rw-r--r--turtlegr.c1298
1 files changed, 1298 insertions, 0 deletions
diff --git a/turtlegr.c b/turtlegr.c
new file mode 100644
index 0000000..c0245c8
--- /dev/null
+++ b/turtlegr.c
@@ -0,0 +1,1298 @@
+
+/* file turtlegr.c *
+ * Copyright (C) 1992 sjm@ee.tut.fi *
+ * jtl@cc.tut.fi *
+ * *
+ * Turtlegraphics primitives for the *
+ * SCM interpreter by Aubrey Jaffer *
+ * *
+ * Last modification: 13.10.1992 *
+ * *
+ * Versions: *
+ * 12.3.1992 The first version. *
+ * 13.3.1992 Added the possibility to pass *
+ * floating point args. *
+ * 15.3.1992 Graphics cards other than EGA *
+ * are now supported. *
+ * 9.4.1992 The internal representation *
+ * of X & Y is now float. *
+ * 13.10.1992 Added X11 support. *
+ * A major rewrite of certain *
+ * parts. *
+ * Put -DX11 -DFLOATS to CFLAGS *
+ * in Makefile to get it. *
+ * *
+ * REMEMBER to define INITS=init_turtlegr() *
+ * in the Makefile. *
+ * */
+
+/* *
+ * This code tries to compromise between two very different *
+ * systems: MSDOS and UNIX with the X11 windowing system. *
+ * The MSDOS version was build first and it really shows. :) *
+ * The X port is a partial rewrite of the old MSDOS stuff *
+ * and plays around with #ifdef's a lot. The result is, *
+ * eventually, a C source which is expected to compile *
+ * under both MSDOS and UNIX (X11). *
+ * The X code handles colors emulating CGA palette. It tries *
+ * to act sensibly even on a monochrome screen and when the *
+ * color palette is full. *
+ * X event handling is implemented with polling whenever *
+ * appropriate. This is not The Right Way to do it in X, but *
+ * it was easiest to adopt in this case. *
+ * Another solution would have been to make the X graphics *
+ * a separate process, but I didn't want to because I wanted *
+ * to keep it simple. I can't tell how good an example of porting *
+ * MSDOS software to X this is, but it works. *
+ * *
+ * This has been tested with SunOs 4.1.2 with X11R5, Linux 0.98.1 *
+ * with Xfree86 1.1 (X11R5 port) and in MSDOS with BC 3.1. *
+ * Because the code uses only the basic Xlib calls, it should *
+ * compile without problems under _any_ UNIX with X11R4 or newer. *
+ * *
+ * Please send bugreports to sjm@ee.tut.fi. *
+ * I'm especially interested in hearing about ports to other *
+ * platforms than those tested by me. *
+ * *
+ * - sjm *
+ * */
+
+
+/****************************************************/
+/***** GENERIC includes & defines *****/
+/****************************************************/
+#include "scm.h" /* includes scmfig.h as well */
+#include "patchlvl.h" /* Guess... */
+#include <math.h> /* sin(), cos(), fmod() */
+#include <stdlib.h> /* atexit() */
+
+/****************************************************/
+/***** X11 specific includes & defines *****/
+/****************************************************/
+#ifdef X11
+
+/* Xlib include files */
+# include <X11/Xlib.h>
+# include <X11/Xutil.h>
+# include <X11/Xatom.h>
+# include <stdio.h>
+
+# include "turtle"
+# define BITMAPDEPTH 1
+
+# define PROGNAME "scm"
+# define CLASSNAME "Scm"
+# define WINDOWNAME "TurtleSCM graphics window"
+# define ICONNAME "TurtleSCM"
+
+# define GR_MAX_XSIZE 1024
+# define GR_MAX_YSIZE 1024
+# define GR_DEF_XSIZE 640
+# define GR_DEF_YSIZE 480
+# define GR_MIN_XSIZE 64
+# define GR_MIN_YSIZE 64
+
+/* Fake CGA colormap with X - yuk! */
+# define GR_COLORS 16 /* CGA/EGA counterpart */
+# define GR_COLOR00 "black" /* black */
+# define GR_COLOR01 "blue2" /* blue */
+# define GR_COLOR02 "green2" /* green */
+# define GR_COLOR03 "cyan2" /* cyan */
+# define GR_COLOR04 "red3" /* red */
+# define GR_COLOR05 "magenta2" /* magenta */
+# define GR_COLOR06 "yellow2" /* brown */
+# define GR_COLOR07 "light gray" /* white */
+# define GR_COLOR08 "gray" /* gray */
+# define GR_COLOR09 "blue1" /* light blue */
+# define GR_COLOR10 "green1" /* light green */
+# define GR_COLOR11 "cyan1" /* light cyan */
+# define GR_COLOR12 "red1" /* light red */
+# define GR_COLOR13 "magenta1" /* light magenta */
+# define GR_COLOR14 "yellow1" /* yellow */
+# define GR_COLOR15 "white" /* bright white */
+
+# ifdef __STDC__
+static void gr_events( int );
+# else
+static void gr_events();
+# endif
+
+#else
+/****************************************************/
+/***** PC specific includes & defines *****/
+/****************************************************/
+# include <graphics.h>
+# include <stdlib.h> /* for getenv() */
+# include <stdio.h> /* for fputs() */
+# define BGIDIR_ENVSTRING "BGIDIR"
+#endif
+
+/********************************************/
+/***** GENERIC code, declarations *****/
+/********************************************/
+#define SIN( x ) \
+ sin( ((x)/180.0) * M_PI )
+#define COS( x ) \
+ cos( ((x)/180.0) * M_PI )
+
+static int gr_graphicsavail = 0;
+static int gr_grmode_on = 0;
+static float gr_dir = 0.0;
+static int gr_max_x=0, gr_max_y=0, gr_max_color=0;
+static float gr_x=0.0, gr_y=0.0;
+static int gr_color = 0;
+
+static char s_gr_draw[] = "draw";
+static char s_gr_move[] = "move";
+static char s_gr_setcolor[] = "set-color!";
+static char s_gr_turnright[] = "turn-right";
+static char s_gr_turnleft[] = "turn-left";
+static char s_gr_turnto[] = "turn-to!";
+
+static char s_gr_getdot[] = "get-dot";
+static char s_gr_drawTo[] = "draw-to!";
+static char s_gr_drawto[] = "draw-to";
+static char s_gr_moveTo[] = "move-to!";
+
+static char s_gr_setdot[] = "set-dot!";
+static char s_gr_validXYC[] = "valid-xyc?";
+
+#ifdef __GNUC__
+inline
+#else
+static
+#endif
+int valid_XYC( x, y, color )
+int x, y, color;
+{
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ if( (x <= gr_max_x) && (y <= gr_max_y) && (color <= gr_max_color)
+ && (x >= 0) && (y >= 0) && (color >= 0) )
+ return( 1 );
+ else
+ return( 0 );
+} /* valid_XYC() */
+
+
+/********************************************************************/
+/***** X11 specific variable and function declarations *****/
+/********************************************************************/
+#ifdef X11
+static Display *gr_display; /* The X display */
+static int gr_screen; /* The X screen number */
+static Window gr_win; /* The drawable Window */
+static GC gr_gc; /* Graphics Context */
+static unsigned long gr_colortbl[GR_COLORS]; /* Color table */
+static XEvent gr_event; /* Event structure */
+
+/* These are needed for XSetWMProperties */
+static char *gr_windowname = WINDOWNAME;
+static char *gr_iconname = ICONNAME;
+static char gr_progname[] = PROGNAME;
+static char gr_classname[] = CLASSNAME;
+static int gr_argc = 1;
+static char *gr_argv[] = { gr_progname, NULL };
+
+static void gr_eventhandler( event )
+XEvent event;
+{
+ switch( event.type ) {
+
+ case ConfigureNotify:
+# ifdef TESTING
+ fputs( "Received ConfigureNotify event\n", stderr );
+# endif
+ gr_max_x = event.xconfigure.width - 1;
+ gr_max_y = event.xconfigure.height - 1;
+ break;
+
+ case MapNotify:
+# ifdef TESTING
+ fputs( "Received MapNotify event\n", stderr );
+# endif
+ break;
+
+ case DestroyNotify:
+# ifdef TESTING
+ fputs( "Received DestroyNotify event\n", stderr );
+# endif
+ break;
+
+ case UnmapNotify:
+# ifdef TESTING
+ fputs( "Received UnmapNotify event\n", stderr );
+# endif
+ break;
+
+ case Expose:
+# ifdef TESTING
+ fputs( "Received Expose event\n", stderr );
+# endif
+ if( event.xexpose.count != 0 )
+ break;
+ break;
+
+ case ClientMessage:
+# ifdef TESTING
+ fputs( "Received ClientMessage event\n", stderr );
+# endif
+ break;
+
+ default:
+ /* Throw away any unknown events */
+ break;
+
+ } /* switch */
+}
+
+static void gr_events( expected )
+int expected;
+{
+int i;
+
+ /* Get at least 'expected' events */
+ for( i = 0; i < expected; ++i ) {
+ XNextEvent( gr_display, &gr_event );
+ gr_eventhandler( gr_event );
+ }
+ /* Handle all remaining events if there are any */
+ /* XPending will call XFlush() if it doesn't find events at once */
+ while( XPending(gr_display) ) {
+ XNextEvent( gr_display, &gr_event );
+ gr_eventhandler( gr_event );
+ } /* while */
+} /* gr_events() */
+
+static void gr_typedevent( type )
+int type;
+{
+ do {
+ XNextEvent( gr_display, &gr_event );
+ gr_eventhandler( gr_event );
+ } while( gr_event.type != type );
+ /* Handle all remaining events if there are any */
+ /* XPending will call XFlush() if it doesn't find events at once */
+ while( XPending(gr_display) ) {
+ XNextEvent( gr_display, &gr_event );
+ gr_eventhandler( gr_event );
+ } /* while */
+}
+
+
+/********************************************************************/
+/***** PC specific variable and function declarations *****/
+/********************************************************************/
+#else
+
+static int gr_max_display_mode;
+static int gr_drivernum;
+
+#endif
+
+
+/********************************************************************/
+/********************************************************************/
+/*** User callable SCM routines begin here ***
+ *** ***
+ *** ***/
+
+
+SCM gr_helpgr()
+{
+ fputs( "\
+Ret Name nargs args returns\n\
+---------------------------------------------------------\n\
+B graphics-avail? 0 - #t if graphics available\n\
+B graphics-mode! 0 - #f if no graphics\n\
+B text-mode! 0 - #t on success\n\
+B clear-graphics! 0 - #f if not in graphics mode\n\
+i max-x 0 - maximum value of x\n\
+i max-y 0 - maximum value of y\n\
+i max-color 0 - maximum value of color\n\
+B valid-xyc? 3 x y color #t if valid\n\
+B set-dot! 3 x y color #t on success\n\
+i get-dot 2 x y color of the dot in (x,y)\n\
+ or #f if (x,y) not legal\n\
+\n\
+NOTE: Origin (0,0) is in the upper left corner.\n\n\
+", stdout );
+ return BOOL_T;
+} /* gr_helpgr() */
+
+
+SCM gr_helpturtlegr()
+{
+ fputs( "\
+Ret Name nargs args returns\n\
+---------------------------------------------------------\n\
+B goto-home! 0 - #f if not in graphics mode\n\
+B goto-center! 0 - #f if not in graphics mode\n\
+B goto-nw! 0 - #f if not in graphics mode\n\
+B goto-ne! 0 - #f if not in graphics mode\n\
+B goto-sw! 0 - #f if not in graphics mode\n\
+B goto-se! 0 - #f if not in graphics mode\n\
+B draw 1 length #t if target within drawing area\n\
+B draw-to 2 x y #t if (x,y) within drawing area\n\
+B draw-to! 2 x y #t if (x,y) within drawing area\n\
+B move 1 length #t if target within drawing area\n\
+B move-to! 2 x y #t if (x,y) within drawing area\n\
+i where-x 0 - current x-coordinate\n\
+i where-y 0 - current y-coordinate\n\
+i turn-right 1 angle drawing direction in degrees\n\
+i turn-left 1 angle drawing direction in degrees\n\
+i turn-to! 1 angle drawing direction in degrees\n\
+i what-direction 0 - drawing direction in degrees\n\
+B set-color! 1 color #t if color valid\n\
+i what-color 0 - current drawing color\n\n\
+", stdout );
+ return BOOL_T;
+} /* gr_helpturtlegr() */
+
+
+SCM gr_available()
+{
+ if( gr_graphicsavail )
+ return BOOL_T;
+ else
+ return BOOL_F;
+} /* gr_available() */
+
+
+SCM gr_maxx()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ return MAKINUM( (long)gr_max_x );
+} /* gr_maxx() */
+
+
+SCM gr_maxy()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ return MAKINUM( (long)gr_max_y );
+} /* gr_maxy() */
+
+SCM gr_maxc()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ return MAKINUM( (long)gr_max_color );
+} /* gr_maxc() */
+
+
+SCM gr_validXYC( x, y, c )
+SCM x, y, c;
+{
+int xi, yi, ci;
+
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_validXYC );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_validXYC );
+ ASRTER( NUMBERP(c), c, ARG3, s_gr_validXYC );
+ if( !gr_grmode_on )
+ return BOOL_F;
+
+ if( INUMP(x) )
+ xi = (int)(INUM(x));
+ else
+ xi = (int)(REALPART(x));
+
+ if( INUMP(y) )
+ yi = (int)(INUM(y));
+ else
+ yi = (int)(REALPART(y));
+
+ if( INUMP(c) )
+ ci = (int)(INUM(c));
+ else
+ ci = (int)(REALPART(c));
+
+/* valid_XYC() calls gr_events() */
+
+ if( valid_XYC( xi, yi, ci ) )
+ return BOOL_T;
+ else
+ return BOOL_F;
+} /* gr_validXYC() */
+
+
+SCM gr_grmode()
+{
+ if( !gr_graphicsavail )
+ return BOOL_F;
+#ifdef X11
+ /* bwuah... but it works :) */
+ if( !gr_grmode_on ) {
+ XMapWindow( gr_display, gr_win );
+ gr_typedevent( MapNotify );
+ }
+#else /* PC version */
+ setgraphmode( gr_max_display_mode );
+#endif
+ gr_grmode_on = 1;
+ return BOOL_T;
+} /* gr_grmode() */
+
+SCM gr_txtmode()
+{
+ if( !gr_graphicsavail )
+ return BOOL_F;
+#ifdef X11
+ /* bwuah... but it works :) */
+ if( gr_grmode_on ) {
+ XUnmapWindow( gr_display, gr_win );
+ gr_typedevent( UnmapNotify );
+ }
+#else /* PC version */
+ restorecrtmode();
+#endif
+ gr_grmode_on = 0;
+ return BOOL_T;
+} /* gr_txtmode() */
+
+
+SCM gr_cleargraph()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ XClearWindow( gr_display, gr_win );
+ gr_events(0);
+#else /* PC version */
+ cleardevice();
+#endif
+ return BOOL_T;
+} /* gr_cleargraph() */
+
+
+SCM gr_setdot( x, y, c )
+SCM x, y, c;
+{
+int xi, yi, ci;
+
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_setdot );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_setdot );
+ ASRTER( NUMBERP(c), c, ARG3, s_gr_setdot );
+ if( !gr_grmode_on )
+ return BOOL_F;
+
+ if( INUMP(x) )
+ xi = (int)(INUM(x));
+ else
+ xi = (int)(REALPART(x));
+
+ if( INUMP(y) )
+ yi = (int)(INUM(y));
+ else
+ yi = (int)(REALPART(y));
+
+ if( INUMP(c) )
+ ci = (int)(INUM(c));
+ else
+ ci = (int)(REALPART(c));
+#ifdef TESTING
+ fprintf( stderr, "set-dot! called (%d,%d,%d)\n", xi, yi, ci );
+#endif
+ if( !valid_XYC( xi, yi, ci ) )
+ return BOOL_F;
+#ifdef X11
+ /* Set the drawing color */
+ XSetForeground( gr_display, gr_gc, gr_colortbl[ ci ] );
+ XDrawPoint( gr_display, gr_win, gr_gc, xi, yi );
+ /* Restore the drawing color */
+ XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] );
+ gr_events(0);
+#else /* PC version */
+ putpixel( xi, yi, ci );
+#endif
+ return BOOL_T;
+} /* gr_setdot() */
+
+
+SCM gr_getdot( x, y )
+SCM x, y;
+{
+int xi, yi;
+#ifdef X11
+XImage *xim;
+XWindowAttributes wattr;
+unsigned long dot;
+int i;
+#endif
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_getdot );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_getdot );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(x) )
+ xi = (int)(INUM(x));
+ else
+ xi = (int)(REALPART(x));
+
+ if( INUMP(y) )
+ yi = (int)(INUM(y));
+ else
+ yi = (int)(REALPART(y));
+#ifdef TESTING
+ fprintf( stderr, "get-dot called (%d,%d)\n", xi, yi );
+#endif
+ if( !valid_XYC( xi, yi, 0 ) )
+ return BOOL_F;
+#ifdef X11
+ /* Now, this IS ugly. But it's there if you need it. */
+
+ /* Have to make sure that the window is mapped. Tough... */
+ XGetWindowAttributes( gr_display, gr_win, &wattr );
+ if( wattr.map_state == IsUnmapped ) {
+ XMapWindow( gr_display, gr_win );
+ gr_typedevent( MapNotify );
+ }
+ /* I KNOW this sucks. */
+ xim = XGetImage( gr_display, gr_win, xi, yi, 1, 1, AllPlanes, XYPixmap );
+ dot = XGetPixel( xim, 0, 0 );
+ for( i = 0; i < GR_COLORS; ++i ) {
+ if( gr_colortbl[i] == dot )
+ return MAKINUM( (long)i );
+ }
+ /* This should never happen. There's garbage in the window! */
+ fprintf( stderr, "%s: %s: Got an illegal pixel value %lu. \
+Is there garbage?\n", gr_progname, s_gr_getdot, dot );
+ return BOOL_F;
+#else /* PC version */
+ return MAKINUM( (long)getpixel( xi, yi ) );
+#endif
+} /* gr_getdot() */
+
+SCM gr_draw( S )
+SCM S;
+{
+float xf, yf;
+float sf;
+int ok;
+
+ ASRTER( NUMBERP(S), S, ARG1, s_gr_draw );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(S) )
+ sf = (float)(INUM(S));
+ else
+ sf = REALPART(S);
+#ifdef TESTING
+ fprintf( stderr, "draw called (%f)\n", sf );
+#endif
+ ok = 1;
+ xf = gr_x + ( COS( gr_dir ) * sf );
+ yf = gr_y + ( SIN( gr_dir ) * sf );
+ if( (int)xf > gr_max_x ) {
+ xf = (float)gr_max_x;
+ ok = 0;
+ }
+ else if( xf < 0.0 ) {
+ xf = 0.0;
+ ok = 0;
+ }
+ if( (int)yf > gr_max_y ) {
+ yf = (float)gr_max_y;
+ ok = 0;
+ }
+ else if( yf < 0.0 ) {
+ yf = 0.0;
+ ok = 0;
+ }
+#ifdef X11
+ XDrawLine( gr_display, gr_win, gr_gc,
+ (int)gr_x, (int)gr_y,
+ (int)xf, (int)yf );
+ gr_events(0);
+#else /* PC version */
+ line( (int)gr_x, (int)gr_y, (int)xf, (int)yf );
+#endif
+ gr_x = xf;
+ gr_y = yf;
+ if( ok )
+ return BOOL_T;
+ else
+ return BOOL_F;
+} /* gr_draw() */
+
+
+SCM gr_move( S )
+SCM S;
+{
+float xf, yf;
+float sf;
+int ok;
+
+ ASRTER( NUMBERP(S), S, ARG1, s_gr_move );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(S) )
+ sf = (float)(INUM(S));
+ else
+ sf = REALPART(S);
+#ifdef TESTING
+ fprintf( stderr, "move called (%f)\n", sf );
+#endif
+ ok = 1;
+ xf = gr_x + ( COS( gr_dir ) * sf );
+ yf = gr_y + ( SIN( gr_dir ) * sf );
+
+ if( (int)xf > gr_max_x ) {
+ xf = (float)gr_max_x;
+ ok = 0;
+ }
+ else if( xf < 0.0 ) {
+ xf = 0.0;
+ ok = 0;
+ }
+ if( (int)yf > gr_max_y ) {
+ yf = (float)gr_max_y;
+ ok = 0;
+ }
+ else if( yf < 0.0 ) {
+ yf = 0.0;
+ ok = 0;
+ }
+ gr_x = xf;
+ gr_y = yf;
+ if( ok )
+ return BOOL_T;
+ else
+ return BOOL_F;
+} /* gr_move() */
+
+
+SCM gr_drawto( x, y )
+SCM x, y;
+{
+int xi, yi;
+
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_drawto );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_drawto );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(x) )
+ xi = (int)(INUM(x));
+ else
+ xi = (int)(REALPART(x));
+
+ if( INUMP(y) )
+ yi = (int)(INUM(y));
+ else
+ yi = (int)(REALPART(y));
+#ifdef TESTING
+ fprintf( stderr, "draw-to called (%d,%d)\n", xi, yi );
+#endif
+ if( !valid_XYC( xi, yi, 0 ) )
+ return BOOL_F;
+#ifdef X11
+ XDrawLine( gr_display, gr_win, gr_gc,
+ (int)gr_x, (int)gr_y, xi, yi );
+ gr_events(0);
+#else /* PC version */
+ line( (int)gr_x, (int)gr_y, xi, yi );
+#endif
+ return BOOL_T;
+} /* gr_drawto() */
+
+
+SCM gr_drawTo( x, y )
+SCM x, y;
+{
+float xf, yf;
+
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_drawTo );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_drawTo );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(x) )
+ xf = (float)(INUM(x));
+ else
+ xf = (REALPART(x));
+
+ if( INUMP(y) )
+ yf = (float)(INUM(y));
+ else
+ yf = (REALPART(y));
+#ifdef TESTING
+ fprintf( stderr, "draw-to! called (%d,%d)\n", (int)xf, (int)yf );
+#endif
+ if( !valid_XYC( (int)xf, (int)yf, 0 ) )
+ return BOOL_F;
+#ifdef X11
+ XDrawLine( gr_display, gr_win, gr_gc,
+ (int)gr_x, (int)gr_y,
+ (int)xf, (int)yf );
+ gr_events(0);
+#else /* PC version */
+ line( (int)gr_x, (int)gr_y, (int)xf, (int)yf );
+#endif
+ gr_x = xf;
+ gr_y = yf;
+ return BOOL_T;
+} /* gr_drawTo() */
+
+
+SCM gr_moveTo( x, y )
+SCM x, y;
+{
+float xf, yf;
+
+ ASRTER( NUMBERP(x), x, ARG1, s_gr_moveTo );
+ ASRTER( NUMBERP(y), y, ARG2, s_gr_moveTo );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(x) )
+ xf = (float)(INUM(x));
+ else
+ xf = (REALPART(x));
+
+ if( INUMP(y) )
+ yf = (float)(INUM(y));
+ else
+ yf = (REALPART(y));
+#ifdef TESTING
+ fprintf( stderr, "move-to! called (%d,%d)\n", (int)xf, (int)yf );
+#endif
+ if( !valid_XYC( (int)xf, (int)yf, 0 ) )
+ return BOOL_F;
+ gr_x = xf;
+ gr_y = yf;
+ return BOOL_T;
+} /* gr_moveTo() */
+
+
+SCM gr_setcolor( c )
+SCM c;
+{
+int color;
+
+ ASRTER( NUMBERP(c), c, ARG1, s_gr_setcolor );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(c) )
+ color = (int)(INUM(c));
+ else
+ color = (int)(REALPART(c));
+#ifdef TESTING
+ fprintf( stderr, "set-color! called (%d)\n", color );
+#endif
+ if( !valid_XYC( 0, 0, color ) )
+ return BOOL_F;
+ gr_color = color;
+#ifdef X11
+ /* Set the drawing color */
+ XSetForeground( gr_display, gr_gc, gr_colortbl[ gr_color ] );
+ gr_events(0);
+#else /* PC version */
+ setcolor( gr_color );
+#endif
+ return BOOL_T;
+} /* gr_setcolor() */
+
+
+SCM gr_turnright( d )
+SCM d;
+{
+float df;
+
+ ASRTER( NUMBERP(d), d, ARG1, s_gr_turnright );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(d) )
+ df = (float)(INUM(d));
+ else
+ df = REALPART(d);
+ df = fmod( df, 360.0 );
+ gr_dir -= df;
+ gr_dir = fmod( gr_dir, 360.0 );
+ return MAKINUM( (long)(gr_dir+.5) );
+} /* gr_turnright() */
+
+
+SCM gr_turnleft( d )
+SCM d;
+{
+float df;
+
+ ASRTER( NUMBERP(d), d, ARG1, s_gr_turnleft );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(d) )
+ df = (float)(INUM(d));
+ else
+ df = REALPART(d);
+ df = fmod( df, 360.0 );
+ gr_dir += df;
+ gr_dir = fmod( gr_dir, 360.0 );
+ return MAKINUM( (long)(gr_dir+.5) );
+} /* gr_turnleft() */
+
+
+SCM gr_turnto( d )
+SCM d;
+{
+float df;
+
+ ASRTER( NUMBERP(d), d, ARG1, s_gr_turnto );
+ if( !gr_grmode_on )
+ return BOOL_F;
+ if( INUMP(d) )
+ df = (float)(INUM(d));
+ else
+ df = REALPART(d);
+ df = fmod( df, 360.0 );
+ gr_dir = df;
+ return MAKINUM( (long)(gr_dir+.5) );
+} /* gr_turnto() */
+
+
+SCM gr_gotohome()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ gr_x = gr_y = 0.0;
+ return BOOL_T;
+} /* gr_gotohome() */
+
+
+SCM gr_gotocenter()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ gr_x = ((float)gr_max_x+1.0) / 2.0;
+ gr_y = ((float)gr_max_y+1.0) / 2.0;
+ return BOOL_T;
+} /* gr_gotocenter() */
+
+
+SCM gr_gotonw()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ gr_x = 0.0;
+ gr_y = 0.0;
+ return BOOL_T;
+} /* gr_gotonw() */
+
+
+SCM gr_gotosw()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ gr_x = 0.0;
+ gr_y = (float)gr_max_y;
+ return BOOL_T;
+} /* gr_gotosw() */
+
+
+SCM gr_gotone()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ gr_x = (float)gr_max_x;
+ gr_y = 0.0;
+ return BOOL_T;
+} /* gr_gotone() */
+
+
+SCM gr_gotose()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+#ifdef X11
+ /* Check for changed window size */
+ gr_events(0);
+#endif
+ gr_x = (float)gr_max_x;
+ gr_y = (float)gr_max_y;
+ return BOOL_T;
+} /* gr_gotose() */
+
+
+SCM gr_whatcolor()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ return MAKINUM( (long)gr_color );
+} /* gr_whatcolor() */
+
+
+SCM gr_whatdirection()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ return MAKINUM( (long)(gr_dir+.5) );
+} /* gr_whatdirection() */
+
+
+SCM gr_wherex()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ return MAKINUM( (long)gr_x );
+} /* gr_wherex() */
+
+
+SCM gr_wherey()
+{
+ if( !gr_grmode_on )
+ return BOOL_F;
+ return MAKINUM( (long)gr_y );
+} /* gr_wherey() */
+
+
+static iproc graph0[] = {
+ { "help-gr", gr_helpgr },
+ { "help-turtlegr", gr_helpturtlegr },
+ { "graphics-mode!", gr_grmode },
+ { "text-mode!", gr_txtmode },
+ { "clear-graphics!", gr_cleargraph },
+ { "graphics-avail?", gr_available },
+ { "max-x", gr_maxx },
+ { "max-y", gr_maxy },
+ { "max-color", gr_maxc },
+ { "what-color", gr_whatcolor },
+ { "what-direction", gr_whatdirection },
+ { "where-x", gr_wherex },
+ { "where-y", gr_wherey },
+ { "goto-home!", gr_gotohome },
+ { "goto-center!", gr_gotocenter },
+ { "goto-nw!", gr_gotonw },
+ { "goto-sw!", gr_gotosw },
+ { "goto-ne!", gr_gotone },
+ { "goto-se!", gr_gotose },
+ {0, 0}
+ };
+
+static iproc graph1[] = {
+ { s_gr_draw, gr_draw },
+ { s_gr_move, gr_move },
+ { s_gr_setcolor, gr_setcolor },
+ { s_gr_turnright, gr_turnright },
+ { s_gr_turnleft, gr_turnleft },
+ { s_gr_turnto, gr_turnto },
+ {0, 0}
+ };
+
+static iproc graph2[] = {
+ { s_gr_getdot, gr_getdot },
+ { s_gr_drawTo, gr_drawTo },
+ { s_gr_drawto, gr_drawto },
+ { s_gr_moveTo, gr_moveTo },
+ {0, 0}
+ };
+
+static iproc graph3[] = {
+ { s_gr_setdot, gr_setdot },
+ { s_gr_validXYC, gr_validXYC },
+ {0, 0}
+ };
+
+#if defined __STDC__ || defined __TURBOC__
+void close_turtlegr()
+{
+# ifdef X11
+ gr_events(0);
+ XFreeColors( gr_display, DefaultColormap(gr_display, gr_screen),
+ gr_colortbl, GR_COLORS, AllPlanes );
+ XFreeGC( gr_display, gr_gc );
+ XUnmapWindow( gr_display, gr_win );
+ XDestroyWindow( gr_display, gr_win );
+# else /* PC version */
+ closegraph();
+# endif
+} /* close_turtlegr() */
+#endif
+
+void init_banner(); /* from scm.c */
+
+void init_turtlegr() /* detects if graphics is available; must be
+ called among program initializations */
+{
+#ifdef X11
+ char *display_name = NULL; /* Server to connect to */
+ Pixmap icon_pixmap; /* Icon */
+ XSizeHints size_hints; /* Preferred sizes */
+ XSetWindowAttributes win_attribs; /* Window attributes */
+ XWMHints wm_hints; /* Window manager hints */
+ XClassHint class_hints; /* Class hints */
+ XTextProperty window_name, icon_name; /* Names for Icon & Window */
+ XGCValues gc_values; /* Graphics Context values */
+ static char *colorname[GR_COLORS] = {
+ GR_COLOR00, GR_COLOR01, GR_COLOR02, GR_COLOR03,
+ GR_COLOR04, GR_COLOR05, GR_COLOR06, GR_COLOR07,
+ GR_COLOR08, GR_COLOR09, GR_COLOR10, GR_COLOR11,
+ GR_COLOR12, GR_COLOR13, GR_COLOR14, GR_COLOR15
+ };
+ XColor x_color; /* X11 Color structure */
+ unsigned long mask; /* Mask for selections */
+ int i; /* loop counter variable */
+
+#else /* PC version */
+int errcode;
+#endif
+
+/***************************/
+/* generic initializations */
+/***************************/
+ gr_x = gr_y = gr_dir = 0.0;
+ gr_max_x = gr_max_y = gr_max_color = 0;
+
+ gr_graphicsavail = 0; /* DEFAULT is no graphics - you can do without */
+
+/********************************************/
+/***** Initialize X11 turtlegraphics *****/
+/********************************************/
+#ifdef X11
+ /* connect to X server */
+ if( (gr_display = XOpenDisplay(display_name)) != NULL )
+ {
+
+ /*****************************/
+ /* connection to X server OK */
+ /*****************************/
+
+ gr_screen = DefaultScreen( gr_display ); /* X screen number */
+
+ /* Create a window with Black background and border */
+ gr_win
+ = XCreateSimpleWindow( gr_display,
+ RootWindow( gr_display, gr_screen),
+ 0, 0, /* initial placement */
+ GR_DEF_XSIZE, GR_DEF_YSIZE,
+ 3, /* border width */
+ /* border pixel value */
+ BlackPixel(gr_display, gr_screen),
+ /* background pixel value */
+ BlackPixel(gr_display, gr_screen) );
+
+ /* Select input (events) for the window */
+ XSelectInput( gr_display, gr_win,
+ StructureNotifyMask|ExposureMask );
+
+ /* Check for backing store capability */
+ if( !DoesBackingStore(DefaultScreenOfDisplay(gr_display)) )
+ {
+ fprintf( stderr, "%s: Warning: \
+X server does not offer backing store capability.\n\
+Window cannot be redrawn if obscured. Sorry...\n", gr_progname );
+ }
+ else
+ {
+ /* Enable the backing store feature of X server
+ and set bit gravity */
+ win_attribs.bit_gravity = NorthWestGravity;
+ win_attribs.backing_store = Always;
+ mask = CWBitGravity | CWBackingStore;
+ XChangeWindowAttributes( gr_display, gr_win, mask, &win_attribs );
+ }
+
+ /* Make names of Window and Icon for window manager */
+ if( XStringListToTextProperty(&gr_windowname, 1, &window_name) == 0 ) {
+ (void)fprintf( stderr, "%s: Structure allocation for windowName\
+ failed.\n", gr_progname );
+ exit( 42 );
+ }
+ if( XStringListToTextProperty(&gr_iconname, 1, &icon_name) == 0 ) {
+ (void)fprintf( stderr, "%s: Structure allocation for iconName\
+ failed.\n", gr_progname );
+ exit( 42 );
+ }
+
+ /* Create the icon */
+ icon_pixmap = XCreateBitmapFromData( gr_display, gr_win, turtle_bits,
+ turtle_width, turtle_height );
+
+ /* Window size, state, icon etc. hints for the window manager */
+ size_hints.flags = PPosition | PMaxSize | PMinSize | USSize;
+ /* position and desired size are given to XCreateSimpleWindow call */
+ size_hints.min_width = GR_MIN_XSIZE;
+ size_hints.min_height = GR_MIN_YSIZE;
+ size_hints.max_width = GR_MAX_XSIZE;
+ size_hints.max_height = GR_MAX_YSIZE;
+ wm_hints.flags = StateHint | IconPixmapHint | InputHint;
+ wm_hints.initial_state = NormalState;
+ wm_hints.input = False;
+ wm_hints.icon_pixmap = icon_pixmap;
+ class_hints.res_name = gr_progname;
+ class_hints.res_class = gr_classname;
+ XSetWMProperties( gr_display, gr_win, &window_name, &icon_name,
+ gr_argv, gr_argc,
+ &size_hints, &wm_hints, &class_hints );
+
+
+ /* Handle colors; this is quite complicated in X11 */
+
+ if( DefaultDepth( gr_display, gr_screen ) == 1 )
+ {
+ /* Only 1 bitplane, BW screen */
+ /* Emulate colors with 0 as Black and 1-15 White */
+ gr_colortbl[0] = BlackPixel( gr_display, gr_screen );
+ for( i = 1; i < GR_COLORS; ++i )
+ gr_colortbl[i] = WhitePixel( gr_display, gr_screen );
+# ifdef TESTING
+ fprintf( stderr, "%s: 1-plane system, substituting White for \
+colors 1-15.\n", gr_progname );
+ fprintf( stderr, "%s: Pixel value is %lu for Black, \
+%lu for White\n", gr_progname, gr_colortbl[0], gr_colortbl[1] );
+# endif
+ }
+ else
+ {
+ /* more than 1 bitplane */
+ for( i = 0; i < GR_COLORS; ++i )
+ {
+ /* Initialize the colortable using named colors */
+ if( XParseColor( gr_display,
+ DefaultColormap(gr_display, gr_screen),
+ colorname[ i ], &x_color ) )
+ {
+ if( !XAllocColor( gr_display,
+ DefaultColormap(gr_display, gr_screen),
+ &x_color ) )
+ {
+ fprintf( stderr, "%s: Can't allocate color \
+\"%s\" (%d). Substituting White.\n",
+ gr_progname,
+ colorname[ i ], i );
+ gr_colortbl[i] = WhitePixel( gr_display, gr_screen );
+ }
+ else
+ {
+ /* succeeded in allocating color */
+ gr_colortbl[ i ] = x_color.pixel;
+# ifdef TESTING
+ fprintf( stderr, "%s: Pixel value is %lu for %s.\n",
+ gr_progname, gr_colortbl[i], colorname[i] );
+# endif
+ }
+ }
+ else
+ {
+ /* could not parse color */
+ fprintf( stderr,
+ "%s: Color name \"%s\" (%d) not in database. \
+Substituting White.\n",
+ gr_progname, colorname[i], i );
+ gr_colortbl[i] = WhitePixel( gr_display, gr_screen );
+ }
+ } /* for */
+ } /* else */
+ gr_max_color = GR_COLORS - 1;
+
+ /* Create and initialize a default GC */
+ gr_gc = XCreateGC( gr_display, gr_win, 0L, &gc_values );
+
+ /* Initialize the drawing color, default's black */
+ XSetForeground( gr_display, gr_gc, gr_colortbl[ 0 ] );
+ XSetBackground( gr_display, gr_gc, gr_colortbl[ 0 ] );
+ gr_color = 0;
+
+ /* OK, we _do_ have graphics available */
+ gr_graphicsavail = 1;
+
+# ifdef __STDC__
+ /* Let's do the Right Thing if possible :) */
+ atexit( close_turtlegr );
+# endif
+ } /* if */
+ else {
+ gr_graphicsavail = 0;
+ }
+/********************************************/
+/***** Initialize PC turtlegraphics *****/
+/********************************************/
+#else /* PC version */
+ gr_drivernum = DETECT;
+
+ detectgraph( &gr_drivernum, &gr_max_display_mode );
+ if( gr_drivernum != grNotDetected ) {
+ if( !getenv( BGIDIR_ENVSTRING ) )
+ fprintf( stderr,
+ "You really should set the %s environment variable.\n",
+ BGIDIR_ENVSTRING );
+ initgraph( &gr_drivernum, &gr_max_display_mode,
+ getenv( BGIDIR_ENVSTRING ) );
+ errcode = graphresult();
+ if( errcode != grOk ) {
+ fputs( "Graphics error: ", stderr );
+ fputs( grapherrormsg( errcode ), stderr );
+ exit( EXIT_FAILURE );
+ }
+ moveto( 0, 0 );
+ gr_x = gr_y = 0.0;
+ setcolor( 0 );
+ gr_color = 0;
+ gr_max_x = getmaxx();
+ gr_max_y = getmaxy();
+ gr_max_color = getmaxcolor();
+ gr_max_display_mode = getmaxmode();
+ restorecrtmode();
+ gr_graphicsavail = 1;
+ atexit( close_turtlegr );
+ }
+ else {
+ gr_graphicsavail = 0;
+ }
+#endif
+
+/* generic */
+ init_iprocs( graph0, tc7_subr_0 );
+ init_iprocs( graph1, tc7_subr_1 );
+ init_iprocs( graph2, tc7_subr_2 );
+ init_iprocs( graph3, tc7_subr_3 );
+ gr_grmode_on = 0;
+
+#ifndef X11
+ /* PC version clears screen so this must be repeated */
+ init_banner();
+#endif
+
+ fputs("\nSCM Turtlegraphics Copyright (C) 1992 sjm@cc.tut.fi, jtl@cc.tut.fi\n\
+Type `(help-gr)' or `(help-turtlegr)' for a quick reference of\n\
+the new primitives.\n", stderr);
+
+ if( !gr_graphicsavail ) {
+#ifdef X11
+ fprintf( stderr, "%s: No X server found. \
+Turtlegraphics not available.\n", gr_progname );
+#else
+ fputs( "No graphics adapter detected. \
+Turtlegraphics not available.\n", stderr );
+#endif
+ }
+ else {
+#ifdef X11
+ gr_events(0);
+#else
+ ;
+#endif
+ }
+} /* init_turtlegr() */
generated by cgit v1.2.3 (git 2.39.1) at 2024-04-27 12:08:33 +0000