Wer ist online?
Buchempfehlung
FreeBASIC-Chat
FreeBASIC-Nachrichten jetzt auch über Twitter erhalten. Follow us!fb:porticula NoPaste
Hochwasser Dubletten - Fehlerhafter Quellcode?
| Uploader: |  ALWIM |
| Datum/Zeit: | 14.07.2013 21:33:46 |
#include once "fmod.bi"
#IFDEF __FB_WIN32__
#INCLUDE "windows.bi"
#ELSE
CONST FALSE=0, TRUE=Not FALSE
#ENDIF
DECLARE SUB MISCHEN()
DECLARE SUB LADEN()
DECLARE SUB NULLSETZEN()
DECLARE SUB ENDE()
DECLARE SUB COMPUTER()
DECLARE SUB LOESUNG()
DECLARE SUB MUSIK()
DECLARE SUB MUSIKAKTIVIERUNG()
DECLARE SUB SPEICHERN()
DECLARE SUB REGEN()
DECLARE SUB REMISPRUEFUNG()
DECLARE SUB REMISANBIETEN()
DIM SHARED AS INTEGER v, wasser, maxpartikel
maxpartikel = 1000 ' Anzahl der Regentropfen
DIM SHARED AS INTEGER yr(1 TO maxpartikel)
DIM SHARED AS INTEGER xr(1 TO maxpartikel)
DIM SHARED AS INTEGER t(1 TO maxpartikel)
DIM SHARED AS INTEGER farbe(1 TO maxpartikel)
DIM SHARED AS INTEGER reserviert(639), gefunden, identisch, Remisbieten
DIM SHARED AS INTEGER b, i, k, j, KC1, KC2, Anzeige, offeneKarten, Prozent, gezKarteM1, gezKarteM2, gezKarteM
DIM SHARED AS INTEGER karte, KartegenommenAlt, test, alt, Bildschirmmodus, klick, gesperrt, Sound, Musiksperre
DIM SHARED AS INTEGER MENSCH, PC, beginner, MODUS, A = 64, Zaehler, Zugzaehler, PunkteMensch, PunktePC, Remis
DIM SHARED AS INTEGER X(A), XX(A), Y(A), YY(A), Xalt, XXalt, Yalt, YYalt
DIM SHARED AS INTEGER gezKarte(64), gezKartealt, aufgedeckteKarten(64), Zahl(64), Setup(10), ZahlM(64), ZahlC(64), Zufall
DIM SHARED AS INTEGER mausx, mausy, mausk, mauswheel
DIM SHARED As STRING taste, Namen(10)
DIM SHARED AS ANY PTR Deckblattpuffer, Leerpuffer, puffer(32)
DIM f AS INTEGER = FREEFILE
Randomize TIMER
SCREENRES 250, 201, 32
' Einstellungen laden
OPEN "Setup.ini" FOR INPUT AS #f
A = 1
DO UNTIL EOF(f)
INPUT #f, Setup(A), Namen(A)
A += 1
LOOP
CLOSE #f
' Setupfunktionen für Setup.ini definieren
Namen(1) = "Funktionen: 1 = ein und 0 = aus"
Namen(2) = "= Musik"
Namen(3) = "= automatische Fensterauswahl: 1 = 1340x620 oder 2 = 1040x825"
Namen(4) = "= Computer aktivieren: 1 = Laie oder 2 = Anfänger oder 3 = Leicht oder 4 = Mittel oder 5 = Schwer"
Namen(5) = "= Cheat"
' Musik laden, wenn die Musik nicht in der Datei Setup.ini deaktiviert wurde!
' Das Musikstück wurde auf dem Yamaha Keyboard PSR-9000 am 07.07.2013 gegen 16.14 Uhr live gespielt,
' aufgenommen bzw. gespeichert als Midifile und anschließend in eine .ogg Datei umgewandelt!
CONST SOUND_FILE = "Musik.ogg" ' Musiknamen des Musikstückes definieren
IF Setup(2) = 1 THEN MUSIK ' Musik laden + abspielen
' Alle Werte auf 0 setzen
NULLSETZEN
' Musik Aktivierung/Deaktivierung
IF Setup(2) >= 0 THEN
IF Setup(2) = 0 THEN Sound = FALSE
IF Setup(2) = 1 THEN Sound = TRUE
END IF
' automatische Bildschirmauswahl!!!
IF Setup(3) <> 0 THEN
IF Setup(3) = 1 THEN Bildschirmmodus = 1
IF Setup(3) = 2 THEN Bildschirmmodus = 2
GOTO spielen
END IF
' Menu zum auswählen der Grafik laden
DIM SHARED AS ANY PTR Menupuffer
Menupuffer = IMAGECREATE(540,320)
BLOAD (EXEPATH & "\Menu.dubletten", Menupuffer)
PUT (1,1), Menupuffer, PSET
IMAGEDESTROY(Menupuffer)
DO
GETMOUSE mausx, mausy,, mausk
SELECT CASE mausk
CASE 1
SELECT CASE mausx
CASE 14 TO 37
SELECT CASE mausy
CASE 37 TO 59
' Auswahl der Größe des Grafikfensters (1340, 620 / 5x13 Anordnung)
CIRCLE (25, 49), 4, &h0000AA, , , , F
CIRCLE (25, 81), 4, &hFFFFFF, , , , F
Bildschirmmodus = 1
END SELECT
END SELECT
SELECT CASE mausx
CASE 14 TO 37
SELECT CASE mausy
CASE 69 TO 92
' Auswahl der Größe des Grafikfensters (1040, 825 / 8x8 Anordnung)
CIRCLE (25, 49), 4, &hFFFFFF, , , , F
CIRCLE (25, 81), 4, &h0000AA, , , , F
Bildschirmmodus = 2
END SELECT
END SELECT
SELECT CASE mausx
CASE 70 TO 167
SELECT CASE mausy
CASE 102 TO 199
' Hochwasser Dubletten spielen
IF Bildschirmmodus > 0 AND Bildschirmmodus < 3 THEN GOTO spielen
END SELECT
END SELECT
END SELECT
' Escape beendet das Programm
IF MULTIKEY(&h01) THEN
FSOUND_Close()
END
END IF
taste = INKEY
SLEEP 1
Loop Until taste = Chr(27) Or taste = Chr(255, 107)
FSOUND_Close()
END
spielen:
' Bildschirmgröße definieren
IF Bildschirmmodus = 1 THEN SCREENRES 1340,620,32
IF Bildschirmmodus = 2 THEN SCREENRES 1040,825,32
' Koordinaten für die 64 Buttons laden - 64 Karten = 64 Buttons / 5x13 Anordnung
IF Bildschirmmodus = 1 THEN
OPEN "Button_Modus 1.txt" FOR INPUT AS #f
A = 1
DO UNTIL EOF(f)
INPUT #f, X(A), XX(A), Y(A), YY(A)
A += 1
LOOP
CLOSE #f
END IF
' Koordinaten für die 64 Buttons laden - 64 Karten = 64 Buttons / 8x8 Anordnung
IF Bildschirmmodus = 2 THEN
OPEN "Button_Modus 2.txt" FOR INPUT AS #f
A = 1
DO UNTIL EOF(f)
INPUT #f, X(A), XX(A), Y(A), YY(A)
A += 1
LOOP
CLOSE #f
END IF
MISCHEN ' Karten mischen - (Unterprogramm)
DO
GETMOUSE mausx, mausy,, mausk
SELECT CASE mausk
CASE 1
A += 1
IF A > 64 THEN A = 1
SELECT CASE mausx
CASE X(A) TO XX(A)
SELECT CASE mausy
CASE Y(A) TO YY(A)
FOR i = 1 TO 64
IF gezKarte(A) = 0 AND MENSCH THEN
' Kartenmausklickzähler um 1 erhöhen - bei 2 Mausklicks wird geprüft ob das Kartenpaar gleich ist!
klick += 1
aufgedeckteKarten(A) = TRUE ' Damit der Computer weiß, welche Karten schon aufgedeckt wurden!
gezKarte(A) = TRUE: LADEN
' Zähler für Anzahl der Versuche um 1 erhöhen!
IF klick > 1 THEN Zugzaehler += 1
' gezogene Karte +32 oder -32 damit man auf gleiches Kartenpaar prüfen kann!
IF gezKartealt < 33 THEN gezKartealt += 32 ELSE gezKartealt -= 32
' Prüfung ob das gleiche Kartenpaar gefunden wurde!
IF Zahl(A) = gezKartealt AND Klick > 1 THEN
' Prüfung ob alle Karten aufgedeckt wurden
FOR i = 1 TO 64
IF Zahl(i) = 1 THEN Zaehler = Zaehler + Zahl(i)
NEXT
' Punktezähler des Menschen
ZahlM(A) = 1
ZahlM(KartegenommenAlt) = 1
PunkteMensch = 0
FOR i = 1 TO 64
IF ZahlM(i) = 1 THEN PunkteMensch = PunkteMensch + ZahlM(i)
NEXT
' wenn alle Karten aufgedeckt wurden, Ergebnis speichern und dann Ende anzeigen
IF Zaehler = 32 THEN
OPEN "Statistik.TXT" FOR APPEND AS #f
IF PunkteMensch <> PunktePC THEN
IF Modus = 0 THEN PRINT #f, Zugzaehler, DATE, TIME, "Einzelspielermodus"
IF Modus = 1 AND Setup(4) = 1 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Laie", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 2 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Anfänger", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 3 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Leicht", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 4 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Mittel", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 5 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Schwer", "Mensch:", PunkteMensch, "Computer:", PunktePC
END IF
IF PunkteMensch = PunktePC then
IF Modus = 0 THEN PRINT #f, Zugzaehler, DATE, TIME, "Einzelspielermodus"
IF Modus = 1 AND Setup(4) = 1 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Laie", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 2 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Anfänger", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 3 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Leicht", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 4 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Mittel", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 5 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Schwer", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
END IF
CLOSE #f
ENDE
EXIT FOR
END IF
' die 2 aufgedeckten Karten löschen!!!
Leerpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\0.dubletten", Leerpuffer)
BLOAD (EXEPATH & "\0.dubletten", Leerpuffer)
PUT (x(a),y(a)), Leerpuffer, PSET
PUT (Xalt,Yalt), Leerpuffer, PSET
IMAGEDESTROY Leerpuffer
klick = 0 ' Mausklickzähler auf 0 setzen
IF gezKartealt < 33 THEN gezKartealt += 32 ELSE gezKartealt -= 32 ' Wert wieder auf den alten zurück setzen
EXIT FOR ' Schleife verlassen
END IF
' Wert wieder auf den alten zurück setzen
IF gezKartealt < 32 THEN gezKartealt += 32 ELSE gezKartealt -= 32
' Sind beide aufgedeckten Karte ungleich, werden beide Karten wieder umgedreht!!!
IF klick > 1 THEN
SLEEP 1200
Deckblattpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\Deckblatt.dubletten", Deckblattpuffer)
PUT (x(a),y(a)), Deckblattpuffer, PSET
PUT (Xalt,Yalt), Deckblattpuffer, PSET
IMAGEDESTROY Deckblattpuffer
' die gezogenen Karten vom Menschen in Variable speichern für die Zugsuche des PCs!!!
gezKarteM1 = gezKartealt ' 1. gezogene Karte
gezKarteM2 = Zahl(A) ' 2. gezogene Karte
gezKarte(A) = 0 ' gesperrte Karte wieder freigeben!!!
gezKarte(KartegenommenAlt) = 0 ' gesperrte Karte wieder freigeben!!!
klick = 0
IF Modus = 1 THEN MENSCH = FALSE: PC = TRUE
EXIT FOR
END IF
' alte Werte speichern
gezKartealt = Zahl(A)
KartegenommenAlt = A
Xalt = X(A)
Yalt = Y(A)
END IF
NEXT
END SELECT
END SELECT
END SELECT
IF Bildschirmmodus = 1 THEN LOCATE 75, 4: PRINT "Versuche: "; USING "###"; Zugzaehler
IF Bildschirmmodus = 2 THEN LOCATE 5, 106: PRINT "Versuche: "; USING "###"; Zugzaehler
IF Bildschirmmodus = 1 AND Sound THEN LOCATE 73, 4: PRINT "Musik: ein"
IF Bildschirmmodus = 1 AND Sound = 0 THEN LOCATE 73, 4: PRINT "Musik: aus"
IF Bildschirmmodus = 2 AND Sound THEN LOCATE 7, 106: PRINT "Musik: ein"
IF Bildschirmmodus = 2 AND Sound = 0 THEN LOCATE 7, 106: PRINT "Musik: aus"
IF Bildschirmmodus = 1 AND Setup(4) > 0 THEN LOCATE 71, 4: PRINT "Computermodus: ein"
IF Bildschirmmodus = 2 AND Setup(4) > 0 THEN LOCATE 9, 106: PRINT "Computermodus: ein"
IF Bildschirmmodus = 1 AND Setup(4) = 0 THEN LOCATE 71, 4: PRINT "Computermodus: aus"
IF Bildschirmmodus = 2 AND Setup(4) = 0 THEN LOCATE 9, 106: PRINT "Computermodus: aus"
' Anzeige der Punkte vom Menschen und vom Computer???
IF Bildschirmmodus = 1 AND Setup(4) > 0 THEN LOCATE 73, 40: PRINT "Punkte Mensch: "; USING "##"; PunkteMensch
IF Bildschirmmodus = 1 AND Setup(4) > 0 THEN LOCATE 75, 40: PRINT "Punkte Computer: "; USING "##"; PunktePC
IF Bildschirmmodus = 2 AND Setup(4) > 0 THEN LOCATE 15, 106: PRINT "Punkte Mensch: "; USING "##"; PunkteMensch
IF Bildschirmmodus = 2 AND Setup(4) > 0 THEN LOCATE 17, 106: PRINT "Punkte Computer: "; USING "##"; PunktePC
' Computerzüge suchen
IF PC THEN COMPUTER
' Hilfe Datei laden (README.TXT)
IF MULTIKEY(&h3B) THEN SHELL "START README.TXT"
' Neues Spiel
IF MULTIKEY(&h1D) AND MULTIKEY(&h31) THEN
NULLSETZEN
MISCHEN
END IF
' ???
IF MULTIKEY(&h2A) AND MULTIKEY(&h1D) AND MULTIKEY(&h36) AND gesperrt AND Setup(5) = 1 THEN LOESUNG
IF MULTIKEY(&h2A) AND MULTIKEY(&h1D) AND MULTIKEY(&h36) THEN gesperrt = FALSE ELSE gesperrt = TRUE
' Musik aus und einschalten
IF MULTIKEY(&h1D) AND MULTIKEY(&h1F) AND Musiksperre THEN MUSIKAKTIVIERUNG: SPEICHERN
IF MULTIKEY(&h1D) AND MULTIKEY(&h1F) THEN Musiksperre = FALSE ELSE Musiksperre = TRUE
' Computer auswählen (C+0 = kein PC, C+1 = Laie, C+2 = Anfänger, C+3 = Leicht, C+4 = Mittel, C+5 = Schwer)
IF MULTIKEY(&h2E) AND MULTIKEY(&h0B) THEN Setup(4) = 0: Mensch = TRUE: PC = FALSE: MODUS = 0: SPEICHERN
IF MULTIKEY(&h2E) AND MULTIKEY(&h02) THEN Setup(4) = 1: MODUS = 1: SPEICHERN
IF MULTIKEY(&h2E) AND MULTIKEY(&h03) THEN Setup(4) = 2: MODUS = 1: SPEICHERN
IF MULTIKEY(&h2E) AND MULTIKEY(&h04) THEN Setup(4) = 3: MODUS = 1: SPEICHERN
IF MULTIKEY(&h2E) AND MULTIKEY(&h05) THEN Setup(4) = 4: MODUS = 1: SPEICHERN
IF MULTIKEY(&h2E) AND MULTIKEY(&h06) THEN Setup(4) = 5: MODUS = 1: SPEICHERN
' Fensterauswahl beim nächsten Programmneustart (F+0 = kein, F+1 = 1340x620, F+2 = 1040x825)
IF MULTIKEY(&h21) AND MULTIKEY(&h0B) THEN Setup(3) = 0: SPEICHERN
IF MULTIKEY(&h21) AND MULTIKEY(&h02) THEN Setup(3) = 1: SPEICHERN
IF MULTIKEY(&h21) AND MULTIKEY(&h03) THEN Setup(3) = 2: SPEICHERN
' Remis anbieten (Strg + R)
IF MULTIKEY(&h1D) AND MULTIKEY(&h13) AND Modus > 0 THEN REMISPRUEFUNG
' Computer bietet Remis, an wenn es die Stellung zulässt!
#IFDEF __FB_WIN32__
IF Modus > 0 AND Remisbieten <> 0 THEN REMISANBIETEN
#ENDIF
' bei einem angenommenen Remis, wird das Spiel beendet, alles gespeichert und die Auswertung angezeigt!
IF Remis THEN
OPEN "Statistik.TXT" FOR APPEND AS #f
IF Modus = 1 AND Setup(4) = 1 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Laie", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 2 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Anfänger", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 3 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Leicht", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 4 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Mittel", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 5 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Schwer", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
CLOSE #f
ENDE
END IF
taste = INKEY
if mausk = 0 then SLEEP 1
LOOP Until taste = Chr(27) Or taste = Chr(255, 107)
FSOUND_Close()
END
SUB MISCHEN()
FOR karte = 1 To 64
Do
zahl(karte) = Int(Rnd * 64) + 1
test = 0
For alt = 1 To karte - 1
If zahl(karte) = zahl(alt) Then test = 1: EXIT FOR
NEXT
Loop While test = 1
NEXT
Deckblattpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\Deckblatt.dubletten", Deckblattpuffer)
IF Bildschirmmodus = 1 THEN
FOR k = 1 TO 5
FOR i = 1 TO 13
IF K = 5 AND i = 13 THEN EXIT FOR
PUT (103*i-103,103*k-103), Deckblattpuffer, PSET
NEXT
NEXT
END IF
IF Bildschirmmodus = 2 THEN
FOR k = 1 TO 8
FOR i = 1 TO 8
PUT (103*i-103,103*k-103), Deckblattpuffer, PSET
NEXT
NEXT
END IF
IMAGEDESTROY(Deckblattpuffer)
END SUB
SUB LADEN()
puffer(a) = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\" & Zahl(a) & ".dubletten", puffer(a))
PUT (x(a),y(a)), puffer(a), PSET
SLEEP 10
IMAGEDESTROY(puffer(a))
END SUB
SUB NULLSETZEN()
' Gegner wird definiert - 0 = Mensch und 1 = PC; in der Setup.ini kann man den PC ein und ausschalten!
IF Setup(4) = 0 THEN modus = 0
IF Setup(4) > 0 THEN modus = 1
' Wahl des Gegners!
IF Modus = 0 THEN beginner = 1 ' Mensch gegen Mensch
IF Modus = 1 THEN beginner = Int(Rnd * 2) + 1 ' Mensch gegen PC = Zufallsgesteuert
' Gegner aktivieren der anfängt!
IF beginner = 1 THEN MENSCH = TRUE: PC = FALSE
IF beginner = 2 THEN MENSCH = FALSE: PC = TRUE
gesperrt = TRUE
gefunden = TRUE
Anzeige = TRUE
Remis = FALSE
identisch = FALSE
Remisbieten = FALSE
A = 0
gezKartealt = 0
KartegenommenAlt = 0
PunkteMensch = 0
PunktePC = 0
Zaehler = 0
Zugzaehler = 0
klick = 0
FOR i = 1 TO 64
gezKarte(i) = 0
ZahlM(i) = 0
ZahlC(i) = 0
aufgedeckteKarten(i) = 0
Zahl(i) = 0
NEXT
MISCHEN
END SUB
SUB ENDE()
' Musik aktivieren falls möglich!
If (FSOUND_Init(44100, 4, 0) = 0) THEN
SLEEP 1
ELSE
Sound = FALSE
MUSIKAKTIVIERUNG
END IF
' Wird Remis angeboten und akzeptiert, so gilt diese Do - Loop Schleife; wird benötigt um den Tastaturpuffer zu leeren, da sonst keine Simulation angezeigt wird!!!
IF Remis THEN
DO
LOOP WHILE INKEY$ <> ""
END IF
' Bildschirmgröße für Endsequenz definieren!!!
SCREENRES 640, 640, 8
WINDOWTITLE "Hochwasser Dubletten" ' Programmname nochmals definieren - es gab Probleme ohne diese Zeile!!!
v = 4 'Zeitkonstante für die Fallgeschwindigkeit
FOR wasser = 1 TO maxpartikel
REGEN
DO
yr(wasser) = RND * 645
LOOP UNTIL POINT(xr(wasser), yr(wasser)) = 0
NEXT
' Ergebnisse anzeigen!
DO
SCREENLOCK
COLOR 14
IF Modus = 0 THEN LOCATE 20,7: PRINT "Einzelspielermodus:"
IF Modus = 1 THEN LOCATE 20,7: PRINT "Computermodus:"
IF modus = 0 THEN LOCATE 24,7: PRINT "Schwierigkeisgrad: Stufe 1 von 1"
IF modus = 1 AND Setup(4) = 1 THEN LOCATE 24,7: PRINT "Computergegner: Laie"
IF modus = 1 AND Setup(4) = 2 THEN LOCATE 24,7: PRINT "Computergegner: Anf„nger"
IF modus = 1 AND Setup(4) = 3 THEN LOCATE 24,7: PRINT "Computergegner: Leicht"
IF modus = 1 AND Setup(4) = 4 THEN LOCATE 24,7: PRINT "Computergegner: Mittel"
IF modus = 1 AND Setup(4) = 5 THEN LOCATE 24,7: PRINT "Computergegner: Schwer"
LOCATE 26,7: PRINT "Versuche: "; USING "###"; Zugzaehler
IF modus = 1 THEN LOCATE 28,7: PRINT "Anzahl der Karten von ihnen: "; USING "###"; PunkteMensch
IF modus = 1 THEN LOCATE 30,7: PRINT "Anzahl der Karten vom PC: "; USING "###"; PunktePC
' Zufallszahl ermitteln für Gewinnerermittlung!
IF Anzeige THEN Zufall = INT(RND * 12) + 1: Anzeige = FALSE
' Mensch gewonnen
IF Remis = 0 THEN
IF modus = 1 AND Zufall = 1 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Herzlichen Glckwunsch, Sie haben gewonnen!"
IF modus = 1 AND Zufall = 2 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Wer bist du denn wirklich? Gunther Karsten?"
IF modus = 1 AND Zufall = 4 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Ich habe dir schon 1000 x gesagt, du sollst nicht gegen mich gewinnen!"
IF modus = 1 AND Zufall = 5 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Jetzt reicht es langsam, dauernd verliere ich gegen dich!"
IF modus = 1 AND Zufall = 6 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Ze Fix, verloren!"
IF modus = 1 AND Zufall = 7 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Win - loose, all the same!"
IF modus = 1 AND Zufall = 8 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Dies war eine schmerzhafte Niederlage fr den PC!"
IF modus = 1 AND Zufall = 9 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Man bist du gut!"
IF modus = 1 AND Zufall = 10 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Jetzt gewinnt der auch noch gegen mich!"
IF modus = 1 AND Zufall = 11 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Ich verneige mich vor dir, mein Gebieter!!!"
IF modus = 1 AND Zufall = 12 AND PunkteMensch > PunktePC THEN LOCATE 36, 7: PRINT "Toll, ganz toll, schon wieder verloren!"
END IF
' Mensch verloren
IF Remis = 0 THEN
IF modus = 1 AND Zufall = 1 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Es tut mir leid, aber Sie haben leider verloren!"
IF modus = 1 AND Zufall = 2 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Auch ein blindes Huhn findet mal ein Korn! Hehehe!!!"
IF modus = 1 AND Zufall = 3 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Einer der nur aus Bits und Bytes besteht, gewinnt auch mal!"
IF modus = 1 AND Zufall = 4 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Computer gewinnt!"
IF modus = 1 AND Zufall = 5 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Na so was, da habe ich doch glatt gewonnen?"
IF modus = 1 AND Zufall = 6 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Ich gebe dir eine Revanche!"
IF modus = 1 AND Zufall = 7 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Computer gewinnt mit lauter Glck und Dusel auch mal ein Spiel!"
IF modus = 1 AND Zufall = 8 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Bin ich dir zu gut? Wenn nein, dann gebe dir ich nochmal eine Chance!"
IF modus = 1 AND Zufall = 9 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Kopf hoch! Beim n„chsten mal wird es besser!!!"
IF modus = 1 AND Zufall = 10 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Was ergibt 32+2? Genau, fr dich einen Verlust!"
IF modus = 1 AND Zufall = 11 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Ab jetzt zweifelt niemand mehr an meiner Intelligenz!!!"
IF modus = 1 AND Zufall = 12 AND PunkteMensch < PunktePC THEN LOCATE 36, 7: PRINT "Das war knapp! Ich hätte beinahe verloren!"
END IF
' remis, wenn Remisangebot vorliegt
IF Remis THEN
IF modus = 1 AND Zufall = 1 THEN LOCATE 36, 7: PRINT "Zum ersten mal gegeneinander gespielt und brderlich geteilt! Remis!!!"
IF modus = 1 AND Zufall = 2 THEN LOCATE 36, 7: PRINT "Dieses ewige Remisgeschiebe geht mir langsam auf die Nerven!"
IF modus = 1 AND Zufall = 3 THEN LOCATE 36, 7: PRINT "Wie sagt man so sch”n? Unentschieden!"
IF modus = 1 AND Zufall = 4 THEN LOCATE 36, 7: PRINT "Remisk”nig!"
IF modus = 1 AND Zufall = 5 THEN LOCATE 36, 7: PRINT "Gleichstand! Komm noch ein Spiel!"
IF modus = 1 AND Zufall = 6 THEN LOCATE 36, 7: PRINT "Ich stand eh auf Verlust! Remis geht schon in Ordnung!"
IF modus = 1 AND Zufall = 7 THEN LOCATE 36, 7: PRINT "Obwohl ich auf Gewinn stand, nehme ich das Remis an!"
IF modus = 1 AND Zufall = 8 THEN LOCATE 36, 7: PRINT "Ich bin mit einem Remis einverstanden!"
IF modus = 1 AND Zufall = 9 THEN LOCATE 36, 7: PRINT "Dauernd Remis!"
IF modus = 1 AND Zufall = 10 THEN LOCATE 36, 7: PRINT "Wer hat denn gewonnen? Niemand? Na, dann schnell ein neues!"
IF modus = 1 AND Zufall = 11 THEN LOCATE 36, 7: PRINT "Ich nehme das Remisangebot an!"
IF modus = 1 AND Zufall = 12 THEN LOCATE 36, 7: PRINT "Mir blieb nichts anderes brig als zu remisieren!"
END IF
' Remis wenn Punkte gleich sind und kein Remisangebot vorliegt!
IF Remis = 0 THEN
IF modus = 1 AND Zufall = 1 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Zum ersten mal gegeneinander gespielt und brderlich geteilt! Remis!!!"
IF modus = 1 AND Zufall = 2 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Dieses ewige Remisgeschiebe geht mir langsam auf die Nerven!"
IF modus = 1 AND Zufall = 3 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Wie sagt man so sch”n? Unentschieden!"
IF modus = 1 AND Zufall = 4 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Remisk”nig!"
IF modus = 1 AND Zufall = 5 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Gleichstand! Komm noch ein Spiel!"
IF modus = 1 AND Zufall = 6 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Ich stand eh auf Verlust! Remis geht schon in Ordnung!"
IF modus = 1 AND Zufall = 7 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Obwohl ich auf Gewinn stand, nehme ich das Remis an!"
IF modus = 1 AND Zufall = 8 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Ich bin mit einem Remis einverstanden!"
IF modus = 1 AND Zufall = 9 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Dauernd Remis!"
IF modus = 1 AND Zufall = 10 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Wer hat denn gewonnen? Niemand? Na, dann schnell ein neues!"
IF modus = 1 AND Zufall = 11 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Ich nehme das Remisangebot an!"
IF modus = 1 AND Zufall = 12 AND PunkteMensch = PunktePC THEN LOCATE 36, 7: PRINT "Mir blieb nichts anderes brig als zu remisieren!"
END IF
LOCATE 75,27: PRINT "Weiter mit beliebiger Taste!"
SCREENUNLOCK
' Hochwasser kommt!!!
FOR wasser = 1 TO maxpartikel
PSET (xr(wasser), yr(wasser)), &h000000
yr(wasser) = yr(wasser) + t(wasser)
IF POINT(xr(wasser), yr(wasser) + 1) <> 0 AND POINT(xr(wasser), yr(wasser) + 1) <> 14 THEN
PSET (xr(wasser), yr(wasser)), farbe(wasser)
REGEN
ELSE
PSET (xr(wasser), yr(wasser)), farbe(wasser)
END IF
NEXT
SLEEP 1
LOOP UNTIL INKEY$ <> ""
COLOR &hFFFFFF
' Bildschirmgröße wieder zurücksetzen auf ursprüngliche Größe
IF Bildschirmmodus = 1 THEN SCREENRES 1340,620,32
IF Bildschirmmodus = 2 THEN SCREENRES 1040,825,32
' alles auf Null setzen und neu mischen!!!
NULLSETZEN
MISCHEN
END SUB
SUB COMPUTER()
' Computer Laie + Anfänger + Leicht + Mittel + Schwer
IF Setup(4) > 0 THEN
' Zufallszahl ermitteln, für Computermodus: Laie + Anfänger + Leicht + Mittel!!!
Zufall = INT(RND * 10) + 1
' Laie
IF Zufall > 3 AND Setup(4) = 1 THEN
gefunden = TRUE
identisch = FALSE
GOTO vergessen
END IF
' Anfänger
IF Zufall > 4 AND Setup(4) = 2 THEN
gefunden = TRUE
identisch = FALSE
GOTO vergessen
END IF
' Leicht
IF Zufall > 5 AND Setup(4) = 3 THEN
gefunden = TRUE
identisch = FALSE
GOTO vergessen
END IF
' Mittel
IF Zufall > 6 AND Setup(4) = 4 THEN
gefunden = TRUE
identisch = FALSE
GOTO vergessen
END IF
mitDubletten:
i = 0 ' Startzähler für i
keineDubletten:
DO
' Zähler um 1 erhöhen
i += 1
' Schleife verlassen wenn keine angeklickte Karte gefunden wurde!
IF i > 64 THEN EXIT DO
' wenn eine angeklickte Karte gefunden wurde, dann Schleife verlassen und Werte speichern!!!
IF aufgedeckteKarten(i) = -1 AND gezKarte(i) = 0 THEN
KC1 = Zahl(i)
gezKartealt = KC1
IF gezKartealt > 32 THEN gezKartealt -= 32 ELSE gezKartealt += 32
EXIT DO
END IF
LOOP
k = 1
DO
' Schleife verlassen wenn keine angeklickte Karte bei i gefunden wurde!!!
IF i > 64 THEN EXIT DO
' Wenn zwei gleiche Karten gefunden wurden, dann Schleife verlassen und Werte speichern!!!
IF (aufgedeckteKarten(k) = -1) AND gezKarte(k) = 0 THEN
IF gezKartealt = Zahl(k) THEN
KC2 = Zahl(k)
gefunden = FALSE
identisch = TRUE
EXIT DO
END IF
END IF
' Zähler um 1 erhöhen
k += 1
' Schleife verlassen wenn keine angeklickte Karte gefunden wurde!
IF k > 64 THEN
EXIT DO
END IF
LOOP
' Weitersuchen wenn keine angeklickte Karte oder zwei gleiche Karten gefunden wurden!!!
IF gefunden AND i < 65 THEN GOTO keineDubletten
vergessen:
' Wenn keine Dubletten gefunden wurden, dann per Zufall zwei Karten auswählen
IF gefunden AND identisch = 0 THEN
DO
DO
KC1 = INT(RND * 64) + 1
LOOP WHILE gezKarte(KC1) = - 1
DO
KC2 = INT(RND * 64) + 1
LOOP WHILE gezKarte(KC2) = - 1
LOOP WHILE KC1 = KC2
SLEEP 300, 1
A = KC1
LADEN
SLEEP 700, 1
A = KC2
LADEN
SLEEP 2000, 1
END IF
' Karten die nicht per Zufall ausgewählt wurden anzeigen
IF identisch THEN
KC1 = i
KC2 = k
SLEEP 300, 1
A = KC1
LADEN
SLEEP 700, 1
A = KC2
LADEN
SLEEP 2000, 1
END IF
identisch = FALSE
' aufgedeckte Karten in Wert speichern!!!
aufgedeckteKarten(i) = TRUE
aufgedeckteKarten(k) = TRUE
' alte Werte speichern
Xalt = X(A)
Yalt = Y(A)
gezKartealt = Zahl(KC1)
KartegenommenAlt = A
' dafür sorgen, dass man prüfen kann, ob beide Karten gleich sind!
IF gezKartealt > 32 THEN gezKartealt -= 32 ELSE gezKartealt += 32
' Karten wieder umdrehen, wenn beide nicht identisch sind!
IF Zahl(KC2) <> gezKartealt THEN
Deckblattpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\Deckblatt.dubletten", Deckblattpuffer)
PUT (x(KC1),y(KC1)), Deckblattpuffer, PSET
PUT (Xalt,Yalt), Deckblattpuffer, PSET
IMAGEDESTROY Deckblattpuffer
END IF
' Karten aus dem Spiel nehmen, wenn beide identisch sind!
IF Zahl(KC2) = gezKartealt THEN
gezKarte(KC1) = TRUE
gezKarte(KC2) = TRUE
gefunden = TRUE
Leerpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\0.dubletten", Leerpuffer)
BLOAD (EXEPATH & "\0.dubletten", Leerpuffer)
PUT (x(KC1),y(KC1)), Leerpuffer, PSET
PUT (Xalt,Yalt), Leerpuffer, PSET
IMAGEDESTROY Leerpuffer
KC1 = 0
KC2 = 0
' Prüfung wie viele Karten aufgedeckt wurden
FOR i = 1 TO 64
IF Zahl(i) = 1 THEN Zaehler = Zaehler + Zahl(i)
NEXT
' Punktezähler des Computers
ZahlC(A) = 1
ZahlC(KartegenommenAlt) = 1
PunktePC = 0
FOR i = 1 TO 64
IF ZahlC(i) = 1 THEN PunktePC = PunktePC + ZahlC(i)
NEXT
PunktePC *= 2
' wenn alle Karten aufgedeckt wurden, Ergebnis speichern und dann Ende anzeigen
IF Zaehler = 32 THEN
DIM f AS INTEGER = FREEFILE
OPEN "Statistik.TXT" FOR APPEND AS #f
IF PunkteMensch <> PunktePC THEN
IF Modus = 1 AND Setup(4) = 1 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Laie", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 2 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Anfänger", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 3 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Leicht", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 4 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Mittel", "Mensch:", PunkteMensch, "Computer:", PunktePC
IF Modus = 1 AND Setup(4) = 5 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Schwer", "Mensch:", PunkteMensch, "Computer:", PunktePC
END IF
IF PunkteMensch = PunktePC THEN
IF Modus = 1 AND Setup(4) = 1 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Laie", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 2 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Anfänger", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 3 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Leicht", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 4 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Mittel", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
IF Modus = 1 AND Setup(4) = 5 THEN PRINT #f, Zugzaehler, DATE, TIME, "Computermodus: Schwer", "Mensch:", PunkteMensch, "Computer:", PunktePC, "Remis!"
END IF
CLOSE #f
ENDE
END IF
EXIT SUB
END IF
END IF
' Mensch wieder am Zug, wenn Computer keine zwei gleichen Karten gefunden hat!!!
Mensch = TRUE
pc = FALSE
END SUB
SUB LOESUNG()
gesperrt = FALSE
' Lösung auf dem Bildschirm anzeigen!
IF Bildschirmmodus = 1 THEN
j = 5
k = 5
FOR i = 1 TO 64
LOCATE k, j: PRINT zahl(i)
j += 13
IF j > 173 THEN k += 13: J = 5
NEXT
END IF
IF Bildschirmmodus = 2 THEN
j = 5
k = 5
FOR i = 1 TO 64
LOCATE k, j: PRINT zahl(i)
j += 13
IF j > 108 THEN k += 13: J = 5
NEXT
END IF
SLEEP 500
CLS
' Karten verdeckt anzeigen, damit Lösung wieder verschwindet!
Deckblattpuffer = IMAGECREATE(100,100)
BLOAD (EXEPATH & "\Deckblatt.dubletten", Deckblattpuffer)
IF Bildschirmmodus = 1 THEN
A = 1
FOR k = 1 TO 5
FOR i = 1 TO 13
IF K = 5 AND i = 13 THEN EXIT FOR
IF gezKarte(A) = 0 THEN PUT (103*i-103,103*k-103), Deckblattpuffer, PSET
A += 1
NEXT
NEXT
END IF
IF Bildschirmmodus = 2 THEN
A = 0
FOR k = 1 TO 8
FOR i = 1 TO 8
IF gezKarte(A) = 0 THEN PUT (103*i-103,103*k-103), Deckblattpuffer, PSET
A += 1
NEXT
NEXT
END IF
IMAGEDESTROY(Deckblattpuffer)
' Anzahl der Versuche um 1 erhöhen wenn geschummelt wird!!!
Zugzaehler += 1
END SUB
SUB MUSIK()
' Musik initialisieren und abspielen
COLOR &hFFFFFF
If (FSOUND_Init(44100, 4, 0) = 0) Then
Print "Could not initialize FMOD"
SLEEP
End 1
End IF
FSOUND_Stream_SetBufferSize(50)
DIM AS FSOUND_STREAM Ptr stream = FSOUND_Stream_Open(SOUND_FILE, FSOUND_MPEGACCURATE, 0, 0)
If (stream = 0) Then
Print "FMOD could not load '" & SOUND_FILE & "'"
FSOUND_Close()
SLEEP
End 1
End IF
FSOUND_Stream_Play(FSOUND_FREE, stream)
END SUB
SUB MUSIKAKTIVIERUNG()
Musiksperre = FALSE
IF Sound THEN
Sound = FALSE
FSOUND_Close()
Setup(2) = 0
IF Bildschirmmodus = 1 AND Sound = 0 THEN LOCATE 73, 4: PRINT "Musik: aus"
IF Bildschirmmodus = 2 AND Sound = 0 THEN LOCATE 7, 106: PRINT "Musik: aus"
EXIT SUB
END IF
IF Sound = 0 THEN
Sound = TRUE
FSOUND_Close()
Setup(2) = 1
IF Bildschirmmodus = 1 AND Sound THEN LOCATE 73, 4: PRINT "Musik: ein"
IF Bildschirmmodus = 2 AND Sound THEN LOCATE 7, 106: PRINT "Musik: ein"
MUSIK
END IF
END SUB
SUB SPEICHERN()
' Einstellungen speichern
DIM f AS INTEGER = FREEFILE
OPEN "Setup.ini" FOR OUTPUT AS #f
i = 1
DO
IF i > 1 THEN PRINT #f, Setup(i), Namen(i) ELSE PRINT #f, Namen(i)
i += 1
LOOP WHILE i < 6
CLOSE #f
END SUB
SUB REGEN()
' Damit es regnet!!!
yr(wasser) = 0
farbe(wasser) = FIX(RND * 4) + 52
reserviert(xr(wasser)) = 0
DO
xr(wasser) = FIX(RND * 640)
LOOP WHILE reserviert(xr(wasser)) = 1
reserviert(xr(wasser)) = 1
t(wasser) = RND * v + v
END SUB
SUB REMISPRUEFUNG()
' errechnen der Werte
offeneKarten = 64 - (PunktePC + PunkteMensch)
Prozent = (offeneKarten / 64) * 100
' Prüfung ob Spiel Remis gegeben werden kann bei Remisangebot!
IF PunktePC > PunkteMensch AND Prozent > 50 THEN Remis = FALSE: EXIT SUB
IF Prozent > 50 THEN Remis = FALSE: EXIT SUB
IF PunktePC > 32 THEN Remis = FALSE: EXIT SUB
IF PunktePC - PunkteMensch = 2 AND Prozent < 18 THEN Remis = TRUE
IF PunktePC = 30 AND PunkteMensch = 30 THEN Remis = TRUE
IF PunktePC < PunkteMensch AND Prozent < 20 THEN Remis = TRUE
IF PunktePC < PunkteMensch AND PunkteMensch > 24 THEN Remis = TRUE
IF Remis THEN Remisbieten = TRUE
END SUB
SUB REMISANBIETEN()
' errechnen der Werte
offeneKarten = 64 - (PunktePC + PunkteMensch)
Prozent = (offeneKarten / 64) * 100
' Prüfung ob Remis angeboten werden kann!
IF PunktePC > PunkteMensch AND Prozent > 50 THEN Remisbieten = FALSE: EXIT SUB
IF Prozent > 50 THEN Remisbieten = FALSE: EXIT SUB
IF PunktePC > 32 THEN Remisbieten = FALSE: EXIT SUB
IF PunktePC - PunkteMensch = 2 AND Prozent < 18 THEN Remisbieten = TRUE
IF PunktePC = 30 AND PunkteMensch = 30 THEN Remisbieten = TRUE
IF PunktePC < PunkteMensch AND Prozent < 20 THEN Remisbieten = TRUE
IF PunktePC < PunkteMensch AND PunkteMensch > 24 THEN Remisbieten = TRUE
' Wenn Stellung es zulässt, bietet Computer Remis an!
#IFDEF __FB_WIN32__
IF Remisbieten THEN IF MessageBox(0, "Computer bietet ihnen Remis! Nehmen sie es an?", "Remisangebot", MB_YESNO OR MB_ICONQUESTION OR MB_SYSTEMMODAL) = IDYES THEN Remis = TRUE: Remisbieten = TRUE
#ENDIF
END SUB