{$i-,f+}
{$m $ff02,0,65535}

unit CORE2;

interface

uses
  graph, QWKTIMER, crt, CORE3;

procedure POINTMCGA (X, Y : integer);
procedure CIRCLEMCGA (XC, YC : integer; R : integer);
procedure LINEMCGA (X, Y : integer; X2, Y2 : integer);
procedure RECTANGLEMCGA (X,Y : integer; X2, Y2  : integer);
procedure ANIMATECURSORMCGA;
procedure ANIMATECURSORVGA;
procedure PAUZE (WAITINGNUMBER : integer);

implementation

procedure POINTMCGA (X, Y : integer);
  var
    BColor, FColor : integer;
  begin
    BColor:= textattr div 16;
    FColor:= textattr mod 16;
    mem[$A000:X + Y*320]:= FColor;
  end;

procedure CIRCLEMCGA (XC, YC : integer; R : integer);
var
  x, y, p: Integer;
begin
  x := 0;
  y := r;
  p := 1 - r;

  while x <= y do
  begin
    pointmcga (xc + x, yc + y);
    pointmcga (xc - x, yc + y);
    pointmcga (xc + x, yc - y);
    pointmcga (xc - x, yc - y);
    pointmcga (xc + y, yc + x);
    pointmcga (xc - y, yc + x);
    pointmcga (xc + y, yc - x);
    pointmcga (xc - y, yc - x);

    if p < 0 then
      p := p + 2 * x + 3
    else
    begin
      p := p + 2 * (x - y) + 5;
      y := y - 1;
    end;
    x := x + 1;
  end;
end;

procedure LINEMCGA (X, Y : integer; X2, Y2 : integer);
  var
    dx, dy   : longint;
    m        : real;
    xvar,yvar: real;
    C        : integer;
  begin
    if X2 < X then WISSEL (X, X2);
    if Y2 < Y then WISSEL (Y, Y2);
    if X=X2 then begin
      for C:= Y to Y2 do
        PointMCGA (X, C);
    end
      else
        if Y=Y2 then begin
          for C:= X to X2 do
            PointMCGA (C, Y);
        end else begin
          dx:= abs (x2-x);
          dy:= abs (y2-y);
          m:= dy/dx;
          xvar:= x;
          repeat
            yvar:= y+ m*(xvar-x);
            PointMCGA (round (xvar), round (yvar));
            xvar:= xvar + 0.33;
          until xvar > x2;
        end;
  end;

procedure RECTANGLEMCGA (X,Y : integer; X2, Y2  : integer);
  begin
    LINEMCGA (X,Y, X2,Y);
    LINEMCGA (X2,Y, X2,Y2);
    LINEMCGA (X,Y2, X2,Y2);
    LINEMCGA (X,Y, X,Y2);
  end;

procedure PAUZE (WAITINGNUMBER : integer);
  var
    C  : integer;
  begin
    TimerOn (18);
    ResetTimer;
    repeat
    until (TimeElapsed > WAITINGNUMBER) or KEYPRESSED;
    TimerOff;
(*
    for C:= 1 to WAITINGNUMBER do begin
      delay (1);
      if keypressed then exit;
    end;
*)
  end;

procedure ANIMATECURSORMCGA;
  var
    A, B, X,Y      : integer;
    BColor, FColor : integer;
    SPRITE         : array[0..11, 0..11] of byte;
    _A, _B         : integer;
  begin
    A:= wherex;
    B:= wherey;
    _A:= A;
    _B:= B;
    BColor:= textattr div 16;
    FColor:= textattr mod 16;
    A:= (A-1)*8;
    B:= (B-1)*8;
    for X:= A to A+8 do
      for Y:= B to B+8 do
        SPRITE [X, Y]:= mem[$A000:X + Y*320];
    repeat
      gotoxy (_A, _B);
      write (#176);
      PAUZE (35);
      for X:= A to A+8 do
        for Y:= B to B+8 do
          mem[$A000:X + Y*320]:= SPRITE [X, Y];
      PAUZE (15);
    until keypressed;
  end;

procedure ANIMATECURSORVGA;
  var
    A, B, X,Y      : integer;
    BColor, FColor : integer;
    SPRITE         : pointer;
    SIZE           : word;
  begin
    directvideo:= false;
    A:= wherex;
    B:= wherey;
    BColor:= textattr div 16;
    FColor:= textattr mod 16;
    A:= (A-1)*8;
    B:= (B-1)*8;
    SIZE:= imagesize (A, B, A+8, B+8);
    getmem (SPRITE, SIZE);
    getimage (A,B, A+8, B+8, SPRITE^);
    repeat
      outtextxy (A, B, #176);
      PAUZE (35);
      putimage (A,B, SPRITE^, NormalPut);
      PAUZE (15);
    until keypressed;
    freemem (SPRITE, SIZE);
  end;

begin
end.