Hello again everybody. Here's another fun puzzle from my Merlin's Wide and Wonderful World of Mystical Magic series. Thanks Zotoaster, I have adapted your writeText function to now use in my programmes and this is the first one posted using the adaptation.
remstart
-------------------------------------------------------
Puzzle Number 2 from my Merlin's Wide and Wonderful
World of Mystical Magic series
***********************
Author: gearce - December 2006
***********************
This is Puzzle Number 2 from my Merlin's Wide and
Wonderful World of Mystical Magic series but without
all the bitmaps, images, special effects etc
-------------------------------------------------------
remend
` This command will hide the mouse pointer
hide mouse
` Set font style and size
set text font "arial"
set text size 16
set text to bold
th=text height("arial")
` Messages
a$=" "
a$=a$+"|Hello! I'm Merlin||Allow me to show you some of|my Mystical Magic "
a$=a$+"with Puzzle|Number 2 from my Wide and|Wonderful World of Mystical"
a$=a$+"|Magic series, but without all the|bitmaps, images, special effects"
a$=a$+"|etc"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("bitmaps, images, special effects")
a=320-(tw/2):across=a:down=135
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
sleep (2*1000)
` Start of programme
start:
` Clear screen
cls
` ---------------------------------------------------------------------
` Draw six cards
` ---------------------------------------------------------------------
` Set new font size
set text size 21
th=text height("arial")
` Messages
a$=" "
a$=a$+"|I will draw six cards"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("I will draw six cards")
a=320-(tw/2):across=a:down=379
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Go to subroutine to deal cards and in between
` wait for a time before proceeding
firsttime=1
gosub drawcards
` Wait for a time before proceeding
wait 1000
` Go to subroutine to block text
ink rgb(0,0,0),1
gosub blocktext
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` Choose a card
` ---------------------------------------------------------------------
` Messages
a$=" "
a$=a$+"|Choose a card and click on it"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Choose a card and click on it")
a=320-(tw/2):across=a:down=379
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` This command will show the mouse pointer
show mouse
` This command will set the mouse pointer
position mouse 320,370
` Go to subroutine to check selection
gosub check_selection
` Go to subroutine to block text
ink rgb(0,0,0),1
gosub blocktext
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` Write numbers to chosen card
` ---------------------------------------------------------------------
` Messages
a$=" "
a$=a$+"|I will now write some numbers to your card"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("I will now write some numbers to your card")
a=320-(tw/2):across=a:down=379
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Set new font size
set text size 16
th=text height("arial")
` On selection go to appropriate subroutine
if selection=1
gosub cardwrite1
endif
if selection=2
gosub cardwrite2
endif
if selection=3
gosub cardwrite3
endif
if selection=4
gosub cardwrite4
endif
if selection=5
gosub cardwrite5
endif
if selection=6
gosub cardwrite6
endif
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` Choose a number on chosen card
` ---------------------------------------------------------------------
` Go to subroutine to block text
ink rgb(0,0,0),1
gosub blocktext
` Set new font size
set text size 21
th=text height("arial")
` Messages
a$=" "
a$=a$+"|Choose any number on the card, write it down and|click mouse"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Choose any number on the card, write it down and")
a=320-(tw/2):across=a:down=369
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for mouse click
suspend for mouse
` Wait for a time before proceeding
wait 1000
` On selection go to appropriate subroutine
` This blocks out numbers on chosen card
carddraw=selection
gosub drawcards
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` Write numbers to remaining cards
` ---------------------------------------------------------------------
` Go to subroutine to block text
ink rgb(0,0,0),1
gosub blocktext
` Messages
a$=" "
a$=a$+"|I will now write numbers to each of the other cards in turn"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("I will now write numbers to each of the other cards in turn")
a=320-(tw/2):across=a:down=379
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Set new font size
set text size 16
th=text height("arial")
` Wait for a time before proceeding
wait 1000
` Go to subroutine to write numbers to other cards
gosub writecards
` Wait for a time before proceeding
wait 1000
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` Here's the magic
` ---------------------------------------------------------------------
` Set new font size
set text size 21
` Messages
a$=" "
a$=a$+"|Now here's the magic ...*Watch this"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Now here's the magic ... Watch this")
a=320-(tw/2):across=a:down=219
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` Go to subroutine to reveal mystical magic and ask play again
gosub reveal
` End of programme
the_end:
cls
end
` ---------------------------------------------------------------------
` Functions
` ---------------------------------------------------------------------
` ---------------------------------------------------------------------
` Function to write letters to screen
` ---------------------------------------------------------------------
function writeletters(across,down,message$)
` Set counters
z=0:a=across:long=len(message$)
repeat
` Increment counter by 1
inc z,1
` and wait for a time before proceeding. This determines
` the speed at which the letters are written to the screen.
` The fastest speed is delay 0. Change the number to a
` higher one for a slower speed
delay=3
th=text height(mid$(message$,z))
if mid$(message$,z)<>"|"
across=across+text width(mid$(message$,z-1))
endif
if mid$(message$,z)="|"
across=a:inc down,(th*1)
goto thispoint
endif
if mid$(message$,z)="*"
wait 1000
goto thispoint
endif
text across,down,mid$(message$,z)
thispoint:
until z>long
endfunction
` ---------------------------------------------------------------------
` Subroutines
` ---------------------------------------------------------------------
` ---------------------------------------------------------------------
` Subroutine to draw cards
` ---------------------------------------------------------------------
drawcards:
` Where to draw card and wait for a time
` in between
for carddraw=1 to 6
if firsttime=1
wait 500
endif
if carddraw=1 or carddraw=4 then across=36
if carddraw>=1 and carddraw<=3 then inc across,116:down=50
if carddraw>=4 and carddraw<=6 then inc across,116:down=204
box across,down,across+106,down+144
next carddraw
firsttime=0
return
` ---------------------------------------------------------------------
` Subroutine to check for selection
` ---------------------------------------------------------------------
check_selection:
` Wait for mouse click
suspend for mouse
` If mouse click
x=mousex()
y=mousey()
` This command will hide the mouse pointer
hide mouse
` Until a selection has been made
for pass=1 to 6
if pass=1 or pass=4 then point1=36:point2=142
if (pass>=1 and pass<=3)
inc point1,116:inc point2,116
if (x>=point1 and x<=point2) and (y>=110 and y<=254)
selection=pass
goto re_turn
endif
endif
if (pass>=4 and pass<=6)
inc point1,116:inc point2,116
if (x>=point1 and x<=point2) and (y>=264 and y<=408)
selection=pass
goto re_turn
endif
endif
next p
re_turn:
if selection=1 then youchose=1
if selection=2 then youchose=2
if selection=3 then youchose=4
if selection=4 then youchose=8
if selection=5 then youchose=16
if selection=6 then youchose=32
return
` ---------------------------------------------------------------------
` Subroutine to write numbers on cards
` ---------------------------------------------------------------------
` ------------------------
` This is card 1
` ------------------------
cardwrite1:
` Set counters
across=155:down=58:k#=0:a=-1
` Write numbers on card
ink 0,0
repeat
inc k#,1:inc a,2:inc across,20
center text across,down,str$(a)
if k#/4=int(k#/4)
across=155:inc down,(th*1)
endif
until k#=32
return
` ------------------------
` This is card 2
` ------------------------
cardwrite2:
` Set counters
across=271:down=58:k#=0:a=-1
` Write numbers on card
ink 0,0
repeat
inc a,3:inc k#,1:inc across,20
center text across,down,str$(a)
inc a,1:inc k#,1:inc across,20
center text across,down,str$(a)
if k#/4=int(k#/4)
across=271:inc down,(th*1)
endif
until k#=32
return
` ------------------------
` This is card 3
` ------------------------
cardwrite3:
` Set counters
across=387:down=58:k#=0:a=3
` Write numbers on card
ink 0,0
repeat
inc a,1:inc k#,1:inc across,20
if k#=5 or k#=9 or k#=13 or k#=17
inc a,4
endif
if k#=21 or k#=25 or k#=29
inc a,4
endif
center text across,down,str$(a)
if k#/4=int(k#/4)
across=387:inc down,(th*1)
endif
until k#=32
return
` ------------------------
` This is card 4
` ------------------------
cardwrite4:
` Set counters
across=155:down=212:k#=0:a=7
` Write numbers on card
ink 0,0
repeat
inc a,1:inc k#,1:inc across,20
if k#=9 or k#=17 or k#=25
inc a,8
endif
center text across,down,str$(a)
if k#/4=int(k#/4)
across=155:inc down,(th*1)
endif
until k#=32
return
` ------------------------
` This is card 5
` ------------------------
cardwrite5:
` set counters
across=271:down=212:k#=0:a=15
` Write numbers on card
ink 0,0
repeat
inc a,1:inc k#,1:inc across,20
center text across,down,str$(a)
if k#/4=int(k#/4)
across=271:inc down,(th*1)
endif
if k#=16
inc a,16
endif
until k#=32
return
` ------------------------
` This is card 6
` ------------------------
cardwrite6:
` Set counters
across=387:down=212:k#=0:a=31
` Write numbers on card
ink 0,0
repeat
inc a,1:inc k#,1:inc across,20
center text across,down,str$(a)
if k#/4=int(k#/4)
across=387:inc down,(th*1)
endif
until k#=32
return
` ---------------------------------------------------------------------
` Subroutine to write numbers to remaining cards
` ---------------------------------------------------------------------
writecards:
` ------------------------
` If selection equals 1
` ------------------------
if selection=1
gosub cardwrite2
gosub checkothers
if mouseclick=1 then youchose=youchose+2
carddraw=2
gosub drawcards
wait 1000
gosub cardwrite3
gosub checkothers
if mouseclick=1 then youchose=youchose+4
carddraw=3
gosub drawcards
wait 1000
gosub cardwrite4
gosub checkothers
if mouseclick=1 then youchose=youchose+8
carddraw=4
gosub drawcards
wait 1000
gosub cardwrite5
gosub checkothers
if mouseclick=1 then youchose=youchose+16
carddraw=5
gosub drawcards
wait 1000
gosub cardwrite6
gosub checkothers
if mouseclick=1 then youchose=youchose+32
carddraw=6
gosub drawcards
wait 1000
endif
` ------------------------
` If selection equals 2
` ------------------------
if selection=2
gosub cardwrite1
gosub checkothers
if mouseclick=1 then youchose=youchose+1
carddraw=1
gosub drawcards
wait 1000
gosub cardwrite3
gosub checkothers
if mouseclick=1 then youchose=youchose+4
carddraw=3
gosub drawcards
wait 1000
gosub cardwrite4
gosub checkothers
if mouseclick=1 then youchose=youchose+8
carddraw=4
gosub drawcards
wait 1000
gosub cardwrite5
gosub checkothers
if mouseclick=1 then youchose=youchose+16
carddraw=5
gosub drawcards
wait 1000
gosub cardwrite6
gosub checkothers
if mouseclick=1 then youchose=youchose+32
carddraw=6
gosub drawcards
wait 1000
endif
` ------------------------
` If selection equals 3
` ------------------------
if selection=3
gosub cardwrite1
gosub checkothers
if mouseclick=1 then youchose=youchose+1
carddraw=1
gosub drawcards
wait 1000
gosub cardwrite2
gosub checkothers
if mouseclick=1 then youchose=youchose+2
carddraw=2
gosub drawcards
wait 1000
gosub cardwrite4
gosub checkothers
if mouseclick=1 then youchose=youchose+8
carddraw=4
gosub drawcards
wait 1000
gosub cardwrite5
gosub checkothers
if mouseclick=1 then youchose=youchose+16
carddraw=5
gosub drawcards
wait 1000
gosub cardwrite6
gosub checkothers
if mouseclick=1 then youchose=youchose+32
carddraw=6
gosub drawcards
wait 1000
endif
` ------------------------
` If selection equals 4
` ------------------------
if selection=4
gosub cardwrite1
gosub checkothers
if mouseclick=1 then youchose=youchose+1
carddraw=1
gosub drawcards
wait 1000
gosub cardwrite2
gosub checkothers
if mouseclick=1 then youchose=youchose+2
carddraw=2
gosub drawcards
wait 1000
gosub cardwrite3
gosub checkothers
if mouseclick=1 then youchose=youchose+4
carddraw=3
gosub drawcards
wait 1000
gosub cardwrite5
gosub checkothers
if mouseclick=1 then youchose=youchose+16
carddraw=5
gosub drawcards
wait 1000
gosub cardwrite6
gosub checkothers
if mouseclick=1 then youchose=youchose+32
carddraw=6
gosub drawcards
wait 1000
endif
` ------------------------
` If selection equals 5
` ------------------------
if selection=5
gosub cardwrite1
gosub checkothers
if mouseclick=1 then youchose=youchose+1
carddraw=1
gosub drawcards
wait 1000
gosub cardwrite2
gosub checkothers
if mouseclick=1 then youchose=youchose+2
carddraw=2
gosub drawcards
wait 1000
gosub cardwrite3
gosub checkothers
if mouseclick=1 then youchose=youchose+4
carddraw=3
gosub drawcards
wait 1000
gosub cardwrite4
gosub checkothers
if mouseclick=1 then youchose=youchose+8
carddraw=4
gosub drawcards
wait 1000
gosub cardwrite6
gosub checkothers
if mouseclick=1 then youchose=youchose+32
carddraw=6
gosub drawcards
wait 1000
endif
` ------------------------
` If selection equals 6
` ------------------------
if selection=6
gosub cardwrite1
gosub checkothers
if mouseclick=1 then youchose=youchose+1
carddraw=1
gosub drawcards
wait 1000
gosub cardwrite2
gosub checkothers
if mouseclick=1 then youchose=youchose+2
carddraw=2
gosub drawcards
wait 1000
gosub cardwrite3
gosub checkothers
if mouseclick=1 then youchose=youchose+4
carddraw=3
gosub drawcards
wait 1000
gosub cardwrite4
gosub checkothers
if mouseclick=1 then youchose=youchose+8
carddraw=4
gosub drawcards
wait 1000
gosub cardwrite5
gosub checkothers
if mouseclick=1 then youchose=youchose+16
carddraw=5
gosub drawcards
wait 1000
endif
return
` ---------------------------------------------------------------------
` Subroutine to check other cards for chosen number
` ---------------------------------------------------------------------
checkothers:
` Go to subroutine to block text
ink rgb(0,0,0),1
gosub blocktext
` Set new font size
set text size 21
` Messages
a$=" "
a$=a$+"|Does your number appear on this card"
b$="Left click mouse for YES - right click mouse for NO"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Does your number appear on this card")
a=320-(tw/2):across=a:down=369
ink rgb(255,255,255),1
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Left click mouse for YES - right click mouse for NO")
a=320-(tw/2):across=a:inc down,(th*2.5)
` Call function to write letters from the messages
message$=b$
writeletters(across,down,message$)
` Until mouse is clicked
do
mouseclick=MouseClick()
if mouseclick=1
` Set new font size
set text size 16
th=text height("arial")
return
exit
endif
if mouseclick=2
` Set new font size
set text size 16
th=text height("arial")
return
exit
endif
` End loop
Loop
return
` ---------------------------------------------------------------------
` Subroutine to block text
` ---------------------------------------------------------------------
blocktext:
ink rgb(0,0,0),0
box 0,378,638,441
ink rgb(255,255,255),0
return
` ---------------------------------------------------------------------
` Subroutine to reveal mystical magic
` and ask play again
` ---------------------------------------------------------------------
` Reveal mystical magic ...
` ---------------------------------------------------------------------
reveal:
` Messages
a$="You chose number"
b$=str$(youchose)
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("You chose number")
a=320-(tw/2):across=a:down=81
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Set new font size
set text size 120
` Messages
message$=b$
` Determine text width of longest message line
` and where to write text to screen.
tw=text width(str$(youchose))
a=320-(tw/2):across=a:down=161
` Call function to write letters from the messages
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` ---------------------------------------------------------------------
` ... and ask play again
` ---------------------------------------------------------------------
` Set new font size
set text size 21
` Messages
a$="Correct? *Thank you"
b$="Play again *Yes or No"
c$="Left click mouse for YES - right click mouse for NO"
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Correct? Thank you")
a=320-(tw/2):across=a:down=338
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Play again Yes or No")
a=320-(tw/2):across=a:inc down,(th*1)
` Call function to write letters from the messages
message$=b$
writeletters(across,down,message$)
` Wait for a time before proceeding
wait 1000
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Left click mouse for YES - right click mouse for NO")
a=320-(tw/2):across=a:inc down,(th*2)
` Call function to write letters from the messages
message$=c$
writeletters(across,down,message$)
` Until mouse is clicked
do
mouseclick=MouseClick()
if mouseclick=1
goto start
exit
endif
if mouseclick=2
goto the_end
exit
endif
` end loop
loop
return
Probably no need to tell anyone but, as previously, highlight the code, right click, copy and paste into DBClassic.
Enjoy
gearce
*****************************************
E D I T
*****************************************
Sorry folks. MAJOR BLUNDER
If you click outside a card area, the programme continues as if a card has been chosen.
To correct this please make the following changes
Go to the subroutine check_selection:
In the for/next loop
change (y>=110 and y<=254)
to (y>=50 and y<=194)
and
change (y>=264 and y<=408)
to (y>=204 and y<=348)
After next p in the for/next loop
insert
and after re_turn:
insert
` Ensure selection can not be duplicated
if selection=chosen(selection)
goto no_selection
endif
chosen(selection)=selection
Go to Choose a card
Between this
` Call function to write letters from the messages
message$=a$
writeletters(across,down,message$)
and this
` This command will show the mouse pointer
show mouse
add this
` If no selection is made come to here
no_selection:
gearce
LANG MAY YER LUM REEK
