Turbo Toolbox/Turbo_Toolbox.iso/1987/08/fliege.inc

Text File | 1987-07-10 | 23.8 KB | 589 lines

(****************************************************************************)
(*                             FLIEGE.INC                                   *)
(*                       Prozeduren und Funktionen                          *)
(*                                                                          *)
(****************************************************************************)

(*--------------------------------------------------------------------------*)
(*                            mehrfach benoetigte                           *)
(*--------------------------------------------------------------------------*)

PROCEDURE OWNWRITE (CH: CHAR; SP,ZE: INTEGER) ;

BEGIN
   IF (SP IN [1..SPALTEN]) AND (ZE IN [1..ZEILEN])
   THEN BEGIN                      (* ausserhalb Schirm nicht zulassen *)
      IF (SP <> SPALTEN) OR (ZE <> ZEILEN)
      THEN BEGIN                   (* Punkt rechts unten nicht ausgeben *)
         GotoXY (SP,ZE) ;          (* Cursor positionieren, HOME ist 1,1 *)
                                   (* horizontal an SP, vertikal an ZE *)
         Write (CH) ;              (* und Zeichen ausgeben *)
      END ;
      SCHIRM [SP,ZE] := CH ;       (* internen Bildspeicher aufdatieren *)
   END ;
END ;                              (* OWNWRITE *)

(*..........................................................................*)

PROCEDURE OWNSOUND (FREQU,ZEIT: INTEGER) ;

BEGIN
   IF DAT_FILE [MITSOUND] = 'J'
   THEN SOUND (FREQU) ;            (* Geraeusch ausgeben *)
   IF ZEIT > 0
   THEN Delay (ZEIT) ;             (* warten, Zeit in Millisekunden *)
   IF DAT_FILE [MITSOUND] = 'J'
   THEN NOSOUND ;                  (* Geraeusch stoppen *)
(* CP/M-Version der Prozedur:
   WriteLn(Chr(BELL));
*)
END ;                              (* OWNSOUND *)

(*..........................................................................*)

FUNCTION JA_NEIN (ALT: CHAR) : CHAR ;

VAR                                (* fordert Eingabe von J oder N *)
   CH : CHAR ;                     (* eingelesener Character *)

BEGIN
   Write (' ( Ja / Nein / <Return> ) : ') ;
   Write (ALT) ;
   REPEAT
      Read (Kbd, CH) ;             (* lese ohne Echo *)
      IF CH = Chr (13)             (* bei Return *)
      THEN CH := ALT ;             (* alten Wert uebernehmen *)
      CH := UpCase (CH) ;          (* mache Grossbuchstabe *)
      Write (Chr(BACKSPACE),CH) ;  (* alten Wert ueberschreiben *)
   UNTIL (CH = 'J') OR (CH = 'N') ;
   JA_NEIN := CH ;                 (* und als Funktionswert uebergeben *)
END ;                              (* JA_NEIN *)

(*..........................................................................*)

PROCEDURE ZUFALLSRICHTUNG (ZUFALL: INTEGER; VAR WEM: BEWEGLICH) ;

VAR
   RI: INTEGER ;

