TheGameCreators - CodeBase - Mystical Magic

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 28th Dec 2006 03:20

Modified: 1st Jan 1970 01:00

Author: gearce

Summary

This is a fun programme

Full Description

This is Puzzle Number 1 from my Merlin's Wide and Wonderful World of Mystical Magic but without all the trimmings, bitmaps, images, special effects etc

DarkBASIC Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

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

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

` 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

Download

Please login to download

Comments

No comments yet.

CodeBase - Mystical Magic - A puzzle programme

Information

Summary

Full Description

DarkBASIC Source Code

Download

Screen Shot

Author

Comments

Author Name:	gearce
CodeBase Entries:	2