home *** CD-ROM | disk | FTP | other *** search
/ PCMania 64 / PCMania CD64_1.iso / phy / phy004 / 3d / source / tunguska.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1996-01-03  |  13.1 KB  |  430 lines
  1. {$M 65520,0,655360}                                                                               {
  2.  
  3. Vulkanus demo......  "My computer, My hero, My God, My life"
  4.  
  5. PROJECTE: EUSKAL PARTY : " TUNGUSKA " By Skynet & Runner                         }
  6.  
  7. Program TUNGUSKA;
  8.  
  9. Uses Crt,Grflib,PasDVT;   {Carregue la graph i el Vangelis Tracker}
  10.  
  11. Const Tecta=0.017453292519943295769;  {Operacions predisenyades}
  12.       COST =0.999847695156391239157;
  13.       SINT =0.017452406437283512819;
  14.  
  15.       MAXVERTEX=1000;
  16.       MAXFACES=2000;
  17.  
  18. Type TresD=Record
  19.              X,Y,Z :extended;
  20.            End;
  21.      Graf =Record
  22.              A,B,C:Integer;
  23.            End;
  24.  
  25. Var Cad,Arxiu:String;
  26.     ASC:Text;
  27.     Vertex,Poligons:String[4];
  28.     Ver,Pol,code,i:Integer;
  29.     VArray:Array [0..MAXVERTEX] of TresD;
  30.     VPolig:Array [0..MAXFACES] of Graf;
  31.     PV,p:Byte;
  32.  
  33. { Procediments de Rotacio 3D--------------------------------------------- }
  34.  
  35. Procedure Rotx(var Dades:Array of TresD);
  36.    Var i : integer;
  37.    Begin
  38.      for i := 0 to MAXVERTEX do
  39.        begin
  40.          dades[i].y := dades[i].y * COST + dades[i].z * SINT;
  41.          dades[i].z :=-dades[i].y * SINT + dades[i].z * COST;
  42.        end;
  43.    End;
  44.  
  45. Procedure Roty(var dades:Array of TresD);
  46.    Var i : integer;
  47.    Begin
  48.      For i := 0 to MAXVERTEX do
  49.        Begin
  50.          dades[i].x := dades[i].x * COST - dades[i].z * SINT;
  51.          dades[i].z := dades[i].x * SINT + dades[i].z * COST;
  52.        End;
  53.    End;
  54.  
  55. Procedure Rotz(var dades:Array of TresD);
  56.    Var i : integer;
  57.    Begin
  58.       For i := 0 to MAXVERTEX do
  59.         Begin
  60.            dades[i].x := dades[i].x * COST + dades[i].y * SINT;
  61.            dades[i].y :=-dades[i].x * SINT + dades[i].y * COST;
  62.         End;
  63.    End;
  64.  
  65. {Procediments de carrega dels poligons i dels vertex------------------------}
  66.  
  67. (* Millorar en un futur....algoritmes molt inexactes... *)
  68. Procedure Comproba_Vertex;
  69.     Begin
  70.        If vertex[2]=' ' then
  71.           vertex:='   '+cad[21];
  72.        If vertex[3]=' ' then
  73.           vertex:='  '+cad[21]+cad[22];
  74.        If vertex[4]=' ' then
  75.           vertex:=' '+cad[21]+cad[22]+cad[23];
  76.        If vertex[1]>' ' then
  77.           poligons:='  '+cad[35]+cad[36];
  78.        If Ord(Cad[0])>38 then Poligons:=Cad[36]+Cad[37]+Cad[38]+Cad[39]
  79.        else Poligons:=Cad[36]+Cad[37]+Cad[38];
  80.        If poligons[2]=' ' then
  81.           poligons:='   '+cad[36];
  82.        If poligons[3]=' ' then
  83.           poligons:='  '+cad[36]+cad[37];
  84.        If Poligons[4]=' ' then
  85.           poligons:=' '+cad[36]+cad[37]+cad[38];
  86.     End;
  87.  
  88. Procedure Load_Vertex(Ver:Integer; Var VArray:Array of TresD);
  89.    Var Cad:String;
  90.        Value:String[4];
  91.        I,J,K:Integer;
  92.        Nombre:String[15];
  93.        X:extended;
  94.      Begin
  95.        K:=0;
  96.        Cad:='                                                                                ';
  97.        Ver:=Ver-1;   {El desfase es 1 perque comensa amb 0}
  98.        Str(Ver,Value);
  99.  
  100.        While (Value<>Cad[8]+Cad[9]+Cad[10]) do
  101.           Begin
  102.             Readln(asc,Cad);
  103.             if (Cad[1]='V') and (Cad[8]<>'l') then
  104.                  Begin
  105.                    I:=1;
  106.                    While Cad[i]+Cad[i+1]<>'X:' Do
  107.                       i:=i+1;
  108.                    i:=i+3;   {Es per al espai en blanc}
  109.                    J:=1;
  110.                    Nombre:='00000000000000000';
  111.                    While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) or
  112.                          (Cad[i]='-') or (Cad[i]='.') do
  113.                           Begin
  114.                             Nombre[j]:=Cad[i];
  115.                             J:=j+1;
  116.                             i:=i+1;
  117.                           End;
  118.                    For i:=j to 15 do
  119.                       Nombre[i]:='0';
  120.                    Val(Nombre,x,code);
  121.                    if x<>0.0 then VArray[k].x:=x else VArray[k].x:=0.00001;
  122.                    While Cad[i]+Cad[i+1]<>'Y:' Do
  123.                       i:=i+1;
  124.                    i:=i+3;   {Es per al espai en blanc}
  125.                    J:=1;
  126.                    Nombre:='00000000000000000';
  127.                    While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) or
  128.                          (Cad[i]='-') or (Cad[i]='.') do
  129.                           Begin
  130.                             Nombre[j]:=Cad[i];
  131.                             J:=j+1;
  132.                             i:=i+1;
  133.                           End;
  134.                    For i:=j to 15 do
  135.                       Nombre[i]:='0';
  136.                    Val(Nombre,x,code);
  137.                     if x<>0.0 then VArray[k].y:=x else VArray[k].y:=0.00001;
  138.                    While Cad[i]+Cad[i+1]<>'Z:' Do
  139.                       i:=i+1;
  140.                    i:=i+3;   {Es per al espai en blanc}
  141.                    J:=1;
  142.                    Nombre:='00000000000000000';
  143.                    While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) or
  144.                          (Cad[i]='-') or (Cad[i]='.') do
  145.                           Begin
  146.                             Nombre[j]:=Cad[i];
  147.                             J:=j+1;
  148.                             i:=i+1;
  149.                           End;
  150.                    For i:=j to 15 do
  151.                       Nombre[i]:='0';
  152.                    Val(Nombre,x,code);
  153.                    if x<>0.0 then VArray[k].z:=x else VArray[k].z:=0.00001;
  154.                    K:=k+1;
  155.                  End;
  156.           End;
  157.  
  158.      End;
  159.  
  160. Procedure Load_Poligon(Pol:Integer; Var Vpolig:Array of Graf);
  161.    Var I,J,K:Integer;
  162.        Cad:String;
  163.        Tex:String[4];
  164.        Valor:extended;
  165.  
  166.     Begin
  167.        I:=1;
  168.        J:=1;
  169.        K:=0;
  170.        Cad:='                                                                         ';
  171.        While Cad<>'Face list:' do
  172.             Readln(ASC,Cad);
  173.        Readln(ASC,Cad);
  174.        While K<>(pol) do
  175.          Begin
  176.            If (Cad[1]='F') and (Cad[4]='e') then
  177.                Begin
  178.                  While Cad[i]+Cad[i+1]<>'A:' do
  179.                     I:=i+1;
  180.                  I:=I+2;
  181.                  tex:='                                              ';
  182.                  While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) do
  183.                      Begin
  184.                        Tex[j]:=Cad[i];
  185.                        i:=i+1;
  186.                        j:=j+1;
  187.                      End;
  188.                  If (Tex[2]=' ') and (Tex[3]=' ') and (Tex[4]=' ') then
  189.                     Begin
  190.                        Tex[4]:=Tex[1];
  191.                        Tex[3]:=' ';
  192.                        Tex[2]:=' ';
  193.                        Tex[1]:=' ';
  194.                     End;
  195.                  If (Tex[3]=' ') and (Tex[4]=' ') then
  196.                     Begin
  197.                        Tex[4]:=Tex[2];
  198.                        Tex[3]:=Tex[1];
  199.                        Tex[2]:=' ';
  200.                        Tex[1]:=' ';
  201.                     End;
  202.                  If tex[4]=' ' then
  203.                     Begin
  204.                        Tex[4]:=Tex[3];
  205.                        Tex[3]:=Tex[2];
  206.                        Tex[2]:=Tex[1];
  207.                        Tex[1]:=' ';
  208.                     End;
  209.  
  210.                  Val(Tex,Valor,Code);
  211.                  Vpolig[k].A:=round(Valor);
  212.                  I:=10;
  213.                  j:=1;
  214.                  While Cad[i]+Cad[i+1]<>'B:' do
  215.                     I:=i+1;
  216.                  I:=I+2;
  217.                  tex:='                                              ';
  218.                  While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) do
  219.                      Begin
  220.                        Tex[j]:=Cad[i];
  221.                        i:=i+1;
  222.                        j:=j+1;
  223.                      End;
  224.                  If (Tex[2]=' ') and (Tex[3]=' ') and (Tex[4]=' ') then
  225.                     Begin
  226.                        Tex[4]:=Tex[1];
  227.                        Tex[3]:=' ';
  228.                        Tex[2]:=' ';
  229.                        Tex[1]:=' ';
  230.                     End;
  231.                  If (Tex[3]=' ') and (Tex[4]=' ') then
  232.                     Begin
  233.                        Tex[4]:=Tex[2];
  234.                        Tex[3]:=Tex[1];
  235.                        Tex[2]:=' ';
  236.                        Tex[1]:=' ';
  237.                     End;
  238.                  If tex[4]=' ' then
  239.                     Begin
  240.                        Tex[4]:=Tex[3];
  241.                        Tex[3]:=Tex[2];
  242.                        Tex[2]:=Tex[1];
  243.                        Tex[1]:=' ';
  244.                     End;
  245.  
  246.                  Val(Tex,Valor,Code);
  247.                  Vpolig[k].B:=round(Valor);
  248.                  I:=15;
  249.                  j:=1;
  250.                  While Cad[i]+Cad[i+1]<>'C:' do
  251.                     I:=i+1;
  252.                  I:=I+2;
  253.                  tex:='                                              ';
  254.                  While ((Ord(Cad[i])>47) and (Ord(Cad[i])<58)) do
  255.                      Begin
  256.                        Tex[j]:=Cad[i];
  257.                        i:=i+1;
  258.                        j:=j+1;
  259.                      End;
  260.                  If (Tex[2]=' ') and (Tex[3]=' ') and (Tex[4]=' ') then
  261.                     Begin
  262.                        Tex[4]:=Tex[1];
  263.                        Tex[3]:=' ';
  264.                        Tex[2]:=' ';
  265.                        Tex[1]:=' ';
  266.                     End;
  267.                  If (Tex[3]=' ') and (Tex[4]=' ') then
  268.                     Begin
  269.                        Tex[4]:=Tex[2];
  270.                        Tex[3]:=Tex[1];
  271.                        Tex[2]:=' ';
  272.                        Tex[1]:=' ';
  273.                     End;
  274.                  If tex[4]=' ' then
  275.                     Begin
  276.                        Tex[4]:=Tex[3];
  277.                        Tex[3]:=Tex[2];
  278.                        Tex[2]:=Tex[1];
  279.                        Tex[1]:=' ';
  280.                     End;
  281.  
  282.                  Val(Tex,Valor,Code);
  283.                  Vpolig[k].C:=round(Valor);
  284.                  K:=k+1;
  285.                End;
  286.            readln(ASC,Cad);
  287.            readln(ASC,Cad);
  288.            I:=10;
  289.            J:=1;
  290.            Tex:='            ';
  291.          End;
  292.     End;
  293.  
  294. { Dibuixa tots els poligons que conte el objecte ----------------------------}
  295.  
  296.  
  297. Procedure Draw_3d(Varray:Array of TresD;Vpolig:Array of graf;
  298.                         c,pv:byte;origeX,origeY,pol:Integer);
  299.  
  300.  
  301.    Procedure lines(x1, y1, x2, y2: extended;c,pv:byte;origeX,OrigeY:integer);
  302.    Begin
  303.     fLinea(round(x1) + origeX,round(y1) + origeY,round(x2) + origeX,round(y2) + origeY,c,PV);
  304.    End;
  305.  
  306.    Var I:integer;
  307.  
  308.       Begin
  309.         For I:=0 to (pol-1) do
  310.           Begin
  311.            lines(Varray[Vpolig[I].a].X,Varray[Vpolig[I].a].y,Varray[Vpolig[i].b].X,
  312.            Varray[Vpolig[i].b].y,c,pv,origex,origey);
  313.            lines(Varray[Vpolig[I].b].X,Varray[Vpolig[I].b].y,Varray[Vpolig[i].c].X,
  314.            Varray[Vpolig[i].c].y,c,pv,origex,origey);
  315.            lines(Varray[Vpolig[I].c].X,Varray[Vpolig[I].c].y,Varray[Vpolig[i].a].X,
  316.            Varray[Vpolig[i].a].y,c,pv,origex,origey);
  317.           End
  318.       End;
  319.  
  320. Procedure Increment(Var Varray:Array of TresD;n:extended);
  321.    Var I:integer;
  322.    Begin
  323.      For I:=0 to 660 do
  324.        Begin
  325.         Varray[i].x:=(Varray[i].x/100)*n;
  326.         Varray[i].y:=(Varray[i].y/100)*n;
  327.         Varray[i].z:=(Varray[i].z/100)*n;
  328.        End;
  329.    End;
  330.  
  331. Function existeix(s:string):boolean;
  332.    Var f:file;
  333.    Begin
  334.      {$I-}
  335.      assign(f,s);
  336.      reset(f);
  337.      close(f);
  338.      {$I+}
  339.      existeix:=(IOResult=0) and (s <>'');
  340.    End;
  341.  
  342. {-------------------------------Programa Principal---------------------------}
  343.  
  344.  
  345. BEGIN
  346.  {OUTPUT-----------------------------------}
  347.  
  348.   ClrScr;
  349.   TextBackground(Blue);
  350.   Writeln('3D Vulkanus.                    PROJECTE TUNGUSKA.                  By Skynet');
  351.   TextBackground(Black);
  352.   Writeln;
  353.   Writeln;
  354.  
  355.   repeat
  356.     writeln('Introdueix el nom i extensio i la ruta del arxiu.(Q per eixir)');
  357.     readln(arxiu);
  358.     if not existeix(arxiu) then
  359.        Writeln('ERROR! El arxiu introduit no existeix.');
  360.   until existeix(arxiu) or (arxiu='q') or (arxiu='Q');
  361.   if (arxiu='q') or (arxiu='Q') then
  362.      halt(27);
  363.  
  364.  {-----------------Programa----------------}
  365.  
  366. {  IF NOT VT_Init THEN
  367.     BEGIN
  368.      WriteLn('Driver no detectat! Si continues, no obtindras musica...');
  369.      readln;
  370.     END;
  371.  
  372.   {ENTORN DEL VANGELIS TRACKER-------Llegir intruccions}
  373.  
  374. {  VT_GoTo(1, 1);
  375.   VT_Autoon;
  376.   VT_SetVolume(255);
  377.   VT_Start;
  378.   VT_SyncStart;
  379.  
  380.   {ALGORITMES ARXIUS------------------------------------}
  381.  
  382.   Assign(ASC,Arxiu);
  383.   reset(ASC);
  384.   Cad:='';
  385.   While (Cad[1]<>'T') and (Cad[6]<>'e') do
  386.     readln(asc,Cad);
  387.   Vertex  :=Cad[21]+Cad[22]+Cad[23]+Cad[24];
  388.  
  389.   COMPROBA_VERTEX;
  390.  
  391.   Val(Vertex,Ver,code);
  392.   Val(Poligons,pol,code);
  393.   Load_Vertex (Ver,VArray);
  394.   Load_Poligon(Pol,VPolig);
  395.   Close(ASC);
  396.  
  397.   {ALGORITMES GRAFICS-----------------------------------}
  398.  
  399.   ModoGrafico;
  400.   PV:=CreaVirtual;
  401.   fBorraPantalla(0,0);
  402.   fBorraPantalla(0,PV);
  403.  
  404.   Increment(Varray,40.0);
  405.  
  406.   repeat
  407.     draw_3d(VArray,Vpolig,1,pv,160,100,pol);
  408.     CopiaPantalla(PV,0);
  409.     rotx(Varray);
  410.     roty(Varray);
  411.     rotz(Varray);
  412.     increment(Varray,100.034);
  413.     fborrapantalla(0,pv);
  414.   until keypressed;
  415.  
  416.   Fadedown(20000,1,0);
  417.  
  418.   {For p:=VT_GetVolume downto 0 do
  419.     Begin
  420.      VT_Setvolume(p);
  421.      delay(3);
  422.     End;}
  423.  
  424.   ModoTexto;
  425.   VT_AutoOff;
  426.   VT_Abort;
  427.  
  428. END.
  429.  
  430.