home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / vectmorf / vectmorf.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-08-01  |  5.3 KB  |  117 lines
  1. {///////////////////////////////////////////////////////////////////////////}
  2. { Ca y est...  je  me suis  décidé  à mettre  le source de VECTMORPH dans le
  3.   domaine public!  A mon point  de vue,  c'est  un petit programme assez peu
  4.   important, mais c'est a priori c'est susceptible d'intéresser quelques uns
  5.   d'entre vous.  Ceux-ci  sont  évidemment  curieux  de savoir  comment "ça"
  6.   marche! Voilà!, sachez donc tirer profit  de ce petit cadeau  et évitez de
  7.   faire partie du club très large des LAMERS en "pompant" bêtement.
  8.  
  9.   Pour  de  plus  amples  informations,  d'éventuelles suggestions,  ou tout
  10.   simplement pour le fun, vous pouvez m'écrire à l'adresse suivante:
  11.  
  12.                                Patrick Ruelle
  13.                          43, av. de Grande Bretagne
  14.                                 98000 Monaco
  15.                             Principauté de Monaco
  16.  
  17.   Evidemment  je n'ai pas pris  la décision  de diffuser  ce source  dans le
  18.   but de demander de l'argent,  mais il va de soit que toutes sortes de dons
  19.   sont acceptés (carte  postale,  matos,  argent, spécialités locales, docs,
  20.   etc...).  N'oubliez pas non plus que cette diffusion ne m'enlève nullement
  21.   mes  droits d'auteur  de cette mmm... de démo;  ce petit package peut être
  22.   diffusé librement à condition de rester sous sa forme initiale:
  23.  
  24.  VECTMORF.EXE  01/08/94   5344 L'exécutable...
  25.  VECTMORF.PAS  01/08/94   5406 Le source principal de la démo
  26.  VECTK   .PAS  01/08/94   5531 Le source du mini noyau pour la démo
  27.                         ------
  28.                TOTAL     16281
  29.  
  30.   La version  actuelle  est remaniée exprès pour la diffusion de ce package,
  31.   mais en fait ce programme date de fin 1993...
  32.  
  33.                                           Patrick Ruelle (Monac) / GRYPHAEA }
  34. {///////////////////////////////////////////////////////////////////////////}
  35. PROGRAM VectMorph;
  36.  
  37. USES VECTK;
  38.  
  39. CONST
  40.   figure:ARRAY[1..6,1..84] OF INTEGER=(
  41.          (150,27,169,27,150,27,150,42,169,27,169,42,132,43,187,43,
  42.           132,43,101,55,187,43,218,55,101,55,80,76,218,55,239,76,
  43.           96,60,223,60,85,71,234,71,80,76,67,103,239,76,252,103,
  44.           67,103,80,130,252,103,239,130,80,130,101,151,239,130,218,151,
  45.           85,135,234,135,96,146,223,146,101,151,132,163,218,151,187,163,
  46.           132,163,187,163),
  47.          (159,23,143,39,160,23,176,39,143,39,154,39,176,39,165,39,
  48.           154,39,132,61,165,39,187,61,132,61,151,61,187,61,168,61,
  49.           151,61,117,95,168,61,202,95,117,95,125,95,202,95,194,95,
  50.           125,95,84,136,194,95,235,136,84,136,235,136,150,136,150,157,
  51.           169,136,169,157,131,157,188,157,131,157,119,169,188,157,200,169,
  52.           119,169,200,169),
  53.          (159,20,150,37,159,20,168,37,150,37,159,46,168,37,159,46,
  54.           159,38,159,50,150,50,169,50,150,50,150,150,169,50,169,150,
  55.           107,150,212,150,212,150,216,150,216,150,221,145,221,145,232,145,
  56.           232,145,237,150,114,157,216,157,237,150,237,157,107,150,126,169,
  57.           212,150,193,169,216,157,221,162,237,157,232,162,126,169,193,169,
  58.           221,162,232,162),
  59.          (187,23,212,23,187,23,191,35,212,23,208,35,191,35,191,63,
  60.           208,35,208,63,191,48,208,48,191,63,176,78,208,63,223,78,
  61.           176,78,168,94,223,78,231,94,91,92,129,92,91,92,110,131,
  62.           129,92,110,131,168,94,168,169,231,94,231,169,94,98,126,98,
  63.           168,112,231,112,110,131,110,169,168,151,231,151,92,169,128,169,
  64.           168,169,231,169),
  65.          (100,30,219,30,100,30,100,131,219,30,219,131,114,43,205,43,
  66.           114,43,114,118,205,43,205,118,114,118,205,118,193,125,205,125,
  67.           60,131,259,131,60,131,60,169,259,131,259,169,195,136,251,136,
  68.           195,136,195,147,251,136,251,147,199,141,247,141,195,147,251,147,
  69.           65,158,72,158,65,158,65,164,72,158,72,164,65,164,72,164,
  70.           60,169,259,169),
  71.          (150,27,169,27,150,27,150,42,169,27,169,42,132,43,187,43,
  72.           132,43,101,55,187,43,218,55,101,55,80,76,218,55,239,76,
  73.           96,60,223,60,85,71,234,71,80,76,67,103,239,76,252,103,
  74.           67,103,80,130,252,103,239,130,80,130,101,151,239,130,218,151,
  75.           85,135,234,135,96,146,223,146,101,151,132,163,218,151,187,163,
  76.           132,163,187,163));
  77.  
  78. VAR
  79.   MemLig:ARRAY[0..20,1..4] OF WORD;
  80.  
  81. PROCEDURE Animation;
  82. VAR
  83.   num_fig,I,J:BYTE;
  84.   x1,y1,x2,y2:INTEGER;
  85. BEGIN
  86.   YMode360x480;
  87.   YRemplitEcran(0);
  88.   num_fig:=0;
  89.   VideTamponClavier;
  90.   REPEAT
  91.     Inc(num_fig);
  92.     IF num_fig>5 THEN num_fig:=1;
  93.     FOR I:=0 TO 99 DO
  94.     BEGIN
  95.       FOR J:=0 TO 20 DO
  96.       BEGIN
  97.         x1:=20+Round(figure[num_fig,j*4+1]+I*(figure[num_fig+1,j*4+1]-figure[num_fig,j*4+1])/99);
  98.         y1:=40+2*Round(figure[num_fig,j*4+2]+I*(figure[num_fig+1,j*4+2]-figure[num_fig,j*4+2])/99);
  99.         x2:=20+Round(figure[num_fig,j*4+3]+I*(figure[num_fig+1,j*4+3]-figure[num_fig,j*4+3])/99);
  100.         y2:=40+2*Round(figure[num_fig,j*4+4]+I*(figure[num_fig+1,j*4+4]-figure[num_fig,j*4+4])/99);
  101.         MemLig[J,1]:=x1; MemLig[J,2]:=y1;
  102.         MemLig[J,3]:=x2; MemLig[J,4]:=y2;
  103.         YLigne(x1,y1,x2,y2,15);
  104.       END;
  105.       YAttenteSynchro;
  106.       IF ((I=99) OR (I=0)) THEN PauseSynchro(140);
  107.       IF I<>99 THEN
  108.         FOR J:=0 TO 20 DO
  109.           YLigne(MemLig[J,1],MemLig[J,2],MemLig[J,3],MemLig[J,4],0);
  110.     END;
  111.   UNTIL ToucheAppuyee;
  112.   YModeTexte;
  113. END;
  114.  
  115. BEGIN
  116.   Animation;
  117. END.