home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / plasma / plasma.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-03  |  8.8 KB  |  373 lines
  1. {///////////////////////////////////////////////////////////////////////////}
  2. { Ca y est...  je  me suis  décidé  à  mettre  le  source  de PLASMA 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!  Le  player  AdLib  9 voix (2  pour  le morceau  ici  présent) est
  7.   NonaLiza;  pour  comprendre  son  utilisation,  le système  d'écriture  de
  8.   morceaux, doc, etc... se reporter au SBAL_Kit chez DP Tool par exemple, ou
  9.   alors  m'envoyer 50F  et vous aurez  alors toutes les infos nécessaires et
  10.   les divers programmes utilitaires (tous les sources sont fournis). Voilà!,
  11.   sachez donc tirer profit  de ce petit cadeau  et évitez de faire partie du
  12.   club  très large  des  LAMERS  en "pompant"  bêtement le code...
  13.  
  14.   Pour  de  plus  amples  informations,  d'éventuelles suggestions,  ou tout
  15.   simplement pour le fun, vous pouvez m'écrire à l'adresse suivante:
  16.  
  17.                                Patrick Ruelle
  18.                          43, av. de Grande Bretagne
  19.                                 98000 Monaco
  20.                             Principauté de Monaco
  21.  
  22.   Evidemment  je n'ai pas pris  la décision  de diffuser  ce source  dans le
  23.   but de demander de l'argent,  mais il va de soit que toutes sortes de dons
  24.   sont acceptés (carte  postale,  matos,  argent, spécialités locales, docs,
  25.   etc...).  N'oubliez pas non plus que cette diffusion ne m'enlève nullement
  26.   mes  droits d'auteur  de cette mmm... de démo;  ce petit package peut être
  27.   diffusé librement à condition de rester sous sa forme initiale:
  28.  
  29.  PLASMA  .EXE  03/08/94  12624 L'exécutable de la démo
  30.  PLASMA  .PAS  03/08/94   8994 Le source de la démo
  31.  NONALIZA.PAS  11/04/94  13108 Le player AdLib au format FM9
  32.  PLASMA01.PAL  03/03/93    768 La palette du fire plasma
  33.  PLASMA02.PAL  03/03/93    768  "    "     " wave plasma
  34.  PLASMA  .FM9  18/05/94   3036 La musique 2 voix FM (de J.S.Bach)
  35.                         ------
  36.                TOTAL     39298
  37.  
  38.   La version  actuelle  est remaniée exprès pour la diffusion de ce package,
  39.   mais en fait ce programme date de début 1993...
  40.  
  41.                                           Patrick Ruelle (Monac) / GRYPHAEA }
  42. {///////////////////////////////////////////////////////////////////////////}
  43. {$M 16000,0,100000}
  44. {$A-,B-,D-,E-,F+,G+,I-,L-,N-,O-,R-,S-,V-,X-}
  45. PROGRAM PLASMA;
  46.  
  47. USES NONALIZA,Crt;
  48.  
  49. CONST
  50.       ys  : BYTE    =   0;
  51.       yt  : BYTE    = 255;
  52.       exactitude    = 100;
  53.       vitesse       =   1;
  54.       precision     = 1.0-(exactitude/100);
  55.       VerticalAmpli =  70;
  56.       HorizAmpli    =  90;
  57.       MaxHoriz      = 400;
  58.       periode       = 320;
  59.  
  60.  
  61. TYPE
  62.       wavetype      = ARRAY[0..(1+periode*3)] OF ShortInt;
  63.       HorizType     = ARRAY[0..MaxHoriz] OF Integer;
  64.  
  65.  
  66. VAR
  67.       ft                     :ARRAY [0..512] OF BYTE;
  68.       sint                   :ARRAY [0..256] OF BYTE;
  69.       i1,a,b,d,c,od,color,e,y:BYTE;
  70.       x,k,i                  :WORD;
  71.       tabl_pal               :ARRAY[0..767] OF BYTE;
  72.       sav_adder              :Integer;
  73.       refwave                :wavetype;
  74.       NbImg                  :Integer;
  75.       Horiz                  :horiztype;
  76.       compteur               :Integer;
  77.       di_addr                :Integer;
  78.       aux                    :Integer;
  79.       decal_factor           :Integer;
  80.       decal_horiz1           :WORD;
  81.       decal_horiz2           :Integer;
  82.       touche                 :CHAR;
  83.  
  84.  
  85. PROCEDURE Active_Palette(VAR pal);ASSEMBLER;
  86. ASM
  87.   push  ds
  88.   lds   si, pal
  89.   mov   dx, $3c8
  90.   cld
  91.   mov   cx, 256
  92.   mov   bx, 0
  93.  @@1:
  94.   mov   al, bl
  95.   out   dx, al
  96.   inc   dx
  97.   lodsb
  98.   out   dx, al
  99.   lodsb
  100.   out   dx, al
  101.   lodsb
  102.   out   dx, al
  103.   dec   dx
  104.   inc   bl
  105.   loop  @@1
  106.   pop   ds
  107. END;
  108.  
  109.  
  110. PROCEDURE MakeScreen(VAR onde:ShortInt;adder:Integer;VAR decal:HorizType);ASSEMBLER;
  111. ASM
  112.   push  bp
  113.   mov   ax, adder
  114.   sub   ax, 2
  115.   mov   sav_adder, ax
  116.   lds   si, onde
  117.   mov   ax, 0A000h
  118.   mov   es, ax
  119.   mov   compteur, 160
  120.   mov   bx, decal_factor
  121.   mov   ax, 320
  122.   mul   bx
  123.   neg   ax
  124.   mov   di_addr, ax
  125.   mov   dx, 0101h
  126.   mov   ax, word ptr decal
  127.   sal   bx, 1
  128.   add   ax, bx
  129.   mov   aux, ax
  130.   mov   ah, [si]
  131.   mov   al, ah
  132.  @@1:
  133.   mov   bp, sav_adder
  134.   lodsw
  135.   add   ax, [ds:si+bp]
  136.   mov   bp, aux
  137.   mov   di, di_addr
  138.   add   di_addr, 2
  139.   mov   cx, 100
  140.  @@2:
  141.   mov   bx, ds:[bp]
  142.   add   bp, 2
  143.   mov   es:[di+bx], ax
  144.   add   ax, dx
  145.   loop  @@2
  146.   dec   compteur
  147.   jnz   @@1
  148.   pop   bp
  149. END;
  150.  
  151.  
  152. PROCEDURE MakeRefWave;
  153. BEGIN
  154.   FOR i:=0 TO 1+periode*3 DO
  155.     refwave[i]:=ShortInt(Round(VerticalAmpli*(Sin(i*6.283185/periode))));
  156. END;
  157.  
  158.  
  159. FUNCTION Arrondi(a:Real):Integer;
  160. BEGIN
  161.   IF ABS(2*Round(a/2)-a)<precision THEN
  162.     Arrondi:=2*Round(a/2)
  163.   ELSE
  164.     Arrondi:=Round(a);
  165. END;
  166.  
  167.  
  168. PROCEDURE MakeHorizWave;
  169. BEGIN
  170.   FOR i:=0 TO MaxHoriz DO
  171.     Horiz[i]:=i*320+Arrondi((HorizAmpli*(0.5+0.5*Sin(i*0.0314159))));
  172. END;
  173.  
  174.  
  175. PROCEDURE ChargePalette(nomfic:STRING);
  176. VAR  couleur:FILE;
  177. BEGIN
  178.   {$I-}
  179.   Assign(couleur,nomfic);
  180.   Reset(couleur,1);
  181.   BlockRead(couleur,tabl_pal,768);
  182.   Close(couleur);
  183.   {$I+}
  184.   IF IOResult<>0 THEN
  185.   BEGIN
  186.     TextMode(CO80);
  187.     WriteLn('erreur concernant le fichier ',nomfic);
  188.     Halt;
  189.   END;
  190. END;
  191.  
  192.  
  193. PROCEDURE CalculeTables;
  194. VAR  i:WORD;
  195. BEGIN
  196.   FOR i:=0 TO 512 DO
  197.     ft[i]:=Round(64+63*Sin(i/81.48));
  198.   FOR i:=0 TO 256 DO
  199.     sint[i]:=Round(128+20*Sin(i/10.18));
  200. END;
  201.  
  202.  
  203. PROCEDURE Initialisations;
  204. BEGIN
  205.   MakeRefWave;
  206.   MakeHorizWave;
  207.   CalculeTables;
  208.   WriteLn('Fire Plasma & Wave Plasma...');
  209.   WriteLn('Appuyer sur une touche pour alterner la séquence (ESC=Quitter)');
  210.   Delay(3000);
  211.   ASM
  212.     mov   al, ys
  213.     mov   y, al
  214.     mov   ax, 0013h
  215.     int   10h
  216.     mov   dx, 3d4h
  217.     mov   al, 9
  218.     out   dx, al
  219.     inc   dx
  220.     in    al, dx
  221.     and   al, 0e0h    {et oui! on est en 320x100 et en 256 couleurs...}
  222.     add   al, 3       {c'est moins gourmant en calculs que le 320x200!}
  223.     out   dx, al
  224.   END;
  225. END;
  226.  
  227.  
  228. PROCEDURE Plasma_Feu;
  229. BEGIN
  230.   ChargePalette('PLASMA01.PAL');
  231.   FillChar(MEM[$A000:$0],32000,0);
  232.   Active_Palette(tabl_pal);
  233.   ASM
  234.    @3:
  235.     inc   i1
  236.     sub   c, 2
  237.     inc   od
  238.     mov   al, od
  239.     mov   d, al
  240.     mov   al, ys
  241.     mov   ah, yt
  242.     xchg  al, ah
  243.     mov   ys, al
  244.     mov   ah, yt
  245.     mov   y, al
  246.    @2:
  247.     mov   al, y
  248.     mov   bx, 320
  249.     mul   bx
  250.     mov   bx, ax
  251.     mov   al, y
  252.     xor   ah, ah
  253.     and   al, 1
  254.     add   ax, bx
  255.     mov   k, ax
  256.     mov   al, i1
  257.     xor   ah, ah
  258.     and   al, 1
  259.     xor   ah, ah
  260.     mov   bx, 320
  261.     mul   bx
  262.     mov   bx, k
  263.     sub   bx, ax
  264.     mov   k, bx
  265.     mov   al, d
  266.     inc   al
  267.     inc   al
  268.     mov   d, al
  269.     mov   al, c
  270.     add   al, y
  271.     and   ax, 255
  272.     mov   di, offset sint
  273.     add   di, ax
  274.     mov   al, ds:[di]
  275.     mov   a, al
  276.     mov   di, offset sint
  277.     mov   al, d
  278.     and   al, 255
  279.     add   di, ax
  280.     mov   al, ds:[di]
  281.     mov   b, al
  282.     xor   ax, ax
  283.     xor   bx, bx
  284.     xor   cx, cx
  285.    @1:
  286.     mov   di, offset ft
  287.     mov   al, a
  288.     add   al, b
  289.     add   di, ax
  290.     mov   al, ds:[di]
  291.     mov   bx, ax
  292.     inc   bx
  293.     mov   di, offset ft
  294.     mov   al, y
  295.     add   al, b
  296.     add   di, ax
  297.     mov   ax, ds:[di]
  298.     add   ax, bx
  299.     mov   color, al
  300.     mov   bx, 0a000h
  301.     mov   es, bx
  302.     mov   di, k
  303.     mov   es:[di], al
  304.     mov   al, b
  305.     inc   al
  306.     inc   al
  307.     mov   b, al
  308.     mov   ax, k
  309.     inc   ax
  310.     inc   ax
  311.     mov   k, ax
  312.     xor   ah, ah
  313.     mov   al, color
  314.     shr   al, 7
  315.     inc   al
  316.     xor   ah, ah
  317.     mov   bl, al
  318.     mov   al, a
  319.     add   al, bl
  320.     mov   a, al
  321.     inc   cx
  322.     cmp   cx, 160
  323.     jnz   @1
  324.     inc   y
  325.     cmp   y, 101
  326.     jnz   @2
  327.     mov   ah, 01h
  328.     int   16h
  329.     jz    @3
  330.   END;
  331.   touche:=ReadKey;
  332. END;
  333.  
  334.  
  335. PROCEDURE Plasma_Vague;
  336. BEGIN
  337.   IF touche<>#27 THEN
  338.   BEGIN
  339.     ChargePalette('PLASMA02.PAL');
  340.     decal_factor:=0;
  341.     decal_horiz1:=0;
  342.     decal_horiz2:=0;
  343.     FillChar(MEM[$A000:$0],32000,0);
  344.     Active_Palette(tabl_pal);
  345.     MemW[$40:$1A]:=MemW[$40:$1C];
  346.     REPEAT
  347.       Inc(decal_horiz1,-1*vitesse);
  348.       WHILE decal_horiz1 > periode DO
  349.         inc(decal_horiz1,periode);
  350.       inc(decal_horiz2,1*vitesse);
  351.       WHILE decal_horiz2 > periode DO
  352.         dec(decal_horiz2,periode);
  353.       inc(decal_factor,1*vitesse);
  354.       WHILE decal_factor > 199 DO
  355.         decal_factor:=decal_factor-200;
  356.       makescreen(refwave[decal_horiz1],decal_horiz2,Horiz);
  357.     UNTIL KeyPressed;
  358.     touche:=ReadKey;
  359.   END;
  360. END;
  361.  
  362.  
  363. BEGIN
  364.   IF Load_Music('PLASMA.FM9')=0 THEN;
  365.   Initialisations;
  366.   Start_Music;
  367.   REPEAT
  368.     Plasma_Feu;
  369.     Plasma_Vague;
  370.   UNTIL touche=#27;
  371.   Stop_Music;
  372.   TextMode(CO80);
  373. END.