/*********************************************************************/
/*                                                                   */
/*    Graphics routines - version 89.10.22                           */
/*                                                                   */
/*********************************************************************/

#include "exec/types.h"
#include "exec/io.h"
#include "intuition/intuition.h"
#include "devices/printer.h"
#include "comal/comal.h"

#define GRAPH_OPEN 1
#define SCREEN_OPEN GRAPH_OPEN << 1
#define WINDOW_OPEN SCREEN_OPEN << 1
#define TMPRAS_OPEN WINDOW_OPEN << 1

#define RP GraphWindow->RPort

#define AND &&
#define OR ||
#define begin {
#define end }

struct Point
  begin
    short x;
    short y;
  end;

struct FltPoint
  begin
    CmlFlt x;
    CmlFlt y;
  end;

extern char CmlConIn();
extern UBYTE CmlTstBrk();
extern CmlFlt IntFloat();
extern int FloatInt();

void CloseGraph(), SetRatio(), Line(), fill();

struct package *packagestr;
struct comalstr *comalstr;
struct IntuitionBase *IntuitionBase;
struct GfxBase *GfxBase;
struct Screen *GraphScreen;
struct Window *GraphWindow;

/*
static struct TmpRas TRas;
static PLANEPTR TBuf;
*/

static short OpenFlags = 0;
static short FlipWindow = 0;
static BYTE PenColor, BackColor;

static short MaxHeight,MaxWidth,Depth,BorderTop,BorderLeft;
static short VPXmin, VPYmin, VPXmax, VPYmax;
static struct FltPoint CurrentPoint;

short pen_x, pen_y;

static long zero = 0, one = 1; 
static CmlFlt WindowXmin, WindowXmax, WindowYmin, WindowYmax;
static CmlFlt RatioX, RatioY;

static struct NewScreen NewScreen =
   begin
      0,0,640,0,              /* left, top, width, height      */
      0,                      /* depth                         */
      0,1,                    /* detail pen and block pen      */
      HIRES | LACE,           /* View modes                    */
      CUSTOMSCREEN,           /* Screen type                   */
      NULL,                   /* Use default font              */
      " AmigaCOMAL graphics screen ",
      NULL,                   /* No additional gadgets         */
      NULL                    /* .. and no bit map             */
   end;

static struct NewWindow NewWindow =
   begin
      0,10,640,200,           /* left, top, width, height      */
      -1,-1,                  /* detail, block pen             */
      NULL,                   /* no IDCMP flags                */
      NULL,                   /* Flags                         */
      NULL,NULL,              /* no gadgets                    */
      NULL,                   /* Window title                  */
      NULL,                   /* Workbench screen used         */
      NULL,                   /* no bit map                    */
      0,0,0,0,                /* Min & Max not used            */
      0                       /* Type                          */
   end;

static UBYTE *WindowTitle = " AmigaCOMAL graphics window ";

