{---------------------------------------------------------------}
{          High Resolution Graphic with the K 6313              }
{---------------------------------------------------------------}
const xtoy=1.25;
      ytox=0.8;
      charwidth=6;
      charheight=8;
      pi=3.1415926536;
type  drawmode=(schw,rot);
var   resolution:record
                   xtext,ytext,xmax,ymax:integer;
                   ylogical:integer end;
      x0,y0:integer;
{---------------------------------------------------------------}
procedure relppos(zeile,spalte:integer);
var num,z1,z2,i,ir:integer;
    f:array[1..2]of array[1..3]of char;
begin
if zeile>0 then
  z1:=101 else
  z1:=117;
if spalte>0 then
  z2:=97 else
  z2:=113;
for i:=1 to 2 do
  begin
  case i of
    1: num:=abs(zeile);
    2: num:=abs(spalte) end;
  for ir:=3 downto 1 do
    begin
    f[i][ir]:=chr(48+num mod 10);
    num:=num div 10;
    end;
  end;
if zeile<>0 then
  write(lst,chr(27),chr(91),f[1],chr(z1));
if spalte<>0 then
  write(lst,chr(27),chr(91),f[2],chr(z2));
end;
{---------------------------------------------------------------}
procedure c60_l48;
begin
write(lst,chr(27),chr(91),chr(54),chr(32),chr(75));
write(lst,chr(27),chr(91),chr(54),chr(32),chr(76));
end;
{---------------------------------------------------------------}
procedure c10_l06;
begin
write(lst,chr(27),chr(91),chr(48),chr(32),chr(75));
write(lst,chr(27),chr(91),chr(48),chr(32),chr(76));
end;
{---------------------------------------------------------------}
procedure window(zeilen,zeichen:integer);
begin
with resolution do
  begin
  xtext:=zeichen;
  ytext:=zeilen;
  xmax:=charwidth*xtext;
  ymax:=charheight*ytext;
  ylogical:=trunc(xtoy*ymax);
  end;
x0:=0;y0:=resolution.ymax;
if zeilen>0 then
  c60_l48;
write(lst,chr($d));
end; (*window *)
{---------------------------------------------------------------}
procedure windowend;
begin
relppos(y0,0);
c10_l06;
write(lst,chr($d));
end;
{---------------------------------------------------------------}
procedure draw(xfrom,yfrom,xto,yto:real;mode:drawmode);
var h,running,x1,x2,y1,y2,x,y,dx,dy:integer;
begin
x1:=round(xfrom);y1:=round(yfrom*ytox);
x2:=round(xto);y2:=round(yto*ytox);
if y2>y1 then
  begin
  h:=x2;x2:=x1;x1:=h;
  h:=y2;y2:=y1;y1:=h;
  end;
relppos(y0-y1,x1-x0);
running:=0;
dx:=abs(x2-x1);
dy:=abs(y2-y1);
x:=x1;y:=y1;
if mode=rot then
  write(lst,chr($14));
while true do
  begin
  if(x<resolution.xmax) and (y<resolution.ymax)
    and (x>=0) and (y>=0) then write(lst,'.');
  if dx<dy then
    begin
    if y=y2 then
      begin
      x0:=x2;y0:=y2;
      if mode=rot then
        write(lst,chr($14));
      exit;
      end;
    y:=y-1;
    write(lst,chr(27),chr(91),chr(49),chr($65));
    running:=running+dx;
    if running+running>=dy then
      begin
      if x2>x1 then
        begin
        x:=x+1;
        write(lst,chr($20));
        end else
        begin
        x:=x-1;
        write(lst,chr($8));
        end;
      running:=running-dy;
      end;
    end else
    begin
    if x=x2 then
      begin
      x0:=x2;y0:=y2;
      if mode=rot then
        write(lst,chr($14));
      exit;
      end;
    if x2>x1 then
      begin
      x:=x+1;
      write(lst,chr($20));
      end else
      begin
      x:=x-1;
      write(lst,chr($8));
      end;
    running:=running+dy;
    if running+running>=dx then
      begin
      y:=y-1;
      write(lst,chr(27),chr(91),chr(49),chr($65));
      running:=running-dx;
      end;
    end;
  end;
