Algoritm.Txt - sbor s vpismi procedr v Pascale pre Grafiku 1.00
---------------------------------------------------------------------------


1. Upraven algoritmus Bresenhama na kreslenie iary
   Prevzat z VGL 2.0 od Marka Morleyho (on to zase prevzal z Graphics Gems).
   V sbore Line.Asm mu zodpoved procedra Line, aj ke je silne zrchlen
   vaka priamemu adresovaniu.

Procedure Bres (X1,Y1,X2,Y2: Integer; C: Byte);
 Var D,DX,AX,SX,DY,AY,SY,X,Y: Integer;
  Function Sgn (X: Integer): Integer;
   Begin
    If X >= 0 Then Sgn := 1
    Else Sgn := -1;
   End;
  Begin
   DX := X2 - X1;
   AX := ABS (DX) Shl 1;
   SX := Sgn (DX);
   DY := Y2 - Y1;
   AY := ABS (DY) Shl 1;
   SY := Sgn (DY);
   X := X1;
   Y := Y1;
   If AX > AY Then
    Begin
     D:= AY - (AX Shr 1);
      While X <> X2 Do
       Begin
        SetPixel (X,Y,C);
        If D >= 0 Then
         Begin
          Y := Y + SY;
          D := D - AX;
         End;
        X := X + SX;
        D := D + AY;
       End
     End
   Else
    Begin
     D := AX - (AY Shr 1);
      While Y <> Y2 Do
       Begin
        SetPixel (X,Y,C);
        If D >= 0 Then
         Begin
          X := X + SX;
          D := D - AY;
         End;
        Y := Y + SY;
        D := D + AX;
       End;
    End;
  End;


2. Kresba vodorovnej iary
   V Pascale je to ete dos komplikovan, tak si pozri Line.Asm, tam
   je to uroben vemi efektne cez REP STOSW a STOSB.

Procedure HorizontalLine (X1,X2,Y: Word; Color: Byte);
 Var I,Len,Off,NColor: Word;
     Parna: Boolean;
  Begin
   NColor := Color + Color Shl 8;          (* 2 byty s rovnakou farbou *)
   Off := X1 + Y Shl 8 + Y Shl 6;          (* Vpoet adresy *)
   Parna := True;                          (* Predpoklad - iara m prnu dku *)
   Len := X2 - X1 + 1;                     (* Vpoet dky iary *)
   If Len And 1 = 1 Then Parna := False;   (* Zistenie, i je iara prna (i m nastaven bit 0) *)
   Len := Len Shr 1;                       (* Vydelenie dky dvomi *)
   For I := 1 To Len Do
    Begin
     MemW [$A000:Off] := NColor;           (* Kreslme 2 body naraz *)
     Off := Off + 2;                       (* Adresu zvyujeme o 2 *)
    End;                                   (* Ak je dka neprna, pridme ete 1 bod *)
   If Not Parna Then Mem [$A000:Off] := Color;
  End;


3. Kresba krunice
   Pouva Bresenhamov algoritmus pre kresbu krunice.
   Publikovan v knihe "Potaov grafika - princpy a algoritmy",
   (c) Grada 1992, autor Ji ra

Procedure Circle (XS,YS,R: Integer; C: Byte);
 Var P,DX,DY,X,Y: Integer;
  Begin
   X := 0;
   Y := R;
   P := 1 - R;
   DX := 3;
   DY := 2 * R - 2;
   Repeat
    SetPixel (XS + X,YS + Y,C);
    SetPixel (XS - X,YS + Y,C);
    SetPixel (XS + X,YS - Y,C);
    SetPixel (XS - X,YS - Y,C);
    SetPixel (XS + Y,YS + X,C);
    SetPixel (XS - Y,YS + X,C);
    SetPixel (XS + Y,YS - X,C);
    SetPixel (XS - Y,YS - X,C);
    If P >= 0 Then
     Begin
      P := P - DY;
      DY := DY - 2;
      Y := Y - 1;
     End;
    P := P + DX;
    DX := DX + 2;
    X := X + 1;
   Until X > Y
  End;


4. Upraven algoritmus Bresenhama (pre kresbu krunice) na vykreslenie kruhu.
   Vykresuje vodorovn iary, ktormi vypa kruh. Vyztvorkovan je
   rieenie pomocou zvislch iar, ktor je pomalie - je tu na to, aby bolo
   vidie, e to ide aj inak.


Procedure FilledCircle (XS,YS,R: Integer; C: Byte);
 Var P,DX,DY,X,Y: Integer;
  Begin
   X := 0;
   Y := R;
   P := 1 - R;
   DX := 3;
   DY := 2 * R - 2;
   Repeat
    HorizontalLine (XS - X,XS + X,YS + Y,C);
    HorizontalLine (XS - X,XS + X,YS - Y,C);
    HorizontalLine (XS - Y,XS + Y,YS + X,C);
    HorizontalLine (XS - Y,XS + Y,YS - X,C);
