⟦b33d9651a⟧

TextFile

/*          Hey EMACS, this is -*- C -*- code!                 */

/****************************************************************
*                                                               *
*                         Copyright (c) 1984                    *
*               Massachusetts Institute of Technology           *
*                                                               *
* This material was developed by the Scheme project at the      *
* Massachusetts Institute of Technology, Department of          *
* Electrical Engineering and Computer Science.  Permission to   *
* copy this software, to redistribute it, and to use it for any *
* purpose is granted, subject to the following restrictions and *
* understandings.                                               *
*                                                               *
* 1. Any copy made of this software must include this copyright *
* notice in full.                                               *
*                                                               *
* 2. Users of this software agree to make their best efforts (a)*
* to return to the MIT Scheme project any improvements or       *
* extensions that they make, so that these may be included in   *
* future releases; and (b) to inform MIT of noteworthy uses of  *
* this software.                                                *
*                                                               *
* 3.  All materials developed as a consequence of the use of    *
* this software shall duly acknowledge such use, in accordance  *
* with the usual standards of acknowledging credit in academic  *
* research.                                                     *
*                                                               *
* 4. MIT has made no warrantee or representation that the       *
* operation of this software will be error-free, and MIT is     *
* under no obligation to provide any services, by way of        *
* maintenance, update, or otherwise.                            *
*                                                               *
* 5.  In conjunction with products arising from the use of this *
* material, there shall be no use of the name of the            *
* Massachusetts Institute of Technology nor of any adaptation   *
* thereof in any advertising, promotional, or sales literature  *
* without prior written consent from MIT in each case.          *
*                                                               *
****************************************************************/

#include "scheme.h"
#include "primitive.h"
#include "flonum.h"
\f


/* Athena graphics primitives.
 *
 * The following 10 routines are the graphics primitives for the VAX
 * when using a VT125 or VS100 type terminal or equivalent.  The routines
 * mostly use the same primitive procedure slots as in the 68000 version.
 */

#ifndef ATHENA
#include "Error: Athena graphics only work on Athena"
#endif

#define YES			    1
#define NO			    0

#define GRAPHICS_TEXT_TOP	   22
#define NORMAL_TEXT_TOP		    1
#define TEXT_BOTTOM		   24

#define VT125			    0
#define VS100			    1

#define ESC			'\033'

#define Check_Graphics_Status(Arg_No)        				\
        if (graphics_initialized == NO)					\
        { printf("You have not yet initialized graphics.\n");		\
 	  if (Arg_No != 0) return NIL;					\
        }

#define If_Error(Err)                                                   \
        if (Err == 1)                                                   \
        Primitive_Error(ERR_ARG_1_WRONG_TYPE);                          \
	if (Err == 2)                                                   \
 	Primitive_Error(ERR_ARG_2_WRONG_TYPE);

static int first_time = YES;
static int graphics_initialized = NO;
static int term_type;
static long line_mode = 0;
\f


/* The following are the external graphics routines in the penplot package */

extern erase_(), move_(), draw_(), vt125_(), line_(), endplt_(), pen_(), 
       where_(), rotate_();

Get_Position(ppos1, ppos2, arg1, arg2)
fast Pointer arg1, arg2;
float *ppos1, *ppos2;
{ long temp;
  if (Type_Code(arg1) == TC_FIXNUM)
  { Sign_Extend(arg1, temp);
    *ppos1 = (float) temp;
  }
  else if (Type_Code(arg1) != TC_BIG_FLONUM) return(1);
  else *ppos1 = (float) Get_Float(arg1);
  if (Type_Code(arg2) == TC_FIXNUM)
  { Sign_Extend(arg2, temp);
    *ppos2 = (float) temp;
  }
  else if (Type_Code(arg2) != TC_BIG_FLONUM) return(2);
  else *ppos2 = (float) Get_Float(arg2);
  return(0);
}

/* (GRAPHICS_CLEAR)
      Clear the graphics section of the screen.  Uses the penplot ERASE
      procedure.
*/
Define_Primitive(Prim_Graphics_Clear, 0, "GRAPHICS-CLEAR")
{ float left, right, bottom, top;
  Primitive_0_Args();
  Check_Graphics_Status(0);
  left = -512;
  bottom = -375;
  right = 511;
  top = 375;
  area_(&left, &right, &bottom, &top);
  erase_();
  return NIL;
}
\f


