Liberty BASIC Community Forum
« Card Game Contest! »

Welcome Guest. Please Login or Register.
Jun 25th, 2017, 12:21am


Rules|Home|Help|Search|Recent Posts|Notification


« Previous Topic | Next Topic »
Pages: 1 ... 4 5 6  Notify Send Topic Print
 veryhotthread  Author  Topic: Card Game Contest!  (Read 6667 times)
Janet
Administrator
ImageImageImageImageImage


member is offline

Avatar




Homepage PM


Posts: 4111
smiley Re: Card Game Contest!
« Reply #75 on: Dec 7th, 2011, 07:28am »

Congratulations jaba/Jack. smiley

Go Fish is fun to play and I certainly enjoyed learning more about the cards dll as the contest progressed. Thanks not only for the entertaining game, but also for the ongoing discussion about how best to deselect and redisplay the cards.

If anyone hasn't tried out Jack's game yet, I have just one thing to say

GO FISH!


grin
« Last Edit: Dec 7th, 2011, 07:29am by Janet » User IP Logged

Windows 7 Professional, SP1, 64 bit Intel Core i5-4200U CPU @ 1.60 GHz 2.30 GHz 6.00 GB

"I am very busy finding out what people mean by what they say." -
CarlGundel
Administrator
ImageImageImageImageImage


member is offline

Avatar

author of Liberty BASIC


Homepage PM


Posts: 2806
xx Re: Card Game Contest!
« Reply #76 on: Dec 7th, 2011, 8:46pm »

Congratulations Jack! Contest results like this should be posted in the announcements forum, I think. smiley

-Carl
on Dec 6th, 2011, 12:15pm, nukesrus21 wrote:
On behalf of the myself and the rest of the staff I am happy to announce that Jack Burman, or jaba as he is known on the forum, is the WINNER of the Card Game Contest with his implementation of the classic card game - Go Fish!

Jack provided a wonderful implementation of this timeless classic which I'm sure a lot of you grew up playing. You can find his entry here - gofish_min.zip

Thanks to those who supplied entries for the contest.

Please join me in congratulating Jack for a job well done!!


{:0)

Brandon
User IP Logged

author of Liberty BASIC
http://www.libertybasic.com
G. Rahman
Guru
ImageImageImageImageImage


member is offline

Avatar




Homepage PM

Gender: Male
Posts: 1137
smiley Re: Card Game Contest!
« Reply #77 on: Dec 30th, 2011, 11:39am »

My entry that I never published:

Code:
'Fietsen Gordon (c) 2011
'idea from a TRS80 program game written by Paul Rodenburg
'TRS80 (Tandy Radio Shack computer in the 80s) uses 3-dimensioned arrays,
'LB doesn't so I had to rewrite everything.
'I choose card32.dll but could have chosen card.dll from Microsoft
'if I knew how delete a card using MS card.dll

    nomainwin
    WindowWidth = 1100
    WindowHeight = 900
    UpperLeftX=int((DisplayWidth-WindowWidth)/2)
    UpperLeftY=int((DisplayHeight-WindowHeight)/2)

for T = 1 to 4 :numPl$(T) = str$(T) :next T

    statictext #main.statictext1, "Number of players", 010,  25, 120, 025
    statictext #main.statictext2, "Name of players  ", 180,  25, 120, 025
    statictext #main.statictext3, " ", 480,  25, 420, 250
    statictext #main.statictext4, "Computer plays?", 180,  245, 120, 025
    checkbox #main.radio1, "",[s],[rs],160,275,20,20
    combobox #main.cbox, numPl$(),[nP],10,50,40,140
    textbox #main.textb1, 180,050,100,30
    textbox #main.textb2, 180,100,100,30
    textbox #main.textb3, 180,150,100,30
    textbox #main.textb4, 180,200,100,30
    textbox #main.textb5, 180,270,100,30
    button #main.but,"<ENTER>",[enter],ul,579,245

    open "FIETSEN" for window as #main
    #main, "font ms_sans_serif 10"
    #main, "trapclose [quit.main]"
    #main.radio1 "setfocus"
    #main.radio1 "set"
    #main.textb5 "COMPUTER"

for T = 1 to 4
var$ = "#main.textb";T
#var$ "!hide"
next T

