Hi there!
Here is Puzzle Number 7 from my Merlin's Magic Puzzles Series.
It should paste 9 card images to the screen but, for some reason, which I have been unable to ascertain, it occasionally pastes only 8. Whilst this shouldn't happen, it doesn't present a great problem ... just press F12 to return to the editor then F5 to re execute.
Maybe someone will be able to find the reason for the error and advise.
remstart
=======================================================
Merlin's Magic Puzzles
***********************
Author: gearce - January 2007
Extensively revamped - March 2008
***********************
Puzzle Number 7
=======================================================
remend
rem Call procedures to set everything up and display Intro Screen
gosub setup
gosub intro
rem Main programme loop
do
gosub play
gosub playagain
loop
rem End programme
end
rem ****************************************************************
rem Set up
rem ****************************************************************
setup:
rem Create, load and paste a bitmap containing images of 52 cards
Create Bitmap 1,1024,768
Load Image "Cards.png",1000
Paste Image 1000,0,0
rem Extract individual images from bitmap
CardNum=1
For Ny=0 To 3
For Nx=0 To 12
Get Image CardNum,Nx*73+2,Ny*98+2,Nx*73+1+72,Ny*98+1+97
Inc CardNum
Next Nx
Next Ny
rem Delete image containing images of 52 cards
Delete Image 1000
rem Set working bitmap
Set Current Bitmap 0
rem Delete non-working bitmap
Delete Bitmap 1
rem Assure each call to the RND produces a different order of random numbers
randomize timer()
rem This command will hide mouse pointer
hide mouse
rem Determine centre of working screen width
sc=238
rem Declare array/s
dim cards(52):dim card$(52):dim intro$(8):dim message$(10)
rem These images, when later pasted, effect the
rem removal of previous text at the location
load image "blocktext.png",101
load image "blocktext2.png",201
rem This image, when later pasted, effects the
rem drawing of a box
load image "box.png",301
return
rem ****************************************************************
rem Introduction
rem ****************************************************************
intro:
rem Display a picture on screen
load bitmap "base1.png"
rem A short wait before proceeding
wait 500
rem Call function to change text style and size and ink colour
set_text("arial",21,"b",255,217,128)
th= text height("X")
rem Set down coordinate
down=190
rem Define the introduction strings ...
intro$(1)="Welcome to Merlin's Magic Puzzles - Number 7"
intro$(2)=""
intro$(3)="I will ask you to follow a few instructions, after"
intro$(4)="which I will reveal the answer."
intro$(5)=""
intro$(6)=""
intro$(7)="Press any key to continue."
rem Determine text width of longest introduction string
tw=text width("Mystical Magic and my Magic Puzzle Number 7.")
rem Turn on screen refreshing
sync on
rem ... and write to screen
for n=1 to 7
rem Set across coordinate
across=sc-tw/2
text across,down,intro$(n)
inc down,th*1
next n
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem Wait for keypress
wait key
rem Effects the removal of previous text at the location
paste image 101,10,119
return
rem ****************************************************************
rem Play
rem ****************************************************************
play:
rem *****************************************************
rem Place nine cards face up
rem *****************************************************
rem Initialise counters
result$=""
result=0
rem A short wait before proceeding
wait 500
rem Define the message string ...
message$(1)="I will place 9 cards (Ace through 9) in random"
message$(2)="order face up"
rem Determine text width of longest message string
tw=text width("I will place 9 cards (Ace through 9) in random")
rem Turn on screen refreshing
sync on
rem ... and write to screen
for n=1 to 2
rem Set across coordinate
across=sc-tw/2
text across,n*th+402,message$(n)
next n
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem A short wait before proceeding
wait 500
rem Go to subroutine to generate nine random cards
gosub ninecards
rem Effects the removal of previous text at the location
paste image 201,22,423
rem A short wait before proceeding
wait 500
rem *****************************************************
rem Choose a card
rem *****************************************************
rem Define the message string ...
message$(1)="Choose any card. Remember it, or write"
message$(2)="it down and press any key"
rem Determine text width of longest message string
tw=text width("Choose any card. Remember it, or write")
rem Turn on screen refreshing
sync on
rem ... and write to screen
for n=1 to 2
rem Set across coordinate
across=sc-tw/2
text across,n*th+402,message$(n)
next n
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem Wait for key press
wait key
rem A short wait before proceeding
wait 500
rem Effects the removal of previous text at the location
paste image 201,22,423
rem A short wait before proceeding
wait 500
rem *****************************************************
rem Add up cards in columns
rem *****************************************************
rem Define the message string ...
message$(1)="Add up the remaining cards in each column,"
message$(2)="note the answers and press any key"
rem Determine text width of longest message string
tw=text width("Add up the remaining cards in each column,")
rem Turn on screen refreshing
sync on
rem ... and write to screen
for n=1 to 2
rem Set across coordinate
across=sc-tw/2
text across,n*th+402,message$(n)
next n
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem Wait for key press
wait key
rem A short wait before proceeding
wait 500
rem Effects the removal of previous text at the location
paste image 201,22,423
rem A short wait before proceeding
wait 500
rem *****************************************************
rem Add up digits and key in answer
rem *****************************************************
rem Define the message string ...
message$="Add up the digits and key in your answer > "
rem Determine text width of longest message string
tw=text width("Add up the digits and key in your answer > ")+56
rem Set across coordinate
across=sc-tw/2
rem ... and write to screen
text across,423,message$
rem Set across coordinate
across=across+text width(message$)+4
rem Effects the drawing of a box
paste image 301,across,423
rem Set cursor and input the result
set cursor across+2,426
input "";answer
rem A short wait before proceeding
wait 500
rem Effects the removal of previous text at the location
paste image 101,10,119
rem A short wait before proceeding
wait 500
rem *****************************************************
rem Reveal mystical magic ...
rem *****************************************************
rem A short wait before proceeding
wait 500
rem Define the message string and write to screen
message$="Now here's the magic ... Watch this"
center text sc,240,message$
rem A short wait before proceeding
wait 500
rem Effects the removal of previous text at the location
paste image 101,10,119
rem A short wait before proceeding
wait 500
rem Define the message string and write to screen
message$="You chose the"
center text sc,147,message$
rem A short wait before proceeding
wait 500
rem Go to subroutine to determine chosen card ...
gosub chosencard
rem Set across and down coordinates
across=200:down=207
rem ... and paste image
paste image card,across,down
return
rem ****************************************************************
rem Play again
rem ****************************************************************
playagain:
rem A short wait before proceeding
wait 500
rem Call function to change text style and size and ink colour
set_text("arial",21,"b",255,217,128)
th=text height("X")
rem Define the message string ...
message$="Correct? Thank you!"
tw=text width(message$)
rem Set across and down coordinates and part counter
across=sc-(tw/2):down=333:part=0
rem ... and write to screen in two parts
repeat
rem Increment part counter
inc part
select part
case 1 : start=1:finish=10 : endcase
case 2 : start=11:finish=20:across=across+text width(sub$): endcase
endselect
rem Get a substring from the message, from start to finish
sub$=""
for n=start to finish
sub$=sub$+mid$(message$,n)
next n
rem A short wait before proceeding
wait 500
text across,down,sub$
until part=2
rem A short wait before proceeding
wait 500
rem Increment down coordinate
inc down,th*2
rem Define the message string and write to screen
message$="Play again?"
center text sc,down,message$
rem A short wait before proceeding
wait 500
rem Increment down coordinate
inc down,th*2
rem Define the message string and write to screen
message$="Left click mouse for YES - Right click mouse for NO"
center text sc,down,message$
rem Until mouse is clicked
repeat
mc=mouseclick()
until mc>0
rem Effects the removal of previous text at the location
paste image 101,10,119
rem User chose right button to end...
if mc=2
center text sc,240,"Thanks For Playing ... Bye!"
wait 3000
cls: end
endif
rem If we are here then user must want to play again, so wait for release
rem of left mouse button...
repeat
until mouseclick()=0
gosub intro: rem <<< Disable this line if you don't want introduction screen shown at
rem start of every game
rem Turn on screen refreshing
sync on
rem As the programme is now modular, the Return below drops back into the
rem main programme Do..Loop and continues round again calling all the procedures
rem in turn to play the game.
return
rem ****************************************************************
rem Functions and Subroutines
rem ****************************************************************
rem ****************************************************************
rem Function to change text style and size and ink colour
rem ****************************************************************
function set_text(font$,sz,style$,r,g,b)
set text font font$,1
set text size sz
if style$="b" then set text to bold
if style$="n" then set text to normal
ink rgb(r,g,b),0
sync
endfunction th
rem *****************************************************
rem Subroutine to generate random order of 9 cards and
rem paste images
rem *****************************************************
ninecards:
rem Set across and down coordinates
across=0:down=180
rem Initialise cards counter
cards=0
rem Continue loop until cards equals 9
repeat
rem Increment a counter
inc cards
repeat
s=rnd(8)+1
rem Create a switch (if alreadyfound is still zero after the
rem for/next, the number has not been picked before)
alreadyfound=0
rem Check each number in the array
rem Check if a number is already found and if yes generate another
for j=1 to cards
rem If the number picked is already in the array
rem turn the switch on
if cards(j)=s
alreadyfound=1
exit
endif
next j
until alreadyfound=0
rem Accept generated number
cards(cards)=s
card=cards(cards)
rem You cannot have the 'One' of a suit
if card=1
card$="A"
else
card$=str$(card)
endif
rem Determine suit at random
suit=rnd(3)+1
if suit=1 then suit$="H"
if suit=2 then suit$="C"
if suit=3 then suit$="D"
if suit=4 then suit$="S"
rem Determine card
card$=card$+suit$
rem Go to subroutine to determine card ...
gosub determinecard
rem Determine card
card$(cards)=card$
rem ... and paste image
if cards=1 or cards=4 or cards=7 then across=40
if cards=1 or cards=2 or cards=3
inc across,80:down=119
paste image card,across,down
wait 100
endif
if cards=4 or cards=5 or cards=6
inc across,80:down=216
paste image card,across,down
wait 100
endif
if cards=7 or cards=8 or cards=9
inc across,80:down=313
paste image card,across,down
wait 100
endif
until cards=9
return
rem *****************************************************
rem Subroutine to determine cards to display
rem *****************************************************
determinecard:
if card$="AH" then card=1
if card$="AC" then card=14
if card$="AD" then card=27
if card$="AS" then card=40
if card$="2H" then card=2
if card$="2C" then card=15
if card$="2D" then card=28
if card$="2S" then card=41
if card$="3H" then card=3
if card$="3C" then card=16
if card$="3D" then card=29
if card$="3S" then card=42
if card$="4H" then card=4
if card$="4C" then card=17
if card$="4D" then card=30
if card$="4S" then card=43
if card$="5H" then card=5
if card$="5C" then card=18
if card$="5D" then card=31
if card$="5S" then card=44
if card$="6H" then card=6
if card$="6C" then card=19
if card$="6D" then card=32
if card$="6S" then card=45
if card$="7H" then card=7
if card$="7C" then card=20
if card$="7D" then card=33
if card$="7S" then card=46
if card$="8H" then card=8
if card$="8C" then card=21
if card$="8D" then card=34
if card$="8S" then card=47
if card$="9H" then card=9
if card$="9C" then card=22
if card$="9D" then card=35
if card$="9S" then card=48
return
rem *****************************************************
rem Subroutine to determine chosen card
rem *****************************************************
chosencard:
if answer>=0 and answer<=8 then bank=9
if answer>=9 and answer<=17 then bank=18
if answer>=18 and answer<=26 then bank=27
if answer>=27 and answer<=35 then bank=36
chosencard=bank-answer
for a=1 to 9
card$=card$(a)
if chosencard=1 and left$(card$(a),1)="A" or left$(card$,1)=str$(chosencard)
gosub determinecard
return
endif
next a
return
Whether there can still be improvements I don't know. I have picked up ideas and bits and pieces from various postings in the forums and, if you read through the programme, you'll probably recognise something that you contributed to the forums.
Anyway! Enjoy.
******************************** EDIT ********************************
Sorry! I forgot to attach the media file ... Now done
gearce
(GRC)
LANG MEY YER LUM REEK (If your fire place is smoking and your are warm, you are likely to live long and happy)
No one can make you feel inferior without your consent.
