Board Logo
« LARGE PRINT Game of 21 »

Welcome Guest. Please Login or Register.
Jan 16th, 2018, 3:38pm


Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Please use the forums Search feature before asking.
Please post code using the code box described in Format Your Messages.
This will keep indentation, separate it better form the message and prevent gibberish.
If the code is too long for one post or additional files are needed, upload a ZIP archive to the Just BASIC Files Archive Site.

« Previous Topic | Next Topic »
Pages: 1  Notify Send Topic Print
 thread  Author  Topic: LARGE PRINT Game of 21  (Read 166 times)
bplus
Senior Member
ImageImageImageImageImage


member is offline

Avatar




PM

Gender: Male
Posts: 1255
xx LARGE PRINT Game of 21
« Thread started on: Oct 1st, 2017, 12:23am »

Remember, not exactly like BlackJack, this is text game brought into graphics window for large print and some color. Some refinements to the way the Game of 21 is played as well...

Code:
'LARGE PRINT 21 GAME.txt for JB (B+=MGA) 2017-10-01
' from: 21 new start.txt for JB [B+=MGA] 2016-03-25
' with LARGE PRINT mod inspired by Don Johnson problem post

global xmax, ymax  'these two you can easily reset to your needs
'set these to screen width = xmax, screen height = ymax, that you want

xmax = 1000 : ymax = 700  '<<<<<< set this as you need or from plug-in notes

global cellW, cellH
'do not mess with cellW and cellH globals for printing
cellW = 14 'pixels wide for characters
cellH = 28 'pixels high for characters

global maxRow, maxCol
'and then these are calclated from above globals
maxCol = int(xmax / cellW)  'these control printing characters
maxRow = int(ymax / cellH)

global lastC, lastR 'for loc8 (locate), pl (print a line), lp (locate and print)
lastC = 1 : lastR = 1

'key events update globals with latest info
global inkee$, h$

h$ = "#gr"

nomainwin

WindowWidth = xmax + 8
WindowHeight = ymax + 32
UpperLeftX = (DisplayWidth-WindowWidth) / 2
UpperLeftY = (DisplayHeight-WindowHeight) / 2

open "         LARGE PRINT GAME OF 21" for graphics_nsb_nf as #gr '<, == change for plug in modules
#gr "trapclose quit"

'fonts that don't work arial, tahoma, verdana
'fonts that work
'#gr "font courier_new 10 20"
'#gr "font consolas 10 20"
#gr "font dejavu_sans_mono ";cellW;" ";cellH

'#gr "home"                  '< check drawing area
'#gr "posxy w2 h2"           '<<<<<<<<<<<<<<<<<<
'notice "Screen Drawing Check";chr$(13);"Size:" + chr$(13) + "Width (w2*2) = ";w2*2;",  Height (h2*2) = ";h2*2

#gr "setfocus"
#gr "when characterInput charIn"
#gr "down"

'=================================================== plug-in main modules here

DIM Deck(52), Player$(11)
'prep deck for shuffles
FOR i = 1 TO 52
    Deck(i) = i
NEXT

GLOBAL deckindex, playerindex, points, ace, playertotal, pointsrisk
points = 100

DO
    call getReady
    call getPointsRisk
    call drawcard
    call drawcard
    call playhand
    call dealer
LOOP UNTIL points = 0
call clear 0, 0, 0
#gr "color white"
call cp 10, "Game Over"
call pause 2500
call quit h$

SUB getReady
    ' shuffle deck before each round with simple and tested routine
    FOR i = 52 TO 2 step -1
        r = INT(RND(1) * i) + 1
        t = Deck(i)
        Deck(i) = Deck(r)
        Deck(r) = t
    NEXT
    ' restart these for next round
    DIM Player$(11)
    playerindex = 1 : deckindex = 1
    playertotal = 0 : pointsrisk = 0 : ace = 0
END SUB

SUB getPointsRisk
    call clear 0, rnd(0) * 100 + 155, rnd(0)*100 + 155
    call cp 4, "You have ";str$(points);" points available to risk:"
    call loc8 18, 8
    call inp " (0 = quit)  Enter point risk > ", pointsrisk$
    pointsrisk = val(pointsrisk$)
    IF pointsrisk <= 0  THEN
        call cp 10, "OK, goodbye"
        call pause 2500
        call quit h$
    ELSE
        IF pointsrisk > points THEN pointsrisk = points
    END IF