void OpenGraph(wrkspc,wrktop) /* graphicscreen routine         */
struct valparam *wrkspc,*wrktop;
begin
  int mode;
  struct OutputStruc *OutputStruc;

  if ( comalstr->ExecStruc->OutputWindow == 0 )
    OutputStruc = comalstr->CommStruc;
  else
    OutputStruc = comalstr->ExecStruc;

  if (OpenFlags == 0) begin
    switch(mode = (short)(--wrkspc)->d2) begin
      case 0:
        GraphWindow = OutputStruc->OutputWindow;
        MaxHeight = OutputStruc->WindowHeight - 1;
        MaxWidth = OutputStruc->WindowWidth - 1;
        Depth = OutputStruc->WindowDepth;
        GraphScreen = OutputStruc->OutputScreen;
        BorderLeft = 0;
        BorderTop = 0;
        break;
      case 1:
        MaxHeight = comalstr->ExecStruc->ScreenHeight - 10;
        MaxWidth = comalstr->ExecStruc->ScreenWidth;
        NewWindow.Height = MaxHeight;
        NewWindow.Width = MaxWidth;
        NewWindow.Flags =  WINDOWDEPTH | WINDOWDRAG | SMART_REFRESH;
        NewWindow.Title = WindowTitle;
        NewWindow.Screen = comalstr->ExecStruc->OutputScreen;
        NewWindow.Type = comalstr->ExecStruc->ScreenType;
        if ((GraphWindow = (struct Window *)OpenWindow(&NewWindow)) == NULL)
          RetStat(63);              /* Out of memory                 */
        BorderLeft = GraphWindow->BorderLeft;
        BorderTop = GraphWindow->BorderTop;
        MaxWidth = MaxWidth - BorderLeft - GraphWindow->BorderRight - 2;
        MaxHeight = MaxHeight - BorderTop - GraphWindow->BorderBottom - 2;
        Depth = comalstr->ExecStruc->ScreenDepth;
        GraphScreen = comalstr->ExecStruc->OutputScreen;
        OpenFlags |= WINDOW_OPEN;
        break;
      case 2:
      case 3:
      case 4:
        NewScreen.Height = 2*(comalstr->ExecStruc->ScreenHeight);
        NewScreen.Depth = mode;
        if ((GraphScreen = (struct Screen *)OpenScreen(&NewScreen)) == NULL)
          RetStat(63);
        OpenFlags |= SCREEN_OPEN;
        MaxHeight = NewScreen.Height - 10;
        MaxWidth = 640;
        Depth = mode;
        NewWindow.Height = MaxHeight;
        NewWindow.Width = MaxWidth;
        NewWindow.Flags =  BORDERLESS;
        NewWindow.Title = NULL;
        NewWindow.Screen = GraphScreen;
        NewWindow.Type = NewScreen.Type;
        if ((GraphWindow = (struct Window *)OpenWindow(&NewWindow)) == NULL)
          RetStat(63);              /* Out of memory                 */
        BorderLeft = 0;
        BorderTop = 0;
        OpenFlags |= WINDOW_OPEN;
        break;
      default:
        RetStat(107); /* Range error */
    end;
    WindowToFront(GraphWindow);
    SetAPen(RP,(PenColor=1));
    BackColor=0;
    VPXmin = 0;
    VPYmin = 0;
    VPXmax = MaxWidth;
    VPYmax = MaxHeight;
    CurrentPoint.x = zero;
    CurrentPoint.y = zero;
    WindowXmin = zero;
    WindowXmax = VPXmax;
    WindowYmin = zero;
    WindowYmax = VPYmax;
    RatioX = one;
    RatioY = one;
    OpenFlags |= GRAPH_OPEN;
    FlipWindow = 1;
  end;
end

void CloseGraph()             /* Close graphics screen         */
begin
  if (OpenFlags) begin
    if (OpenFlags & WINDOW_OPEN)
      CloseWindow(GraphWindow);
    else
      WindowToBack(GraphWindow);
    if (OpenFlags & SCREEN_OPEN) CloseScreen(GraphScreen);
    OpenFlags = 0;
    FlipWindow = 0;
  end;
end

void StorePen()
begin
  pen_x = RP->cp_x;
  pen_y = RP->cp_y;
end

void RestorePen()
begin
  Move(RP,pen_x,pen_y);
end

void HeightRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt value;

  if (OpenFlags>0)
    value=IntFloat(MaxHeight);
  else
    value=IntFloat(0);
  RetValue(&value);
end

void XcorRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt value;

  if (OpenFlags>0)
    value=CurrentPoint.x;
  else
    value=zero;
  RetValue(&value);
end

void YcorRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt value;

  if (OpenFlags>0)
    value=CurrentPoint.y;
  else
    value=zero;
  RetValue(&value);
end

void WidthRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt value;

  if (OpenFlags>0)
    value=IntFloat(MaxWidth);
  else
    value=IntFloat(0);
  RetValue(&value);
end

void DepthRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt value;

  if (OpenFlags>0)
    value=IntFloat(Depth);
  else
    value=IntFloat(0);
  RetValue(&value);
end

