home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / phy / phy005 / lowlevel / trian2.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1997-07-04  |  2.2 KB  |  117 lines
  1. PROGRAM ProbaTriangle;  { Dibujado de triangulos rellenos. Navi/PhyMosys }
  2.  
  3. USES Crt;
  4.  
  5. VAR i : Integer;
  6.  
  7. PROCEDURE Modo(x : WORD); Assembler;
  8. ASM
  9.   mov ax, x
  10.   int 10h
  11. END;
  12.  
  13. PROCEDURE Triangle(x1,y1, x2,y2, x3,y3 : Integer; col : BYTE);
  14.   PROCEDURE Canviar(VAR a, b : Integer);
  15.   VAR Aux : Integer;
  16.   BEGIN
  17.     Aux:=b;
  18.     b:=a;
  19.     a:=Aux;
  20.   END;
  21. VAR
  22.   ax, bx, cx, dx,
  23.   aux      : Real;
  24.   si, di   : Word;{Real;}
  25.   dreta    : Boolean;
  26.   aux2     : word;
  27. BEGIN
  28.   If NOT (y1<y2) Then
  29.    BEGIN
  30.      Canviar(x1,x2);
  31.      Canviar(y1,y2);
  32.    END;
  33.   If NOT (y1<y3) Then
  34.    BEGIN
  35.      Canviar(x1,x3);
  36.      Canviar(y1,y3);
  37.    END;
  38.   If NOT (y2<y3) Then
  39.    BEGIN
  40.      Canviar(x2,x3);
  41.      Canviar(y2,y3);
  42.    END;                 { Ordenados! }
  43.  
  44.   di:=320*y1+x1;
  45.   si:=320*y2;
  46.   bx:=320+((x1-x3)/(y1-y3));
  47.   dx:=abs(((x2-x1)/(y2-y1))-((x1-x3)/(y1-y3)));
  48.   cx:=0;
  49.  
  50.   If x2>x1 Then
  51.     dreta:=TRUE
  52.    Else
  53.     dreta:=FALSE;
  54.  
  55.   While di<si do
  56.    BEGIN
  57.      aux:=1;
  58.      If dreta then
  59.        While aux<cx do
  60.         BEGIN
  61.           aux2:=word(Round(di+aux));
  62.           Mem[$A000:aux2]:=col;
  63.           aux:=aux+1;
  64.         END
  65.       Else
  66.        While aux<cx do
  67.         BEGIN
  68.           aux2:=word(Round(di-aux));
  69.           Mem[$A000:aux2]:=col;
  70.           aux:=aux+1;
  71.         END;
  72.      di:=di+word(Round(bx));
  73.      cx:=cx+dx;
  74.    END;
  75.  
  76.   si:=320*y3;
  77.   dx:=abs(((x2-x3)/(y2-y3))-((x1-x3)/(y1-y3)));
  78.  
  79.   While di<=si do
  80.    BEGIN
  81.      aux:=1;
  82.      If dreta then
  83.        While aux<cx do
  84.         BEGIN
  85.           aux2:=word(Round(di+aux));
  86.           Mem[$A000:aux2]:=col;
  87.           aux:=aux+1;
  88.         END
  89.       Else
  90.        While aux<cx do
  91.         BEGIN
  92.           aux2:=word(Round(di-aux));
  93.           Mem[$A000:aux2]:=col;
  94.           aux:=aux+1;
  95.         END;
  96.      di:=di+word(Round(bx));
  97.      cx:=cx-dx;
  98.    END;
  99. END;
  100.  
  101. BEGIN
  102.   WriteLn('Demo de dibujado de triangulos');
  103.   ReadLn;
  104.   Modo($13);
  105.  
  106.   For i:=1 to 200 do
  107.    BEGIN
  108.      Triangle(130,80, 100,20, 40,130, i);
  109.      Triangle(20,60, 20,30, 100,40, i);
  110.      Triangle(310,0, 170,110, 190,15, i);
  111.      Triangle(134,150, 95,135, 120,115, i);
  112.    END;
  113.  
  114.   ReadLn;
  115.   Modo(3);
  116. END.
  117.