From ae2b295c7deaf2d7c18ad1ed9b6050970e56bae7 Mon Sep 17 00:00:00 2001 From: Bryan Newbold Date: Mon, 20 Feb 2017 00:05:31 -0800 Subject: Import Upstream version 5e2 --- turtlegr.c | 1298 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 1298 insertions(+) create mode 100644 turtlegr.c (limited to 'turtlegr.c') 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 /* sin(), cos(), fmod() */ +#include /* atexit() */ + +/****************************************************/ +/***** X11 specific includes & defines *****/ +/****************************************************/ +#ifdef X11 + +/* Xlib include files */ +# include +# include +# include +# include + +# 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 +# include /* for getenv() */ +# include /* 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() */ -- cgit v1.2.3