(************************************************************************
************************************************************************
************************************************************************
************************************************************************

 NAO ESQUECER DE CRIAR OS PROCEDURES:
  CIRCLE
  ARC

************************************************************************
************************************************************************
************************************************************************
************************************************************************)
(*

Criado por Denilson F. de Sa (http://go.to/denilson)

Copiado do tutorial feito por DENTHOR of ASPHYXIA (mcphail@beastie.cs.und.ac.za)

*)

unit MCGA;
Interface
uses dfs;

const VGA = $a000;


procedure SetMCGA;
procedure SetText;
procedure Cls (Col : Byte);
procedure Putpixel (X,Y : Word; Col : Byte);
function  Getpixel (X,Y : Word) : Byte;
procedure WaitRetrace;
procedure SetPal(Col,R,G,B : Byte);
Procedure GetPal(Col : Byte; Var R,G,B : Byte);
procedure lineh(x1,x2,y:integer;col:byte);
procedure linev(x,y1,y2:integer;col:byte);
procedure line(a,b,c,d:integer;col:byte);
procedure rect(x1,y1,x2,y2:integer;col:byte);
procedure bar(x1,y1,x2,y2:integer;col:byte);


Implementation


procedure SetMCGA; assembler;
 { This procedure gets you into 320x200x256 mode. }
asm
  mov ax,0013h
  int 10h
end;


procedure SetText; assembler;
 { This procedure returns you to text mode.  }
asm
  mov ax,0003h
  int 10h
end;


procedure Cls (Col : Byte);
     { This clears the screen to the specified color }
begin
  Fillchar(Mem[$a000:0],64000,col);
end;


procedure Putpixel (X,Y : Word; Col : Byte);
     { This puts a pixel on the screen by writing directly to memory. }
begin
  Mem[VGA:X+(Y*320)]:=Col;
end;


function Getpixel (X,Y : Word) : Byte;
     { This gets pixel color on the screen. }
begin
  GetPixel:=Mem[VGA:X+(Y*320)];
end;


procedure WaitRetrace; assembler;
  { This waits until you are in a Verticle Retrace ... this means that all
    screen manipulation you do only appears on screen in the next verticle
    retrace ... this removes most of the "fuzz" that you see on the screen
    when changing the pallette. It unfortunately slows down your program
    by "synching" your program with your monitor card ... it does mean
    that the program will run at almost the same speed on different
    speeds of computers which have similar monitors. In our SilkyDemo,
    we used a WaitRetrace, and it therefore runs at the same (fairly
    fast) speed when Turbo is on or off. }

label
  l1, l2;
asm
    mov dx,3DAh
l1:
    in al,dx
    and al,08h
    jnz l1
l2:
    in al,dx
    and al,08h
    jz  l2
end;


(*procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This reads the values of the Red, Green and Blue values of a certain
    color and returns them to you. }
begin
  Port[$3c7] := Col;
  R := Port[$3c9];
  G := Port[$3c9];
  B := Port[$3c9];
end;

procedure SetPal(Col,R,G,B : Byte);
  { This sets the Red, Green and Blue values of a certain color }
begin
  Port[$3c8] := Col;
  Port[$3c9] := R;
  Port[$3c9] := G;
  Port[$3c9] := B;
end;*)

Procedure SetPal(Col,R,G,B : Byte);
  { This sets the Red, Green and Blue values of a certain color }
Begin
   asm
      mov    dx,3c8h
      mov    al,[col]
      out    dx,al
      inc    dx
      mov    al,[r]
      out    dx,al
      mov    al,[g]
      out    dx,al
      mov    al,[b]
      out    dx,al
   end;
End;

Procedure GetPal(Col : Byte; Var R,G,B : Byte);
  { This gets the Red, Green and Blue values of a certain color }
Var
   rr,gg,bb : Byte;
Begin
   asm
      mov    dx,3c7h
      mov    al,col
      out    dx,al

      add    dx,2

      in     al,dx
      mov    [rr],al
      in     al,dx
      mov    [gg],al
      in     al,dx
      mov    [bb],al
   end;
   r := rr;
   g := gg;
   b := bb;
end;


procedure lineh(x1,x2,y:integer;col:byte);
  { This draws a horizontal line from x1,y to x2,y of color col. }
var i:integer;
begin
  if (y>=0) and (y<200) then
    for i:=menori(x1,x2) to maiori(x1,x2) do
      if (i>=0) and (i<320) then
        putpixel(i,y,col);
end;


procedure linev(x,y1,y2:integer;col:byte);
  { This draws a vertical line from x,y1 to x,y2 of color col. }
var i:integer;
begin
  if (x>=0) and (x<320) then
    for i:=menori(y1,y2) to maiori(y1,y2) do
      if (i>=0) and (i<200) then
        putpixel(x,i,col);
end;


procedure line(a,b,c,d:integer;col:byte);
  { This draws a line from a,b to c,d of color col. }
  { Foi alterada por Denilson para ficar melhor. }
  function sgn(a:integer):shortint;
  begin
    if a=0 then sgn:=0
    else sgn:=a div abs(a);
  end;
var d1x,d1y,d2x,d2y:shortint;
    u,s,v,m,n,i:integer;
begin
  u:= c - a;
  v:= d - b;
  if u=0 then linev(a,b,d,col)
  else if v=0 then lineh(a,c,b,col)
  else begin
    d1x:= sgn(u);
    d1y:= sgn(v);
    d2x:= sgn(u);
    d2y:= 0;
    m := ABS(u);
    n := ABS(v);
    if not (m>n) then begin
      d2x := 0 ;
      d2y := sgn(v);
      m := ABS(v);
      n := ABS(u);
    end;
    s := trunc(INT(m/2));
    for i := 0 to m do begin
      if (a>=0) and (a<320) AND (b>=0) and (b<200) then putpixel(a,b,col);
      s := s + n;
      if not (s<m) then begin
        s := s - m;
        a := a + d1x;
        b := b + d1y;
      end else begin
        a := a + d2x;
        b := b + d2y;
      end;
    end; {for}
  end; {if}
end;


procedure rect(x1,y1,x2,y2:integer;col:byte);
begin
  lineh(x1,x2,y1,col);
  linev(x1,y1,y2,col);
  linev(x2,y1,y2,col);
  lineh(x1,x2,y2,col);
end;


procedure bar(x1,y1,x2,y2:integer;col:byte);
var i:integer;
begin
  for i:=menori(y1,y2) to maiori(y1,y2) do
    lineh(x1,x2,i,col);
end;


end.