home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 17 / CD_ASCQ_17_101194.iso / dos / prg / demosrce / headache / headache.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1994-08-01  |  16.8 KB  |  616 lines
  1. {///////////////////////////////////////////////////////////////////////////}
  2. { Ca y est...  je  me suis  décidé  à mettre  le source  de HEADACHE 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! En fait, c'est relativement simple (une fois  que l'on a visualisé
  7.   le fichier PCX), sauf peut-être en ce qui concerne  la partie graphique en
  8.   BASM.  J'ai fait un effort violent  en réécrivant  les routines SB pour le
  9.   DMA  entièrement  en TP (à l'origine c'est en BASM et pour toute ligne IRQ
  10.   et canal DMA,  et avec  une réelle détection automatique du port). 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  et en changeant les
  13.   textes des messages...
  14.  
  15.   ATTENTION!  le numéro de téléphone  dans la démo  n'est plus valable!!!...
  16.   Pour  de  plus  amples  informations,  d'éventuelles suggestions,  ou tout
  17.   simplement pour le fun, vous pouvez m'écrire à l'adresse suivante:
  18.  
  19.                                Patrick Ruelle
  20.                          43, av. de Grande Bretagne
  21.                                 98000 Monaco
  22.                             Principauté de Monaco
  23.  
  24.   Evidemment  je n'ai pas pris  la décision  de diffuser  ce source  dans le
  25.   but de demander de l'argent,  mais il va de soit que toutes sortes de dons
  26.   sont acceptés (carte  postale,  matos,  argent, spécialités locales, docs,
  27.   etc...).  N'oubliez pas non plus que cette diffusion ne m'enlève nullement
  28.   mes  droits d'auteur  de cette mmm... de démo;  ce petit package peut être
  29.   diffusé librement à condition de rester sous sa forme initiale:
  30.  
  31.  HEADACHE.EXE  01/08/94  13264 L'exécutable utilisant HEADIMG et les HEADSEQ
  32.  HEADACHE.PAS  01/08/94  17253 Le source principal de la démo
  33.  SB_DMA  .PAS  01/08/94   9170 Le source des routines DMA pour la SB
  34.  HEADACHE.PCX  25/04/93   8471 L'image des sprites au format PCX
  35.  HEADIMG .RAW  25/07/94  64768    "     "     "    en format brut (img+pal)
  36.  HEADSEQ .1    25/07/94  20040 Le 1er pattern digital de musique
  37.  HEADSEQ .2    25/07/94  20168  " 2e     "       "     "    "
  38.  HEADSEQ .3    25/07/94  20040  " 3e     "       "     "    "
  39.  HEADSEQ .4    25/07/94  20168  " 4e     "       "     "    "
  40.  HEADSEQ .5    25/07/94  20168  " 5e     "       "     "    "
  41.  HEADSEQ .6    25/07/94  20168  " 6e     "       "     "    "
  42.  HEADSEQ .7    25/07/94  20104  " 7e     "       "     "    "
  43.                         ------
  44.                TOTAL    253782
  45.  
  46.   La version  actuelle  est remaniée exprès pour la diffusion de ce package,
  47.   mais en fait ce programme date de début 1993...
  48.  
  49.                                           Patrick Ruelle (Monac) / GRYPHAEA }
  50. {///////////////////////////////////////////////////////////////////////////}
  51. {$R-} {$V-} {$G+}
  52. {$M 8000,0,270000}
  53. PROGRAM HEADACHE; {Le programme principal de la démo avec toutes les}
  54.                   {routines graphiques nécessaires et  l'utilisation}
  55.                   {de l'unité SB_DMA pour le son digital            }
  56.  
  57. USES SB_DMA;
  58.  
  59.  
  60. CONST
  61.  Taille_Seq:ARRAY[1..7] OF WORD=(19976,20104,19976,20104,20104,20104,20040);
  62.  
  63.  Rebond    :ARRAY[1..8] OF WORD=(15,3,15,13,273,3,273,15);
  64.  
  65.  Palette2  :ARRAY[0..53] OF BYTE=
  66.             (21,21,63,21,30,63,21,39,63,21,48,63,21,57,63,21,63,57,21,63,48,
  67.              21,63,39,21,63,30,21,63,21,21,63,30,21,63,39,21,63,48,21,63,57,
  68.              21,57,63,21,48,63,21,39,63,21,30,63);
  69.  
  70.  Trace     :ARRAY[1..180] OF BYTE=
  71.             (8,6,4,3,2,1,1,1,2,3,4,6,8,9,11,13,14,15,15,15,14,13,11,9,8,6,4,
  72.              3,2,2,2,3,4,6,8,9,11,13,14,14,14,13,11,9,8,6,4,3,3,3,4,6,8,9,11,
  73.              13,13,13,11,9,8,6,5,4,4,5,6,8,9,11,12,12,11,9,8,6,5,5,6,8,9,11,
  74.              11,9,8,7,6,6,7,8,9,10,10,9,8,7,7,8,9,9,8,7,8,9,8,8,8,8,8,8,8,8,
  75.              8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
  76.              8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,8,
  77.              8,8,8,8);
  78.  
  79.  Trace2    :ARRAY[1..105] OF BYTE=
  80.             (11,13,15,17,20,23,26,29,33,37,41,37,33,30,27,25,23,22,23,25,27,
  81.              30,33,37,41,37,35,32,30,28,27,28,30,32,35,37,41,38,35,33,32,33,
  82.              35,38,41,39,37,36,37,39,41,39,38,39,41,40,41,41,41,41,41,41,41,
  83.              41,41,41,41,41,41,41,41,41,41,41,41,41,40,39,38,37,36,35,34,33,
  84.              32,31,30,29,28,27,26,25,24,23,22,21,20,19,18,17,16,15,14,13,12);
  85.  
  86.  Texte     :ARRAY[1..18] OF ARRAY[1..30] OF BYTE=
  87.             ((27,27,27,27,23,5,12,3,15,13,5,27,20,15,27,1,27,14,5,23,27,9,14,
  88.              20,18,15,27,27,27,27),(27,27,27,6,18,15,13,27,20,8,5,27,7,18,25,
  89.              16,8,1,5,1,27,7,18,15,21,16,38,27,27,27),(27,20,8,9,19,27,16,9,
  90.              5,3,5,27,15,6,27,1,18,20,27,9,19,27,3,1,12,12,5,4,27,27),(27,50,
  91.              27,50,27,50,27,8,27,5,27,1,27,4,27,1,27,3,27,8,27,5,38,27,50,27,
  92.              50,27,50,27),(27,27,20,8,5,27,13,1,9,14,27,16,1,18,20,27,15,6,
  93.              27,20,8,5,27,9,14,20,18,15,27,27),(27,9,19,27,3,15,4,5,4,27,9,
  94.              14,27,20,21,18,2,15,27,16,1,19,3,1,12,27,35,52,28,27),(27,1,14,
  95.              4,27,16,1,18,20,19,27,14,5,5,4,9,14,7,27,19,15,13,5,27,19,16,5,
  96.              5,4,27),(27,1,18,5,27,3,15,4,5,4,27,9,14,27,1,19,13,27,42,31,28,
  97.              28,27,12,9,14,5,19,43,27),(20,8,5,27,9,14,20,18,15,27,8,1,19,27,
  98.              2,5,5,14,27,20,5,19,20,5,4,27,15,14,27,1),(27,32,36,34,4,24,31,
  99.              31,27,46,27,19,31,27,19,22,7,1,27,46,27,19,2,16,18,15,27,9,9,27),
  100.              (27,27,1,14,4,27,14,15,23,27,19,15,13,5,27,7,18,5,5,20,9,14,7,
  101.              19,27,20,15,51,27,27),(27,27,27,27,27,27,40,40,27,6,21,20,21,18,
  102.              5,27,3,18,5,23,27,41,41,27,27,27,27,27,27,27),(27,27,27,27,27,
  103.              27,40,40,27,18,5,14,1,9,19,19,1,14,3,5,27,41,41,27,27,27,27,27,
  104.              27,27),(27,27,27,40,40,27,20,8,5,27,2,18,1,9,14,27,19,12,1,25,5,
  105.              18,19,27,41,41,27,27,27,27),(27,27,27,27,27,27,27,40,40,27,21,
  106.              12,20,18,1,6,15,18,3,5,27,41,41,27,27,27,27,27,27,27),(27,1,14,
  107.              4,27,1,12,19,15,27,20,15,27,1,12,12,27,20,8,5,27,15,20,8,5,18,
  108.              19,38,38,27),(15,21,18,27,16,8,15,14,5,51,27,42,31,31,47,29,43,
  109.              27,32,31,47,35,28,47,35,29,47,29,35,27),(27,27,27,27,27,27,27,
  110.              27,50,27,18,5,19,20,1,18,20,9,14,7,27,50,27,27,27,27,27,27,27,
  111.              27));
  112.  
  113.  Texte2    :ARRAY[1..245] OF BYTE=
  114.             (224,224,224,224,224,224,224,224,224,224,184,187,180,180,177,224,
  115.             185,171,167,173,223,223,223,210,210,210,224,224,224,224,224,224,
  116.             224,224,224,224,167,187,172,224,191,178,177,172,184,187,174,224,
  117.             185,174,167,176,184,191,187,191,224,183,178,172,174,177,210,210,
  118.             210,224,224,224,224,224,224,224,224,224,224,183,172,217,173,224,
  119.             189,191,180,180,187,188,224,196,196,224,184,187,191,188,191,189,
  120.             184,187,224,194,194,224,224,224,224,224,224,224,224,224,224,189,
  121.             177,188,187,224,218,224,185,186,168,224,218,224,179,171,173,183,
  122.             189,224,190,167,224,179,177,178,191,189,210,210,210,224,224,224,
  123.             224,224,224,224,224,224,224,172,177,224,189,177,178,172,191,189,
  124.             172,224,171,173,224,216,186,174,191,178,189,187,215,198,224,216,
  125.             205,205,211,207,215,224,204,205,211,201,208,211,201,207,211,207,
  126.             201,210,210,210,224,224,224,224,224,224,224,224,224,224,173,187,
  127.             187,224,167,177,171,224,173,177,177,178,224,186,177,174,224,191,
  128.             224,178,187,169,224,173,172,171,186,186,223,223,223,224,190,167,
  129.             187,210,210,210,224);
  130.  
  131.  Taille_Txt2 =   245;
  132.  Taille_Car  =     8;
  133.  Nbre_Cars   =   256;
  134.  Seg_Police  =$0F000;
  135.  Ofs_Police  =$0FA6E;
  136.  Seg_VGA     =$0A000;
  137.  Pos_ScrollY =   115;
  138.  Rayon       =    20;
  139.  Parties     =    45;
  140.  Inc_Angle   = 2*Pi/Parties;
  141.  Espacement  =     4;
  142.  Nbre_CoordsX= 320 DIV Espacement;
  143.  
  144.  
  145. TYPE
  146.  UnCar=ARRAY[1..Taille_Car] OF BYTE;
  147.  Imptr=^img;
  148.  img  =ARRAY[0..64767] Of BYTE;
  149.  
  150.  
  151. VAR
  152.  Chaine        :STRING;
  153.  CheminEcran   :ARRAY[1..8*80] OF WORD;
  154.  LigneCour,
  155.  TabPosCour    :Integer;
  156.  CarsEcrits    :ARRAY[1..Taille_Txt2*64] OF BYTE;
  157.  Police        :ARRAY[1..Nbre_Cars] OF UnCar;
  158.  Secoue        :BOOLEAN;
  159.  i,j,k         :WORD;
  160.  Incr          :Real;
  161.  txt,cptxt,k1  :BYTE;
  162.  Fic           :FILE;
  163.  img1          :imptr;
  164.  palette       :ARRAY[0..767] OF BYTE;
  165.  res           :BYTE;
  166.  Blaster,
  167.  ToucheAppuyee :BOOLEAN;
  168.  Int9Vec       :LongInt;
  169.  Tmp           :Pointer;
  170.  
  171.  
  172. PROCEDURE ModeVideo(Mode:BYTE);ASSEMBLER;
  173. ASM
  174.   mov   AH, 0
  175.   mov   AL, Mode
  176.   int   10h
  177.   mov   AH, 15
  178.   int   10h
  179.   mov   res, al
  180. END;
  181.  
  182.  
  183. PROCEDURE ActivePalette(VAR Pal; Deb,Nbre:WORD);
  184. BEGIN
  185. ASM
  186.   push  ds
  187.   lds   si, Pal
  188.   mov   dx, $3c8
  189.   cld
  190.   mov   cx, Nbre
  191.   mov   bx, Deb
  192.  @@1:
  193.   mov   al, bl
  194.   out   dx, al
  195.   inc   dx
  196.   lodsb
  197.   out   dx, al
  198.   lodsb
  199.   out   dx, al
  200.   lodsb
  201.   out   dx, al
  202.   dec   dx
  203.   inc   bl
  204.   loop  @@1
  205.   pop   ds
  206. END;
  207. END;
  208.  
  209.  
  210. PROCEDURE SynchroVert;ASSEMBLER;
  211. ASM
  212.   mov   dx, 03DAh
  213.  @deb1:
  214.   in    al, dx
  215.   test  al, 08
  216.   jne   @deb1
  217.  @deb2:
  218.   in    al, dx
  219.   test  al, 08
  220.   je    @deb2
  221. END;
  222.  
  223.  
  224. PROCEDURE SpriteEcran(x1,y1,larg:WORD;haut:BYTE;x2,y2,Orig:Word);ASSEMBLER;
  225. ASM
  226.   push  ds
  227.   mov   ds, Orig
  228.   mov   ax, 0A000h
  229.   mov   es, ax
  230.   mov   bx, x1
  231.   mov   ax, y1
  232.   xchg  ah, al
  233.   add   bx, ax
  234.   shr   ax, 2
  235.   add   bx, ax
  236.   mov   si, bx
  237.   mov   bx, x2
  238.   mov   ax, y2
  239.   xchg  ah, al
  240.   add   bx, ax
  241.   shr   ax, 2
  242.   add   bx, ax
  243.   mov   di, bx
  244.   xor   dl, dl
  245.   mov   dh, haut
  246.   mov   ax, larg
  247.   mov   bx, 320
  248.   sub   bx, ax
  249.   shr   ax, 1
  250.   cld
  251.  @boucle:
  252.   inc   dl
  253.   mov   cx, ax
  254.   rep   movsw
  255.   add   si, bx
  256.   add   di, bx
  257.   cmp   dl, dh
  258.   jne   @boucle
  259.   pop   ds
  260. END;
  261.  
  262.  
  263. PROCEDURE SpriteGeneral(x1,y1,larg:WORD;haut:BYTE;x2,y2,Orig,Dest:WORD);ASSEMBLER;
  264. ASM
  265.   push  ds
  266.   mov   ds, Orig
  267.   mov   es, Dest
  268.   mov   bx, x1
  269.   mov   ax, y1
  270.   xchg  ah, al
  271.   add   bx, ax
  272.   shr   ax, 2
  273.   add   bx, ax
  274.   mov   si, bx
  275.   mov   bx, x2
  276.   mov   ax, y2
  277.   xchg  ah, al
  278.   add   bx, ax
  279.   shr   ax, 2
  280.   add   bx, ax
  281.   mov   di, bx
  282.   xor   dl, dl
  283.   mov   dh, haut
  284.   mov   ax, larg
  285.   mov   bx, 320
  286.   sub   bx, ax
  287.   shr   ax, 1
  288.   cld
  289.  @boucle:
  290.   inc   dl
  291.   mov   cx, ax
  292.   rep   movsw
  293.   add   si, bx
  294.   add   di, bx
  295.   cmp   dl, dh
  296.   jne   @boucle
  297.   pop   ds
  298. END;
  299.  
  300.  
  301. PROCEDURE TexteSinus;
  302. LABEL Attente,Boucle1,Boucle2,Continue1,Continue2,
  303.       Continue3,Continue4,Continue5;
  304. BEGIN
  305. ASM
  306.   mov   ax, Seg_VGA
  307.   mov   es, ax
  308.   mov   di, (Pos_ScrollY-Rayon)*320
  309.   mov   cx, 320*Rayon+320
  310.   mov   dx, 3DAh
  311.  Attente:
  312.   in    al, dx
  313.   test  al, 08h
  314.   jz    Attente
  315.   xor   ax, ax
  316.   rep   stosw
  317.   mov   bx, LigneCour
  318.   mov   cl, 3
  319.   shl   bx, cl
  320.   mov   dx, bx
  321.   mov   ax, Nbre_CoordsX
  322.  Boucle1:
  323.   mov   cx, 8
  324.  Boucle2:
  325.   cmp   Byte Ptr CarsEcrits[bx], 0
  326.   je    Continue2
  327.   push  bx
  328.   sub   bx, dx
  329.   shl   bx, 1
  330.   mov   di, Word Ptr CheminEcran[bx]
  331.   mov   Byte Ptr es:[di], 243
  332.   mov   Byte Ptr es:[di+1], 245
  333.   mov   Byte Ptr es:[di+320], 245
  334.   mov   Byte Ptr es:[di+321], 243
  335.   pop   bx
  336.  Continue2:
  337.   inc   bx
  338.   cmp   bx, (Taille_Txt2-1)*64
  339.   jng   Continue3
  340.   xor   bx, bx
  341.   xor   dx, dx
  342.  Continue3:
  343.   loop  Boucle2
  344.   dec   ax
  345.   jnz   Boucle1
  346.   inc   LigneCour
  347.   cmp   LigneCour, (Taille_Txt2-1)*8
  348.   jng   Continue4
  349.   mov   LigneCour, 0
  350.  Continue4:
  351.   inc   TabPosCour
  352.   cmp   TabPosCour, 245
  353.   jng   Continue5
  354.   mov   TabPosCour, 0
  355.  Continue5:
  356. END;
  357. END;
  358.  
  359.  
  360. PROCEDURE ChangeInt9(I9Seg,I9Ofs:WORD);
  361. BEGIN
  362. ASM
  363.   push  ds
  364.   mov   ah, 35h
  365.   mov   al, 09h
  366.   int   21h
  367.   mov   Word Ptr Int9Vec, bx
  368.   mov   Word Ptr Int9Vec[2], es
  369.   mov   ax, I9Seg
  370.   mov   ds, ax
  371.   mov   dx, I9Ofs
  372.   mov   ah, 25h
  373.   mov   al, 09h
  374.   int   21h
  375.   pop   ds
  376. END;
  377. END;
  378.  
  379.  
  380. PROCEDURE RestaureInt9;
  381. BEGIN
  382. ASM
  383.   push  ds
  384.   mov   dx, Word Ptr Int9Vec
  385.   mov   ax, Word Ptr Int9Vec[2]
  386.   mov   ds, ax
  387.   mov   ah, 25h
  388.   mov   al, 09h
  389.   int   21h
  390.   pop   ds
  391. END;
  392. END;
  393.  
  394.  
  395. PROCEDURE NouveauInt9;INTERRUPT;
  396. BEGIN
  397. ASM
  398.   pushf
  399.   call  Int9Vec
  400.   inc   ToucheAppuyee
  401. END;
  402. END;
  403.  
  404.  
  405. PROCEDURE Abandon(chaine:STRING; ok:BYTE);
  406. BEGIN
  407.   IF OK=1 THEN
  408.    Close(Fic);
  409.   ModeVideo(3);
  410.   WriteLn(chaine);
  411.   Halt;
  412. END;
  413.  
  414.  
  415. PROCEDURE RecuperePolice;
  416. VAR CptrNum,
  417.     CptrByte,
  418.     CptrMem  :Integer;
  419. BEGIN
  420.   CptrMem:=0;
  421.   FOR CptrNum:=1 TO Nbre_Cars DO
  422.     FOR CptrByte:=1 TO Taille_Car DO
  423.     BEGIN
  424.       Police[CptrNum][CptrByte]:=Mem[Seg_Police:Ofs_Police+CptrMem];
  425.       Inc(CptrMem);
  426.     END;
  427. END;
  428.  
  429.  
  430. PROCEDURE ConstruitTrace;
  431. VAR CptrY,
  432.     CptrX,
  433.     PtrTab   :Integer;
  434.     AngleCour:Real;
  435. BEGIN
  436.   AngleCour:=Pi;
  437.   PtrTab   :=1;
  438.   FOR CptrX:=1 TO Nbre_CoordsX DO
  439.   BEGIN
  440.     FOR CptrY:=1 TO 8 DO
  441.     BEGIN
  442.       CheminEcran[PtrTab]:=(Pos_ScrollY+Round(Rayon*sin(AngleCour)))*320
  443.                            +(CptrX-1)*Espacement+1;
  444.       AngleCour:=AngleCour+Inc_Angle;
  445.       Inc(PtrTab);
  446.     END;
  447.     AngleCour:=AngleCour-7*Inc_Angle;
  448.   END;
  449. END;
  450.  
  451.  
  452. PROCEDURE ConstruitTableau;
  453. VAR YSCptr,XSCptr,
  454.     Cptr,PtrTab   :Integer;
  455.     ByteTemp      :BYTE;
  456. BEGIN
  457.   PtrTab:=1;
  458.   FOR Cptr:=1 TO Taille_Txt2 DO
  459.   BEGIN
  460.     ByteTemp:=256-Texte2[Cptr];
  461.     FOR XSCptr:=1 TO 8 DO
  462.       FOR YSCptr:=1 TO 8 DO
  463.       BEGIN
  464.         IF Mem[Seg_Police:Ofs_Police+ByteTemp*8+YSCptr-1] AND
  465.            ($80 SHR (XSCptr-1))=0
  466.         THEN CarsEcrits[PtrTab]:=0
  467.         ELSE CarsEcrits[PtrTab]:=1;
  468.         Inc(PtrTab);
  469.       END;
  470.   END;
  471. END;
  472.  
  473.  
  474. PROCEDURE Initialisations;
  475. BEGIN
  476.   ModeVideo($13);
  477.   IF res<>$13 THEN
  478.     Abandon('Wrong video type, VGA needed!',1);
  479.   Blaster   :=True;
  480.   RecuperePolice;
  481.   ConstruitTableau;
  482.   ConstruitTrace;
  483.   LigneCour :=0;
  484.   TabPosCour:=0;
  485.   Assign(Fic,'HEADIMG.RAW');
  486.   {$I-}
  487.   Reset(Fic,1);
  488.   {$I+}
  489.   IF ((IOResult<>0) OR (FileSize(fic)<>64768)) THEN
  490.     Abandon('HEADIMG.RAW is missing or corrupted!',0);
  491.   {$I-}
  492.   New(img1);
  493.   {$I+}
  494.   IF IOResult<>0 THEN
  495.     Abandon('Not enough memory!',1);
  496.   BlockRead(Fic,img1^,64768);
  497.   Close(Fic);
  498.   i:=1;
  499.   {$I-}
  500.   REPEAT
  501.     Str(i,Chaine);
  502.     Assign(Fic,'HEADSEQ.'+Chaine);
  503.     Reset(Fic,1);
  504.     GetMem(s[i],Taille_Seq[i]);
  505.     WHILE ((Seg(s[i]^) SHL 4 +Ofs(s[i]^))>44500) DO {Les  séquences  sonores}
  506.     BEGIN                                           {ne   doivent   pas   se}
  507.       FreeMem(s[i],Taille_Seq[i]);                  {chevaucher  sur +sieurs}
  508.       GetMem(tmp,1);                                {segments! Le DMA n'aime}
  509.       GetMem(s[i],Taille_Seq[i]);                   {pas vraiment ça...     }
  510.     END;
  511.     BlockRead(Fic,s[i]^,Taille_Seq[i]);
  512.     Close(Fic);
  513.     Inc(i);
  514.   UNTIL ((i>7) OR (IOResult<>0));
  515.   {$I+}
  516.   IF IOResult<>0 THEN Blaster:=False;
  517.   {Affichage du titre}
  518.   FOR i:=0 TO 767 DO
  519.     palette[i]:=0;
  520.   ActivePalette(palette[0],0,255);
  521.   SpriteEcran(0,2,196,46,62,15,Seg(img1^)+Ofs(img1^));
  522.   SpriteEcran(204,21,40,13,269,33,Seg(img1^)+Ofs(img1^));
  523.   Move(img1^[64000],palette[0],768);
  524.   ActivePalette(palette[0],0,255);
  525. END;
  526.  
  527.  
  528. PROCEDURE ApparitionBarres;
  529. BEGIN
  530.   FOR i:=199 DOWNTO 193 DO
  531.   BEGIN
  532.     SynchroVert;
  533.     SpriteEcran(0,176,320,200-i,0,i,Seg(img1^)+Ofs(img1^));
  534.   END;
  535.   i:=192;
  536.   WHILE i>=86 DO
  537.   BEGIN
  538.     SynchroVert;
  539.     SpriteEcran(0,176,320,10,0,i,Seg(img1^)+Ofs(img1^));
  540.     Dec(i,2);
  541.   END;
  542.   FOR i:=199 DOWNTO 193 DO
  543.   BEGIN
  544.     SynchroVert;
  545.     SpriteEcran(0,186,320,200-i,0,i,Seg(img1^)+Ofs(img1^));
  546.   END;
  547.   i:=192;
  548.   WHILE i>=137 DO
  549.   BEGIN
  550.     SynchroVert;
  551.     SpriteEcran(0,186,320,10,0,i,Seg(img1^)+Ofs(img1^));
  552.     Dec(i,2);
  553.   END;
  554. END;
  555.  
  556.  
  557. PROCEDURE AnimEtSon;
  558. BEGIN
  559.   i     :=0;
  560.   j     :=0;
  561.   k1    :=0;
  562.   txt   :=1;
  563.   cptxt :=0;
  564.   secoue:=False;
  565.   REPEAT
  566.     Inc(i);
  567.   UNTIL ((InitDSP(i)=True) OR (i>6));
  568.   IF i>6 THEN Blaster:=False;
  569.   i:=0;
  570.   ChangeInt9(Seg(NouveauInt9),Ofs(NouveauInt9));
  571.   IF Blaster THEN InitPlayBack(s[1],19976,11000);
  572.   ToucheAppuyee:=False;
  573.   REPEAT
  574.     TexteSinus;
  575.     Inc(k1);
  576.     IF k1>105 THEN k1:=1;
  577.     SpriteEcran(208,3,32,13,15,trace2[k1]+10,Seg(img1^)+Ofs(img1^));
  578.     Inc(i);
  579.     IF secoue=True THEN Inc(j);
  580.     IF i=18 THEN i:=0;
  581.     IF ((j=173) AND (secoue=True)) THEN
  582.     BEGIN
  583.       Inc(txt);
  584.       IF txt>18 THEN txt:=1;
  585.       cptxt:=0;
  586.       secoue:=False;
  587.       j:=0;
  588.     END;
  589.     k:=i*3;
  590.     IF secoue=True THEN
  591.     BEGIN
  592.       FOR k:=1 TO 8 DO
  593.         SpriteEcran(51,59+k,230,1,37+trace[k+j-1],169+k,Seg(img1^)+Ofs(img1^));
  594.     END
  595.     ELSE
  596.     BEGIN
  597.       Inc(cptxt);
  598.       IF cptxt>30 THEN secoue:=True
  599.       ELSE SpriteGeneral((texte[txt,cptxt]-1)*6,51,6,8,54+cptxt*7,60,
  600.                           Seg(img1^)+Ofs(img1^),Seg(img1^)+Ofs(img1^));
  601.     END;
  602.   UNTIL ToucheAppuyee;
  603.   IF Blaster THEN FinPlayBack;
  604.   Dispose(img1);
  605.   ModeVideo($3);
  606.   RestaureInt9;
  607.   WriteLn('Thanks for running Headache from GRYPHAEA!');
  608. END;
  609.  
  610.  
  611. BEGIN
  612.   Initialisations;
  613.   ApparitionBarres;
  614.   AnimEtSon;
  615. END.
  616.