void ViewPortRout(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  int x1,x2,y1,y2;
  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    y2 = (int)(--wrkspc)->d2;
    y1 = (int)(--wrkspc)->d2;
    x2 = (int)(--wrkspc)->d2;
    x1 = (int)(--wrkspc)->d2;
    if (x1>=x2 OR y1>=y2 OR x1<0 OR x2>MaxWidth-1 OR y1<0 OR y2>MaxHeight)
       RetStat(107);
    VPXmin = x1;
    VPXmax = x2;
    VPYmin = y1;
    VPYmax = y2;
    SetRatio();
  end;
end  

void ClearRout()
begin
  int Xmin,Xmax,Ymin,Ymax;
  if (OpenFlags>0) begin
    if ( PenColor < 0 )
      SetDrMd(RP,JAM1);
    else
      SetAPen(RP,BackColor);
    Xmin = VPXmin+BorderLeft;
    Ymin = MaxHeight-VPYmax+BorderTop;
    Xmax = VPXmax+BorderLeft;
    Ymax = MaxHeight-VPYmin+BorderTop;
    RectFill(RP,Xmin,Ymin,Xmax,Ymax);
    if ( PenColor < 0 )
      SetDrMd(RP,COMPLEMENT);
    else
      SetAPen(RP,PenColor);
  end;
end

void WindowRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  if (OpenFlags>0) begin
    CmlFlt Xmin,Xmax,Ymin,Ymax;
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    Ymax = *(--wrkspc);
    Ymin = *(--wrkspc);
    Xmax = *(--wrkspc);
    Xmin = *(--wrkspc);
    if ( Xmin>Xmax OR Ymin>Ymax ) RetStat(102);
    WindowXmin = Xmin;
    WindowXmax = Xmax;
    WindowYmin = Ymin;
    WindowYmax = Ymax;
    SetRatio();
    CurrentPoint.x = Xmin;
    CurrentPoint.y = Ymin;
  end;
end

void SetRatio()
begin
  RatioX = (VPXmax-VPXmin)/(WindowXmax-WindowXmin);
  RatioY = (VPYmax-VPYmin)/(WindowYmax-WindowYmin);
end

void PenColorRout(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  if (OpenFlags>0) begin
    if ((PenColor = (int)(--wrkspc)->d2) < 0) begin
      SetDrMd(RP,COMPLEMENT);
      SetAPen(RP,0);
    end;
    if (PenColor>=0) begin
      SetDrMd(RP,JAM1);
      SetAPen(RP,PenColor);
    end;
  end;
end

void BackColorRout(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  if (OpenFlags>0) BackColor=(UBYTE)(--wrkspc)->d2;
end

struct Point Convert(X,Y)
CmlFlt X,Y;
begin
  struct Point P;

  P.x = FloatInt((X-WindowXmin)*RatioX)+VPXmin;
  P.y = FloatInt((Y-WindowYmin)*RatioY)+VPYmin;
  return (P);
end

void PlotTextRout0(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  struct valparam *p;               /* pointer to text */
  struct Point Pixel;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    p = (--wrkspc);
    wrkspc = (struct valparam *)p->d2;
    if ( NOT (OpenFlags & WINDOW_OPEN) ) StorePen();
    Pixel = Convert(CurrentPoint.x,CurrentPoint.y);
    Move(RP,Pixel.x+BorderLeft,MaxHeight-Pixel.y+BorderTop);
    Text(RP,p->d2,(int)p->d3);
    if ( NOT (OpenFlags & WINDOW_OPEN) ) RestorePen();
  end;
end

void PlotTextRout1(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  struct valparam *p;               /* pointer to text */
  int x,y;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    p = (--wrkspc);
    wrkspc = (struct valparam *)p->d2;
    y = (int)(--wrkspc)->d2;
    x = (int)(--wrkspc)->d2;
    if ( NOT (OpenFlags & WINDOW_OPEN) ) StorePen();
    Move(RP,x+BorderLeft,MaxHeight-y+BorderTop);
    Text(RP,p->d2,(int)p->d3);
    if ( NOT (OpenFlags & WINDOW_OPEN) ) RestorePen();
  end;
end

void SetPntRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt X, Y;
  struct Point Pixel;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    Y = *(--wrkspc);
    X = *(--wrkspc);
    Pixel = Convert(X,Y);
    if ( VPXmin<=Pixel.x AND VPXmax>=Pixel.x AND VPYmin<=Pixel.y AND VPYmax>=Pixel.y )
      WritePixel(RP,Pixel.x+BorderLeft,MaxHeight-Pixel.y+BorderTop);
  end;
end

void TstPntRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt X, Y, value;
  struct Point Pixel;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    Y = *(--wrkspc);
    X = *(--wrkspc);
    Pixel = Convert(X,Y);
    if ( VPXmin<=Pixel.x AND VPXmax>=Pixel.x AND VPYmin<=Pixel.y AND VPYmax>=Pixel.y )
      value=IntFloat(ReadPixel(RP,Pixel.x+BorderLeft,MaxHeight-Pixel.y+BorderTop));
    else
      value=IntFloat(-1);
    RetValue(&value);
  end;
end

void MoveToRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    CurrentPoint.y = *(--wrkspc);
    CurrentPoint.x = *(--wrkspc);
  end;
end

void MoveRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    CurrentPoint.y = CurrentPoint.y + *(--wrkspc);
    CurrentPoint.x = CurrentPoint.x + *(--wrkspc);
  end;
end

void DrawToRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  struct Point EndPoint, StartPoint;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    StartPoint = Convert(CurrentPoint.x,CurrentPoint.y);
    CurrentPoint.y = *(--wrkspc);
    CurrentPoint.x = *(--wrkspc);
    EndPoint = Convert(CurrentPoint.x,CurrentPoint.y);
    Line(StartPoint.x,StartPoint.y,EndPoint.x,EndPoint.y);
  end;
end

void DrawRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  struct Point EndPoint, StartPoint;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    StartPoint = Convert(CurrentPoint.x,CurrentPoint.y);
    CurrentPoint.y = CurrentPoint.y + *(--wrkspc);
    CurrentPoint.x = CurrentPoint.x + *(--wrkspc);
    EndPoint = Convert(CurrentPoint.x,CurrentPoint.y);
    Line(StartPoint.x,StartPoint.y,EndPoint.x,EndPoint.y);
  end;
end

void GfxDump()
begin
  union printerIO begin
    struct IOStdReq ios;
    struct IODRPReq iodrp;
    struct IOPrtCmdReq iopc;
  end;
  extern union printerIO *CreateExtIO();
  extern struct MsgPort  *CreatePort();
  extern UBYTE AllocSignal();
  union printerIO *request;
  struct MsgPort *printerPort;
  struct ColorMap *dump_cm;
  struct ViewPort *dump_vp;
  struct RastPort *dump_rp;
  int dump_modes,dump_width,dump_height,dump_error;
  UBYTE signal;
  ULONG signal_mask, recieve_signal;

  if (OpenFlags) begin
    dump_error = 0;
    dump_vp = &GraphScreen->ViewPort;
    dump_rp = &GraphScreen->RastPort;
    dump_cm = dump_vp->ColorMap;
    dump_modes = dump_vp->Modes;
    dump_width = GraphScreen->Width;
    dump_height = GraphScreen ->Height;
    printerPort = CreatePort("my.print.port",0);
    request = CreateExtIO(printerPort,sizeof(union printerIO));
    if ((signal = AllocSignal(-1)) == -1) begin
      dump_error = 202;
      goto cleanup;
    end
    printerPort->mp_SigBit = signal;
    signal_mask = 1 << signal;
    if (OpenDevice("printer.device",0,request,0)) begin
      dump_error = 202;
      goto cleanup;
    end
    request->iodrp.io_Command = PRD_DUMPRPORT;
    request->iodrp.io_RastPort = dump_rp;
    request->iodrp.io_ColorMap = dump_cm;
    request->iodrp.io_Modes = dump_modes;
    request->iodrp.io_SrcX = 0;
    request->iodrp.io_SrcY = 0;
    request->iodrp.io_SrcWidth = dump_width;
    request->iodrp.io_SrcHeight = dump_height;
    request->iodrp.io_DestCols = 0;
    request->iodrp.io_DestRows = 0;
    request->iodrp.io_Special = SPECIAL_FULLCOLS | SPECIAL_ASPECT;
    SendIO(request);
    recieve_signal = 0;
    while ((recieve_signal & signal_mask) == 0) begin
      recieve_signal = CmlWait(signal_mask);
      if ((recieve_signal & signal_mask) == 0)
        if (CmlTstBrk() != 0) begin
          AbortIO(request);
          recieve_signal = signal_mask;
        end;
    end;
    GetMsg(printerPort);          
    CloseDevice(request);
    cleanup:
      FreeSignal(signal);
      DeleteExtIO(request,sizeof(union printerIO));
      DeletePort(printerPort);
      if (dump_error) RetStat(dump_error+1000);
  end
end

void CircleRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt C1,C2,R;
  struct Point C;
  int x,y,a2,b2,d;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    R = *(--wrkspc);
    C2 = *(--wrkspc);
    C1 = *(--wrkspc);
    x = RatioX*R; y = RatioY*R;
    a2 = x*x; b2 = y*y;
    y = 0;
    C = Convert(C1,C2);
    if ( y+C.y>=VPYmin AND y+C.y<=VPYmax) begin
      if (x+C.x>=VPXmin AND x+C.x<=VPXmax)
        WritePixel(RP,BorderLeft+x+C.x,BorderTop+MaxHeight-(y+C.y));
      if (-x+C.x>=VPXmin AND -x+C.x<=VPXmax)
        WritePixel(RP,BorderLeft-x+C.x,BorderTop+MaxHeight-(y+C.y));
    end
    if (- y+C.y>=VPYmin AND -y+C.y<=VPYmax) begin
      if (x+C.x>=VPXmin AND x+C.x<=VPXmax)
        WritePixel(RP,BorderLeft+x+C.x,BorderTop+MaxHeight-(-y+C.y));
      if (-x+C.x>=VPXmin AND -x+C.x<=VPXmax)
        WritePixel(RP,BorderLeft-x+C.x,BorderTop+MaxHeight-(-y+C.y));
    end
    d = 0;
    while (x > 0 ) begin
      if ( d > 0 )
        d -= b2*(x+(x--)-1);
      else
        d += a2*(y+(y++)+1);
      if ( y+C.y>=VPYmin AND y+C.y<=VPYmax) begin
        if (x+C.x>=VPXmin AND x+C.x<=VPXmax)
          WritePixel(RP,BorderLeft+x+C.x,BorderTop+MaxHeight-(y+C.y));
        if (-x+C.x>=VPXmin AND -x+C.x<=VPXmax)
          WritePixel(RP,BorderLeft-x+C.x,BorderTop+MaxHeight-(y+C.y));
      end
      if (- y+C.y>=VPYmin AND -y+C.y<=VPYmax) begin
        if (x+C.x>=VPXmin AND x+C.x<=VPXmax)
          WritePixel(RP,BorderLeft+x+C.x,BorderTop+MaxHeight-(-y+C.y));
        if (-x+C.x>=VPXmin AND -x+C.x<=VPXmax)
          WritePixel(RP,BorderLeft-x+C.x,BorderTop+MaxHeight-(-y+C.y));
      end
    end
  end
end   

void FillRout(wrkspc,wrktop)
CmlFlt *wrkspc,*wrktop;
begin
  CmlFlt X, Y;
  struct Point Point;

  if (OpenFlags>0) begin
    WorkBot = (APTR)wrkspc;
    WorkTop = (APTR)wrktop;
    Y = *(--wrkspc);
    X = *(--wrkspc);
    Point = Convert(X,Y);
    if (Point.x<=VPXmax AND Point.x>=VPXmin
            AND Point.y<=VPYmax AND Point.y>=VPYmin)
       fill(Point.x,Point.y);
  end;
end

#define test(X,Y) ReadPixel(RP,X+BorderLeft,MaxHeight-(Y)+BorderTop)
    
/******************************************************************/
/*                                                                */
/*             Recursive fill routine                             */
/*                                                                */
/******************************************************************/
void fill(x,y)
int x,y;
begin
  int xright;

  if (comalstr->EventCount)               /* Key pressed? */
    if (CmlTstBrk()) RetStat(0);          /* Return if break */
  xright = x;
  while (xright <= VPXmax AND test(xright,y) == BackColor)
    WritePixel(RP,BorderLeft+(xright++),BorderTop+MaxHeight-y);
  if ( xright > VPXmax ) xright--;
  while (x > VPXmin AND test(x-1,y) == BackColor)
    WritePixel(RP,BorderLeft+(--x),BorderTop+MaxHeight-y);
  while (x <= xright) begin
    if (y < VPYmax AND test(x,y+1) == BackColor ) fill(x,y+1);
    if (y > VPYmin AND test(x,y-1) == BackColor ) fill(x,y-1);
    x++;
  end
  if (comalstr->EventCount)               /* Key pressed? */
    if (CmlTstBrk()) RetStat(0);          /* Return if break */
end

/******************************************************************/
/*                                                                */
/* Draw line from (x1,y1) to (x2,y2)                              */
/*                                                                */
/******************************************************************/
void Line(x1,y1,x2,y2)
int x1,y1,x2,y2;
begin
  int t,dx,dy;
  if (x1>x2) begin
    t=x1;x1=x2;x2=t;
    t=y1;y1=y2;y2=t;
  end;
  if (x1>VPXmax OR x2<VPXmin) return;
  dx=x2-x1;dy=y2-y1;
  if (x1<VPXmin) begin
    if (dx==0)
      return;
    else begin
      y1=(dy*(VPXmin-x1)+(dx>>1))/dx+y1;
      x1=VPXmin;
    end;
  end;
  if (x2>VPXmax) begin
    if (dx==0)
      return;
    else begin
      y2=(dy*(VPXmax-x1)+(dx>>1))/dx+y1;
      x2=VPXmax;
    end;
  end;
  if (y2>=y1) begin
    if (y1<VPYmin) begin
      if (dy==0)
        return;
      else begin
        x1=(dx*(VPYmin-y1)+(dy>>1))/dy+x1;
        y1=VPYmin;
      end;
    end;
    if (y2>VPYmax) begin
      if (dy==0)
        return;
      else begin
        x2=(dx*(VPYmax-y1)+(dy>>1))/dy+x1;
        y2=VPYmax;
      end;
    end;
  end;
  if (y2<y1) begin
    if (y2<VPYmin) begin
      x2=(dx*(VPYmin-y1)+(dy>>1))/dy+x1;
      y2=VPYmin;
    end;
    if (y1>VPYmax) begin
      x1=(dx*(VPYmax-y1)+(dy>>1))/dy+x1;
      y1=VPYmax;
    end;
  end;
  if ( NOT (OpenFlags & WINDOW_OPEN) ) StorePen();
  Move(RP,x1+BorderLeft,MaxHeight-y1+BorderTop);
  Draw(RP,x2+BorderLeft,MaxHeight-y2+BorderTop);
  if ( NOT (OpenFlags & WINDOW_OPEN) ) RestorePen();
end

char ConIn(wrkspc,wrktop)
struct valparam *wrkspc,*wrktop;
begin
  char c;

start:
  c = CmlConIn();
  if ( OpenFlags>0 ) begin
    if ( c == (char)138 ) begin
      if ( (FlipWindow = 1-FlipWindow) )
        if ( OpenFlags & SCREEN_OPEN )
          ScreenToFront(GraphScreen);
        else
          WindowToFront(GraphWindow);
      else begin
        if ( OpenFlags & SCREEN_OPEN )
          ScreenToBack(GraphScreen);
        else
          WindowToBack(GraphWindow);
      end;
      goto start;
    end
  end
  return (c);
end


void signal(s)                /* Signal routine                */
short s;
begin
  switch(s)
    begin
      case 0:
      case 1: break;
      case 2:
      case 3: CloseGraph();
      case 4:
      case 5:
      case 6:
      case 7:
      case 8:
      case 9: break;
      case 10: CloseGraph();
    end;
end

/******************************************************************/
/*                                                                */
/*             Identifier table                                   */
/*                                                                */
/******************************************************************/

struct varnode YcorLnk =
  begin
    0L,
    "YCOR",
    fltcode,
    0,
  end;
void (*ycor)() = &YcorRout;

struct varnode XcorLnk =
  begin
    &YcorLnk,
    "XCOR",
    fltcode,
    0,
  end;
void (*xcor)() = &XcorRout;

struct varnode OpnLnk =
  begin
    &XcorLnk,
    "GRAPHICSCREEN",
    codeproc,
    1,
  end;
UWORD OpnPar1 = longval;
void (*OpnRout)() = &OpenGraph;

struct varnode ClsLnk =
  begin
    &OpnLnk,
    "TEXTSCREEN",
    codeproc,
    0
  end;
void (*ClsRout)() = &CloseGraph;

struct varnode WidthLnk =
  begin
    &ClsLnk,
    "WIDTH",
    longcode,
    0,
  end;
void (*width)() = &WidthRout;

struct varnode HeightLnk =
  begin
    &WidthLnk,
    "HEIGHT",
    longcode,
    0,
  end;
void (*height)() = &HeightRout;

struct varnode DepthLnk =
  begin
    &HeightLnk,
    "DEPTH",
    longcode,
    0,
  end;
void (*depth)() = &DepthRout;

struct varnode VPLnk =
  begin
    &DepthLnk,
    "VIEWPORT",
    codeproc,
    4
  end;
UWORD VPPar1 = longval;
UWORD VPPar2 = longval;
UWORD VPPar3 = longval;
UWORD VPPar4 = longval;
void (*VPRout)() = &ViewPortRout;

struct varnode ClrLnk =
  begin
    &VPLnk,
    "CLEAR",
    codeproc,
    0
  end;
void (*ClrRout)() = &ClearRout;

struct varnode WndLnk =
  begin
    &ClrLnk,
    "WINDOW",
    codeproc,
    4
  end;
UWORD WndPar1 = fltval;
UWORD WndPar2 = fltval;
UWORD WndPar3 = fltval;
UWORD WndPar4 = fltval;
void (*WndRout)() = &WindowRout;

struct varnode PenColLnk =
  begin
     &WndLnk,
     "PENCOLOR",
     codeproc,
     1
  end;
UWORD PenColPar1 = longval;
void (*PenColRout)() = &PenColorRout;

struct varnode BackColLnk =
  begin
     &PenColLnk,
     "BACKCOLOR",
     codeproc,
     1
  end;
UWORD BackColPar1 = longval;
void (*BackColRout)() = &BackColorRout;

struct varnode PlotTextLnk =
  begin
    &BackColLnk,
    "PLOTTEXT",
    codeproc,
    0x8001,                   /* One argument - alternative number   */
  end;
UWORD PlotTextPar0 = strgval;
void (*PlTxt0)() = &PlotTextRout0;

UWORD PlotText1ArgNum = 3;
UWORD PlotTextPar1 = longval;
UWORD PlotTextPar2 = longval;
UWORD PlotTextPar3 = strgval;
void (*PlTxt1)() = &PlotTextRout1;

struct varnode SetPntLnk =
  begin
    &PlotTextLnk,
    "PLOT",
    codeproc,
    2,
  end;
UWORD PlotPar1 = fltval;
UWORD PlotPar2 = fltval;
void (*plt)() = &SetPntRout;

struct varnode GetColLnk =
  begin
    &SetPntLnk,
    "GETCOLOR",
    longcode,
    2,
  end;
UWORD GetColPar1 = fltval;
UWORD GetColPar2 = fltval;
void (*GetCol)() = &TstPntRout;

struct varnode TstPntLnk =
  begin
    &GetColLnk,
    "READPIXEL",
    longcode,
    2,
  end;
UWORD ReadPixelPar1 = fltval;
UWORD ReadPixelPar2 = fltval;
void (*rdpxl)() = &TstPntRout;

struct varnode MoveToLnk =
  begin
    &TstPntLnk,
    "MOVETO",
    codeproc,
    2,
  end;
UWORD MoveToPar1 = fltval;
UWORD MoveToPar2 = fltval;
void (*MvTo)() = &MoveToRout;

struct varnode MoveLnk =
  begin
    &MoveToLnk,
    "MOVE",
    codeproc,
    2,
  end;
UWORD MovePar1 = fltval;
UWORD MovePar2 = fltval;
void (*Mv)() = &MoveRout;

struct varnode DrawToLnk =
  begin
    &MoveLnk,
    "DRAWTO",
    codeproc,
    2,
  end;
UWORD DrawToPar1 = fltval;
UWORD DrawToPar2 = fltval;
void (*DrwTo)() = &DrawToRout;

struct varnode DrawLnk =
  begin
    &DrawToLnk,
    "DRAW",
    codeproc,
    2,
  end;
UWORD DrawPar1 = fltval;
UWORD DrawPar2 = fltval;
void (*Drw)() = &DrawRout;

struct varnode CircleLnk =
  begin
    &DrawLnk,
    "CIRCLE",
    codeproc,
    3,
  end;
UWORD CirclePar1 = fltval;
UWORD CirclePar2 = fltval;
UWORD CirclePar3 = fltval;
void (*Crcl)() = &CircleRout;

struct varnode FillLnk =
  begin
    &CircleLnk,
    "FILL",
    codeproc,
    2,
  end;
UWORD FillPar1 = fltval;
UWORD FillPar2 = fltval;
void (*Fl)() = &FillRout;

struct varnode DumpLnk =
  begin
    &FillLnk,
    "PRINTERDUMP",
    codeproc,
    0,
  end;
void (*dump)() = &GfxDump;

topptr topnode = &DumpLnk;

void init(pck)
struct package *pck;
begin
  pck->var = &topnode;
  pck->signal = &signal;
  comalstr = pck->comal;
  pck->ConIn = &ConIn;
  pck->Flags  |= ConInFlag;
  pck->Priority = 5;
  packagestr = pck;
  IntuitionBase = comalstr->IntBase;
  GfxBase = comalstr->GfxBase;
end