fietsen$ = "FIETSEN"+chr$(13)_
            +"PLAYERS HAVE TO EXTEND THE CARDSUITS."+CHR$(13)_
            +"AT THE START THE 10 OF EACH SUIT IS SHOWN."+CHR$(13)_
            +"THE SUITS HAVE TO BE COMPLETED TO 2 AND ACE.             "+CHR$(13)_
            +"THE GAME IS PLAYED IN TURNS AND WHEN EVER POSSIBLE"+CHR$(13)+CHR$(13)_
            +"THE PLAYER(S) HAVE TO PLACE A CARD!"+CHR$(13)+CHR$(13)_
            +"IF ONE WANTS TO PLAY A KNOWN SYSTEM THEN THE COMPUTER    "+CHR$(13)_
            +"WILL PLAY THE SYSTEM (4 SYSTEMS ARE KNOWN) WITHOUT       "+CHR$(13)_
            +"SHOWING THE PLAYER CARDS!            "+CHR$(13)+CHR$(13)+CHR$(13)_
            +"PRESS HERE                            TO CONTINUE"

            #main.statictext3 fietsen$
wait

[s]
    #main.radio1 "set"
    #main.textb5 "COMPUTER"
    wait
[rs]
    #main.radio1 "reset"
    #main.textb5 ""
    wait

[nP]
#main.cbox "selectionindex? index"
#main.but "!setfocus"
AS1 = index

for T = 1 to 4
var$ = "#main.textb";T
#var$ "!hide"
next T

for T = 1 to index
var$ = "#main.textb";T
#var$ "!show"
next T
wait

[enter]
for T = 1 to index
var$ = "#main.textb";T
#var$ "!contents? player$"
player$(T) = player$
next T

for T = 1 to index: N$(T) = player$(T):next T

#main.textb5 "!contents? comp$"
if comp$ <> "" then AO = 1
close #main

'------------------------------------------New display------------------
    open "qcard32.dll" for dll as #qc

'loadbmp "fietsen","fietsen.bmp"

    button #1.b, "PASS",[cantPlay],UL, 970,20
    open "FIETSEN Card Game" for graphics as #1
