Uses Crt,Gfx3;


Var i:Word;
    TProb,Prob:Array[1..200,1..2] of Integer;
    LookSin:Array[1..628] of Integer;
    Counter:Word;
    MaxProbs:Word;



Procedure TGouraudPoly(X1, Y1, X2, Y2, X3, Y3, C1, C2, C3:Integer; PgSeg : Word);

Var
  xTop, yTop : Integer;
  xBot, yBot : Integer;
  xMid, yMid : Integer;
  cTop, cBot, cMid : Integer;
  Count : Integer;
  xVal1, xStep1 : Integer;
  xVal2, xStep2 : Integer;
  cVal1, cStep1 : Integer;
  DColor : Integer;
  crMid : Integer;
  xrMid : Integer;
  hCount, cVal : Integer;

Begin
  Asm
    Mov  ax,Y1
    Mov  bx,X1
    Mov  cx,Y2
    Mov  dx,X2
    Mov  si,C1
    Mov  di,C2

    Mov  xTop,bx
    Mov  yTop,ax
    Mov  xBot,dx
    Mov  yBot,cx
    Mov  cTop,si
    Mov  cBot,di
    Cmp  ax,cx
    Jle @Skip2Top
      Mov  xTop,dx
      Mov  yTop,cx
      Mov  xBot,bx
      Mov  yBot,ax
      Mov  cTop,di
      Mov  cBot,si
   @Skip2Top:
    Mov  ax,Y3
    Mov  bx,X3
    Mov  cx,C3
    Cmp  ax,yTop
    Jge @CheckY3Bottom
      Mov  dx,yTop
      Mov  yMid,dx
      Mov  dx,xTop
      Mov  xMid,dx
      Mov  dx,cTop
      Mov  cMid,dx
      Mov  yTop,ax
      Mov  xTop,bx
      Mov  cTop,cx
      Jmp @Fini
   @CheckY3Bottom:
      Cmp ax,yBot
      Jle @Y3Mid
        Mov  dx,yBot
        Mov  yMid,dx
        Mov  dx,xBot
        Mov  xMid,dx
        Mov  dx,cBot
        Mov  cMid,dx
        Mov  yBot,ax
        Mov  xBot,bx
        Mov  cBot,cx
        Jmp @Fini
     @Y3Mid:
        Mov  yMid,ax
        Mov  xMid,bx
        Mov  cMid,cx
   @Fini:
  End;

  If (yBot-yTop) = 0
    Then Begin
      xrMid := xMid;
      crMid := cMid;
    End
    Else Begin
      xrMid := (yMid-yTop)*(xBot-xTop) Div (yBot-yTop) + xTop;
      crMid := (yMid-yTop)*(cBot-cTop) Div (yBot-yTop) + cTop;
    End;

  Asm
    Mov  es,PgSeg
  End;

  If xMid < XrMid
    Then Begin
      DColor := (crMid-cMid) Shl 8 Div (xrMid-xMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := xTop Shl 6;
      xVal2 := xVal1;
      xStep1 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);
      cStep1 := (cMid-cTop) Shl 8 Div (yMid-yTop+1);
      xStep2 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok
            Mov Dl,50
            @Ok:
            Cmp Dh,50
            Jl  @ok2
            Mov Dh,50
            @Ok2:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal2 := xVal2 - xStep2;

      cVal1 := cMid Shl 8;
      xVal1 := xMid Shl 6;
      xStep1 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      cStep1 := (cBot-cMid) Shl 8 Div (yBot-yMid+1);
      For Count := yMid+1 to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok3
            Mov Dl,50
            @Ok3:
            Cmp Dh,50
            Jl  @ok4
            Mov Dh,50
            @ok4:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End
    Else Begin
      DColor := (cMid-crMid) Shl 8 Div (xMid-xrMid+1);

      cVal1 := cTop Shl 8;
      xVal1 := (xTop) Shl 6;
      xVal2 := xVal1;
      xStep1 := (xBot-xTop) Shl 6 Div (yBot-yTop+1);
      cStep1 := (cBot-cTop) Shl 8 Div (yBot-yTop+1);
      xStep2 := (xMid-xTop) Shl 6 Div (yMid-yTop+1);

      For Count := yTop to yMid do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6
            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok5
            Mov Dl,50
            @Ok5:
            Cmp Dh,50
            Jl  @ok6
            Mov Dh,50
            @Ok6:

            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;

      xVal1 := xVal1 - xStep1;
      cVal1 := cVal1 - cStep1;
      xVal2 := (xMid) Shl 6;
      xStep2 := (xBot-xMid) Shl 6 Div (yBot-yMid+1);
      For Count := yMid+1 to yBot do
        Begin
          Asm
            Mov  bx,Count
            Mov  dx,bx
            Shl  bx,6
            Add  bh,dl
            Mov  di,bx

            Mov  ax,Word Ptr [xVal1]
            Shr  ax,6
            Mov  cx,Word Ptr [xVal2]
            Shr  cx,6

            Add  di,ax

            Sub  cx,ax
            Inc  cx
            Js   @Exit
            Jcxz @Exit
            Mov  bx,dColor
            Mov  ax,cVal1
            Shr  cx,1
            Jnc @SkipSingle
            {add ah,es:[di]}
            Mov  es:[di],ah
            Add  ax,bx
            Inc  di
           @SkipSingle:
            Jcxz @Exit
           @Looper:
            Mov  dl,ah
            Add  ax,bx
            Mov  dh,ah
            Add  ax,bx
            add dx,es:[di]
            Cmp Dl,50
            Jl  @ok7
            Mov Dl,50
            @Ok7:
            Cmp Dh,50
            Jl  @ok8
            Mov Dh,50
            @Ok8:
            Mov  es:[di],dx
            Add  di,2
            Dec  cx
            Jnz  @Looper
           @Exit:
          End;
          Inc(cVal1, cStep1);
          Inc(xVal1, xStep1);
          Inc(xVal2, xStep2);
        End;
    End;

