This content is archived and may be deprecated or obsolete and is presented in the hope that it may still be useful.
REM Pairs 0.10 31-May-2005
REM (C) Jon Ripley 2005
:
ON ERROR PROC_Err
PROC_Init
:
ON ERROR PROC_Err
:
ON MOUSE PROC_Mouse(@msg%,@wparam%,@lparam%):RETURN
ON SYS PROC_Sys(@msg%,@wparam%,@lparam%):RETURN
:
PROCNewGame
REPEAT
IF showtime% AND TIME>showtime% THEN
FOR i%=0 TO 51
IF state%(i%)=2 state%(i%)=1:PROCDrawCard(i%)
NEXT
showtime%=0:showing%=0
ENDIF
SYS "Sleep",100
UNTIL FALSE
REM Finish using the DLL
PROCcdtTerm
END
:
DEF PROC_Err
IF ERR=17 ENDPROC
LOCAL r%
SYS "MessageBox",@hwnd%,"Internal error ("+REPORT$+":"+STR$ERL+"). Quit program ?","An error has occured",52 TO r%
cdtTerm%=cdtTerm%
IF r%=6 THEN
IF cdtTerm% PROCcdtTerm
QUIT
ENDIF
ENDPROC
:
DEF PROC_Init
*Esc Off
OFF
:
REM Set window size
V% = 0:W% = 0:X% = 952:Y% = 472
SYS "AdjustWindowRect", ^V%, &CF0000, 0
SYS "SetWindowPos", @hwnd%, 0, 0, 0, X%-V%, Y%-W%, 6
VDU 26
:
SYS "SetWindowText",@hwnd%,"Pairs"
:
SYS "CreatePopupMenu" TO m_file%
SYS "AppendMenu",m_file%,0,100,"&New Game"
SYS "AppendMenu",m_file%,2048,101,""
SYS "AppendMenu",m_file%,0,102,"&Hint"
SYS "AppendMenu",m_file%,0,103,"&Resign"
SYS "AppendMenu",m_file%,2048,104,""
SYS "AppendMenu",m_file%,0,105,"E&xit"
:
SYS "CreatePopupMenu" TO m_options%
SYS "AppendMenu",m_options%,0,300,"Deck &1"
SYS "AppendMenu",m_options%,0,301,"Deck &2"
SYS "AppendMenu",m_options%,0,302,"Deck &3"
SYS "AppendMenu",m_options%,0,303,"Deck &4"
SYS "AppendMenu",m_options%,0,304,"Deck &5"
SYS "AppendMenu",m_options%,0,305,"Deck &6"
SYS "AppendMenu",m_options%,0,306,"Deck &7"
SYS "AppendMenu",m_options%,0,307,"Deck &8"
SYS "AppendMenu",m_options%,0,308,"Deck &9"
SYS "AppendMenu",m_options%,0,309,"Deck 10"
SYS "AppendMenu",m_options%,0,310,"Deck 11"
SYS "AppendMenu",m_options%,0,311,"Deck 12"
:
SYS "CreatePopupMenu" TO m_help%
SYS "AppendMenu",m_help%,0,400,"&About this program..."
:
SYS "CreateMenu" TO m_main%
SYS "AppendMenu",m_main%,16,m_file%,"&Game"
SYS "AppendMenu",m_main%,16,m_options%,"&Options"
SYS "AppendMenu",m_main%,16,m_help%,"&Help"
SYS "SetMenu",@hwnd%,m_main%
SYS "DrawMenuBar",@hwnd%
:
INSTALL "CardLib.bbc"
:
REM Setup
PROCcdtInit
:
REM Turn off screen update
PROCcdtRedraw(FALSE)
:
REM Create a deck of cards
DIM deck%(51):DIM state%(51)
:
REM Misc
back%=cdFaceDownFirst
SYS "CheckMenuItem", m_options%, back%+300-cdFaceDownFirst, 8
showtime%=0
showing%=0
board%=&FFFFFF
resigned%=FALSE
hints%=0
ENDPROC
:
DEF PROC_Mouse(msg%,wparam%,lparam%)
LOCAL wlo%,whi%,llo%,lhi%,x%,y%
whi%=wparam%>>16 AND &FFFF:wlo%=wparam% AND &FFFF
lhi%=lparam%>>16 AND &FFFF:llo%=lparam% AND &FFFF
:
IF msg%=513 AND wlo%=1 AND showing%<2 AND NOT resigned% THEN
REM Convert mouse coords to grid coords
x%=(llo%-2)/(cdtWidth%+2)
y%=(lhi%-2)/(cdtHeight%+2)
:
REM Is selection within the playing field
IF x%=>0 AND x%<13 AND y%=>0 AND y%<4 THEN
REM Flip card
IF state%(FNGtoCd(x%,y%))=1 THEN
state%(FNGtoCd(x%,y%))=2:showing%+=1
ENDIF
REM Update display
PROCDrawCard(FNGtoCd(x%,y%))
REM If showing two cards set the timer
IF showing%=2 PROCCheckPair:showtime%=TIME+100
ENDIF
ENDIF
ENDPROC
:
DEF PROC_Sys(msg%,wparam%,lparam%)
LOCAL wlo%,whi%,llo%,lhi%
whi%=wparam%>>16 AND &FFFF:wlo%=wparam% AND &FFFF
lhi%=lparam%>>16 AND &FFFF:llo%=lparam% AND &FFFF
CASE msg% OF
WHEN 273
CASE wparam% OF
WHEN 100:REM m_file% > &New Game
PROCNewGame
WHEN 102:REM m_file% > &Hint
PROCHint
WHEN 103:REM m_file% > &Resign
PROCResign
WHEN 105:REM m_file% > E&xit
QUIT
WHEN 400:REM m_help% > &About this program...
SYS "MessageBox",@hwnd%,"Pairs vsn 0.10"+CHR$13+"31-May-2005"+CHR$13+"(C) Jon Ripley 2005","About this program...",64 TO r%
ENDCASE
ENDCASE
:
REM Handle Options menu
IF wparam%>=300 AND wparam%<=311 THEN
SYS "CheckMenuItem", m_options%, back%+300-cdFaceDownFirst, 0
back%=wparam%-300+cdFaceDownFirst
SYS "CheckMenuItem", m_options%, wparam%, 8
PROCDraw
ENDIF
ENDPROC
:
REM Shuffle deck of cards
DEF PROCShuffle(RETURN deck%())
LOCAL i%,j%,k%
FOR i%=0 TO 51:deck%(i%)=i%:state%(i%)=1:NEXT
FOR i%=0 TO 8+RND(16)
FOR j%=0 TO 51
k%=RND(52)-1
SWAP deck%(k%),deck%(j%)
NEXT
NEXT
ENDPROC
:
REM Draw entire playing field
DEF PROCDraw
LOCAL suit%,rank%
FOR suit%=0 TO 3
FOR rank%=0 TO 12
CASE state%(FNGtoCd(rank%,suit%)) OF
WHEN 0:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),0,mdGhost,board%)
WHEN 1:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),back%,mdFaceDown,0)
WHEN 2:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),deck%(FNGtoCd(rank%,suit%)),mdFaceUp,0)
ENDCASE
NEXT
NEXT
:
REM Redraw the screen to display cards
PROCcdtRedrawArea(0,0,14*cdtWidth%,5*cdtHeight%)
:
PROCDrawScore
ENDPROC
:
REM Display the score
DEF PROCDrawScore
PRINT TAB(2,27)"Score: ";score%;SPC(20)
PRINT TAB(2,28)"Turns: ";turns%;SPC(20)
ENDPROC
:
REM Redraw an individual card
DEF PROCDrawCard(card%)
LOCAL rank%,suit%
:
rank%=card%>>2:suit%=card% AND 3
:
CASE state%(card%) OF
WHEN 0:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),0,mdGhost,board%)
WHEN 1:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),back%,mdFaceDown,0)
WHEN 2:
PROCcdtDraw(@memhdc%,FNConvW(rank%),FNConvH(suit%),deck%(card%),mdFaceUp,0)
ENDCASE
PROCcdtRedrawArea(FNConvW(rank%),FNConvH(suit%),cdtWidth%,cdtHeight%)
ENDPROC
:
REM Grid conversion functions
DEF FNConvW(num%)
=2+(cdtWidth%*num%)+(2*num%)
:
DEF FNConvH(num%)
=2+(cdtHeight%*num%)+(2*num%)
:
DEF FNGtoCd(x%,y%)
=y%+(x%<<2)
:
REM Setup new game
DEF PROCNewGame
LOCAL tmp%
REM Set random number seed
tmp%=RND(-TIME)
PROCShuffle(deck%())
score%=0:turns%=0:resigned%=0:hints%=0
SYS "EnableMenuItem",m_file%,102,0
PROCDraw
ENDPROC
:
REM Check for user revealing a pair
DEF PROCCheckPair
LOCAL c1%,c2%,i%,c%
REM Find flipped cards
FOR i%=0 TO 51
IF state%(i%)=2 THEN
IF c% THEN
c2%=i%
ELSE
c1%=i%:c%=TRUE
ENDIF
ENDIF
NEXT
:
REM If a pair then remove carads and update score
IF FNcdtRaFromCd(deck%(c1%))=FNcdtRaFromCd(deck%(c2%)) THEN
score%+=2
state%(c1%)=0
state%(c2%)=0
PROCDrawCard(c1%)
PROCDrawCard(c2%)
ENDIF
REM Update turn count and score
turns%+=1
PROCDrawScore
ENDPROC
:
REM Resign from game
DEF PROCResign
LOCAL i%
FOR i%=0 TO 51
IF state%(i%)=1 state%(i%)=2
resigned%=TRUE
NEXT
PROCDraw
ENDPROC
:
REM Display a hint
DEF PROCHint
REPEAT
card%=RND(52)-1
UNTIL state%(card%)=1
i%=0:card2%=-1
REPEAT
IF i%<>card% AND FNcdtRaFromCd(deck%(i%))=FNcdtRaFromCd(deck%(card%)) card2%=i%
i%+=1
UNTIL card2%<>-1 OR i%=52
state%(card%)=2:state%(card2%)=2
PROCDrawCard(card%):PROCDrawCard(card2%)
T%=TIME:REPEATUNTILTIME-T%>10
state%(card%)=1:state%(card2%)=1
PROCDrawCard(card%):PROCDrawCard(card2%)
score%-=3:PROCDrawScore
hints%+=1
IF hints%=3 SYS "EnableMenuItem",m_file%,102,1
ENDPROC