Hello! My name is NOT Merlin and this is NOT a puzzle from a Wide and Wonderful World of Mystical Magic series, but still a bit of magic none the less in what is commonly known as a Magic Square, in which the sum of the numbers running horizontally, vertically or diagonally is always the same.
Each time it is run, Magic Square will create one of these squares from size 3x3 to size 9x9 with a starting number from 1 to 19. I have restricted the starting number to a high of 19 simply for screen appearance and to keep the numbers inside a size 9x9 square from exceeding two digits.
remstart
=======================================================
MAGIC SQUARE
***********************
Author: gearce - January 2007
***********************
=======================================================
remend
` Declare array/s
dim m(25,25)
` This command will hide the mouse pointer
hide mouse
` Go to subroutine to write title
gosub title
` A short pause
wait 1000
` Set new text size
set text size 16
` Define the string (a space is needed at the end
` to print the last word)
partone$=" "
partone$=partone$+"|*Hello! My name is NOT Merlin and this is NOT a "
partone$=partone$+"puzzle from a Wide and Wonderful World of Mystical "
partone$=partone$+"Magic series, but still a bit of magic none the less "
partone$=partone$+"in what is commonly known as a Magic Square, *in which "
partone$=partone$+"the sum of the numbers "
` Message is limited to 255 characters in length
` hence the need to split it
message$=partone$
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("Hello! My name is NOT Merlin and this is NOT a ")/2
across=320-tw:down=146:wide=across+0
wide=wide+text width("Hello! My name is NOT Merlin and this is NOT a ")
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
` Reset down coordinate
down=242
` Continuing message
` Define the string (a space is needed at the end
` to print the last word)
parttwo$="running horizontally, vertically or diagonally is always the same. "
parttwo$=parttwo$+"||*Each time it is run, Magic Square will create one "
parttwo$=parttwo$+"of these squares from size 3x3 to 9x9 with a starting "
parttwo$=parttwo$+"number between 1 and 20. ||*Press any key to start. "
` Message
message$=parttwo$
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
` Press any key to start
wait key
` A short pause
wait 1000
` Start of programme
start:
` Clear screen
cls
` Go to subroutine to write title
gosub title
` A short pause
wait 1000
` Set new text size
set text size 16
` ==========================================
` Determine square size and starting number
` ==========================================
` Determine the square size. This must be an odd size so,
` if an even size is selected, try again. Also try again
` if a size less than three is selected
anothersize:
size#=rnd(8)+1
if size#/2=int(size#/2) then gosub anothersize
if size#<3 then gosub anothersize
` Determine the starting number
startnumber=rnd(18)+1
s=startnumber
` Write square size to screen
center text 320,110,str$(size#)+" by "+str$(size#)
` A short pause
wait 1000
` Write starting number to screen
center text 320,130,"starting with number "+str$(s)
` A short pause
wait 1000
` Initialise counters
k=1
h=1
j=(size#+1)/2
` ==========================================
` Subroutine 130 - reset counters and take
` action if conditions are met
` ==========================================
130:
m(h,j)=s
s=s+1
if s>size#^2+startnumber-1 then gosub 290
if k<size# then gosub 200
k=1
h=h+1
gosub 130
` ==========================================
` Subroutine 200 - reset counters and take
` action if conditions are met
` ==========================================
200:
h=h-1
j=j+1
k=k+1
if h<>0 then gosub 260
h=size#
gosub 130
` ==========================================
` Subroutine 260 - - reset counters and take
` action if conditions are met
` ==========================================
260:
if j<=size# then gosub 130
j=1
gosub 130
` ==========================================
` Subroutine 290 - write numbers to screen
` ==========================================
290:
` Depending on the size of the square, determine
` across and down coordinates
if size#=3 then across=280:x=across:down=200
if size#=5 then across=260:x=across:down=180
if size#=7 then across=240:x=across:down=160
if size#=9 then across=220:x=across:down=140
` For each of the numbers in the square, where to
` write to screen
for i=1 to size#
across=x:inc down,20
for j=1 to size#
inc across,20
number$=str$(m(i,j))
center text across,down,number$
next j
next i
` ==========================================
` Determine constant and write to screen
` ==========================================
` Determine constant (the sum when the numbers running
` horizontally, vertically or diagonally are added
` together)
constant=(((size#^3)+size#)/2)+size#*(startnumber-1)
` Write constant to screen
center text 320,380,"The constant is "+str$(constant)
` A short pause
wait 1000
` ==========================================
` Click mouse to try again or end programme
` ==========================================
` Text and where to write to screen
text$="Left click mouse to try again or "
text$=text$+"right click mouse to end the programme"
center text 320,400,text$
` Until mouse is clicked
do
` If mouse is left clicked, exit do ... loop and go to
` start of programme
if mouseclick()=1
gosub start
endif
` If mouse is right clicked, exit do ... loop and go to
` end of programme
if mouseclick()=2
` A short pause
wait 1000
` Clear screen
cls
` A short pause
wait 1000
gosub endit
endif
` End loop
loop
` End programme
endit:
end
` --------------------------------------------------
` Function to write words to screen
` --------------------------------------------------
function writewords(across,down,message$,tw,wide)
` Go through all the letters in the message
for t=1 to len(message$)
` Add one letter from message$ to nextword$
nextword$=nextword$+mid$(message$,t)
` Check if that letter is a space, a | or a *
if mid$(message$,t)=" " or mid$(message$,t)="|" or mid$(message$,t)="*"
` Check if the current across coordinate + the size of the
` word will go beyond the designated width and, if it does,
` reset across and increase down coordinates
if across+text width(nextword$)>wide
across=320-tw
inc down,text height(nextword$)
endif
` If the letter is a |, this indicates start of a new line
` of text
if mid$(message$,t)="|"
across=320-tw-text width(mid$(message$,t))
inc down,text height(nextword$)
endif
` If the letter is a *, this indicates a short pause before
` continuing same line of text
if mid$(message$,t)="*"
across=across-text width(mid$(message$,t))
wait 500
endif
` Create a write text switch and turn it off to avoid writing
` this | or this *
if mid$(message$,t)="|" or mid$(message$,t)="*"
writetext$="off"
else
` or turn it on to write all other text
writetext$="on"
text across,down,nextword$
endif
` Increase the across coordinate by the size of the word
inc across,text width(nextword$)
` Clear the current word to make a new word next loop
nextword$=""
` A short pause so you can see it working
wait 200
endif
next t
endfunction
` --------------------------------------------------
` Subroutine to write title
` --------------------------------------------------
title:
` Set text style and size
set text font "arial"
set text size 30
set text to bold
th=text height("arial")
` Define the string (a space is needed at the end
` to print the last word)
message$="|*MAGIC SQUARE "
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("MAGIC SQUARE ")/2
across=320-tw:down=50:wide=across+0
wide=wide+text width("MAGIC SQUARE ")
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
return
To have Magic Square create a square to your choice of size and starting number, simply go to this part of the programme and change size#=rnd(8)+1 and startnumber=rnd(18)+1.
` ==========================================
` Determine square size and starting number
` ==========================================
` Determine the square size. This must be an odd size so,
` if an even size is selected, try again. Also try again
` if a size less than three is selected
anothersize:
size#=rnd(8)+1
if size#/2=int(size#/2) then gosub anothersize
if size#<3 then gosub anothersize
` Determine the starting number
startnumber=rnd(18)+1
s=startnumber
Highlight the code, right click, copy and paste into DBClassic
Enjoy
gearce
LANG MAY YER LUM REEK