(***************** In monos ******************)
(*    VerticalLine (XS + X,YS - Y,YS + Y,C);    *)
(*    VerticalLine (XS - X,YS - Y,YS + Y,C);    *)
(*    VerticalLine (XS + Y,YS - X,YS + X,C);    *)
(*    VerticalLine (XS - Y,YS - X,YS + X,C);    *)
(************************************************)
    If P >= 0 Then
     Begin
      P := P - DY;
      DY := DY - 2;
      Y := Y - 1;
     End;
    P := P + DX;
    DX := DX + 2;
    X := X + 1;
   Until X > Y
  End;


5. Kresba elipsy postaven na algoritmoch Akena a Earna
   Vyuva symetriu tyroch bodov.
   Publikovan v knihe "Potaov grafika - princpy a algoritmy",
   (c) Grada 1992, autor Ji ra


Procedure Ellipse (XS,YS,A,B: Integer;C: Byte);
 Var AK,DAK,BK,DBK: LongInt;
     P,XD,YD: LongInt;
     X,Y: Integer;
  Procedure Points;
   Begin
    SetPixel (XS + X,YS + Y,C);
    SetPixel (XS - X,YS + Y,C);
    SetPixel (XS + X,YS - Y,C);
    SetPixel (XS - X,YS - Y,C);
   End;
  Begin
   X := 0;
   Y := B;
   AK := LongInt (A) * A;
   BK := LongInt (B) * B;
   DAK := 2 * AK;
   DBK := 2 * BK;
   P := BK - AK * B + AK Shr 2;
   XD := 0;
   YD := DAK * B;
   While XD < YD Do
    Begin
     Points;
     If P >= 0 Then
      Begin
       Y := Y - 1;
       YD := YD - DAK;
       P := P - YD;
      End;
     X := X + 1;
     XD := XD + DBK;
     P := P + BK + XD;
    End;
   P := P + (3 * (AK - BK) Div 2-(XD + YD)) Div 2;
   While Y >= 0 Do
    Begin
     Points;
     If P <= 0 Then
      Begin
       X := X + 1;
       XD := XD + DBK;
       P := P + XD;
      End;
     Y := Y - 1;
     YD := YD - DAK;
     P := P + AK - YD;
    End;
  End;

6. Kresba vntornej oblasti elipsy je postaven na algoritme pre kresbu
   elipsy, miesto tyroch smernch bodov vykresuje dve vodorvn seky.


Procedure FilledEllipse (XS,YS,A,B: Integer;C: Byte);
 Var AK,DAK,BK,DBK: LongInt;
     P,XD,YD: LongInt;
     X,Y: Integer;
  Procedure Lines;
   Begin
    HorizontalLine (XS-X,XS+X,YS+Y,C);
    HorizontalLine (XS-X,XS+X,YS-Y,C);
   End;
  Begin
   X := 0;
   Y := B;
   AK := LongInt (A) * A;
   BK := LongInt (B) * B;
   DAK := 2 * AK;
   DBK := 2 * BK;
   P := BK - AK * B + AK Shr 2;
   XD := 0;
   YD := DAK * B;
   While XD < YD Do
    Begin
     Lines;
     If P >= 0 Then
      Begin
       Y := Y - 1;
       YD := YD - DAK;
       P := P - YD;
      End;
     X := X + 1;
     XD := XD + DBK;
     P := P + BK + XD;
    End;
   P := P + (3 * (AK - BK) Div 2-(XD + YD)) Div 2;
   While Y >= 0 Do
    Begin
     Lines;
     If P <= 0 Then
      Begin
       X := X + 1;
       XD := XD + DBK;
       P := P + XD;
      End;
     Y := Y - 1;
     YD := YD - DAK;
     P := P + AK - YD;
    End;
  End;


7. Vykresovanie spritu.
   Algoritmus je ete znane pomal, pozri Sprite v Sprite.Asm.
   Vetky body v obdniku Width x Height s vykresovan.

Procedure Sprite (PSprite: Pointer; X,Y: Word; Width,Height: Byte);
 Var SegSpr,OfsSpr,SegVid,OfsVid: Word;
     I: Byte;
  Begin
   SegVid := $A000;                         (* Videopam *)
   OfsVid := X + (Y Shl 8) + (Y Shl 6);     (* Adresa *)
   SegSpr := Seg (PSprite^);                (* Segment spritu *)
   OfsSpr := Ofs (PSprite^);                (* Offset spritu *)
   For I := 1 To Height Do                  (* Ideme po riadkoch *)
    Begin                                   (* Vyplnme vetky stpce jednho riadku *)
     Move (Mem [SegSpr:OfsSpr], Mem [SegVid:OfsVid], Width);
     OfsSpr := OfsSpr + Width;              (* Posunieme sa na a riadok v sprite *)
     OfsVid := OfsVid + 320;                (* Posunieme sa na a riadok vo videopamti *)
    End;
  End;



