home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / spezial / 19 / wesp / wesp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1990-07-31  |  27.6 KB  |  869 lines
  1. (* ====================================================== *)
  2. (*               WESP +   Weltraumspringen                *)
  3. (*    (C) 1990 Thomas Perner, Gerald Arend & toolbox      *)
  4. (*               Compiler: Turbo Pascal ab 5.0            *)
  5. (* ====================================================== *)
  6.  
  7. PROGRAM Wesp;
  8. {$A+,B-,D-,E-,F-,I-,L-,N-,O-,R-,S-,V-}
  9. {$M 4000,0,100000}
  10.  
  11. USES
  12.   Crt, Dos, Graph;
  13.  
  14. CONST
  15.   AnzMaxRaeume = 99;
  16.   AnzLevel = 99;
  17.   LevelFileName: STRING = 'WESP.LEV';
  18.  
  19. TYPE
  20.   Str20 = STRING[20];
  21.   Str80 = STRING[80];
  22.   HiScoreTyp = RECORD                                           { High-Scores }
  23.                Name: Str20;
  24.                Punkte: WORD;
  25.              END;
  26.   GrafikTyp = (EGAScr, CGAScr, HERCScr);
  27.   FlaechenTyp = RECORD                                    { Parameter Flächen }
  28.                   Rahmen, Flaeche,
  29.                   FillType: ARRAY[1..4] OF BYTE;
  30.                 END;
  31.   DatenRec = RECORD                                         { Daten für Level }
  32.                Zeile: ARRAY[1..8] OF BYTE;
  33.                x,y  : BYTE;
  34.              END;
  35.   DatenArray = RECORD
  36.                  Kennung: STRING[10];
  37.                  Level: ARRAY[1..AnzMaxRaeume] OF DatenRec;      { Alle Level }
  38.                END;
  39.  
  40. CONST
  41.   Flaechen: ARRAY[EGAScr..HERCScr] OF FlaechenTyp =       { Parameter Flächen }
  42.    ((Rahmen: (14,5,7,15); Flaeche: (12,14,10,9); FillType: (1,1,1,1)),
  43.     (Rahmen: (1,1,2,2); Flaeche: (2,3,1,3); FillType: (1,1,1,1)),
  44.     (Rahmen: (1,1,1,1); Flaeche: (1,1,1,1); FillType: (1,1,1,1)));
  45.   Punkte: WORD = 0;
  46.   Start_Ebene: BYTE = 1;
  47.   Zeitspeicher: WORD = 0;
  48.   Schwarz = 0;                                               { Farben für CGA }
  49.   Gruen = 1;
  50.   Rot = 2;
  51.   Gelb = 3;
  52.   AnzSterne = 600;
  53.   GameOver: STRING[8] = 'GAMEOVER';
  54.  
  55. VAR
  56.   Treiber, Modus: INTEGER;
  57.   TreiberTyp: GrafikTyp;
  58.   Figur, Leer: POINTER;
  59.   FeldHintergrund: ARRAY[1..8, 1..8] OF POINTER;       { Für die Hintergründe }
  60.   AnzBilder, BildZeiger: BYTE;
  61.   BildName: ARRAY[1..50] OF STRING[12];               { Dateinamen der Bilder }
  62.   BildNr,
  63.   PCXFrequenz: BYTE;   { Alle wieviel Level soll ein PCX-Bild geladen werden? }
  64.   Ext: STRING[3];
  65.   BilderVorhanden, BildGeladen: BOOLEAN;
  66.   BildDatei: FILE OF DatenArray;
  67.   BildDaten: DatenArray;
  68.   MultX, MultY,
  69.   OffsetX, OffsetY,
  70.   OffsetFigurX, OffsetFigurY,
  71.   Figur_Spalte, Figur_Zeile,
  72.   FigBreite, FigTiefe, FigHoehe,
  73.   FBreite, FTiefe, FHoehe: INTEGER;
  74.   Anzahl_Felder, Felder_Vernichtet: BYTE;
  75.   FeldGesetzt: ARRAY[-1..10, -1..10] OF BOOLEAN;
  76.   HiScoreDatei: FILE OF HiScoreTyp;
  77.   HiScoreListe: ARRAY[0..12] OF HiScoreTyp;
  78.   Eintrag: HiScoreTyp;
  79.   Punkte_Str: STRING[5];
  80.   Ebene_Str, Zeit_Str: STRING[3];
  81.   Sterne: ARRAY[1..AnzSterne] OF PointType;
  82.   I, J, X, Y: INTEGER;
  83.   Ende: BOOLEAN;
  84.   Dummy: STRING[6];
  85.   Hilfe: str80;
  86.   Schrift, Hell, Hintergrund, Header, Taste, Ebene, Zeit,
  87.   A, TastByteAlt: BYTE;
  88.   Regs: REGISTERS;
  89.   TastByte: BYTE ABSOLUTE $0040:$0017;                 { Tastatur-Status-Byte }
  90.   ZZ: WORD;
  91.   SoundOn: BOOLEAN;
  92.  
  93. PROCEDURE MakeAstronaut(Ofx, Ofy: INTEGER;
  94.                         FX, FY, Hell, Mittel, Dunkel: BYTE);
  95. CONST
  96.   Astronaut: ARRAY[1..47] OF STRING[20] =
  97.  ('          *         ',
  98.   '         *       *  ',
  99.   '        *       *   ',
  100.   '        *      *    ',
  101.   '       *       *    ',
  102.   '       ****** *     ',
  103.   '      *------**     ',
  104.   '     *--------*     ',
  105.   '    *******---**    ',
  106.   '    *      *-***    ',
  107.   '    *      *-***    ',
  108.   '    *      *-***    ',
  109.   '    *     *---*     ',
  110.   '     *****----*     ',
  111.   '     **------*      ',
  112.   '    **************  ',
  113.   '  ***-------*-----* ',
  114.   ' *-*-------*------* ',
  115.   ' *-*-------*-***---*',
  116.   ' *-*-------**---**-*',
  117.   '*--*-------*------**',
  118.   '*--*---**-****----* ',
  119.   '****--*--*----*---* ',
  120.   '*--*-*---*----*---* ',
  121.   '*--*--*---*---*--*  ',
  122.   '*--*-*----*----**   ',
  123.   ' ****-*---*---*-*   ',
  124.   '   *****-*****--*   ',
  125.   '  *--**-*--------*  ',
  126.   '  *---*----------*  ',
  127.   '  *----*--------*   ',
  128.   '  *----*-------**   ',
  129.   '  **----**-----**   ',
  130.   '  ***--**-*****-*   ',
  131.   '   *-**--***---*    ',
  132.   '    *****-*-**--*   ',
  133.   '  *****   *******   ',
  134.   ' *.....* *.......*  ',
  135.   '*......* *.......*  ',
  136.   '*.....*  *.......*  ',
  137.   ' *****    *******   ',
  138.   '  ***       ***     ',
  139.   ' *             *    ',
  140.   ' * ***     *** *    ',
  141.   '  ****     ****     ',
  142.   '  *           *     ',
  143.   '   ***     ***      ');
  144.  
  145.   PROCEDURE Punkt(x, y: INTEGER; col: WORD);
  146.   VAR
  147.     xx, yy: INTEGER;
  148.   BEGIN
  149.     IF FX=1 THEN
  150.     BEGIN
  151.       PutPixel(OfX+x,OfY+y,col);
  152.       exit;
  153.     END;
  154.     SetFillStyle(SolidFill, col);
  155.     SetColor(col);
  156.     Bar(FX*x+OfX, FY*y+OfY, FX*x+OfX+FX-1, FY*y+OfY+FY-1);
  157.   END;
  158.  
  159. VAR
  160.   z, n: BYTE;
  161. BEGIN
  162.   FOR z:=1 to 47 DO
  163.     FOR n:=1 to 20 DO
  164.       CASE Astronaut[z,n] OF
  165.         '*': Punkt(n, z, Hell);
  166.         '.': Punkt(n, z, Dunkel);
  167.         '-': Punkt(n, z, Mittel);
  168.       END;
  169. END;
  170.  
  171. PROCEDURE Draw_Flaeche(x, y, Breite, Tiefe, Hoehe, ColRand,     { Eine Fläche }
  172.                        ColFlaeche: INTEGER; FillStyle: BYTE);   { zeichnen    }
  173. BEGIN
  174.   Inc(y, Tiefe+Hoehe);
  175.   SetColor(ColRand);
  176.   SetFillStyle(FillStyle, ColFlaeche);
  177.   Bar3D(X, Y, X+Breite, Y-Hoehe, Tiefe, TopOn);
  178.   FloodFill(X+Breite+2, Y-2, ColRand);
  179.   FloodFill(X+Breite+2, Y-Hoehe-2, ColRand);
  180.   IF Treiber=HercMono THEN                    { Schwarzer Rahmen für Hercules }
  181.   BEGIN
  182.     SetColor(Hintergrund);
  183.     Bar3D(X, Y, X+Breite, Y-Hoehe, Tiefe, TopOn);
  184.   END;
  185. END;
  186.  
  187. PROCEDURE Create_Sprites;         { Figur und "Lochmaske" als Image speichern }
  188. BEGIN
  189.   FigBreite:=GetMaxX div 40;                                     { Maße Figur }
  190.   FigHoehe:=GetMaxY div 90;
  191.   FigTiefe:=GetMaxY div 40;
  192.   SetFillStyle(SolidFill, GetMaxColor);
  193.   Bar(0, 0, FBreite+FTiefe, FBreite+FHoehe);
  194.   Draw_Flaeche(0, 0, FigBreite, FigTiefe, FigHoehe,
  195.                Schrift, Hintergrund, SolidFill);
  196.   ZZ:=ImageSize(0, 0, FigBreite+FigTiefe, FigTiefe+FigHoehe);
  197.   GetMem(Figur, ZZ);
  198.   GetImage(0, 0, FigBreite+FigTiefe, FigTiefe+FigHoehe, Figur^);
  199.   OffsetFigurX:=3*FigBreite div 4+1;
  200.   OffsetFigurY:=FigTiefe div 2+1;
  201.   ClearDevice;
  202.   SetFillStyle(SolidFill, GetMaxColor);
  203.   Bar(0, 0, FBreite+FTiefe, FBreite+FHoehe);
  204.   Draw_Flaeche(0, 0, FBreite, FTiefe, FHoehe,          { "Lochmaske" zeichnen }
  205.                Hintergrund, Hintergrund, SolidFill);
  206.   ZZ:=ImageSize(0, 0, FBreite+FTiefe, FTiefe+FHoehe);
  207.   GetMem(Leer, ZZ);
  208.   GetImage(0, 0, FBreite+FTiefe, FTiefe+FHoehe, Leer^);
  209. END;
  210.  
  211. PROCEDURE Schreibe(Spalte, Zeile: WORD;          { Textausgabe im Grafikmodus }
  212.           Text: Str80; Farbe: BYTE);
  213. BEGIN
  214.   Y:=TextHeight(Text)*5 DIV 4;
  215.   X:=TextWidth(Text);
  216.   SetFillStyle(SolidFill, Hintergrund);                 { Hintergrund löschen }
  217.   Bar(Spalte, Zeile, Spalte+X, Zeile+Y);
  218.   SetColor(Farbe);
  219.   OutTextXY(Spalte, Zeile, Text);
  220. END;
  221.  
  222. PROCEDURE Vorbereitungen;                           { Diverse Dinge erledigen }
  223. VAR
  224.   DirInfo: SearchRec;                            { Zum Suchen der Bilddateien }
  225. BEGIN
  226.   Assign(HiScoreDatei, 'WESP.DAT');                      { Hi-Scores laden... }
  227.   Reset(HiScoreDatei);
  228.   IF IOResult=0 THEN
  229.   BEGIN
  230.     FOR I:=1 TO 10 DO
  231.     BEGIN
  232.       Read(HiScoreDatei, Eintrag);
  233.       HiScoreListe[I]:=Eintrag;
  234.     END;
  235.     Close(HiScoreDatei);
  236.   END
  237.   ELSE
  238.     FOR I:=1 TO 10 DO                                 { ...oder neu erstellen }
  239.     BEGIN
  240.       HiScoreListe[I].Name:='Nobody';
  241.       HiScoreListe[I].Punkte:=110-I*10;
  242.     END;
  243.   Treiber:=Detect;
  244.   DetectGraph(Treiber, Modus);
  245.   CASE Treiber OF                        { Variablen auf Grafikkarte anpassen }
  246.     EGA,
  247.     VGA: BEGIN
  248.            Treiber:=EGA;
  249.            Modus:=EGAHi;
  250.            Schrift:=LightGray;
  251.            Hell:=LightRed;
  252.            Hintergrund:=Black;
  253.            Header:=LightMagenta;
  254.            A:=1;
  255.            TreiberTyp:=EGAScr;
  256.            Ext:='EGA';
  257.          END;
  258.     HercMono:
  259.          BEGIN
  260.            Treiber:=HercMono;
  261.            Modus:=HercMonoHi;
  262.            Schrift:=1;
  263.            Hell:=1;
  264.            Header:=1;
  265.            Hintergrund:=Black;
  266.            A:=1;
  267.            TreiberTyp:=HERCScr;
  268.            Ext:='HGC';
  269.          END;
  270.     MCGA,
  271.     CGA: BEGIN
  272.            Treiber:=CGA;
  273.            Modus:=CGAC0;
  274.            Schrift:=Rot;
  275.            Hell:=Gruen;
  276.            Header:=Gelb;
  277.            Hintergrund:=Schwarz;
  278.            A:=2;
  279.            TreiberTyp:=CGAScr;
  280.            EXT:='CGA';
  281.          END;
  282.   ELSE                                                              { Hoppla! }
  283.     writeln(^G, 'Was haben Sie denn für eine Grafikkarte?');
  284.     writeln(#10#13, 'Sorry - die kenne ich leider nicht!');
  285.     Halt;
  286.   END;
  287.   InitGraph(Treiber, Modus, '');
  288.   IF GraphResult<>0 THEN
  289.   BEGIN                                                    { Nicht vergessen! }
  290.     writeln(^G,'Wo haben Sie denn Ihre BGI-Treiber?'#10#13);
  291.     writeln('Bitte schnell in mein Verzeichnis damit!');
  292.     Halt;
  293.   END;
  294.   SetTextJustify(LeftText, TopText);
  295.   CheckBreak:=FALSE;
  296.   TastByteAlt:=TastByte;                                { NumLock einschalten }
  297.   TastByte:=TastByte OR 32;                 { LED bleibt evtl. unbeeinflusst! }
  298.   FBreite:=GetMaxX div 20;                                 { Maße der Flächen }
  299.   FHoehe:=GetMaxY div 45;
  300.   FTiefe:=GetMaxY div 20;
  301.   MultX:=FBreite+FTiefe+1;                          { Multiplikatoren x und y }
  302.   MultY:=FTiefe+FHoehe+1;
  303.   ZZ:=ImageSize(0, 0, MultX-1, MultY-1);
  304.   FOR I:=1 to 8 DO
  305.     FOR J:=1 to 8 DO
  306.       GetMem(FeldHintergrund[I, J], ZZ);       { Speicher für den Hintergrund }
  307.   OffsetX:=(GetMaxX-8*MultX) div 2+3*MultX div 2;  { Verschiebung der Flächen }
  308.   OffsetY:=(GetMaxY-MultY*8) div 2;
  309.   Create_Sprites;
  310.   BildNr:=1;                              { Dateinamen der Bildfiles einlesen }
  311.   FindFirst('*.'+Ext, Archive, DirInfo);
  312.   BildZeiger:=1;
  313.   while (DosError=0) AND (BildZeiger<50) DO
  314.   BEGIN
  315.     BildName[BildZeiger]:=DirInfo.Name;
  316.     FindNext(DirInfo);
  317.     Inc(BildZeiger);
  318.   END;
  319.   AnzBilder:=Pred(BildZeiger);                      { So viele Bilder gibt es }
  320.   BilderVorhanden:=AnzBilder>0;
  321. END;
  322.  
  323. PROCEDURE Plattform(Spalte, Zeile: BYTE; Zeichnen: BOOLEAN);{ Fläche zeichnen }
  324. VAR
  325.   n: BYTE;
  326. BEGIN
  327.   X:=Spalte*MultX-Zeile*MultY+OffsetX;
  328.   Y:=Zeile*MultY+OffsetY;
  329.   FeldGesetzt[Spalte, Zeile]:=Zeichnen;              { Wichtig: Array setzen! }
  330.   IF Zeichnen THEN
  331.   BEGIN
  332.     GetImage(X, Y, X+MultX-1, Y+MultY-1,          { Stück Hintergrund sichern }
  333.              FeldHintergrund[Spalte, Zeile]^);
  334.     PutImage(X, Y, Leer^, AndPut);             { "Lochmaske" draufkopieren... }
  335.     n:=(Spalte+Zeile) mod 4+1;
  336.     Draw_Flaeche(x, y, FBreite, FTiefe, FHoehe,       { ...und erst jetzt die }
  337.                  Flaechen[TreiberTyp].Rahmen[n],      { Fläche zeichnen!      }
  338.                  Flaechen[TreiberTyp].Flaeche[n],
  339.                  Flaechen[TreiberTyp].FillType[n]);
  340.   END
  341.   ELSE
  342.   BEGIN
  343.     PutImage(X, Y, FeldHintergrund[Spalte, Zeile]^,            { Hintergrund  }
  344.              NormalPut);                                       { restaurieren }
  345.   END;
  346. END;
  347.  
  348. PROCEDURE Ton(F: WORD);               { ...damit man auch leise spielen kann! }
  349. BEGIN
  350.   IF SoundOn THEN
  351.     Sound(F);
  352. END;
  353.  
  354. PROCEDURE Piep;                                                      { Pieps! }
  355. VAR
  356.   S: WORD;
  357. BEGIN
  358.   S:=100;
  359.   WHILE S<2000 DO
  360.   BEGIN
  361.     Ton(S);
  362.     Delay(6);
  363.     INC(S, 100);
  364.   END;
  365.   NoSound;
  366. END;
  367.  
  368. PROCEDURE Spielfigur(Spalte, Zeile: BYTE);   { Spielfigur auf Fläche zeichnen }
  369. BEGIN
  370.  X:=Spalte*MultX-Zeile*MultY+OffsetX+OffsetFigurX;
  371.  Y:=Zeile*MultY+OffsetY+OffsetFigurY;
  372.  PutImage(X, Y, Figur^, AndPut);
  373.  IF I=1 THEN                                     { Ton für einen einfachen... }
  374.  BEGIN
  375.    Ton(150);
  376.    Delay(1);
  377.    NoSound;
  378.    Delay(1);
  379.    Ton(100);
  380.    Delay(1);
  381.    NoSound;
  382.  END
  383.  ELSE
  384.    Piep;                                 { ... und für einen doppelten Sprung }
  385. END;
  386.  
  387. PROCEDURE DrawSterne;                                { Sternenhimmel zeichnen }
  388. BEGIN
  389.   FOR I:=1 TO AnzSterne DO
  390.   BEGIN
  391.     REPEAT
  392.       x:=Random(GetMaxX);
  393.       y:=Random(GetMaxY);
  394.     UNTIL GetPixel(x, y)=Hintergrund;
  395.     Sterne[I].x:=x;
  396.     Sterne[I].y:=y;
  397.     PutPixel(Sterne[I].x, Sterne[I].y,
  398.              Succ(Random(GetMaxColor)));
  399.   END;
  400. END;
  401.  
  402. PROCEDURE Sternenflimmern;  { Der Romantik wegen: Sterne bunt flimmern lassen }
  403. VAR
  404.   n: WORD;
  405. BEGIN
  406.   n:=Succ(Random(AnzSterne));
  407.   PutPixel(Sterne[n].x, Sterne[n].y,
  408.            Random(Succ(GetMaxColor)));
  409. END;
  410.  
  411. PROCEDURE GetParameter;                   { Kommandozeilenparameter auswerten }
  412. VAR
  413.   Error: INTEGER;
  414.   n: BYTE;
  415.   P: ARRAY [1..2] OF STRING;
  416. BEGIN
  417.   PCXFrequenz:=2;                 { Normalerweise: Jede 2. Runde mit PCX-Bild }
  418.   IF ParamCount>0 THEN
  419.   BEGIN
  420.     P[1]:=ParamStr(1);
  421.     IF ParamCount>1 THEN
  422.       P[2]:=ParamStr(2)
  423.     ELSE
  424.       P[2]:='';
  425.     IF P[1][1]='?' THEN
  426.     BEGIN
  427.       writeln(^G, 'Falsche(r) Parameter!');
  428.       writeln;
  429.       writeln('Erlaubte Parameter für WESP +');
  430.       writeln('=============================');
  431.       writeln;
  432.       writeln('Wenn Sie mit einem anderen Datenfile als WESP.LEV spielen möchten,');
  433.       writeln('dann geben sie den Namen dieser HiScoreDatei einfach als Parameter an.');
  434.       writeln('Eine Pfadangabe darf auch enthalten sein!');
  435.       writeln;
  436.       writeln('Beispiel:   WESP C:\SPIELE\SCHWER.LEV');
  437.       writeln;
  438.       writeln('Außerdem können Sie selbst bestimmen, in welchen Levels jeweils');
  439.       writeln('ein neues PCX-Bild geladen werden soll. Dazu müssen Sie nur einen');
  440.       writeln('Schrägstrich (/), gefolgt von einer Zahl n zwischen 0 und 10 angeben.');
  441.       writeln('Alle n Runden wird dann ein Hintergrundbild geladen.');
  442.       writeln;
  443.       writeln('Beispiel:   WESP /2   (entspricht dem Default-Wert)');
  444.       writeln;
  445.       writeln('Der Parameter "/0" unterbindet das Einladen von PCX-Hintergründen.');
  446.       Halt;
  447.     END;
  448.  
  449.     FOR n:=1 to 2 DO
  450.       IF P[n][1]<>'/' THEN
  451.       BEGIN
  452.         IF P[n]>'' THEN
  453.           LevelFileName:=P[n];             { Level nicht aus "WESP.LEV" laden }
  454.       END
  455.       ELSE
  456.       BEGIN
  457.         P[n][1]:=' ';
  458.         Val(P[n], PCXFrequenz, Error);
  459.         IF Error<>0 THEN
  460.           PCXFrequenz:=2;
  461.       END;
  462.     IF PCXFrequenz>50 THEN
  463.       PCXFrequenz:=50;
  464.     IF PCXFrequenz<0 THEN
  465.       PCXFrequenz:=0;
  466.   END;
  467. END;
  468.  
  469. PROCEDURE Load_BackGround;             { Organisiert das Laden der PCX-Bilder }
  470. VAR
  471.   Name: STRING[12];
  472. BEGIN
  473.   BildGeladen:=FALSE;
  474.   IF not BilderVorhanden OR (PCXFrequenz=0) OR
  475.      (Pred(Ebene) mod PCXFrequenz<>0)  THEN
  476.     exit;
  477.   BildZeiger:=((Pred(Ebene) div PCXFrequenz) mod AnzBilder)+1;
  478.   Name:=BildName[BildZeiger];
  479.   SwapVectors;
  480.   Exec('SHOW.EXE', Name+' /S');         { Muß im gleichen Verzeichnis stehen! }
  481.   SwapVectors;
  482.   BildGeladen:=TRUE;
  483. END;
  484.  
  485. PROCEDURE Tastaturpuffer_loeschen;
  486. BEGIN
  487.   Regs.AX:=$0C00;
  488.   MsDos(Regs);
  489. END;
  490.  
  491. PROCEDURE LoadRunden;               { Daten für alle Level auf einmal laden - }
  492. CONST                               { es sind ja nur 1000 Bytes!              }
  493.   LevelKennung: STRING[10] = 'WESP plus*';
  494. BEGIN
  495.   {$I-}
  496.   Assign(BildDatei, LevelFileName);
  497.   Reset(BildDatei);
  498.   {$I+}
  499.   IF IOResult<>0 THEN
  500.   BEGIN
  501.     writeln(^G, 'Die Level-Datei ', LevelFileName, ' kann ich nicht öffnen!');
  502.     writeln(#10#13, 'Programm beendet...');
  503.     Halt;
  504.   END;
  505.   {$I-}
  506.   IF FileSize(BildDatei)=1 THEN
  507.     Read(BildDatei, BildDaten);
  508.   {$I+}
  509.   IF (BildDaten.Kennung<>LevelKennung) OR (IOResult<>0) THEN
  510.   BEGIN
  511.     writeln(^G, 'Die Datei ', LevelFileName, ' ist keine Leveldatei für WESP+');
  512.     writeln(#10#13, 'Programm beendet...');
  513.     Halt;
  514.   END;
  515.   Close(BildDatei);
  516. END;
  517.  
  518. PROCEDURE Spielfeld_aufbauen(Feld_Nr: BYTE);    { Daten für Level aufbereiten }
  519. CONST                                           { und Flächen zeichnen lassen }
  520.   Wert: ARRAY[1..8] OF BYTE=(128, 64, 32, 16, 8, 4, 2, 1);
  521. VAR
  522.   x, y: INTEGER;
  523. BEGIN
  524.   SetGraphMode(Modus);        { ...damit die Standardpalette wieder erscheint }
  525.   ClearDevice;                                         { Statuszeile aufbauen }
  526.   IF Feld_Nr>AnzLevel THEN                             { Alle Level geschafft }
  527.     Exit;
  528.   Dec(Feld_Nr);
  529.   REPEAT                               { Checken, ob es noch mehr Levels gibt }
  530.     Inc(Feld_Nr);
  531.   UNTIL (BildDaten.Level[Feld_Nr].x>0) OR (Feld_Nr>=AnzMaxRaeume);
  532.   IF BildDaten.Level[Feld_Nr].x=0 THEN       { Es gibt keinen weiteren Level! }
  533.   BEGIN
  534.     OutTextXY(GetMaxX div 2-18*TextWidth('L'), GetMaxY div 2,
  535.               'Keine weiteren Level mehr vorhanden!');
  536.     Write(^G);
  537.     Delay(1000);
  538.     Anzahl_Felder:=0;
  539.     exit;
  540.   END;
  541.   Load_BackGround;
  542.   SetTextStyle(DefaultFont, HorizDir, 1);
  543.   SetFillStyle(EmptyFill, Hintergrund);
  544.   PutPixel(0, 0, Hintergrund);         { Setzt geg. wieder korrekte EGA-Plane }
  545.   Bar(0, 0, GetMaxX, TextHeight('X')*5 div 4);
  546.   SetColor(13);
  547.   OutTextXY(1, 1, 'Punkte');
  548.   OutTextXY(250 DIV A+1, 1, 'Bonus');
  549.   OutTextXY(500 DIV A+1, 1, 'Ebene');
  550.   SetColor(15);
  551.   OutTextXY(0, 0, 'Punkte');
  552.   OutTextXY(250 DIV A, 0, 'Bonus');
  553.   OutTextXY(500 DIV A, 0, 'Ebene');
  554.   FOR I:=-1 to 10 DO                         { Flächenarray für Spiel löschen }
  555.     FOR J:=-1 to 10 DO
  556.       FeldGesetzt[I, J]:=FALSE;
  557.   Anzahl_Felder:=0;
  558.   FOR I:=1 TO 8 DO
  559.     FOR J:=1 TO 8 DO
  560.       IF ((BildDaten.Level[Feld_Nr].Zeile[I] AND Wert[J]) > 0) THEN
  561.       BEGIN
  562.         INC(Anzahl_Felder);             { Schön die Anzahl Flächen mitzählen! }
  563.         Plattform(J, I, TRUE);
  564.       END;
  565.   Figur_Spalte:=BildDaten.Level[Feld_Nr].x;                 { Startposition }
  566.   Figur_Zeile:=BildDaten.Level[Feld_Nr].y;
  567.   TastaturPuffer_Loeschen;
  568.   IF not BildGeladen THEN            { Wenn kein Bild, dann wenigstens Sterne }
  569.     DrawSterne;
  570. END;
  571.  
  572. PROCEDURE Zeitroutine;                                   { Bonuszeit anzeigen }
  573. VAR
  574.   Stunde, Minute, Sekunde, Hunderstel: WORD;
  575. BEGIN
  576.   GetTime(Stunde, Minute, Sekunde, Hunderstel);
  577.   IF (Sekunde<>Zeitspeicher) AND (Zeit>0) THEN
  578.   BEGIN
  579.     Zeitspeicher:=Sekunde;
  580.     DEC(Zeit);
  581.     Str(Zeit, Zeit_Str);
  582.     Schreibe(380 DIV A, 0, Zeit_Str+#32, 15);
  583.   END;
  584. END;
  585.  
  586. PROCEDURE SpielEnde;
  587. BEGIN
  588.   CloseGraph;                                                { Grafik beenden }
  589.   TastByte:=TastByteAlt;                    { NumLock-Status wiederherstellen }
  590.   Halt;
  591. END;
  592.  
  593. PROCEDURE Tastendruck(Blink: BOOLEAN);                          { Taste holen }
  594. BEGIN
  595.   Tastaturpuffer_loeschen;
  596.   REPEAT
  597.     IF Blink THEN                  { Bei der Gelegenheit eventuell gleich die }
  598.       Sternenflimmern;             { Sterne blinken lassen                    }
  599.   UNTIL KeyPressed;
  600. END;
  601.  
  602. FUNCTION Eingabe(Zeile, Spalte: WORD; Max: BYTE;
  603.          Zahlen, Blink: BOOLEAN): Str20;                      { Alle Eingaben }
  604. BEGIN
  605.   Hilfe:='';
  606.   SetFillStyle(SolidFill, Hintergrund);
  607.   REPEAT
  608.     Schreibe(Spalte, Zeile, Hilfe+#60#32#32#32, Hell);
  609.     Tastendruck(Blink);
  610.     Taste:=Ord(ReadKey);
  611.     IF Taste=0 THEN
  612.     BEGIN
  613.       Taste:=Ord(ReadKey);
  614.       Taste:=0;
  615.     END;
  616.     IF Taste=8 THEN                                               { Backspace }
  617.       Delete(Hilfe, Length(Hilfe), 1);
  618.     IF Zahlen THEN                                            { Zahleneingabe }
  619.     BEGIN
  620.       IF Taste=27 THEN                                          { ESC -> Ende }
  621.         SpielEnde;
  622.       IF (Taste in [48..57]) AND (Max>Length(Hilfe)) THEN
  623.         Hilfe:=Concat(Hilfe, Chr(Taste));
  624.     END
  625.     ELSE                                                        { Texteingabe }
  626.       IF (Taste in [32, 48..57, 65..90, 97..122]) AND
  627.          (Max>Length(Hilfe)) THEN
  628.         Hilfe:=Concat(Hilfe, Chr(Taste));
  629.   UNTIL Taste=13;
  630.   Eingabe:=Hilfe
  631. END;
  632.  
  633. PROCEDURE Spiel;                                        { Hauptprozedur Spiel }
  634. BEGIN
  635.   Ebene:=Start_Ebene-1;                 { Diverse Variablenwerte zurücksetzen }
  636.   Punkte:=0;
  637.   Str(Punkte, Punkte_Str);
  638.   Ende:=FALSE;
  639.   REPEAT                                      { Äußere Schleife: Je ein Level }
  640.     Tastaturpuffer_loeschen;
  641.     INC(Ebene);
  642.     Str(Ebene, Ebene_Str);
  643.     Spielfeld_aufbauen(Ebene);
  644.     IF Anzahl_Felder=0 THEN
  645.       exit;
  646.     Felder_Vernichtet:=0;
  647.     Zeit:=101;
  648.     Str(Zeit, Zeit_Str);
  649.     Schreibe(140 DIV A, 0, Punkte_Str, 15);                     { Statuszeile }
  650.     Schreibe(380 DIV A, 0, Zeit_Str, 15);
  651.     Schreibe(600 DIV A, 0, Ebene_Str, 15);
  652.     I:=1;
  653.     Spielfigur(Figur_Spalte, Figur_Zeile);
  654.     REPEAT                                 { Innere Schleife: Je ein Spielzug }
  655.       Zeitroutine;
  656.       IF not BildGeladen THEN
  657.         Sternenflimmern;
  658.       IF KeyPressed THEN
  659.       BEGIN                                                  { Taste gedrückt }
  660.         I:=1;
  661.         Taste:=Ord(ReadKey);
  662.         CASE Taste OF
  663.           0:       Taste:=Ord(ReadKey);
  664.           27:      BEGIN                                                { ESC }
  665.                      Punkte:=0;
  666.                      Exit;
  667.                    END;
  668.           83, 115: SoundOn:=Not SoundOn;      { <S> zum Umschalten des Sounds }
  669.         END;
  670.         IF Taste In [72, 80, 77, 75, 56, 50, 54, 52] THEN
  671.         BEGIN                                          { Spielzug durchführen }
  672.           Plattform(Figur_Spalte, Figur_Zeile, FALSE);       { Fläche löschen }
  673.           INC(Felder_Vernichtet);
  674.           INC(Punkte, 10);
  675.           Str(Punkte, Punkte_Str);
  676.           Schreibe(140 DIV A, 0, Punkte_Str, 15);
  677.           I:=1;
  678.           IF Taste in [72, 80, 77, 75] THEN                     { Sprungweite }
  679.             I:=2;
  680.           CASE Taste OF
  681.             83,115: SoundOn:=Not SoundOn;
  682.             72, 56: DEC(Figur_Zeile, I);                      { Cursor hoch   }
  683.             80, 50: INC(Figur_Zeile, I);                      { Cursor runter }
  684.             77, 54: INC(Figur_Spalte, I);                     { Cursor rechts }
  685.             75, 52: DEC(Figur_Spalte, I);                     { Cursor links  }
  686.           END;
  687.           IF not FeldGesetzt[Figur_Spalte, Figur_Zeile]
  688.              AND (Felder_Vernichtet<Anzahl_Felder) THEN
  689.             Ende:=TRUE;                                    { Daneben gehüpft! }
  690.         END;
  691.         IF (Felder_Vernichtet<Anzahl_Felder) AND (Not(Ende))
  692.         THEN
  693.           Spielfigur(Figur_Spalte, Figur_Zeile);                     { Zug OK }
  694.       END;
  695.     UNTIL Ende OR (Felder_Vernichtet=Anzahl_Felder) OR
  696.           (Ebene>AnzLevel);                                      { Rundenende }
  697.     IF Felder_Vernichtet=Anzahl_Felder THEN
  698.     BEGIN                                                   { Runde geschafft }
  699.       INC(Punkte, Zeit);
  700.       Zeit:=0;
  701.       Str(Zeit, Zeit_Str);
  702.       Str(Punkte, Punkte_Str);
  703.       FOR I:=1 TO 3 DO
  704.       BEGIN
  705.         Piep;
  706.         Delay(100);
  707.       END;
  708.       Schreibe(140 DIV A, 0, Punkte_Str, 15);
  709.       Schreibe(380 DIV A, 0, Zeit_Str+#32, 15);
  710.       SetTextStyle(TriplexFont, Horizdir, GetMaxX div 319*2);
  711.       Schreibe(GetMaxX DIV 2-TextWidth('XXXXXXXX'), GetMaxY DIV 2,
  712.                ' RUNDE GESCHAFFT! ', 15);
  713.       Tastendruck(not BildGeladen);
  714.     END;
  715.   UNTIL Ende;
  716.   I:=1000;                                                   { Spiel verloren }
  717.   WHILE I>100 DO
  718.   BEGIN
  719.     Ton(Random(I)+100);                                         { C R A S H ! }
  720.     Delay(1);
  721.     DEC(I);
  722.   END;
  723.   NoSound;
  724.  
  725.   FOR J:=1 to 8 DO       { Ein letzter Gruß: 8 Flächen mit Game Over anzeigen }
  726.     FOR I:=1 to 8 DO
  727.       IF (I in [3..6]) AND (J in [4, 5]) THEN
  728.       BEGIN
  729.         IF not FeldGesetzt[I, J] THEN
  730.           Plattform(I, J, TRUE);
  731.       END
  732.       ELSE
  733.         IF (FeldGesetzt[I, J]) THEN
  734.           Plattform(I, J, FALSE);
  735.  
  736.   SetTextStyle(DefaultFont, HorizDir, 1);
  737.   SetTextJustify(LeftText, BottomText);
  738.   IF Treiber=CGA THEN
  739.     SetUserCharSize(1, 1, 3, 5);
  740.   SetColor(Hintergrund);
  741.   FOR I:=1 to 2 DO
  742.     FOR J:=1 to 4 DO
  743.       OutTextXY((J+2)*MultX-(I+3)*MultY+OffsetX+2*FBreite div 3,
  744.                 (I+3)*MultY+OffsetY+FTiefe+FHoehe-FHoehe-1,
  745.                 GameOver[Pred(I)*4+J]);
  746.   TastenDruck(not BildGeladen);
  747. END;
  748.  
  749. PROCEDURE Hauptmenue;                                             { Titelbild }
  750. VAR
  751.   ch: CHAR;
  752. BEGIN
  753.   SetGraphMode(Modus);
  754.   ClearDevice;
  755.   CASE Treiber OF
  756.     EGA:      MakeAstronaut(GetMaxX-100, 3*GetMaxY div 16, 3, 2,
  757.                             White, LightBlue, LightRed);
  758.     CGA:      MakeAstronaut(GetMaxX-50, 3*GetMaxY div 16, 2, 1,
  759.                             3, 1, 2);
  760.     HercMono: MakeAstronaut(GetMaxX-100, 3*GetMaxY div 16, 4, 2,
  761.                             1, 0, 0);
  762.   END;
  763.   SetColor(Hell);
  764.   Rectangle(0, 0, GetMaxX, GetMaxY);
  765.   SetTextStyle(GothicFont, HorizDir, 1);
  766.   SetTextJustify(LeftText, TopText);
  767.   IF Treiber=CGA THEN                        { Größe der Überschrift anpassen }
  768.     SetUserCharSize(4, 3, 6, 7)
  769.   ELSE
  770.     SetUserCharSize(5, 2, 5, 3);
  771.   SetColor(Header);
  772.   OutTextXY(GetMaxX DIV 20, 0, 'WESP+');
  773.   SetColor(Schrift);
  774.   OutTextXY(Succ(GetMaxX DIV 20), 1, 'WESP+');
  775.  
  776.   I:=0;                                                    { Neuer Hi-Score ? }
  777.   Ende:=FALSE;
  778.   REPEAT
  779.     INC(I);
  780.     IF Punkte>HiScoreListe[I].Punkte THEN
  781.     BEGIN
  782.       IF I<10 THEN
  783.         FOR J:=10 DownTo I DO
  784.           HiScoreListe[J]:=HiScoreListe[J-1];
  785.       HiScoreListe[I].Name:='';
  786.       HiScoreListe[I].Punkte:=Punkte;
  787.       Ende:=TRUE;
  788.     END;
  789.   UNTIL (Ende) OR (I=12);
  790.   CASE Treiber OF                          { Schrift je nach Auflösung setzen }
  791.     HercMono,
  792.     EGA: BEGIN
  793.            SetTextStyle(TriplexFont, HorizDir, 1);
  794.            SetUserCharSize(3, 4, 2, 3);
  795.          END;
  796.     CGA: BEGIN
  797.            SetTextStyle(DefaultFont, HorizDir, 1);
  798.            SetUserCharSize(1, 3, 1, 3);
  799.          END;
  800.   END;
  801.   OutTextXY(5*GetMaxX DIV 10, GetMaxY DIV 30,
  802.             '(c) ''90 Th. Perner');
  803.   OutTextXY(5*GetMaxX DIV 10, 3*GetMaxY DIV 30,
  804.             ' &  t o o l b o x');
  805.   FOR J:=1 TO 10 DO                                 { Hi-Score-Liste anzeigen }
  806.   BEGIN
  807.     y:=GetMaxY DIV 16*(J+2);
  808.     IF J=I THEN
  809.       SetColor(Hell)
  810.     ELSE
  811.       IF Treiber=EGA THEN
  812.         SetColor(11-j)
  813.       ELSE
  814.         SetColor(Schrift);
  815.     Str(J:2, Dummy);
  816.     OutTextXY(GetMaxX DIV 20, y, Dummy);
  817.     OutTextXY(GetMaxX DIV 7, y, HiScoreListe[J].Name);
  818.     Str(HiScoreListe[J].Punkte:5, Dummy);
  819.     OutTextXY(5*GetMaxX DIV 7, y, Dummy);
  820.   END;
  821.  
  822.   IF Ende AND (I<11) THEN
  823.   BEGIN
  824.     SetColor(Hell);
  825.     y:=GetMaxY DIV 16*(I+2);
  826.     HiScoreListe[I].Name:=Eingabe(y, GetMaxX DIV 7, 20, FALSE, FALSE);
  827.     Assign(HiScoreDatei, 'WESP.DAT');
  828.     Rewrite(HiScoreDatei);                  { Neue Hi-Score-Liste abspeichern }
  829.     FOR J:=1 TO 10 DO
  830.       Write(HiScoreDatei, HiScoreListe[J]);
  831.     Close(HiScoreDatei);
  832.   END;
  833.  
  834.   Schreibe(GetMaxX DIV 20, GetMaxY DIV 16*14,
  835.            'Gib die Startebene ein: ', Schrift);
  836.   Schreibe(GetMaxX DIV 20, GetMaxY DIV 16*15, '0 -> Programmende', Schrift);
  837.   DrawSterne;
  838.   WHILE KeyPressed DO                                { Tastaturpuffer löschen }
  839.     ch:=ReadKey;
  840.   REPEAT                                                { Eingabe Levelnummer }
  841.     Dummy:=Eingabe(GetMaxY DIV 16*14, 5*GetMaxX DIV 6, 2, TRUE, TRUE);
  842.     Val(Dummy, Start_Ebene, X);
  843.   UNTIL (Start_Ebene>=0) AND (Start_Ebene<100);
  844.   IF Start_Ebene=0 THEN
  845.     SpielEnde;                                        { 0 -> Programm beenden }
  846. END;
  847.  
  848. BEGIN                                                         { HAUPTPROGRAMM }
  849.   GetParameter;
  850.   LoadRunden;
  851.   Vorbereitungen;
  852.   SoundOn:=TRUE;
  853.   REPEAT
  854.     Hauptmenue;
  855.     Spiel;
  856.   UNTIL FALSE;
  857. END.
  858. (* ========================================================================= *)
  859.  
  860.  
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.  
  869.