(***********************************************************)
(*                                                         *)
(*                  Graphics system kernel                 *)
(*                     fuer BIC 5105                       *)
(*                     Stand: 12.2.89                      *)
(*                                                         *)
(***********************************************************)

procedure DrawBorder;
begin end;

procedure SetLinestyle(ls:integer);
  var i:integer;
  const lsa:array [0..4] of byte=($FF,$88,$F8,$E4,$EE);

  begin
    if not (ls in [0..4]) then ls:=ls and $FF + $100;
    LineStyleGlb:=ls;
    if ls<5 then ls:=lsa[ls];
    for i:=0 to 7 do LineStyleArrayGlb[7-i]:=((ls shr i) and 1)<>0;
    CntGlb:=7;
  end;

procedure DefineWorld(i:integer;
                      X_1,Y_1,X_2,Y_2:real);
  begin
    if ((X_1<>X_2) and (Y_1<>Y_2)) and (i in [1..MaxWorldsGlb]) then
      with world[i] do
       begin
        x1:=X_1;y1:=Y_2;x2:=X_2;y2:=Y_1;
        if i>MaxWorldGlb then MaxWorldGlb:=i;
       end
    else if i in [1..MaxWorldsGlb] then error(1,3)
    else error(1,2);
  end;

procedure SelectWorld(i:integer);
  begin
    if (i in [1..MaxWorldGlb]) then
      with world[i] do
       begin
        X1WldGlb:=x1;
        Y1WldGlb:=y1;
        X2WldGlb:=x2;
        Y2WldGlb:=y2;
       end
    else error(2,2);
  end;

procedure ReDefineWindow(i,X_1,Y_1,X_2,Y_2:integer);
  begin
    if (i in [1..MaxWindowsGlb]) and (X_1<=X_2) and (Y_1<=Y_2) and
       (X_1>=0) and (X_2<=XMaxGlb) and (Y_1>=0) and (Y_2<=YMaxGlb) then
      with window[i] do
       begin
        x1:=X_1;
        y1:=Y_1;
        x2:=X_2;
        y2:=Y_2;
        if i>MaxWindowGlb then MaxWindowGlb:=i;
       end
    else if i in [1..MaxWindowsGlb] then error(3,3)
    else error(3,2);
  end;

procedure DefineWindow(i,X_1,Y_1,X_2,Y_2:integer);
  begin
    ReDefineWindow(i,X_1,Y_1,X_2,Y_2);
    with window[i] do
     begin
      header:='';
      top:=true;
      drawn:=false;
     end;
  end;

procedure SelectWindow(i:integer);
  begin
    if (i in [1..MaxWindowGlb]) then
      with window[i] do
       begin
        WindowNdxGlb:=i;
        X1RefGlb:=x1;
        Y1RefGlb:=y1;
        X2RefGlb:=x2;
        Y2RefGlb:=y2;
        BxGlb:=((x2-x1) shl 3+7)/(X2WldGlb-X1WldGlb);
        ByGlb:=(y2-y1)/(Y2WldGlb-Y1WldGlb);
        AxGlb:=(x1 shl 3)-X1WldGlb*BxGlb;
        AyGlb:=y1-Y1WldGlb*ByGlb;
        if AxisGlb then
         begin
          AxisGlb:=false;
          X1Glb:=0;
          Y1Glb:=0;
          X2Glb:=0;
          Y2Glb:=0;
         end;
       end
    else error(4,2);
  end;

function WindowX(x:real):integer;
  begin
    WindowX:=trunc(AxGlb+BxGlb*x);
  end;

function WindowY(y:real):integer;
  begin
    WindowY:=trunc(AyGlb+ByGlb*y);
  end;

procedure InitGraphic;
  var fil:text;
      tfile:text;
      test:^integer;
      temp:WrkString;
      i:integer;
      help:array [0..284] of char absolute CharSet;

  begin
    MessageGlb:=True;
    BrkGlb:=False;
    for i:=1 to MaxWorldsGlb do
      DefineWorld(i,0,0,XScreenMaxGlb,YMaxGlb);
    MaxWorldGlb:=1;
    for i:=1 to MaxWindowsGlb do
     begin
      DefineWindow(i,0,0,XMaxGlb,YMaxGlb);
     end;
    MaxWindowGlb:=1;
    if CharFile<>'' then
     begin
      assign(fil,CharFile);
      {$I-} reset(fil); {$I+}
      if ioresult=0 then for i:=0 to 284 do read(fil,help[i])
      else error(0,1);
      close(fil);
     end;
    BrkGlb:=true;
    WindowNdxGlb:=1;
    ClippingGlb:=true;
    SelectWorld(1);
    SelectWindow(1);
    AspectGlb:=AspectFactor*AspectFactor;
    DirectModeGlb:=false;
    PieGlb:=false;
    ErrCodeGlb:=0;
    SetLineStyle(0);
    X1Glb:=0;
    X2Glb:=0;
    Y1Glb:=0;
    Y2Glb:=0;
    AxisGlb:=false;
    HatchGlb:=false;
    ColorGlb := 1;
    init;
  end;