End;


Procedure Smooth(Where:Word);assembler;
Var M:Word;
Asm
 Mov Es,Where
 Xor Di,Di
 Xor Ah,ah
 Xor bh,bh
 Xor Ch,Ch
 Xor Dh,Dh
 @MainLoop:
  Inc Di
  Dec Di
  Mov Al,Es:[Di]
  Add Di,2
  Mov Bl,Es:[Di]
  Add Di,320
  Mov Cl,Es:[Di]
  Sub Di,2
  Mov Dl,Es:[Di]
  Sub Di,319
  Mov M,Ax
  Add M,Bx
  Add M,Cx
  Add M,Dx
  Shr M,2
  Mov Ax,M
  Mov Es:[Di],Al
  Xor Ah,Ah

  Cmp Di,63670
 Jne @MainLoop
End;





Procedure GetPallete(Fil:String);
Var TCol:Byte;
    Pale:Array[1..3,0..255] of Byte;
Begin
 LPcx(Fil,Vaddr);
 For TCol:=0 to 100 do
   GetPal(Getpixel(160-TCol,100,Vaddr),Pale[1,TCol],Pale[2,TCol],Pale[3,TCol]);
 For TCol:=0 to 100 do
  Pal(TCol,Pale[1,100-TCol],Pale[2,100-TCol],Pale[3,100-TCol]);
End;






Procedure ShowProbs;
Var TempX1,TempX2,TempY1,TempY2:Integer;
    Light:Word;

Procedure PseudoCliping;
Begin
 If TempX1<0 Then TempX1:=0;
 If TempX2<0 Then TempX2:=0;
 If TempY1<0 Then TempY1:=0;
 If TempY2<0 Then TempY2:=0;
 If TempX1>319 Then TempX1:=319;
 If TempX2>319 Then TempX2:=319;
 If TempY1>199 Then TempY1:=199;
 If TempY2>199 Then TempY2:=199;
End;

Begin
 For i:=1 to MaxProbs do
  Begin
   TempX1:=TProb[i,1]-20;
   TempX2:=TempX1+30;
   TempY1:=TProb[i,2]-20;
   TempY2:=TempY1+30;
   PseudoCliping;
   Light:=Round(Abs(100-Abs(TempX1-160))/2);
   Light:=Light shr 1 +Round(Abs(100-Abs(TempY1-100))/2);
   TGouraudPoly(160,100,TempX1,TempY1,TempX2,TempY2,
   0,Light,Light,Vaddr);
  End;
End;





Procedure MoveProbs(Count:Word);
Var Speed1,Speed2:Word;
Begin

 Speed1:=LookSin[Count Mod 628]+160;
 Speed2:=Looksin[(Count+500) Mod 628]+100;
 For i:=1 to MaxProbs do
  Begin
   TProb[i,1]:=Speed1+PRob[i,1];
   TPRob[i,2]:=Speed2+PRob[i,2];
  End;
End;



Begin
 MaxProbs:=100;
 SetMCGA;
 SetUpVirtual;
 GetPallete('LenPal3.PCX');
 Pal(0,0,0,0);
 For i:=1 to MaxProbs do
  Begin
   Prob[i,1]:=Round(Cos(i)*(i*15));
   Prob[i,2]:=Round(Sin(i)*(i*15));
  End;
 Cls(Vaddr,0);
 For i:=1 to 628 do
  LookSin[i]:=Round(Sin(i/100)*100);

 Repeat
  Cls(Vaddr,0);
  Inc(Counter,12);
  MoveProbs(Counter);
  ShowProbs;
  WaitRetrace;
  Smooth(Vaddr);
  Smooth(Vaddr);
  Line(0,0,0,199,0,vaddr);
  Line(1,0,1,199,0,vaddr);
  Line(319,0,319,199,0,vaddr);
  Line(318,0,318,199,0,vaddr);
  Flip(VAddr,Sega000);
 Until Keypressed;
 ShutDown;
 SetText;
End.


