type
  str80=string[80];
  filename=string[14];
  picstring=string[10];
  regpack=record
    a:byte;
    x:byte;
    y:byte
    end; {6502 registers}
const
xmax=279;
ymax=191;
black1=0;
green=1;
blue1=2;
white1=3;
black2=4;
orange=5;
blue2=6;
white2=7;

var xleft,xright,ytop,ybottom:integer;
    reg:regpack;

procedure graphwindow(xl,yt,xr,yb:integer);
begin
  if (xl>=0) AND (xl<XMAX) then xleft:=xl else xleft:=0;
  if (xr<=XMAX) AND (xr>xleft) then xright:=xr else xright:=xmax;
  if (yt>=0) AND (yt<YMAX) then ytop:=yt else ytop:=0;
  if (yb<=YMAX) AND (yb>ytop) then ybottom:=yb else ybottom:=YMAX
end;

procedure fullwindow;
begin
  graphwindow(0,0,XMAX,YMAX)
end;

function inwindow(x,y:integer):boolean;
begin
  inwindow:=(x>=xleft) AND (x <=xright) AND
    (y>=ytop) AND (y<=ybottom)
end;


procedure page1;
CONST
  page1switch=$E054;
begin
  inline($3a/page1switch)
end;

procedure page2;
CONST
  page2switch=$E055;
begin
  inline($3a/page2switch)
end;

procedure graphcolormode;
CONST
  graphmodeswitch=$E050;
  hiresOnswitch=$E057;
begin
  page2;
  inline($3A/graphmodeswitch/$3A/hiresonswitch)
end;

procedure textmode;
begin
end;

procedure callapplerom(romaddr:integer);
const
  routineptr=$F3D0;
  slotvalue=$F3C8;
  aregbuff=$F045;
  xregbuff=$F046;
  yregbuff=$F047;
begin
  mem[routineptr]:=lo(romaddr);
  mem[routineptr+1]:=hi(romaddr);
  mem[aregbuff]:=reg.a;
  mem[xregbuff]:=reg.x;
  mem[yregbuff]:=reg.y;
  inline ($3A/slotvalue/$C6/$20/$67/$2E/$00/$77);
  reg.a:=mem[aregbuff];
  reg.x:=mem[xregbuff];
  reg.y:=mem[yregbuff]
end;

procedure initgraphics;
CONST
  page2val=$0040;
  romsignature=$DBB3;
  readrom=$E081;
  readram=$E083;
  fullpageswitch=$E052;
  clearaddr=$F3F2;
  pageaddr=$F0E6;
var signature:integer;
begin
  fullwindow;
  inline($3A/fullpageswitch);
  mem[pageaddr]:=page2val;
  callapplerom(clearaddr);
end;

procedure setcolor(color:integer);
const
  setcoloraddr=$F6EC;
begin
  if (color>white2) or (color<black1)then color:=black1;
  reg.a:=0;
  reg.x:=lo(color);
  reg.y:=0;
  callapplerom(setcoloraddr);
end;

procedure graphbackground(color:integer);
const setcoloraddr=$F6EC;
      setbkndaddr=$F3F6;
      lastcoloraddr=$F01C;
begin
  setcolor(color);
  mem[lastcoloraddr]:=reg.a;
  callapplerom(setbkndaddr);
end;

procedure getpenposition(var x,y:integer);
const
  getposnaddr=$F5CB;
  xcoordlo=$F0E0;
  xcoordhi=$F0E1;
  ycoord=$F0E2;
begin
  callapplerom(getposnaddr);
  x:=mem[xcoordhi] shl 8 + mem[xcoordlo];
  y:=mem[ycoord];
end;

procedure positionpen(x,y:integer);
const
  posnaddr=$F411;
begin
  if inwindow(x,y) then begin
    reg.a:=lo(y);
    reg.x:=lo(x);
    reg.y:=hi(x);
    callapplerom(posnaddr);
  end
end;

procedure plot(x,y,color:integer);
const
  plotaddr=$F457;
