Hi there!
Here's another from my Merlin's Wide and Wonderful World of Mystical Magic series ...... Mystical Magic Card Predictor.
There is one small but insignificant problem ...... When clicking outside card areas, some text flashes ...... I don't know why ...... Perhaps someone will find where I've gone wrong.
I have posted the code here but it and necessary media are in the attached .zip file
[pbcode]
rem ==========================================================================
rem Initialise program
rem ==========================================================================
rem Set the max frames per second this program should execute at
SetFps 61.7
rem Pre-load required fonts
Arial24 =loadnewfont("arial bold",24,0)
Arial40 =loadnewfont("arial bold",40,0)
rem Declare array/s
Dim CardIMages(1)
Dim cardimage(52)
rem Create an array with 52 spaces (+1 to avoid using '0').
Dim deck(53)
rem Fill the deck(xx) with values 1 to 52
for cards=1 to 52
deck(cards)=cards
next cards
rem Declare global variables
global tc
global across
global down
global choice
rem Declare global font
global Arial24
rem Pre-load required media
baseimage=loadnewimage("base.bmp")
backdropimage=loadnewimage("backdrop.bmp")
global cardbackimage=loadnewimage("Cardback.bmp")
global backdrop2image=loadnewimage("backdrop2.png")
for lp=1 to 13
CardIMage(lp) = LoadNewImage(Str$(lp)+"H"+".Bmp")
CardIMage(13+lp) = LoadNewImage(Str$(lp)+"C"+".Bmp")
CardIMage(26+lp) = LoadNewImage(Str$(lp)+"D"+".Bmp")
CardIMage(39+lp) = LoadNewImage(Str$(lp)+"S"+".Bmp")
next
rem Determine card width, height and number of unique cards in pack
CardWidth =71
CardHeight =96
NumberOfCardsInDeck =50
rem Set text style and size
setfont arial24
rem Set ink colour
ink rgb(255,217,128)
rem Call function to create images to represent the deck of cards.
Make_Card_Graphics(NumberOfCardsInDeck,CardWidth,CardHeight,CardImages())
rem ==========================================================================
rem Declare Type to represent CARDS within the game
rem ==========================================================================
Type tCard
rem State of this card. Not matched/ Selected / or matched
State
rem Screen position of this card
Xpos
Ypos
EndType
rem ==========================================================================
rem Programme Main Loop
rem ==========================================================================
rem Display an image
drawimage baseimage,0,0,false
rem Write text to screen
centertext 310,270,"Hello! My name is Merlin. "
centertext 310,300,"Welcome to my Mystical Magic Card Predictor."
centertext 310,500,"Press any key to start."
rem wait for a keypress
waitkey
waitnokey
rem Display an image
drawimage backdropimage,0,0,false
rem Jump to Play a game
Gosub PLay_Game
rem Call the end of program sub routine
gosub End_OF_Program:
rem END (TERMINATE) the PROGRAM
End
rem ==========================================================================
rem End Program Subroutine
rem ==========================================================================
End_OF_Program:
rem Set text style and size
setfont arial40
StartTime=Timer()
repeat
boxc 0,0,798,598,1,rgb(255,0,0)
CurrentTime=Timer()
Timepast=ClipRange(Timer()-StartTime,1,1000)
Ink rgbfade(rgb(255,217,128),(1000-TimePast)/10.0)
Xpos= GetScreenWidth()/2
Ypos= GetScreenHeight()*0.40
CenterText Xpos,Ypos,"Thanks For Playing!"
rem Display the Screen
Sync
until CurrentTime>(StartTime+1000)
rem Return to where this subroutine was called
return
rem ==========================================================================
rem Play Game Subroutine
rem ==========================================================================
PLay_Game:
rem Calculate the number of cards that the player will be able to choose from
NumberOfCards=NumberOfCardsInDeck
rem Dimension the card array to hold the info about each of the cards
Dim Cards(NumberOfCards) as tCard
rem Create and randomize the card sequence
Dim CardSequence(NumberOfCards)
index=1
For lp=1 to NumberOfCards step 2
CardSequence(lp)=Index
CardSequence(lp+1)=Index
Inc index
next
rem Initialise cards position and layout upon the screen.
Row =0
CardsPerRow =10
CardPadX =5
CardPadY =5
Ypos =80-(CardHeight+CardPadY)
For ThisCard=1 To NumberOfCards
if Row=0
Xpos=((CardWidth+CardPadX)*CardsPerRow)/2
Xpos=(GetScreenWidth()/2)-Xpos
ypos=ypos+CardHeight+CardPadY
endif
rem Position (top Left)
Cards(ThisCard).Xpos=Xpos
Cards(ThisCard).Ypos=Ypos
xpos=xpos+CardWidth+CardPadX
Row=Mod(Row+1,CardsPerRow)
Next
rem Repeat until the spacekey is pressed
Repeat
rem Draw box to hide previous text at location
boxc 2,0,398,75,1,rgb(255,0,0)
boxc 400,0,798,75,1,rgb(255,0,0)
rem Write text to screen
text 20,30,"Merlin's Mystical Magic Card Predictor"
text 800-gettextwidth("Choose a card and click on it")-30,10,"Choose a card and click on it"
text 800-gettextwidth("Press Spacekey to finish")-30,50,"Press Spacekey to finish"
rem Display the Screen
sync
rem Poll mouse state this frame
Mx =mouseX()
My =mouseY()
Mb =mouseButton()
rem Detect if mouse button is pressed
if mb
rem Draw box to hide previous text at location
boxc 400,0,798,40,1,rgb(255,0,0)
rem If it was, lets check if the mouse is over a card
For ThisCard=1 To NumberOfCards
rem Query if this card exists
if Cards(ThisCard)
rem Get the Position of this card
Xpos=Cards(ThisCard).Xpos
Ypos=Cards(ThisCard).Ypos
rem Detect if the mouse is over this card
if PointInBox(mx,my,Xpos,Ypos,Xpos+CardWidth,Ypos+CardHeight)=true
rem Substitute variables
tc=thiscard:across=xpos:down=ypos
rem Call the function to shuffle the deck of cards
shuffle_deck()
rem Call function to show shuffle results
show_results()
endIf
endif
endif
rem End of the for next to detect mouse clicks on cards
next
rem Draw all of the cards and return the number of selected changes also
NumberOfCardStateChanges=DrawCards(NumberOfCards)
rem Display the Screen
Sync
rem Until the spacekey is pressed
until SpaceKey()
rem Return to where this subroutine was called
return
rem ==========================================================================
rem Function to draw the Cards
rem ==========================================================================
Function DrawCards(NumberOfCards)
CurrentTime=Timer()
StateChangesCount=0
For ThisCard=1 To NumberOfCards
rem Check if this card exists
if Cards(ThisCard)
rem Position (top Left)
Xpos =Cards(ThisCard).Xpos
Ypos =Cards(ThisCard).Ypos
Select Cards(ThisCard).State
Case CardState_NotMatched
rem Since this card is not selected we show the 'blank' version of the card
ThisImage=cardimages(0)
DrawImage ThisImage,Xpos,Ypos,False
EndSelect
endif
next
EndFunction StateChangesCount
rem ==========================================================================
rem Function to create images to represent the deck of cards
rem ==========================================================================
Function Make_Card_Graphics(Number,Width,Height,Images())
Dim Images(Number)
OldSurface=GetSurface()
rem This for/next loop will display card images
For lp =0 to Number
Img=NewImage(width,Height)
Images(lp)=Img
rendertoimage Img
rem Display an image
drawimage cardbackimage,0,0,false
next
rendertoimage OldSurface
EndFunction
rem ==========================================================================
rem Function to shuffle cards
rem ==========================================================================
function shuffle_deck()
for counter=1 to 10
for s=1 to 52
random_index=rnd(51)+1
tmp=deck(random_index)
deck(random_index)=deck(s)
deck(s)=tmp
next s
next counter
endfunction
rem ==========================================================================
rem Function to show shuffle results
rem ==========================================================================
function show_results()
c=1
for x=0 to 12
for y=0 to 3
rem If chosen card, display card and exit function
if tc
choice=deck(c)
rem Call function to display chosen card
my_guess()
drawimage CardIMage(deck(c)),across,down,false
rem Display the Screen and a short wait before proceeding
sync
wait 1000
drawimage backdrop2image,0,0,false
exitfunction
endif
c=c+1
next y
next x
endfunction
rem ==========================================================================
rem Function to display card choice
rem ==========================================================================
function my_guess()
select choice
case 1 to 13
if choice=1
choice$="Ace of Hearts"
elseif choice=11
choice$="Jack of Hearts"
elseif choice=12
choice$="Queen of Hearts"
elseif choice=13
choice$="King of Hearts"
else
choice$=str$(choice)+" of Hearts"
endif
case 14 to 26
if choice=14
choice$="Ace of Clubs"
elseif choice=24
choice$="Jack of Clubs"
elseif choice=25
choice$="Queen of Clubs"
elseif choice=26
choice$="King of Clubs"
else
choice$=str$(choice-13)+" of Clubs"
endif
case 27 to 39
if choice=27
choice$="Ace of Diamonds"
elseif choice=37
choice$="Jack of Diamonds"
elseif choice=38
choice$="Queen of Diamonds"
elseif choice=39
choice$="King of Diamonds"
else
choice$=str$(choice-26)+" of Diamonds"
endif
case 40 to 52
if choice=40
choice$="Ace of Spades"
elseif choice=50
choice$="Jack of Spades"
elseif choice=51
choice$="Queen of Spades"
elseif choice=52
choice$="King of Spades"
else
choice$=str$(choice-39)+" of Spades"
endif
endselect
rem Write text to screen
text 800-gettextwidth("You chose the "+choice$)-30,10,"You chose the "+choice$
rem Display the Screen and a short wait before proceeding
sync
wait 1000
endfunction
[/pbcode]
:)
Enjoy
geecee
Others from my Merlin's Wide and Wonderful World of Mystical Magic series
Merlin's Mystical Magic series - Puzzle 1 (http://www.underwaredesign.com/forums/index.php?topic=2949.0)
Merlin's Mystical Magic series - Puzzle 2 (http://www.underwaredesign.com/forums/index.php?topic=2956.0)
Merlin's Mystical Magic series - Puzzle 3 (http://www.underwaredesign.com/forums/index.php?topic=3041.0)
Hi geecee
nice little demo again
cut line 203: boxc 400,0,798,40,1,rgb(255,0,0)
and paste it in line 217:boxc 400,0,798,40,1,rgb(255,0,0)
this will stop the flickering text as it will draw box that is causing the flicker only if mouse is over a card
drawing a box around unwated text seem a little over the top , how about just changing the ink for text to red in this case
then back to white to read it
must be another way of doing this
anyway i used to have a marvin magic set yonks ago , the best card tricks i can remember was the invisible deck , were you pulled a spectators card they choose upside down in pack ,
simple trick but one that got a great responce , another trick i remember was one where you stacked the cards first in a certain order something like 10c 7h 4d 1s and so on , then asked spectator to pick a card out of pack and you could tell them the card they had picked , by having a quick glance of the card they cut to in your hand , something like that anyway
keep up the unusall programs
mick :)
Hi there micky4fun.
Thanks for your reply and suggestion about moving the box ...... Works OK now ...... Guess I should have picked that up.
Quotehow about just changing the ink for text to red in this case
then back to white to read it
I tried that but I found, going from the light coloured text to RED, didn't work as the RED didn't
completely hide the lighter colour ...... For some reason it left an outline ...... Anyway, thanks for your suggestion.
:)
geecee
If you're going to post a 'series' of the snippets, the please take the time to cross reference them. So users can follow links to the various articles. See Related to (http://www.underwaredesign.com/forums/index.php?topic=2235.0) Example
Thanks for your reply kevin.
How do I achieve this ...... by inserting a Hyperlink (which I know how to use) or is this the purpose of the FTP link (which I don't know how to use)?
???
geecee
Like this,
Merlin's Mystical Magic series - Puzzle 2 (http://www.underwaredesign.com/forums/index.php?topic=2956.0)
Thanks for your reply kevin.
Much appreciated ...... Is there a shortcut button?
:)
geecee