Hope I am posting this on the correct board.
This is my first completely working programme in PB.
The programme produces what is commonly known as a Magic Square, in which the sum of the numbers running horizontally, vertically and diagonally is always the same. Each time it is run, Magic Square will create one of these squares from size 3x3 to 9x9 with a starting number from 1 to 19. Numbers less than 10 are preceeded by a zero to enhance the screen appearance.
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.
[pbcode]
remstart
=======================================================
MAGIC SQUARE
***********************
Author: geecee
Originally written for Dark Basic - January 2007
Re-written for Play Basic - March 2009
***********************
=======================================================
remend
` Determine screen width
screenwide=getscreenwidth()/2
` Declare array/s
dim m(25,25)
` This command will hide the mouse pointer
mouse off
` Go to subroutine to write title
gosub title
` Set text style and size
loadfont "arial bold",1,20,0
` Set frames per second
setfps 12
` A short wait before proceeding
sync
wait 500
` Define the message string (a space is needed at the end of each line
` to write the last word)
message$=""
message$=message$+"This programme produces what is commonly known as a Magic "
message$=message$+"Square, in which the sum of the numbers running horizontally, "
message$=message$+"vertically and diagonally is always the same. "
message$=message$+"||Each time it is run, Magic Square will create one "
message$=message$+"of these squares from size 3x3 to 9x9 with a starting "
message$=message$+"number from 1 to 19. ||Numbers less than 10 are preceeded by a "
message$=message$+"zero to enhance the appearance of the output. ||Left click or "
message$=message$+"right click mouse to start. "
` Determine text width of longest message line and where to write text to screen.
tw=gettextwidth("This programme produces what is commonly known as a Magic ")/2
across=screenwide-tw:down=200:wide=across+0
wide=wide+gettextwidth("This programme produces what is commonly known as a Magic ")
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
` Until mouse is clicked
do
` If mouse is clicked
mb=mousebutton()
sync
wait 10
if mb=1 or mb=2
sync
gosub start
endif
loop
` Start of programme
start:
` Set ink colour and draw a box to hide previous text at location
ink rgb(0,0,0)
box 10,120,790,590,1
` Declare title of project
title$="MAGIC SQUARE"
` Determine height of text
height=gettextheight(title$)
` Set frames per second
setfps 50
` Until the Magic Square has been determined
Do
` Set ink colour and draw a box to hide previous text at location
ink rgb(0,0,0)
box 10,120,790,590,1
` Set new ink colour
ink rgb(255,217,128)
` 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
n=size#
`Declare array/s
dim m(25,25):dim line$(n)
` Determine the starting number
startnumber=rnd(18)+1
y=startnumber
s=y
` A short wait before proceeding
sync
wait 1000
` Set across and down coordinates and write size of square and starting
` number to screen
across=400:down=120
centertext across,down,str$(n)+" by "+str$(n)+" Starting with the number "+str$(s)
print ""
` Declare variables
k=1: h=1: j=(n+1)/2
While s <= n^2+y-1
m(h,j)=s: s=s+1
if s>n^2+y-1
gosub Display
Else
if k<n
h=h-1: j=j+1: k=k+1
if h<>0
If j>n Then j=1
Else
h=n
Endif
Else
k=1: h=h+1
Endif
Endif
EndWhile
Loop
` --------------------------------------------------
` Subroutine to display Magic Square. Numbers less
` than 10 are preceeded by a zero to enhance the
` appearance of the output
` --------------------------------------------------
Display:
for i=1 to n
for j=1 to n
t$=str$(m(i,j))+" "
if val(str$(m(i,j)))<10
t$="0"+str$(m(i,j))+" "
line$(i)=line$(i)+t$
else
line$(i)=line$(i)+t$
endif
next j
if n=3
across=400
for here=1 to n
across=400
down=320-height*(here*1)
centertext across,down,line$(here)
next here
endif
if n=5
across=400
for here=1 to n
across=400
down=346-height*(here*1)
centertext across,down,line$(here)
next here
endif
if n=7
across=400
for here=1 to n
across=400
down=372-height*(here*1)
centertext across,down,line$(here)
next here
endif
if n=9
across=400
for here=1 to n
across=400
down=398-height*(here*1)
centertext across,down,line$(here)
next here
endif
next i
` Write text to centre of screen
centertext 400,500,"The constant is "+str$((n^3+n)/2+n*(y-1))
centertext 400,500+height*2, "Press any key to re-run"
` Wait for a keypress
sync
waitkey
Return
` --------------------------------------------------
` 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,1)
` Declare a variable to represent the letters in the message
ThisChr$=mid$(message$,t,1)
` Check if that letter is a space, a | or a *
if ThisChr$=" " or ThisChr$="|" or ThisCHR$="*"
` 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+gettextwidth(nextword$)>wide
across=400-tw
down=down+gettextheight(nextword$)
endif
` If the letter is a |, this indicates start of a new line
` of text
if ThisChr$="|"
across=400-tw-gettextwidth(mid$(message$,t,1))
down=down+gettextheight(nextword$)
endif
` Create a write text switch and turn it off to avoid writing
` this | or this *
if ThisChr$="|" or ThisCHR$="*"
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
across=across+gettextwidth(nextword$)
` Clear the current word to make a new word next loop
nextword$=""
` A short wait before proceeding so you can see it working
sync
endif
next t
endfunction
` --------------------------------------------------
` Subroutine to write title
` --------------------------------------------------
title:
` Set text style and size and ink colour
loadfont "arial black",1,30,0
ink rgb(255,217,128)
` 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=gettextwidth("MAGIC SQUARE ")/2
across=400-tw:down=50:wide=across+0
wide=wide+gettextwidth("MAGIC SQUARE ")
` Call the function to write words to screen
writewords(across,down,message$,tw,wide)
return
[/pbcode]
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()+1 and startnumber=rnd(18)+1 to whatever you desire. Sorry about the size#=rnd()+1, but if I put the figure 8 inside the parenthesis it prints a smiley.
[pbcode]
` 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
n=size#
` Determine the starting number
startnumber=rnd(18)+1
y=startnumber
s=y
[/pbcode]
Hope you enjoy.
geecee
Some of my other contributions
Lingo (http://www.underwaredesign.com/forums/index.php?topic=3017.0)
Yeah, looks pretty good. Probably should be in the Source Code (http://www.underwaredesign.com/forums/index.php?board=12.0) board though.
One tip is that there's a bit of redundant function calling some of the loops. So rather than polling mid$(message$,t,1) for example, you could just grab the character into a String variable if you really need it to be string.. A lot more efficient.
ie.
ThisChr$=mid$(message$,t,1)
if ThisChr$=" " or ThisChr$="|" or ThisCHR$="*"
etc
Thanks for the tip kevin.
Looks neater too ...... I have amended the function.
Please feel free to move to the Source Code board ...... I should have paid more attention.
Much appreciated.
geecee