home *** CD-ROM | disk | FTP | other *** search
/ Collection of Hack-Phreak Scene Programs / cleanhpvac.zip / cleanhpvac / OTMORPH.ZIP / morphing.pas < prev   
Pascal/Delphi Source File  |  1996-06-06  |  7KB  |  287 lines
  1. {
  2.    Rotation and morphing around 360 degrees. Integer math. As you can
  3.    see, the dots all reach their destination at the same time. Thanks
  4.    to Ryu/D+P+S for object generating code (some small modifications
  5.    were made, though). This example needs a lot of optimizing. Don't
  6.    steal code, use this to learn. Bye,
  7.  
  8.           - Vulture / Outlaw Triad -
  9. }
  10.  
  11. Program Rotation3d;                   { Rotation & morphing 360 degrees }
  12.  
  13. Uses Crt;
  14.  
  15. Const VGA = $0a000;
  16.       MaxPoints = 100;
  17.  
  18. Var Sine: Array[0..359] of Integer;   { Sine values for 360 degrees }
  19.     X,Y,Z: Integer;                   { All integer math }
  20.     Xt,Yt,Zt: Integer;
  21.     Xsin,Xcos,
  22.     Ysin,Ycos,
  23.     Zsin,Zcos: Integer;
  24.     Xangle,Yangle,Zangle: Integer;
  25.     Loop1,Zoff: Integer;
  26.     ScreenX, ScreenY: Integer;
  27.     RealObj: Array[1..MaxPoints,1..3] of Integer;
  28.     TempObj: Array[1..MaxPoints,1..3] of Integer;
  29.     MorphData: Array[1..MaxPoints,1..3] of Integer;
  30.     OldXY: Array[1..MaxPoints,1..2] of Integer;
  31.     Key: Char;
  32.  
  33. Procedure VideoMode(Mode: Byte); Assembler;
  34. Asm
  35.   xor  ah,ah
  36.   mov  al,Mode
  37.   int  10h
  38. End;
  39.  
  40. Procedure Putpixel(X,Y:Word; Color:byte; Where:Word); Assembler;
  41. Asm
  42.   mov ax,Where
  43.   mov es,ax
  44.   mov di,X
  45.   mov ax,Y
  46.   shl ax,6
  47.   add di,ax
  48.   shl ax,2
  49.   add di,ax
  50.   mov al,Color
  51.   mov byte ptr es:[di],al
  52. End;
  53.  
  54. Procedure WaitRetrace; Assembler;     { Waits for vertical retrace }
  55. label l1, l2;
  56. Asm
  57.    mov  dx,3dah
  58. l1:
  59.    in   al,dx
  60.    and  al,08h
  61.    jnz  l1
  62. l2:
  63.    in   al,dx
  64.    and  al,08h
  65.    jz   l2
  66. End;
  67.  
  68. Procedure CalcSine;                   { Guess what this does... ;-) }
  69. Var I,Out: Integer;
  70.     An: Real;
  71. Begin
  72.   For I := 0 to 359 Do                { 360 values }
  73.   Begin
  74.     An := I*(2*pi / 360);
  75.     Out := Round(Sin(An)*256);
  76.     Sine[I] := Out;                   { Save into array }
  77.   End;
  78. End;
  79.  
  80. Procedure CreateRandom;               { Creates a random object }
  81. Var Loop1: Integer;
  82. Begin
  83.   For Loop1 := 1 to MaxPoints Do
  84.   Begin
  85.     RealObj[Loop1,1] := (Random(50)-25) shl 6;
  86.     RealObj[Loop1,2] := (Random(60)-40) shl 6;
  87.     RealObj[Loop1,3] := (Random(50)-25) shl 6;
  88.   End;
  89. End;
  90.  
  91. Procedure CreateRandom2;              { Creates a random object }
  92. Var Loop1: Integer;
  93. Begin
  94.   For Loop1 := 1 to MaxPoints Do
  95.   Begin
  96.     TempObj[Loop1,1] := (Random(50)-25) shl 6;
  97.     TempObj[Loop1,2] := (Random(60)-40) shl 6;
  98.     TempObj[Loop1,3] := (Random(50)-25) shl 6;
  99.   End;
  100. End;
  101.  
  102. Procedure CreateBox;
  103. Var a1,a2,a3,Loop1: Integer;
  104. Begin
  105.   a1:=-30;
  106.   a2:=-30;
  107.   a3:=-30;
  108.   For Loop1 := 1 to MaxPoints do
  109.   Begin
  110.     TempObj[Loop1,1] := a1 shl 6;
  111.     TempObj[Loop1,2] := a2 shl 6;
  112.     TempObj[Loop1,3] := a3 shl 6;
  113.     Inc(a1,10);
  114.     If a1=20 then
  115.     Begin
  116.      a1:=-30;
  117.      Inc(a2,10);
  118.     End;
  119.  
  120.     If a2=20 then
  121.     Begin
  122.       a2:=-30;
  123.       Inc(a3,10);
  124.     End;
  125.   End;
  126. End;
  127.  
  128. Procedure CreateBall;
  129. Var a2: Real;
  130.     Loop1: Integer;
  131. Begin
  132.   a2 := 1;
  133.   for Loop1 := 1 to MaxPoints do
  134.   Begin
  135.     TempObj[Loop1,1] := (Sine[Round(a2) mod 360]*50 div 256) shl 6;
  136.     TempObj[Loop1,2] := (Sine[Round(a2+90) mod 360]*50 div 256) shl 6;
  137.     TempObj[Loop1,3] := 0;
  138.     a2 := a2 + 3.6;
  139.   End;
  140. End;
  141.  
  142. Procedure CreateCyl;
  143. Var a2:real;
  144.     Loop1,a1: Integer;
  145. Begin
  146.   a1 := -50;
  147.   a2 := 0;
  148.   For Loop1 := 1 to MaxPoints do
  149.   Begin
  150.     TempObj[Loop1,1] := (Sine[round(a2) mod 360]*20 div 256) shl 6;
  151.     TempObj[Loop1,2] := (Sine[round(a2+90) mod 360]*20 div 256) shl 6;
  152.     TempObj[Loop1,3] := a1 shl 6;
  153.     If (Loop1 mod 10)=0 then
  154.     Begin
  155.       a2:=0;
  156.       inc(a1,10);
  157.     End;
  158.    a2:=a2+360/10;
  159.   End;
  160. End;
  161.  
  162. Procedure DoAngles(DeltaX,DeltaY,DeltaZ: Integer); { Increase rotation angles }
  163. Begin
  164.   Xangle := (Xangle+DeltaX) mod 360;
  165.   Yangle := (Yangle+DeltaY) mod 360;
  166.   Zangle := (Zangle+DeltaZ) mod 360;
  167. End;
  168.  
  169. Procedure GetSinCos;                  { Gets sine & cosine of angles }
  170. Begin
  171.   Xsin := Sine[Xangle];
  172.   Xcos := Sine[(Xangle+90) mod 360];  { Add 90 to get cosine value }
  173.   Ysin := Sine[Yangle];
  174.   Ycos := Sine[(Yangle+90) mod 360];
  175.   Zsin := Sine[Zangle];
  176.   Zcos := Sine[(Zangle+90) mod 360];
  177. End;
  178.  
  179. Procedure RotateXYZ(Current: Integer);
  180. Begin
  181. { Get original x,y,z values }
  182.   X := RealObj[Current,1] div 64;
  183.   Y := RealObj[Current,2] div 64;
  184.   Z := RealObj[Current,3] div 64;
  185.  
  186. { Rotate around x-axis }
  187.   YT := (Y * Xcos - Z * Xsin) div 256;
  188.   ZT := (Y * Xsin + Z * Xcos) div 256;
  189.   Y := Yt;
  190.   Z := Zt;
  191.  
  192. { Rotate around y-axis }
  193.   XT := (X * Ycos - Z * Ysin) div 256;
  194.   ZT := (X * Ysin + Z * Ycos) div 256;
  195.   X := Xt;
  196.   Z := Zt;
  197.  
  198. { Rotate around z-axis }
  199.   XT := (X * Zcos - Y * Zsin) div 256;
  200.   YT := (X * Zsin + Y * Zcos) div 256;
  201.   X := Xt;
  202.   Y := Yt;
  203. End;
  204.  
  205. Procedure CalcVgaPos;                 { Calculate vga position }
  206. Begin
  207.   ScreenX := (X shl 8) div (Z+Zoff)+160;
  208.   ScreenY := (Y shl 8) div (Z+Zoff)+100;
  209. End;
  210.  
  211. Procedure DoAllPoints;
  212. Var Loop1: Integer;
  213. Begin
  214.   If KeyPressed then Exit;
  215.   DoAngles(2,2,0);                    { Update rotation angles }
  216.   GetSinCos;
  217.   For Loop1 := 1 to MaxPoints Do
  218.   Begin
  219.     RotateXYZ(Loop1);                 { Rotate point }
  220.     CalcVgaPos;                       { Calculate screenposition }
  221.     OldXY[Loop1,1] := ScreenX;        { Store vga x,y }
  222.     OldXY[Loop1,2] := ScreenY;
  223.     PutPixel(OldXY[Loop1,1], OldXY[Loop1,2], 34, VGA);
  224.   End;
  225.   WaitRetrace;
  226.   For Loop1 := 1 to MaxPoints Do
  227.      PutPixel(OldXY[Loop1,1], OldXY[Loop1,2], 0, VGA);
  228. End;
  229.  
  230. Procedure RealMorph;
  231. Var Loop1, Loop2: Integer;
  232. Begin
  233.   For Loop1 := 1 to MaxPoints Do
  234.   Begin
  235.     MorphData[Loop1,1] := (RealObj[Loop1,1] - TempObj[Loop1,1]) div 64;
  236.     MorphData[Loop1,2] := (RealObj[Loop1,2] - TempObj[Loop1,2]) div 64;
  237.     MorphData[Loop1,3] := (RealObj[Loop1,3] - TempObj[Loop1,3]) div 64;
  238.   End;
  239.   For Loop1 := 1 to 64 Do
  240.   Begin
  241.     For Loop2 := 1 to MaxPoints Do
  242.     Begin
  243.       Dec(RealObj[Loop2,1],MorphData[Loop2,1]);
  244.       Dec(RealObj[Loop2,2],MorphData[Loop2,2]);
  245.       Dec(RealObj[Loop2,3],MorphData[Loop2,3]);
  246.     End;
  247.     DoAllPoints;
  248.  End;
  249. End;
  250.  
  251. Begin
  252.   RandoMize;
  253.   CalcSine;                           { Create sine chart }
  254.   Xangle := 0;                        { Starting angles }
  255.   Yangle := 0;
  256.   Zangle := 0;
  257.   Zoff := 250;                        { Distance from viewer }
  258.   Loop1 := 1;
  259.   CreateRandom;
  260.   VideoMode($13);
  261.   Repeat
  262.     For Loop1 := 1 to 150 Do DoAllPoints;
  263.     CreateBox;
  264.     RealMorph;
  265.     For Loop1 := 1 to 150 Do DoAllPoints;
  266.     CreateCyl;
  267.     RealMorph;
  268.     For Loop1 := 1 to 150 Do DoAllPoints;
  269.     CreateBall;
  270.     RealMorph;
  271.     For Loop1 := 1 to 150 Do DoAllPoints;
  272.     CreateRandom2;
  273.     RealMorph;
  274.   Until KeyPressed;
  275.   VideoMode($3);
  276.   Writeln('▄  ▄▄  ▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄  ▄▄  ▄');
  277.   Writeln;
  278.   Writeln('                    - An Outlaw Triad Production (c) 1996 -');
  279.   Writeln;
  280.   Writeln('                             Code∙∙∙∙∙∙∙∙∙∙Vulture');
  281.   Writeln;
  282.   Writeln('                            -=≡ Outlaw Triad Is ≡=-');
  283.   Writeln;
  284.   Writeln(' Vulture(code) ■ Dazl(artist) ■ Troop(sysop) ■ Xplorer(artist) ■ Inopia(coder)');
  285.   Writeln;
  286.   Writeln('▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄▄');
  287. End.