XProfan

English

p.specht

in the year 1691 publizierte the french Gesandte Simon de la Loubére one from Siam (today Thailand) mitgebrachtes take action to Creation discretionary great Magischer Squares ungerader Seitenlänge. though stammt this stupendous simple take action probably from Surat (in india), of where it one Franzose namens M. Vincent then to Siam brought. old and Zuschreibung of EDV-take action shine means quite willkürlich. Hauptsache, it works:

Compile Mark Separation

Window Title "Simon de la Loubére (Siamesische method) for magic Squares ungerader Seitenlänge"
'(D) demonstration 2017-09 by P.woodpecker, Vienna/Austria. everything without Gewähr! 'Q: Wikipedia
var N&=7'<<< desired ungerade Seitenlänge here prompt!
'====================================================================================
'The first number (1) comes supra into middle.
'If the lastly written number i no multiple of n is (i mod n <> 0),
'then carry The next number i+1 into area supra right of lastly ausgefüllten area.
'Hierbei becomes the magic Quadrat as periodic repeatedly respected, d. h.,
'if one over the oberen edge hinausgeht (the happens already at first step),
'comes one of under again into, and if one right hinausgeht, then comes one
'of left again into.
'
'is The lastly written number i one multiple of n (i Mod n = 0),
'then carry The next number into area *under* the lastly written number.
'
'leave one to this regulate the Quadrat to supra (x,-1), so write The next number
'integrally under into slot, The right the column lying, into The latest number written watts.
'becomes the Quadrat to right leave, write The next number integrally left into row,
'The over the row the lastly written number lying.
'
'here one to this rule konstruiertes 7×7-Quadrat
'
'30 	39 	48 	 1 	10 	19 	28
'38 	47   7 	 9 	18 	27 	29
'46 	6 	 8 	17 	26 	35 	37
' 5 	14 	16 	25 	34 	36 	45
'13 	15 	24 	33 	42 	44 	 4
'21 	23 	32 	41 	43 	 3 	12
'22 	31 	40 	49 	 2 	11 	20
Window Style 24:if n&<16:cls:else:Window 0,0-%maxx,%maxy:showmax:endif:font 2

if n&>25:print "\n statement on the screen not any more possible!":goto "exit":endif

    if n& mod 2

        declare F&[n&,n&],m&,x&,y&,z&,i&,j&,lx&,ly&

        proc show

            locate 2,2

            Whileloop 1,n&:j&=&Loop:whileloop 1,n&:i&=&Loop

                print tab(5*i&);if(F&[i&,j&],F&[i&,j&],"_");
                endwhile:print:print:endwhile

            endproc

            prep:
            m&=n&*n&
            x&=(n&+1)/2:y&=1
            z&=1:F&[x&,y&]=z&:Show

            While 1

                x&=x&+1:case x&>n&:x&=x&-n&
                y&=y&-1:case y&< 1:y&=y&+n&

                if F&[x&,y&]=0

                    inc z&:case z&>m&:goto "exit"
                    F&[x&,y&]=z&

                else

                    y&=y&+3
                    x&=x&-2
                    case y&=n&+2:goto "exit"
                    case x&<1:x&=x&+n&
                    case y&>n&:y&=y&-n&

                endif

                case n&<14:Show':waitinput

            Endwhile

        else

            Print "\n this Algorithmus counts only for ungerade Seitenlängen!"

        endif

        exit:
        case (n&>14) and (n&<26):show
        print "\n    Reihensumme the magic ";n&;"x";n&;"-Quadrates: ";int((n&^3+n&)/2);
        beep:waitinput 30000
        End