path: root/turtlegr.c

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