/* (GRAPHICS_MOVE ARG1 ARG2)
      Uses the penplot routine MOVE to pick up the pen and move to the
      position indicated by ARG1 and ARG2.  Both must be Scheme FIXNUMs
      or FLONUMs.
*/
Define_Primitive(Prim_Graphics_Move, 2, "GRAPHICS-MOVE")
{ float pos1, pos2;
  int Error_Number;
  Primitive_2_Args();
  Check_Graphics_Status(2);
  Error_Number = Get_Position(&pos1, &pos2, Arg1, Arg2);
  If_Error(Error_Number)
  move_(&pos1, &pos2);
  return NIL;
}
\f


/* (GRAPHICS_DRAW ARG1 ARG2 ARG3)
      Uses the penplot routine DRAW to first make sure the current
      pen is down and uses the current line type to draw to position
      indicated by ARG1 and ARG2.  ARG3 is either 0 or 1 which indicates
      whether the line should be drawn in the current foreground color 
      or the background color respectfully.  TSEND forces graphics buffer
      to be drawn, so that each line is drawn when wanted.
*/
Define_Primitive(Prim_Graphics_Draw, 3, "GRAPHICS-DRAW")
{ float pos1, pos2;
  int Error_Number;
  long mode;
  Primitive_3_Args();
  Check_Graphics_Status(3);
  Error_Number = Get_Position(&pos1, &pos2, Arg1, Arg2);
  If_Error(Error_Number)
  mode = (long) Get_Integer(Arg3);
  if (mode != line_mode)
  { line_mode = mode;
    pmode_(&line_mode);
  }
  draw_(&pos1, &pos2);
  tsend_();
  return NIL;
}
\f


/* (GRAPHICS_PIXEL ARG1 ARG2 ARG3)
      This routine plots one point on the screen at ARG1, ARG2.  Again,
      ARG1 and ARG2 must FIXNUMs or FLONUMs.  ARG3 is the same as in 
      GRAPHCIS_DRAW.
*/
Define_Primitive(Prim_Graphics_Pixel, 3, "GRAPHICS-PIXEL")
{ float pos1, pos2;
  int Error_Number;
  long mode;
  Primitive_3_Args();
  Check_Graphics_Status(3);
  Error_Number = Get_Position(&pos1, &pos2, Arg1, Arg2);
  If_Error(Error_Number)
  mode = (long) Get_Integer(Arg3);
  if (mode != line_mode)
  { line_mode = mode;
    pmode_(&line_mode);
  }
  move_(&pos1, &pos2);
  draw_(&pos1, &pos2);
  tsend_();
  return NIL;
}

/* (GRAPHICS_SET_LINE STYLE)
      Used to change the style of the line to dashes or dots and 
      dashes or whatever.  Uses penplot LINE procedure.
*/
Define_Primitive(Prim_Graphics_Set_Line, 1, "SET-LINE-STYLE")
{ long line_type;
  Primitive_1_Arg();
  Check_Graphics_Status(1);
  Arg_1_Type(TC_FIXNUM);
  line_type = (long) Get_Integer(Arg1);
  line_(&line_type);
  return NIL;
}
\f


/* (GRAPHICS_DONE)
      When finished user will call this routine to finish things up and
      restore the terminal to normal operating conditions.
*/
Define_Primitive(Prim_Graphics_Done, 0, "GRAPHICS-DONE")
{ Primitive_0_Args();
  if (graphics_initialized == YES)
  { if (term_type == VT125)
    { erase_();
      printf("%c[2J%c[%d;%dr%c[%d;%df", ESC, ESC, NORMAL_TEXT_TOP, 
                                        TEXT_BOTTOM, ESC, NORMAL_TEXT_TOP, 1);
    }
    else endplt_();
  }
  graphics_initialized = NO;
  return NIL;
}
\f


/* (GRAPHICS_PEN PEN)
      Select pen.  There are four pen numbers.  Pen 0 is the background.
      Initially pen 1 is blue, pen 2 is red and pen 3 is green.  Pen 3
      is also the pen used for normal input to the terminal.  Uses the 
      penplot PEN routine.  On a real vt125, the pen are just different
      intensities, and on a vs100, this has no effect.
*/
Define_Primitive(Prim_Graphics_Pen, 1, "GRAPHICS-PEN")
{ long npen;
  Primitive_1_Arg();
  Check_Graphics_Status(1);
  Arg_1_Type(TC_FIXNUM);
  npen = (long) Get_Integer(Arg1);
  pen_(&npen);
  return NIL;
}

