![]() ![]() 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 --------------------------------------------------------- Passender Link: Bedienungsanleitung zur Open-Macro und Open-Maxi Meine Homepage: http://ccintern.dharlos.de |
Antwort schreiben |