Program na zobrazenie bezierových kriviek za použitia asembleru

Delphi & Pascal (česká wiki)
Přejít na: navigace, hledání
Kategória: KMP (Klub mladých programátorov)
bezier.pngAutor: Ján Benkovič
web: www.tbteacher.host.sk

Program: Bezier.pas
Súbor exe: Bezier.exe

Program na zobrazenie bezierových kriviek za použitia asembleru.
{ BEZIER.PAS                                                        }
{ Program na zobrazenie bezierovych kriviek.                        }
{                                                                   }
{ Datum:02.07.1994                             http://www.trsek.com }
 
uses crt;
{ Define Test}
{ Define Lines}
 
const step=0.01;
      krokt= 1/10;
      p    = 0.5*0.35;      {malo by p> 0.5*0.25}
      f=14;
 
      sirkaw = 200;
      vyskaw = 200;
 
      BerierSt = 4;
 
      MaxX2 = 376 div 2;
      MaxY2 = 282 div 2;
 
      stx = 0;
      sty = 17;
 
 
const sirka=MaxX2*2;
 
var X1st,X2st,X3st,X4st,Y1st,Y2st,Y3st,Y4st,XSst,YSst:integer;
    c:char;
    Xd,Yd,PX1,PX2,PX3,PY1,PY2,PY3:integer;
    PSeg:word;
    a:real;
    tria:byte;
 
PROCEDURE DLine(x1,y1,x2,y2:word; colorka:byte); Assembler;
 
asm
{$I-}
{$R-}
 
  push ds
 
  mov  ax,PSeg
  mov  ds,ax
 
  mov  bx,x1
  mov  ax,y1
  mov  dx,x2
  mov  cx,y2
 
  cmp  bx,dx           {v bx musi byt mensie z x1,x2}
  jl   @Mensie
 
@Vacsie:               {ak tam nie je, treba to opravit}
 
  xchg bx,dx           {treba vymenit bx a dx (x1,x2)}
  xchg ax,cx           {treba vymenit ax a cx (y1,y2)}
 
@Mensie:               {Ak je vsechno OK, alebo bolo = x1<x2; y1<y2?}
 
  push dx
  push dx              {dx bude pouzite na deltax }
  push ax
 
  mov  dx,sirka/4      {ajtak ho to znuluje}
  mul  dx              {ax = ax*320    = y1*320}
 
  mov  dx,bx
  shr  dx,1
  shr  dx,1
  add  ax,dx
  mov  di,ax           {di := y1*320+x1}
 
@Dal:
  pop  ax              {ax = y1}
  pop  dx              {dx = x2}
 
  sub  dx,bx           {** dx = deltax := x_koncove(=dx) - x(=bx)}
 
  cmp  ax,cx           {do ax dame abs(ax-cx) preto treba vediet co je vacsie}
  pushf
  jg   @Vacsie2
 
@Mensie2:              {ax je mensie; y1<y2 => abs(y1-y2) = y2-y1}
  xchg ax,cx           {sub  cx,ax;    mov  ax,cx}
 
@Vacsie2:              {y1>y2 => abs(y1-y2) = y1-y2}
  sub  ax,cx
 
  cmp  dx,ax
  jl   @PodmePoY       {** if deltax < deltay then jump            }
                       {                      else Ok              }
 
{************************************************************************}
                       {  mov  si,offset @IncDec+2}
  popf
  jg   @Vacsie22
 
@Mensie22:
  mov  word ptr [cs:@IncDec+2], Sirka / 4  {treba prestavit na dec(Y)}
  jmp  @Dalej
 
@Vacsie22:
  mov  word ptr [cs:@IncDec+2], -Sirka / 4  {treba prestavit na dec(Y)}
 
@Dalej:                {** v ax je hodnota ax = deltay = abs(y1-y2)}
                       {** v dx je hodnota dx = deltax = abs(x1-x2)}
 
  shl  ax,1            {** v ax je deltay = zbytocne, preto dame ax=konst1=2*deltay}
  mov  word ptr [cs:@Konst1+2],ax      {Ok}
 
  sub  ax,dx           {ax=predikce na chvilu=2*deltay-deltax; pre mna aj zaporne(?)}
  mov  cx,ax           {cx=predikce na dlhodlbo=ax}
  sub  ax,dx           {ax=konst2, lebo=2*deltay-deltax-deltax=2*(deltay-deltax)}
  mov  word ptr [cs:@Konst2+2],ax      {Ok}
 
  {opakovanie: V   ax = konst2 = zbytocne = uvolnene pre plain(?), ktory pixel}
             { x1  bx = x1 = mensie x = zvacsovanie}
             { pr  cx = predikce zvacsovanie}
             { V   dx = deltax = treba uvolnit pre porty}
             { !   di = kam bachnut pixel}
  mov  ah,00010001b
  mov  dx,cx
  mov  cx,bx
  and  cx,00000011b
  shl  ah,cl
  mov  cx,dx
  pop  si    { x2  si = x2 = vacsie x}
 
  mov  al,02h
  mov  dx,03c4h
  out  dx,ax
 
  mov  al,colorka
  mov  byte ptr [ds:di],al
 
  push bp
{hlavny cyklus}
@Hlavny:
  cmp  bx,si
  je   @DostBolo
 
    shl  ah,1
    jnc  @Rotuj
    mov  ah,00010001b
    inc  di                     {incni di ak prerotoval plainsy}
@Rotuj:
 
    inc  bx
    test cx,1000000000000000b   {if predikce<0 }
    jz   @Vacsie3  {if not je = preco by jedla = 0 = nie je = je tam 0}
 
@Konst1:
      add  cx,1234h    {predikce:=predikce+konst1 => konst1 sa meni-modifikuje}
      jmp  @Pixelaz
 
@Vacsie3:
@IncDec:
      db   81h,0C7h  {add di,...}
      dw   Sirka/4   {modifikovany 320 ak od 0 na vacsie=4 a 8 qvdr.; -320 ak z vacsieho mensie 0,0 je vlavo hore}
@Konst2:
      add  cx,1234h     {predikce:=predikce+konst2 => konst2 sa meni-modifikuje}
 
@Pixelaz:
    mov  bp,ax
    mov  al,02h
    out  dx,ax
    mov  ax,bp
    mov  byte ptr [ds:di],al
  jmp  @Hlavny
 
@DostBolo:
  pop  bp
  pop  ds
 
  jmp  @ShitPascalRet
 
{**************************************************************************}
 
@PodmePoY:
 
  popf
  jle  @JeMensi
 
@JeVacsi:     {ide zdola hore do ax, ktore je vacsie}
  add  ax,cx  {ax = y1-y2 +y2 = y1}
  xchg ax,cx  {vymen y1,y2}
 
  push dx
  push ax                         {treba zmenit aj di, huraaa v bx je x2}
 
  add  bx,dx                      {v dx je roziel => x1+(x2-x1)=x2}
  mov  si,bx                      {x1}
 
  mov  dx,Sirka/4      {ajtak ho to znuluje}
  mul  dx              {ax = ax*320    = y1*320}
 
  mov  dx,bx
  shr  dx,1
  shr  dx,1
  add  ax,dx
  mov  di,ax           {di := y1*320+x1}
 
  pop  ax
  pop  dx
 
  mov  word ptr [cs:@ShiftY],0ECD0h  {treba prestavit na shr ah,1}
  mov  byte ptr [cs:@MaskaY+1],10001000b  {treba prestavit na shr di,1}
  mov  byte ptr [cs:@IncDecY],4Fh  {treba prestavit inc di}
  jmp  @Dalejsi
 
@JeMensi:     {ciara ide zhora dole od 0, +320 preto ide doprava, hore sort}
  add  ax,cx  {ax = y1-y2 +y2 = y1}
  xchg ax,cx
  mov  si,bx
  mov  word ptr [cs:@ShiftY],0E4D0h  {treba prestavit na shr ah,1}
  mov  byte ptr [cs:@MaskaY+1],00010001b  {treba prestavit na shr di,1}
  mov  byte ptr [cs:@IncDecY],47h  {treba prestavit inc di}
 
@Dalejsi:
  pop  bx     {treba popnut x2 ..., (bx je nedolezite bolo tam x1)}
  push cx     {a dat tam y2  =>   pojde do si, do vacsieho }
  mov  bx,ax  {bx - od neho sa pojde, +320 ... az do <-\- push cx do cx=y2}
 
{povodna rutinka:}
 
  sub  ax,cx           {do ax treba dat cx-ax = -(ax-cx)}
  neg  ax   
                       {** v ax je hodnota ax = deltay = abs(y1-y2)}
                       {** v dx je hodnota dx = deltax = abs(x1-x2)}
 
  shl  dx,1            {** v dx je deltax = zbytocne, preto dame dx=konst1=2*deltax}
  mov  word ptr [cs:@Konst1Y+2],dx      {Ok}
 
  sub  dx,ax           {dx=predikce na chvilu=2*deltax-deltay; pre mna aj zaporne(?)}
  mov  cx,dx           {cx=predikce na dlhodlbo=dx}
  sub  dx,ax           {dx=konst2, lebo=2*deltax-deltay -deltay=2*(deltax-deltay)}
  mov  word ptr [cs:@Konst2Y+2],dx      {Ok}
 
  {opakovanie: V   ax = deltax = zbytocne = uvolnene pre plain(?), ktory pixel}
             { x1  bx = y1 = mensie y = zvacsovanie}
             { pr  cx = predikce zvacsovanie}
             { V   dx = konst2 = zbytocne =  treba uvolnit pre porty}
             { !   di = kam bachnut pixel}
  mov  ah,00010001b
  mov  dx,cx
  mov  cx,si
  and  cx,00000011b
  shl  ah,cl            {zisti masku plainsy}
  mov  cx,dx
 
  pop  si    { y2  si = y2 = vacsie y}
  mov  dx,03c4h
  mov  al,02h
  out  dx,ax
 
  mov al,colorka
  mov [ds:di],al
 
  push bp
 
{hlavny cyklus}
@HlavnyY:
  cmp  bx,si
  je   @DostBoloY
 
    inc  bx
    add  di,Sirka /4
    test cx,1000000000000000b   {if predikce<0 }
    jz   @Vacsie3Y  {if not je = preco by jedla = 0 = nie je = je tam 0}
 
@Konst1Y:
      add  cx,1234h    {predikce:=predikce+konst1 => konst1 sa meni-modifikuje}
      jmp  @PixelazY
 
@Vacsie3Y:
@ShiftY:
      shl  ah,1
      jnc  @Konst2Y
@MaskaY:
      mov  ah,00010001b
@IncDecY:
      inc  di  {add  di,1234h modifikovany 1 ak od 0 na vacsie; -1 ak z vacsieho mensie 0,0 je vlavo hore}
 
@Konst2Y:
      add  cx,1234h    {predikce:=predikce+konst2 => konst2 sa meni-modifikuje}
 
@PixelazY:
 
    mov  bp,ax
    mov  al,02h
    out  dx,ax
    mov  ax,bp
    mov  byte ptr [ds:di],al
  jmp  @HlavnyY
 
@DostBoloY:
  pop  bp
  pop  ds
 
@ShitPascalRet:
 
{$I+}
{$R+}
end;
 
 
 
PROCEDURE XMode; Assembler;
asm
                push bp
                push ds
 
                mov dx, 0a000h
	        mov es, dx
	        xor di, di
	        xor ax, ax
	        mov cx, 8000h
	        rep stosw
 
 
                mov  ax,cs
                mov  ds,ax
 
        	mov  ax,13h
        	int  10h
 
		mov  dx,3c4h
		mov  ax,2101h
		out  dx,ax
 
                mov  dx,03c4h
        	mov  ax,0604h
        	out  dx,ax               { disable chain4 mode                   }
        	mov  ax,0100h
        	out  dx,ax               { synchronous reset while setting Misc  }
			         	 {  Output for safety, even though clock }
			                 {  unchanged                            }
        	mov  si,offset @X376Y282
        	lodsb
        	mov  dx,03c2h
        	out  dx,al               { select the dot clock and Horiz        }
				         {  scanning rate                        }
        	mov  dx,03c4h
        	mov  ax,0300h
        	out  dx,ax               { undo reset (restart sequencer)        }
 
         	mov  dx,03d4h            { reprogram the CRT Controller          }
        	mov  al,11h              { VSync End reg contains register write }
        	out  dx,al               { protect bit                           }
        	inc  dx                  { CRT Controller Data register          }
        	in   al,dx               { get current VSync End register setting}
        	and  al,07fh             { remove write protect on various       }
        	out  dx,al               { CRTC registers                        }
        	dec  dx                  { CRT Controller Index                  }
        	cld
                xor  ch,ch
        	lodsb
        	mov  cl,al
 
@@SetCRTParmsLoop:
		lodsw                    { get the next CRT Index/Data pair      }
		out  dx,ax               { set the next CRT Index/Data pair      }
		loop @@SetCRTParmsLoop
 
            { clear all of display memory           }
 
                mov  dx,03c4h
                mov  ax,0f02h
                out  dx,ax               { enable writes to all four planes      }
 
                mov  ax,0a000h           { now clear all display memory, 8 pixels}
                mov  es,ax               { at a time                             }
                xor  di,di               { point ES:DI to display memory         }
                xor  ax,ax               { clear to zero-value pixels            }
                mov  cx,8000h            { # of words in display memory          }
                rep  stosw
 
                mov  dx,3c4h
		mov  ax,0101h
		out  dx,ax
 
                pop  ds
                pop  bp
 
		ret
@X376Y282:
	db      0e7h
	db      18
	dw      06e00h  { horz total                    }
	dw      05d01h  { horz displayed                }
	dw      05e02h  { start horz blanking           }
	dw      09103h  { end horz blanking             }
	dw      06204h  { start h sync                  }
	dw      08f05h  { {nd h sync                    }
	dw      06206h  { vertical total                }
	dw      0f007h  { overflow                      }
	dw      06109h  { cell height                   }
	dw      0310fh  {                               }
	dw      03710h  { v sync start                  }
	dw      08911h  { v sync end and protect cr0-cr7}
	dw      03312h  { vertical displayed            }
	dw      02f13h  { offset                        }
	dw      00014h  { turn off dword mode           }
	dw      03c15h  { v blank start                 }
	dw      05c16h  { v blank end                   }
	dw      0e317h  { turn on byte mode             }
 
@X360Y480:
	        DB      0e7h
	        DB      17
	        DW      06b00h  { horz total                    }
	        DW      05901h  { horz displayed                }
	        DW      05a02h  { start horz blanking           }
	        DW      08e03h  { end horz blanking             }
	        DW      05e04h  { start h sync                  }
	        DW      08a05h  { end h sync                    }
	        DW      00d06h  { vertical total                }
	        DW      03e07h  { overflow                      }
	        DW      04009h  { cell height                   }
	        DW      0ea10h  { v sync start                  }
	        DW      0ac11h  { v sync end and protect cr0-cr7}
	        DW      0df12h  { vertical displayed            }
	        DW      02d13h  { offset                        }
	        DW      00014h  { turn off         DWord mode   }
	        DW      0e715h  { v blank start                 }
	        DW      00616h  { v blank end                   }
	        DW      0e317h  { turn on byte mode             }
end;
 
PROCEDURE XMode2; assembler;
asm
        mov ax, 2101h
	mov dx, 3c4h
	out dx, ax
	mov ax, 13h
	int 10h
	mov dx, 3c4h
	mov ax, 604h            {spristupnenie nad 64k image memory}
	out dx, ax
 
	mov ax, 0f02h           {zapis do 00001111 = vsetkych bit plains}
	out dx, ax
 
	mov dx, 0a000h
	mov es, dx
	xor di, di
	xor ax, ax
	mov cx, 8000h
	rep stosw               {vynulovanie pamate 4 plainsy}
 
	mov dx, 3d4h
	mov ax, 14h             {0014h }
	out dx, ax
 
	mov ax, 0e317h
        out dx, ax          { potialto}
 
        mov ax, 2813h
        out dx, ax
 
        mov ax, 0109h
        out dx, ax
end;
 
PROCEDURE PutPixel(x,y,color:integer); assembler;
asm
  mov  ax,PSeg
  mov  es,ax
  mov  dx,03c4h
  mov  cx,x
  and  cx,00000011b
  mov  ah,1
  shl  ah,cl
  mov  al,02
  out  dx,ax
 
  mov  ax,y
  mov  cx,Sirka/4
  mul  cx
  mov  di,ax
 
  mov  ax,x
  shr  ax,1
  shr  ax,1
  add  di,ax
  mov  ax,color
  stosb
end;
 
PROCEDURE Berier(X1,Y1,X2,Y2,X3,Y3:integer;st:integer);
begin
  if st=0 then
  begin
    {$IfDef Lines}
      DLine(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f);
    {$Else}
      PutPixel(X1 shr 1+(X1 and 1),Y1 shr 1+(Y1 and 1),f);
      PutPixel(X3 shr 1+(X3 and 1),Y3 shr 1+(Y3 and 1),f);
    {$EndIf}
    exit;
  end;
  PX1:=((((X1+X3) shr 1)+X2) shr 1); PX1:=PX1 shr 1+(PX1 and 1);
  PY1:=((((Y1+Y3) shr 1)+Y2) shr 1); PY1:=PY1 shr 1+(PY1 and 1);
  PutPixel(PX1,PY1,f);
 
  PX1:=X1;                              PY1:=Y1;
  PX2:=(X1+X2) shr 1;                   PY2:=(Y1+Y2) shr 1;
  PX3:=((((X1+X3) shr 1)+X2) shr 1);    PY3:=((((Y1+Y3) shr 1)+Y2) shr 1);
  Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1);
 
  PX1:=((((X1+X3) shr 1)+X2) shr 1);    PY1:=((((Y1+Y3) shr 1)+Y2) shr 1);
  PX2:=(X2+X3) shr 1;                   PY2:=(Y2+Y3) shr 1;
  PX3:=X3;  PY3:=Y3;
  Berier(PX1,PY1,PX2,PY2,PX3,PY3,st-1);
end;
 
 
PROCEDURE Bezier(X1,Y1,X2,Y2,X3,Y3:integer);
var t:real;
    X,Y:integer;
begin
  t:=0;
  repeat
    X:=round(X1+t*(2*X2-2*X1)+t*t*(X1+X3-2*X2));
    Y:=round(Y1+t*(2*Y2-2*Y1)+t*t*(Y1+Y3-2*Y2));
    PutPixel(X,Y,15);
 
    t:=t+step;
  until t>=1;
end;
 
PROCEDURE Triangel(X1z,Y1z,X2z,Y2z,X3z,Y3z:integer);
var XN,YN,X1,X2,X3,Y1,Y2,Y3,Xd1,Yd1,Xd2,Yd2:integer;
    X1p,X2p,X3p,Y1p,Y2p,Y3p:integer;
    X1p2,X2p2,X3p2,Y1p2,Y2p2,Y3p2:integer;
    X,Y:integer;
    c:char;
    t2:real;
begin
 
  X1:=X1z; X2:=X2z; X3:=X3z;
  Y1:=Y1z; Y2:=Y2z; Y3:=Y3z;
 
  Xd1:=X2;  Yd1:=Y2;  Xd2:=(X1+X3) div 2;  Yd2:=(Y1+Y3) div 2;
 
{$IfDef AllLines}
  Line(X1,Y1,round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1));
  Line(round(Xd2+(Xd1-Xd2)*1),round(Yd2+(Yd1-Yd2)*1),X3,Y3);
  Line(Xd1,Yd1,Xd2,Yd2);
{$EndIf}
 
  DLine(X1,Y1,X3,Y3,15);
 
  X1p:=X1;  X3p:=X3;
  Y1p:=Y1;  Y3p:=Y3;
 
  t2:=krokt;
 
{ X2p:=round(Xd2+(Xd1-Xd2)*t2);
  Y2p:=round(Yd2+(Yd1-Yd2)*t2); }
 
  X2p:=round( (X1p+X3p)/2 + 2*((Xd1-Xd2)*t2-((X1p+X3p)/2-Xd2)));
  Y2p:=round( (Y1p+Y3p)/2 + 2*((Yd1-Yd2)*t2-((Y1p+Y3p)/2-Yd2)));
 
  while t2-krokt<=1 do
  begin
{$IfDef Test}
     if tria=1 then
     asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,12
       out  dx,al
     End;
{$EndIf}
    Berier(X1p shl 1,Y1p shl 1,X2p shl 1,Y2p shl 1,X3p shl 1,Y3p shl 1,BerierSt);
    {Bezier(X1p,Y1p,X2p,Y2p,X3p,Y3p);}
{$IfDef Test}
     if tria=1 then
     asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,15
       out  dx,al
     End;
{$EndIf}
    t2:=t2+krokt;
 
    X1p2:=round(X1p+p*(2*X2p-2*X1p)+p*p*(X1p+X3p-2*X2p));
    Y1p2:=round(Y1p+p*(2*Y2p-2*Y1p)+p*p*(Y1p+Y3p-2*Y2p));
 
    X3p2:=round(X1p+(1-p)*(2*X2p-2*X1p)+(1-p)*(1-p)*(X1p+X3p-2*X2p));
    Y3p2:=round(Y1p+(1-p)*(2*Y2p-2*Y1p)+(1-p)*(1-p)*(Y1p+Y3p-2*Y2p));
 
    X2p2:=round( (X1p2+X3p2)/2 + 2*((Xd1-Xd2)*t2-((X1p2+X3p2)/2-Xd2)));
    Y2p2:=round( (Y1p2+Y3p2)/2 + 2*((Yd1-Yd2)*t2-((Y1p2+Y3p2)/2-Yd2)));
 
 
    X1p:=X1p2;  X2p:=X2p2;  X3p:=X3p2;
    Y1p:=Y1p2;  Y2p:=Y2p2;  Y3p:=Y3p2;
 
  end;
 
 
end;
 
 {  4 --- 3
 
    |     |
    |     |
 
    1 --- 2  }
 
 
begin
  XMode;
 
  randomize;
 
  X1st:=Maxx2-sirkaw div 2;  X2st:=X1st+sirkaw;   X3st:=X2st;  X4st:=X1st;
  Y3st:=Maxy2-vyskaw div 2;   Y4st:=Y3st;  Y1st:=Y3st+vyskaw;  Y2st:=Y1st;
 
  XSSt:=X1st+random(round((X2st-X1st)*0.3))+round((X2st-X1st)*((1-0.3)/2));
  YSSt:=Y4st+random(round((Y1st-Y3st)*0.3))+round((Y1st-Y3st)*((1-0.3)/2));
 
  PSeg:=$0a000;
 
  Yd:=round((X2st-X1st)*0.25);
  Xd:=+stx;  {Yd:=+sty;}
 
  a:=0;
 
  repeat
 
    asm
      mov cx,PSeg
      and cx,$0fff
      shl cx,1
      shl cx,1
      shl cx,1
      shl cx,1
      mov dx,3d4h
      mov al,0ch
      mov ah,ch
      out dx,ax
      mov al,0dh
      mov ah,cl
      out dx,ax
 
      mov dx,03dah
@Retrace: in al,dx
      test al,08h
      jnz  @Retrace
@NoRetrace: in al,dx
      test al,08h
      jz  @NoRetrace
    end;
 
 
    PSeg:=PSeg xor $800;
 
    asm
       mov  dx,03c4h
       mov  ax,0f02h
       out  dx,ax               { enable writes to all four planes      }
 
       mov  ax,PSeg             { now clear all display memory, 8 pixels}
       mov  es,ax               { at a time                             }
       xor  di,di               { point ES:DI to display memory         }
       xor  ax,ax               { clear to zero-value pixels            }
       mov  cx,3500h            { # of words in display memory          }
       rep  stosw
    end;
 
    XSSt:=(X1st+X2st) shr 1 + round(cos(a)*Yd);
    YSSt:=(Y1st+Y3st) shr 1 + round(sin(a)*Yd);
 
    Yd:=Yd+Xd;
    If Yd>=(X2st-X1st)*0.25 then Xd:=-stx;
    if Yd<=Xd then Xd:=stx;
 
    a:=a+2*pi/30;
 
    {
    XSSt:=XSSt+Xd;
    YSSt:=YSSt+Yd;
 
    If XSSt<=X1st+round((X2st-X1st)*((1-0.5)/2)) then Xd:=stx;
    If YSSt<=Y4st+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=sty;
    If XSSt>=X1st+round((X2st-X1st)*0.5)+round((X2st-X1st)*((1-0.5)/2)) then Xd:=-stx;
    If YSSt>=Y4st+round((Y1st-Y3st)*0.5)+round((Y1st-Y3st)*((1-0.5)/2)) then Yd:=-sty;
    }
 
    tria:=1;
{$IfDef Test}
    asm
       mov dx,03dah
@Retrace: in al,dx
      test al,08h
      jz  @Retrace
@NoRetrace: in al,dx
      test al,08h
      jnz  @NoRetrace
 
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,15
       out  dx,al
    End;
{$EndIf}
    Triangel(X1st,Y1st,XSst,YSst,X2st,Y2st);
{$IfDef Test}
    asm
       mov  dx,03c0h
       mov  al,11h+32
       out  dx,al
       mov  al,0
       out  dx,al
    End;
    tria:=0;
{$EndIf}
 
 
    Triangel(X2st,Y2st,XSst,YSst,X3st,Y3st);
    Triangel(X3st,Y3st,XSst,YSst,X4st,Y4st);
    Triangel(X4st,Y4st,XSst,YSst,X1st,Y1st);
 
  until keypressed;
 
  c:=readkey;
end.