XProfan

Titre de la fenêtre upper$("Türme de Hanoi avec 4 Pfosten, rekursiv")
Fenêtre Style 24:Fenêtre 0,0-%maxx,240:randomize:font 2
imprimer "\n ici une rekursive variante avec 4 Pfosten"
declare n&,m&
imprimer "\n\n\n Gewünschte Scheibenzahl ?:",:input n&
Titre de la fenêtre " TASTE Q pour SCHNELL-LAUF DRÜCKEN "
cls
declare h&[4,n&],v&[4],z&

whileloop n& : h&[1,&Boucle]=n&+1-&Boucle : endwhile :

    v&[1]=n&
    m&=n&
    show 1,2
    waitinput 1000
    hanoi4(n&,1,4,3,2)
    beep
    waitinput
    end

    proc hanoi4 :parameters n&,von&,ueber&,ueber2&,nach&

        si n&=1

            déplacer(von&,nach&)

        elseif n&=2

            déplacer(von&,ueber&)
            déplacer(von&,nach&)
            déplacer(ueber&,nach&)

        d'autre

            Hanoi4(n&-2,von&,ueber2&,nach&,ueber&)
            déplacer(von&,ueber2&)
            déplacer(von&,nach&)
            déplacer(ueber2&,nach&)
            Hanoi4(n&-2,ueber&,von&,ueber2&,nach&)

        endif

    endproc

    'proc hanoi :parameters n&,von&,nach&,ueber&
    'si n&=1
    '  déplacer(von&,nach&)
    'elseif n&>1
    '  hanoi(n&-1,von&,ueber&,nach&)
    '  déplacer(von&,nach&)
    '  hanoi(n&-1,ueber&,nach&,von&)
    'endif
    'endproc

    proc déplacer :parameters von&,nach&

        v&[nach&]=v&[nach&]+1
        h&[nach&,v&[nach&]]=h&[von&,v&[von&]]
        h&[von&,v&[von&]]=0:v&[von&]=v&[von&]-1
        show von&,nach&
        cas %clé<>113:waitinput 1000

    endproc

    proc Show :parameters von&,nach&

        locate 1,1
        inc z&
        imprimer " ";z&;»,von&;">";nach&;" "
        imprimer "------------------------"
        cas %clé<>113:waitinput 1000
        declare v&,w&

        whileloop 1,4:v&=&Boucle

            imprimer " ";v&;":  ",

            whileloop 1,m&

                w&=&Boucle

                si h&[v&,w&]>0:imprimer h&[v&,w&],

                    d'autre :imprimer ".",

                endif

            endwhile

            imprimer

        endwhile

        imprimer "------------------------"

    endproc