Re my posting dated 28th Dec 2006 01:28
Sorry folks but I posted the wrong version. Whilst it still works, it has been updated and the updated version is posted here
remstart
-------------------------------------------------------
Puzzle Number 1 from my Merlin's Wide and Wonderful
World of Mystical Magic series
***********************
Author: gearce - December 2006
***********************
This is Puzzle Number 1 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
` Messages
a$="Hello! I'm Merlin."
b$=""
c$="Allow me to show you some of"
d$="my Mystical Magic with Puzzle"
e$="Number 1 from my Wide and"
f$="Wonderful World of Mystical"
g$="Magic series, but without all the"
h$="bitmaps, images, special effects"
i$="etc"
` Determine text height. Determine text width
`(i.e width of longest message line). Determine
` where to write text to screen. Set ink colour
th=21
tw=text width(h$)
a=320-(tw/2):across=a:down=156
ink rgb(255,255,255),1
` Go to subroutine to get letters from the messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
message$=c$
across=a:inc down,(th*1)
gosub get_letters
message$=d$
across=a:inc down,(th*1)
gosub get_letters
message$=e$
across=a:inc down,(th*1)
gosub get_letters
message$=f$
across=a:inc down,(th*1)
gosub get_letters
message$=g$
across=a:inc down,(th*1)
gosub get_letters
message$=h$
across=a:inc down,(th*1)
gosub get_letters
message$=i$
across=a:inc down,(th*1)
gosub get_letters
` Wait for a time before proceeding
wait 3000
` Clear screen
cls
` Start of programme
start:
` Declare array/s
dim a$(84)
` Assure random is always different
randomize timer()
` -------------------------------------------
` Think of a number
` -------------------------------------------
` Messages
a$="Think of a number from 10 to 99,"
b$="write it down and click mouse"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=219
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Add two digits together and subtract
` from number
` -------------------------------------------
` Messages
a$="Add the two digits together, subtract"
b$="from your number and click mouse"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=219
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Note answer
` -------------------------------------------
` Messages
a$="Note your answer and click mouse"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=240
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` ---------------------------------------------
` Draw a 12x7 matrix and load it with random
` letters
` ---------------------------------------------
` Messages
a$="I will draw a 12x7 matrix and load it"
b$="with 84 numbers and letters"
tw=text width(a$)
a=320-(tw/2):across=a:down=219
` Go to subroutine to get letters from the messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` Call eighty four letters function
secretletter$=eighty_four_letters(a$)
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Note letter above answer
` -------------------------------------------
` Messages
a$="Note the letter over your answer and click mouse"
tw=text width(a$)
a=320-(tw/2):across=a:down=24
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` Messages
a$="Now here's the magic ... Watch this"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=240
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Clear screen
cls
` ---------------------------------------------
` Reveal mystical magic ...
` ---------------------------------------------
` Message
a$="The letter over your answer was"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=81
` Go to subroutine to get letters from the messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Change to large text
` Call large text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_120(a$)
th=text height("arial")
down=180
center text 320,down,secretletter$
` Wait for a time before proceeding
wait 1000
` ----------------------------------------------
` ... and ask play again
` ----------------------------------------------
` Messages
a$="Correct? "
b$="Thank you"
c$="Play again [Y]es or [N]o"
` Return to normal text
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$+b$)
a=320-(tw/2):across=a:down=378
` Go to subroutine to get letters from the messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Go to subroutine to get letters from the messages
message$=b$
tw=text width(a$)
across=a+tw:down=down
gosub get_letters
message$=c$
tw=text width(c$)
a=320-(tw/2):across=a:inc down,(th*1)
gosub get_letters
` Go to subroutine for a keypress
gosub yes_or_no
` Depending on keypress, take appropriate action
if a=21
` If keypress equals Y
` Clear screen
cls
goto start
else
` If keypress equals N
goto the_end
endif
` End of programme
the_end:
cls
end
` ----------------------------------------------------------------
` Text functions
` ----------------------------------------------------------------
function font_21(a$)
set text font "arial"
set text size 21
set text to bold
endfunction
function font_120(a$)
set text font "arial"
set text size 120
set text to bold
endfunction
` -----------------------------------------------
` Function to Select 84 random letters, determine
` secret letter and write letters to the screen
` -----------------------------------------------
function eighty_four_letters(a$)
for a=1 to 84
t=rnd(25)+1
a$(a)=chr$(t+64)
tw=text width(a$(a))
if a=9
secretletter$=a$(a)
endif
next a
` Set counters
`across=-10:down=134
across=76:down=134
` Write random numbers to screen
for a=1 to 84
a#=a
inc across,38
center text across,down,str$(a#)
if a#/12=int(a#/12)
across=76:inc down,50
endif
next a
` Set counters
across=76:down=109
` Write random letters to screen
for a=1 to 84
a#=a
inc across,38
if a#/9=int(a#/9)
center text across,down,secretletter$
else
center text across,down,a$(a)
endif
if a#/12=int(a#/12)
across=76:inc down,50
endif
next a
endfunction secretletter$
` ---------------------------------------------
` Subroutine to get letters from messages and
` write one at a time to screen
` ---------------------------------------------
get_letters:
long=len(message$)
for z= 1 to long
text across,down,left$(message$,(long-(long-z)))
next z
delay=0
return
` -------------------------------------------------
` Subroutine for keypress Y or N
` -------------------------------------------------
yes_or_no:
repeat
a=scancode()
until a=21 or a=49
return
Here is another puzzle from my Merlin's Wide and Wonderful World of Mystical Magic series
remstart
-------------------------------------------------------
Puzzle Number 15 from my Merlin's Wide and Wonderful
World of Mystical Magic series
***********************
Author: gearce - December 2006
***********************
This is Puzzle Number 15 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
` Messages
a$="Hello! I'm Merlin."
b$=""
c$="Allow me to show you some of"
d$="my Mystical Magic with Puzzle"
e$="Number 15 from my Wide and"
f$="Wonderful World of Mystical"
g$="Magic series, but without all the"
h$="bitmaps, images, special effects"
i$="etc"
` Determine text height. Determine text width
`(i.e width of longest message line). Determine
` where to write text to screen. Set ink colour
th=21
tw=text width(h$)
a=320-(tw/2):across=a:down=156
ink rgb(255,255,255),1
` Go to subroutine to get letters from the messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
message$=c$
across=a:inc down,(th*1)
gosub get_letters
message$=d$
across=a:inc down,(th*1)
gosub get_letters
message$=e$
across=a:inc down,(th*1)
gosub get_letters
message$=f$
across=a:inc down,(th*1)
gosub get_letters
message$=g$
across=a:inc down,(th*1)
gosub get_letters
message$=h$
across=a:inc down,(th*1)
gosub get_letters
message$=i$
across=a:inc down,(th*1)
gosub get_letters
` Wait for a time before proceeding
wait 3000
` Clear screen
cls
` Start of programme
start:
` Declare array/s
dim x(4)
` Assure random is always different
randomize timer()
` Generate four random numbers each from 1 to 999
for randomnumber=1 to 4
tryagain:
s=rnd(998)+1
` If any random number generated is less than 100
` repeat the process since we are looking for a
` three-digit number
if s<100 then goto tryagain
` This command identifies the numbers in the order
` in which they are generated
x(randomnumber)=s
next randomnumber
` Convert the numbers to strings and add the first
` and second strings together to give us one six-
` character string, then the third and fourth strings
` to give us a second six-character string
number1$=str$(x(1))+str$(x(2))
number2$=str$(x(3))+str$(x(4))
` Convert the strings back to numbers to give us two
` six-digit numbers
number1=val(number1$)
number2=val(number2$)
` If choice is play again
if a=21
goto write_numbers
endif
` Wait for a time before proceeding
wait 100
write_numbers:
` -------------------------------------------
` Write down two numbers
` -------------------------------------------
` Messages
a$="Write down these two six-digit numbers "
b$="one below the other like so, call these"
c$="rows A and B "
d$=""
e$=number1$+" A"
f$=number2$+" B"
g$="and click mouse"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=156
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
message$=c$
across=a:inc down,(th*1)
gosub get_letters
message$=d$
across=a:inc down,(th*1)
gosub get_letters
` Wait for a time before proceeding
wait 1000
message$=e$
tw=text width(e$)
a=320-(tw/2):across=a
inc down,(th*1)
gosub get_letters
message$=f$
tw=text width(f$)
a=320-(tw/2):across=a
inc down,(th*1)
gosub get_letters
message$=d$
across=a:inc down,(th*1)
gosub get_letters
message$=g$
tw=text width(a$)
a=320-(tw/2):across=a
inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Find a digit to add to make 9
` -------------------------------------------
` Messages
a$="For each digit in row A, find a digit to ADD"
b$="to make 9, write them underneath to form"
c$="row C and click mouse"
th=text height("arial")
tw=text width(b$)
a=320-(tw/2):across=a:down=209
` Go to subroutine to get letters from messages
message$=a$
across=a
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
message$=c$
across=a:inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Write any six-digit number
` -------------------------------------------
` Messages
a$="Write any six-digit number underneath"
b$="to form row D and ..."
c$="... for each digit in row D write the"
d$="digit to ADD to make 9 for row E and"
e$="click mouse"
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=188
` Go to subroutine to get letters from messages
message$=a$
across=a
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
message$=c$
across=a:inc down,(th*1)
gosub get_letters
message$=d$
across=a:inc down,(th*1)
gosub get_letters
message$=e$
across=a:inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Wait for a time before proceeding
wait 1000
` -------------------------------------------
` Add numbers together
` -------------------------------------------
` Messages
a$="Add these five numbers together and"
b$="click mouse"
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=219
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:inc down,(th*1)
gosub get_letters
` Wait for mouse click
suspend for mouse
` Clear screen
cls
` Messages
a$="Now here's the magic ... Watch this"
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=240
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Clear screen
cls
` -------------------------------------------
` Reveal mystical magic ...
` -------------------------------------------
` Calculate answer to puzzle
answer=2000000+(number2-2)
` Messages
a$="Your answer is"
th=text height("arial")
tw=text width(a$)
a=320-(tw/2):across=a:down=81
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Change to large text
` Call large text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_120(a$)
th=text height("arial")
down=180
center text 320,down,str$(answer)
` Wait for a time before proceeding
wait 1000
` Return to normal text
` Call normal text function. Determine text height.
` Determine text width `(i.e width of longest message
` line). Determine where to write text to screen.
font_21(a$)
th=text height("arial")
tw=text width(a$)
` -------------------------------------------
` ... and ask play again
` -------------------------------------------
` Messages
a$="Correct? "
b$="Thank you"
c$="Play again [Y]es or [N]o"
tw=text width(a$+b$)
a=320-(tw/2):across=a:down=378
` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
` Wait for a time before proceeding
wait 1000
` Go to subroutine to get letters from messages
message$=b$
tw=text width(a$)
across=a+tw:down=down
gosub get_letters
message$=c$
tw=text width(c$)
a=320-(tw/2):across=a:inc down,(th*1)
gosub get_letters
` Go to subroutine for a keypress
gosub yes_or_no
if a=21
` If keypress=Y
` Clear screen
cls
goto start
else
` If keypress=N
goto the_end
endif
` End of programme
the_end:
cls
end
` ----------------------------------------------------------------
` Text functions
` ----------------------------------------------------------------
function font_21(a$)
set text font "arial"
set text size 21
set text to bold
endfunction
function font_120(a$)
set text font "arial"
set text size 120
set text to bold
endfunction
` -------------------------------------------------
` Subroutine go get letters from messages and print
` one at a time to screen
` -------------------------------------------------
get_letters:
long=len(message$)
for z=1 to long
text across,down,left$(message$,(long-(long-z)))
next z
return
` -------------------------------------------------
` Subroutine for keypress Y or N
` -------------------------------------------------
yes_or_no:
repeat
a=scancode()
until a=21 or a=49
return
For both, just highlight the text, right click, copy and paste into Dark Basic.
Enjoy
gearce
LANG MAY YER LUM REEK
