Import Upstream version 5e2upstream/5e2

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() */