8. Vykresovanie spritu bez nulovch bodov.
   Algoritmus je ete pomal ako predchdzajci, pozri SpriteOver v Sprite.Asm.
   Body s hodnotou 0 v obdniku Width x Height nie s vykresovan.

Procedure SpriteOver (PSprite: Pointer; X,Y: Word; Width,Height: Byte);
 Var SegSpr,OfsSpr,SegVid,OfsVid: Word;
     I,J,K: Byte;
  Begin
   SegVid := $A000;                         (* Videopam *)
   OfsVid := X + (Y Shl 8) + (Y Shl 6);     (* Adresa *)
   SegSpr := Seg (PSprite^);                (* Segment spritu *)
   OfsSpr := Ofs (PSprite^);                (* Offset spritu *)
   For I := 1 To Height Do                  (* Ideme po riadkoch *)
    Begin                                   (* Ideme po stpcoch *)
     For J := 0 To Width-1 Do               (* Zistme hodnotu bodu v sprite *)
      K := Mem [SegSpr:OfsSpr + Width]      (* Ak to nie je 0, vykreslme bod na obrazovku *)
      If K <> 0 Then Mem [SegVid:OfsVid + Width] := K;
     OfsSpr := OfsSpr + Width;              (* Posunieme sa na a riadok v sprite *)
     OfsVid := OfsVid + 320;                (* Posunieme sa na a riadok vo videopamti *)
    End;
  End;



9. Zmena vekosti spritu (SpriteScaling)
   Zmen vekos ubovonho spritu, pouva celoseln aritmetiku = odpad
   pouvanie relnych sel na zistenie potrebnho bodu.
   Algoritmus je ete znane pomal, zrchlenie sa d dosiahnu vmenou
   procedry SetPixel za priame adresovanie a zmenou vypotavania offsetu
   aktulneho bodu v sprite.
   Procedra SpriteScale v sbore Sprite.Asm je u tmto spsobom zrchlen.


Procedure SpriteScale (PSprite: Pointer; X,Y:Word; W,H: Byte; NW,NH: Word);
 Var SX, SY, PX, PY, S, O, NX, NY, SSX: Word;
  Begin
   S := Seg (PSprite^);
   O := Ofs (PSprite^);
   NX := X + NW - 1;
   NY := Y + NH - 1;
   SY := 0;
   SSX := X;
   If (NW >= W) And (NH >= H) Then
    Begin
     PY := H;
     While Y <= NY Do
      Begin
       SX := 0;
       PX := W;
       While X <= NX Do
        Begin
         SetPixel (X, Y, Mem [S:O + SX + SY * W]);
         If PX >= NW Then
          Begin
           SX := SX + 1;
           PX := PX - NW;
          End;
         PX := PX + W;
         X := X + 1;
        End;
       If PY >= NH Then
        Begin
         SY := SY + 1;
         PY := PY - NH;
        End;
       PY := PY + H;
       Y := Y + 1;
       X := SSX;
      End;
    End;
   If (NW >= W) And (NH < H) Then
    Begin
     PY := NH;
     While Y <= NY Do
      Begin
       SX := 0;
       PX := W;
       While X <= NX Do
        Begin
         SetPixel (X, Y ,Mem [S:O + SX + SY * W]);
         If PX >= NW Then
          Begin
           SX := SX + 1;
           PX := PX - NW;
          End;
         PX := PX + W;
         X := X + 1;
        End;
       If PY >= H Then
        Begin
         Y := Y + 1;
         PY := PY - H;
        End;
       PY := PY + NH;
       SY := SY + 1;
       X := SSX;
      End;
    End;
   If (NW < W) And (NH > H) Then
    Begin
     PY := H;
     While Y <= NY Do
      Begin
       SX := 0;
       PX := NW;
       While X <= NX Do
        Begin
         SetPixel (X, Y, Mem [S:O + SX + SY * W]);
         If PX >= W Then
          Begin
           X := X + 1;
           PX := PX - W;
          End;
         PX := PX + NW;
         SX := SX + 1;
        End;
       If PY >= NH Then
        Begin
         SY := SY + 1;
         PY := PY - NH;
        End;
       PY := PY + H;
       Y := Y + 1;
       X := SSX;
      End;
    End;
   If (NW < W) And (NH < H) Then
    Begin
     PY := NH;
     While Y <= NY Do
      Begin
       SX := 0;
       PX := NW;
       While X <= NX Do
        Begin
         SetPixel (X, Y, Mem [S:O + SX + SY * W]);
         If PX >= W Then
          Begin
           X := X + 1;
           PX := PX - W;
          End;
         PX := PX + NW;
         SX := SX + 1;
        End;
       If PY >= H Then
        Begin
         Y := Y + 1;
         PY := PY - H;
        End;
       PY := PY + NH;
       SY := SY + 1;
       X := SSX;
      End;
    End;
  End;



---------------------------------------------------------------------------
Algoritmy v tomto sbore je mon vone pouva a modifikova.