/* (GRAPHICS_POSITION)
      Returns in cons cell the current pen position on the graphics
      screen.  Uses penlot WHERE which returns two floating point
      numbers.
*/
Define_Primitive(Prim_Graphics_Position, 0, "GRAPHICS-POSITION")
{ float pos1, pos2;
  Pointer *Cons_Cell;
  double floor();
  Primitive_0_Args();
  Check_Graphics_Status(0);
  Cons_Cell = Free;
  Primitive_GC_If_Needed(Free + 2);
  Free += 2;
  where_(&pos1, &pos2);
  Store_Reduced_Flonum_Result((double) pos1, Cons_Cell[CONS_CAR]);
  Store_Reduced_Flonum_Result((double) pos2, Cons_Cell[CONS_CDR]);
  return Make_Pointer(TC_LIST, Cons_Cell); 
}
\f


/* (GRAPHICS_DEFINE_PEN ARG-LIST)
      This procedure will change the characteristics of any of the four
      pens.  Will require four arguments, the pen number, the color as
      specified on a color wheel, the percent light intensity, and the
      percent saturation.  Does not use penplot, instead it writes directly
      to the VT125 using the ReGis graphics that are part of the VT125,
      therefore, there is no effect on a vs100.
*/
Define_Primitive(Prim_Graphics_Define_Pen, 1, "GRAPHICS-DEFINE-PEN")
{ int args[3], i = 0;
  Pointer temp;
  Primitive_1_Arg();
  Check_Graphics_Status(1);
  if (term_type == VT125)
  { while (Type_Code(Arg1) == TC_LIST)
    { temp = Vector_Ref(Arg1, CONS_CAR);
      if (Type_Code(temp) != TC_FIXNUM)
	Primitive_Error(ERR_ARG_1_WRONG_TYPE);
      args[i++] = (int) Get_Integer(temp);
      Arg1 = Vector_Ref(Arg1, CONS_CDR);
    }
    if (i != 4)
      Primitive_Error(ERR_WRONG_NUMBER_OF_ARGUMENTS);
    printf("%cPpS(M%d(AH%dL%dS%d))%c\\",
            ESC, args[0], args[1], args[2], args[3], ESC);
  }
  return NIL;
}
\f


/* (GRAPHICS_INITIALIZE)
      Need to initialize penplot for the VT125's (the only terminals
      on which these graphics will work).  Will eventually check the 
      user's environment to make sure that the current terminal is 
      a VT125.
*/
Define_Primitive(Prim_Graphics_Initialize, 0, "GRAPHICS-INITIALIZE")
{ char *term, *getenv();
  float left, right, bottom, top;
  int strcmp();
  Primitive_0_Args();
  if (first_time == NO)
  { if (term_type == VT125)
      printf("%c[2J%c[%d;%dr%c[%d;%df", ESC, ESC, GRAPHICS_TEXT_TOP,
	 			        TEXT_BOTTOM, ESC,
					GRAPHICS_TEXT_TOP, 1);
    else terminal_();
    graphics_initialized = YES;
  }
  else
  { term = getenv("TERM");
    if (strcmp(term, "vt125") == 0) term_type = VT125;
    else if (strcmp(term, "vs100") == 0) term_type = VS100;
    else Primitive_Error(ERR_EXTERNAL_RETURN);
    terminal_();
    graphics_initialized = YES;
    first_time = NO;
  }
  left = -512;
  bottom = -375;
  right = 511;
  top = 375;
  area_(&left, &right, &bottom, &top);
  return NIL;
}
\f


/* (GRAPHICS_LABEL STRING)
      Prints a string label at the current pen position.  The label is
      written according to the current letter type as defined by 
      GRAPHICS_LETTER.
*/
Define_Primitive(Prim_Graphics_Label, 1, "GRAPHICS-LABEL")
{ char *user_label;
  int length;
  Primitive_1_Arg();
  Check_Graphics_Status(1);
  Arg_1_Type(TC_CHARACTER_STRING);
  user_label = Scheme_String_To_C_String(Arg1);
  length = (int) Get_Integer(Vector_Ref(Arg1, STRING_LENGTH));
  label_(user_label, length);
  tsend_();
  return NIL;
}

