home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / 1988 / 03 / hasen.bas < prev    next >
Encoding:
BASIC Source File  |  1980-01-03  |  5.2 KB  |  215 lines
  1. REM Hasen - Einfangen
  2. REM (C) 1988 B. Freier & PASCAL International
  3. REM Turbo BASIC - IBM PC/XT/AT
  4.  
  5. SCREEN 1                   'Initialisierungen
  6. COLOR 15,0
  7.  
  8. DIM hase%(95)               'Arrays bereitstellen
  9. DIM rahmen%(182)
  10. DIM spielfeld%(1:56,1:28)
  11.  
  12. RANDOMIZE TIMER     'Zufallsgenerator starten
  13.  
  14. CLS                   'Hase zeichnen
  15. CIRCLE (10,23),10,3
  16. PAINT (10,23),3,3
  17. CIRCLE (10,10),5,3
  18. PAINT (10,10),3,3
  19. CIRCLE (10,27),4,0
  20. LINE ( 5,0)-( 7,7),3,B
  21. LINE (13,0)-(15,7),3,B
  22.  
  23. GET (0,0)-(20,30),hase%       'Hase als Symbol in
  24.                               'ein Array einlesen
  25.  
  26.  
  27. CLS                        'Rahmen zeichnen
  28. LINE (0,0)-(30,40),2,BF
  29. LINE (4,4)-(26,36),0,BF
  30.  
  31. GET (0,0)-(30,40),rahmen%        'Rahmen einlesen
  32.  
  33.  
  34.  
  35. spielerklaerung:
  36. CLS
  37. LOCATE  3,7:?"H A S E N F A N G E N";
  38. LOCATE  6,2:?"Oh Schreck! Dem Nachbarn sind die";
  39. LOCATE  8,2:?"Hasen aus dem Stall entlaufen.";
  40. LOCATE 10,2:?"Sie sitzen unbewacht im Garten.";
  41. LOCATE 13,2:?"Nimm schnell einen Rahmen";
  42. LOCATE 15,2:?"und hilf beim Fangen der Hasen.";
  43. LOCATE 18,2:?"Steuere den Rahmen mit den Pfeil-";
  44. LOCATE 20,2:?"tasten. Druecke die Eingabetaste,";
  45. LOCATE 22,2:?"wenn der Rahmen um den Hasen liegt.";
  46. LOCATE 25,2:?"Druecke jetzt irgendeine Taste!";
  47.  
  48. WHILE NOT INSTAT:WEND:nix$=INKEY$  'Taste löschen
  49.  
  50.  
  51. start:
  52.  
  53. SCREEN 1
  54.  
  55. freie% = 6                 'Werte auf Startwert
  56. gefangen% = 0
  57.  
  58. CLS                  'Spielfeld aufbauen
  59. VIEW (10,1)-(310,171),1,3
  60. WINDOW SCREEN (1,1)-(60,34)
  61.  
  62. FOR versatz%=2 TO 55 STEP 9      'Hasen zufällig
  63.   zufallx%=INT(RND*5)+1 + versatz%     'verteilen
  64.   zufally%=INT(RND*26)+2
  65.   spielfeld%(zufallx%,zufally%) = 1
  66.   PUT (zufallx%,zufally%),hase%
  67. NEXT versatz%
  68.  
  69. rahmenx%=28                  'Rahmen in die Mitte
  70. rahmeny%=14
  71.  
  72. PUT (rahmenx%,rahmeny%),rahmen%    
  73. GOSUB wertausgabe
  74.  
  75.  
  76. abfrage:
  77. WHILE INSTAT           'Tastaturpuffer leeren
  78. nix$ = INKEY$
  79. WEND
  80.  
  81. WHILE NOT INSTAT        'Zeichen von Tastatur
  82. WEND                                    'einlesen
  83. eingabe$ = INKEY$
  84. IF LEN(eingabe$) = 2 THEN GOTO steuercodes
  85. IF eingabe$ = CHR$(13) THEN
  86.   IF spielfeld%(rahmenx%+1,rahmeny%+1) = 1 THEN
  87.        GOTO richtig
  88.      ELSE
  89.        GOTO falsch
  90.   END IF
  91. ELSEIF eingabe$="E" OR eingabe$="e" THEN
  92.   GOTO beendigung
  93. ELSE
  94.   PRINT CHR$(7);:GOTO abfrage
  95. END IF
  96.  
  97.  
  98. steuercodes:               'Cursortaste wurde
  99. xalt% = rahmenx%                        'gedrückt
  100. yalt% = rahmeny%
  101. eingabe$ = RIGHT$(eingabe$,1)
  102.                                    'Aufwärtspfeil
  103. IF eingabe$=CHR$(72) AND rahmeny%>1 THEN    
  104.    rahmeny%=rahmeny%-1
  105.                                     'Abwärtspfeil
  106. ELSEIF eingabe$=CHR$(80) AND rahmeny%<26 THEN    
  107.   rahmeny%=rahmeny%+1
  108.                                       'Linkspfeil
  109. ELSEIF eingabe$=CHR$(75) AND rahmenx%>1 THEN    
  110.   rahmenx%=rahmenx%-1
  111.                                      'Rechtspfeil
  112. ELSEIF eingabe$=CHR$(77) AND rahmenx%<54 THEN    
  113.    rahmenx%=rahmenx%+1
  114.  
  115. ELSE                        'andere Taste
  116.    PRINT CHR$(7);:GOTO abfrage
  117. END IF
  118.  
  119.                              'Rahmen neu zeichnen
  120. PUT (xalt%,yalt%),rahmen%        
  121. PUT (rahmenx%,rahmeny%),rahmen%
  122. GOTO abfrage
  123.  
  124.  
  125.  
  126. richtig:         'Hase richtig eingerahmt
  127. FOR i%=250 TO 275 STEP 5          'Erfolgsmelodie
  128.   SOUND i%,1.5
  129. NEXT i%
  130.  
  131.                               'Löschen des Wertes
  132. spielfeld%(rahmenx%+1,rahmeny%+1)=0
  133.                           'Bild des Hasen löschen
  134. PUT (rahmenx%+1,rahmeny%+1),hase%
  135. freie% = freie%-1            'Werte neu berechnen
  136. gefangen% = gefangen%+1
  137. GOSUB wertausgabe            'Werte aktualisieren
  138.  
  139. LOCATE 23,4                  'Satz zur Motivation
  140. PRINT "Hurra, wieder ein Hase gefangen !";
  141.  
  142. DELAY 1                              'Verzögerung
  143. LOCATE 23,2:PRINT STRING$(37,32);
  144.                                    'Zum Spielende
  145. IF freie%=0 THEN GOTO erfolgsmeldung
  146. GOTO abfrage                  'Rücksprung
  147.  
  148.  
  149.  
  150. wertausgabe:
  151. LOCATE 25,1              'Werte ausgeben
  152. PRINT "Hasen gefangen: ";gefangen%;
  153. LOCATE 25,26
  154. PRINT "Noch frei: ";freie%;
  155. RETURN
  156.  
  157.  
  158.  
  159. falsch:                   'Rahmen nicht über Hase
  160. PRINT CHR$(7);
  161. gesucht% = 0
  162. FOR suchx% = -2 TO 2           'Umgebung absuchen
  163. FOR suchy% = -3 TO 3
  164. IF spielfeld%(rahmenx%+1+suchx%,rahmeny%+1+suchy%)_
  165.    = 1 THEN GOSUB daneben:gesucht% = -1
  166.                                        'Hilfstext
  167. NEXT suchy%
  168. NEXT suchx%
  169.  
  170.                            'Meldung bei Mißerfolg
  171. IF gesucht% = 0 THEN
  172.     LOCATE 23,7:PRINT "Hier ist kein Hase !!!";
  173.     DELAY 1
  174.     LOCATE 23,2:PRINT STRING$(37,32);
  175. END IF
  176. GOTO abfrage
  177.  
  178.  
  179.  
  180. daneben:                   'Hilfe für den Spieler
  181. LOCATE 23,3
  182. PRINT "Lege den Rahmen genau um den Hasen!";
  183. DELAY 1
  184. LOCATE 23,2: PRINT STRING$(38,32);
  185. RETURN
  186.  
  187.  
  188.  
  189. erfolgsmeldung:        'Alle Hasen sind gefangen
  190. SCREEN 1                'Sätze mit Erfolgsmeldung
  191. CLS
  192. LOCATE 8,10:PRINT "Das ist ja prima ! ! !"
  193. LOCATE 14,6:PRINT "Es sind alle Hasen im Stall !"
  194.  
  195.  
  196.  
  197.  
  198. wiederholungsfrage:
  199. LOCATE 20,7:PRINT "Noch ein Spiel ( J / N ) ?";
  200.  
  201. eingabe$=INKEY$             'Tastaturabfrage
  202. IF eingabe$ = "" THEN GOTO wiederholungsfrage
  203. IF eingabe$ = "J" OR eingabe$ = "j" THEN_
  204.               GOTO start ELSE END
  205.  
  206.  
  207.  
  208. beendigung:                'Spielabbruch
  209. SCREEN 1
  210. CLS                  'Satz des Bedauerns
  211. LOCATE 8,7:PRINT "Schade, dass Du aufgibst !";
  212. GOTO wiederholungsfrage
  213.  
  214. END                    'Programmende
  215.