END SUB

SUB drawcard
    value = Deck(deckindex) mod 13
    IF value = 1 THEN
        IF ace = 0 OR ace = 1 THEN
            IF playertotal < 11 THEN ace = 11 ELSE ace = 1
            playertotal = playertotal + ace
        ELSE
            playertotal = playertotal + 1
        END IF
    ELSE
        IF value > 1 AND value < 10 THEN
            playertotal = playertotal + value
        ELSE
            playertotal = playertotal + 10
        END IF
    END IF
    IF playertotal > 21 AND ace = 11 THEN playertotal = playertotal - 10 : ace = 1
    Player$(playerindex) = Cardname$(value)
    deckindex = deckindex + 1 : playerindex = playerindex + 1
END SUB

SUB playhand
    g = rnd(0) * 100 + 155 : b = rnd(0) * 100 + 155
    WHILE 1
        call clear 0, g, b
        call cp 2, "TWENTYONE";"     Points: ";str$(points);"    risking ";str$(pointsrisk)
        s$ = "Player's cards: "
        FOR i=1 TO playerindex-1
            s$ = s$ + " " + Player$(i)
        NEXT
        call cp 6, s$
        call cp 8, "Card total at present is " + str$(playertotal)
        if playertotal >= 21 then exit while
        s$ = "Enter 1 for another card, 2 to stay "
        IF ace = 11 and playertotal <> 21 THEN s$ = s$ + "or 3 to change ace value to one "
        call cp 10, s$
        DO
            call loc8 35, 12
            call inp "", choice$
            choice = val(choice$)
        LOOP UNTIL choice = 1 OR choice = 2 OR (choice = 3 AND ace = 11)
        IF choice = 1 THEN
            CALL drawcard
        ELSE
            IF ace = 11 AND choice = 3 THEN
                playertotal = playertotal - 10 : ace = 1
            ELSE
                EXIT WHILE
            END IF
        END IF
    WEND
END SUB

SUB dealer
    s$ = "Dealer's cards: "
    if playertotal < 22 then enough = playertotal else enough = 12
    WHILE dealtotal <= enough
        s$ = s$ + " " + Cardname$(Deck(deckindex))
        dcard = Deck(deckindex) MOD 13
        deckindex = deckindex + 1
        IF dcard = 1 THEN 'deal with ace
            IF dealtotal < 11 THEN  'go for or make 21
                dealtotal = dealtotal + 11 : dealace = 11
            ELSE
                dealtotal = dealtotal + 1
            END IF
        ELSE
            IF dcard > 1 AND dcard < 10 THEN
                dealtotal = dealtotal + dcard
            ELSE
                dealtotal = dealtotal + 10
            END IF
        END IF
        IF dealtotal > 21 AND dealace = 11 THEN
            dealtotal = dealtotal - 10
            dealace = 1
        END IF
    wend
    call cp 16, s$
    call cp 18, "The dealer has a total of " +str$(dealtotal) + "."
    IF (playertotal > dealtotal AND playertotal <= 21) OR (playertotal <= 21 AND dealtotal > 21) THEN
        points = points + pointsrisk
        call cp 21, "You won " + str$(pointsrisk) + " points!"
    ELSE
        IF (dealtotal > playertotal AND dealtotal <= 21) OR (playertotal > 21 AND dealtotal <= 21) THEN
            points = points - pointsrisk
            call cp 21, "You lost " + str$(pointsrisk) + " points."
        ELSE
            call cp 21, "You tied."
        END IF
    END IF
    call loc8 23, 24
    call inp "Press enter to continue... ", temp$
END SUB

FUNCTION Cardname$(avalue)
    SELECT CASE avalue mod 13
    CASE 1
        cn$ = "Ace"
    CASE 11
        cn$ = "Jack"
    CASE 12
        cn$ = "Queen"
    CASE 0
        cn$ = "King"
    CASE 2, 3, 4, 5, 6, 7, 8, 9,10
        cn$ = str$(avalue mod 13)
    END SELECT
    Cardname$ = cn$
