'MAGIC12.BAS H.Heinz April 1997 ' July 3 /94 Magic12.bas ' after completing LoubereM sub-program & ClearText S.R. ' June 17 / 94 Magic11.bas ' use screen 12 for everything except sqrInput which uses screen 0 ' April 20, 1994 Magic10.bas ' Start modifying MAGIC9C.BAS for screen 12 & magic lines routine ' This is modified version of MAGIC8.BAS as it was on Mar.9/94 ' --- Following REM's apply to MAGIC8.BAS ' --- This is modified version of MAGICSQR.BAS 3/11/93 11:35 ' --- This is MATTEST2.BAS renamed & with subprograms modified somewhat ' --- modified Mar6/93 to allow testing m.s. with non-consequetive numbers. ' --- demo Magic Square program showing use of general order sub-routines. ' --- this is a fully functional program for testing magic squares of ' order 2 to 9. The sub-routines adjust accordingly. ' --- matrixA() is used in subroutines to hold EITHER origSqr() OR rotateSqr(). DEFINT A-Z CONST false = 0, true = NOT false COMMON SHARED size, sum, sumCorrect, endroutine, origSqr(), rotateSqr(), nograph DECLARE SUB AssocSum (matrixA()) ' test associated pairs DECLARE SUB ClearText () ' clear some text for large m.s. DECLARE SUB DiagSum (matrixA(), mainSum) ' test diagonals DECLARE SUB DisplayMenuBox (choiceList$(), leftCoord, Prompt$, ok$) ' display main menu DECLARE SUB displaySqr (pairnum()) ' control printing sqr DECLARE SUB frame (left, right, top, bottom) ' draw a frame DECLARE SUB lineImput () ' input a new square DECLARE SUB Loubere () ' Loubere method DECLARE SUB LoubereM () ' Modified Loubere method DECLARE SUB magicLines () ' called by showSqr DECLARE SUB MatRotate () ' rotate the original DECLARE SUB menu2 (storedSqr()) ' select a stored m. s. DECLARE SUB menu3 () ' demo's of construction DECLARE SUB OrthoSum (matrixA()) ' test rows, columns DECLARE SUB pan5x5 (matrixA(), pTbl(), pairnum()) 'generate all 5x5 basic pand DECLARE SUB Pause () ' pauses for a keypress DECLARE SUB SemiPanSum (matrixA()) ' test oppos. short diag DECLARE SUB showSqr () ' print the square & grid DECLARE SUB sqrInput () ' edit the square in memory DECLARE SUB titleOne () ' prints the main title DECLARE FUNCTION Getletter$ (Prompt$, legal$) ' get a letter DECLARE FUNCTION menu (choices$()) ' main menu DIM pairnum(3 TO 9) ' holds # of pairs for each order DIM storedSqrs(1084) ' all squares are stored linearly, 1 after the other DIM origSqr(9, 9) ' this array holds the original version DIM rotateSqr(9, 9) ' this is a copy rotated 90 degrees DIM matrixA(size, size) ' this matrix holds the m.s. in the sub-rout. DIM menuOptions$(6) ' list of choices for the main menu DIM pTbl(1 TO 36, 1 TO 9) ' table 7 from book p. 1137 SCREEN 12 ' run program on graphic screen with 80 x 30 text nograph = 0 ' permit graphs unless this is 1 (sqrInput) ' --- # of correct associated pairs for each order (for Associated magic square). DATA 4,8,12,18,24,32,40 FOR i = 3 TO 9 ' load into pairnum array READ pairnum(i) NEXT i ' --- sample magic squares, ALL are 'normal' except last order 6 (l) because NO normal ' singly-even order associated magic squares. ' --- order 4 squares DATA 7,6,12,9,15,14,4,1,2,11,5,16,10,3,13,8 DATA 2,8,15,9,11,13,6,4,14,12,3,5,7,1,10,16 DATA 2,11,7,14,13,8,12,1,16,5,9,4,3,10,6,15 DATA 1,15,6,12,14,4,9,7,11,5,16,2,8,10,3,13 ' --- order 5 squares DATA 23,6,19,2,15,10,18,1,14,22,17,5,13,21,9,4,12,25,8,16,11,24,7,20,3 DATA 14,10,1,22,18,20,11,7,3,24,21,17,13,9,5,2,23,19,15,6,8,4,25,16,12 DATA 23,1,2,20,19,22,16,9,14,4,5,11,13,15,21,8,12,17,10,18,7,25,24,6,3 DATA 1,15,24,8,17,23,7,16,5,14,20,4,13,22,6,12,21,10,19,3,9,18,2,11,25 ' --- order 6 magic squares DATA 1,35,34,3,32,6,30,8,28,27,11,7,24,23,15,16,14,19,13,17,21,22,20,18,12,26,9,10,29,25,31,2,4,33,5,36 DATA 17,8,33,24,2,27,32,22,11,25,16,5,3,30,14,9,36,19,18,1,28,23,7,34,31,21,12,26,15,6,10,29,13,4,35,20 DATA 32,31,1,3,21,23,29,30,4,2,24,22,9,11,20,19,25,27,12,10,17,18,28,26,16,15,33,35,5,7,13,14,36,34,8,6 DATA 1,47,6,43,5,48,35,17,30,21,31,16,36,12,41,8,40,13,7,45,2,49,3,44,29,19,34,15,33,20,42,10,37,14,38,9 ' --- order 7 magic squares DATA 46,1,2,3,42,41,40,45,35,13,14,32,31,5,44,34,28,21,26,16,6,7,17,23,25,27,33,43,11,20,24,29,22,30,39,12,19,37,36,18,15,38,10,49,48,47,8,9,4 DATA 26,20,14,1,44,38,32,34,28,15,9,3,46,40,42,29,23,17,11,5,48,43,37,31,25,19,13,7,2,45,39,33,27,21,8,10,4,47,41,35,22,16,18,12,6,49,36,30,24 DATA 42,18,29,9,45,26,6,20,35,11,43,23,3,40,4,36,16,31,12,48,28,33,13,49,25,1,37,17,22,2,38,19,34,14,46,10,47,27,7,39,15,30,44,24,5,41,21,32,8 DATA 1,8,17,26,35,40,48,30,41,46,4,10,16,28,12,21,23,31,39,43,6,36,45,5,14,19,24,32,20,25,29,38,47,7,9,49,2,13,18,22,34,37,27,33,42,44,3,11,15 ' --- order 8 magic squares DATA 1,63,62,4,5,59,58,8,56,15,49,48,19,44,20,9,55,47,25,39,38,28,18,10,11,22,36,30,31,33,43,54,53,42,32,34,35,29,23,12,13,24,37,27,26,40,41,52,14,45,16,17,46,21,50,51,57,2,3,61,60,6,7,64 DATA 1,57,40,32,5,44,29,52,48,24,9,49,61,20,37,12,25,33,64,8,36,13,60,21,56,16,17,41,28,53,4,45,50,47,2,31,43,19,38,30,7,26,55,42,54,14,59,3,63,34,15,18,27,35,22,46,10,23,58,39,6,62,11,51 DATA 1,2,62,61,60,59,7,8,9,10,54,53,52,51,15,16,48,47,19,20,21,22,42,41,40,39,27,28,29,30,34,33,32,31,35,36,37,38,26,25,24,23,43,44,45,46,18,17,49,50,14,13,12,11,55,56,57,58,6,5,4,3,63,64 DATA 7,42,55,26,31,50,47,2,62,19,14,35,38,11,22,59,1,48,49,32,25,56,41,8,60,21,12,37,36,13,20,61,4,45,52,29,28,53,44,5,57,24,9,40,33,16,17,64,6,43,54,27,30,51,46,3,63,18,15,34,39,10,23,58 ' --- order 9 magic squares DATA 77,1,2,3,4,72,71,70,69,76,62,17,18,19,58,57,56,6,75,61,51,29,30,48,47,21,7,74,60,50,44,37,42,32,22,8,9,23,33,39,41,43,49,59,73,14,27,36,40,45,38,46,55,68,15,28,35,53,52,34,31,54,67,16,26,65,64,63,24,25,20,66,13,81,80,79,78,10,11,12,5 DATA 42,34,26,18,1,74,66,58,50,52,44,36,19,11,3,76,68,60,62,54,37,29,21,13,5,78,70,72,55,47,39,31,23,15,7,80,73,65,57,49,41,33,25,17,9,2,75,67,59,51,43,35,27,10,12,4,77,69,61,53,45,28,20,22,14,6,79,71,63,46,38,30,32,24,16,8,81,64,56,48,40 DATA 71,64,69,8,1,6,53,46,51,66,68,70,3,5,7,48,50,52,67,72,65,4,9,2,49,54,47,26,19,24,44,37,42,62,55,60,21,23,25,39,41,43,57,59,61,22,27,20,40,45,38,58,63,56,35,28,33,80,73,78,17,10,15,30,32,34,75,77,79,12,14,16,31,36,29,76,81,74,13,18,11 DATA 75,53,11,25,14,65,48,42,36,10,26,74,54,49,43,32,15,66,71,57,7,29,33,16,67,50,39,8,28,72,56,68,46,40,34,17,52,69,13,30,41,35,18,64,47,12,27,38,51,77,80,20,3,61,37,59,76,9,24,4,60,81,19,73,6,23,45,58,79,21,2,62,31,44,55,70,5,1,63,78,22 ' --- All the magic squares are stored in 1 long string. The starting position for each m.s. is: ' order 4; 1, 17, 33, 49 order 5; 65, 90, 115,140 ' order 6; 165,201,237,273 order 7; 309,358,407,456 ' order 8; 505,569,633,697 order 9; 761,842,923,1004 FOR i = 1 TO 1084 ' load into storedSqrs array READ storedSqrs(i) NEXT i ' --- data for pTbl used in Pan5x5 routine - this is table 7 in the book DATA 1,1,1,10,15,20,3,4,5,2,3,1,10,15,20,3,5,4,3,5,1,10,20,15,3,4,5 DATA 4,7,1,10,20,15,3,5,4,5,9,1,10,15,20,4,3,5,6,11,1,10,15,20,4,5,3 DATA 7,13,1,10,20,15,4,3,5,8,15,1,10,20,15,4,5,3,9,17,1,10,15,20,5,3,4 DATA 10,19,1,10,15,20,5,4,3,11,21,1,10,20,15,5,3,4,12,23,1,10,20,15,5,4,3 DATA 13,25,2,15,10,20,3,4,5,14,27,2,15,10,20,3,5,4,15,29,1,15,20,10,3,4,5 DATA 16,31,1,15,20,10,3,5,4,17,33,2,15,10,20,4,3,5,18,35,2,15,10,20,4,5,3 DATA 19,37,1,15,20,10,4,3,5,20,39,1,15,20,10,4,5,3,21,41,2,15,10,20,5,3,4 DATA 22,43,2,15,10,20,5,4,3,23,45,1,15,20,10,5,3,4,24,47,1,15,20,10,5,4,3 DATA 25,49,2,20,10,15,3,4,5,26,51,2,20,10,15,3,5,4,27,53,2,20,15,10,3,4,5 DATA 28,55,2,20,15,10,3,5,4,29,57,2,20,10,15,4,3,5,30,59,2,20,10,15,4,5,3 DATA 31,61,2,20,15,10,4,3,5,32,63,2,20,15,10,4,5,3,33,65,2,20,10,15,5,3,4 DATA 34,67,2,20,10,15,5,4,3,35,69,2,20,15,10,5,3,4,36,71,2,20,15,10,5,4,3 FOR snum = 1 TO 36 ' load into pTbl array FOR j = 1 TO 9 READ pTbl(snum, j) NEXT j NEXT snum ' --- Main menu options DATA show a stored square DATA input a new square DATA edit the square in memory DATA display 5x5 pandiagonals DATA view construction methods DATA quit the program FOR i = 1 TO 6 ' load into menuOptions array READ menuOptions$(i) NEXT i CLS ' --- Display the menu & react to the user's choices DO titleOne ' print the main title PRINT "This is a demo program only. Still being added to and modified. h.h. 12-1-93" SELECT CASE menu(menuOptions$()) CASE 1 ' select a stored magic square menu2 storedSqrs() CASE 2 ' input a new magic square lineImput CASE 3 SCREEN 0 CLS : nograph = 1 ' flag to prevent graph showSqr ' put the square on screen sqrInput ' edit the square on screen SCREEN 12 nograph = 0 ' reset for graphs CASE 4 ' generate ALL essentially different sum = 0 pan5x5 matrixA(), pTbl(), pairnum() ' order 5 pandiagonal m.s. (36) CASE 5 ' show methods of construction menu3 CASE 6 done = true ' set flag to exit program CASE ELSE ' --- not necessary to do anything END SELECT IF NOT done THEN ' show the selected magic square IF size > 0 THEN ' if no m.s. in memory displaySqr pairnum() ' don't try to display one Pause ' continue when ready END IF CLS END IF LOOP UNTIL done SCREEN 0 ' reset for standard text screen before exit END keyevent: ' ---- exit sub-program if Function key two is pressed endroutine = true RETURN PrinterError: ' --- Traps printer errors and pauses for corrections LOCATE 23, 20 PRINT "*** Printer not in Operation ***" Pause LOCATE 23, 20 PRINT " " RESUME NEXT SUB AssocSum (matrixA()) ' This sub routine tests for pairs of cells that are diametrically equidistant ' from the center summing to the total of the first and last numbers in the series. ' It test the corresponding pairs in the top left & lower right quadrants. ' On the second call it tests these same quadrants, but in the rotated matrix. ' This routine works on odd or doubly-even order NORMAL magic squares. ' Singly-even order m.s. are also tested although NO assoc.m.s. of this order. ' It is called by the displaySqr sub-routine. sumCorrect = 0 pairsSum = size * size + 1 ' i.e. N^2+1 (only for NORMAL m.s.) halfSize = size \ 2 ' integer division IF size MOD 2 = 1 THEN oddOrder = true ' order is odd center = halfSize + 1 IF matrixA(center, center) = ((size * size) + 1) / 2 THEN CouldBeAssoc = true ELSE ' assoc. odd order m.s. must CouldBeAssoc = false ' have center cell equal to END IF ' (N^2 + 1)/2 ELSE oddOrder = false ' order is even CouldBeAssoc = true ' so it could be associated END IF cn = 1: cx = size IF CouldBeAssoc THEN ' run test only if possibility ' of being associated DO rn = 1: rx = size DO ' cycle through pairs of cells in testSum = 0 ' upper left & lower right testSum = matrixA(rn, cn) + matrixA(rx, cx) IF testSum = pairsSum THEN sumCorrect = sumCorrect + 1 ' count correct pairs END IF rn = rn + 1: rx = rx - 1 LOOP UNTIL rn > halfSize ' by rows, then columns cn = cn + 1: cx = cx - 1 LOOP UNTIL cn > halfSize IF oddOrder THEN ' odd order m.s. require you cn = halfSize + 1 ' now do center column rn = 1: rx = size DO ' check pairs in center column testSum = 0 testSum = matrixA(rn, cn) + matrixA(rx, cn) IF testSum = pairsSum THEN sumCorrect = sumCorrect + 1 ' second call, in effect END IF ' does center row rn = rn + 1: rx = rx - 1 LOOP UNTIL rn > halfSize END IF END IF END SUB SUB ClearText ' This sub-rooutine is used to clear several lines of text in the ' LoubereM sub-program LOCATE 4, 1 ' erase text FOR i = 1 TO 6 PRINT STRING$(80, 32) NEXT i END SUB SUB DiagSum (matrixA(), mainSum) ' Sub routine DiagSum calculates & checks the sums of all the diagonals ' including broken diagonal pairs. It returns a count of the # correct. ' Call twice, once checks original, 2nd time checks rotated square to get ' diagonals in the other direction. ' MatrixA() holds origSqr() on first pass, rotateSqr() on second pass. ' It is called by the displaySqr sub-routine. sumCorrect = 0 ' reset count of correct sums mainSum = 0 ' reset main diagonal flag ' --- test diagonals from upper left to lower right, starting with main diagonal FOR k = 1 TO size ' k counts the # of diagonals testSum = 0 ' initialize for new diagonal i = k: j = 0 DO j = j + 1 testSum = testSum + matrixA(i, j) IF i = size THEN ' move to 2nd half of broken diagonal i = 1 ELSE i = i + 1 END IF LOOP WHILE j < size ' is diagonal finished IF k = 1 AND j = size AND testSum = sum THEN mainSum = 1 'main diagonal IF testSum = sum THEN sumCorrect = sumCorrect + 1 ' add to count if correct sum END IF NEXT k ' test next diagonal pair END SUB SUB DisplayMenuBox (choiceList$(), leftCoord, Prompt$, ok$) ' The DisplayMenuBox subprogram displays the menu choices on the screen and ' prepares the prompt string and validation string. This routine is called ' from the Menu function. ' --- Find the number of choices (numChoices) and initialize variables. numChoices = UBOUND(choiceList$) Prompt$ = " " ok$ = "" longChoice = 0 ' --- Prepare the prompt string (prompt$) and the string of legal input ' characters (ok$). Also, find the length of the longest choice string. FOR i = 1 TO numChoices first$ = UCASE$(LEFT$(choiceList$(i), 1)) ok$ = ok$ + first$ Prompt$ = Prompt$ + first$ + " " longTemp = LEN(choiceList$(i)) IF longTemp > longChoice THEN longChoice = longTemp NEXT i longChoice = longChoice + 1 Prompt$ = Prompt$ + "-> " ' --- Test to see if the prompt string is longer then promptChoice IF LEN(Prompt$) >= longChoice THEN longChoice = LEN(Prompt$) + 1 ' --- Given longChoice and numChoice, determine the demensions of the ' menu frame. Draw the frame, calling on the frame subprogram. leftCoord = 37 - longChoice \ 2 rightCoord = 80 - leftCoord topCoord = 5 bottomCoord = 10 + numChoices frame leftCoord, rightCoord, topCoord, bottomCoord ' --- Display the menu choices. The first letter of each choice is ' displayed in uppercase, followed by a parenthesis character. FOR i = 1 TO numChoices LOCATE 7 + i, leftCoord + 3 PRINT UCASE$(LEFT$(choiceList$(i), 1)) + ")" + MID$(choiceList$(i), 2) NEXT i LOCATE 6, 38: PRINT "Menu" line$ = STRING$(longChoice, 196) LOCATE 7, leftCoord + 3: PRINT line$ LOCATE 8 + numChoices, leftCoord + 3: PRINT line$ ' --- Print the input prompt. LOCATE 9 + numChoices, leftCoord + 3: PRINT Prompt$; END SUB SUB displaySqr (pairnum()) ' --- This subroutine handles the display of the square and summary. ' It also calls the routines that tests the various aspects of m.s. ' It is called from the main program & pan5X5 sub-routine. CLS titleOne ' print the main title ' --- sum is calculated for a normal m.s. (i.e. 1st N^2 natural numbers)(if it is now 0) IF sum = 0 THEN sum = (size * size * size + size) / 2 ' this test allows for impure m.s. halfSize = size \ 2 ' this is integer division top = 13 - size: bottom = top + size * 2 + 1 ' position on the screen showSqr ' routine to print square & grid MatRotate ' rotate 90 degrees right ' --- test sums of rows (& later columns) & count correct ones sumFlag = 0: sumFlag2 = 0 ' keep track of rows, col., & main diag OrthoSum origSqr() ' test rows rowTotal = sumCorrect ' # of rows correct IF rowTotal = size THEN sumFlag = 1 ' i.e. all rows are correct OrthoSum rotateSqr() ' test columns (of original m.s.) colTotal = sumCorrect ' # of columns correct IF colTotal = size THEN sumFlag = sumFlag + 1 ' i.e. all columns correct ' --- Test that main diagonals are correct. Also test all broken diagonals. DiagSum origSqr(), mainSum ' test original diagonals diagTotal = sumCorrect sumFlag = sumFlag + mainSum ' add 1 if main diagonal OK DiagSum rotateSqr(), mainSum ' test rotated diagonals diagTotal = diagTotal + sumCorrect ' # of main & broken diagonals cor. sumFlag = sumFlag + mainSum ' add 1 if main diagonal OK IF diagTotal = 2 * size THEN diagFlag = true ' this is a pandiagonal m.s. END IF ' ---Count the number of complementary pairs for possible Associated m.s. AssocSum origSqr() ' test for associated assocTotal = sumCorrect ' # of pairs correct AssocSum rotateSqr() ' test other 2 quadrants assocTotal = assocTotal + sumCorrect ' total # of pairs correct 'Count opposite short diagonal pairs with the correct sum. semipanTotal = 0 IF NOT diagFlag AND size > 3 THEN ' if not pandiagonal, semiPan ? SemiPanSum origSqr() ' check for semi-pan semipanTotal = sumCorrect ' is opposite short diagonal cor. SemiPanSum rotateSqr() ' check for semi-pan semipanTotal = semipanTotal + sumCorrect ' total # correct (need 2) END IF ' --- Check values from above tests and advise specifications of magic square. LOCATE 25, 1 'locate at bottom of screen PRINT "Total rows correct: "; rowTotal, "Total columns correct: "; colTotal PRINT "Total diagonals correct: "; diagTotal, IF diagFlag THEN ' advise if this is a pandiagonal PRINT "This is a Pandiagonal M.S.", sumFlag2 = sumFlag + 1 ' add 1 to show it's not simple END IF IF semipanTotal = 2 THEN ' advise if semi-pandiagonal PRINT "This is a Semi-Pandiagonal M. S.", sumFlag2 = sumFlag + 1 ' add 1 to show it's not simple END IF IF assocTotal > 0 THEN ' show # of correct pairs PRINT "Pairs of 2 assoc. cells correct:"; assocTotal, END IF IF assocTotal = pairnum(size) THEN ' correct # of pairs? PRINT "This is an Associated M. Sqr.", ' # of pairs is correct for size sumFlag2 = sumFlag + 1 ' add 1 to show it's not simple END IF ' --- some squares may NOT have correct rows, or columns & still have correct diagonals ' or associated pairs. i.e. 16,2,14,4,5,11,7,9,8,10,6,12,13,3,15,1 has NO correct ' rows or columns yet otherwise it would be an associated pandiagonal m.s. IF sumFlag = 4 AND sumFlag2 = 0 THEN ' ALL rows, col. & 2 main diag. O.K.? PRINT "This is a simple magic square.", ELSEIF sumFlag = 3 THEN ' only 1 main diagonal O.K. PRINT "This square is only semi-magic !!", ELSEIF sumFlag < 3 THEN ' not all rows or col. correct PRINT "This square is NOT magic !!!", ' or not both diagonals END IF IF sumFlag > 3 THEN PRINT "The Magic Sum is "; sum; ' magic!! so constant is ... END SUB SUB frame (left, right, top, bottom) STATIC ' The Frame subprogram draws a rectangular double-line frame on ' the screen, using "text-graphics" characters from the ' IBM Extended ASCII character set. (change chr$ for single lines) ' --- Draw the four corners. ' use chr$ 218, 191, 192, 217 for corners of single line. ' use chr$ 201, 187, 200, 188 for corners of double line. LOCATE top, left: PRINT CHR$(201) LOCATE top, right: PRINT CHR$(187) LOCATE bottom, left: PRINT CHR$(200) LOCATE bottom, right: PRINT CHR$(188) ' --- Draw the vertical lines ' use chr$ 179 for single line. ' use chr$ 186 for double line. FOR vert = top + 1 TO bottom - 1 LOCATE vert, left: PRINT CHR$(186); LOCATE vert, right: PRINT CHR$(186); NEXT vert ' --- Draw the horizontal lines. ' use chr$ 196 for single line. ' use chr$ 205 for double line. horiz = right - left - 1 hline$ = STRING$(horiz, 205) LOCATE top, left + 1: PRINT hline$ LOCATE bottom, left + 1: PRINT hline$; END SUB DEFSNG A-Z FUNCTION Getletter$ (Prompt$, legal$) ' The getLetter function elicits a single letter response that must ' correspond to a letter that is included in the parameter Legal. ' These letters (in Legal) should be upper case. ' This function is called from the lineInput, Menu2, & pan5X5 sub-routines. PRINT Prompt$; " -> "; ' --- Get the response. A beep indicates an invalid response. DO ans$ = UCASE$(INKEY$) ansPos = INSTR(legal$, ans$) IF ansPos = 0 THEN BEEP LOOP UNTIL ans$ <> "" AND ansPos <> 0 PRINT ans$ Getletter$ = ans$ END FUNCTION DEFINT A-Z SUB lineImput ' --- this subprogram handles the input of a new magic square by asking for the numbers ' 1 at a time. If you make an error (like getting out of step), it can be edited ' later (from the main menu). ' This routine is called from the main program. CLS titleOne ' print the main title PRINT PRINT "This program demonstrates the use of generalized subroutines that perform" PRINT "the required function for any order Magic Square. These routines may be" PRINT "used in any Quickbasic program by 'merging'. " PRINT "This program is a practical program for testing order 3 to 9 magic squares." PRINT "Screen space (only) limits this demo to a maximum of order 9 magic squares." PRINT size$ = Getletter$("Enter length of line (order of square) 3-9 ", "3,4,5,6,7,8,9") size = VAL(size$) ' size = order of m.s. PRINT : PRINT "Enter the integers for the square, 1 at a time. If an error is made, " PRINT "it may be corrected later by using 'edit' from the main menu." PRINT "The constant will be determined by the sum of the cells in the first row." endroutine = false ' be sure flag is clear FOR r = 1 TO size firstrowSum = 0 FOR c = 1 TO size LOCATE 20, 5: PRINT "Number for row "; r; "col "; c; "is "; : INPUT n firstrowSum = firstrowSum + n origSqr(r, c) = n LOCATE 20, 5: PRINT " " NEXT c IF r = 1 THEN sum = firstrowSum LOCATE 20, 5: PRINT "The magic constant is **"; sum; "** "; : proceed$ = Getletter$("Is this correct (Y/N) ?", "Y,N") IF proceed$ = "N" THEN EXIT SUB 'go back to main menu LOCATE 20, 5: PRINT " " END IF ON KEY(2) GOSUB keyevent KEY(2) ON LOCATE 30, 1 PRINT "F2, then spacebar to exit"; ' provision for exiting this routine Pause IF endroutine THEN CLS : EXIT SUB ' leave orderly LOCATE 30, 1: PRINT " "; NEXT r END SUB SUB Loubere sum = 0 ' set magic constant to 0 CLS PRINT "De La Loubere Method of Magic Square Generation" PRINT : PRINT "This is the most popular and widely known method of odd order m.s. generation" LOCATE 4, 1 choice$ = Getletter$("Enter the size of the desired magic Square (3,5,7,or 9 please)", "3,5,7,9") size = VAL(choice$) IF size = 9 THEN ClearText ' clear bottom line of text for large square FOR i = 1 TO size ' clear the magic square array FOR j = 1 TO size origSqr(i, j) = 0 k = k + 1 NEXT j NEXT i showSqr Pause r = 1: c = INT(size / 2) + 1: count = 1 origSqr(r, c) = count showSqr Pause count = 2 DO r = r - 1 IF r < 1 AND c = size THEN r = r + 2: c = c - 1 END IF IF r < 1 THEN r = size' c = c - 1 ' out of bounds c = c + 1 IF c > size THEN c = 1 ' out of bounds IF origSqr(r, c) > 0 THEN r = r + 2: c = c - 1 ' rest of diagonal filled origSqr(r, c) = count showSqr Pause count = count + 1 LOOP UNTIL count > size * size END SUB SUB LoubereM CLS PRINT "Modified De La Loubere Method of Magic Square Generation" PRINT "Does starting at a different cell produce a magic square?" sum = 0 ' set magic constant to 0 DO LOCATE 4, 1 choice$ = Getletter$("Enter the size of the desired magic Square (3,5,7,or 9 please)", "3,5,7,9") size = VAL(choice$) choice$ = Getletter$("Enter the row of the starting cell", "1,2,3,4,5,6,7,8,9") r = VAL(choice$) choice$ = Getletter$("Enter the column of the starting cell", "1,2,3,4,5,6,7,8,9") c = VAL(choice$) IF r = 1 AND c = (size + 1) / 2 THEN PRINT "Starting with this Cell uses the regular Loubere method" choice$ = Getletter$("Proceed anyway Y/N ?", "Y,N") IF choice$ = "Y" THEN ClearText LOCATE 3, 1: PRINT "This is the regular Loubere method" EXIT DO ELSE ClearText END IF ELSE ClearText EXIT DO ' this is not a regular Loubere so proceed END IF LOOP FOR i = 1 TO size ' clear the magic square array FOR j = 1 TO size origSqr(i, j) = 0 k = k + 1 NEXT j NEXT i showSqr ' empty at this point Pause count = 1 origSqr(r, c) = count showSqr ' first number only here Pause count = 2 DO r = r - 1 IF r < 1 THEN r = size ' out of bounds c = c + 1 IF c > size THEN c = 1 ' out of bounds IF origSqr(r, c) > 0 THEN r = r + 2: c = c - 1 ' rest of diagonal filled IF c < 1 THEN c = size IF r > size THEN r = r - size origSqr(r, c) = count showSqr ' show m.s. after each number is Pause ' added to it, and pause to view count = count + 1 LOOP UNTIL count > size * size END SUB SUB magicLines 'graph7.bas 4-19-94 Magic Lines ' --- draw a square based on size of array --- ' ---following lines maintains almost constant size regardless of order, and positions square ' so diagram is centered. 100 & 200 indicates position of top left corner (approximate) cell = INT(91 / size) ' variable is 22,18,15,13,11,10 lineSize = cell * size ' then draw the square LINE (2 + cell, 90 + cell)-(2 + cell + lineSize, 90 + cell + lineSize), , B LOCATE 14, 3: PRINT "Magic Lines" ' ---locate position of consecutive numbers in the array --- FOR i = 1 TO size * size 'step through consecutive numbers startover = o ' flag FOR r = 1 TO size 'step through position in string FOR c = 1 TO size IF origSqr(r, c) = i THEN ' find position of each number startover = 1 IF origSqr(r, c) = 1 THEN 'this is the start of the pattern starth = (2 + cell / 2) + cell * c startv = (90 + cell / 2) + cell * r oldh = starth: oldv = startv END IF IF origSqr(r, c) > 1 THEN newh = (2 + INT(cell / 2)) + cell * c newv = (90 + INT(cell / 2)) + cell * r LINE (newh, newv)-(oldh, oldv) oldh = newh: oldv = newv IF origSqr(r, c) = size * size THEN ' this is the end of the pattern LINE (starth, startv)-(newh, newv) 'close pattern END IF END IF END IF NEXT c IF startover = 1 THEN EXIT FOR NEXT r NEXT i ' --- start of routine to show associated pairs --- cornerh = 2 + cell: cornerv = 235 + cell ' constants for origin LINE (cornerh, cornerv)-(2 + cell + lineSize, 235 + cell + lineSize), , B' draw the square LOCATE 23, 3: PRINT "Assoc. Pairs" number = 1 ' 2nd half of m.s. range indicater abort = 0 ' flag for ginerating module DO WHILE number <= size * size / 2 FOR r = 1 TO size 'find location for start of line FOR c = 1 TO size IF origSqr(r, c) = 0 THEN abort = 1 ' needed while generating a m.s. 'STOP IF origSqr(r, c) = number THEN startliner = r: startlinec = c EXIT FOR END IF NEXT c NEXT r FOR r = 1 TO size 'find location for end of line FOR c = 1 TO size IF origSqr(r, c) = size * size + 1 - number THEN endliner = r: endlinec = c EXIT FOR END IF NEXT c NEXT r IF number > size THEN ' move line over 2 pixals starth = cornerh + cell * startlinec - cell / 2 + 2 ' so two don't overlap startv = cornerv + cell * startliner - cell / 2 + 2 endh = cornerh + cell * endlinec - cell / 2 + 2 endv = cornerv + cell * endliner - cell / 2 + 2 ELSE starth = cornerh + cell * startlinec - cell / 2 startv = cornerv + cell * startliner - cell / 2 endh = cornerh + cell * endlinec - cell / 2 endv = cornerv + cell * endliner - cell / 2 END IF IF abort = 0 THEN LINE (starth, startv)-(endh, endv) ' draw line if no value 0 number = number + 1 LOOP END SUB SUB MatRotate ' This subroutine copies A into B but rotated 90 degrees right. ' This cuts coding in half for OrthoSum, DiagSum, SemiPanSum, and AssocSum ' by calling these routines twice; once with origSqr() for 1 direction ' & once with rotateSqr() for the other direction. ' It is called from the displaySqr sub routine. r = 0 DO r = r + 1 FOR c = 1 TO size cc = size + 1 - r ' new col is old row rotateSqr(c, cc) = origSqr(r, c) ' new row is old column in reverse NEXT c LOOP WHILE r < size END SUB FUNCTION menu (choices$()) STATIC ' The Menu function displays a menu on the screen and elicits a menu ' choice from the user. Menu receives a string array (choices$) ' containing the manu choices and returns an integer indicating the ' users selection from among those choices. ' It is called from the main routine. listLength = UBOUND(choices$) DisplayMenuBox choices$(), leftMargin, promptStr$, okStr$ ' --- Get a menu choice. Validate and verify the choice. controlKeys$ = CHR$(13) + CHR$(27) DO LOCATE , , 1 charPos = 0 DO answer$ = UCASE$(INKEY$) IF answer$ <> "" THEN charPos = INSTR(okStr$, answer$) IF charPos = 0 THEN BEEP END IF LOOP UNTIL charPos > 0 PRINT answer$ LOCATE 11 + listLength, 23, 0 PRINT " to confirm; to redo." inChoice = charPos charPos = 0 DO answer$ = INKEY$ IF answer$ <> "" THEN charPos = INSTR(controlKeys$, answer$) IF charPos = 0 THEN BEEP END IF LOOP UNTIL charPos > 0 IF charPos = 1 THEN done = true CLS ELSE done = false LOCATE 11 + listLength, 23: PRINT SPACE$(35) LOCATE 9 + listLength, leftMargin + 3 + LEN(promptStr$), 1: PRINT " "; LOCATE , POS(0) - 1 END IF LOOP UNTIL done menu = inChoice END FUNCTION SUB menu2 (storedSqrs()) ' --- Selects the required stored magic cell. ' Return with selected m.s. in origSqr & the order size in size. ' It is called from the main routine. ' --- Clear the screen & display the menu. CLS LOCATE 2, 30: PRINT " Stored Magic Squares " PRINT TAB(11); "All are Normal - consequetive #'s starting with 1 (except l)" LOCATE 5, 10: PRINT "Order 4" LOCATE 6, 10: PRINT "a.- Simple magic Square b.- SemiPandiagonal m. Square" LOCATE 7, 10: PRINT "c.- SemiPandiagonal Associative d.- Pandiagonal magic square" LOCATE 8, 10: PRINT "Order 5" LOCATE 9, 10: PRINT "e.- SemiPandiagonal Associative f.- Lozenge-even #'s in corners" LOCATE 10, 10: PRINT "g.- Simple M. S. - bordered h.- Pandiagonal - Associated" LOCATE 11, 10: PRINT "Order 6" LOCATE 12, 10: PRINT "i.- Simple M. S. - bordered j.- SemiPandiagonal m. Square" LOCATE 13, 10: PRINT "k.- Simple M. S. - no 6x6 assoc l.- Pandiagonal (but not normal" LOCATE 14, 10: PRINT "Order 7" LOCATE 15, 10: PRINT "m.- Simple M. S. - bordered n.- SemiPan Assoc.- Lozenge" LOCATE 16, 10: PRINT "o.- SemiPandiagonal Associative p.- Pandiagonal magic square" LOCATE 17, 10: PRINT "Order 8" LOCATE 18, 10: PRINT "q.- Simple M. S. - bordered r.- SemiPandiagonal m. Square" LOCATE 19, 10: PRINT "s.- SemiPandiagonal Associative t.- Pandiagonal Associated m.s." LOCATE 20, 10: PRINT "Order 9" LOCATE 21, 10: PRINT "u.- Simple M. S. - bordered v.- SemiPan. Assoc. - lozenge" LOCATE 22, 10: PRINT "w.- SemiPan. Assoc. - Composite x.- Semipan - no Pandiagonal 9x9" frame 7, 75, 1, 23 ' draw the frame LOCATE 24, 25: choice$ = Getletter$("Enter the appropriate letter", "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z") choice$ = UCASE$(choice$) SELECT CASE choice$ CASE "A" k = 1: size = 4: sum = 34 ' k is starting position in storedSqrs array CASE "B" k = 17: size = 4: sum = 34 CASE "C" k = 33: size = 4: sum = 34 CASE "D" k = 49: size = 4: sum = 34 CASE "E" k = 65: size = 5: sum = 65 ' order 5 CASE "F" k = 90: size = 5: sum = 65 CASE "G" k = 115: size = 5: sum = 65 CASE "H" k = 140: size = 5: sum = 65 CASE "I" ' order 6 k = 165: size = 6: sum = 111 CASE "J" k = 201: size = 6: sum = 111 CASE "K" ' the 9 2x2 subsquares are each in numerical k = 237: size = 6: sum = 111 ' order & sums form a 3x3 m.s. CASE "L" k = 273: size = 6: sum = 150 ' not a normal m.s. (also 4 & 9 ply) CASE "M" ' order 7 k = 309: size = 7: sum = 175 CASE "N" k = 358: size = 7: sum = 175 CASE "O" k = 407: size = 7: sum = 175 CASE "P" k = 456: size = 7: sum = 175 CASE "Q" ' order 8 k = 505: size = 8: sum = 260 CASE "R" k = 569: size = 8: sum = 260 CASE "S" k = 633: size = 8: sum = 260 CASE "T" k = 697: size = 8: sum = 260 CASE "U" ' order 9 k = 761: size = 9: sum = 369 CASE "V" k = 842: size = 9: sum = 369 CASE "W" ' Composite - 9 3x3 squares are also k = 923: size = 9: sum = 369 ' magic & arranged as a 3x3 magic square CASE "X" ' Overlap - 2 4x4 upper left & lower right k = 1004: size = 9: sum = 369 ' 2 5x5 upper right & lower left. All Pandiag CASE ELSE ON ERROR GOTO 0 ' Oops, invalid key pressed END SELECT ' --- k = starting position of required m.s. .. size = order .. sum = constant ' --- All the magic squares are stored in 1 long string. ' The starting position for each m.s. is: ' order 4; 1, 17, 33, 49 order 5; 65, 90, 115,140 ' order 6; 165,201,237,273 order 7; 309,358,407,456 ' order 8; 505,569,633,697 order 9; 761,842,923,1004 FOR i = 1 TO size ' Enter the selected magic square into origSqr() FOR j = 1 TO size origSqr(i, j) = storedSqrs(k) k = k + 1 NEXT j NEXT i END SUB SUB menu3 CLS ' --- Selects the required method of generating a pure magic square. ' Return with generated m.s. in origSqr & the order size in size. ' It is called from the main routine. ' --- Clear the screen & display the menu. CLS LOCATE 2, 20: PRINT " Generate Magic Squares by Different Methods " PRINT TAB(12); "All are Normal - i.e. use consecutive #'s starting with 1 " LOCATE 5, 10: PRINT "Odd Order" LOCATE 6, 10: PRINT "a.-De La Loubere method b.- Modified De La Loubere" LOCATE 7, 10: PRINT "c.- d.- " LOCATE 8, 10: PRINT LOCATE 9, 10: PRINT "e.- f.- " LOCATE 10, 10: PRINT "g.- h.-" LOCATE 12, 10: PRINT "Even Order " LOCATE 13, 10: PRINT "i.- j.- " LOCATE 14, 10: PRINT "k.- l.- " LOCATE 15, 10: PRINT LOCATE 16, 10: PRINT "m.- n.- " LOCATE 17, 10: PRINT "o.- q.- Return to main menu" frame 7, 75, 1, 21 ' draw the frame LOCATE 19, 25: choice$ = Getletter$("Enter the appropriate letter", "A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,Q") choice$ = UCASE$(choice$) SELECT CASE choice$ CASE "A" Loubere ' goto the De La Loubere method CASE "B" LoubereM ' go to the modified De La Loubere CASE "C" EXIT SUB CASE "D" EXIT SUB CASE "E" EXIT SUB CASE "F" EXIT SUB CASE "G" EXIT SUB CASE "H" EXIT SUB CASE "I" EXIT SUB CASE "J" EXIT SUB CASE "K" EXIT SUB CASE "L" EXIT SUB CASE "M" EXIT SUB CASE "N" EXIT SUB CASE "O" EXIT SUB CASE "Q" EXIT SUB ' return to main menu CASE ELSE ON ERROR GOTO 0 ' Oops, invalid key pressed END SELECT END SUB SUB OrthoSum (matrixA()) ' sub OrthoSum calculates & checks the row sums (call 1),& column sums (call 2) ' it is called form displaySqr sub-routine sumCorrect = 0 ' reset count of correct sums FOR i = 1 TO size testSum = 0 ' reset for new row or column FOR j = 1 TO size testSum = testSum + matrixA(i, j) NEXT j IF testSum = sum THEN ' if sum is correct then sumCorrect = sumCorrect + 1 ' increment flag END IF NEXT i END SUB SUB pan5x5 (matrixA(), pTbl(), pairnum()) ' adapted from PAN5X5M4.BAS ' This program will generate the 36 essentially different 5 x 5 pandiagonal ' magic squares. ' There are 99 additional magic squares that are cyclic permutations of each ' of these, for a total of 3600 different 5 x 5 pandiagonal magic squares. ' Of course each of these has 7 variations because of rotations and/or ' reflections. (i.e. 'camoflaged' or 'disguised' copies). ' This program relies heavily on information in chapter 19 of 'New ' Recreations in Magic Squares' by Benson & Jacoby, Dover Publ. 1976. ' In retrospect, it would have been simpler, and taken less memory to simply list ' the integers of the 36 magic squares. ' It is called from the main routine. DIM bSqr1(5, 5) ' base square 1 DIM bSqr2(5, 5) ' base square 2 Title1$ = "Calculate & Display all 36 Essentially Different Order 5 Pandiagional Magic Sqrs" a = 0: B = 5: v = 1: w = 2 ' these four variables are fixed size = 5 snum = 1 ' start @ 1st square in the sequence CLS PRINT Title1$ PRINT : PRINT "Each of these 36 magic squares have 99 variations (plus the 3 reflections & 4" PRINT "rotations), for a total of 3600 pandiagonal magic squares of order five." PRINT " There are 0 order 3, 6, & 9; 48 order 4; 678,222,720 order 7; ? order 8" 'VIEW PRINT 5 TO 23 Report$ = Getletter$("Print a listing of Magic Squares (Y/N)", "YN") IF Report$ = "Y" THEN PRINT : PRINT "Turn on the printer *** set it to 15 CPI ***" OPEN "lpt1:" FOR OUTPUT AS #1 WIDTH "lpt1:", 110 ' set printer output for wider lines Pause ' wait for user response ON ERROR GOTO PrinterError ' set the error trap END IF IF Report$ = "Y" THEN ' print report heading PRINT #1, "": PRINT #1, " *** List of ALL Basic Pandiagonal Magic Squares of Order 5 ***" PRINT #1, "": PRINT #1, " Each of these 36 squares have 99 variations (plus the 3 rotations & 4 reflections)," PRINT #1, " for a total of 3600 Pandiagonal Magic Squares of order 5." PRINT #1, " There are 0 order 3, 48 order 4, 0 order 6, 678,222,720 order 7, ? order 8, & 0 order 9" PRINT #1, "": PRINT #1, " No. row 1 row 2 row 3 row 4 row 5" END IF CLS endroutine = false ' be sure flag is clear s conSqr = 1 ' consequetive order of square DO ' cycle through the 36 squares CLS frNum = pTbl(snum, 2) ' Frenicle number ??? bSqr = pTbl(snum, 3) ' basic square number (1 or 2) c = pTbl(snum, 4): d = pTbl(snum, 5): e = pTbl(snum, 6) qx = pTbl(snum, 7): Y = pTbl(snum, 8): z = pTbl(snum, 9) ' --- calculate values for cells .. this is basic square 1 bSqr1(1, 1) = a + v: bSqr1(1, 2) = B + w: bSqr1(1, 3) = c + qx bSqr1(1, 4) = d + Y: bSqr1(1, 5) = e + z bSqr1(2, 1) = c + Y: bSqr1(2, 2) = d + z: bSqr1(2, 3) = e + v bSqr1(2, 4) = a + w: bSqr1(2, 5) = B + qx bSqr1(3, 1) = e + w: bSqr1(3, 2) = a + qx: bSqr1(3, 3) = B + Y bSqr1(3, 4) = c + z: bSqr1(3, 5) = d + v bSqr1(4, 1) = B + z: bSqr1(4, 2) = c + v: bSqr1(4, 3) = d + w bSqr1(4, 4) = e + qx: bSqr1(4, 5) = a + Y bSqr1(5, 1) = d + qx: bSqr1(5, 2) = e + Y: bSqr1(5, 3) = a + z bSqr1(5, 4) = B + v: bSqr1(5, 5) = c + w ' --- calculate values for cells .. this is basic square 2 bSqr2(1, 1) = a + v: bSqr2(1, 2) = B + w: bSqr2(1, 3) = c + qx bSqr2(1, 4) = d + Y: bSqr2(1, 5) = e + z bSqr2(2, 1) = d + qx: bSqr2(2, 2) = e + Y: bSqr2(2, 3) = a + z bSqr2(2, 4) = B + v: bSqr2(2, 5) = c + w bSqr2(3, 1) = B + z: bSqr2(3, 2) = c + v: bSqr2(3, 3) = d + w bSqr2(3, 4) = e + qx: bSqr2(3, 5) = a + Y bSqr2(4, 1) = e + w: bSqr2(4, 2) = a + qx: bSqr2(4, 3) = B + Y bSqr2(4, 4) = c + z: bSqr2(4, 5) = d + v bSqr2(5, 1) = c + Y: bSqr2(5, 2) = d + z: bSqr2(5, 3) = e + v bSqr2(5, 4) = a + w: bSqr2(5, 5) = B + qx IF bSqr = 1 THEN FOR i = 1 TO 5 ' transfer values from FOR j = 1 TO 5 ' basic square 1 to origSqr(i, j) = bSqr1(i, j) ' the magic square NEXT j NEXT i ELSE ' Or FOR i = 1 TO 5 ' transfer values from FOR j = 1 TO 5 ' basic square 2 to origSqr(i, j) = bSqr2(i, j) ' the magic square NEXT j NEXT i END IF displaySqr pairnum() ' display m.s. & report IF Report$ = "Y" THEN PRINT #1, : PRINT #1, " "; ' set to condensed type first PRINT #1, " "; PRINT #1, USING "##"; frNum; : PRINT #1, " "; ' print a quick & dirty FOR i = 1 TO 5 ' list of magic squares FOR j = 1 TO 5 ' 1 m.s. per line PRINT #1, USING "##"; origSqr(i, j); : PRINT #1, " "; NEXT j PRINT #1, " "; NEXT i END IF ON KEY(2) GOSUB keyevent KEY(2) ON LOCATE 1, 1 PRINT Title1$ PRINT : PRINT "Each of these 36 magic squares have 99 variations (plus the 3 reflections & 4" PRINT "rotations), for a total of 3600 pandiagonal magic squares of order five." PRINT " There are 0 order 3, 6, & 9; 48 order 4; 678,222,720 order 7; ? order 8" LOCATE 19, 20: PRINT "Frenicle Number:"; frNum LOCATE 19, 45: PRINT "Basic square Number:"; bSqr LOCATE 20, 20: PRINT "Consequetive number:"; conSqr: conSqr = conSqr + 1 LOCATE 21, 20: PRINT "See New Recreations With Magic Squares " LOCATE 22, 23: PRINT "by Benson & Jacoby, page 137" LOCATE 23, 20 PRINT "F2, then spacebar to exit"; ' provision for exiting this routine Pause IF endroutine THEN CLS : EXIT SUB ' leave orderly snum = snum + 1 LOOP UNTIL snum > 36 'VIEW PRINT: CLS ' all 36 m.s. displayed ! END SUB SUB Pause STATIC ' The pause sub-routine allows the operater to view the screen until ' ready to proceed. It puts a message on the lower center of the ' screen and waits for a key-press. ' It is called from the main program & pan5X5. 'COLOR 0, 4 LOCATE 30, 30: PRINT "Press any key to continue."; 'COLOR 7, 1 DO WHILE INKEY$ = "" ON KEY(2) GOSUB keyevent KEY(2) ON LOOP LOCATE 30, 30: PRINT " "; END SUB SUB SemiPanSum (matrixA()) ' This subroutine tests the opposite short diagonals. If each pair sums correctly ' it indicates a semi pandiagonal magic square. ' It is only called if the square is NOT pandiagonal, and is called twice, ' once with the original square, and once with the rotated square, in order to ' test both pairs (2 directions). ' Tests all order magic squares for the correct constant of both opposite short ' diagonal pairs. ' Test for singly-even order, if desired, before calling this routine, because ' there are no semi-pandiagonal magic squares of this order. ' It is called form the displaySqr sub-routine. sumCorrect = 0 halfSize = size \ 2 ' integer division r = halfSize: c = 1 IF halfSize * 2 <> size THEN ' order is odd because halfSize ' took only integer value DO testSum = testSum + matrixA(r, c) ' add cells in 1st half of diagonal pair r = r - 1: c = c + 1 LOOP WHILE r > 0 r = size c = c + 1 ' move to column past center DO ' add cells in 2nd half of diagonal pair testSum = testSum + matrixA(r, c) r = r - 1: c = c + 1 LOOP WHILE r > halfSize + 1 ' stop before center row testSum = testSum + matrixA((size + 1) / 2, (size + 1) / 2) ' add value of center cell IF testSum = sum THEN ' test for constant sumCorrect = 1 END IF ELSE ' square order is even DO ' so use this routine testSum = testSum + matrixA(r, c) ' 1st half of pair r = r - 1: c = c + 1 ' no need to add center cell & LOOP WHILE r > 0 ' c doesn't have to jump over center r = size DO testSum = testSum + matrixA(r, c) ' 2nd half of pair r = r - 1: c = c + 1 LOOP WHILE r > halfSize IF testSum = sum THEN ' test for correct constant sumCorrect = 1 END IF END IF END SUB SUB showSqr ' --- sub showSqr prints the matrix to the screen ' This is a general purpose subprogram that handles any order of m.s. ' It is called form the main program & also from displaySqr sub-routine. ' --- calculate frame parameters and call it halfSize = size \ 2 top = 13 - size: bottom = top + size * 2 ' determine location & size of display left = 39 - halfSize * 6: right = left + size * 6 frame left, right, top, bottom ' and call frame s.r. FOR row = top + 2 TO bottom - 2 STEP 2 ' draw mid horizontal lines FOR col = left + 1 TO right - 1 LOCATE row, col PRINT CHR$(196) NEXT col, row firstVert = left + 6: lastVert = right - 6 ' location of 1st & last vertical lines FOR col = firstVert TO lastVert STEP 6 ' draw mid vertical lines FOR row = top + 1 TO bottom - 1 LOCATE row, col PRINT CHR$(179) NEXT row, col FOR i = 1 TO size ' print the cell contents FOR j = 1 TO size row = top + 2 * i - 1 col = left + 6 * j - 4 LOCATE row, col PRINT USING "###"; origSqr(i, j) NEXT j, i IF nograph = 0 THEN magicLines END SUB SUB sqrInput ' This routine allows input directly to the cells of the square. ' Best use is for changing a few cells to form a different m.s. ' Called by the main program. ' --- Values for keys on the curser keys and the spacebar: CONST UP = 72, DOWN = 80, rightArrow = 77, SPACE = " " halfSize = size \ 2 ' these 3 rows exactly the same top = 11 - size: bottom = top + size * 2 ' as showSqr left = 39 - halfSize * 6: right = left + size * 6 ' determine location & size of display ' --- Null$ is the first character of the two-character INKEY$ ' value returned for direction keys such as UP and DOWN: Null$ = CHR$(0) LOCATE 1, 27: PRINT "Edit or Input a Magic Square" LOCATE 21, 26: PRINT "Press 'q' to exit this module" LOCATE 22, 5: PRINT "You MUST enter 3 digits for each cell (i.e. 001 for 1; or space,space,1)" LOCATE 23, 5: PRINT "Correct errors by going to the right, up, or down until back at the cell" LOCATE 24, 4: PRINT "Numbers (not digits) you pass over with the arrow keys will not be changed"; r = top + 3: c = left + 2: i = 1: j = 1 B$ = "": a$ = "" DO SELECT CASE keyVal$ CASE Null$ + CHR$(UP) ' move up to next row r = r - 2: i = i - 1 IF r < top + 1 THEN ' if at top, go to bottom r = bottom - 1: i = size END IF CASE Null$ + CHR$(DOWN) ' move down to next row r = r + 2: i = i + 1 IF r > bottom - 1 THEN ' if at bottom, go to top r = top + 1: i = 1 END IF CASE Null$ + CHR$(rightArrow) ' move to next digit position c = c + 1 IF c > right - 2 THEN ' go back to the start of the row c = left + 2: j = 1 END IF CASE SPACE ' enter key values c = c + 1: a$ = " ": PRINT " "; CASE "1" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "1" CASE "2" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "2" CASE "3" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "3" CASE "4" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "4" CASE "5" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "5" CASE "6" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "6" CASE "7" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "7" CASE "8" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "8" CASE "9" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "9" CASE "0" LOCATE r, c: PRINT keyVal$ c = c + 1: a$ = "0" CASE ELSE ' The user pressed some key other than one of the direction ' keys, or the number keys, so don't do anything. END SELECT LOCATE r, c, 1 ' make curser visible keyVal$ = UCASE$(INKEY$) IF c MOD 6 = 2 THEN ' skip to next cell c = c + 3: j = j + 1 END IF IF LEN(B$) < 3 AND LEN(a$) > 0 THEN ' add digits to the number B$ = B$ + a$: a$ = "" ' until there are 3 digits END IF IF LEN(B$) = 3 THEN num = VAL(B$) B$ = "" IF num = 0 THEN ' keep original number origSqr(i, j) = origSqr(i, j) ELSE ' save new number origSqr(i, j - 1) = num IF c > right - 2 THEN ' you are at the end of the row c = left + 2: j = 1 ' go back to the start END IF END IF END IF LOOP UNTIL keyVal$ = "Q" ' exit this routine sum = 0 ' recalculate the constant FOR c = 1 TO size sum = sum + origSqr(1, c) ' sum cells of top row NEXT c END SUB SUB titleOne ' --- This sub-routine prints the main title when required. ' It is called from various routines PRINT "MAGICSQR.BAS --- Tests & demonstrates MAGIC SQUARES & use of general order S.R. " END SUB