home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 9 / CD_ASCQ_09_1193.iso / news / 557 / animate / animdemo.pas < prev    next >
Pascal/Delphi Source File  |  1993-09-03  |  15KB  |  381 lines
  1. {┌───────────────────────────────────────────────────────────────────────────┐
  2.  │ ANIMAGE: Unité pour Turbo Pascal permettant d'animer des sprites, de faire│
  3.  │          des scrolls, zooms, cyclages, splits, en VGA 256 couleurs.       │
  4.  │                                                                           │
  5.  │ Info...: Ce package est un produit shareware qui ne doit pas être modifié.│
  6.  │          Si vous en obtenez  entière satisfaction  ou si vous  l'utilisez │
  7.  │          souvent, effectuez donc votre contrat moral en envoyant un chèque│
  8.  │          de 50FF (vous recevrez une licence d'utilisation) à l'adresse:   │
  9.  │                                                                           │
  10.  │          Patrick RUELLE                                                   │
  11.  │          163 rue de Charonne                                              │
  12.  │          75011 Paris                                                      │
  13.  │          (France)                                                         │
  14.  │                                                                           │
  15.  │ CE FICHIER CONTIENT LE PROGRAMME "ANIMDEMO" UTILISANT L'UNITE "ANIMAGE".  │
  16.  └───────────────────────────────────────────────────────────────────────────┘}
  17.  
  18. {$R-,V-,A+}
  19. PROGRAM ANIMDEMO;
  20.  
  21.  USES Crt,Animage;
  22.  
  23.  CONST
  24.  
  25.    bar_couls:Array[1..4,1..27] Of Byte=
  26.    ((2,46,2,11,51,11,22,54,22,35,58,35,49,63,49,35,58,35,22,54,22,11,51,11,2,
  27.    4,6),(58,54,0,59,56,11,60,59,22,61,61,34,63,63,46,61,61,34,60,59,22,59,56,
  28.    11,58,54,0),(8,8,63,18,18,63,28,28,63,37,37,63,48,48,63,37,37,63,28,28,63,
  29.    18,18,63,8,8,63),(63,25,50,63,30,51,63,35,53,63,40,54,63,46,56,63,40,54,
  30.    63,35,53,63,30,51,63,25,50));
  31.  
  32.    pal_couls:Array[0..140] Of Byte=
  33.    (60,60,60,51,51,51,41,41,41,31,31,31,41,41,41,31,31,31,21,21,21,0,0,0,0,0,
  34.    0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,0,47,52,47,39,43,39,35,39,35,27,
  35.    31,27,23,27,23,15,19,15,11,15,11,21,63,21,16,58,16,11,54,11,7,50,7,4,46,4,
  36.    1,42,1,0,38,0,63,50,58,63,44,56,63,39,54,63,34,52,63,29,50,63,24,48,63,19,
  37.    47,63,63,21,60,59,16,58,56,12,55,52,8,53,49,5,50,45,2,48,42,0,0,0,0,0,0,0,
  38.    63,63,63);
  39.  
  40.    texte:Array[1..78] Of Word=
  41.    (16,32,152,152,32,232,24,32,96,112,232,160,152,64,88,64,144,32,232,88,0,
  42.    232,120,88,160,120,0,136,152,232,24,32,144,232,40,112,104,16,152,64,112,
  43.    104,104,0,88,64,152,32,144,232,24,32,232,88,232,160,104,64,152,32,232,0,
  44.    104,64,96,0,48,32,232,232,232,232,232,232,232,232,232,232);
  45.  
  46.    titre1:Array[1..13] Of Word=
  47.    (24,32,96,112,104,144,152,136,0,152,64,112,104);
  48.  
  49.    titre2:Array[1..7] Of Word=
  50.    (0,104,64,96,0,48,32);
  51.  
  52.    fonte:Array[0..1679] Of Byte=
  53.    (0,0,211,211,210,209,0,0,0,212,211,211,210,209,0,0,0,0,211,211,210,209,0,
  54.    0,0,212,211,211,210,209,0,0,0,0,211,211,210,209,209,0,0,0,211,211,210,209,
  55.    209,0,0,0,211,211,210,209,0,0,0,212,211,211,0,0,209,0,0,0,211,211,210,0,0,
  56.    0,0,0,0,211,210,209,0,0,0,212,211,211,0,0,209,0,0,212,211,211,0,0,0,0,0,0,
  57.    211,211,0,209,0,0,0,0,211,211,210,209,0,0,0,0,211,211,210,209,0,0,0,212,
  58.    211,211,210,209,0,0,0,0,211,211,210,209,0,0,0,212,211,211,210,209,0,0,0,0,
  59.    211,211,210,209,0,0,0,212,211,211,210,209,0,0,0,212,211,211,0,0,209,0,0,
  60.    212,211,211,0,0,209,0,0,212,0,211,0,209,209,0,0,212,211,211,0,0,209,0,0,
  61.    212,211,211,0,0,209,0,0,212,211,211,210,209,209,0,0,0,248,247,246,246,0,0,
  62.    0,0,234,233,232,232,0,0,0,0,241,240,239,239,0,0,0,0,0,0,0,0,0,0,0,212,212,
  63.    211,211,210,210,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,210,0,0,212,
  64.    212,211,0,0,210,0,0,212,212,211,0,0,0,0,0,212,212,211,0,0,0,0,0,212,212,
  65.    211,0,0,210,0,0,212,212,211,0,0,210,0,0,0,212,211,211,0,0,0,0,0,0,211,211,
  66.    210,0,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,0,0,0,212,212,211,211,
  67.    210,210,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,210,0,0,212,212,211,0,
  68.    0,210,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,210,0,0,212,212,0,0,0,
  69.    210,0,0,0,212,211,211,0,0,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,210,
  70.    0,0,212,0,211,0,210,210,0,0,212,212,211,0,0,210,0,0,212,212,211,0,0,210,0,
  71.    0,0,0,0,211,210,210,0,0,250,249,248,247,246,246,0,0,236,235,234,233,232,
  72.    232,0,0,243,242,241,240,239,239,0,0,0,0,0,0,0,0,0,0,215,0,0,211,211,210,0,
  73.    0,215,212,212,0,0,210,0,0,215,212,212,0,0,0,0,0,215,212,212,0,0,210,0,0,
  74.    215,212,212,0,0,0,0,0,215,212,212,0,0,0,0,0,215,212,212,0,0,0,0,0,215,212,
  75.    212,0,0,210,0,0,0,212,212,211,0,0,0,0,0,0,212,211,211,0,0,0,215,212,212,0,
  76.    0,210,0,0,215,212,212,0,0,0,0,0,215,212,0,211,0,210,0,0,215,212,212,0,0,
  77.    210,0,0,215,212,212,0,0,210,0,0,215,212,212,0,0,210,0,0,215,212,212,0,0,
  78.    210,0,0,215,212,212,0,0,210,0,0,215,212,212,211,0,0,0,0,0,212,212,211,0,0,
  79.    0,0,215,212,212,0,0,210,0,0,215,212,212,0,0,210,0,0,215,0,212,0,211,210,0,
  80.    0,215,212,212,0,0,210,0,0,215,212,212,0,0,210,0,0,0,0,0,211,211,0,0,251,
  81.    251,250,249,248,247,246,246,237,237,236,235,234,233,232,232,244,244,243,
  82.    242,241,240,239,239,0,0,0,0,0,0,0,0,0,215,0,0,212,211,211,0,0,215,215,212,
  83.    212,211,0,0,0,215,215,212,0,0,0,0,0,215,215,212,0,0,211,0,0,215,215,212,
  84.    212,211,0,0,0,215,215,212,212,211,0,0,0,215,215,212,0,0,0,0,0,215,215,212,
  85.    212,211,211,0,0,0,215,212,212,0,0,0,0,0,0,212,212,211,0,0,0,215,215,212,
  86.    212,211,0,0,0,215,215,212,0,0,0,0,0,215,215,0,212,0,211,0,0,215,215,212,0,
  87.    0,211,0,0,215,215,212,0,0,211,0,0,215,215,212,212,211,0,0,0,215,215,212,0,
  88.    0,211,0,0,215,215,212,212,211,0,0,0,0,215,212,212,211,0,0,0,0,215,212,212,
  89.    0,0,0,0,215,215,212,0,0,211,0,0,0,215,212,212,211,0,0,0,215,0,212,0,211,
  90.    211,0,0,0,215,212,212,211,0,0,0,0,215,212,212,211,211,0,0,0,0,212,212,0,0,
  91.    0,252,251,251,250,249,248,247,246,238,237,237,236,235,234,233,232,245,244,
  92.    244,243,242,241,240,239,0,0,0,0,0,0,0,0,0,214,215,215,212,212,211,0,0,214,
  93.    215,215,0,0,211,0,0,214,215,215,0,0,0,0,0,214,215,215,0,0,211,0,0,214,215,
  94.    215,0,0,0,0,0,214,215,215,0,0,0,0,0,214,215,215,0,212,211,0,0,214,215,215,
  95.    0,0,211,0,0,0,215,215,212,0,0,0,0,0,0,215,212,212,0,0,0,214,215,215,0,0,
  96.    211,0,0,214,215,215,0,0,0,0,0,214,215,0,212,0,211,0,0,214,215,215,0,0,211,
  97.    0,0,214,215,215,0,0,211,0,0,214,215,215,0,0,0,0,0,214,215,215,0,0,211,0,0,
  98.    214,215,215,0,0,211,0,0,0,0,215,212,212,211,0,0,0,215,215,212,0,0,0,0,214,
  99.    215,215,0,0,211,0,0,0,215,215,212,212,0,0,0,214,0,215,0,212,211,0,0,214,
  100.    215,215,0,0,211,0,0,0,0,215,212,212,0,0,0,0,215,215,0,0,0,0,252,252,251,
  101.    251,250,249,248,247,238,238,237,237,236,235,234,233,245,245,244,244,243,
  102.    242,241,240,0,0,0,0,0,0,0,0,0,214,0,0,215,212,212,0,0,214,214,215,0,0,212,
  103.    0,0,214,214,215,0,0,212,0,0,214,214,215,0,0,212,0,0,214,214,215,0,0,0,0,0,
  104.    214,214,215,0,0,0,0,0,214,214,215,0,0,212,0,0,214,214,215,0,0,212,0,0,0,
  105.    214,215,215,0,0,0,0,214,0,215,215,212,0,0,0,214,214,215,0,0,212,0,0,214,
  106.    214,215,0,0,0,0,0,214,214,0,215,0,212,0,0,214,214,215,0,0,212,0,0,214,214,
  107.    215,0,0,212,0,0,214,214,215,0,0,0,0,0,214,214,215,0,0,212,0,0,214,214,215,
  108.    0,0,212,0,0,214,0,0,0,212,212,0,0,0,214,215,215,0,0,0,0,214,214,215,0,0,
  109.    212,0,0,0,214,215,215,212,0,0,0,214,214,215,215,212,212,0,0,214,214,215,0,
  110.    0,212,0,0,0,0,215,215,212,0,0,0,214,214,215,0,0,0,0,0,252,252,251,251,250,
  111.    249,0,0,238,238,237,237,236,235,0,0,245,245,244,244,243,242,0,0,0,0,0,0,0,
  112.    0,0,0,213,0,0,215,215,212,0,0,213,214,214,215,215,0,0,0,0,214,214,215,215,
  113.    0,0,0,213,214,214,215,215,0,0,0,0,214,214,215,215,212,0,0,213,214,214,0,0,
  114.    0,0,0,0,214,214,215,215,0,0,0,213,214,214,0,0,212,0,0,0,214,214,215,0,0,0,
  115.    0,0,214,214,215,0,0,0,0,213,214,214,0,0,212,0,0,213,214,214,215,215,212,0,
  116.    0,213,214,0,215,0,212,0,0,213,214,214,0,0,212,0,0,0,214,214,215,215,0,0,0,
  117.    213,214,214,0,0,0,0,0,0,214,214,215,215,212,0,0,213,214,214,0,0,212,0,0,0,
  118.    214,214,215,215,0,0,0,0,214,214,215,0,0,0,0,0,214,214,215,215,0,0,0,0,0,
  119.    214,215,0,0,0,0,0,214,0,215,215,0,0,0,213,214,214,0,0,212,0,0,0,0,214,215,
  120.    215,0,0,0,213,214,214,215,215,212,0,0,0,252,252,251,251,0,0,0,0,238,238,
  121.    237,237,0,0,0,0,245,245,244,244,0,0,0,0,0,0,0,0,0,0);
  122.  
  123.  TYPE ecran=^image;
  124.       image=Array[0..63999] Of Byte;
  125.  
  126.  VAR  palette,
  127.       palette2   :Array[0..767] Of Byte;
  128.       trace_barre:Array[1..140] Of Integer;
  129.       posit_barre:Array[1..4]   Of Integer;
  130.       xy_balles  :Array[1..3,1..4] Of Integer;
  131.       image1,
  132.       image2     :ecran;
  133.       carac_num,
  134.       carac_seg,
  135.       cpt_balle  :Byte;
  136.       ligne,
  137.       compteur,
  138.       increment  :Word;
  139.       signe,
  140.       octet,
  141.       cpt_barre  :Integer;
  142.  
  143.  PROCEDURE Precalcul_Barre;
  144.   VAR compteur : Integer;
  145.   BEGIN
  146.     FOR compteur:=1 TO 140 DO
  147.       trace_barre[compteur]:=Round(74*Sin((2*Pi/140)*compteur))+75;
  148.     FOR compteur:=1 TO 4 DO
  149.       posit_barre[compteur]:=compteur*6;
  150.   END;
  151.  
  152.  PROCEDURE Transfert_Fonte;
  153.   BEGIN
  154.     FOR compteur:=0 TO 6 DO
  155.       Move(fonte[compteur*240],image1^[compteur*320],240);
  156.   END;
  157.  
  158.  PROCEDURE Affiche_Barre(VAR barre:Integer);
  159.   VAR compteur,
  160.       barre_prec : Integer;
  161.   BEGIN
  162.     IF posit_barre[barre]=1
  163.       THEN barre_prec:=trace_barre[140]
  164.       ELSE barre_prec:=trace_barre[posit_barre[barre]-1];
  165.     FOR Compteur:=0 TO 8 DO
  166.       Ecriture_Couleur(barre_prec+compteur,0,0,0);
  167.     FOR Compteur:=0 TO 8 DO
  168.       Ecriture_Couleur(trace_barre[posit_barre[barre]]+compteur,
  169.                        bar_couls[barre,compteur*3+1],
  170.                        bar_couls[barre,compteur*3+2],
  171.                        bar_couls[barre,compteur*3+3]);
  172.     Inc(posit_barre[Barre]);
  173.   END;
  174.  
  175.  PROCEDURE Apparition_Fading;
  176.   VAR i,j:Word;
  177.   BEGIN
  178.     FOR i:=0 TO 63 DO
  179.     BEGIN
  180.       FOR j:=0 TO 767 DO
  181.         IF palette2[j]<palette[j]
  182.           THEN Inc(palette2[j]);
  183.       Attente_Synchro;
  184.       Ecriture_Palette(palette2[0],0,128);
  185.       Attente_Synchro;
  186.       Ecriture_Palette(palette2[384],128,128);
  187.     END;
  188.   END;
  189.  
  190.  PROCEDURE Disparition_Fading;
  191.   VAR i,j:Word;
  192.   BEGIN
  193.     FOR i:=0 TO 63 DO
  194.     BEGIN
  195.       FOR j:=0 TO 767 DO
  196.         IF palette[j]>0
  197.           THEN Dec(palette[j]);
  198.       Attente_Synchro;
  199.       Ecriture_Palette(palette[0],0,128);
  200.       Attente_Synchro;
  201.       Ecriture_Palette(palette[384],128,128);
  202.     END;
  203.   END;
  204.  
  205.  PROCEDURE Initialisations_Diverses;
  206.   BEGIN
  207.     FillChar(image1^,64000,Chr(0));
  208.     FillChar(palette[0],627,Chr(0));
  209.     FillChar(palette2[0],768,Chr(0));
  210.     Move(pal_couls[0],palette[627],141);
  211.     Attente_Synchro;
  212.     Ecriture_Palette(palette2[0],0,256);
  213.     increment:=20*320;
  214.     FOR compteur:=1 TO 160 DO
  215.     BEGIN
  216.       FillChar(Mem[$A000:increment],320,Chr(compteur));
  217.       Inc(increment,320);
  218.     END;
  219.   END;
  220.  
  221.  PROCEDURE Affichage_Titre1_Et_2;
  222.   BEGIN
  223.     FOR compteur:=0 TO 12 DO
  224.       Copie_Bloc_Masque(titre1[compteur+1],0,8,7,108+compteur*8,80,
  225.                         Seg(image1^)+Ofs(image1^),$A000);
  226.     FOR compteur:=0 TO 6 DO
  227.       Copie_Bloc_Masque(titre2[compteur+1],0,8,7,132+compteur*8,100,
  228.                         Seg(image1^)+Ofs(image1^),$A000);
  229.     Move(Mem[$A000:$0],image2^,64000);
  230.   END;
  231.  
  232.  PROCEDURE Initialisation_Balles;
  233.   BEGIN
  234.     FOR compteur:=1 TO 3 DO
  235.     BEGIN
  236.       xy_balles[compteur,1]:=Random(300) DIV 2 +10;
  237.       xy_balles[compteur,2]:=Random(129) DIV 2 +32;
  238.       IF Random(2)=1
  239.         THEN xy_balles[compteur,3]:=1
  240.         ELSE xy_balles[compteur,3]:=-1;
  241.       IF Random(2)=1
  242.         THEN xy_balles[compteur,4]:=1
  243.         ELSE xy_balles[compteur,4]:=-1;
  244.     END;
  245.   END;
  246.  
  247.  PROCEDURE Scrolling_Titre;
  248.   BEGIN
  249.     octet:=0;
  250.     signe:=1;
  251.     compteur:=0;
  252.     REPEAT
  253.       Inc(compteur);
  254.       Attente_Synchro;
  255.       Defilement_Ecran(octet);
  256.       octet:=octet+signe;
  257.       IF ((octet>78) OR (octet<1))
  258.         THEN signe:=-signe;
  259.     UNTIL compteur=159;
  260.   END;
  261.  
  262.  PROCEDURE Zoom_Texte;
  263.   BEGIN
  264.     Dedoublement_Ecran(400);
  265.     FillChar(Mem[$A000:2240],61760,Chr(0));
  266.     FOR compteur:=2 TO 30 DO
  267.     BEGIN
  268.       Attente_Synchro;
  269.       Zoom_Vertical(compteur);
  270.       Delay(20);
  271.     END;
  272.     FOR compteur:=29 DOWNTO 1 DO
  273.     BEGIN
  274.       Attente_Synchro;
  275.       Zoom_Vertical(compteur);
  276.       Delay(20);
  277.     END;
  278.     FillChar(palette2[0],768,Chr(0));
  279.   END;
  280.  
  281.  PROCEDURE Traitements_Invisibles;
  282.   BEGIN
  283.     Copie_Bloc_Normal(2,190,318,7,0,190,Seg(image1^)+Ofs(image1^),
  284.                       Seg(image1^)+Ofs(image1^));
  285.     Copie_Bloc_Normal(texte[carac_num]+carac_seg*2,0,2,7,318,190,
  286.                       Seg(image1^)+Ofs(image1^),Seg(image1^)+Ofs(image1^));
  287.     FOR cpt_balle:=1 TO 3 DO
  288.       Copie_Bloc_Normal(xy_balles[cpt_balle,1]-2,xy_balles[cpt_balle,2]-2,12,
  289.                         11,xy_balles[cpt_balle,1]-2,xy_balles[cpt_balle,2]-2,
  290.                         Seg(image2^)+Ofs(image2^),Seg(image1^)+Ofs(image1^));
  291.     FOR cpt_balle:=1 TO 3 DO
  292.       Copie_Bloc_Masque(200+cpt_balle*8,0,
  293.                         8,7,xy_balles[cpt_balle,1],xy_balles[cpt_balle,2],
  294.                         Seg(image1^)+Ofs(image1^),Seg(image1^)+Ofs(image1^));
  295.   END;
  296.  
  297.  PROCEDURE Actualisation_Ecran;
  298.   BEGIN
  299.     Attente_Synchro;
  300.     Copie_Bloc_Normal(0,190,320,7,0,0,Seg(image1^)+Ofs(image1^),$A000);
  301.     FOR cpt_barre:=1 TO 4 DO
  302.     BEGIN
  303.       Affiche_Barre(cpt_barre);
  304.       IF posit_barre[cpt_barre]>140
  305.         THEN posit_barre[cpt_barre]:=1;
  306.     END;
  307.     FOR cpt_balle:=1 TO 3 DO
  308.       Copie_Bloc_Normal(xy_balles[cpt_balle,1]-2,xy_balles[cpt_balle,2]-2,
  309.                         12,11,xy_balles[cpt_balle,1]-2,xy_balles[cpt_balle,2]-2,
  310.                         Seg(image1^)+Ofs(image1^),$A000);
  311.     Dedoublement_Ecran(ligne);
  312.   END;
  313.  
  314.  PROCEDURE Calcul_Limites_Balles;
  315.   BEGIN
  316.    FOR cpt_balle:=1 TO 3 DO
  317.    BEGIN
  318.      xy_balles[cpt_balle,1]:=xy_balles[cpt_balle,1]+2*xy_balles[cpt_balle,3];
  319.      xy_balles[cpt_balle,2]:=xy_balles[cpt_balle,2]+2*xy_balles[cpt_balle,4];
  320.      IF ((xy_balles[cpt_balle,1]<3) OR (xy_balles[cpt_balle,1]>308))
  321.        THEN xy_balles[cpt_balle,3]:=-xy_balles[cpt_balle,3];
  322.      IF ((xy_balles[cpt_balle,2]<23) OR (xy_balles[cpt_balle,2]>169))
  323.        THEN xy_balles[cpt_balle,4]:=-xy_balles[cpt_balle,4];
  324.    END;
  325.   END;
  326.  
  327.  PROCEDURE Calcul_Decalage_Texte;
  328.   BEGIN
  329.     Inc(carac_seg);
  330.     IF carac_seg>3
  331.       THEN BEGIN
  332.              carac_seg:=0;
  333.              Inc(carac_num);
  334.              IF carac_num>78
  335.                THEN carac_num:=1;
  336.            END;
  337.   END;
  338.  
  339.  PROCEDURE Calcul_Decalage_Dedoublement;
  340.   BEGIN
  341.     IF ((ligne>400) OR (ligne<360))
  342.       THEN signe:=-signe;
  343.     ligne:=ligne+signe;
  344.   END;
  345.  
  346.  PROCEDURE Animation_Globale;
  347.   BEGIN
  348.     ligne    :=360;
  349.     signe    :=1;
  350.     carac_num:=1;
  351.     carac_seg:=0;
  352.     REPEAT
  353.       Traitements_Invisibles;
  354.       Actualisation_Ecran;
  355.       Calcul_Decalage_Texte;
  356.       Calcul_Decalage_Dedoublement;
  357.       Calcul_Limites_Balles;
  358.     UNTIL KeyPressed;
  359.   END;
  360.  
  361. BEGIN { ANIMDEMO }
  362.   Randomize;
  363.   IF Activation_MCGA=False
  364.     THEN WriteLn('Mode VGA non disponible!');
  365.   New(image1);
  366.   New(image2);
  367.   Initialisations_Diverses;
  368.   Precalcul_Barre;
  369.   Transfert_Fonte;
  370.   Affichage_Titre1_Et_2;
  371.   Initialisation_Balles;
  372.   Apparition_Fading;
  373.   Scrolling_Titre;
  374.   Animation_Globale;
  375.   Zoom_Texte;
  376.   Disparition_Fading;
  377.   Dispose(image1);
  378.   Dispose(image2);
  379.   Activation_Texte;
  380. END. { ANIMDEMO }
  381.