begin
  if inwindow(x,y) then begin
    setcolor(color);
    reg.a:=lo(y);
    reg.x:=lo(x);
    reg.y:=hi(x);
    callapplerom(plotaddr);
  end
end;

procedure draw(x1,y1,x2,y2,color:integer);
var
  index:integer;
  xplot,yplot:array[1..2]of integer;
  vertline,horizline,lineinwindow:boolean;

  procedure definesegment;
  var
    x1r,y1r,x2r,y2r:real;
    yb,yt          :real;
    slope, intersect:real;
    ixbottom,ixtop,iyleft,iyright:integer;
    thirdhand:integer;

    procedure findintersection(x,y:integer);
    begin
      if inwindow(x,y) then begin
        xplot[index]:=x;yplot[index]:=y;
        lineinwindow:=true; index:=2
      end
    end;

  begin
    index:=1;
    lineinwindow:=false;
    vertline:=(x1=x2);
    horizline:=(y1=y2);
    x1r:=abs(x1);y1r:=abs(y1);x2r:=abs(x2);y2r:=abs(y2);
    yb:=ybottom;yt:=ytop;
    if not vertline and not horizline then begin
      slope:=(y2r-y1r)/(x2r-x1r);
      intersect:=y1r-slope*x1r;

      ixbottom:=round((yb-intersect)/slope);
      ixtop:=round((yt-intersect)/slope);
      iyleft:=round((slope*xleft)+intersect);
      iyright:=round((slope*xright)+intersect);

      findintersection(ixbottom,ybottom);
      findintersection(xleft,iyleft);
      findintersection(ixtop,ytop);
      findintersection(xright,iyright);

      if ((abs(x1)<abs(x2)) AND (xplot[1]>xplot[2]) OR
          (abs(x1)>abs(x2)) AND (xplot[1]<xplot[2])) then begin
        thirdhand:=xplot[1];
        xplot[1]:=xplot[2];
        xplot[2]:=thirdhand;
        thirdhand:=yplot[1];
        yplot[1]:=yplot[2];
        yplot[2]:=thirdhand
      end
    end;
    if vertline then begin
      findintersection(abs(x1),ytop);
      findintersection(abs(x2),ybottom)
    end;
    if horizline then begin
      findintersection(xleft,abs(y1));
      findintersection(xright,abs(y2))
    end
  end;

  procedure clipsegment;
  begin
    if not vertline then begin
      if abs(x1)>xplot[1] then begin
        xplot[1]:=abs(x1);yplot[1]:=abs(y1)
      end;
      if abs(x2)<xplot[2] then begin
        xplot[2]:=abs(x2);yplot[2]:=abs(y2)
      end
    end
    else begin
      if abs(y1)>yplot[1] then yplot[1]:=abs(y1);
      if abs(y2)<yplot[2] then yplot[2]:=abs(y2)
    end
  end;

  procedure drawline(xstart,ystart,xend,yend:integer);
  const
    drawlineaddr=$F53A;
  begin
    positionpen(xstart,ystart);
    reg.a:=lo(xend);
    reg.x:=hi(xend);
    reg.y:=lo(yend);
    callapplerom(drawlineaddr);
  end;

begin {draw}
  setcolor(color);
  definesegment;
  if lineinwindow then clipsegment;
  if lineinwindow then drawline(xplot[1],yplot[1],xplot[2],yplot[2])
end;

procedure fixpicname(var fname:str80);
begin
  if pos('.',fname)>0 then fname:=copy(fname,1,pos('.',fname)-1);
  fname:=fname+'.PIC'
end;

procedure saveimage(picname:str80);
const
  hires2addr=$3000;
  numscreenblocks=64;
var
  f:file;
begin
  fixpicname(picname);
  assign(f,picname);
  rewrite(f);
  blockwrite(f,mem[hires2addr],numscreenblocks);
  close(f);
end;

procedure loadimage(picname:str80);
const
  hires2addr=$3000;
  numscreenblocks=64;
var f:file;
begin
  fixpicname(picname);
  assign(f,picname);
  reset(f);
  blockread(f,mem[hires2addr],numscreenblocks);
  close(f);
end;

{end of GRAF.INC}