XProfan

WindowTitle "Simon de la Loubére (Siamesische Methode) für Magische Quadrate ungerader Seitenlänge"
'(D) Demo 2017-09 by P.Specht, Vienna/Austria. Alles ohne Gewähr! 'Q: Wikipedia
var N&=7'<<< Gewünschte ungerade Seitenlänge hier eingeben!
'====================================================================================
'Die erste Zahl (1) kommt oben in die Mitte.
'Wenn die zuletzt geschriebene Zahl i kein Vielfaches von n ist (i mod n <> 0),
'dann trage die nächste Zahl i+1 in das Feld oben rechts vom zuletzt ausgefüllten Feld.
'Hierbei wird das magische Quadrat als periodisch wiederholt angesehen, d. h.,
'wenn man über den oberen Rand hinausgeht (das passiert schon beim ersten Schritt),
'kommt man von unten wieder hinein, und wenn man rechts hinausgeht, dann kommt man
'von links wieder hinein.
'
'Ist die zuletzt geschriebene Zahl i ein Vielfaches von n (i Mod n = 0),
'dann trage die nächste Zahl in das Feld *unter* der zuletzt geschriebenen Zahl.
'
'Verlässt man nach diesen Regeln das Quadrat nach oben (x,-1), so schreibe die nächste Zahl
'ganz unten in die Spalte, die rechts der Spalte liegt, in die die letzte Zahl geschrieben wurde.
'Wird das Quadrat nach rechts verlassen, schreibe die nächste Zahl ganz links in die Zeile,
'die über der Zeile der zuletzt geschriebenen Zahl liegt.
'
'Hier ein nach dieser Regel 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
WindowStyle 24:if n&<16:cls:else:Window 0,0-%maxx,%maxy:showmax:endif:font 2

if n&>25:print "\n Darstellung am Schirm nicht mehr möglich!":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 Dieser Algorithmus gilt nur für ungerade Seitenlängen!"

        endif

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