  INFO - FAQ - CC2-Forum - CCPro-Forum |
|
||
|
> ' =========================================================================== > ' Demoprogramm: Spiel "Black-Jack", auch "17 & 4" genannt > ' In OCBASIC 1.12a_e1 für Open-Maxi von Dietmar Harlos am 3. Oktober 2021 > ' =========================================================================== > > ' Dieses Programm demonstriert unter anderem die Verwendung von Bitarrays > ' und die Schleifen WHILE..WEND und REPEAT..UNTIL. > > ' Die Idee stammt von der Website "http://www.kultmags.com/" aus der > ' Computerzeitschrift "Happy Computer 1984-01" ab Seite 100. > > ' An dieser Stelle möchte ich mich bei Dirk von "das |_ Team" und bei Norbert > ' für ihre Unterstützung bedanken. > > ' --- Definitionen ---------------------------------------------------------- > > INCLUDE "omax.def" 'Definitionen für die Open-Maxi > > DEFINE bitarrayaddr &h02aa 'Startadresse des Bit-Feldes hinter dem USER-RAM > > DIM bitarray BYTE 'ein Bitarray für 8 Bits > DIM nochmal BIT[1] OF bitarray > DIM first BIT[2] OF bitarray > > DIM a,b,c BYTE 'temporäre Variablen > > DIM karte BYTE 'Kartennummer des Spielers > DIM kartec BYTE 'Kartennummer des Croupiers > DIM asse BYTE 'Anzahl Asse > DIM punktes BYTE 'Punkte des Spielers > DIM punktec BYTE 'Punkte des Croupiers > > DIM nr BYTE 'Kartennummer > > DIM temp BYTE 'temporäre Variable > > DIM buchstabe BYTE 'Vom Anwender eingegebener Buchstabe > > ' --- Hauptprogramm --------------------------------------------------------- > > End2Host=ON 'Bei Programmende gleich in den Host-Modus wechseln > > RANDOMIZE 3 'Zufallszahlengenerator initialisieren. > > ?:?"Black-Jack, auch 17 & 4 genannt:":? > > asse=0 > punktes=0 > > FOR a=0 TO 51 > bitarray_clear a > NEXT a > > ?"Der Croupier zieht zwei Karten." > kartec=ziehekarte > ?"Die nicht verdeckte Karte ist "; > blatt kartec > ?"." > ? > > REPEAT > karte=ziehekarte > ?"Du hast die Karte "; > blatt karte > ?" gezogen. Sie hat den Wert "; > ?wert(karte); > IF wert(karte)=11 THEN > ?" bzw. 1"; > ADD asse,1 > END IF > ?"." > ADD punktes,wert(karte) > > nochmal=FALSE > REPEAT > ?"Du hast ";punktes;" Punkte." > IF punktes>21 THEN > IF asse>0 THEN > SUB asse,1 > SUB punktes,10 > ?"Zähle As als 1." > nochmal=TRUE > ELSE > ?:?"Du bist über 21 und hast verloren!" > GOTO abbruch > END IF > ELSE IF punktes=21 THEN > ?:?"Der Spieler hat gewonnen." > GOTO abbruch > ELSE > nochmal=FALSE > END IF > UNTIL NOT(nochmal) > > REPEAT > ?"Eine weitere Karte ziehen? [J/N]"; > buchstabe=GET > ? > IF buchstabe=ASC(" ") THEN END > IF buchstabe>=ASC("a") AND buchstabe<=ASC("z") THEN > SUB buchstabe,32 > END IF > UNTIL buchstabe=ASC("J") OR buchstabe=ASC("N") > UNTIL buchstabe=ASC("N") > > ? > asse=0 > punktec=0 > > first=TRUE > > WHILE punktec<=punktes 'punktec<17 > IF first=FALSE THEN kartec=ziehekarte > first=FALSE > ?"Der Croupier hat die Karte "; > blatt kartec > ?" gezogen. Sie hat den Wert "; > ?wert(kartec); > IF wert(kartec)=11 THEN > ?" bzw. 1"; > ADD asse,1 > END IF > ?"." > ADD punktec,wert(kartec) > > nochmal=FALSE > REPEAT > ?"Er hat ";punktec;" Punkte." > IF punktec>21 THEN > IF asse>0 THEN > SUB asse,1 > SUB punktec,10 > ?"Zähle As als 1." > nochmal=TRUE > ELSE > ?:?"Er ist über 21 und hat verloren!" > GOTO abbruch > END IF > ELSE > nochmal=FALSE > END IF > UNTIL NOT(nochmal) > > 'Sind alle Spieler bedient, zieht der Croupier seine zweite Karte. Hat er 17 > 'oder mehr Punkte, muß er stehen bleiben, hat er 16 oder weniger Punkte, muß > 'er eine weitere Karte ziehen ("Dealer must stand on 17 and must draw to 16"). > WEND > > ? > ?"Spieler: ";punktes > ?"Croupier: ";punktec > > ? > ?"Der "; > IF punktec>punktes THEN > ?"Croupier"; > ELSE > ?"Spieler"; > END IF > ?" hat gewonnen." > > #abbruch > > END 'Zurück in den Hostmodus. Neustart mit RETURN-Taste. > > ' --- Subroutinen und Funktionen -------------------------------------------- > > ' Liefert eine Kartennummer zwischen 0 und 51 zurück > > FUNCTION ziehekarte > ' ?"ziehekarte" > REPEAT > nr=((RAND SHR 1)+16384)/631 'Zufallszahl 0 bis 51 > ' ?nr;bitarray_get(nr) > UNTIL NOT(bitarray_get(nr)) > bitarray_set nr > RETURN nr > END FUNCTION > > ' Die Werte der einzelnen Karten > > ' laut https://de.wikipedia.org/wiki/Black_Jack#Die_Werte_der_einzelnen_Karten > > ' Asse zählen nach Belieben ein oder elf Punkte. (Der Wert des Asses wird erst > ' dann festgelegt, wenn der Spieler keine weitere Karte mehr kauft - dann > ' zählt der Croupier das As so, wie es für den Spieler günstiger ist.) > ' Zweier bis Zehner zählen entsprechend ihren Augen. > ' Bildkarten (Buben, Damen, Könige) zählen zehn Punkte. > > FUNCTION wert(nr) > temp=nr MOD 13 > IF temp=0 THEN > RETURN 11 > ELSE IF temp<=9 THEN > RETURN temp+1 > ELSE IF temp=10 THEN > RETURN 10 > ELSE IF temp=11 THEN > RETURN 10 > ELSE IF temp=12 THEN > RETURN 10 > ELSE > ?"Fehler in FUNC wert:";nr:END > END IF > END FUNCTION > > ' Kartenblatt auf Serieller Schnittstelle ausgeben > > PROCEDURE blatt(nr) > temp=nr/13 > IF temp=0 THEN > ?"Kreuz"; > ELSE IF temp=1 THEN > ?"Pik"; > ELSE IF temp=2 THEN > ?"Herz"; > ELSE IF temp=3 THEN > ?"Karo"; > END IF > > PUT ASC(" ") > > temp=nr MOD 13 > IF temp=0 THEN > ?"As"; > ELSE IF temp<=9 THEN > ?temp+1; > ELSE IF temp=10 THEN > ?"Bube"; > ELSE IF temp=11 THEN > ?"Dame"; > ELSE IF temp=12 THEN > ?"König"; > END IF > > RETURN > END PROCEDURE > > ' --- INCLUDE-Dateien ------------------------------------------------------- > > INCLUDE "bitarray.pro" 'INCLUDE-Datei für Bit-Feld-Routinen > INCLUDE "om_fw.pro" 'INCLUDE-Datei für Firmwareroutinen > > ' --- Programmende --------------------------------------------------------- Etwas gegen Langeweile Hallo, ein schönes Gimmick, das Dietmar wieder präsentiert. Das kann gegen Langeweile jetzt in der kalten Jahreszeit helfen. Und man kann vom Code noch etwas lernen. Norbert |
| Antwort schreiben |