Hi everybody! This is a fun programme. It's Puzzle Number 1 from my Merlin's Wide and Wonderful World of Mystical Magic series but without the media.
It was first Posted: 28th Dec 2006 01:28 (now locked) but has been extensively re-written, putting to use some of the things I have learned over this time.
Here though, I’ve used the sync commands for the first time in any of my programmes and I’d be interested to know if they have been used correctly and if the rem statements describe them properly.
They appear to be doing what I want.
Whilst
gosub with no
return works, a reply from TDK_Man to something I submitted on the TGPF forum says:
Quote: "Yes, that code snippet works, but it corrupts the stack - that's why it should never be used.
The stack is very limited in size and any values placed on it, eventually fill it up if not removed.
Return is the command which removes items from the stack and any program which uses Gosub with no Return uses stack space which cannot be recovered. OK, that example may not cause a program to grind to a halt, but it does lessen the amount of stack space available for other parts of your program which may need it."
Any suggestions then on how my gosub start could be re-written would be appreciated.
remstart
-------------------------------------------------------
Puzzles from my Merlin's Wide and Wonderful
World of Mystical Magic series
************************
Author: gearce - December 2006
Extensively re-written - October 2007
************************
This is Puzzle Number 1 from my Merlin's Wide and
Wonderful World of Mystical Magic series but without
all the media
-------------------------------------------------------
remend
` This command will hide the mouse pointer
hide mouse
` A short wait before proceeding
wait 1000
` Set text style and size and ink colour
set text font "arial"
set text size 21
set text to bold
th=text height("arial")
ink rgb(255,217,128),0
` -------------------------------------------------------
` SPLASHSCREEN
` -------------------------------------------------------
` Set across and down coordinates
across=320:down=135
` Turn on screen refreshing
sync on
repeat
` Increment line number and down coordinate
inc linenumber:inc down,(th*1)
select linenumber
case 1 : center text across,down,"Puzzles from my Merlin's Wide and Wonderful" : endcase
case 2 : center text across,down,"World of Mystical Magic series" : endcase
case 3 : center text across,down,"************************" : endcase
case 4 : center text across,down,"Author: gearce - December 2006" : endcase
case 5 : center text across,down,"Extensively re-written - October 2007" : endcase
case 6 : center text across,down,"************************" : endcase
case 7 : center text across,down,"This is Puzzle Number 1 from my Merlin's Wide and" : endcase
case 8 : center text across,down,"Wonderful World of Mystical Magic series but without" : endcase
case 9 : center text across,down,"all the media" : endcase
endselect
until linenumber=9
` Let programme handle screen refreshing
sync
` Return screen refreshing to system
sync off
` A short wait before proceeding
wait 3000
` Start of programme
start:
` Clear screen
cls
` Declare array/s
dim a$(84)
` Assure random is always different
randomize timer()
` -------------------------------------------------------
` Select a number from 10 to 99
` -------------------------------------------------------
` Define the message string and write to screen
message$="Left click mouse to select a number from 10 to 99"
center text 320,187,message$
` Set across and down coordinates
across=320:down=208
` Until mouse is clicked
do
` If mouse is clicked, generate a random number from 10 to 99
if mouseclick()=1
number=rnd(89)+10
chosennumber$=str$(number)
` Write chosen number to screen and exit loop
center text across,down,chosennumber$
exit
endif
loop
` A short wait before proceeding
wait 1000
` -------------------------------------------------------
` Add two digits of number and subtract from original
` -------------------------------------------------------
` Define the message string ...
message$="Add the two digits of the number together, subtract your answer from "
message$=message$+"the number and click mouse"
` Determine text width of longest message line
tw=text width("subtract your answer from the number and")
` Set across and down coordinates and set part counter
across=320-(tw/2):inc down,(th*1):part=0
` ... and write to screen in three parts
repeat
` Increment part counter and down coordinate
inc part:inc down,(th*1)
select part
case 1 : pos=1:length=42 : endcase
case 2 : pos=length+2:length=83 : endcase
case 3 : pos=length+2:length=95 : endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$,n)
next n
wait 500
text across,down,sub$
until part=3
` Wait for mouse click
suspend for mouse
` A short wait before proceeding
wait 1000
` Clear screen
cls
` -------------------------------------------------------
` Draw a 12x7 matrix and load it with 84 random letters
` -------------------------------------------------------
` Define the message string and write to screen
message$="I will draw a 12x7 matrix and load it with 84 letters"
center text 320,240,message$
` A short wait before proceeding
wait 1000
` Clear screen
cls
` A short wait before proceeding
wait 1000
` Turn on screen refreshing
sync on
` Call function to draw matrix
matrix
` Call function to write 84 numbers
eightyfournumbers
` Let programme handle screen refreshing
sync
` Return screen refreshing to system
sync off
` A short wait before proceeding
wait 1000
` Call function to write 84 letters
secretletter$=eightyfourletters(a$)
` A short wait before proceeding
wait 1000
` Set text style and size and ink colour
set text font "arial"
set text size 21
set text to bold
th=text height("arial")
ink rgb(255,217,128),0
` Define the message string and write to screen
message$="Write down the letter that appears above your answer and click mouse"
center text 320,398,message$
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` A short wait before proceeding
wait 1000
` -------------------------------------------------------
` Reveal mystical magic ...
` -------------------------------------------------------
` Define the message string ...
message$="Now here's the magic ... Watch this"
tw=text width(message$)
` Set across and down coordinates and reset part counter
across=320-(tw/2):down=240:part=0
` ... and write to screen in three parts
repeat
` Increment part counter
inc part
select part
case 1 : pos=1:length=21 : endcase
case 2 : pos=22:length=25:across=across+text width(sub$) : endcase
case 3 : pos=26:length=35:across=across+text width(sub$) : endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$,n)
next n
wait 500
text across,down,sub$
until part=3
` A short wait before proceeding
wait 1000
` Clear screen
cls
` A short wait before proceeding
wait 1000
` Define the message string and write to screen
message$="The letter that appeared above your answer was"
center text 320,93,message$
` A short wait before proceeding
wait 1000
` Set text style and size
set text font "arial black"
set text size 144
set text to bold
th=text height("arial black")
` Set down coordinate and write secret letter
down=114
center text 320,down,secretletter$
` A short wait before proceeding
wait 1000
` -------------------------------------------------------
` ... and ask play again
` -------------------------------------------------------
` Set text style and size
set text font "arial"
set text size 21
set text to bold
th=text height("arial")
` Define the message string ...
message$="Correct? Thank you"
` Determine text width of message
tw=text width(message$)
` Set across and down coordinates and reset part counter
across=320-(tw/2):down=284:part=0
` ... and write to screen in two parts
repeat
` Increment part counter
inc part
select part
case 1 : pos=1:length=10 : endcase
case 2 : pos=11:length=19:across=across+text width(sub$) : endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$,n)
next n
wait 500
text across,down,sub$
until part=2
` A short wait before proceeding
wait 1000
` Increment down coordinate
inc down,(th*1)
` Define the message string and write to screen
message$="Play again?"
center text 320,down,message$
` A short wait before proceeding
wait 1000
` Define the message string ...
message$="Left click mouse for YES - right click mouse for NO"
` Determine text width of message
tw=text width(message$)
` Set across and down coordinates and reset part counter
across=320-(tw/2):inc down,(th*2):part=0
` ... and write to screen in three parts
repeat
` Increment part counter
inc part
select part
case 1 : pos=1:length=25 : endcase
case 2 : pos=26:length=27:across=across+text width(sub$) : endcase
case 3 : pos=28:length=51:across=across+text width(sub$) : endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$,n)
next n
wait 500
text across,down,sub$
until part=3
` Until mouse is clicked
do
mc=mouseclick()
if mc=1 then wait 1000:gosub start
if mc=2 then wait 1000:cls:exit
loop
` End of programme
end
` -------------------------------------------------------
` Function to draw matrix
` -------------------------------------------------------
function matrix
for down=0 to 7
l=92:t=down*50+27:r=548:b=t
line l,t,r,b
next down
for across=0 to 12
l=across*38+92:t=27:r=l:b=377
line l,t,r,b
next across
endfunction
` -------------------------------------------------------
` Function to write 84 numbers to screen
` -------------------------------------------------------
function eightyfournumbers
` Set text style and size
set text font "arial"
set text size 12
set text to bold
th=text height("arial")
` Set next number counter
nextnumber=0
` Write numbers in a 12 x 7 matrix
for down=0 to 6
for across=0 to 11
inc nextnumber
a#=nextnumber
center text across*38+112,down*50+55,str$(a#)
next across
next down
endfunction
` -------------------------------------------------------
` Function to select 84 random letters, determine secret
` letter and write letters to screen
` -------------------------------------------------------
function eightyfourletters(a$)
` Set text style and size
set text font "arial black"
set text size 30
set text to bold
th=text height("arial black")
` Arrange 84 letters in random order
for a=1 to 84
t=rnd(25)+1
a$(a)=chr$(t+64)
if a=9
secretletter$=a$(a)
endif
next a
` Set next number counter
nextnumber=0
` Write random letters in a 12 x 7 matrix
for down=0 to 6
for across=0 to 11
inc nextnumber
a#=nextnumber
if a#/9=int(a#/9)
center text across*38+112,down*50+30,secretletter$
else
center text across*38+112,down*50+30,a$(nextnumber)
endif
next across
next down
endfunction secretletter$
****************************** EDIT ************************
The programme above will not work properly with DB Classic V1.2 due to the altering of the text sizes in the upgrade.
Latch has written a text conversion function that corrects the text problem. See his posting 22nd Oct 2007 10:52 below, where he has reproduced the programme with the implementation of the function.
Unfortunately, a straight conversion produces a somewhat smaller sized text and I find that where I was using, for example, size 21 with earlier versions of DB Classic, I now have to use size 24 to get a comparable result.
So, for the
FINAL TIME, here is the programme, yet again rewritten.
Whilst TDK_Man pointed out in
http://www.computechtenerife.com/forum/index.php/topic,186.0.html
Quote: ""DB Classic is very 'iffy' with Syncs and Text - especially when using different sized text on the same screen. It often requires a double-sync or the text flashes or doesn't appear. It can get quite messy!”"
the programme, as written, works fine on my computer system:
OS is Microsoft Windows ME 4.90.3000
Processor is Authentic AMD AMD.K6(tm) 48.0MB RAM
My thanks to TDK_Man and Latch for your information.
Latch, I have taken the liberty of modifying your function to use when I require to change fonts. Hope you don’t mind.
remstart
-------------------------------------------------------
Puzzles from my Merlin's Wide and Wonderful
World of Mystical Magic series
************************
Author: gearce - December 2006
Extensively re-written - October 2007
************************
This is Puzzle Number 1 from my Merlin's Wide and
Wonderful World of Mystical Magic series but without
all the media
-------------------------------------------------------
remend
rem Call procedures to set everything up and display Splash Screen
gosub setup
gosub splash
rem Main programme loop
do
gosub selectnum
gosub addtwo
gosub drawmatrix
gosub reveal
gosub playagain
loop
rem End programme
end
rem =======================================================
rem *** Procedures ***
rem =======================================================
selectnum:
rem -------------------------------------------------------
rem Select a number from 10 to 99
rem -------------------------------------------------------
rem A short wait before proceeding
wait 1000
rem Define the message string and write to screen
message$(1)="Move mouse left and right to select a number from 10 to 99"
message$(2)="Click the mouse button to continue."
for n=1 to 2
center text sc,n*th+108,message$(n)
next n
rem Call function to change text style and size and ink colour
set_text_size("arial",72,"b",255,255,255)
set text opaque
th=text height("X")
rem Set starting number and write to screen
number=10: chosennumber$="10"
center text sc,180,chosennumber$
rem Sync: Sync
rem Move mouse left and right until number is chosen
repeat
mmx=mousemovex(): mc=mouseclick()
if mmx<>0
inc number,mmx/16
if number<10 then number=10
if number>99 then number=99
chosennumber$=str$(number)
endif
sync
center text sc,180,chosennumber$
until mouseclick()=1
rem sync
return
addtwo:
rem -------------------------------------------------------
rem Add two digits of number and subtract from original
rem -------------------------------------------------------
rem A short wait before proceeding
wait 1000
rem Call function to change text style and size and ink colour
set_text_size("arial",24,"b",255,217,128)
set text transparent
th=text height("X")
rem Sync: Sync
rem Define the message string ...
message$(1)="1. Add the above two digits of your chosen number together."
message$(2)="2. Subtract the result from the chosen number."
message$(3)="3. Click the mouse button to continue ..."
rem ... and write to screen in three parts
for n=1 To 3
if n>1 then wait 2000
center text sc,n*th+252,message$(n)
next n
rem Wait for mouse click
suspend for mouse
rem Clear screen
cls
return
drawmatrix:
rem -------------------------------------------------------
rem Draw a 12x7 matrix and load it with 84 random letters
rem -------------------------------------------------------
rem A short wait before proceeding
wait 1000
rem Define the message string and write to screen
message$="I will draw a 12x7 matrix and load it with 84 letters"
center text sc,228,message$
rem A short wait before proceeding
wait 4000
rem Clear screen
cls
rem Turn on screen refreshing
sync on
rem Call function to draw matrix
matrix()
rem Call function to write 84 numbers
eightyfournumbers()
rem Let programme handle screen refreshing
sync
rem A short wait before proceeding
wait 2000
rem Call function to write 84 letters
secretletter$=eightyfourletters(a$)
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem A short wait before proceeding
wait 1000
rem Call function to change text style and size and ink colour
set_text_size("arial",24,"b",255,217,128)
th=text height("X")
rem Define the message string and write to screen
message$="Find the letter that appears above your answer and click mouse"
center text sc,398,message$
rem Wait for mouse click
suspend for mouse
rem Clear screen
cls
return
reveal:
rem -------------------------------------------------------
rem Reveal mystical magic ...
rem -------------------------------------------------------
rem A short wait before proceeding
wait 1000
rem Define the message string ...
message$="Now here's the magic ... Watch this"
tw=text width(message$)
rem Set across and down coordinates and part counter
across=sc-(tw/2):down=228:part=0
rem ... and write to screen in three parts
repeat
rem Increment part counter
inc part
select part
case 1 : pos=1:length=21 : endcase
case 2 : pos=22:length=25:across=across+text width(sub$) : endcase
case 3 : pos=26:length=35:across=across+text width(sub$) : endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$,n)
next n
wait 500
text across,down,sub$
until part=3
rem A short wait before proceeding
wait 1000
rem Clear screen
cls
rem A short wait before proceeding
wait 1000
rem Define the message string and write to screen
message$="The letter that appeared above your answer was ..."
center text sc,93,message$
rem A short wait before proceeding
wait 3000
rem Call function to change text style and size and ink colour
set_text_size("arial black",144,"b",255,0,0)
th=text height("X")
rem Set down coordinate and write secret letter
down=114
center text sc,down,secretletter$
return
playagain:
rem -------------------------------------------------------
rem ... and ask play again
rem -------------------------------------------------------
rem A short wait before proceeding
wait 1000
rem Call function to change text style and size and ink colour
set_text_size("arial",24,"b",255,217,128)
th=text height("X")
rem Sync
rem Define the message string ...
message$(0)="Correct? Thank you!"
tw=text width(message$(0))
rem Set across and down coordinates and part counter
across=sc-(tw/2):down=260:part=0
rem ... and write to screen in two parts
repeat
rem Increment part counter
inc part
select part
case 1 : pos=1:length=10 : endcase
case 2 : pos=11:length=20:across=across+text width(sub$): endcase
endselect
sub$=""
for n=pos to length
sub$=sub$+mid$(message$(0),n)
next n
rem A short wait before proceeding
wait 1000
text across,down,sub$
rem Sync: Sync
until part=2
rem A short wait before proceeding
wait 1000
rem Increment down coordinate
inc down,th*2
rem Define the message string and write to screen
message$(0)="Play again?"
center text sc,down,message$(0)
rem A short wait before proceeding
wait 1000
rem Define the message string ...
message$(1)="Left click mouse for YES "
message$(2)="- "
message$(3)="Right click mouse for NO"
rem Set across and down coordinates
scrposx=sc-(text width(message$(1)+message$(2)+message$(3))/2)
inc down,th*2: spx=0
rem ... and write to screen in three parts
for n=1 To 3
text scrposx+spx,down,message$(n)
rem Sync
rem A short wait before proceeding
wait 500
inc spx,text width(message$(n))
next n
rem Until mouse is clicked
repeat
mc=mouseclick()
until mc>0
rem Clear screen
cls
rem : Sync
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
rem Gosub Splash: rem <<< Enable this line if you want splash screen shown at
rem start of every game
rem Turn on screen refreshing
sync on
rem : Sync Rate 60
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 End of programme
end
setup:
rem -------------------------------------------------------
rem Setup
rem -------------------------------------------------------
rem Set display mode
set display mode 640,480,16
rem This command will hide the mouse pointer
hide mouse
rem Assure random is always different
randomize timer()
rem Clear screen
cls
rem Call function to change text style and size and ink colour
set_text_size("arial",24,"b",255,217,128)
th=text height("X")
rem Determine centre of screen width
sc=screen width()/2
rem Declare array/s
dim a$(84)
dim splash$(9)
dim message$(10)
rem Define Splash Screen message string ...
splash$(1) = "Puzzles from my Merlin's Wide and Wonderful"
splash$(2) = "World of Mystical Magic series"
splash$(3) = "************************"
splash$(4) = "Author: gearce - December 2006"
splash$(5) = "Extensively re-written - October 2007"
splash$(6) = "************************"
splash$(7) = "This is Puzzle Number 1 from my Merlin's Wide and"
splash$(8) = "Wonderful World of Mystical Magic series but without"
splash$(9) = "all the media"
return
splash:
rem -------------------------------------------------------
rem Splash screen
rem -------------------------------------------------------
rem Turn on screen refreshing
sync on
rem ... and write to screen
for n=1 To 9
center text sc,n*th+108,splash$(n)
next n
rem sync
rem Let programme handle screen refreshing
sync
rem Return screen refreshing to system
sync off
rem A short wait before proceeding
wait 5000
rem Clear screen
cls
rem Sync
rem : Sync off
Return
rem -------------------------------------------------------
rem Function to draw matrix
rem -------------------------------------------------------
function matrix
for down=0 to 7
l=92:t=down*50+27:r=548:b=t
line l,t,r,b
next down
for across=0 to 12
l=across*38+92:t=27:r=l:b=377
line l,t,r,b
next across
endfunction
rem -------------------------------------------------------
rem Function to write 84 numbers to screen
rem -------------------------------------------------------
function eightyfournumbers
rem Call function to change text style and size and ink colour
set_text_size("arial",12,"b",255,217,128)
th=text height("X")
rem Set next number counter
nextnumber=0
rem Write numbers in a 12 x 7 matrix
for down=0 to 6
for across=0 to 11
inc nextnumber
a#=nextnumber
center text across*38+112,down*50+60,str$(a#)
next across
next down
endfunction
rem -------------------------------------------------------
rem Function to select 84 random letters, determine secret
rem letter and write letters to screen
rem -------------------------------------------------------
function eightyfourletters(a$)
rem Call function to change text style and size and ink colour
set_text_size("arial black",30,"b",255,255,255)
th=text height("X")
rem Arrange 84 letters in random order
for a=1 to 84
t=rnd(25)+1
a$(a)=chr$(t+64)
if a=9
secretletter$=a$(a)
endif
next a
rem Set next number counter
nextnumber=0
rem Write random letters in a 12 x 7 matrix
for down=0 to 6
for across=0 to 11
inc nextnumber
a#=nextnumber
if a#/9=int(a#/9)
center text across*38+112,down*50+30,secretletter$
else
center text across*38+112,down*50+30,a$(nextnumber)
endif
next across
next down
endfunction secretletter$
rem -------------------------------------------------------
rem Function to correct text size in DBC 1.2
rem and change font
rem -------------------------------------------------------
rem DBC 1.2 text size correction
rem By Latch - 10/14/2007
rem find the ratio of expected size to new size
rem *******************************************
rem and modified by gearce to change font
rem *******************************************
function set_text_size(font$,sz,style$,r,g,b)
set text font font$
set text size sz
a$="Q"
adjustment#=((text size()*1.0)/(text height(a$)*1.0))
newsize=((sz*1.0)*adjustment#)
set text size newsize
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
gearce
(GRC)
LANG MEY YER LUM REEK
That's ODD ...... In 1911, 3 men were hung for the murder of Sir Edmund Berry at Greenbury Hill, their last names were Green, Berry, and Hill.
