home *** CD-ROM | disk | FTP | other *** search
/ Club Amiga de Montreal - CAM / CAM_CD_1.iso / files / 572.lha / Getem_v1.0 / Sources / Getem1.0.p < prev    next >
Encoding:
Text File  |  1991-09-17  |  76.7 KB  |  1,754 lines
  1. PROGRAM Getem (Input,Output);
  2.  
  3. { © By M. Illenseer 1990/1991                                                }
  4. { Überarbeitete Version 1.0 , 15.9.1991                                      }
  5. { Erstellt mit Kickpascal V1.1 und V2.0 , thanx to the Himpire !             }
  6. { Achtung! Vor Compilierung ist auf die Größe des Speichers von Kickpascal   }
  7. { zu achten ! Es werden wohl mindestens 200 kB benötigt.                     }
  8. { Einziges Compilerflag sollte 'Stackgröße' sein.                            }
  9. { Diese Source ist nicht (in vorliegender Form) kompilierfähig unter KP 1.1. }
  10. { Ab Version KP 2.0 gibts aber jetzt Option Flags, und die setze ich jetzt ! }
  11.  
  12. {$opt q,s+}  { Nur auf Stackgröße testen }
  13.  
  14. USES ExecSupport, ExecIO, Intuition, Graphics;
  15. {$incl "intuition/intuitionbase.h","graphics/gfxbase.h" }
  16.  
  17. { Werden für die Fonts, IntBase und GfxBase benötigt}
  18.  
  19. { Wir haben hier jede Menge Grafik !                }
  20. { Benutzt werden dabei auch Exec1 und Graphtype.    }
  21. { Siehe Linker ! Wenn hier viel probiert wird, dann }
  22. { Pfad richtig einstellen !                         }
  23.  
  24. { In GetemSound.m sind Proceduren zum Laden und     }
  25. { Abspielen eines 8SVX-Sounds. Dieses Module ist    }
  26. { speziell fuer Getem (um)programmiert, kann aber   }
  27. { leicht geändert werden .                          }
  28.  
  29. {$link 'getem:GetemSound.o'}
  30.  
  31. {Wenn hier die Fehlermeldung kommt, daß das MODUL 'getemsound.m' nicht }
  32. {existiert dann muß GetemSound.m kompiliert und als Objektdatei abge-  }
  33. {speichert werden ! (GetemSound.o) Oder aber der Pfad muß geändert werden. }
  34.  
  35. {$incl "workbench/startup.h"}
  36.  
  37. { Dieses Include brauchen wir, wenn in der Procedure ChkParam die }
  38. { Startup-Msg benötigt wird. }
  39.  
  40.  
  41. TYPE                      { Ein paar Typen kann ich leiden ... }
  42.   GetPlane  = ARRAY[1..90] OF WORD;               { 6*15 = 90 Typ für Getemimage }
  43.   Plane     = ARRAY[1..20] OF WORD;               { Typ für Blockdata  }
  44.   ImgDatTyp = ARRAY[1..14] OF LONG;               { Typ für Imagedata  }
  45.   Spiel     = ARRAY[0..13,0..13] OF WORD;         { Typ für Spielfeld  }
  46.   Level     = ^LevelList;                         { Pointer auf Struktur }
  47.   LevelList = RECORD Lev: ARRAY[0..195] OF CHAR;  { Spielfeld =0..13,0..13=196 Blöcke }
  48.                      Name: String[80];            { Name des Levels }
  49.                      Score: Integer;              { Aktueller Score des Levels  }
  50.                      Next: Level;                 { Zeiger auf nächsten Level  }
  51.               END;
  52.  
  53. CONST
  54.   VERSION2 = 'Version 1.0 ';                      { Eyh! Nicht ändern ! }
  55.   NoCursor = ''\e'0 p';                           { Cursor abschalten mit WRITE  }
  56.   CLS = ''\e'c '\e'0;0H';                         { ClearScreen  }
  57.   {Debug = 'YES';}          { Klammern löschen, wenn Debug erwünscht, dann   }
  58.                             { erfolgen diverse Ausgaben auf der Console.     }
  59.                             { Also auf dem aktuellem CLI oder in KickPascal. }
  60.                             { ! Achtung ! Nicht von WB möglich ! }
  61.  
  62.   { Konstanten erleichtern das Leben...  }
  63.   WAIT = TRUE;       { Flag ob auf Messages gewartet werden soll }
  64.   NOWAIT = FALSE;    { oder eben nicht gewartet werden soll}
  65.   NOTHING = -1;      { Wenn keine Message erfolgte }
  66.   START = 1;         { Das Gadget 'start' wurde gedrückt }
  67.   TASTE = 2;         { Es wurde eine Taste gedrueckt }
  68.   TICK = 3;          { Es wurde ein Tick (Zeit) geliefert }
  69.   WINACT = 4;        { Das Window wurde (re)aktiviert }
  70.   WININACT = 5;      { Das Window wurde inaktiviert }
  71.   ICON = 6;          { Das Gadget 'icon' wurde gedrückt }
  72.   Stop = 7;          { Das Gadget 'stop' wurde gedrückt }
  73.   LEFT = 8;          { Die Maus wurde links gedrückt }
  74.   REGO = 9;          { Das Gadget 'rego' wurde gedrückt }
  75.   RIGHT = 11;        { Die Maus wurde rechts gedrückt }
  76.   MIDDLE = 12;       { Die Maus wurde in der Mitte gedrückt !! (Für 3-Tasten-Mäuse) }
  77.   SCOR=12 ;          { Das Gadget 'score' wurde gedrückt }
  78.  
  79. VAR
  80.   BarHeight,FSize,
  81.   x, y, Q, P,key,s,T,
  82.   time,posX,PosY,
  83.   PX,PY,AnzLev,AktLev : INTEGER;            {  Laufvariablen und Diverse  }
  84.   Score               : LONG;               {  Highscore in LONG!?  }
  85.   Load                : String;             {  Name des Level-Files }
  86.   TStr,TStr1          : String;             {  Temopärer String }
  87.   InitDone,                                 {  Flag für getane Arbeit }
  88.   Ende,Demon,Gamen,GameOn,                  {  Flags für aktuellen Status  }
  89.   NoSound,ScWindow    : BOOLEAN;            {  und Ende des Prog.  }
  90.   HiScore             : Array[1..10] OF INTEGER; {  HiScore Liste  }
  91.   Feld                : Spiel;              {  Feld für Blockmarkierung  }
  92.   Getem,                                    {  GetemImage  }
  93.   Imggad1, Imggad2,                         {  Die diversen Images ... }
  94.   Imggad3, Imggad4,
  95.   Imggad5, Imggad6,
  96.   Imggad7, Imggad8,
  97.   Imggad9, Imggad10   : Image;              {  Start, Stop, ReGo, Score Gadget-Images  }
  98.   Img                 : ARRAY[0..14] OF Image; {  15 Block Images }
  99.   Gad1, Gad2, Gad3,
  100.   Gad4, Gad5          : Gadget;             { Start,Stop,ReGo,Score Gadget }
  101.   IT                  : IntuiText;          { Text Start/Stop Gadget , für GfxText }
  102.   MyFnt               : TextAttr;           { Für IntuiText }
  103.   Cpy,Stufe,First     : Level;              { Kopie, 1. Level und aktueller Level }
  104.   Msg,Mesg            : ^IntuiMessage;      { Signalmessage des Windows }
  105.   IDt1, IDt2,
  106.   IDt3, IDT4,
  107.   IDt5                : ^ImgDatTyp;         { Pointer für Images }
  108.   AktGad              : ^Gadget;            { Pointer für Gadgettyp }
  109.   Win,ScWin           : ^Window;            { Pointer für Windows }
  110.   Con,Con1            : ^Ptr;               { Pointer für Consol-Windows }
  111.   Dat                 : ARRAY [0..14] OF ^Plane; { Pointer für Blockimages }
  112.   MouseDat,BusyMDat   : ^Plane;             { Pointer für Mousezeiger }
  113.   GetDat              : ^GetPlane;          { Pointer für GetemImage }
  114.   rp                  : ^RastPort;          { RastPort des Windows }
  115.   IntBase             : ^IntuitionBase;     { Base der Intuition }
  116.   GfxBase             : ^GraphicsBase;
  117.   OLock               : BPTR;               { Zeiger auf Filestruktur }
  118.   Label TheEnd;       { Tja, eigentlich gehts auch ohne Labels, ist nur
  119.                        schneller mit einem... und hier auch erlaubt !
  120.                        (Wo sind Labels schon erlaubt in Pascal ?)      }
  121.  
  122. { Soweit die Variablen, laßt Euch nicht abhalten das Listing durchzulesen !}
  123. { Fangt am besten mit dem Hauptprogramm an ! Dann erst die Funtionen und    }
  124. { Proceduren ! Hier sind genug Beispiele für Grafiken dabei ! }
  125.  
  126. Function  PlaySinit(Filename:String):boolean; Import;
  127. Procedure EndPlay; Import;
  128. Procedure Piep; Import;
  129.  
  130. { Diese Funktionen und Proceduren sind im Modul GetemSound.m vereinbart }
  131. { Ist dieses Modul nicht vorhanden, oder wird Getem umgeschrieben, so}
  132. { muß auch die Procedure Beep verändert werden (s. Kommentare). }
  133.  
  134.  
  135. PROCEDURE Beep(a:INTEGER);
  136. { a gibt Art des Sounds an, hier sind nur 2 implementiert ... }
  137. { Also, hier sollte mal ein richtiger Sound hin, wer Lust hat soll es programmieren. }
  138. { Wichtig ist, das GetemSound nicht zuz lang ist, ca. 1 Sekunde Sound sollte ausreichen. }
  139. BEGIN
  140.   IF NoSound THEN  { Es gibt ein Flag NoSound, welches man hier einsetzen kann. }
  141.                    { Also einen Sound wenn NoSound gesetzt, und einen, wenn }
  142.                    { gelöscht (=FALSE) ! }
  143.      Case a of     { Man kann hier mehrere Sounds abspielen... }
  144.  
  145.      1: Piep;  { Aus MODUL GetemSound, wenn nicht da, dann ausklammern }
  146.      2: ;      { Hier eine andere Prozedur anhängen, wenn erwünscht }
  147.                { Diese muss im Modul GetemSound.m definiert sein, um 8SVX Files lesen zu können }
  148.      otherwise ;   { Nix ! }
  149.      end
  150.   ELSE
  151.      DisplayBeep(Nil); { Es soll Leute geben, die 'InstallBeep' einsetzen ! }
  152.                        { Dann kommt hier auch ein Sound raus ! }
  153. end;
  154.  
  155. PROCEDURE  LoadLevels(a,b:INTEGER);
  156. { Hier wird nun eine externe Datei geladen, die ein paar Levels enthalten sollte. }
  157. { Es könnte Schwierigkeiten geben, wenn Getem von der Workbench gestartet wird. }
  158. { Ich habe nicht gewollt, dass man mehrere Level-Files mit Shift-Klick }
  159. { mit übergibt. Siehe auch 'GetParam' }
  160.  
  161. VAR fn   : file of char;            { Filehandle (hätte auch File of TEXT sein können)  }
  162.     t,c  : STRING;                  { String bis EoLn }
  163.     L    : array [0..13] of String; { Levelgröße }
  164.     i, j, Anz, z
  165.          : INTEGER;                 { Laufvariablen }
  166.     tmp  : Level;                   { Pointer, Level werden dynamisch }
  167.                                     { gelesen, somit 'unbegrenzt' viele Level möglich ! }
  168.     w    :^Window;                  { Neues Window , für Ladeanzeige }
  169.     it   : IntuiText;               { Lokaler TextPointer }
  170.     r    :^RastPort;                { Pointer auf Window }
  171.     Err  : Boolean;                 { Fehlerflag }
  172.     Leer : String ;                 { Leerstring }
  173.  
  174.  PROCEDURE Errors(Error:Boolean);
  175.  { Ausgabe von Fehlern: LeseFehler, File nich vorhanden, falsche FileStruktur }
  176.    BEGIN
  177.       it :=  IntuiText(3,0,1,0,0,^Myfnt,Leer,Nil);
  178.       PrintIText(r, ^it,170-StrLen(t)*4,3); { Text löschen }
  179.       t:='Can´t find the Level-File:'+Load;
  180.       IF (StrLen(t)>42) THEN t := Copy(t,1,40)+'..';
  181.       it :=  IntuiText(2,0,1,0,0,^Myfnt,t,Nil);
  182.       PrintIText(r, ^it,170-StrLen(t)*4,3); { Ausgabe von: FILE NOT FOUND }
  183.       Delay(50);                            { Ne Sekunde warten }
  184.       it :=  IntuiText(3,0,1,0,0,^Myfnt,Leer,Nil);
  185.       PrintIText(r, ^it,170-StrLen(t)*4,3);
  186.       IF Error=False THEN Begin
  187.        t:='File-Error #: '+intstr(IOresult); { Ausgabe des DOS-Errors }
  188.        IF (StrLen(t)>42) THEN t := Copy(t,1,40)+'..';
  189.        it :=  IntuiText(2,0,1,0,0,^Myfnt,t,Nil);
  190.        PrintIText(r, ^it,170-StrLen(t)*4,3);
  191.        t:='Making Random-Levels. Read Doc-File!'; { Ausgabe, daß Getem Zufalls-Level baut }
  192.        it :=  IntuiText(3,0,1,0,0,^Myfnt,t,Nil);
  193.        PrintIText(r, ^it,170-StrLen(t)*4,10);
  194.       end
  195.       ELSE
  196.       Begin
  197.        Close(fn); { File zu. Falsches Format. }
  198.        t:=' Wrong Level File Struktur !! '; { Falsche Filestruktur ! }
  199.        it :=  IntuiText(2,0,1,0,0,^Myfnt,t,Nil);
  200.        PrintIText(r, ^it,170-StrLen(t)*4,3);
  201.        t:=' EXIT GAME ! DANGER ! '; { Ausgabe, daß Getem verlassen wird ! }
  202.        it :=  IntuiText(3,0,1,0,0,^Myfnt,t,Nil);
  203.        PrintIText(r, ^it,170-StrLen(t)*4,10);
  204.       end;
  205.       Stufe :=  NIL;                        { Kein Level da! }
  206.       First :=  NIL;                        { Auch kein erster }
  207.       Delay(5*60);                          { 5 sekunden warten }
  208.    END; { errors }
  209.  
  210.  
  211. BEGIN
  212.    AnzLev :=0; { Ist klar, erst mal auf Null setzen }
  213.    Err:=False; { Fehlerfalg false = kein Fehler }
  214.    Leer:='                                         '; { Leerstring }
  215.    { Mache kleines Window auf, indem angezeigt wird, das Getem die Levels lädt. }
  216.    W :=  Open_Window(Win^.LeftEdge+30,Win^.TopEdge+140,    { Oben links und rechts , abhängig vom Basisfenster}
  217.                      340,20,                               { Breite Höhe }
  218.                      1,                                    { Farbe }
  219.                      ACTIVEWINDOW,RmbTrap,                 { IDCMP-Flags und Traps}
  220.                      Nil,Nil,                              { ScreenPointer unwichtig...}
  221.                      0,0,0,0);                             { Das hier auch, das Window kann ja nicht bewegt werden...}
  222.  
  223.    r := w^.RPort; { Setze Window-Pointer }
  224.    TStr:=' Get´em ! '+VERSION2+' A Game by M. Illenseer. LoadWindow';
  225.    SetWindowTitles(w,Nil,TStr);
  226.    SetPointer(w,BusyMDat,8,8,-9,-4);
  227.    SetPointer(win,BusyMDat,8,8,-9,-4);
  228.    { Mehr zu SetWindowTitles und SetPointer siehe Procedure Init }
  229.  
  230.    t := 'Loading: '+Load; { Intuitext verträgt keine temporären Strings. Load ist File-Name. }
  231.                           { Default ist GETEMLEVELS, kann aber per Parameter angegeben werden. }
  232.    IF (StrLen(t)>42) THEN t := Copy(t,1,40)+'..';  { Jups. String darf nicht zu groß werden... }
  233.    it :=  IntuiText(3,0,1,0,0,^MyFnt,t,Nil);
  234.    PrintIText(r, ^it,170-StrLen(t)*4,3);  { Ausgabe von: Loading: ..LEVELS  }
  235.    Assign(fn, Load);                      { Gutes altes ISO-Pascal... Setze Pointer auf File }
  236.    Reset (fn);                            { Load = Parameter-Name oder einfach 'GetemLevels' }
  237.    IF EOF(fn) or (IOResult<>0) THEN       { Wenn File leer (!) oder sonstiger Fehler }
  238.     Errors(False)
  239.    ELSE                                     { Ok. File gefunden }
  240.    BEGIN
  241.       Buffer(fn, 4000);                     { Neue Puffer-Funktion von KP 2.0X }
  242.       { OHNE DIESE FUNKTION WIRD DIE LADEROUTINE ZUR GEDULDPROBE ! }
  243.       { Wird der Puffer erhöht, ergibt sich kein grosser Geschwindigkeits }
  244.       { Vorteil, und der Stack muss entsprechend erhöht werden ! }
  245.       AnzLev:=1;                            { Also wenigstens 1 Level ! }
  246.       Anz := 0;z := 5;                      { z ist nur ne Laufvariable für die Lade-Kontroll-Punkte }
  247.       New (Stufe);                          { Absolut neue Stufe }
  248.       First :=  Stufe;                      { Baue Struktur auf }
  249.       FOR i :=  0 TO 13 DO                  { Lese 13 (Getem-)Blöcke ein }
  250.       BEGIN
  251.          READLN(fn, c);                     { Jetzt einlesen mit readln, da wird mir schon schl%&*t ! }
  252.          FOR j :=  0 TO 13 DO
  253.             IF c[j+1] IN ['0'..'8'] THEN Stufe^.lev[i+j*14]:=c[j+1]     {  Lese ersten Level in die Ringstruktur ein }
  254.             ELSE Begin Stufe^.lev[i+j*14] := '0'; Err := True; end;
  255.       END;
  256.       READLN(fn,Stufe^.Name);               { Schön, der Level-Name ist auch da ! }
  257.       Stufe^.Score := 0;                    { Natürlich kein Score da ! }
  258.                                             { Eigentlich könnte ja hier ein Readln für einen Score hin}
  259.                                             { Aber das würde eine Speicher-Procedure erfordern...}
  260.       WritePixel(r,5,17);                   { Jeder Punkt ein Level... }
  261.       WHILE not EOF(fn) DO                  { weitermachen bis kein Level mehr da ! }
  262.       BEGIN
  263.          New(tmp);                          { Stufe ist schon voll, deshalb neue Struktur tmp }
  264.          Anz := Anz +2;                     { Mehr Level! }
  265.          FOR i :=  0 TO 13 DO
  266.          BEGIN
  267.             READLN(fn, c);                  { Einlesen einer ganzen Zeile }
  268.             FOR j :=  0 TO 13 DO            { Die ersten 13 Buchstaben interpretieren }
  269.                IF c[j+1] in ['0'..'8'] THEN tmp^.lev[i+j*14] := c[j+1]  {  Lese weitere Level  }
  270.                ELSE Begin Stufe^.lev[i+j*14] := '0'; Err:=True; End;
  271.          END;
  272.          READLN(fn, tmp^.Name);             { Level Name einlesen }
  273.          tmp^.Score := 0;
  274.          WritePixel(r,z+Anz*2,17);          { Ladekontrollpixel }
  275.          IF Anz>165 THEN BEGIN
  276.            z := 6;
  277.            Anz := 2;
  278.          end; { 165= Breite_Fenster*2 }
  279.          Stufe^.Next :=  tmp;
  280.          Stufe :=  tmp;                     { Hops, jetzt Struktur umhängen ! }
  281.          AnzLev := AnzLev +1;               { Noch mehr Levels }
  282.       END; {  WHILE  }
  283.       stufe^.Next :=  First;                { Struktur verlängern und umhängen! }
  284.       Close(fn);                            { File zu! }
  285.       Stufe :=  First;
  286.       Cpy := First;                         { Nach dem letzten Level kommt wieder der Erste ! }
  287.   END; { IF konnte geöffnet werden  }
  288.   If Err=True THEN  { Filestruktur falsch !!! (Blödsinn eingeladen ?)}
  289.    Begin
  290.     Errors(True);             { Fehlerroutine mit Parameter für falsche Filestruktur }
  291.     Delay(25);
  292.     CloseWindow(w);           { Fenster zu }
  293.     OLock:=CurrentDir(OLock); { Zurück ins alte Directory }
  294.     Goto TheEnd;              { Abbruch }
  295.   End;
  296.   NoSound:=Not PlaySinit('GetemSound');     { LadeRoutine für Sound aus MODUL GetemSounds }
  297.   If NoSound then Begin                     { Wow! Endlich ! Ein wenig Sound ! }
  298.    t:='    Could not load SoundFile !       '; { Mist, kein SoundFile da ! }
  299.    it :=  IntuiText(2,0,1,0,0,^Myfnt,t,Nil);
  300.    PrintIText(r, ^it,170-StrLen(t)*4,3);     { Ausgabe daß das Sound-File nicht da ist }
  301.    t:='   Going to use Flash instead...     '; { Wenn 'InstallBeep installiert ist, bekommen wir auch Sound :-) }
  302.    it :=  IntuiText(3,0,1,0,0,^Myfnt,t,Nil);
  303.    PrintIText(r, ^it,170-StrLen(t)*4,10);   { Ausgabe daß das Sound-File nicht da ist }
  304.    Delay(2*50);                             { 2 sekunden warten , damit Msg ausgegeben werden kann }
  305.   end; {NoSound}
  306.   t:='              Game Ready !              ';
  307.   it :=  IntuiText(3,0,1,0,0,^Myfnt,t,Nil);
  308.   PrintIText(r, ^it,170-StrLen(t)*4,10);   { Ausgabe OK! }
  309.   Delay(25); { Anzeigezeit }
  310.   Close_Window(w);                          { Fenster zu }
  311.   SetPointer(win,MouseDat,8,8,-9,-4); { Setze normalen Mousepointer }
  312.   OLock:=CurrentDir(OLock);  { In das alte Direktory zurück gehen }
  313. END; { loadlevels }
  314.  
  315. PROCEDURE HiPrint;
  316. { Ausgabe der Highscores. Aufgrund der Ringstruktur der Levels kann ich (noch nicht) den }
  317. { vorherigen Level-Score nicht ausgeben. Die Lösung mit dem Console-Window ist }
  318. { nicht schön... aber wie soll ich es sonst machen ? }
  319. Var tp,p,q   :INTEGER;   { Nur ein paar Laufvariablen }
  320.     t        : Level;    { Ein Pointer auf den 1. Level }
  321.      ht,c    :STRING;    { Ein paar strings }
  322.  
  323. BEGIN
  324.  IF SCWINDOW = TRUE THEN                    { Ist das Fenster für die Scores schon offen ? }
  325.  BEGIN
  326.   c:='               ';                     { Leerstring }
  327.   ht := '                   '+chr(10);      { Leere Zeile mit CR }
  328.   FOR q := 1 TO 10 DO                       { Fenster sozusg. löschen }
  329.    WriteCon(Con1, ht);
  330.   WriteCon(Con1, CLS);                      { und ein CLS hinterherjagen }
  331.   New(t);
  332.   t := Stufe;                               { Kopie anfertigen }
  333.   IF AnzLev<=9 THEN                         { Hamwa mehr als 9 Level ? }
  334.    q:=AnzLev
  335.   ELSE q:=10;                               { Sind mehr als 10 Level da ! }
  336.   For p := 1 to q do                        { Ausgabe aller LevelNamen und Scores }
  337.   BEGIN                                     { Abschneiden der Namen, kann nur 11 Zeichen ausgeben }
  338.    t := Stufe;
  339.    for tp := 1 to p do t := t^.Next;
  340.    IF Length(t^.Name)<20 THEN ht:=t^.Name+Copy(c,1,20-Length(t^.Name))
  341.                          ELSE ht:=Copy(t^.Name,1,20);
  342.    ht := ht+':'+IntStr(t^.Score)+chr(10);   { Namen und Score in String }
  343.    WriteCon(Con1, ht);                      { Ausgabe Level und Score }
  344.   END; { For }
  345.   t:=t^.Next;                               { Umhängen auf nächsten Level }
  346.   IF Length(t^.Name)<20 THEN ht:=t^.Name+Copy(c,1,20-Length(t^.Name))
  347.                         ELSE ht:=Copy(t^.Name,1,20);
  348.   ht := ht+':'+IntStr(t^.Score);
  349.   WriteCon(Con1, ht);
  350.  END; { SCWINDOW da }
  351. END; { HiPrint }
  352.  
  353. PROCEDURE HILIST;
  354. { Hier wird geschaut, ob das Fenster für die Sores offen ist, wenn }
  355. { ja, dann werden die Scores ausgegeben, sonst wird daß Fenster geschlossen. }
  356.  
  357. VAR t,p,q,r,s:integer;                        { Nur son paar Laufvariablen }
  358. CONST WinX = 216;                           { Fenster soll nich größer als 216 = 26*8sein, kann verändert werden ... }
  359.  
  360. BEGIN
  361.  IF SCWINDOW = TRUE THEN { Flag gibt an, ob schließen oder öffnen des ScoreWin }
  362.  BEGIN
  363.    SCWINDOW := FALSE;                       { Fenster da, also schließen und Flag negieren }
  364.    CloseConsole(Con1);                      { console zu }
  365.    Close_Window(SCWIN);                     { Fenster zu }
  366.  END { then }
  367.  ELSE
  368.  BEGIN
  369.    SCWINDOW := TRUE;                        { Fenster n. existent, also öffnen }
  370.    q := win^.leftedge; s:=win^.width;       { Abhängig vom Hauptfenster }
  371.    r := win^.wscreen^.width;                { Immer schön ordentlich neben dem Hauptfenster }
  372.                                             { Damit auch unter Dos 2.0 oder unter MegaWB alles läuft }
  373.    IF (q+s>r-WinX+WinX/5) THEN p := q-WinX-5{ links vom Fenster noch Platz ?}
  374.    ELSE p := q+s+5;                         { sonst eben rechts }
  375.    IF p<0 THEN REPEAT p:=p+5 UNTIL p>0;
  376.    IF p+WinX>r THEN REPEAT p:=p-5 UNTIL p+WinX<r;
  377. {$IF DEF Debug } { Zur Kontrolle auf die Console ausgeben }
  378.    Writeln('Sizes: ScoreWin:',p,' Game:',q,' Screen:',r);
  379. {$ENDIF }
  380.    q :=win^.topedge+14;                     { win ist Pointer auf das Haupfenster }
  381.    t := (FSize+1)*11;                       { Ohauer ? Ist der Default-Font zu gross ? Dos 2.0 ? }
  382.    if q+t>s then repeat Dec(q) until (q=0) or (q+t<=s); { Wenn ja Fenster vergrössern ..}
  383.    SCWIN :=  Open_Window(p,q, { Gleiche Höhe wie Hauptfenster }
  384.                          WinX,t,
  385.                          1,
  386.                          GADGETUP,Windowdrag+WindowDepth+RMBTrap, { Kein Resize }
  387.                          Nil,Nil,                                 { RMBTrap, damit kein hässlicher Balken erscheint, wenn }
  388.                          0,0,0,0);                                { jemand R-Mouse drückt }
  389.    { Auf das Fenster ! }
  390.    TStr:=' Get´em ! '+VERSION2+' A Game by M. Illenseer. ScoreWindow ';
  391.    SetWindowTitles(SCWIN,'  Get´em Scores  ',TStr);
  392.    SetPointer(SCWIN,MouseDat,8,8,-9,-4);
  393.    Con1 := OpenConsole(SCWIN);               { als Console öffnen }
  394.    WriteCon(Con1, NoCursor);                 { Cursor löschen }
  395.    HiPrint;                                  { Ausgabe der Scores }
  396.  END; { if scorewin }
  397. END; { Hilist }
  398.  
  399. PROCEDURE Iconify; Forward;
  400. { Tja, da in Iconify auch'n Aufruf einer Funktion ist, die noch nicht deklariert ist... }
  401. { muß ich wohl oder übel zum Forward greifen, ich habe keine Lust alles neu }
  402. { zu schreiben... }
  403.  
  404. FUNCTION ChkFeld:Byte;Forward;
  405. { Gilt auch hier... }
  406.  
  407.  
  408. PROCEDURE DrBlk(x,y:INTEGER,z:WORD);
  409. { Zeichnet einen Getem-Block an der Koordinate x,y ,wobei x,y umgerechnet }
  410. { werden auf Bildschirmkoordinate, wenn z>0dann wird gezeichnet, sonst  }
  411. { gelöscht. }
  412. VAR TX,TY:INTEGER;
  413. BEGIN { DrBlk }
  414.  IF (x >= 14) or (x <  0) or (y >= 14) or (y <  0) THEN
  415.  { Erstmal schauen, ob denn hier auch korrekte Werte ankommen... }
  416.    BEGIN
  417.     { Hier stand mal eine Error-Routine... Ist entfallen, da keine Fehler mehr }
  418.     { aufgetreten sind.... und ich habe vergessen WAS hier stand, ich hätte ja }
  419.     { wenigstens ein if def Debug drinlassen können ... :-)  }
  420.    END
  421.   ELSE
  422.    BEGIN
  423.      IF z>0 THEN
  424.          BEGIN { Block malen }              { XOffset=20, YOffSet=40, ImageXSize=21, ImageYSize=11 }
  425.          DrawImage(RP,                      { RastPort auf Window }
  426.                    ^Img[z],                 { Pointer auf zu malendes Image }
  427.                    20+x*21,40+y*11+BarHeight{ x und y umrechnen auf Window }
  428.                   );                        { So einfach ist das... :-) }
  429.          Feld[x,y] :=  z;                   { Und im Array auch setzen... }
  430.        END
  431.      ELSE
  432.        BEGIN { Block löschen }
  433.          IF GAMEON=True THEN BEGIN
  434.           DrawImage(RP,^Img[14],20+x*21,40+y*11+BarHeight);
  435.           Delay(1);
  436.          END;
  437.          DrawImage(RP,^Img[0],20+x*21,40+y*11+BarHeight); { Null-Block }
  438.          Feld[x,y] :=  0; { = gelöscht }
  439.        END
  440.    END
  441. END; { DrBlk }
  442.  
  443. PROCEDURE ClFeld;
  444. { Löschprozedur fuer Feld-ARRAY }
  445. VAR x,y:INTEGER;
  446. BEGIN { ClFeld }
  447.   FOR y :=  0 TO 13 DO
  448.    FOR x :=  0 TO 13 DO
  449.     Feld[x,y] :=  0;                        { Wenn 0, dann leer }
  450. END; { ClFeld }
  451.  
  452. PROCEDURE DrFeld;
  453. { Male gesamtes Feld }
  454. VAR x,y:INTEGER;
  455. BEGIN { DrFeld }
  456.  FOR y :=  0 TO 13 DO
  457.    FOR x :=  0 TO 13 DO
  458.      BEGIN
  459.        DrBlk(x,y,Feld[x,y]);                { Aufruf Malen eines Blocks }
  460.      END
  461. END;
  462.  
  463. {$IF DEF Debug }
  464. PROCEDURE WrFeld;
  465. { Kontrollprozedur für Feld, nur wichtig, wenn Debug gesetzt }
  466. VAR x,y:INTEGER;
  467.       z:STRING;
  468. BEGIN
  469.  Page;   { Bildschirm löschen }
  470.  FOR y :=  0 TO 12 DO
  471.  BEGIN
  472.   FOR x := 0 TO 10 DO
  473.    WRITE(Feld[x,y]);                         { Ausgabe vom Feld }
  474.   WRITELN;
  475.  END
  476. END;
  477. {$ENDIF }
  478.  
  479. FUNCTION SomethingPressed(quest:BOOLEAN):INTEGER;
  480. { Abfrage auf Gadgets und Events allgemein. Jedes Gadget wird hier abgefragt, }
  481. { auch Ticks werden zurückgegeben. Ist quest=TRUE dann wird auf eine Msg }
  482. { gewartet. Sonst geht das Spiel weiter. Zurückgegeben wird eine Zahl, die }
  483. { Info über das gedrückte Gadget liefern und auch TastenCodes angibt. }
  484. { Siehe auch Constantendeklaration. Als Globale Variable gibt Key den Wert }
  485. { der zuletzt gedrückten Taste aus. }
  486.  
  487. VAR class,                                  { (Art) Klasse der Message }
  488.     gadid,                                  { ID - Nummer des Gadget }
  489.     gadadd,
  490.     code:INTEGER;                           { Tastendruck }
  491.  
  492.  BEGIN { SomethingPressed }
  493.      SomethingPressed :=  NOTHING; { Default von -1, damit wenigstens etwas rauskommt }
  494.  
  495.      IF quest = WAIT THEN Msg :=  Wait_Port(Win^.UserPort); { Warten BIS eine Message kommt, aber kein busy-Wait ! }
  496.      Msg :=  Get_Msg(Win^.UserPort); { Message abfragen, kommt aus dem Window Meldung? }
  497.  
  498.      IF NOT(Msg = Nil) THEN  { Ne Message da ? }
  499.       BEGIN { Keine Meldung: Msg = NIL }
  500.         Case Msg^.Class OF                  { Class = Was wurde gedrückt ? Geht gut mit Case }
  501.           _CLOSEWINDOW: BEGIN ENDE :=  TRUE; SomethingPressed :=  0 END;
  502.               { Closewindow sollte Spiel beenden }
  503.           GADGETUP,GADGETDOWN: { Ein Gadget wurde gedrückt! (oder wieder losgelassen) }
  504.                 BEGIN
  505.                   AktGad :=  Msg^.IAddress; { Pointer auf Addresse von Gadget }
  506.                   Case AktGad^.GadgetID OF  { welches Gadget? Nummer }
  507.                    1: { 1. Gadget = Start }
  508.                         SomethingPressed :=  START;
  509.                    2: { 2. Gadget = ICONIFy  }
  510.                         Somethingpressed :=  ICON;
  511.                    3: { 3. Gadget = Stop }
  512.                         SomethingPressed :=  Stop;
  513.                    4: { 4. Gadget = ReGo  }
  514.                         SomethingPressed :=  REGO;
  515.                    5: { 5. Gadget = Score  }
  516.                         SomethingPressed :=  SCOR;
  517.                   Otherwise; { Nix ansonsten... Mehr hamwa nich }
  518.                   END  {  inneres CASE für Nummer Gadget }
  519.                 END;
  520.           RAWKEY: { Also kein gadget, sondern ne Taste }
  521.                 BEGIN
  522.                   SomethingPressed :=  Taste;
  523.                   Key :=  Msg^.Code;
  524.                 END;
  525.           INTUITICKS: { Keine User-Eingabe, sondern ein SystemTick (=1/50 sekunde }
  526.                 BEGIN
  527.                   SomethingPressed :=  TICK;
  528.                 END;
  529.           ACTIVEWINDOW: { Wenn das Fenster verlassen wurde, müssen die Gadgets }
  530.                         { re-initialisiert werden. }
  531.                 BEGIN
  532.                   RefreshGadgets(Win^.FirstGadget, Win, Nil);
  533.                   SomethingPressed :=  WINACT;
  534.                 END;
  535.           INACTIVEWINDOW: { Fenster wird verlassen, Gadgets refreshen }
  536.                 BEGIN
  537.                   RefreshGadgets(Win^.FirstGadget, Win, Nil);
  538.                   SomethingPressed :=  WININACT;
  539.                 END;
  540.           MOUSEBUTTONS: { Achja, ne Maustaste haben wir auch noch ! }
  541.                 IF (Msg^.Code and $80) = 0 THEN    { Hier wird der Code mit $80 ge-and-et , das liefert ne 0 wenn ne Taste gedrückt wurde }
  542.                      BEGIN
  543.                        CASE Msg^.Code OF
  544.                         104: SomethingPressed := LEFT;
  545.                         106: SomethingPressed := MIDDLE; { !!! Mittlere Maustaste ! Wird nicht benötigt}
  546.                         105: SomethingPressed := RIGHT;
  547.                        end;
  548.                      END;
  549.      Otherwise; { Nix. Mehr will ich ja nicht }
  550.     END; {  OF CASE für Was wurde gedrückt? }
  551.     Reply_Msg(Msg);   {Die Message zurueckgeben}
  552.   END; { Not Msg = NIL }
  553.   IF BREAK(1) THEN BEGIN WRITELN('Getem: ** User Break with Ctrl-C!'); Goto TheEnd; End;
  554.   IF BREAK(2) THEN BEGIN WRITELN('Getem: ** User Break with Ctrl-D!'); Goto TheEnd; End;
  555.   { Ach! Hier wird das Label TheEnd benötigt ! Hier wird ein User-Break abge- }
  556.   { fragt. Wenn von Cli aufgerufen, und mit 'Break Task-# [cd]' gestoppt }
  557.  END; { SomethingPressed }
  558.  
  559. PROCEDURE Ausgabe(t: Str;x,y:INTEGER);
  560. { gibt den Text "t" im Window-Getem an Position x,y aus  }
  561. VAR it: IntuiText;
  562. BEGIN
  563.    it :=  IntuiText(1,0,1,0,0,^Myfnt,t,Nil);   { Hab ich kein Bock zu erklären }
  564.    PrintIText(RP, ^it, x,y+BarHeight)          { PrintIText = GfxText oder Text, kollidiert mit Pascal-Typ 'TEXT' }
  565. END;
  566.  
  567.  
  568. PROCEDURE InitDemo; { Die Demo wird nur ganz am Anfang gebraucht...(vor Laden) }
  569. BEGIN
  570.  ClFeld; { Lösche Feld }
  571.     FOR y :=  1 TO 13 do
  572.       FOR x :=  Random(10) downto 0 Do
  573.         Feld[y,13-x] :=  Random(8);         { Ein Zufallswert 0..7 }
  574.  DrFeld;
  575. END;
  576.  
  577. PROCEDURE Demo;
  578. Var a,b:integer;
  579.     w:string;
  580. { Eine kleine Demo der purzelnden Blöcke... }
  581. BEGIN { Demo }
  582. {$IF def debug }   { CONST DEBUG ist ganz oben zu setzen !!! }
  583.    WrFeld;
  584. {$ENDIF } { Dieses debug stammt noch aus den Anfangszeiten, als Getem immer }
  585.            { wieder abschmierte... da die Pointer mal wieder ins Nil zeigten... }
  586.    IF AnzLev=0 THEN
  587.       DrBlk(Random(14),Random(14),Random(8))
  588.       { ^ Diese Zeile macht ne gaaanz einfache Demo ... mir zu doof ! :-) }
  589.    ELSE Begin
  590.     FOR a :=  0 TO 13 do
  591.        FOR b :=   0 TO 13 do
  592.         IF ord(Cpy^.lev[a*14+b])<>10 THEN { Aktueller Level von Cpy wird ausgeben }
  593.           Feld[a,b] :=  ord(Cpy^.lev[a*14+b]) - 48
  594.         ELSE
  595.           Feld[a,b] :=  7;
  596.     DrFeld;
  597.     Ausgabe('                                                ',5,29);
  598.     w :=Copy(Cpy^.Name,1,50); { Aktuellen Levelname ausgeben }
  599.     Ausgabe(w,10,29);
  600.     Cpy:=Cpy^.Next; { Weiterpushen... }
  601.    End; {If}
  602. END; { Demo }
  603.  
  604. PROCEDURE Helproutine;
  605. { A little Window with some Hints for the Game }
  606. { Man drücke 'HELP'-Taste oder gebe Parameter ? an }
  607. VAR w : ^Window; { Windowpointer }
  608.     i,a,b : INTEGER; { Laufvariablen }
  609.     st : STRING; { Ausgabestring }
  610.  
  611. PROCEDURE pr(t:Str;x,y,col:INTEGER);
  612. { Unterprocedure zur Ausgabe im Help-fenster }
  613. VAR it: IntuiText;
  614.   BEGIN
  615.     it :=  IntuiText(col,0,1,0,0,^Myfnt,t,Nil);
  616.     PrintIText(W^.RPort, ^it,x,y+BarHeight);
  617.   END;
  618.  
  619. BEGIN { Kein Kommentar }
  620.   a :=  Win^.LeftEdge;b :=  Win^.TopEdge;
  621.   w :=  Open_Window(25,25,410,200+BarHeight,1,_CLOSEWINDOW+RAWKEY,
  622.        WINDOWDRAG+WINDOWCLOSE+ACTIVATE+WINDOWDEPTH+RMBTRAP,Nil,Nil,0,0,0,0);
  623.   TStr:=' Get´em ! '+VERSION2+' A Game by M. Illenseer. HelpWindow';
  624.   SetWindowTitles(w,'    Get´em - Help & Hints',TStr);
  625.   SetPointer(w,BusyMDat,8,8,-9,-4);
  626.   SetPointer(win,BusyMDat,8,8,-9,-4);
  627.   FOR i :=  1 TO 18 do
  628.   DrawImage(W^.RPort,^Img[Random(12)+1],i*20,185+BarHeight);
  629.   { Ab hier nun Ausgabe.. sieht kompliziert aus .. }
  630.   st :=  VERSION2; pr(st,6,2,1);
  631.   st :=  'Amiga-Version made by Markus Illenseer. ';pr(st,6,11,2);
  632.   st :=  'Well, all you have to do is to move the small';pr(st,5,20,1);
  633.   st :=  'boxes together, to disappear them automagically. ';pr(st,5,30,1);
  634.   st :=  'The problem: Mostly there are only 2 or 4 boxes' ;pr(st,5,40,1);
  635.   st :=  'of same type, but sometimes there are 3 boxes ';pr(st,5,50,1);
  636.   st :=  'to be disappear... So, have a look at right, there';pr(st,5,60,1);
  637.   st :=  'is a list of all pieces during a level. You must';pr(st,5,70,1);
  638.   st :=  'use the mouse to select the box to move. The ';pr(st,5,80,1);
  639.   st :=  'boxes move only left and right.';pr(st,5,90,1);
  640.   st :=  'Remember, that you can disappear 3 boxes at the';pr(st,5,100,1);
  641.   st :=  'same time! You finish a level, if theres is no';pr(st,5,110,1);
  642.   st :=  'more box. Have care with falling boxes, they';pr(st,5,120,1);
  643.   st :=  'allways fall straight down. In this Version,';pr(st,5,130,1);
  644.   st :=  'there is no limit of time. Use the ReGo-Knob!';pr(st,5,140,1);
  645.   st :=  'Have luck & fun ! Try "Getem -?" for more Docs! ';pr(st,5,150,3);
  646.   st :=  'EMail me, when you want to get Updates or Hints:';pr(st,5,160,2);
  647.       pr(' markus@TechFak.Uni-Bielefeld.de ',6,170,3);
  648.   REPEAT { Somethingpresed ist nicht gut hier, da neues Fenster... }
  649.       Msg :=  Wait_Port(w^.UserPort); { KEIN Busy Loop ! }
  650.       IF Msg<>Nil THEN
  651.         BEGIN
  652.           Msg :=  Get_Msg(w^.UserPort);
  653.           Reply_Msg(Msg)
  654.         END;
  655.   UNTIL (Msg^.class = _CLOSEWINDOW) OR (Msg^.Code in [69,95]) or (Break(1)) or (Break(2));
  656.   Close_Window(W);
  657.   SetPointer(win,MouseDat,8,8,-9,-4);
  658. END;
  659.  
  660. PROCEDURE InterKey;
  661. { Interpretiere Keyboardinput in Window, war mal länger in den Anfangszeiten ... }
  662. BEGIN
  663. {$IF Def Debug }
  664.  WRITELN(" Key: ",key);
  665. {$ENDIF }
  666.  IF key = 23 THEN iconify;     { 'i'-Taste }
  667.  IF key = 95 THEN Helproutine; { HELP-Taste }
  668.  IF key = 69 THEN ;            { ESC - Taste }
  669. END;
  670.  
  671. FUNCTION ChkFeld;
  672. { Prüft Feld bzw. Level , und gibt 1 zurück, wenn alles leer }
  673. { 3 für beendet, aber noch nicht alle verschwunden  }
  674. { 2 für beendet, aber Feld nicht leer (D.h. ReGo ist angesagt :-) }
  675. VAR a,b,c,d,e,s:INTEGER;f:BOOLEAN;
  676. BEGIN
  677.  c :=  0;f :=  FALSE;s :=  0;
  678.  FOR a :=  0 TO 13 DO FOR b :=  0 TO 13 do
  679.   IF (Feld[a,b]<>0)AND(Feld[a,b]<>7) THEN c :=  c+1;
  680.  IF (c = 0) THEN
  681.    { Wenn diese Zahl geändert wird, dann ist der Level einfacher...! }
  682.    { Schummeln gilt nicht !  :-) }
  683.  BEGIN
  684.     ChkFeld :=  1 { Feld leer ! }
  685.  END
  686.  ELSE
  687.  BEGIN
  688.   FOR a :=  0 TO 12 do
  689.    FOR b :=  0 TO 12 do
  690.     BEGIN { Test auf Nachbarn }
  691.        e :=  Feld[a,b];
  692.        IF (e<>0)AND(e <  7)AND(e = Feld[a+1,b]) THEN { Rechts }
  693.        BEGIN
  694.         DrBlk(a,b,0); { Lösche Block an aktueller Stelle }
  695.         DrBlk(a+1,b,0); { Und den Nachbarn auch .. }
  696.         f :=  TRUE;
  697.         s :=  s+1;
  698.        END;
  699.        IF (e<>0)AND(e <  7)AND(e = Feld[a,b+1]) THEN { Unten }
  700.        BEGIN
  701.         DrBlk(a,b,0);
  702.         DrBlk(a,b+1,0);
  703.         f :=  TRUE;
  704.         s :=  s+1;
  705.        END;
  706.     END;
  707.   FOR b :=  0 TO 12 do
  708.     BEGIN { Test auf Nachbarn }
  709.        e :=  Feld[13,b];
  710.        IF (e<>0)AND(e <  7)AND(e = Feld[13,b+1]) THEN { Unten,ganz rechts }
  711.        BEGIN
  712.         DrBlk(13,b,0);
  713.         DrBlk(13,b+1,0);
  714.         f :=  TRUE;
  715.         s :=  s+1;
  716.        END;
  717.     END;
  718.   FOR a :=  0 TO 12 do
  719.     BEGIN { Test auf Nachbarn }
  720.        e :=  Feld[a,13];
  721.        IF (e<>0)AND(e <  7)AND(e = Feld[a+1,13]) THEN { Rechts,ganz unten }
  722.        BEGIN
  723.         DrBlk(a,13,0);
  724.         DrBlk(a+1,13,0);
  725.         f :=  TRUE;
  726.         s :=  s+1;
  727.        END;
  728.     END;
  729.   { IF s = 1 THEN Begin Beep(2);s :=  0 END;} { Nur sinnvoll, wenn ein 2. Soundmodul existiert }
  730.   FOR a :=  0 TO 13 DO { Let them purzel ! }
  731.    FOR b :=  0 TO 12 do
  732.      IF (Feld[a,b]<>0)AND(Feld[a,b] <  7) THEN
  733.       IF Feld[a,b+1] = 0 THEN
  734.       BEGIN
  735.        d :=  Feld[a,b];e :=  b;
  736.        REPEAT
  737.         DrBlk(a,e,0); { An aktueller Position löschen }
  738.         DrBlk(a,e+1,d); { Und einen tiefer neu malen.. er ist gefallen ! }
  739.         f :=  TRUE;
  740.         s :=  s+1;
  741.         Delay(1);       { Fallverzögerung } { Kann verändert werden... }
  742.         e :=  e+1;
  743.        UNTIL (e >= 13) or (Feld[a,e]<>0)OR(Feld[a,e]<>7);
  744.       END;
  745.  {IF s=1 THEN Beep(2); } { Nur wenn ein 2. Sound installiert wird, sinnvoll }
  746.   ChkFeld :=  2; { Beendet, aber Feld nicht leer }
  747.  END; { IF }
  748.  IF f = TRUE THEN ChkFeld :=  3; { Noch nicht beendet }
  749. END;
  750.  
  751. PROCEDURE PrScr;
  752. { Ausgabe aller möglichen Sachen. So die Zeit, die Anzahl der Blöcke. }
  753. VAR a,b:INTEGER;c:ARRAY[0..13] OF INTEGER;t:STRING;
  754. BEGIN
  755.  FOR a := 0 to 13 DO c[a] := 0;
  756.  FOR a :=  0 TO 13 do
  757.   FOR b :=  0 TO 13 do
  758.    c[Feld[a,b]] :=  c[Feld[a,b]]+1; { Zähle Blöcke eines jeden Typs }
  759.  FOR a :=  1 TO 6 do
  760.   BEGIN
  761.    t :=  Intstr(c[a])+' ';
  762.    Ausgabe(t,358,95+a*11); { Anzahl Blöcke des Typs c[a] (max 6) }
  763.   END;
  764.  t:=IntStr(Time div 600)+':'; {Time wird durch Ticks (=1/10 s !) gezählt }
  765.  IF ((Time mod 600) div 10) < 10 THEN  { Minutengrenze erreicht ? }
  766.   t := t+'0'+IntStr((Time mod 600) div 10)+' ' { Nein, also '0' vorweg }
  767.  ELSE
  768.   t := t+IntStr((Time mod 600)div 10)+' '; { Ja }
  769.  Ausgabe(t,330,184); { Zeit }
  770. END;
  771.  
  772. PROCEDURE InitLevel;
  773. { Zok! Neuer Level ! Natürlich nur, wenn Level existent, sonst Zufall-Level }
  774. VAR a,b:INTEGER;
  775.     w:string;
  776. BEGIN
  777.  IF Stufe = NIL THEN { Oh! Kein Level da ?! Kann nur passieren, wenn File nicht gefunden, oder aber falsches File..}
  778.  BEGIN
  779.     ClFeld;
  780.     FOR a :=  1 TO 13 do
  781.       FOR b :=  Random(10) downto 0 Do
  782.         Feld[a,13-b] :=  Random(8); { Zufall Blöcke, die 8 nicht ändern ! }
  783.     DrFeld;
  784.     Ausgabe('                                                 ',5,29);
  785.     w :='Random-Level. Maybe unsolvable !'; { Zufallslevel !}
  786.     Ausgabe(w,10,29);
  787.     HiPrint;
  788.     WHILE a = 3 DO a :=  ChkFeld;
  789.     a :=  3;
  790.     WHILE a = 3 DO a :=  ChkFeld;
  791.  END { No level file }
  792.  ELSE
  793.  BEGIN
  794.     FOR a :=  0 TO 13 do
  795.        FOR b :=   0 TO 13 do
  796.         IF ord(Stufe^.lev[a*14+b])<>10 THEN
  797.         { Wenn jemand ein Quatsch als Level-File genommen hat... }
  798.           Feld[a,b] :=  ord(Stufe^.lev[a*14+b]) - 48
  799.         ELSE
  800.           Feld[a,b] :=  7;
  801.         { ..dann wird eben eine Mauer genommen. }
  802.     DrFeld;
  803.     Ausgabe('                                                 ',5,29);
  804.     w :=Copy(Stufe^.Name,1,50); {Level-Name .. }
  805.     Ausgabe(w,10,29);
  806.     a :=  3;
  807.     HiPrint;  { Ausgabe Scores falls vorhanden }
  808.     WHILE a = 3 DO a :=  ChkFeld;
  809.  END; { Level file }
  810.  
  811.  Time :=  0; { Zeit pro Level }
  812. END; {  initLevel  }
  813.  
  814. PROCEDURE FunScroll;
  815. { Ein paar Gfx-Gags zur Show .. }
  816. Var a,b,c:integer;
  817.  
  818. BEGIN
  819.  SetBPen(rp,0);
  820.  SetAPen(rp,1);
  821.  b:=Random(12);
  822.  CASE b OF
  823.  1 :
  824.   For a:=1 to 25 Do Begin {Nach rechts rausscrollen }
  825.    ScrollRaster(rp,4,0,295,BarHeight,295+99,BarHeight+16);
  826.    Delay(1);
  827.   end;
  828.  2 :
  829.   For a:=1 to 25 Do Begin { Nach links rausscrollen }
  830.    ScrollRaster(rp,-4,0,295,BarHeight,295+99,BarHeight+16);
  831.    Delay(1);
  832.   end;
  833.  3:
  834.   For a:=1 to 16 Do Begin { Nach unten rausscrollen }
  835.    ScrollRaster(rp,0,1,295,BarHeight,295+99,BarHeight+16);
  836.    Delay(1);
  837.   end;
  838.  4:
  839.   For a:=1 to 18 Do Begin {Nach unten rausscrollen }
  840.    ScrollRaster(rp,0,-1,295,BarHeight,295+99,BarHeight+16);
  841.    Delay(1);
  842.   end;
  843.  5 :
  844.   For a:=1 to 25 do Begin { In der Mitte zusammenscrollen }
  845.    ScrollRaster(rp,4,0,295,BarHeight,(295+99+295) div 2,BarHeight+16);
  846.    ScrollRaster(rp,-4,0,(295+295+99) div 2,BarHeight,295+99,BarHeight+16);
  847.    Delay(1);
  848.   end;
  849.  6 :
  850.   For a:=1 to 25 do Begin { Zwei Hälften nach aussen scrollen }
  851.    ScrollRaster(rp,-4,0,295,BarHeight,(295+99+295) div 2,BarHeight+16);
  852.    ScrollRaster(rp,4,0,(295+295+99) div 2,BarHeight,295+99,BarHeight+16);
  853.    Delay(1);
  854.   end;
  855.  7 :
  856.   Begin          { 1000 Punkte malen }
  857.    SetAPen(rp,2);
  858.    For a:=1 to 99 * 16 DO
  859.     WritePixel(rp,295+Random(99),BarHeight+Random(16));
  860.   End;
  861.  8 :
  862.   Begin          { Ein paar schwarze Flecken erzeugen }
  863.    SetAPen(rp,1);
  864.    For a:=1 to 20 do begin
  865.     c:=Random(89);
  866.     RectFill(rp,295+c,BarHeight,295+c+Random(10),BarHeight+Random(16));
  867.     IF a mod 2=0 THEN Delay(1);
  868.    end;
  869.   end;
  870.  9 :
  871.   For a:=1 to 25 Do Begin { nach unten rechts rausscrollen }
  872.    ScrollRaster(rp,4,1,295,BarHeight,295+99,BarHeight+16);
  873.    Delay(1);
  874.   end;
  875.  0 :
  876.   For a:=1 to 25 Do Begin { nach oben links rausscrollen }
  877.    ScrollRaster(rp,-4,-1,295,BarHeight,295+99,BarHeight+16);
  878.    Delay(1);
  879.   end;
  880.  10 :
  881.   Begin { Kreise malen .. }
  882.    b:=Random(78)+295+10; c:=BarHeight+6;
  883.    SetAPen(RP,3);
  884.    DrawEllipse(RP,b,c,6,6);
  885.    For a:=6 downto 0 Do Begin
  886.     Delay(1);
  887.     SetAPen(RP,0);
  888.     DrawEllipse(RP,b,c,a+1,a+1);
  889.     SetAPen(RP,3);
  890.     DrawEllipse(RP,b,c,a,a);
  891.    End;
  892.    SetAPen(RP,0);
  893.    WritePixel(RP,b,c);
  894.   end;
  895.  11 :
  896.   Begin { Floh im Spielfeld }
  897.    GameOn := True;
  898.    c:=Random(13);
  899.    For a:=1 to 13 do Begin
  900.     b:=random(13);
  901.     DrBlk(a,b,c);
  902.     DrBlk(a,b,0);
  903.    End;
  904.    GameOn := False;
  905.   End;
  906.  Otherwise ; { Nothing }
  907.  END;
  908.  
  909.  SetAPen(rp,0); { Alten Zustand herstellen }
  910.  RectFill(rp,296,BarHeight,295+99,BarHeight+16);
  911.  SetAPen(rp,1); { Altes Image malen }
  912.  RectFill(rp,296,BarHeight+2,295+99,BarHeight+16);   { Schatten Getem-Image }
  913.  SetAPen(rp,2);
  914.  DrawImage(RP,^Getem,295,BarHeight);                 { Getem-Image }
  915. END; { FunScroll }
  916.  
  917. PROCEDURE Game;
  918. { Diese Prozedur steuert den Ablauf des Spiels, d.h. verarbeitet Eingabe und }
  919. { steuert die Ausgabe. }
  920.  
  921. VAR chk:byte; { Flag für Feldzustand }
  922.     D,F,Button:BOOLEAN; { Flags für Levelzustand }
  923.     FeldCopy,Feldicfy:Spiel; { Kopien des aktuellen Spielzustand }
  924. BEGIN
  925.  GameOn := False;
  926.  OffGadget(^Gad1,win,NIL); { Gadgets schalten ..}
  927.  OnGadget(^Gad3,win,NIL);  { Wenn gespielt wird, kann nur 'Stop', 'ReGo' und 'Score' gedrückt werden }
  928.  OnGadget(^Gad4,win,NIL);
  929.  Stufe :=  First;          { 1. Level }
  930.  InitLevel;
  931.  FeldCopy :=  Feld;
  932.  FeldIcfy :=  Feld;        { Nach De-Iconifizierung letzten Spielzustand herstellen !}
  933.  Button :=  FALSE;D :=  FALSE;F :=  FALSE;
  934.  PX :=  -1;PY :=  -1;P :=  0;  { PX = MousePointerX .. }
  935.  REPEAT { Game }
  936.   Q :=  SomethingPressed(WAIT);   { Q wie Query }
  937.   IF (Q = LEFT)OR(Q = RIGHT) THEN
  938.    BEGIN
  939.      Button :=  TRUE;
  940.      PosX :=  (Win^.MouseX-20) div 21; { Offset zur Maus wird berechnet }
  941.      PosY :=  (Win^.MouseY-40-BarHeight) div 11;
  942.      IF  (PosX <  14)AND(PosX >= 0)AND(PosY <  14)AND(PosY >= 0) THEN { Im Bereich ? }
  943.       BEGIN
  944.        IF (Feld[PosX,PosY]<>0) and (Feld[PosX,PosY]<>7) THEN
  945.         BEGIN  { Auch wirklich Block da ? }
  946.          IF D = FALSE THEN  { Ist Gerade ein Blockpaar gelöscht worden ? }
  947.          BEGIN
  948.            DrBlk(PX,PY,P-7); { Dann darf kein Block erneut gesetzt werden ! }
  949.            P :=  Feld[PosX,PosY];
  950.            PX :=  PosX;PY :=  PosY;
  951.            IF P <  7 THEN P :=  P+7;
  952.            DrBlk(PX,PY,P); { Andere Farbe }
  953.          END
  954.          ELSE { D = TRUE }
  955.          BEGIN
  956.            D :=  FALSE;
  957.            P :=  Feld[PosX,PosY];
  958.            PX :=  PosX;PY :=  PosY;
  959.            IF P <  7 THEN P :=  P+7;
  960.            DrBlk(PX,PY,P); { Andere Farbe }
  961.          END { IF D }
  962.         END;
  963.       END;
  964.    END;
  965.    IF (Button) and (d = FALSE) THEN { Mousebutton ? }
  966.     BEGIN
  967.        Button :=  FALSE;
  968.        IF (Q = LEFT) THEN { Links gedrückt }
  969.         BEGIN
  970.          IF (PX>0)THEN
  971.          IF (Feld[PX-1,PY] = 0) THEN { Kann ich nach links bewegen ? }
  972.           BEGIN
  973.            GameOn := True;
  974.            DrBlk(PX,PY,0); { Löschen }
  975.            GameOn := False;
  976.            DrBlk(PX-1,PY,P); { Neu an neuer Stelle }
  977.            PX :=  PX-1;
  978.           END; { Kann LEFT }
  979.         END; { Left }
  980.        IF (Q = RIGHT) THEN { Rechts gedrückt }
  981.         BEGIN
  982.          IF (PX <  13) and (PX >= 0) THEN
  983.          IF (Feld[PX+1,PY] = 0) THEN { Kann ich nach Rechts bewegen ? }
  984.           BEGIN
  985.            GameON := True;
  986.            DrBlk(PX,PY,0); { Löschen }
  987.            GameON := False;
  988.            DrBlk(PX+1,PY,P); { Neu an neuer Stelle }
  989.            PX :=  PX+1;
  990.           END; { Kann RIGHT }
  991.         END; { RIGHT ? }
  992.       END; { Button ? }
  993.      {  Now check IF it can fall ...  }
  994.  
  995.      IF (PX<>-1)AND(D = FALSE) THEN { Wenn Mouse bewegt, und Block bewegt }
  996.      REPEAT
  997.       IF (PY <  13) THEN
  998.        IF Feld[PX,PY+1] = 0 THEN { Kann der aktuelle Block nach unten fallen ? }
  999.        BEGIN
  1000.         GameON := True;
  1001.         DrBlk(PX,PY,0); { Ja ! }
  1002.         GameOn := False;
  1003.         PY :=  PY+1;
  1004.         DrBlk(PX,PY,P);
  1005.         Delay(1);      { Fallverzögerung möglichst schnell, damit auch bei }
  1006.                        { Multitasking noch gut. Aber eben eine Verzögerung! }
  1007.        END
  1008.        ELSE F :=  TRUE;
  1009.      {  Now check IF same types come together.... }
  1010.       IF (PX <  13) THEN IF Feld[PX+1,PY] = P-7 THEN BEGIN DrBlk(PX,PY,0);DrBlk(PX+1,PY,0); Beep(1);D :=  TRUE; END;
  1011.       IF (PX>0) THEN IF Feld[PX-1,PY] = P-7 THEN BEGIN DrBlk(PX,PY,0);DrBlk(PX-1,PY,0); Beep(1);D :=  TRUE; END;
  1012.       IF (PY <  13) THEN IF Feld[PX,PY+1] = P-7 THEN BEGIN DrBlk(PX,PY,0);DrBlk(PX,PY+1,0); Beep(1);D :=  TRUE; END;
  1013.       IF (PY>0) THEN IF Feld[PX,PY-1] = P-7 THEN BEGIN DrBlk(PX,PY,0);DrBlk(PX+1,PY-1,0); Beep(1);D :=  TRUE; END;
  1014.       { schön kompakt, damit ich auch ja verwirre... }
  1015.      UNTIL (PY >= 13) or (D = TRUE) or (F = TRUE);
  1016.  
  1017.      IF (Q = TASTE)OR(Q = LEFT)OR(Q = RIGHT) THEN
  1018.       REPEAT Chk :=  ChkFeld UNTIL Chk<>3;
  1019.      IF (Chk = 1) THEN { Q :=  7; Alle schon runtergepurzelt heute ? }
  1020.      BEGIN
  1021.         If Time<>0 THEN Score := Trunc(360000/Time)  { Score berechnen, abhängig von Zeit }
  1022.                    ELSE Score :=0;  { Score ! }
  1023.         If Score> Stufe^.Score then Stufe^.Score := Score; { Neuer HiScore ? }
  1024.         Stufe :=  Stufe^.Next;
  1025.         { Level umhängen, eins weiter.. (Da Ringstruktur, kommt nach dem letzten immer wieder der 1. Level !}
  1026.         Inc(AktLev);
  1027.         If AktLev>AnzLev then AktLev:=1;
  1028.         InitLevel; {  Level geschafft  = > Nächsten Malen  }
  1029.         FeldCopy :=  Feld;Feldicfy :=  Feld;
  1030.         Chk :=  0;
  1031.      END;
  1032.      F :=  FALSE;
  1033.      IF Q = TICK THEN INC(time);
  1034.      PrScr; { Ausgabe des Scores etc.  }
  1035.      IF Q = REGO THEN { Restart } { Armer Kerl! Hat den Level vergeigt! :-) }
  1036.       BEGIN { Defaultwerte setzen, Zeit läuft weiter !! }
  1037.        Feld :=  FeldCopy;
  1038.        DrFeld;
  1039.        Button :=  FALSE;D :=  FALSE;F :=  FALSE;
  1040.        PX :=  -1;PY :=  -1;P :=  0;
  1041.       END;
  1042.      IF (Q = ICON) or (key = 23) THEN { IconIFy } { Flups! Der Boss gekommen ? }
  1043.       BEGIN
  1044.        iconIFy;
  1045.        Button :=  FALSE;D :=  FALSE;F :=  FALSE;
  1046.        PX :=  -1;PY :=  -1;P :=  0;
  1047.        OffGadget(^Gad1,win,NIL);  { Gadgets wieder herstellen }
  1048.        OnGadget(^Gad3,win,NIL);
  1049.        OnGadget(^Gad4,win,NIL);
  1050.       END;
  1051.      IF Q = SCOR THEN {  Show HighScores  }
  1052.       Begin HILIST; End;
  1053.      IF (Q = WININACT) and (BREAK(1) or BREAK(2)) THEN Goto TheEnd;
  1054.  
  1055.  UNTIL (Q in [STOP,0]) or (key=69); { Ende ? }
  1056.  OnGadget(^Gad1,win,NIL);   { Gadgets in Non-Spiel Zustand umschalten }
  1057.  OffGadget(^Gad3,win,NIL);
  1058.  OffGadget(^Gad4,win,NIL);
  1059.  GameOn := False;
  1060. END;
  1061.  
  1062. PROCEDURE Init(a,b:WORD);
  1063. { a,b sind Top und LeftEdge des Haupt-Fensters}
  1064. { Init deklariert alle Gadgets, Images und Fenster }
  1065. { ACHTUNG! Die meisten Variablen GLOBAL, sonst Konflikte mit Hauptprogramm möglich }
  1066. { Das betrifft vorallem die Strukturen von Gadgets und Windows ! }
  1067.  
  1068. VAR i : WORD;                   { Laufvariable }
  1069.    TxFnt,TxFnt2 : ^TextFont;    { FontStrukturen fuer SystemDefaultFont und eigenen Font }
  1070.    Lock : ^Long;                { Pointer für Sperren der Intuitionbase }
  1071.  
  1072. BEGIN { Init }
  1073.  
  1074. IF InitDone=FALSE THEN BEGIN
  1075.  
  1076.   Lock:=LockIBase(0); { Sperre IntuitionBase zur gefahrlosen Betrachtung derselben }
  1077.   BarHeight:=IntBase^.ActiveScreen^.WBorTop; { Unter Dos 2.0 kann die Höhe des Rahmens varieren ! }
  1078.   TxFnt := OpenFont(Intbase^.ActiveScreen^.Font);
  1079.   UnLockIBase(Lock);
  1080.  
  1081.   BarHeight := BarHeight+TxFnt^.tf_YSize;
  1082.   CloseFont(TxFnt);
  1083.   TxFnt2:=GfxBase^.DefaultFont;
  1084.   FSize:=TxFnt2^.tf_YSize;
  1085.   IF (FSize>10) THEN BEGIN
  1086.    MyFnt.ta_name := "topaz.font";
  1087.    MyFnt.ta_YSize := 8;
  1088.    MyFnt.ta_Style:=0;
  1089.    MyFnt.ta_Flags:=0;
  1090.   END;
  1091.  
  1092.   BarHeight := BarHeight+2;
  1093.  
  1094. END;
  1095.  
  1096.   { Main Window öffnen }
  1097.   Win :=  Open_Window(a,b,         { Offset zu 0,0 }
  1098.                       400,200+Barheight, { Maximale Größe }
  1099.                       1,           { Farbe 0, normal blau ? }
  1100.                       _CLOSEWINDOW+{ Abfrage auf CloseGadget }
  1101.                       GADGETUP+    { Abfrage auf GadgetDruck }
  1102.                       GADGETDOWN+  { und natürlich loslassen }
  1103.                       INTUITICKS+  { Ticks sollen auch abgefragt werden }
  1104.                       ACTIVEWINDOW+{ Ebenso wenn Fenster aktiviert wird }
  1105.                       INACTIVEWINDOW+ { Oder inaktiviert wird. }
  1106.                       RAWKEY+      { Tasten- und }
  1107.                       MOUSEBUTTONS { Mauesedrücke werden verlangt! }
  1108.                      ,WINDOWDRAG+  { Fenster darf verschoben werden }
  1109.                       WINDOWDEPTH+ { und nach hinten gedrückt werden }
  1110.                       WINDOWCLOSE+ { und geschlossen werden }
  1111.                       ACTIVATE+    { und aktiviert werden }
  1112.                       RMBTRAP,     { die rechte Maustaste wird anders abgefragt. }
  1113.                                    { Kein Menue !! }
  1114.                       '',          { Noch kein Text, wird unten gemacht ! }
  1115.                       Nil          { Pointer auf keinen Screen. Standard ist WB }
  1116.                       ,0,0,0,0);   { Kann nicht verkleinert werden... }
  1117.  
  1118.   rp :=  Win^.RPort; { RastPort-Zeiger auf window }
  1119.   SetAPen(rp,2);     { Nehme 3. Farbe }
  1120.   TStr1:='   Get´em '+VERSION2+' By M.Illenseer ©`90    ';
  1121.   TStr:=' Get´em ! '+VERSION2+' A Game by M. Illenseer. Programmed with Kickpascal 2.0 MainWindow';
  1122.   SetWindowTitles(win,TStr1,TStr);
  1123.        {  Hey! Wer diese Zeilen ^^ ändert macht sich Strafbar!! }
  1124.        {  Ich verweise auf die Dokumentation ! }
  1125.  
  1126. IF InitDone=False THEN BEGIN
  1127.  
  1128.   MouseDat := Ptr( Alloc_Mem(SizeOf(Plane),2 ));
  1129.   { Die Plane der Mouse braucht Speicher im Chip-Mem, die Daten für sie }
  1130.   { müßen mit 2 Nullen anfangen und beendet werden ... }
  1131.   MouseDat^:= Plane( 0,0,
  1132.                  %0000110000010000,%0000100000011000,
  1133.                  %0000011000100000,%0000010000110000,
  1134.                  %0000001101000000,%0000001001100000,
  1135.                  %0000000110000000,%0000000111000000,
  1136.                  %0000000111000000,%0000000110000000,
  1137.                  %0000001001100000,%0000001101000000,
  1138.                  %0000010000110000,%0000011000100000,
  1139.                  %0000100000011000,%0000110000010000,
  1140.                  0,0);
  1141.   { Sehr interessant ! Hier wird ein Mousezeiger für Getem definiert !}
  1142.   { Und zwar nur für das aktuelle Fenster ! (win) Die Daten sind in Planes}
  1143.   { aufgeteilt. Da es auf der Standard-WB deren nur 4 gibt, definiere ich }
  1144.   { 2 Planes. Die Farben kommen durch die verknüpfung dieser 2 Planes }
  1145.   { zustande: Farbe 0 : kein Plane gesetzt. Farbe 1 : Plane 1 gesetzt }
  1146.   { Farbe 2 : Plane 2 gesetzt und Farbe 3 : Beide Planes gesetzt. }
  1147.   { Die Planes kommen nacheinander dran, deshalb oben auch nebeneinander ... }
  1148.   { Änderungen sollten einfach sein... }
  1149.  
  1150.   { SetPointer(win,MouseDat,8,8,-9,-4); }
  1151.   { Befehl ist nach unten verlegt worden .. }
  1152.   { 8,8 setzt die Höhe und Breite der Mouse (obwohl eigentlich 16x8 groß !)}
  1153.   { Bitte beachten: Mouse darf in x-Richtung 16 nicht überschreiten ! }
  1154.   { -9,-4 setzt den Hot-Spot der Mouse (! Negativ zu 0,0 ganz links oben )}
  1155.  
  1156.   BusyMDat := Ptr( Alloc_Mem(SizeOf(Plane),2 ));
  1157.   { UhrZeiger.. 'Busy'-State }
  1158.   BusyMDat^:= Plane( 0,0,
  1159.                  %0000001110000000,%0000000000000000,
  1160.                  %0000110101100000,%0000001110000000,
  1161.                  %0001000100010000,%0000111111100000,
  1162.                  %0010000100001000,%0001111111110000,
  1163.                  %0010000100001000,%0001111111110000,
  1164.                  %0001000010010000,%0000111111100000,
  1165.                  %0000110001100000,%0000001110000000,
  1166.                  %0000001110000000,%0000000000000000,
  1167.                  0,0);
  1168.  
  1169.   {  Speicher für Getemblöcke reservieren:  }
  1170.   GetDat :=  Ptr( Alloc_Mem(SizeOf(GetPlane), 2) );   {  2 = "MEMF_CHIP"  }
  1171.   {  Bild initialisieren:  }
  1172.   GetDat^ :=  GetPlane { Mein schönes Logo ! }
  1173.   (%0000000000000000,%0000000000000000,%0000000000000000,%0000000000000000, %0000000000000000, %0000000000000000,
  1174.    %0000011111110000,%0111111111111100,%1111111111111110,%0000000111000000, %0111111111111100, %0111100000011110,
  1175.    %0011111111111100,%0111111111111100,%1111111111111110,%0000000111000000, %0111111111111100, %0111110000111110,
  1176.    %0111100000011110,%0111000000000000,%0000011100000000,%0000011100000000, %0111000000000000, %0111111001111110,
  1177.    %0110000000000110,%0111000000000000,%0000011100000000,%0000011100000000, %0111000000000000, %0111011111101110,
  1178.    %1110000000000000,%0111000000000000,%0000011100000000,%0000111000000000, %0111000000000000, %0111001111001110,
  1179.    %1110000000000000,%0111111110000000,%0000011100000000,%0000000000000000, %0111111110000000, %0111000110001110,
  1180.    %1110000001111110,%0111111110000000,%0000011100000000,%0000000000000000, %0111111110000000, %0111000000001110,
  1181.    %1110000000111110,%0111000000000000,%0000011100000000,%0000000000000000, %0111000000000000, %0111000000001110,
  1182.    %0110000000000110,%0111000000000000,%0000011100000000,%0000000000000000, %0111000000000000, %0111000000001110,
  1183.    %0111100000011110,%0111000000000000,%0000011100000000,%0000000000000000, %0111000000000000, %0111000000001110,
  1184.    %0011111111111110,%0111111111111100,%0000011100000000,%0000000000000000, %0111111111111100, %0111000000001110,
  1185.    %0000011111110110,%0111111111111100,%0000011100000000,%0000000000000000, %0111111111111100, %0111000000001110,
  1186.    %0000000000000000,%0000000000000000,%0000000000000000,%0000000000000000, %0000000000000000, %0000000000000000,
  1187.    %1111111111111111,%1111111111111111,%1111111111111111,%1111111111111111, %1111111111111111, %1111111111111111);
  1188.  
  1189.   {  Image-Struktur  }
  1190.   Getem :=  Image(0,0,  {  keine Verschiebung  }
  1191.              96,      {  Breite  }
  1192.              15,      {  Höhe  }
  1193.              1,       {  nur eine Plane  }
  1194.              GetDat,  {  Bilddaten  }
  1195.              1,2,     {  weißes Bild, schwarzer Hintergrund  }
  1196.              Nil);    {  kein weiteres Image  }
  1197.   Q :=  2;P :=  1; { wer diese Farbenkobination nicht mag, soll sie ändern }
  1198.   FOR i :=  0 TO 14 DO Dat[i] :=  Ptr( Alloc_Mem(SizeOf(Plane), 2) );
  1199.              {  2 = "MEMF_CHIP"  }
  1200.  
  1201.   Dat[0]^ :=  Plane(%0000000000000000,%0000000000000000, { Leeres Bild, zum schneller löschen }
  1202.                  %0000000000000000,%0000000000000000, { Und als Hintergrund }
  1203.                  %0000000000000000,%0000000000000000,
  1204.                  %0000000000000000,%0000000000000000,
  1205.                  %0000000000000000,%0000000000000000,
  1206.                  %0000000000000000,%0000000000000000,
  1207.                  %0000000000000000,%0000000000000000,
  1208.                  %0000000000000000,%0000000000000000,
  1209.                  %0000000000000000,%0000000000000000,
  1210.                  %0000000000000000,%0000000000000000);
  1211.   Dat[7] :=  Dat[0];
  1212.   Dat[1]^ :=  Plane(%0000000000000000,%0000000000000000, { Das ist der Getemblock ! }
  1213.                     %0111111111111111,%1110000000000000,    {  Quadrat  }
  1214.                     %0111000111111111,%1110000000000000,
  1215.                     %0111001111111111,%1110000000000000,
  1216.                     %0111011111111111,%1010000000000000,
  1217.                     %0111111111111111,%0010000000000000,
  1218.                     %0111111111111111,%0010000000000000,
  1219.                     %0111111111111111,%0010000000000000,
  1220.                     %0111111111110000,%0010000000000000,
  1221.                     %0111111111111111,%1110000000000000);
  1222.   Dat[8] :=  Dat[1];                     {^}
  1223.   Dat[2]^ :=  Plane(%0000000000000000,%0000000000000000, {  Kreuz  }
  1224.                     %0011110000000011,%1100000000000000,
  1225.                     %0000111100001111,%0000000000000000,
  1226.                     %0000001111111100,%0000000000000000,
  1227.                     %0000000011110000,%0000000000000000,
  1228.                     %0000001111111100,%0000000000000000,
  1229.                     %0000111100001111,%0000000000000000,
  1230.                     %0011110000000011,%1000000000000000,
  1231.                     %1111000000000001,%1100000000000000,
  1232.                     %1110000000000000,%1110000000000000);
  1233.   Dat[9] :=  Dat[2];
  1234.   Dat[3]^ :=  Plane(%0000000001100000,%0000000000000000, {  Dreieck  }
  1235.                     %0000000011110000,%0000000000000000,
  1236.                     %0000000111111000,%0000000000000000,
  1237.                     %0000001111111100,%0000000000000000,
  1238.                     %0000011111111110,%0000000000000000,
  1239.                     %0000111111111011,%0000000000000000,
  1240.                     %0001111111111101,%1000000000000000,
  1241.                     %0011111111111110,%1100000000000000,
  1242.                     %0111111111111000,%1110000000000000,
  1243.                     %1111111111111111,%1111000000000000);
  1244.   Dat[10] :=  Dat[3];
  1245.   Dat[4]^ :=  Plane(%0000000000000000,%0000000000000000, {  Kreis  }
  1246.                     %0000000000000000,%0000000000000000,
  1247.                     %0000000111111000,%0000000000000000,
  1248.                     %0000011111111110,%0000000000000000,
  1249.                     %0001111111111111,%1000000000000000,
  1250.                     %0011110011111111,%1100000000000000,
  1251.                     %0011111111111111,%1100000000000000,
  1252.                     %0001111111111111,%1000000000000000,
  1253.                     %0000011111111110,%0000000000000000,
  1254.                     %0000000111111000,%0000000000000000);
  1255.   Dat[11] :=  Dat[4];
  1256.   Dat[5]^ :=  Plane(%0011111110111111,%1000000000000000, {  Muster  }
  1257.                     %0011111110111111,%1000000000000000,
  1258.                     %0011111110000111,%1000000000000000,
  1259.                     %0011111110110111,%1000000000000000,
  1260.                     %0011111110110000,%0000000000000000,
  1261.                     %0000000000110111,%1000000000000000,
  1262.                     %0011011111110111,%1000000000000000,
  1263.                     %0011000000000111,%1000000000000000,
  1264.                     %0011111111011111,%1000000000000000,
  1265.                     %0011111111011111,%1000000000000000);
  1266.   Dat[12] :=  Dat[5];
  1267.   Dat[6]^ :=  Plane(%0011111111111111,%1100000000000000, {  Muster  }
  1268.                     %0001111001111111,%1000000000000000,
  1269.                     %0000011011111110,%0000000000000000,
  1270.                     %0000001111111100,%0000000000000000,
  1271.                     %0000000001110000,%0000000000000000,
  1272.                     %0000000111111100,%0000000000000000,
  1273.                     %0000011011111111,%0000000000000000,
  1274.                     %0000110111111111,%1000000000000000,
  1275.                     %0011100011111111,%1110000000000000,
  1276.                     %0111111111111111,%1111000000000000);
  1277.   Dat[13] :=  Dat[6];
  1278.   Dat[14]^ := Plane(%0100110011001000,%1000000000000000, {  Muster  }
  1279.                     %0010001010110001,%0000000000000000,
  1280.                     %0001010000110010,%0000000000000000,
  1281.                     %0000100101101000,%0000000000000000,
  1282.                     %0001010110100000,%0000000000000000,
  1283.                     %0010101101000100,%0000000000000000,
  1284.                     %0100000000100010,%0000000000000000,
  1285.                     %1011111110010000,%0000000000000000,
  1286.                     %0000010110001000,%1100000000000000,
  1287.                     %0000100001000000,%0010000000000000);
  1288.  
  1289.   FOR i :=  0 TO 6 DO      { Alle 6 Bilder init.  }
  1290.     Img[i] :=  Image(0,0,     {  keine Verschiebung  }
  1291.                   20,      {  Breite  }
  1292.                   10,      {  Höhe  }
  1293.                   1,       {  nur eine Plane  }
  1294.                Dat[i],     {  Bilddaten  }
  1295.                   2,1,     {  Bildfarbe,  Hintergrundfarbe  }
  1296.                   Nil);    {  kein weiteres Image  }
  1297.   Img[14] :=  Image(0,0,20,10,1,Dat[14],2,1,Nil); { Explosion }
  1298.   FOR i :=  7 TO 13 do
  1299.     Img[i] :=  Image(0,0,20,10,1,Dat[i],1,2,Nil);
  1300.  
  1301.  
  1302.  
  1303.    Gad1 :=  Gadget(NIL,           {  Gadget-Struktur: Nachfolger ist Gad2 }
  1304.                 20,BarHeight,        {  Position  }
  1305.                 32,14,         {  Größe  }
  1306.                 GADGHCOMP+GADGHIMAGE+GADGIMAGE,    {  Gadget hat Bild  }
  1307.                 RELVERIFY, {  Activation Flags  }
  1308.                 BOOLGADGET,    {  Typ  }
  1309.                 ^Imggad1,         {  Zeiger auf Imagestruktur = Start }
  1310.                 ^Imggad2,         {  Select-Image = Stop }
  1311.                 Nil,         {  Zeiger auf Text  }
  1312.                 0, Nil, 1, 0); {  Nummer 1  }
  1313.    IDt1 :=  Ptr(Alloc_Mem(SizeOf(ImgDatTyp),2));
  1314.    IDt1^ :=  ImgDatTyp(%11111111111111111111111111111111,
  1315.                        %10001111000000000000000000000001,
  1316.                        %10111111100110000000000000001101,
  1317.                        %11100001100110000000000000001101,
  1318.                        %11100000001111000000000000011111,
  1319.                        %10110000001111000000000000011111,
  1320.                        %10011000000110000000000000001101,
  1321.                        %10001100000110000111100101101101,
  1322.                        %10000110000110001101100111101101,
  1323.                        %10000011000110011001100110001101,
  1324.                        %11100011000110011001100110001101,
  1325.                        %10111110000110001101100110001101,
  1326.                        %10011100000011000110110110000111,
  1327.                        %11111111111111111111111111111111);
  1328.  
  1329.    Imggad1 :=  Image(0,0,32,14,1,IDt1,1,1,Nil);
  1330.    Imggad2 :=  Image(0,0,32,14,1,IDt1,1,3,Nil);
  1331.  
  1332.    Gad2 :=  Gadget(NIL,           {  Gadget-Struktur  }
  1333.                 25,BarHeight-(Barheight div 2)-6, {  Position  }
  1334.                 26,10,         {  Größe  }
  1335.                 GADGIMAGE+GADGHCOMP+GADGHIMAGE,    { Gadget hat Bild  }
  1336.                 RELVERIFY, {  Activation Flags  }
  1337.                 BOOLGADGET,    {  Typ  }
  1338.                 ^Imggad3,      {  Zeiger auf Imagestruktur = Icon }
  1339.                 ^Imggad4,      {  kein 2. Bild }
  1340.                 NIL,         {  kein Text  }
  1341.                 0, Nil, 2, 0); {  Nummer 2  }
  1342.    IDt2 :=  Ptr(Alloc_Mem(SizeOf(ImgDatTyp),2));
  1343.    IDt2^ :=  ImgDatTyp(%11111111111111111111111111000000,
  1344.                        %10000000000000000000000001000000,
  1345.                        %10111001110011110010010001000000,
  1346.                        %10010001000011010011010001000000,
  1347.                        %10010001000010010011010001000000,
  1348.                        %10010001000010010010110001000000,
  1349.                        %10010001000010010010110001000000,
  1350.                        %10111001110011110010010001000000,
  1351.                        %10000000000000000000000001000000,
  1352.                        %11111111111111111111111111000000,
  1353.                        %00000000000000000000000000000000,
  1354.                        %00000000000000000000000000000000,
  1355.                        %00000000000000000000000000000000,
  1356.                        %00000000000000000000000000000000);
  1357.  
  1358.  
  1359.    Imggad3 :=  Image(0,0,26,10,1,IDt2,1,1,Nil);
  1360.    Imggad4 :=  Image(0,0,26,10,1,IDt2,1,3,Nil);
  1361.  
  1362.    Gad3 :=  Gadget(NIL,           {  Gadget-Struktur: Nachfolger ist Gad2 }
  1363.                 60,BarHeight,        {  Position  }
  1364.                 32,14,         {  Größe  }
  1365.                 GADGHCOMP+GADGHIMAGE+GADGIMAGE,    {  Gadget hat Bild  }
  1366.                 RELVERIFY, {  Activation Flags  }
  1367.                 BOOLGADGET,    {  Typ  }
  1368.                 ^Imggad5,         {  Zeiger auf Imagestruktur = Start }
  1369.                 ^Imggad6,         {  Select-Image = Stop }
  1370.                 Nil, { ^Tex2, }         {  Zeiger auf Text  }
  1371.                 0, Nil, 3, 0); {  Nummer 3  }
  1372.    IDt3 :=  Ptr(Alloc_Mem(SizeOf(ImgDatTyp),2));
  1373.    IDt3^ :=  ImgDatTyp(%11111111111111111111111111111111,
  1374.                        %10001111000000000000000000000001,
  1375.                        %10111111100110000000000000000001,
  1376.                        %11100001100110000000000000000001,
  1377.                        %11100000001111000000000000000001,
  1378.                        %10110000001111000000000000000001,
  1379.                        %10011000000110000000000000000001,
  1380.                        %10001100000110000111000111110001,
  1381.                        %10000110000110001101100110011001,
  1382.                        %10000011000110011000110110001101,
  1383.                        %11100011000110011000110110011001,
  1384.                        %10111110000110001101100111100001,
  1385.                        %10011100000011000111100110000001,
  1386.                        %11111111111111111111111111111111);
  1387.  
  1388.    Imggad5 :=  Image(0,0,32,14,1,IDt3,1,1,Nil);
  1389.    Imggad6 :=  Image(0,0,32,14,1,IDt3,1,3,Nil);
  1390.  
  1391.    Gad4 :=  Gadget(NIL,           {  Gadget-Struktur: Nachfolger ist Gad2 }
  1392.                 100,BarHeight,        {  Position  }
  1393.                 32,14,         {  Größe  }
  1394.                 GADGHCOMP+GADGHIMAGE+GADGIMAGE,    {  Gadget hat Bild  }
  1395.                 RELVERIFY, {  Activation Flags  }
  1396.                 BOOLGADGET,    {  Typ  }
  1397.                 ^Imggad7,         {  Zeiger auf Imagestruktur = Start }
  1398.                 ^Imggad8,         {  Select-Image = Stop }
  1399.                 Nil,          {  Zeiger auf Text  }
  1400.                 0, Nil, 4, 0); {  Nummer 4  }
  1401.    IDt4 :=  Ptr(Alloc_Mem(SizeOf(ImgDatTyp),2));
  1402.    IDt4^ :=  ImgDatTyp(%11111111111111111111111111111111,
  1403.                     %10111110000000000001110000000001,
  1404.                     %10111111000000000111111000000001,
  1405.                     %10110001100000001100001100000001,
  1406.                     %10110000110000001100000000000001,
  1407.                     %10110001100000001100000000000001,
  1408.                     %10111110000011001100000000011001,
  1409.                     %10111100000111101100000001100111,
  1410.                     %10110110001100101100000001100111,
  1411.                     %10110011001111101100011101100111,
  1412.                     %10110001101100001100001101100111,
  1413.                     %10110001100110000110011101100111,
  1414.                     %10110001100011100011111100011001,
  1415.                     %11111111111111111111111111111111);
  1416.  
  1417.    Imggad7 :=  Image(0,0,32,14,1,IDt4,1,1,Nil);
  1418.    Imggad8 :=  Image(0,0,32,14,1,IDt4,1,3,Nil);
  1419.  
  1420.    Gad5 :=  Gadget(NIL,           {  Gadget-Struktur: Nachfolger ist Gad2 }
  1421.                 140,BarHeight,        {  Position  }
  1422.                 32,14,         {  Größe  }
  1423.                 GADGHCOMP+GADGHIMAGE+GADGIMAGE,    {  Gadget hat Bild  }
  1424.                 RELVERIFY, {  Activation Flags  }
  1425.                 BOOLGADGET,    {  Typ  }
  1426.                 ^Imggad9,         {  Zeiger auf Imagestruktur = Start }
  1427.                 ^Imggad10,        {  Select-Image = Stop }
  1428.                 NIL,              {  Zeiger auf Text  }
  1429.                 0, Nil, 5, 0); {  Nummer 5  }
  1430.    IDt5 :=  Ptr(Alloc_Mem(SizeOf(ImgDatTyp),2));
  1431.  IDt5^:=  ImgDatTyp(%11111111111111111111111111111111,
  1432.                     %10001111000000000000000000000001,
  1433.                     %10111111100000000000000000000001,
  1434.                     %11100001100000000000000000000001,
  1435.                     %11100000000000000000000000000001,
  1436.                     %10110000000000000000000000000001,
  1437.                     %10011000000000000000000000000001,
  1438.                     %10001100001110011110010011001111,
  1439.                     %10000110011000110011011011011011,
  1440.                     %10000011011000110011011110011111,
  1441.                     %11100011011000110011011100011001,
  1442.                     %10111110011000110011011000001101,
  1443.                     %10011100001110011110011000000111,
  1444.                     %11111111111111111111111111111111);
  1445.  
  1446.    Imggad9 :=  Image(0,0,32,14,1,IDt5,1,1,Nil);
  1447.    Imggad10:=  Image(0,0,32,14,1,IDt5,1,3,Nil);
  1448.  
  1449. END; {IF InitDone}
  1450.  
  1451.    SetPointer(win,MouseDat,8,8,-9,-4); { MausPointer MainWindow }
  1452.  
  1453.    SetAPen(rp,1);
  1454.    RectFill(rp,20,BarHeight+1,19+37,16+BarHeight); { Schatten für Gadgets }
  1455.    RectFill(rp,60,Barheight+1,60+37,16+Barheight);
  1456.    RectFill(rp,100,Barheight+1,100+37,16+Barheight);
  1457.    RectFill(rp,140,Barheight+1,140+37,16+Barheight);
  1458.    SetAPen(rp,3);
  1459.    RectFill(rp,19,Barheight-1,19+33,14+Barheight); { Untergrund für Gadgets }
  1460.    RectFill(rp,59,Barheight-1,60+33,14+Barheight);
  1461.    RectFill(rp,99,Barheight-1,100+33,14+Barheight);
  1462.    RectFill(rp,139,Barheight-1,140+33,14+Barheight);
  1463.    SetAPen(rp,2);
  1464.    AddGadget(Win, ^Gad1, Nil);  { Gadgets setzen }
  1465.    AddGadget(Win, ^Gad2, Nil);
  1466.    AddGadget(Win, ^Gad3, Nil);
  1467.    AddGadget(Win, ^Gad4, Nil);
  1468.    AddGadget(Win, ^Gad5, Nil);
  1469.    OffGadget(^Gad3,win,NIL);
  1470.    OffGadget(^Gad4,win,NIL);
  1471.  
  1472.    RefreshGadgets(Win^.FirstGadget, Win, Nil);
  1473.    SetAPen(rp,1);
  1474.    RectFill(rp,328,106+BarHeight,356,171+Barheight+2); { Schatten für Boxes }
  1475.    RectFill(rp,296,BarHeight+2,295+99,BarHeight+16);   { Schatten Getem-Image }
  1476.    SetAPen(rp,2);
  1477.    RectFill(rp,327,98+BarHeight-2,352,171+Barheight);  { Untergrund Boxes }
  1478.    DrawImage(RP,^Getem,295,BarHeight);                 { Getem-Image }
  1479.    DrawImage(rp,^Img[1],330,105+BarHeight);
  1480.    DrawImage(rp,^Img[2],330,116+BarHeight);
  1481.    DrawImage(rp,^Img[3],330,127+BarHeight);
  1482.    DrawImage(rp,^Img[4],330,138+BarHeight);
  1483.    DrawImage(rp,^Img[5],330,149+BarHeight);
  1484.    DrawImage(rp,^Img[6],330,160+BarHeight);
  1485.    Ausgabe("Boxes:",327,95);
  1486.    Ausgabe("Time:",327,175);
  1487.    SetAPen(rp,1);
  1488.    RectFill(rp,17,38+BarHeight+3,319+2,193+BarHeight+3); { Schatten Spielfeld }
  1489.    SetAPen(rp,2);
  1490.    RectFill(rp,16,38+BarHeight,316,193+BarHeight); { Untergrund Spielfeld }
  1491. END; { Init }
  1492.  
  1493.  
  1494. PROCEDURE Iconify;
  1495. { Wenn der Boss kommt... Damit wird das Fenster ganz klein ! }
  1496. { Hier erspare ich mir die Erklärungen, das ist nicht sauber programmiert ...}
  1497. VAR ww:^Window;
  1498.     a,b:INTEGER;
  1499.     Sc:Boolean;
  1500. BEGIN
  1501.  a :=  win^.leftedge;            { Merke Position des Fensters }
  1502.  b :=  win^.topedge;
  1503.  Close_Window(win);              { Ach so geht das ! }
  1504.  IF ScWindow THEN Begin HiList; sc := True; End Else Sc:=False;
  1505.  ww :=  Open_Window(a,b,84,Barheight-2,1,GADGETUP+GADGETDOWN+ACTIVEWINDOW+INACTIVEWINDOW+RAWKEY
  1506.        ,WINDOWDRAG+ACTIVATE+RMBTRAP,NIL,Nil,0,0,0,0);
  1507.  win :=  ww;                     { !!! Damit SomeThingPressed geht!! }
  1508.  SetAPen(ww^.RPort,3);
  1509.  IT :=  IntuiText(1,3,1,0,0,^MyFnt,'Get    ´em',Nil);
  1510.  AddGadget(ww, ^Gad2, Nil);  { 'Icon' }
  1511.  key :=0;
  1512.  REPEAT
  1513.    RectFill(ww^.RPort,2,2,82,BarHeight-4);
  1514.    PrintIText(ww^.RPort,^it,2,1);
  1515.    RefreshGadgets(ww^.FirstGadget,ww,Nil);
  1516.    Q :=  Somethingpressed(WAIT);
  1517.    IF (key in [69,23]) THEN Q :=  6;
  1518.  UNTIL (Q = 6);
  1519.  key :=  0;
  1520.  Close_Window(ww);
  1521.  Init(a,b); { Und neu aufmachen }
  1522.  DrFeld;
  1523.  IF Sc then HiList;
  1524. END; { Iconify }
  1525.  
  1526.  
  1527. PROCEDURE ChkParam;
  1528. { Prüfe auf Parameter... Naturlich nur wenn von CLI aufgerufen... }
  1529. VAR  s      :STRING; { Parameterstring }
  1530.      l,q    :LONG;   { Parameterstring-länge }
  1531.      a,b    :INTEGER;{ Laufvariablen }
  1532.      WStart :p_WBStartup; { Zeiger auf Startup-Message der WB }
  1533.  
  1534.  PROCEDURE Hilfe; { Ausgabe von text, wenn von CLI mit Paramter ? }
  1535.  Var s:string;
  1536.  BEGIN
  1537.   WRITELN(chr($9b),'3m',chr($9b),'33m',VERSION2);
  1538.   WRITELN('A Game by Markus Illenseer .',chr($9b),'32m');
  1539.   WRITELN;
  1540.   WRITELN('This Game is, up to this Version: ',VERSION2,' completely moved into the Public-Domain !');
  1541.   WRITELN('You can do with the Game whatever you want, if you include');
  1542.   WRITELN('my Name and the Doc-File !');
  1543.   WRITELN('All Rights for this Version reserved by Markus Illenseer, Germany.');
  1544.   WRITELN(chr($9b),'31m','IF you want any Update or Hint, use EMail:',chr($9b),'33m');
  1545.   WRITELN(chr($9b),'0m',' Domain:  markus@techfak.uni-bielefeld.de',chr($9b),'31m');
  1546.   WRITELN;
  1547.   WRITELN('The target of this Game is to let disappear all the small boxes.');
  1548.   WRITELN('To move a box, move the Mousepointer on it, then hit LEFT or RIGHT');
  1549.   WRITELN('Mousebutton. The Box will be hilited and moved to the side');
  1550.   WRITELN('you hit it. The boxes can only be moved to left and right.');
  1551.   WRITELN('Now you can move the hilited box with other Mousebutton without being');
  1552.   WRITELN('on the box with the Mousepointer.');
  1553.   WRITELN('As you will see, the boxes are falling straight downwards, if');
  1554.   WRITELN('there is no other box or wall (Solid Pieces) below them.');
  1555.   WRITELN('While falling, the box is looking left, right and (!) downwards for a box,');
  1556.   WRITELN('which is of the same type. If found, the matching boxes will disappear.');
  1557.   WRITELN;
  1558.   WRITELN(chr($9b),'33m','PRESS RETURN TO CONTINUE',chr($9b),'31m');
  1559.   Readln(s);
  1560.   WRITELN('The Problem is, that sometimes there are boxes of each type in');
  1561.   WRITELN('an odd number. Then you have to try to eliminate 3 boxes at the');
  1562.   WRITELN('time. (It´s easy !) Have a look at right, there is always');
  1563.   WRITELN('a list of the numbers of each type. There you can find the');
  1564.   WRITELN('odd types...');
  1565.   WRITELN;
  1566.   WRITELN('At ANY time, you can use the ICONify Gadget at the top.');
  1567.   WRITELN('This causes the window to be shrinked and moved to the left top.');
  1568.   WRITELN('Don´t bother, use ICON again to re-enter the Game.');
  1569.   WRITELN('It´s a sort of BOSS-Key!' );
  1570.   WRITELN;
  1571.   WRITELN('The Restart (ReGo)-Gadget is for trying the same Level once again');
  1572.   WRITELN;
  1573.   WRITELN('Stop the Game with STOP-Gadget.');
  1574.   WRITELN;
  1575.   WRITELN('Quit Game with Close-Gadget or hit ´ESC´ at any time.');
  1576.   WRITELN;
  1577.   WRITELN('Hit´n HELP-Key to get short help. ');
  1578.   WRITELN('Good luck, and much fun !');
  1579.   WRITELN;
  1580.   WRITELN(chr($9b),'33m','USAGE: ',chr($9b),'32m','Getem [-? -F LevelFile]',chr($9b),'31m');
  1581.   WRITELN('       -? to show this List.');
  1582.   WRITELN('       -F LevelFile (Optional Get´em LevelFile). ');
  1583.   WRITELN;
  1584.   WRITE(chr($9b),0,'m');
  1585.   Ende :=  TRUE;
  1586.  END;
  1587.  
  1588. BEGIN { ChkParam }
  1589. { Bekannte Parameter : '-?' '-F' }
  1590.  Load:='GetemLevels'; { Default Filename }
  1591.  IF FromWB=false THEN BEGIN { Kickpascal funktion,die angibt, ob von WB gestartet }
  1592.   s :=  Parameterstr;
  1593.   l :=  Parameterlen;
  1594.   FOR b := 1 to Length(s) DO s[b] := Upcase(s[b]);
  1595.   a :=  pos('?',s); { Hilfe erbeten ? }
  1596.   IF (a<>0) THEN Hilfe;
  1597.   a :=  pos('F',s); { optionaler Filename für Levelfile ? }
  1598.   IF (a<>0)AND(a<StrLen(s)) THEN BEGIN  { Parse Filenamen für Levels }
  1599.    IF s[a+1]=' ' THEN BEGIN { Suche nur, wenn ein Blank zwischen -f und Namen }
  1600.      b := a+2;Load := '';
  1601.      REPEAT { Lade Zeichen für Zeichen }
  1602.       Load := Load+s[b];
  1603.       b := b+1;
  1604.      UNTIL (b>=Length(s))OR(s[b]=' '); { Bis Blank gefunden, oder Ende erreicht }
  1605.    END;
  1606.   END;
  1607.   WHILE Load[1]=' ' DO { Lösche führende Blanks, sollte aber nicht vorkommen }
  1608.    Load := Copy(Load,2,StrLen(Load));
  1609.  END { Not FromWB }
  1610.  ELSE
  1611.  Begin { FromWB }
  1612.   WStart:=StartupMessage; { Kopiere die WB-Startup-Message }
  1613.   IF WStart^.sm_NumArgs < 2 THEN BEGIN { Wenn nur 1 Argument, dann wurde kein Parameter mit 'Shift-Click' übergeben }
  1614.    Load:='GetemLevels'; { DefaultFilename setzen }
  1615.     OLock:=CurrentDir(WStart^.sm_ArgList^[1].wa_Lock); { In das Direktory gehen, von wo aus Getem gestartet (WB !) wurde }
  1616.   END
  1617.   ELSE { Getem wurde mit Parameter aufgerufen ( 'Shift-Click' ) }
  1618.       WITH WStart^.sm_ArgList^[2] DO { Wir interpretieren die Argumentenliste }
  1619.         BEGIN
  1620.           { Als Datei wird das 2. Argument angenommen. Falls noch}
  1621.           { mehr Icons aktiviert sind,durch "Shift-Klick",       }
  1622.           { werden diese ignoriert.                              }
  1623.           Load := wa_Name; { Siehe auch Struktur WB-Startupmessage ! }
  1624.           { Nur reiner Name ohne Pfad! Deshalb müssen wir den Lock ausführen }
  1625.           OLock := CurrentDir( wa_Lock );
  1626.           { CurrentDir macht nix anderes als ein 'CD' im CLI ! }
  1627.         END;
  1628.  End;
  1629.  IF Load = '' THEN Load := 'GetemLevels'; { wenn nur Parameter f eingegeben, dann Default für Level }
  1630. END;
  1631.  
  1632.  
  1633. { ############################################################################### }
  1634.  
  1635.  BEGIN { ***************************** MAIN ****************************** }
  1636.   ENDE :=  FALSE;  { Falg für Spielende, reguläres Spielende }
  1637.   Demon := TRUE;   { Ist mal wieder Demo-Zeit ? }
  1638.   Gamen :=  FALSE; { Flag fuer Demo und ENDE setzen }
  1639.   PosX := 0;PosY := 0; { Mausposition }
  1640.   time := 1; { Zeitzähler }
  1641.   key := 0;  { Beinhält letzten Tastendruck }
  1642.   PX :=  -1;PY :=  -1;
  1643.   P :=  0;
  1644.   ScWindow := FALSE; { Kein ScoreWindow geöffnet }
  1645.   AktLev:=1; { Der Aktive Level ist der 1. }
  1646.   InitDone := False; { Die InitProzedur noch nicht durchlaufen }
  1647.   GameOn := False; { Wir sind noch nicht mitten im Spiel }
  1648.   ChkParam; { Parameter überprüfen und interpretieren }
  1649.   FOR P := 1 to 10 DO HiScore[p] := 0;
  1650.  
  1651.   OpenLib(IntBase,'intuition.library',0);
  1652.       { öffne Intuition für Zeichenbefehle }
  1653.   OpenLib(GfxBase,'graphics.library',0);
  1654.  
  1655.   IF not ENDE THEN
  1656.   BEGIN
  1657.    PX := 10; PY := 10;
  1658.    Init(PX,PY);  { Alle Fenster öffnen, Gadgets initialisieren }
  1659.    InitDone:=True;
  1660.    InitDemo; { Feld init. }
  1661.    DrFeld; { Feld malen }
  1662.    LoadLevels(PX,PY);  { Level laden }
  1663.    REPEAT { Endlosschleife, bis Ende }
  1664.     s :=  SomethingPressed(WAIT);
  1665.     IF s = START THEN
  1666.      BEGIN
  1667.        Gamen :=  NOT Gamen; { Inverse... }
  1668.      END;
  1669.     IF Gamen THEN { Spiel starten }
  1670.       BEGIN
  1671.        NoSound := NOT NoSound;
  1672.        Game;
  1673.        Gamen :=  NOT Gamen;
  1674.        NoSound := NOT NoSound;
  1675.       END; { Spiel starten }
  1676.     IF s = TASTE THEN InterKey; { Z.B Help ? }
  1677.     IF key = 69 THEN Ende :=  TRUE; { Jemand hat ESC gedrückt }
  1678.     IF s = TICK THEN INC(time); { Intuitick bekommen }
  1679.     IF s = WININACT THEN { Wenn Fenster nicht aktiv, dann warten bis wieder aktiv }
  1680.              REPEAT
  1681.               T:=SomethingPressed(WAIT);
  1682.               IF BREAK(1) or BREAK(2) THEN BEGIN ENDE:=True; T:=-77; END;
  1683.              UNTIL (T=WINACT) or (T=-77);
  1684.     IF s = ICON THEN { Iconify }
  1685.               Iconify;
  1686.     IF s = SCOR THEN {  Show HighScores  }
  1687.               begin HILIST; end;
  1688.     IF Anzlev >0 THEN Begin IF (s = TICK) and (time/60=time div 60) THEN Demo End { Nur Demo laufen lassen }
  1689.     ELSE IF (s = TICK) THEN Demo;
  1690.     IF Time/35=Time div 35 then FunScroll;
  1691.    UNTIL (ENDE = TRUE); { Spielende ! }
  1692. TheEnd: { Der berüchtigte Label :-) }
  1693.   IF SCWINDOW THEN  Close_Window(SCWIN);
  1694.   IF Not NoSound THEN EndPlay; {Schliesst Audio-Device, MODUL GetemSound }
  1695.   Close_Window(Win);{Fenster zu}
  1696.   CloseLib(IntBase);{Nix Intuition mehr}
  1697.   CloseLib(GfxBase);{Nix Grafik.. }
  1698. {  Eigentlich muß man hier den Speicher für die Images freigeben... }
  1699. {  Macht aber Run-Time Lib von Kickpascal, bei Umsetzung auf C beachten !  }
  1700.  END;
  1701. END. { *** Main *** }
  1702.  
  1703. {$opt t0,i0,b0,s0,a0                                                         }
  1704. { Optionen wieder einschalten auf Default                                    }
  1705.  
  1706. { *** Credits ***
  1707.  Tja. Soweit so gut. Ich hoffe hier ein paar neue Ideen geliefert zu haben.
  1708.  Eine Optimierung habe ich nicht vor. Das Spiel ist schnell genug.
  1709.  
  1710.  Wer will kann Sound zufügen, die Images verändern, das Ganze auf einem
  1711.  eigenen Screen laufen lassen, mit mehr Farben und schöneren Images oder
  1712.  Sprites. Oder Fahrstühle und Falltüren ausdenken. Oder, oder...
  1713.  Vorsicht mit den Images und den Gadgets. Wird hier was falsch gemacht
  1714.  so kann es zum Guru kommen. Das macht Spaß! :-(
  1715.                                                Kopf 90° links drehen!
  1716.  Dringend benötigt werden neue Levels. Meine Beigefügten sind mir langsam
  1717.  zu öde... Wie es geht, steht im Doc-File.
  1718.  Zum Schluß noch, wie man mich erreichen kann, und wo das Copyright liegt:
  1719.  
  1720.  EMAIL: (Geht janz fix!)
  1721.         markus@TechFak.Uni-Bielefeld.DE
  1722.  
  1723.  
  1724.  Snail-MAIL: (Schneckenpost) (Bin Schreibmuffel ... )
  1725.         Markus Illenseer
  1726.         Große Kurfürstenstr. 1
  1727.         D-4800 Bielefeld 1
  1728.         Germany
  1729.  
  1730.  © by Markus Illenseer 1990,1991.
  1731.     Die Source ist als Public-Domain freigegeben. Sie darf verändert
  1732.     und kopiert werden, solange mein Name und die Dokumentation
  1733.     enthalten bleibt. Mit dieser Source, mit dem daraus resultierenden,
  1734.     lauffähigen Programm und mit dem SoundFile darf KEIN Profit
  1735.     erwirtschaftet werden ! Dies gilt insbesondere für sogenannte
  1736.     PD/FD und PW Händler !!
  1737.  
  1738.     Portierungen auf andere Systeme sind erlaubt.
  1739.     (Sogar erwünscht! Ich bereite gerade eine Portierung für X11 vor. )
  1740.     Ich erbitte aber Kopien von Portierungen auf Fremdsysteme!  :-)
  1741.     Und auch Kopien von veränderter Source ...
  1742.  
  1743.  Kickpascal ® ist eingetragenes Warenzeichen der Maxon-GmBH ®
  1744.  Kickpascal is a product of the Himpire.
  1745.  
  1746.  Ganz zum Schluß: Gruß an  Himpel: Der Compiler ist gut! :-)
  1747.                             Massa: Danke für die Tips !
  1748.                            Medusa: Hatte die Idee mit größeren Blöcken...
  1749.                              Nick: Er wollte immer neue Levels schreiben...
  1750.                           StefanB: Half bei der WB 2.0 fähigen Version.
  1751.                            Richie: Wollte unbedingt Special-Effects ..
  1752.  }
  1753.  
  1754.