'    #1 "drawbmp fietsen 0 0"
    #1 "trapclose [quit]"
    hBox = hwnd(#1)

    Call InitializeDeck hBox
    #1 "down; fill 10 190 225"
    playwave "shuffle.wav",sync
    #1 "when leftButtonUp [go]"


dim CB(53),CC(53),CP(53)
'CB() Cards of Bar (playdeck on display bar etc)
'CC() Cards of Computer
'CP() Cards of Player

    for I = 1 to 52
        CC(I) = 1           'CC is the computer deck (all cards to comp)
    next I

'-------------------------- 4 tenth cards to ----- display and CB() adjust
Cd=4
for Card = 10 to 52 step 13
    Rd = 9:Cd = Cd + 1:gosub [displCard]
    CC(Card) = 0 :CP(Card) = 0 :CB(Card) = 1
next Card

'--------------------------- rest of deck dealt to CP and CC --------
TC = 52 -4 'TC = total number of cards = 48
numPl = 2



while AC<(TC/numPl)
Card = int(rnd(0)*52+1)
R = (Card-1)-int((Card-1)/13)*13+1
C = int((Card-1)/13+1)

if CC(Card)=1 then
    if Card = 1 or Card = 14 or Card = 27 or Card =40 then
    Rd = R+12:Cd = C:gosub [displCard]
    else
    Rd = R-1 :Cd = C:gosub [displCard]
    end if
CC(Card)=0 : CP(Card) = 1
AC = AC +1
end if
wend
wait



'----------------------------------------------------------------
[cantPlay]
player = 0
goto [compplays]
wait

[go]


X = MouseX : Y = MouseY

    if Y <100 then C=1:goto [goF]
    if Y <200 then C=2:goto [goF]
    if Y <300 then C=3:goto [goF]
    if Y <400 then C=4:goto [goF]
    if Y >400 then wait
[goF]
    if X <070 then R=2 :goto [goF2]
    if X <140 then R=3 :goto [goF2]
    if X <210 then R=4 :goto [goF2]
    if X <280 then R=5 :goto [goF2]
    if X <350 then R=6 :goto [goF2]
    if X <420 then R=7 :goto [goF2]
    if X <490 then R=8 :goto [goF2]
    if X <560 then R=9 :goto [goF2]
    if X <630 then R=10 :goto [goF2]
    if X <700 then R=11 :goto [goF2]
    if X <770 then R=12 :goto [goF2]
    if X <840 then R=13 :goto [goF2]
    if X <910 then R=01 :goto [goF2]
    if X >910 then wait
[goF2]

Card = (C-1)*13+R
'-------------------------------remove card and display in bar (bottom part of screen) ------------

if CP(Card)=1 and (Card = 1 or Card = 14 or Card = 27 or Card =40) then
     if CB(Card +12)= 1 then
        gosub [removeCard]
        R = R +12 :Rd = R:Cd = C:gosub [displCard2]
        CP(Card)=0
        CB(Card) =1
        player = 0: goto [compplays]
    end if
end if
if CP(Card)=1 and R<10 then
    if CB(Card+1)=1 then
        gosub [removeCard]
        R = R -1 :Rd = R:Cd = C:gosub [displCard2]
        CP(Card)=0
        CB(Card) =1
        player = 0 :goto [compplays]
    end if
end if
if CP(Card)=1 and R>10 then
    if CB(Card-1)=1 then
        gosub [removeCard]
        R = R -1 :Rd = R:Cd = C:gosub [displCard2]
        CP(Card)=0
        CB(Card) =1
        player = 0: goto [compplays]
    end if
end if

wait

'----------------------------------------------------------------
[quit.main] 'End the program
    close #main
    end

[quit]
    close #qc
    close #1
    end

''''''''''''''''''''
'subs and functions:

Sub Pause ms
    calldll #kernel32,"Sleep",_
    ms as long, re as void
    End Sub

Sub InitializeDeck hndle
    calldll #qc, "InitializeDeck",_
    hndle as long,r as long
    End Sub

Sub DealCard hndle,nC,x,y
    calldll #qc, "DealCard",hndle as long,nC as long,_
    x as long,y as long,r as void
    End Sub

Sub RemoveCard hndle,nC
    calldll #qc, "RemoveCard",hndle as long,_
    nC as long,r as void
    End Sub



[removeCard]
        Call RemoveCard hBox,Card
        playwave "card.wav",sync
        call Pause 100
        return
[displCard]
        Call DealCard hBox,Card,(Rd)*70-70,(Cd)*100-100 +5
        playwave "card.wav",sync
        call Pause 100
        return
[displCard2]
        Call DealCard hBox,Card,(Rd)*70-70,(Cd+4)*100-100 +5
        playwave "card.wav",sync
        call Pause 100
        return

'------------------------------------------------------
'              computer thinks and plays

'--- stupid lousy play
[compplays]
startplace = int(rnd(0)*52)+1


for Card = startplace to 52
    if CC(Card)=1 then
    R =(Card-1)-(int((Card-1)/13)*13+1)+2
    C = (int((Card-1)/13+1))
    end if

    if CC(Card)=1 and (Card = 1 or Card = 14 or Card = 27 or Card =40) then
        if CB(Card+12)=1 then
        R=13 :Rd = R:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player = 1
        exit for
        end if
    end if

    if CC(Card)=1 and R<10 and R>1 then
        if CB(Card+1)=1 then
        Rd = R-1:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player =1
        exit for
        end if
    end if

    if CC(Card)=1 and R>10 and R<14 then
        if CB(Card-1)=1 then
        Rd = R-1:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player = 1
        exit for
        end if
    end if

next Card

if player = 1 then wait

for Card = 1 to startplace
    if CC(Card)=1 then
    R =(Card-1)-(int((Card-1)/13)*13+1)+2
    C = (int((Card-1)/13+1))
    end if

    if CC(Card)=1 and (Card = 1 or Card = 14 or Card = 27 or Card =40) then
        if CB(Card+12)=1 then
        R=13 :Rd = R:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player = 1
        exit for
        end if
    end if

    if CC(Card)=1 and R<10 and R>1 then
        if CB(Card+1)=1 then
        Rd = R-1:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player = 1
        exit for
        end if
    end if

    if CC(Card)=1 and R>10 and R<14 then
        if CB(Card-1)=1 then
        Rd = R-1:Cd = C:gosub [displCard2]
        CB(Card) = 1
        CC(Card) = 0
        player = 1
        exit for
        end if
    end if

next Card

if player = 0 then notice "Computer Passes" :player = 1

wait

 





Why didn't I post it?
The computer game is not strong....
b.t.w. remove the playwave if you down have them...


Gordon
User IP Logged

Gordon Rahman

http://www.libertybasic.nl
Pages: 1 ... 4 5 6  Notify Send Topic Print
« Previous Topic | Next Topic »

Rules|Home|Help|Search|Recent Posts|Notification

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