TGC Codebase Backup



Mystical Magic by gearce

28th Dec 2006 3:20
Summary

This is a fun programme



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



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
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