BEGIN
   RI := Random (ZUFALL) ;              (* diese Art der Zuweisungen ist *)
   IF RI = 0 THEN WEM.RICHTUNG := LI ;  (* umstaendlich aber leichter zu *)
   IF RI = 1 THEN WEM.RICHTUNG := RE ;  (* verstehen als verschachtelte *)
   IF RI = 2 THEN WEM.RICHTUNG := HO ;  (* IF's, und CASE lohnt sich nur *)
   IF RI = 3 THEN WEM.RICHTUNG := RU ;  (* bei komplexeren Aktionen *)
END ;                              (* ZUFALLSRICHTUNG *)

(*..........................................................................*)

PROCEDURE GENERIERE (VAR WAS: BEWEGLICH) ;


VAR
   SP, ZE, VON, BIS: INTEGER ;

BEGIN
   VON := L_RAND + 1 ;             (* Grenzwerte, damit SP im *)
   BIS := R_RAND - 1 ;             (* Spielfeld liegt *)
   REPEAT
      ZE := Random (ZEILEN - 2) + 2 ;        (* ist in [1 .. ZEILEN-1] *)
      SP := Random (BIS - VON + 1) + VON ;   (* ist in [VON .. BIS] *)
   UNTIL (SCHIRM [SP,ZE] = Chr (SPACE)) ;
   WAS.Pos.S := SP ;               (* setze Position in Type BEWEGLICH *)
   WAS.Pos.Z := ZE ;
   ZUFALLSRICHTUNG (4, WAS) ;
END ;                              (* GENERIERE *)

(*..........................................................................*)

PROCEDURE START_WERTE ;

BEGIN
   PUNKTE := 0 ;
   P_S := Round ((SPALTEN / 2) - 2 ) ;
   P_Z := Round ((ZEILEN - 1 ) / 2 ) ;
   L_RAND := 2 ;
   R_RAND := SPALTEN - 1 ;
   WIEVIELE := Ord(DAT_FILE[ANZAHL]) - Ord('0') ;
   TRAEGE := 13 - (Ord(DAT_FILE[BEWEGE]) - Ord('0')) ;
   WARTEZAHL := (9 - (Ord(DAT_FILE[WARTEN]) - Ord('0'))) * 8 + 1 ;
   WIELANGE := (10 - (Ord (DAT_FILE [LAENGE]) - Ord ('0'))) ;
   WIELANGE := Round (MAXRUNDEN / WIELANGE) ;
END ;                              (* START_WERTE *)

(*..........................................................................*)

PROCEDURE START_BILD ;

(*                  lokale Prozeduren fuer START_BILD                       *)

PROCEDURE BOX (CH: CHAR; S_VON,Z_VON,S_BIS,Z_BIS: INTEGER; FILL: BOOLEAN) ;

VAR                                (* mache eine Box mit Begrenzung CH,     *)
   Z, S: INTEGER ;                 (* Grenzen seien S und Z, fuelle sie mit *)

BEGIN                              (* CH aus, wenn FILL true ist *)
   IF (S_VON <= S_BIS) AND (Z_VON <= Z_BIS)
   THEN BEGIN                      (* nur was machen, wenn Grenzen O.k. *)
      IF FILL = TRUE
      THEN                         (* mit fuellen Zeile fuer Zeile *)
         FOR S := S_VON TO S_BIS
         DO FOR Z := Z_VON TO Z_BIS
            DO OWNWRITE (CH,S,Z)
      ELSE BEGIN
         FOR S := S_VON TO S_BIS
         DO BEGIN
            OWNWRITE (CH,S,Z_VON) ;     (* oberer Rand *)
            OWNWRITE (CH,S,Z_BIS) ;     (* unterer Rand *)
            END ;
         FOR Z := Z_VON TO Z_BIS   (* Eckpunkte werden doppelt gezeichnet, *)
         DO BEGIN                  (* wodurch der Algorithmus einfacher ist *)
            OWNWRITE (CH,S_VON,Z) ;     (* linker Rand *)
            OWNWRITE (CH,S_BIS,Z) ;     (* rechter Rand *)
         END ;
      END ;
   END ;
END ;                              (* BOX *)

(*                                                                          *)

PROCEDURE OWNLOESCHE ;

VAR                                (* loescht Bildschirm und internen *)
   CH : CHAR ;                     (* Bildspeicher *)
   Z, S: INTEGER ;

BEGIN
   CH := Chr (SPACE) ;
   FOR Z := 1 TO ZEILEN
   DO FOR S := 1 TO SPALTEN
      DO SCHIRM [S,Z] := CH ;      (* loesche internen Bildspeicher *)
   ClrScr ;                        (* und jetzt Bildschirm tatsaechlich *)
END ;                              (* OWNLOESCHE *)

(*                       jetzt folgt START_BILD                             *)

BEGIN
   OWNLOESCHE ;
   BOX (Chr(GRENZE),L_RAND,1,R_RAND,ZEILEN,FALSE) ;
   BOX (Chr(MITTE),P_S-9,P_Z-2,P_S+9,P_Z+2,TRUE) ;
   GotoXY (P_S - 2, P_Z) ;         (* nur die Anzahl Punkte wird waehrend *)
   Write (PUNKTE:4) ;              (* des Spiels nicht mit OWNWRITE gesetzt *)
   GENERIERE (YOU) ;
   OWNWRITE (Chr(SPIELER), YOU.Pos.S, YOU.Pos.Z) ;
   FOR INDEX := 1 TO WIEVIELE
   DO BEGIN                        (* generiere gewaehlte Anzahl *)
      GENERIERE (FLY[INDEX]) ;
      WITH FLY[INDEX]
      DO OWNWRITE (Chr(FLIEGE), Pos.S, Pos.Z) ;
   END ;
END ;                              (* START_BILD *)

(*..........................................................................*)

FUNCTION AN_NEUER_POS (VAR SP, ZE: INTEGER; WEM: BEWEGLICH) : CHAR ;

BEGIN                              (* uebergibt char an vorraussichtlich *)
   WITH WEM                        (* neuer Position und diese in SP, ZE *)
   DO BEGIN
      SP := Pos.S ;
      ZE := Pos.Z ;
      IF RICHTUNG = LI THEN SP := SP - 1 ;   (* Vorteil dieser mehrfachen *)
      IF RICHTUNG = RE THEN SP := SP + 1 ;   (* IF ist, dass benoetigte *)
      IF RICHTUNG = HO THEN ZE := ZE - 1 ;   (* Zeit fast immer gleich ist *)
      IF RICHTUNG = RU THEN ZE := ZE + 1 ;
   END ;
   AN_NEUER_POS := SCHIRM [SP,ZE] ;
END ;                              (* AN_NEUER_POS *)

(*..........................................................................*)

PROCEDURE SETZE_NEU (CH: CHAR; SP, ZE: INTEGER; VAR WEN: BEWEGLICH) ;

BEGIN
   WITH WEN
   DO BEGIN
      OWNWRITE (Chr(SPACE), Pos.S, Pos.Z) ;  (* an alter Position loeschen *)
      OWNWRITE (CH, SP, ZE) ;      (* an neuer Position setzen *)
      Pos.S := SP ;                (* neue Werte fuer Spalte und Zeile *)
      Pos.Z := ZE ;
      END ;
END ;                              (* SETZE_NEU *)

(*..........................................................................*)

FUNCTION INKEY : CHAR ;            (* liefert character, von gedrueckter *)
                                   (* Taste oder chr (0) *)
VAR
   CH : CHAR ;

BEGIN
   IF KeyPressed
   THEN Read (Kbd,CH)              (* lese ohne Echo auf Bildschirm *)
   ELSE CH := Chr (0) ;
   INKEY := CH ;
END ;                              (* INKEY *)

(*..........................................................................*)

PROCEDURE SPIELERRICHTUNG ;

VAR
   CH : CHAR ;

BEGIN
   CH := INKEY ;                   (* schaue nach, ob Taste gedrueckt *)
   CH := UpCase (CH) ;             (* wenn Buchstabe, dann Grossbuchstabe *)
   WITH YOU
   DO BEGIN                        (* mehrfache IF wegen Zeitgleichheit *)
      IF CH = DAT_FILE[T_LI] THEN RICHTUNG := LI ;
      IF CH = DAT_FILE[T_RE] THEN RICHTUNG := RE ;
      IF CH = DAT_FILE[T_HO] THEN RICHTUNG := HO ;
      IF CH = DAT_FILE[T_RU] THEN RICHTUNG := RU ;
   END ;
END ;                              (* SPIELERRICHTUNG *)

(*--------------------------------------------------------------------------*)
(*                            initialisiere                                 *)
(*--------------------------------------------------------------------------*)

PROCEDURE INIT_ALLES ;

(*..........................................................................*)
(*             lokale Prozeduren und Funktionen fuer INIT_ALLES             *)
(*..........................................................................*)

PROCEDURE START_TEXT ;

VAR
   X_CENTER : INTEGER ;            (* nur zum Zentrieren am Begin *)
   CH : CHAR ;                     (* wird als dummy fuer warten benutzt *)

BEGIN
   X_CENTER := Round ((SPALTEN-14)/2) - 5 ;
   ClrScr ;                        (* loesche Bildschirm *)
   GotoXY (X_CENTER,1) ;     Write ('**************') ;
   GotoXY (X_CENTER,2) ;     Write ('*            *') ;
   GotoXY (X_CENTER,3) ;     Write ('*   FLIEGE   *') ;
   GotoXY (X_CENTER,4) ;     Write ('*            *') ;
   GotoXY (X_CENTER,5) ;     Write ('**************') ;
   GotoXY (6,10) ;
   Write ('Sie bewegen die Spielfigur ') ;
   Write (Chr (SPIELER)) ;
   Write (' mit Tasten auf dem Bildschirm.') ;
   GotoXY (6,11) ;
   Write ('Dabei sollen Sie Fliegen ') ;
   Write (Chr (FLIEGE)) ;
   Write (' fangen, die sich auch bewegen.') ;
   GotoXY (6,12) ;
   Write ('Jede gefangene Fliege bleibt als Hindernis ') ;
   Write (Chr (HINDERNIS)) ;
   Write (' stehen. Die Spiel-') ;
   GotoXY (6,13) ;
   Write ('feldgrenze ') ;
   Write (Chr (GRENZE)) ;
   Write (' kann nicht betreten werden und ist fest vorgegeben.') ;
   GotoXY (10,16) ;
   Write ('Weiter mit beliebiger Taste ... ') ;
   Read (Kbd, CH) ;
END ;                              (* START_TEXT *)

(*..........................................................................*)

FUNCTION ZIFFER_CHAR (VON, BIS, ALT: CHAR) : CHAR ;

VAR                                (* fordert Eingabe von Ziffer oder char *)
   CH : CHAR ;                     (* eingelesener Character *)

BEGIN
   Write (' ( von ') ;
   Write (VON) ;                   (* Wert ausgeben *)
   Write (' bis ') ;
   Write (BIS) ;                   (* Wert ausgeben *)
   Write (' ) : ') ;
   Write (ALT) ;                   (* bisherigen Wert ausgeben *)
   REPEAT
      CH := INKEY ;                (* lese ohne Echo *)
      CH := UpCase (CH) ;          (* falls Buchstabe, so Grossbuchstabe *)
      IF CH = Chr (13)             (* bei Return *)
      THEN CH := ALT ;             (* alten Wert uebernehmen *)
   UNTIL (Ord(CH) >= Ord(VON)) AND (Ord(CH) <= Ord(BIS)) ;
   Write (Chr(BACKSPACE),CH) ;     (* alten Wert ueberschreiben *)
   ZIFFER_CHAR := CH ;             (* und als Funktionswert uebergeben *)
END ;                              (* ZIFFER_CHAR *)

(*..........................................................................*)

FUNCTION R_W_FLYCOM (R_W: INTEGER) : BOOLEAN ;
                                   (* lese bzw. schreibe Daten fuer Spiel, *)
VAR                                (* Ergebnis zeigt mit oder ohne Erfolg *)
   F : FILE OF CHAR ;
   RES, DAT_OK : BOOLEAN ;

(*             lokale Prozeduren und Funktionen fuer R_W_FLYCOM             *)

PROCEDURE CHECKIO (VAR RESULT: BOOLEAN) ;
                                    (* Seiteneffekt kuerzer als Funktion *)
BEGIN
   IF IOResult <> 0 THEN RESULT := FALSE ;
END ;                              (* CHECKIO *)

(*                                                                          *)

FUNCTION R_W_FEHLER : CHAR ;       (* meldet R/W Error und fragt ob noch *)
                                   (* ein Versuch unternommen werden soll *)
BEGIN
   WriteLn ;
   Write ('  R/W Error !!!   nochmals versuchen ???') ;
   R_W_FEHLER := JA_NEIN ('J') ;
END ;

(*                       jetzt folgt R_W_FLYCOM                             *)

BEGIN
   Assign (F,'FLYCOM.DAT') ;
   REPEAT
      RES := TRUE ;                (* Preset ist kein Fehler *)
      {$I-}                        (* check IO ausschalten *)
      IF R_W = LESE THEN ReSet (F) (* Zeiger auf Anfang setzen *)
      ELSE ReWrite (F) ;           (*    ... *)
      CHECKIO (RES) ;              (* bei Fehler wird RES zu FALSE *)
      FOR INDEX := 1 TO 9          (* Grenzen koennten berechnet werden *)
      DO BEGIN                     (* aber so ist keine Anpassung noetig *)
         IF R_W=LESE
         THEN Read (F,DAT_FILE [INDEX])
         ELSE Write (F,DAT_FILE [INDEX]) ;
         CHECKIO (RES) ;           (* bei Fehler wird RES zu FALSE *)
      END ;
      Close (F) ;                  (* am Ende File schliessen *)
      CHECKIO (RES) ;              (* bei Fehler wird RES zu FALSE *)
      {$I+}                        (* check IO wieder einschalten *)
      IF RES = TRUE
      THEN DAT_OK := TRUE          (* kein Fehler, dann O.k. *)
      ELSE DAT_OK := (R_W_FEHLER = 'N') (* Abfrage, ob noch ein Versuch *)
   UNTIL DAT_OK;
   R_W_FLYCOM := RES ;             (* setze Resultat *)
END ;                              (* R_W_FLYCOM *)

(*..........................................................................*)

FUNCTION UEBERNEHMEN : CHAR ;      (* zeigt gelesene Daten und fragt, ob *)
                                   (* sie uebernommen werden sollen *)
BEGIN                              (* loesche Bildschirm *)
   ClrScr ;
   WriteLn ;
   Write ('   Anzahl der Fliegen ..........') ; WriteLn (DAT_FILE[ANZAHL]) ;
   Write ('   Beweglichkeit der Fliegen ...') ; WriteLn (DAT_FILE[BEWEGE]) ;
   Write ('   Schnelligkeit des Spiels ....') ; WriteLn (DAT_FILE[WARTEN]) ;
   Write ('   Laenge des Spiels ...........') ; WriteLn (DAT_FILE[LAENGE]) ;
   Write ('   Spiel mit Geraeuschen .......') ; WriteLn (DAT_FILE[MITSOUND]) ;
   Write ('   Taste fuer Spieler links ....') ; WriteLn (DAT_FILE[T_LI]) ;
   Write ('   Taste fuer Spieler rechts ...') ; WriteLn (DAT_FILE[T_RE]) ;
   Write ('   Taste fuer Spieler hoch .....') ; WriteLn (DAT_FILE[T_HO]) ;
   Write ('   Taste fuer Spieler runter ...') ; WriteLn (DAT_FILE[T_RU]) ;
   WriteLn ;
   Write ('   sollen diese Daten uebernommen werden') ;
   UEBERNEHMEN := JA_NEIN ('J') ;
END ;                              (* UEBERNEHMEN *)

(*..........................................................................*)

PROCEDURE MACHE_FILE ;             (* fragt Daten ab und versucht file *)
                                   (* zu generieren *)
VAR                                (* fuer korrekten Aufruf von R_W_FLYCOM *)
   ALL_OK : BOOLEAN ;

(*                  lokale Funktion fuer MACHE_FILE                         *)

FUNCTION TASTEN_OK : BOOLEAN ;     (* TRUE wenn Tasten alle verschieden *)
BEGIN
   TASTEN_OK := (DAT_FILE[T_LI] <> DAT_FILE[T_RE]) AND
                (DAT_FILE[T_LI] <> DAT_FILE[T_HO]) AND
                (DAT_FILE[T_LI] <> DAT_FILE[T_RU]) AND
                (DAT_FILE[T_RE] <> DAT_FILE[T_HO]) AND
                (DAT_FILE[T_RE] <> DAT_FILE[T_RU]) AND
                (DAT_FILE[T_HO] <> DAT_FILE[T_RU]);
END ;                              (* TASTEN_OK *)

(*                       jetzt folgt MACHE_FILE                             *)

BEGIN
   ClrScr ;                        (* loesche Bildschirm *)
   WriteLn ;
   Write (' Anzahl der Fliegen ...................') ;
   DAT_FILE[ANZAHL] := ZIFFER_CHAR ('1','9','3') ;
   WriteLn ;
   Write (' Beweglichkeit der Fliegen ............') ;
   DAT_FILE[BEWEGE] := ZIFFER_CHAR ('1','9','4') ;
   WriteLn ;
   Write (' Schnelligkeit des Spiels .............') ;
   DAT_FILE[WARTEN] := ZIFFER_CHAR ('1','9','7') ;
   WriteLn ;
   Write (' Laenge des Spiels ....................') ;
   DAT_FILE[LAENGE] := ZIFFER_CHAR ('1','9','2') ;
   WriteLn ;
   Write (' Spiel mit Geraeuschen .......') ;
   DAT_FILE[MITSOUND] := JA_NEIN ('J') ;
   REPEAT
      WriteLn ;
      Write (' Taste fuer Spieler links .............') ;
      DAT_FILE[T_LI] := ZIFFER_CHAR ('A','Z','A') ;
      WriteLn ;
      Write (' Taste fuer Spieler rechts ............') ;
      DAT_FILE[T_RE] := ZIFFER_CHAR ('A','Z','D') ;
      WriteLn ;
      Write (' Taste fuer Spieler hoch ..............') ;
      DAT_FILE[T_HO] := ZIFFER_CHAR ('A','Z','E') ;
      WriteLn ;
      Write (' Taste fuer Spieler runter ............') ;
      DAT_FILE[T_RU] := ZIFFER_CHAR ('A','Z','X') ;
   UNTIL TASTEN_OK ;               (* bis Tasten eindeutig *)
   ALL_OK := R_W_FLYCOM (SCHREIBE) ;    (* und speicher in file *)
END ;                              (* MACHE_FILE *)

(*..........................................................................*)
(*        Ende der lokalen Prozeduren und Funktionen fuer INIT_ALLES        *)
(*..........................................................................*)

BEGIN                              (* von INIT_ALLES *)
   START_TEXT ;
   IF R_W_FLYCOM (LESE)            (* versuche file FLYCOM.DAT zu lesen *)
   THEN BEGIN
      IF UEBERNEHMEN = 'N'         (* wenn lesbar und Daten nicht *)
      THEN MACHE_FILE ;            (* uebernommen werden sollen *)
   END
   ELSE MACHE_FILE ;               (* bei Lesefehler auch eingeben *)
END ;

(*--------------------------------------------------------------------------*)
(*                            bewege alle Fliegen                           *)
(*--------------------------------------------------------------------------*)

PROCEDURE ALLE_FLIEGEN ;

VAR
   SP, ZE, INDEX: INTEGER ;

BEGIN
   FOR INDEX := 1 TO WIEVIELE
   DO BEGIN
      ZUFALLSRICHTUNG (TRAEGE, FLY[INDEX]) ; (* waehle evtl. neue Richtung *)
      IF AN_NEUER_POS (SP, ZE, FLY[INDEX]) = Chr (SPACE)
      THEN SETZE_NEU (Chr(FLIEGE), SP, ZE, FLY[INDEX]) ;
      OWNSOUND (NOTE_C, 5) ;       (* gebe ein kurzes Geraeusch aus *)
      SPIELERRICHTUNG ;            (* fuer mehrfache Abfrage, ob Taste fuer *)
   END ;                           (* eine neue Richtung gedrueckt ist *)
END ;

(*--------------------------------------------------------------------------*)
(*        bewege Spieler und ueberpruefe, ob eine Fliege gefangen           *)
(*--------------------------------------------------------------------------*)

PROCEDURE BEWEGE_SPIELER ;

VAR
   CH: CHAR ;
   SP, ZE: INTEGER ;

(*..........................................................................*)
(*                  lokale Prozeduren fuer BEWEGE_SPIELER                   *)
(*..........................................................................*)

PROCEDURE GEFANGEN ;
VAR
   GEFUNDEN : BOOLEAN ;

(*                       lokale Prozedur fuer GEFANGEN                      *)

PROCEDURE BLINK (SP, ZE : INTEGER) ;

VAR                                (* laesst Fliege blinken und gibt ein *)
   ZAEHLER : INTEGER ;             (* Sirenenartiges Geraeusch aus *)

BEGIN
   OWNWRITE (Chr(SPIELER),SP,ZE) ;
   GotoXY (P_S + 2, P_Z) ;         (* Parkposition des Cursors *)
   FOR ZAEHLER := 120 TO 170 DO OWNSOUND (10*ZAEHLER,3) ;
   OWNWRITE (Chr(FLIEGE),SP,ZE) ;
   GotoXY (P_S + 2, P_Z) ;         (* Parkposition des Cursors *)
   FOR ZAEHLER := 170 DOWNTO 120 DO OWNSOUND (10*ZAEHLER,3) ;
   OWNWRITE (Chr(SPACE),SP,ZE) ;
   GotoXY (P_S + 2, P_Z) ;         (* Parkposition des Cursors *)
   FOR ZAEHLER := 120 TO 170 DO OWNSOUND (10*ZAEHLER,3) ;
   OWNWRITE (Chr(SPIELER),SP,ZE) ;
   GotoXY (P_S + 2, P_Z) ;         (* Parkposition des Cursors *)
   FOR ZAEHLER := 170 DOWNTO 120 DO OWNSOUND (10*ZAEHLER,3) ;
   OWNWRITE (Chr(HINDERNIS),SP,ZE) ;
END ;                              (* BLINK *)

(*                       jetzt folgt GEFANGEN                               *)

BEGIN
   INDEX := 0 ;
   GEFUNDEN := FALSE ;
   REPEAT                          (* suche alle Fliegen ab, welche *)
      INDEX := INDEX + 1 ;         (* gefangen worden ist *)
      IF (SP = FLY[INDEX].Pos.S)   (* SP und ZE sind wegen vorherigem *)
      AND (ZE = FLY[INDEX].Pos.Z)  (* Aufruf von AN_NEUER_POS bekannt *)
      THEN GEFUNDEN := TRUE ;
   UNTIL (INDEX = WIEVIELE) OR GEFUNDEN = TRUE ;
   IF GEFUNDEN
   THEN BEGIN                      (* normalerweise ist index bekannt *)
      BLINK (SP, ZE) ;
      PUNKTE := PUNKTE + 1 ;
      GotoXY (P_S - 2, P_Z) ;      (* nur die Anzahl Punkte wird waehrend *)
      Write (PUNKTE:4) ;           (* des Spiels nicht mit OWNWRITE gesetzt *)
      GENERIERE (FLY[INDEX]) ;
   END
   ELSE BEGIN                      (* darf normalerweise nicht vorkommen *)
      GotoXY (P_S - 8, P_Z + 1) ;  (* wurde waehrend Testphase benoetigt *)
      Write ('interner Fehler') ;  (* und kann evtl. weggelassen werden *)
   END ;
END ;                              (* GEFANGEN *)

(*..........................................................................*)
(*             Ende der lokalen Prozeduren  fuer BEWEGE_SPIELER             *)
(*..........................................................................*)

BEGIN                              (* von BEWEGE_SPIELER *)
   SPIELERRICHTUNG ;               (* bei Tastendruck evtl. neue Richtung *)
   CH := AN_NEUER_POS (SP, ZE, YOU) ;
   IF CH = Chr(SPACE)
   THEN SETZE_NEU (Chr(SPIELER), SP, ZE, YOU)
   ELSE IF CH = Chr (FLIEGE) THEN GEFANGEN ;
END ;                              (* BEWEGE_SPIELER *)

(*--------------------------------------------------------------------------*)
(*                            warte einige Zeit                             *)
(*--------------------------------------------------------------------------*)

PROCEDURE WARTE_ETWAS ;

VAR
   INDEX : INTEGER ;               (* Zaehler fuers Warten *)

BEGIN
   GotoXY (P_S + 2, P_Z) ;         (* Parkposition des Cursors *)
   FOR INDEX := 1 TO WARTEZAHL     (* anstatt nur DELAY auszufuehren wird *)
   DO BEGIN                        (* auch laufend die Tastatur abgefragt. *)
      SPIELERRICHTUNG ;
      Delay (2) ;
   END;
END ;                              (* Dies leert Tastaturbuffer *)

(*--------------------------------------------------------------------------*)
(*                            Spiel ist beendet                             *)
(*--------------------------------------------------------------------------*)

PROCEDURE ENDEBILD ;
BEGIN
   GotoXY (P_S - 4, P_Z - 1) ;
   Write ('Sie haben') ;
   GotoXY (P_S - 7, P_Z + 1) ;
   Write ('Punkte erreicht') ;
   GotoXY (17, ZEILEN) ;
   Write ('noch ein Spielchen') ;
END ;                              (* ENDEBILD *)
(* ----------------------------------------------------------------------- *)
(*                          Ende von FLIEGE.INC                            *)