home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / OTFACE.ZIP / FACESORT.PAS < prev    next >
Pascal/Delphi Source File  |  1996-08-29  |  13KB  |  408 lines
  1. {
  2.   Basic 3d engine. Rotates a closed cube around 256 degrees. By Vulture/OT
  3. }
  4.  
  5. Program Rotations3d;
  6.  
  7. Uses Crt;                                { Used units (don't need much :-) }
  8.  
  9. Const VGA = $0a000;                      { VGA segment }
  10.       MaxPolys = 6;
  11.  
  12. Type Virtual = Array [1..64000] of byte;
  13.      VirtPtr = ^Virtual;                 { Pointer to virtual screen }
  14.      PolyObject = Array[1..MaxPolys,1..4,1..3] of Integer;
  15.  
  16. Const Size = 70;
  17.       Box: PolyObject =                  { Our object }
  18.         (((-Size,-Size,Size),(-Size,Size,Size),(Size,Size,Size),(Size,-Size,Size)),
  19.          ((-Size,-Size,-Size),(-Size,Size,-Size),(Size,Size,-Size),(Size,-Size,-Size)),
  20.          ((-Size,-Size,-Size),(-Size,Size,-Size),(-Size,Size,Size),(-Size,-Size,Size)),
  21.          ((Size,-Size,-Size),(Size,Size,-Size),(Size,Size,Size),(Size,-Size,Size)),
  22.          ((Size,-Size,Size),(Size,-Size,-Size),(-Size,-Size,-Size),(-Size,-Size,Size)),
  23.          ((Size,Size,Size),(Size,Size,-Size),(-Size,Size,-Size),(-Size,Size,Size)));
  24.  
  25. Var Virscr: VirtPtr;
  26.     Vaddr: Word;                     { Segment value of virtual screen}
  27.     Sine: Array[0..255] of Integer;  { Contains sine&cosine values }
  28.     Points: PolyObject;              { Holds new x,y,z }
  29.     AverageZ: Array[1..MaxPolys] of Integer;  { Average Z values of polygons }
  30.     Order: Array[1..MaxPolys] of Integer; { Order in which to draw the polys }
  31.     Xlist: Array[0..199,1..2] of Integer; { Start/End x values for polygon }
  32.     X,Y,Z: Integer;                  { Variables for formula }
  33.     Xt,Yt,Zt: Integer;               { Temporary variables for x,y,z }
  34.     XAngle,YAngle,ZAngle: Byte;      { Angles to rotate around }
  35.     Zoff: Integer;                   { Distance from viewer }
  36.     XSin,XCos: Integer;              { Sine/cosine of angle to rotate around }
  37.     YSin,YCos: Integer;
  38.     ZSin,ZCos: Integer;
  39.     Key: Byte;                       { To intercept a keypress }
  40.  
  41. (* =========================== MEMORY ROUTINES ============================ *)
  42.  
  43. Procedure SetUpVirtual;     { Set up memory needed for virtual screen }
  44. Begin
  45.   GetMem(VirScr,64000);
  46.   Vaddr := Seg(VirScr^);
  47. End;
  48.  
  49. Procedure ShutDown;         { Free memory used by virtual screen }
  50. Begin
  51.   FreeMem(VirScr,64000);
  52. End;
  53.  
  54. (* =========================== GRAPHICS ROUTINES ========================== *)
  55.  
  56. Procedure VideoMode(Mode: Byte); Assembler;
  57. Asm
  58.   xor     ah,ah
  59.   mov     al,Mode
  60.   int     10h
  61. End;
  62.  
  63. Procedure WaitRetrace; Assembler;
  64. Asm
  65.   mov     dx,3dah
  66. @l1:
  67.   in      al,dx
  68.   and     al,08h
  69.   jnz     @l1
  70. @l2:
  71.   in      al,dx
  72.   and     al,08h
  73.   jz      @l2
  74. End;
  75.  
  76. Procedure ClearScreen(Color:Byte;Where:Word); Assembler;
  77. Asm
  78.   mov     ax,Where
  79.   mov     es,ax           { ES points to VGA or vitual screen }
  80.   xor     di,di           { Start at begin of screen }
  81.   cld
  82.   mov     al,Color        { Set color in ax }
  83.   mov     ah,al
  84.   mov     cx,32000        { Do the entire screen }
  85.   rep     stosw           { Store the word in ax to es:[di] }
  86. End;
  87.  
  88. Procedure FlipPage(source,dest:Word); Assembler;
  89. Asm
  90.   push    ds              { Save ds on stack }
  91.   mov     ax,[Source]
  92.   mov     ds,ax           { ds => source segment }
  93.   xor     si,si           { ds:si => source }
  94.   mov     ax,[Dest]
  95.   mov     es,ax           { es => destination segment }
  96.   xor     di,di           { es:di => destination }
  97.   mov     cx,16000        { Screen size = 64 kbytes = 16000 dwords }
  98.   db      66h
  99.   rep     movsw           { Copy ds:si to es:di }
  100.   pop     ds              { Restore ds }
  101. End;
  102.  
  103. Procedure Hline(x1,x2,y:Word;Color:Byte;Where:Word); Assembler;
  104. Asm
  105.   mov     ax,Where
  106.   mov     es,ax
  107.   mov     ax,y
  108.   mov     di,ax
  109.   shl     ax,8
  110.   shl     di,6
  111.   add     di,ax
  112.   add     di,x1
  113.  
  114.   mov     al,Color
  115.   mov     ah,al
  116.   mov     cx,x2
  117.   sub     cx,x1
  118.   shr     cx,1
  119.   jnc     @Start
  120.   stosb                   { Set extra byte if carry set }
  121. @Start:
  122.   rep     stosw           { Set all bytes }
  123. End;
  124.  
  125. Procedure ScanEdge(X1,Y1,X2,Y2: Integer);        { By Denthor/Asphyxia }
  126. Var Loop,X,Xstep,Temp: Integer;
  127. Begin
  128.   If Y1 = Y2 then Exit;
  129.   If Y1 > Y2 then                         { y1 must be smaller than y2 }
  130.   Begin
  131.     Temp := Y1;
  132.     Y1 := Y2;
  133.     Y2 := Temp;
  134.     Temp := X1;
  135.     X1 := X2;
  136.     X2 := Temp;
  137.   End;
  138.   Xstep := ((X2-X1) shl 8) div (Y2-Y1);   { Calculate gradient }
  139.   X := X1 shl 8;                          { Starting x value }
  140.   For Loop := Y1 to Y2 Do
  141.   Begin
  142.     If (X shr 8) < Xlist[Loop,1] then Xlist[Loop,1] := X shr 8;
  143.     If (X shr 8) > Xlist[Loop,2] then Xlist[Loop,2] := X shr 8;
  144.     Inc(X,Xstep);
  145.   End;
  146. End;
  147.  
  148. Procedure Draw_Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4: Integer; Color: Byte; Where:Word);
  149. Var MinY,MaxY,Loop: Integer;
  150. Begin
  151.   Asm                                     { Set minx/maxx to extremes }
  152.      mov    si,offset Xlist
  153.      mov    cx,200
  154. @FillLoop:
  155.      mov    ax,320                        { Minx = 320 }
  156.      mov    ds:[si],ax
  157.      inc    si
  158.      inc    si
  159.      xor    ax,ax                         { Maxx = 0 }
  160.      mov    ds:[si],ax
  161.      inc    si
  162.      inc    si
  163.      loop   @FillLoop
  164.   End;
  165.   miny:=y1;
  166.   maxy:=y1;
  167.   if y2<miny then miny:=y2;
  168.   if y3<miny then miny:=y3;
  169.   if y4<miny then miny:=y4;
  170.   if y2>maxy then maxy:=y2;
  171.   if y3>maxy then maxy:=y3;
  172.   if y4>maxy then maxy:=y4;
  173.   ScanEdge(X1,Y1,X2,Y2);
  174.   ScanEdge(X2,Y2,X3,Y3);
  175.   ScanEdge(X3,Y3,X4,Y4);
  176.   ScanEdge(X4,Y4,X1,Y1);
  177.   For Loop := MinY to MaxY Do
  178.      HLine(Xlist[Loop,1],Xlist[Loop,2],Loop,Color,Where);
  179. End;
  180.  
  181. (* ============================== 3D ROUTINES ============================= *)
  182.  
  183. Procedure CalculateSine;
  184. Var I: Integer;
  185. Begin
  186.   For I := 0 to 255 Do Sine[I] := Round(Sin(I*(2*pi/256))*256);
  187. End;
  188.  
  189. Procedure UpdateRotation(DeltaX,DeltaY,DeltaZ: Integer);
  190. Begin
  191.   XAngle := (Xangle+DeltaX) Mod 256;  { Add addition factors }
  192.   YAngle := (Yangle+DeltaY) Mod 256;
  193.   ZAngle := (Zangle+DeltaZ) Mod 256;
  194.  
  195.   Xsin := Sine[Xangle];               { Grab sine from sinetable }
  196.   Xcos := Sine[(Xangle+64) Mod 256];  { Add 64 to get cosine (neat trick!) }
  197.   Ysin := Sine[Yangle];
  198.   Ycos := Sine[(Yangle+64) Mod 256];
  199.   Zsin := Sine[Zangle];
  200.   Zcos := Sine[(Zangle+64) Mod 256];
  201. End;
  202.  
  203. Procedure GetOrgXYZ(Obj: PolyObject; Poly,Place: Integer);
  204. Begin
  205.   X := Obj[Poly,Place,1];    { Grabs our original x,y,z values }
  206.   Y := Obj[Poly,Place,2];
  207.   Z := Obj[Poly,PLace,3];
  208. End;
  209.  
  210. Procedure RotatePoint; Assembler;  { Rotates a point around all axis }
  211. Asm
  212. { Rotate around x-axis }
  213. { YT = Y * COS(xang) - Z * SIN(xang) / 256 }
  214. { ZT = Y * SIN(xang) + Z * COS(xang) / 256 }
  215. { Y = YT }
  216. { Z = ZT }
  217.     pusha
  218.     mov     ax,[Y]
  219.     mov     bx,[XCos]
  220.     imul    bx               { ax = Y * Cos(xang) }
  221.     mov     bp,ax
  222.     mov     ax,[Z]
  223.     mov     bx,[XSin]
  224.     imul    bx               { ax = Z * Sin(xang) }
  225.     sub     bp,ax            { bp = Y * Cos(xang) - Z * Sin(xang) }
  226.     sar     bp,8             { bp = Y * Cos(xang) - Z * Sin(xang) / 256 }
  227.     mov     [Yt],bp
  228.  
  229.     mov     ax,[Y]
  230.     mov     bx,[XSin]
  231.     imul    bx               { ax = Y * Sin(xang) }
  232.     mov     bp,ax
  233.     mov     ax,[Z]
  234.     mov     bx,[XCos]
  235.     imul    bx               { ax = Z * Cos(xang) }
  236.     add     bp,ax            { bp = Y * SIN(xang) + Z * COS(xang) }
  237.     sar     bp,8             { bp = Y * SIN(xang) + Z * COS(xang) / 256 }
  238.     mov     [Zt],bp
  239.  
  240.     mov     ax,[Yt]          { Switch values }
  241.     mov     [Y],ax
  242.     mov     ax,[Zt]
  243.     mov     [Z],ax
  244.  
  245. { Rotate around y-axis }
  246. { XT = X * COS(yang) - Z * SIN(yang) / 256 }
  247. { ZT = X * SIN(yang) + Z * COS(yang) / 256 }
  248. { X = XT }
  249. { Z = ZT }
  250.  
  251.     mov     ax,[X]
  252.     mov     bx,[YCos]
  253.     imul    bx               { ax = X * Cos(yang) }
  254.     mov     bp,ax
  255.     mov     ax,[Z]
  256.     mov     bx,[YSin]
  257.     imul    bx               { ax = Z * Sin(yang) }
  258.     sub     bp,ax            { bp = X * Cos(yang) - Z * Sin(yang) }
  259.     sar     bp,8             { bp = X * Cos(yang) - Z * Sin(yang) / 256 }
  260.     mov     [Xt],bp
  261.  
  262.     mov     ax,[X]
  263.     mov     bx,[YSin]
  264.     imul    bx               { ax = X * Sin(yang) }
  265.     mov     bp,ax
  266.     mov     ax,[Z]
  267.     mov     bx,[YCos]
  268.     imul    bx               { ax = Z * Cos(yang) }
  269.     add     bp,ax            { bp = X * SIN(yang) + Z * COS(yang) }
  270.     sar     bp,8             { bp = X * SIN(yang) + Z * COS(yang) / 256 }
  271.     mov     [Zt],bp
  272.  
  273.     mov     ax,[Xt]          { Switch values }
  274.     mov     [X],ax
  275.     mov     ax,[Zt]
  276.     mov     [Z],ax
  277.  
  278. { Rotate around z-axis }
  279. { XT = X * COS(zang) - Y * SIN(zang) / 256 }
  280. { YT = X * SIN(zang) + Y * COS(zang) / 256 }
  281. { X = XT }
  282. { Y = YT }
  283.  
  284.     mov     ax,[X]
  285.     mov     bx,[ZCos]
  286.     imul    bx               { ax = X * Cos(zang) }
  287.     mov     bp,ax
  288.     mov     ax,[Y]
  289.     mov     bx,[ZSin]
  290.     imul    bx               { ax = Y * Sin(zang) }
  291.     sub     bp,ax            { bp = X * Cos(zang) - Y * Sin(zang) }
  292.     sar     bp,8             { bp = X * Cos(zang) - Y * Sin(zang) / 256 }
  293.     mov     [Xt],bp
  294.  
  295.     mov     ax,[X]
  296.     mov     bx,[ZSin]
  297.     imul    bx               { ax = X * Sin(zang) }
  298.     mov     bp,ax
  299.     mov     ax,[Y]
  300.     mov     bx,[ZCos]
  301.     imul    bx               { ax = Y * Cos(zang) }
  302.     add     bp,ax            { bp = X * SIN(zang) + Y * COS(zang) }
  303.     sar     bp,8             { bp = X * SIN(zang) + Y * COS(zang) / 256 }
  304.     mov     [Yt],bp
  305.  
  306.     mov     ax,[Xt]          { Switch values }
  307.     mov     [X],ax
  308.     mov     ax,[Yt]
  309.     mov     [Y],ax
  310.     popa
  311. End;
  312.  
  313. Procedure SortPolygons;                           { Sort polys on Z }
  314. Var Loop1, Position, Temp: Integer;
  315. Begin
  316.   For Loop1 := 1 to MaxPolys Do Order[Loop1] := Loop1;  { Reset order }
  317.   Position := 1;
  318.   While Position < MaxPolys Do                    { Sort all polygons }
  319.   Begin
  320.     If AverageZ[Position] < AverageZ[Position+1] then
  321.     Begin
  322.       Temp := AverageZ[Position];                 { Swap Z values }
  323.       AverageZ[Position] := AverageZ[Position+1];
  324.       AverageZ[Position+1] := Temp;
  325.       Temp := Order[Position];                    { Swap polygon draw order }
  326.       Order[Position] := Order[Position+1];
  327.       Order[Position+1] := Temp;
  328.       Position := 0;                              { Reset counter }
  329.     End;
  330.     Position := Position + 1;                     { Compare next 2 values }
  331.   End;
  332. End;
  333.  
  334. Procedure RotateAllStuff(Obj: PolyObject; Where: Word; Mx,My: Integer);
  335. Var Loop1,Loop2,Temp,Nr,
  336.     X1,Y1,X2,Y2,X3,Y3,X4,Y4: Integer; { 4 points of polygon }
  337. Begin
  338.  
  339.   For Loop1 := 1 to MaxPolys Do       { Rotate the polygons }
  340.   Begin
  341.     For Loop2 := 1 to 4 Do            { All 4 3d-points of polygon }
  342.     Begin
  343.       GetOrgXYZ(Obj,Loop1,Loop2);     { Get the original x,y,z values }
  344.       RotatePoint;                    { Rotate the point around x,y,z }
  345.       Points[Loop1,Loop2,1] := X;     { Save new x,y,z }
  346.       Points[Loop1,Loop2,2] := Y;
  347.       Points[Loop1,Loop2,3] := Z;
  348.     End;
  349.     AverageZ[Loop1] := Points[Loop1,1,3]+Points[Loop1,2,3]+Points[Loop1,3,3]+Points[Loop1,4,3];
  350.   End;
  351.  
  352.   SortPolygons;                       { Sort the polygons on z values }
  353.  
  354.   For Loop1 := 1 to MaxPolys Do       { Draw the polygons }
  355.   Begin
  356.     Nr := Order[Loop1];               { # of polygon to draw }
  357.     Temp := Points[Nr,1,3]-Zoff;
  358.     X1 := ((Points[Nr,1,1] shl 8) div Temp) + Mx;
  359.     Y1 := ((Points[Nr,1,2] shl 8) div Temp) + My;
  360.     Temp := Points[Nr,2,3]-Zoff;
  361.     X2 := ((Points[Nr,2,1] shl 8) div Temp) + Mx;
  362.     Y2 := ((Points[Nr,2,2] shl 8) div Temp) + My;
  363.     Temp := Points[Nr,3,3]-Zoff;
  364.     X3 := ((Points[Nr,3,1] shl 8) div Temp) + Mx;
  365.     Y3 := ((Points[Nr,3,2] shl 8) div Temp) + My;
  366.     Temp := Points[Nr,4,3]-Zoff;
  367.     X4 := ((Points[Nr,4,1] shl 8) div Temp) + Mx;
  368.     Y4 := ((Points[Nr,4,2] shl 8) div Temp) + My;
  369.     Draw_Polygon(X1,Y1,X2,Y2,X3,Y3,X4,Y4,Nr+20,Where);
  370.   End;
  371.  
  372. End;
  373.  
  374. (* ============================= MAIN PROGRAM ============================= *)
  375.  
  376. Begin
  377.   Randomize;
  378.   SetupVirtual;             { Setup memory for virtual screen }
  379.   CalculateSine;
  380.   Xangle := Random(255);    { Set initial degrees }
  381.   Yangle := Random(255);
  382.   Zangle := Random(255);
  383.   Zoff := -500;             { Distance from viewer }
  384.   VideoMode($13);
  385.  
  386.   Repeat
  387.     UpdateRotation(3,1,2);  { Set new angles and fetch (co)sine data }
  388.     ClearScreen(0,Vaddr);   { Clear virtual page (slow method) }
  389.     RotateAllStuff(Box,Vaddr,160,100);     { Do all good stuff }
  390.     WaitRetrace;            { Wait for a vertical retrace }
  391.     FlipPage(Vaddr,VGA);    { And let's show the stuff on screen }
  392.     If Keypressed then Key := Ord(Readkey);   { Catch a keypress }
  393.   Until Key = 27;           { Quit on escape }
  394.  
  395.   ShutDown;                 { Free memory }
  396.   VideoMode($3);            { Warp back to textmode }
  397.   Writeln('▄  ▄▄  ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄  ▄▄  ▄');
  398.   Writeln('                    - An Outlaw Triad Production (c) 1996 -');
  399.   Writeln;
  400.   Writeln('                             Code∙∙∙∙∙∙∙∙∙∙Vulture');
  401.   Writeln;
  402.   Writeln('                            -=≡ Outlaw Triad Is ≡=-');
  403.   Writeln;
  404.   Writeln('  Vulture/code ■ Archangle/artist ■ Troop/sysop ■ Xplorer/artist ■ Inopia/code');
  405.   Writeln;
  406.   Writeln('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');
  407. End.
  408.