/* (GRAPHICS_SET_LETTER ARG-LIST)
      This routine will change the way in which letters are drawn for the
      penplot LABEL routine.  The default values are HEIGHT = 3, ASPECT = .7,
      ROTATE = 0, and SLANT = 0.
*/
Define_Primitive(Prim_Graphics_Set_Letter, 1, "GRAPHICS-SET-LETTER")
{ float args[3];
  int i = 0;
  Pointer temp;
  Primitive_1_Arg();
  Check_Graphics_Status(1);
  Arg_1_Type(TC_LIST);
  while (Type_Code(Arg1) == TC_LIST)
  { temp = Vector_Ref(Arg1, CONS_CAR);
    if (Type_Code(temp) == TC_FIXNUM)
    { long intemp;
      Sign_Extend(temp, intemp);
      args[i++] = (float) intemp;
    }
    else if (Type_Code(temp) ==  TC_BIG_FLONUM)
      args[i++] = (float) Get_Float(temp);
    else Primitive_Error(ERR_ARG_1_WRONG_TYPE);
    Arg1 = Vector_Ref(Arg1, CONS_CDR);
  }
  if (i != 4)
    Primitive_Error(ERR_WRONG_NUMBER_OF_ARGUMENTS);
  letter_(&args[0], &args[1], &args[2], &args[3]);
  return NIL;
}

/* (GRAPHICS_SCyL3)
      One must call this routine to set up for three dimensional graphics.
      After calling this, the user can use GRAPHICS_SPLOT3 to draw in the 
      three dimensional region set up here.
*/
Define_Primitive(Prim_Graphics_Scl3, 2, "GRAPHICS-SCL3")
{ float args[8];
  long ibox;
  int i = 0;
  Pointer temp;
  Primitive_2_Args();
  Check_Graphics_Status(2);
  Arg_1_Type(TC_LIST);
  Arg_2_Type(TC_FIXNUM);
  while (Type_Code(Arg1) == TC_LIST)
  { temp = Vector_Ref(Arg1, CONS_CAR);
    if (Type_Code(temp) == TC_FIXNUM)
    { long intemp;
      Sign_Extend(temp, intemp);
      args[i++] = (float) intemp;
    }
    else if (Type_Code(temp) == TC_BIG_FLONUM)
      args[i++] = (float) Get_Float(temp);
    else Primitive_Error(ERR_ARG_1_WRONG_TYPE);
    Arg1 = Vector_Ref(Arg1, CONS_CDR);
  }
  if (i != 9)
    Primitive_Error(ERR_WRONG_NUMBER_OF_ARGUMENTS);
  ibox = (long) Get_Integer(Arg2);
  scl3_(&args[0], &args[1], &args[2], &args[3], &args[4],
        &args[5], &args[6], &args[7], &args[8], &ibox);
  tsend_();
  return NIL;
}
\f


/* (GRAPHICS_SPLOT3 LIST_OF_COORDS PEN)
      This procedure allows one to draw in a three dimensional region as
      defined by the arguments given to SCL3.
*/
Define_Primitive(Prim_Graphics_Splot3, 2, "GRAPHICS-SPLOT3")
{ float args[2];
  int i = 0;
  long ipen;
  Pointer temp;
  Primitive_2_Args();
  Check_Graphics_Status(2);
  Arg_1_Type(TC_LIST);
  Arg_2_Type(TC_FIXNUM);
  while (Type_Code(Arg1) == TC_LIST)
  { temp = Vector_Ref(Arg1, CONS_CAR);
    if (Type_Code(temp) == TC_FIXNUM)
    { long intemp;
      Sign_Extend(temp, intemp);
      args[i++] = (float) intemp;
    }
    else if (Type_Code(temp) == TC_BIG_FLONUM)
      args[i++] = (float) Get_Float(temp);
    else Primitive_Error(ERR_ARG_1_WRONG_TYPE);
    Arg1 = Vector_Ref(Arg1, CONS_CDR);
  }
  if (i != 3)
   Primitive_Error(ERR_WRONG_NUMBER_OF_ARGUMENTS);
  ipen = (long) Get_Integer(Arg2);
  splot3_(&args[0], &args[1], &args[2], &ipen);
  tsend_();
  return NIL;
}
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦b33d9651a⟧ TextFile

Derivation

TextFile