function clip(var x1,y1,x2,y2:integer):boolean;
  var ix1,iy1,ix2,iy2,dummy,x1Loc,x2Loc:integer;
      ClipLoc:boolean;

  function inside(x,xx1,xx2:integer):integer;
     begin
       inside:=0;
       if x<xx1 then inside:=-1
       else if x>xx2 then inside:=1;
     end;

  begin
    clip:=true;
    ClipLoc:=true;
    if ClippingGlb then
     begin
      if HatchGlb then
       begin
        X1Loc:=X1RefGlb;
        X2Loc:=X2RefGlb;
       end
      else
       begin
        X1Loc:=X1RefGlb shl 3;
        X2Loc:=X2RefGlb shl 3 +7;
       end;
      ix1:=inside(x1,X1Loc,X2Loc);
      iy1:=inside(y1,Y1RefGlb,Y2RefGlb);
      ix2:=inside(x2,X1Loc,X2Loc);
      iy2:=inside(y2,Y1RefGlb,Y2RefGlb);
      if (ix1 or ix2 or iy1 or iy2)<>0 then
       begin
        if x1<>x2 then
         begin
          if ix1<>0 then
           begin
            if ix1<0 then dummy:=X1Loc else dummy:=X2Loc;
            if y2<>y1 then y1:=y1+trunc((y2-y1)/(x2-x1)*(dummy-x1));
            x1:=dummy;
           end;
          if (ix2<>0) and (x1<>x2) then
           begin
            if ix2<0 then dummy:=X1Loc else dummy:=X2Loc;
            if y2<>y1 then y2:=y1+trunc((y2-y1)/(x2-x1)*(dummy-x1));
            x2:=dummy;
           end;
          iy1:=inside(y1,Y1RefGlb,Y2RefGlb);
          iy2:=inside(y2,Y1RefGlb,Y2RefGlb);
         end;
        if y1<>y2 then
         begin
          if iy1<>0 then
           begin
            if iy1<0 then dummy:=Y1RefGlb else dummy:=Y2RefGlb;
            if x1<>x2 then x1:=x1+trunc((x2-x1)/(y2-y1)*(dummy-y1));
            y1:=dummy;
           end;
          if iy2<>0 then
           begin
            if iy2<0 then dummy:=Y1RefGlb else dummy:=Y2RefGlb;
            if x1<>x2 then x2:=x1+trunc((x2-x1)/(y2-y1)*(dummy-y1));
            y2:=dummy;
           end;
         end;
        iy1:=inside(y1,Y1RefGlb,Y2RefGlb);
        iy2:=inside(y2,Y1RefGlb,Y2RefGlb);
        if (iy1<>0) or (iy2<>0) then ClipLoc:=false;
        if ClipLoc then
         begin
          ix1:=inside(x1,X1Loc,X2Loc);
          ix2:=inside(x2,X1Loc,X2Loc);
          if (ix2<>0) or (ix1<>0) then ClipLoc:=false;
         end;
        clip:=ClipLoc;
       end;
     end;
  end;


  procedure DrawLineDirect (x1,y1,x2,y2:integer);
    var x,y,DeltaX,DeltaY,XStep,YStep,direction:integer;

    begin
      x:=x1;
      y:=y1;
      XStep:=1;
      YStep:=1;
      if x1>x2 then XStep:=-1;
      if y1>y2 then YStep:=-1;
      DeltaX:=abs(x2-x1);
      DeltaY:=abs(y2-y1);
      if DeltaX=0 then direction:=-1
      else direction:=0;
      while not ((x=x2) and (y=y2)) do
       begin
        if LinestyleGlb=0 then dp(x,y)
        else
         begin
          CntGlb:=(CntGlb+1) and 7;
          if LineStyleArrayGlb[CntGlb] then dp(x,y);
         end;
        if direction<0 then
         begin
          y:=y+YStep;
          direction:=direction+DeltaX;
         end
        else
         begin
          x:=x+XStep;
          direction:=direction-DeltaY;
         end;
       end;
    end;

procedure DrawLine (x1,y1,x2,y2:real);
var X1Loc,Y1Loc,X2Loc,Y2Loc:integer;

  begin
    if DirectModeGlb then
      DrawLineDirect(trunc(x1),trunc(y1),trunc(x2),trunc(y2))
    else
     begin
      X1Loc:=WindowX(x1);
      Y1Loc:=WindowY(y1);
      X2Loc:=WindowX(x2);
      Y2Loc:=WindowY(y2);
      if clip (X1Loc,Y1Loc,X2Loc,Y2Loc) then
        DrawLineDirect(X1Loc,Y1Loc,X2Loc,Y2Loc);
     end;
  end;