end; (* draw *)
{---------------------------------------------------------------}
procedure plot(xplot,yplot:real;mode:drawmode);
var x1,y1:integer;
begin
x1:=round(xplot);y1:=round(yplot*ytox);
relppos(y0-y1,x1-x0);
x0:=x1;y0:=y1;
if mode=schw then
  write(lst,'.') else
  write(lst,chr($14),'.',chr($14));
end; (* plot *)
{---------------------------------------------------------------}
procedure spoke(xcenter,ycenter,length,angle:real;mode:drawmode);
var   xto,yto:real;
begin
xto:=xcenter+length*sin(angle);
yto:=ycenter+length*cos(angle);
draw(xcenter,ycenter,xto,yto,mode);
end; (* spoke *)
{---------------------------------------------------------------}
procedure makearc(xcenter,ycenter,rad,startangle,arcangle:real;
    xdistortion,ydistortion:real;mode:drawmode);
var   theta:real;
procedure make(st,a,eta:real);
var x,y:real;
    i:integer;
begin
for i:=0 to round(a/abs(eta)) do
  begin
  x:=xcenter+rad*sin(st);
  y:=ycenter+rad*cos(st);
  plot(x*xdistortion,y*ydistortion,mode);
  st:=st+eta;
  end;
end; (* make *)
begin (* makearc *)
if xdistortion=0 then
  xdistortion:=0.00001;
if ydistortion=0 then
  ydistortion:=0.00001;
xcenter:=xcenter/xdistortion;
ycenter:=ycenter/ydistortion;
theta:=arctan(1/rad);
if startangle<0 then
  startangle:=-180/pi*startangle;
if arcangle<0 then
  arcangle:=-180/pi*arcangle;
if startangle<pi then
  if startangle+arcangle<=pi then
    make(startangle,arcangle,theta) else
    begin
    make(startangle,pi-startangle,theta);
    if startangle+arcangle<=2*pi then
      make(startangle+arcangle,startangle+arcangle-pi,-theta) else
      begin
      make(0,pi,-theta);
      make(0,startangle+arcangle-2*pi,theta);
      end;
    end else
  if startangle+arcangle<=2*pi then
    make(startangle+arcangle,arcangle,-theta) else
    begin
    make(0,2*pi-startangle,-theta);
    if startangle+arcangle<=3*pi then
      make(0,startangle+arcangle-2*pi,theta) else
      begin
      make(0,pi,theta);
      make(startangle+arcangle-2*pi,startangle+arcangle-3*pi,-theta);
      end;
    end;
end;
{---------------------------------------------------------------}
procedure circle(xcenter,ycenter,rad:real;mode:drawmode);
begin
makearc(xcenter,ycenter,rad,0,2*pi,1,1,mode);
end;
{---------------------------------------------------------------}
procedure arc(xcenter,ycenter,rad,startangle,arcangle:real;
                                              mode:drawmode);
begin
makearc(xcenter,ycenter,rad,startangle,arcangle,1,1,mode);
end;
{---------------------------------------------------------------}
procedure segment(xcenter,ycenter,rad,startangle,arcangle:real;
                                                  mode:drawmode);
var xa,ya,xe,ye:real;
begin
xa:=xcenter+rad*sin(startangle);
ya:=ycenter+rad*cos(startangle);
xe:=xcenter+rad*sin(startangle+arcangle);
ye:=ycenter+rad*cos(startangle+arcangle);
draw(xcenter,ycenter,xa,ya,mode);
arc(xcenter,ycenter,rad,startangle,arcangle,mode);
draw(xcenter,ycenter,xe,ye,mode);
end;