XProfan

WindowTitle "Simon de la Loubére (Siamesische Methode) per 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 circa 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 circa 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 possibile!":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 per 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