Mystical Magic - Puzzle number 4 in DBClassic

Author

Message

gearce

17

Years of Service

User Offline

Joined: 18th Dec 2006

Location: ex SCOTLAND, now MELBOURNE, Australia

Posted: 2nd Jan 2007 02:55 Edited at: 2nd Jan 2007 10:40

Link

Well here's puzzle number 4 in my Merlin's Wide and Wonderful World of Mystical Magic series.

By now you will probably have guessed that these puzzles are aimed at the youngster generation (Yes I'm an adult).

remstart
  -------------------------------------------------------
    Puzzle Number 4 from my Merlin's Wide and Wonderful
              World of Mystical Magic series
                  ***********************
           Author: gearce    -     December 2006
                  ***********************
    This is Puzzle Number 4 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 4 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

` Start of programme
start:

` Clear screen
cls

` Assure random is always different
randomize timer()

` Set counters
answer$=""
selection=0

` Declare array/s
dim a$(84)

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Choose a number from 1 to 99
` -------------------------------------------------------
` Messages
a$="Choose any number from 1 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=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Write down the next six consecutive numbers
` -------------------------------------------------------
` Messages
a$="Underneath, write down the next six"
b$="consecutive numbers and click mouse"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Add up the seven numbers
` -------------------------------------------------------
` Messages
a$="Add up the seven numbers, write down"
b$="the answer and click mouse"
tw=text width(a$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Draw a 11x9 matrix and load it with numbers
` -------------------------------------------------------
` Messages
a$="I will draw a 11x9 matrix and load it"
b$="with 99 numbers"
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

` Go to subroutine to draw matrix
gosub drawmatrix

` Call ninety nine numbers function
number=ninety_nine_numbers(a)

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Tell chosen number
` -------------------------------------------------------
` Messages
a$="Tell me the number you chose by clicking"
b$="the appropriate box number"
tw=text width(a$)
a=320-(tw/2):across=a:down=40

` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:down=down+(th*1)
gosub get_letters

` Until a selection has been made
  do
     ` If a selection has been made then exit the loop
     if selection>=1
       exit
     endif

` If no selection is made return here
    no_selection:

` Wait for a time before proceeding
    wait 50

` This command will show the mouse pointer
    show mouse

` This command will set the mouse pointer
    position mouse 320,268

` Go to subroutine to check selection
    gosub check_selection

` Wait for a time before proceeding
    wait 50

` End loop
  loop

` Wait for a time before proceeding
wait 1000

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Here's the magic
` -------------------------------------------------------
` Messages
a$="Now here's the magic ... "
b$="Watch this"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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=240

` 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

` Wait for a time before proceeding
wait 1000

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Reveal mystical magic ...
` -------------------------------------------------------
` Messages
a$="Your answer is"
b$=""
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
message$=b$
across=a:inc down,(th*1)
gosub get_letters

` Wait for a time before proceeding
wait 1000

` Switch to large text
` Call large text function. Determine text height.
` Determine where to write text to screen.
font_120(a$)
th=text height("arial")
down=180
answer$=str$(answer)
center text 320,down,answer$

` Wait for a time before proceeding
wait 1000
` -------------------------------------------------------
` ... and ask play again
` -------------------------------------------------------
` Messages
a$="Correct?   "
b$="Thank you"
c$="Play again Yes or No"
d$="Left click mouse for YES - right click mouse for NO"

` 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=357

` 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
message$=d$
tw=text width(d$)
a=320-(tw/2):across=a:inc down,(th*1)
gosub get_letters

` Until mouse is clicked
  do
    mouseclick=MouseClick()

if mouseclick=1
      goto start
      exit
    endif
    if mouseclick=2
      goto the_end
      exit
    endif
  ` End loop
  Loop

` End of programme
the_end:
cls
end

` -------------------------------------------------------
` FUNCTIONS
` -------------------------------------------------------
` -------------------------------------------------------
` Text font 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 write 99 numbers to the screen
` -------------------------------------------------------
 function ninety_nine_numbers(a)

` Set counters
    across=92:down=108

` Write numbers to screen
    for a=1 to 99
      a#=a
      inc across,38
          center text across,down,str$(a#)
        if a#/11=int(a#/11)
          across=92:inc down,38
        endif
    next a
  endfunction number
` -------------------------------------------------------
` SUBROUTINES
` -------------------------------------------------------
` -------------------------------------------------------
` 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
` -------------------------------------------------------
` Subroutine to draw matrix on screen
` -------------------------------------------------------
  drawmatrix:
    ` Set counters
    l=111:t=61:r=529:b=99
    ` Where on screen to draw matrix
    for nextbox=1 to 9
      inc t,38:inc b,38
      box l,t,r,b
      ink 0,0
      box l+1,t+1,r-1,b-1
      ink rgb(255,255,255),1
    next nextbox

left=111
    for aline=1 to 12
      line left,99,left,441
      inc left,38
    next aline
  return
` -------------------------------------------------------
` Subroutine to draw lines on screen
` -------------------------------------------------------
  draw_lines:
    left=111:top=251:right=529:bottom=289
    line left,top,right,top

for a=1 to 12
        line left,251,left,289
        inc left,38
      next a

left=111
    line left,bottom,right,bottom
  return
` -------------------------------------------------------
` Subroutine to check for selection
` -------------------------------------------------------
  check_selection:

`Wait for mouse click
  suspend for mouse

` If mouse button is pressed
  x=mousex()
  y=mousey()

` This command will hide the mouse pointer
  hide mouse

` First row in matrix - numbers 1 to 11
  if (y>=100 and y<=136)
    first=112:last=148:selection=0:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Second row in matrix - numbers 12 to 22
  if (y>=138 and y<=174)
    first=112:last=148:selection=11:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Third row in matrix - numbers 23 to 33
  if (y>=176 and y<=212)
    first=112:last=148:selection=22:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Fourth row in matrix - numbers 34 to 44
  if (y>=214 and y<=250)
    first=112:last=148:selection=33:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Fifth row in matrix - numbers 45 to 55
  if (y>=252 and y<=288)
    first=112:last=148:selection=44:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Sixth row in matrix - numbers 56 to 66
  if (y>=290 and y<=326)
    first=112:last=148:selection=55:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Seventh row in matrix - numbers 67 to 77
  if (y>=328 and y<=364)
    first=112:last=148:selection=66:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Eighth row in matrix - numbers 78 to 88
  if (y>=366 and y<=402)
    first=112:last=148:selection=77:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

` Ninth row in matrix - numbers 89 to 99
  if (y>=404 and y<=440)
    first=112:last=148:selection=88:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif
  goto no_selection

re_turn:
  answer=(selection+3)*7
  return

+ Code Snippet

remstart
  -------------------------------------------------------
    Puzzle Number 4 from my Merlin's Wide and Wonderful
              World of Mystical Magic series
                  ***********************
           Author: gearce    -     December 2006
                  ***********************
    This is Puzzle Number 4 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 4 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

` Start of programme
start:

` Clear screen
cls

` Assure random is always different
randomize timer()

` Set counters
answer$=""
selection=0

` Declare array/s
dim a$(84)

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Choose a number from 1 to 99
` -------------------------------------------------------
` Messages
a$="Choose any number from 1 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=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Write down the next six consecutive numbers
` -------------------------------------------------------
` Messages
a$="Underneath, write down the next six"
b$="consecutive numbers and click mouse"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Add up the seven numbers
` -------------------------------------------------------
` Messages
a$="Add up the seven numbers, write down"
b$="the answer and click mouse"
tw=text width(a$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Draw a 11x9 matrix and load it with numbers
` -------------------------------------------------------
` Messages
a$="I will draw a 11x9 matrix and load it"
b$="with 99 numbers"
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

` Go to subroutine to draw matrix
gosub drawmatrix

` Call ninety nine numbers function
number=ninety_nine_numbers(a)

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Tell chosen number
` -------------------------------------------------------
` Messages
a$="Tell me the number you chose by clicking"
b$="the appropriate box number"
tw=text width(a$)
a=320-(tw/2):across=a:down=40

` Go to subroutine to get letters from messages
message$=a$
gosub get_letters
message$=b$
across=a:down=down+(th*1)
gosub get_letters

  ` Until a selection has been made
  do
     ` If a selection has been made then exit the loop
     if selection>=1
       exit
     endif

    ` If no selection is made return here
    no_selection:

    ` Wait for a time before proceeding
    wait 50

    ` This command will show the mouse pointer
    show mouse

    ` This command will set the mouse pointer
    position mouse 320,268

    ` Go to subroutine to check selection
    gosub check_selection

    ` Wait for a time before proceeding
    wait 50

  ` End loop
  loop

` Wait for a time before proceeding
wait 1000

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Here's the magic
` -------------------------------------------------------
` Messages
a$="Now here's the magic ... "
b$="Watch this"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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=240

` 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

` Wait for a time before proceeding
wait 1000

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Reveal mystical magic ...
` -------------------------------------------------------
` Messages
a$="Your answer is"
b$=""
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
message$=b$
across=a:inc down,(th*1)
gosub get_letters

` Wait for a time before proceeding
wait 1000

` Switch to large text
` Call large text function. Determine text height.
` Determine where to write text to screen.
font_120(a$)
th=text height("arial")
down=180
answer$=str$(answer)
center text 320,down,answer$

` Wait for a time before proceeding
wait 1000
` -------------------------------------------------------
` ... and ask play again
` -------------------------------------------------------
` Messages
a$="Correct?   "
b$="Thank you"
c$="Play again Yes or No"
d$="Left click mouse for YES - right click mouse for NO"

` 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=357

` 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
message$=d$
tw=text width(d$)
a=320-(tw/2):across=a:inc down,(th*1)
gosub get_letters

` Until mouse is clicked
  do
    mouseclick=MouseClick()

    if mouseclick=1
      goto start
      exit
    endif
    if mouseclick=2
      goto the_end
      exit
    endif
  ` End loop
  Loop

` End of programme
the_end:
cls
end

` -------------------------------------------------------
` FUNCTIONS
` -------------------------------------------------------
` -------------------------------------------------------
` Text font 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 write 99 numbers to the screen
` -------------------------------------------------------
 function ninety_nine_numbers(a)

   ` Set counters
    across=92:down=108

    ` Write numbers to screen
    for a=1 to 99
      a#=a
      inc across,38
          center text across,down,str$(a#)
        if a#/11=int(a#/11)
          across=92:inc down,38
        endif
    next a
  endfunction number
` -------------------------------------------------------
` SUBROUTINES
` -------------------------------------------------------
` -------------------------------------------------------
` 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
` -------------------------------------------------------
` Subroutine to draw matrix on screen
` -------------------------------------------------------
  drawmatrix:
    ` Set counters
    l=111:t=61:r=529:b=99
    ` Where on screen to draw matrix
    for nextbox=1 to 9
      inc t,38:inc b,38
      box l,t,r,b
      ink 0,0
      box l+1,t+1,r-1,b-1
      ink rgb(255,255,255),1
    next nextbox

    left=111
    for aline=1 to 12
      line left,99,left,441
      inc left,38
    next aline
  return
` -------------------------------------------------------
` Subroutine to draw lines on screen
` -------------------------------------------------------
  draw_lines:
    left=111:top=251:right=529:bottom=289
    line left,top,right,top

      for a=1 to 12
        line left,251,left,289
        inc left,38
      next a

    left=111
    line left,bottom,right,bottom
  return
` -------------------------------------------------------
` Subroutine to check for selection
` -------------------------------------------------------
  check_selection:

  `Wait for mouse click
  suspend for mouse

  ` If mouse button is pressed
  x=mousex()
  y=mousey()

  ` This command will hide the mouse pointer
  hide mouse

  ` First row in matrix - numbers 1 to 11
  if (y>=100 and y<=136)
    first=112:last=148:selection=0:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Second row in matrix - numbers 12 to 22
  if (y>=138 and y<=174)
    first=112:last=148:selection=11:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

 ` Third row in matrix - numbers 23 to 33
  if (y>=176 and y<=212)
    first=112:last=148:selection=22:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Fourth row in matrix - numbers 34 to 44
  if (y>=214 and y<=250)
    first=112:last=148:selection=33:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Fifth row in matrix - numbers 45 to 55
  if (y>=252 and y<=288)
    first=112:last=148:selection=44:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Sixth row in matrix - numbers 56 to 66
  if (y>=290 and y<=326)
    first=112:last=148:selection=55:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Seventh row in matrix - numbers 67 to 77
  if (y>=328 and y<=364)
    first=112:last=148:selection=66:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Eighth row in matrix - numbers 78 to 88
  if (y>=366 and y<=402)
    first=112:last=148:selection=77:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif

  ` Ninth row in matrix - numbers 89 to 99
  if (y>=404 and y<=440)
    first=112:last=148:selection=88:plus=0
    for chosen=first to last
      inc plus,1
      if (x>=first and x<=last) then inc selection,plus:goto re_turn
        inc first,38:inc last,38
    next chosen
  endif
  goto no_selection

  re_turn:
  answer=(selection+3)*7
  return

As before, highlight the text, right click, copy and paste into Dark Basic Classic.

My DBClassic programming skills are on a continual learner level so I'd like to hear from you if you can offer a different (not necessarily better) way of writing any part of any of the programmes.

Have a Happy New Year wherever you are.

gearce

EDIT

This makes more sense. Take out

` -------------------------------------------------------
` Choose a number from 1 to 99
` -------------------------------------------------------
` Messages
a$="Choose any number from 1 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=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Write down the next six consecutive numbers
` -------------------------------------------------------
` Messages
a$="Underneath, write down the next six"
b$="consecutive numbers and click mouse"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

+ Code Snippet

` -------------------------------------------------------
` Choose a number from 1 to 99
` -------------------------------------------------------
` Messages
a$="Choose any number from 1 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=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

` -------------------------------------------------------
` Write down the next six consecutive numbers
` -------------------------------------------------------
` Messages
a$="Underneath, write down the next six"
b$="consecutive numbers and click mouse"
tw=text width(b$)
a=320-(tw/2):across=a:down=230

` 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 mouse click
suspend for mouse

` Clear screen
cls

` Wait for a time before proceeding
wait 1000

and put in

+ Code Snippet

` -------------------------------------------------------
` Write down seven consecutive numbers
` -------------------------------------------------------
` Messages
a$="Starting with any number from 1 to 99,"
b$="write down seven consecutive numbers"
c$="each below the other 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(b$)
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
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

Also replace this

+ Code Snippet

` -------------------------------------------------------
` Tell chosen number
` -------------------------------------------------------
` Messages
a$="Tell me the number you chose by clicking"
b$="the appropriate box number"

with this

+ Code Snippet

` -------------------------------------------------------
` Tell first number written
` -------------------------------------------------------
` Messages
a$="Tell me the first number you wrote down"
b$="by clicking the appropriate box number"

I think you will agree

gearce

LANG MAY YER LUM REEK

Back to top

Profile PM

Zotoaster

19

Years of Service

User Offline

Joined: 20th Dec 2004

Location: Scotland

Posted: 2nd Jan 2007 03:30

Link

If you want any tips fo your programming, you seem to be wating alot of lines writing the text. Try something like this:

+ Code Snippet

sync on : sync rate 60

writeText(10,10,"Hello, my name is Zotoaster|This is my writeText function in action|Use it as you wish|No need for credit|It's only a simple function|I'm not that greedy|",20.0)

wait key
end



`Functions
function writeText(x,y,text$,wtime#)
repeat
   inc curi#,wtime#/100
   oldcur=ncur
   ncur=int(curi#)
   if oldcur<>ncur then cur=ncur else cur=0
   cur$=mid$(text$,cur)
   if cur$<>"|" then posx=posx+text width(mid$(text$,cur-1))
   if cur$="|" then posx=0-text width(mid$(text$,cur-1)) : posy=posy+text height(cur$)
   if cur$<>"|" then text x+posx,y+posy,cur$
sync
until cur>len(text$)
endfunction

Back to top

Profile PM Email

gearce

17

Years of Service

User Offline

Joined: 18th Dec 2006

Location: ex SCOTLAND, now MELBOURNE, Australia

Posted: 2nd Jan 2007 03:41

Link

Thanks Zotoaster for your code snippet. Much appreciated. Looks good. Will certainly try it out in one of my programmes.

gearce

LANG MAY YER LUM REEK

Back to top

Profile PM

Sorry your browser is not supported!

Code Snippets / Mystical Magic - Puzzle number 4 in DBClassic