procedure DrawStraight(x1,x2,y:real);
  begin
  DrawLine(x1,y,x2,y);
  end;

procedure DrawLineClipped(x1,y1,x2,y2:integer);
  begin
    if clip(x1,y1,x2,y2) then DrawLine(x1,y1,x2,y2);
  end;

procedure DrawCircleDirect(xr,yr,r:integer; DirectModeLoc: boolean);
  const n=14;
  type Circ = array [1..n] of integer;
  const x:Circ=(0,121,239,355,465,568,663,749,823,885,935,971,993,1000);
  var xk1,xk2,yk1,yk2,xp1,yp1,xp2,yp2:integer;
      xfact,yfact:real;
      i:integer;

  procedure DrawLinW(X1,Y1,X2,Y2:integer);
    var DrawIt: boolean;

    begin
      DrawIt:=DirectModeLoc;
      if not DrawIt then DrawIt:=Clip(X1,Y1,X2,Y2);
      if DrawIt then DrawLine(X1,Y1,X2,Y2);
    end;

  begin
    xfact:=abs(r*0.001);
    yfact:=xfact*AspectGlb;
    if xfact>0.0 then
     begin
      xk1:=trunc(x[1]*xfact+0.5);
      yk1:=trunc(x[n]*yfact+0.5);
      for i:=2 to n do
       begin
        xk2:=trunc(x[i]*xfact+0.5);
        yk2:=trunc(x[n-i+1]*yfact+0.5);
        xp1:=xr-xk1;
        yp1:=yr+yk1;
        xp2:=xr-xk2;
        yp2:=yr+yk2;
        DrawLinW(xp1,yp1,xp2,yp2);
        xp1:=xr+xk1;
        xp2:=xr+xk2;
        DrawLinW(xp1,yp1,xp2,yp2);
        yp1:=yr-yk1;
        yp2:=yr-yk2;
        DrawLinW(xp1,yp1+1,xp2,yp2+1);
        xp1:=xr-xk1;
        xp2:=xr-xk2;
        DrawLinW(xp1,yp1+1,xp2,yp2+1);
        xk1:=xk2;
        yk1:=yk2;
       end;
     end
    else dp(xr,yr);
  end;

procedure DrawCircle(X_R,Y_R,xradius:real);
  var DirectModeLoc:boolean;

  begin { DrawCircle }
    DirectModeLoc:=DirectModeGlb;
    DirectModeGlb:=True;
    if DirectModeLoc then DrawCircleDirect(trunc(X_R),trunc(Y_R),trunc(xradius),True)
    else DrawCircleDirect(WindowX(X_R),WindowY(Y_R),trunc(xradius*100.0),False);
    DirectModeGlb:=DirectModeLoc;
  end;

procedure DrawAscii(var x,y:integer;
                    size,ch:byte);
  var x1ref,x2ref,xpos,ypos,xstart,ystart,xend,yend,xx,yy: integer;
      charbyte: byte;

  begin
    x1ref:=X1RefGlb shl 3;
    x2ref:=X2RefGlb shl 3+7;
    for ypos:=0 to 5 do
     begin
      CharByte:=(CharSet[ch,(7-ypos) shr 1] shr ((ypos and 1) shl 2)) and $0F;
      for xpos:=0 to 3 do
        if (CharByte shr (3-xpos)) and 1<>0 then
         begin
          xstart:=x+xpos*size;
          xend:=xstart+size-1;
          ystart:=y+1+(ypos-2)*size;
          yend:=ystart+size-1;
          if ClippingGlb then
           begin
            if xstart<x1ref then xstart:=x1ref;
            if xend>x2ref then xend:=x2ref;
            if ystart<Y1RefGlb then ystart:=Y1RefGlb;
            if yend>Y2RefGlb then yend:=Y2RefGlb;
           end;
          for yy:=ystart to yend do
            for xx:=xstart to xend do
              dp(xx,yy);
         end;
     end;
     x:=x+size*6;
   end;

procedure DrawText(x,y,scale:integer;
                   txt:wrkstring);
  var LineStyleLoc,code,AsciiValue,StringLen,i,SymbolScale,SymbolCode:integer;
      DirectModeLoc:boolean;

  begin
    DirectModeLoc:=DirectModeGlb;
    DirectModeGlb:=true;
    LineStyleLoc:=LinestyleGlb;
    SetLineStyle(0);
    StringLen:=length(txt);
    i:=1;
    while i<=StringLen do
     begin
      AsciiValue:=ord(txt[i]);
      if AsciiValue>27 then DrawAscii(x,y,scale,AsciiValue);
      i:=i+1;
     end;
    DirectModeGlb:=DirectModeLoc;
    SetLineStyle(LineStyleLoc);
  end;