Hi there!
This is my Magic Square programme re-written.
Why am I posting again instead of editing my previous thread posted: 2nd Feb 2007 19:51? Quite simple. Edits don’t show up on the respective menu and if they don't appear, then the threads are unlikely to be revisited, thereby rendering the chance of comments less likely.
Maybe something for the powers that be to have a look at methinks.
This programme produces 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 square from exceeding two digits.
remstart
=======================================================
MAGIC SQUARE
***********************
Author: gearce - January 2007
Re-written - October 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
` Increment down coordinate
inc down,(th*2)
` Set new text size and write text to screen
set text size 16
th=text height("arial")
center text 320,down,"By gearce : re-written October 2007"
` A short wait before proceeding
wait 1000
` Define the message string (a space is needed at the end of each line
` to write the last word)
partone$=""
partone$=partone$+"This programme produces what is commonly known as a Magic "
partone$=partone$+"Square, *in which the sum of the numbers running horizontally, "
partone$=partone$+"vertically and diagonally is always the same. "
` Message is limited to 255 characters in length
` hence the need to split it - Part one
message$=partone$
` Determine text width of longest message line
` and where to write text to screen.
tw=text width("This programme produces what is commonly known as a Magic ")/2
across=320-tw:down=200:wide=across+0
wide=wide+text width("This programme produces what is commonly known as a Magic ")
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
` Define the message string (a space is needed at the end of each line
` to write the last word)
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 from 1 to 19. ||*Left click or right click mouse to start. "
` Continuing message - Part two
message$=parttwo$
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
` Until mouse is clicked
do
` If mouse is clicked
if mouseclick()=1 or mouseclick()=2
gosub start
endif
loop
` Start of programme
start:
` Clear screen
cls
` Go to subroutine to write title
gosub title
` A short wait before proceeding
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
repeat
repeat
size#=rnd(8)+1
until size#/2<>int(size#/2)
until size#>2
` 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 wait before proceeding
wait 1000
` Write starting number to screen
center text 320,130,"starting with number "+str$(s)
` A short wait before proceeding
wait 1000
` Initialise counters
k=1
h=1
j=(size#+1)/2
` ==========================================
` Subroutine to create the Magic Square
` ==========================================
creatasquare:
m(h,j)=s
s=s+1
if s>size#^2+startnumber-1
` 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
` A short wait before proceeding
wait 1000
` ==========================================
` 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 wait before proceeding
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 wait before proceeding
wait 1000
` Clear screen
cls
` A short wait before proceeding
wait 1000
gosub endit
endif
` End loop
loop
` End programme
endit:
end
endif
if k<size#
h=h-1
j=j+1
k=k+1
if h<>0
if j<=size# then gosub creatasquare
j=1
gosub creatasquare
endif
h=size#
gosub creatasquare
endif
k=1
h=h+1
gosub creatasquare
` --------------------------------------------------
` 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 wait 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 wait before proceeding so you can see it working
wait 200
endif
next t
endfunction
` --------------------------------------------------
` Subroutine to write title
` --------------------------------------------------
title:
` Set text style and size and ink colour
set text font "arial"
set text size 30
set text to bold
th=text height("arial")
ink rgb(255,217,128),0
` Define the string (a space is needed at the end of each line
` to write 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
****** EDIT ******
See demons breath post below
gearce
(GRC)
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.
