Hi everybody, this is a fun programme. It's from my Merlin's Wide and Wonderful World of Mystical Magic series but without the fancy trimmings, bitmaps, images, special effects etc
It's coded in DB Classic
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()
` Go through a loop until the keypress is Enter
repeat
set cursor 0,0:print "Think of a number from 10 to 99, write it down and press ENTER"
` Wait for a keypress
a=scancode()
until a=28
` Wait for a time before proceeding
wait 1000
` Go through a loop until the keypress is Enter
do
set cursor 0,18:print "Add the two digits together, subtract from your number and press ENTER"
` Wait for a keypress
b=scancode()
if b=28 then exit
loop
` Wait for a time before proceeding
wait 1000
` Set counter
c=0
` Go through a loop until the keypress is Enter
while c<>28
set cursor 0,36:print "Note your answer and press ENTER"
` Wait for a keypress
c=scancode()
endwhile
` Leave a space between text lines
print
` Wait for a time before proceeding
wait 1000
` Print text to screen
print "Now here's the magic ... ";
` Wait for a time before proceeding
wait 1000
` Print text to screen
print "Watch this"
` Wait for a time before proceeding
wait 1500
` Call eighty four letters function
secretletter$=eighty_four_letters(a$)
` Wait for a time before proceeding
wait 1000
` Print text to screen
print "The letter above your answer is ";
` Wait for a time before proceeding
wait 1500
` Print text to screen
print secretletter$;" ... ";
` Wait for a time before proceeding
wait 1000
` Print text to screen
print "Press any key (except Esc) to try again"
` Wait for a keypress
wait key
` Clear screen and return to start
cls:goto start
end
` -----------------------------------------------
` 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
` 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=-10:inc down,50
endif
next a
` Set counters
across=-10: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=-10: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
Just highlight the code, right click, copy and paste into Dark Basic. Enjoy
gearce
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.