home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 18 / CD_ASCQ_18_111294_W.iso / dos / prg / pas / gfxfx / rot2.pas < prev    next >
Pascal/Delphi Source File  |  1994-04-21  |  5KB  |  166 lines
  1.  
  2. program _Rotation;
  3. { Quite buggy source of Rotating Starfield, by Bas van Gaalen, Holland, PD }
  4. uses
  5.   crt,dos;
  6.  
  7. const
  8.   gseg : word = $a000;
  9.   NofPoints = 100;                                       { Number of 'stars' }
  10.   Speed = 2;                                              { Speed of 'stars' }
  11.   Xc : word = 0;                                           { Center: X, Y, Z }
  12.   Yc : word = 0;
  13.   Zc : word = 250;
  14.   SinTab : array[0..255] of integer = (
  15.     0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,
  16.     71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,
  17.     113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,
  18.     128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,
  19.     121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,
  20.     91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,
  21.     28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,
  22.     -37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,
  23.     -84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,
  24.     -113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,
  25.     -126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,
  26.     -127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,
  27.     -114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,
  28.     -88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,
  29.     -46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);
  30.  
  31. type
  32.   PointRec = record
  33.                X,Y,Z : integer;
  34.              end;
  35.   PointPos = array[0..NofPoints] of PointRec;
  36.  
  37. var
  38.   Point : PointPos;
  39.  
  40. {----------------------------------------------------------------------------}
  41.  
  42. procedure SetGraphics(Mode : word); assembler; asm
  43.   mov ax,Mode; int 10h end;
  44.  
  45. {----------------------------------------------------------------------------}
  46.  
  47. function Sinus(Idx : byte) : integer; begin
  48.   Sinus := SinTab[Idx]; end;
  49.  
  50. {----------------------------------------------------------------------------}
  51.  
  52. function Cosin(Idx : byte) : integer; begin
  53.   Cosin := SinTab[(Idx+192) mod 255]; end;
  54.  
  55. {----------------------------------------------------------------------------}
  56.  
  57. procedure Init;
  58.  
  59. var
  60.   I : word;
  61.  
  62. begin
  63.   randomize;
  64.   for I := 0 to NofPoints do begin
  65.     Point[I].X := random(250)-125;
  66.     Point[I].Y := random(250)-125;
  67.     Point[I].Z := random(250)-125;
  68.   end;
  69.   for I := 0 to 63 do begin
  70.     port[$3C8] := I;
  71.     port[$3C9] := 0;
  72.     port[$3C9] := I;
  73.     port[$3C9] := I;
  74.   end;
  75. end;
  76.  
  77. {----------------------------------------------------------------------------}
  78.  
  79. procedure DoRotation;
  80.  
  81. const
  82.   Xstep = 1;                                        { Rotation 'round x-axes }
  83.   Ystep = 1;
  84.   Zstep = 1;
  85.  
  86. var
  87.   Xp,Yp : array[0..NofPoints] of word;
  88.   X,Y,Z,X1,Y1,Z1 : integer;
  89.   I : word;
  90.   Color,PhiX,PhiY,PhiZ : byte;
  91.  
  92. begin
  93.   PhiX := 0; PhiY := 0; PhiZ := 0;                            { Begin values }
  94.   asm mov es,gseg end;
  95.   repeat
  96.     while (port[$3da] and 8) <> 8 do;
  97.     while (port[$3da] and 8) = 8 do;
  98.     for I := 0 to NofPoints do begin
  99.  
  100.       asm
  101.         mov si,i                  { get index }
  102.         shl si,1                  { x2 for word-size }
  103.         mov ax,word ptr yp[si]    { get indexed-value from yp }
  104.         cmp ax,200                { check if value greater than 200 }
  105.         jae @skip                 { if so, then jump out }
  106.         mov bx,word ptr xp[si]    { get indexed-value from xp }
  107.         cmp bx,320                { check if value greater than 320 }
  108.         jae @skip                 { if so, then jump out }
  109.         shl ax,6                  { multiply with 64 }
  110.         mov di,ax                 { keep in di }
  111.         shl ax,2                  { multiply with 4 }
  112.         add di,ax                 { add with di (64+(4*64)=320) }
  113.         add di,bx                 { add horizontal value }
  114.         xor al,al                 { al zero (black color) }
  115.         mov [es:di],al            { move to screen }
  116.        @skip:
  117.       end;
  118.  
  119.       X1 := (Cosin(PhiY)*Point[I].X-Sinus(PhiY)*Point[I].Z) div 128;
  120.       Y1 := (Cosin(PhiZ)*Point[I].Y-Sinus(PhiZ)*X1) div 128;
  121.       Z1 := (Cosin(PhiY)*Point[I].Z+Sinus(PhiY)*Point[I].X) div 128;
  122.       X  := (Cosin(PhiZ)*X1+Sinus(PhiZ)*Point[I].Y) div 128;
  123.       Y  := (Cosin(PhiX)*y1+Sinus(PhiX)*z1) div 128;
  124.       Z  := (Cosin(PhiX)*Z1-Sinus(PhiX)*Y1) div 128;
  125.  
  126.       Xp[I] := 160+(Xc*Z-X*Zc) div (Z-Zc);
  127.       Yp[I] := 100+(Yc*Z-Y*Zc) div (Z-Zc);
  128.  
  129.       asm
  130.         mov si,i
  131.         shl si,1
  132.         mov ax,word ptr yp[si]
  133.         cmp ax,200
  134.         jae @skip
  135.         mov bx,word ptr xp[si]
  136.         cmp bx,320
  137.         jae @skip
  138.         shl ax,6
  139.         mov di,ax
  140.         shl ax,2
  141.         add di,ax
  142.         add di,bx
  143.         mov ax,z                  { get z (depth) value }
  144.         shr ax,3                  { divide by 8 (range/8=32) }
  145.         add ax,30                 { add 30, ax is now in range 0 -> 64 }
  146.         mov [es:di],al
  147.        @skip:
  148.       end;
  149.  
  150.       inc(Point[I].Z,Speed); if Point[I].Z > 125 then Point[I].Z := -125;
  151.     end;
  152.     inc(PhiX,Xstep);
  153.     inc(PhiY,Ystep);
  154.     inc(PhiZ,Zstep);
  155.   until keypressed;
  156. end;
  157.  
  158. {----------------------------------------------------------------------------}
  159.  
  160. begin
  161.   SetGraphics($13);
  162.   Init;
  163.   DoRotation;
  164.   textmode(lastmode);
  165. end.
  166.