END FUNCTION


wait ' end plug-in section ==========================
'========================== subset of DE procedures

sub charIn hdl$, c$
    inkee$ = c$ 
end sub

sub quit hdl$
    timer 0
    close #gr
    end
end sub

sub clear r, g, b 'clear screen to new RGB color and set backcolor
' and set up so pl (print line) will start at line 1, cell column 1)
    #gr "fill ";r;" ";g;" ";b
    #gr "backcolor ";r;" ";g;" ";b
    lastC = 1 : lastR = 1
end sub

sub loc8 x, y   'locate xColumnCell, yRowCell for printing
    if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
        lastC = x
        lastR = y
    end if
end sub

sub pl mess$ 'print line (feed)
    startR = lastR
    for i = 1 to len(mess$)
        scan
        call lp lastC, lastR, mid$(mess$, i, 1)
        if lastR <> startR then exit for
    next
    lastC = 1
    lastR = startR + 1
    if lastR > maxRow then lastR = maxRow 'yuck!
end sub

sub lp x, y, mess$ 'locate x, y : print mess$ lp = locate and print
    'if locate = x col and y row then and top left corner locates as 1, 1
    c = x - 1: r = y
    if 0 < x and x < maxCol + 1 and 0 < y and y < maxRow + 1 then
        #gr "place ";c * cellW;" ";r * cellH - 4
        #gr "|";mess$
        lastC = x + len(mess$)
        if lastC > maxCol then lastC = 1 : lastR = lastR + 1
        if lastR > maxRow then lastR = maxRow 'yuck!
    end if
end sub

sub cp y,cpText$ 'cp Center Print on line y the cpText$
    call lp int((maxCol - len(cpText$))/2 + 1.5), y, cpText$
    lastC = 1 : lastR = y + 1
end sub

sub inp prmpt$, byref var$   'input
'prints prompt at lastC, lastR and leaves lastC = 1 lastR = pRow + 1

    inkee$ = "" 'clear last key (new fix for DE5)
    call lp lastC, lastR, prmpt$;"{"
    'this will update lastR and lastC to the starting point of input variable
    pRow = lastR : pCol = lastC 'save these for redrawing var
    call lp pCol, pRow, "}"
    OK$ = "ABCDEFGHIJKLMNOPQRSTUVWXYZ abcdefghijklmnopqrstuvwxyz"
    OK$ = OK$+ chr$(8)+ chr$(27) + chr$(13) + "1234567890!@#$%^&*()_-+={}[]|\:;'<,>.?/"
    do
        scan
        if instr(OK$, inkee$) then
            if inkee$ = Chr$(8) then
                if t$ <> "" then
                    if Len(t$)=1 then t$="" else t$=Left$(t$,Len(t$)-1)
                end if
            else
                if inkee$=Chr$(13) or inkee$=Chr$(27) then
                    'new D5, I was expecting nothing in return for my esc
                    if inkee$ = chr$(27) then t$ = ""
                    exit do
                else
                    t$=t$;inkee$
                end if
            end if
            call lp pCol, pRow, t$;"} "
            inkee$ = ""
        end if
    loop until done
    var$ = t$
    lastC = 1 : lastR = pRow + 1
end sub

sub at xPix, yPix, char$  'print a string at pixel x, y This pin point locating.
    #gr "place ";xPix;" ";yPix
    #gr "|";char$ 
end sub

sub pause mil   'tsh version has scan built-in
    t0 = time$("ms")
    while time$("ms") < t0 + mil : scan : wend
end sub

 
User IP Logged

B+
Pages: 1  Notify Send Topic Print
« Previous Topic | Next Topic »

Conforums Terms of Service | Membership Rules | Home | Search | Recent Posts | Notification | Format Your Message | Installation FAQ

Donate $6.99 for 50,000 Ad-Free Pageviews!

| |

This forum powered for FREE by Conforums ©
Sign up for your own Free Message Board today!
Terms of Service | Privacy Policy | Conforums Support | Parental Controls