Der Nachfolger des WDR-Computerclub mit Wolfgang Back und Wolfgang Rudolph - ...und immer ein Bit übrigbehalten!


Das Forum zur C-Control-1
Welche C-Control-Varianten existieren?
Übersicht - Suchen - Neueste 50 Beiträge - Neuer Beitrag - Login - Registrieren
INFO - FAQ - CC2-Forum - CCPro-Forum 

 Re: Demoprogramm: Spiel "Black-Jack", auch "17 & 4" genannt Kategorie: Open-Micro/Open-Mini/Open-Midi/Open-Macro/Open-Maxi (von Norbert - 10.10.2021 0:15)
 Als Antwort auf Demoprogramm: Spiel "Black-Jack", auch "17 & 4" genannt von Dietmar - 9.10.2021 14:52
Norbert nutzt:  Open-Micro, Open-Mini, Open-Midi, Open-Macro, Open-Maxi
> ' ===========================================================================
> ' 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

Bisherige Antworten: