XProfan

Titre de la fenêtre "DAS SPIEL NIMM"
' (CL) CopyLeft 2014-09 by P. Specht, vienne. aucun cependant geartete Gewähr!
' il y a pour den Spieler, qui beginnt une Strategie, chez qui il pas perdre peux.
' trop Beginn nimmt qui plus tard Gewinner un allumette. ensuite richtet il sich pour seinem
' Gegner bzw. versucht stets une Viererzahl trop erreichen. car si il dem Gegner im letzteb
' rame comme sélection 4 Hölzchen präsentiert, peux ER cela dernier Hölchen prendre et gewinnt avec cela.
Windowstyle 24:Randomiser : font 2 : declare b&,m&,h&,x&,y&,s$ : h&=9+rnd(21)
Start:
b&=0:m&=0:CLS
Imprimer "\n qui Zufallsgenerator legt dans cette Runde ";h&;" Hölzchen aus."
show h&
Imprimer "\n qui soll commencer {1=Spieler, 0=Computer}?: ";:Contribution b&
imprimer " --------------------------------------------------------"
Boucle:

Si b&=0 : cls:imprimer "\n qui ordinateur ist tour."

    d'autre    : imprimer "\n Spieler ist tour.     "

endif

inc m& : imprimer "\n ";int(m&/2);". rame: encore liegen ";h&;" Hölzchen sur dem Tisch.\n"
show h&

si b&=0

    ' Gewinn-rame: Möglichst sur une Viererzahl apporter
    x&=h& mod 4:cas x&=0:x&=1'Pech pour Compi: 0 allez pas!
    imprimer " ordinateur nimmt ";x&;" Hölzchen weg.     ":h&=h&-x&
    d'autre :nochmal:
    imprimer " Wieviele Hölzchen serait vous enlever {1,2 ou bien 3}?: ";:input y&
    cas (y&<1) or (y&>3):goto "nochmal"
    imprimer "\n Spieler hat ";y&;" Hölzchen weggenommen.":h&=h&-y&

endif

b&=not(b&)
imprimer "\n Pour dem ";m&;". rame liegen maintenant ";h&;" Hölzchen sur dem Tisch.\n"
show h&
waitinput 2000

si h&<=0 :imprimer "\n *********************************"

    si b&=0:imprimer " * Spieler gewinnt! Gratulation! *"

        d'autre   :imprimer " *      ordinateur hat gewonnen.   *"
        endif  :imprimer " *********************************"
        imprimer  "\n encore un Spiel {1=Ja}?: ";:input s$:cas s$="1":goto "Start"
        imprimer "\n Wiedersehen!":waitinput 6000:end

    d'autre

        imprimer " --------------------------------------------------------"
        waitinput 1000:goto "Loop"

    endif

    FIN

    proc show :parameters h&

        usepen 1,1,rgb(255,255,255):usebrush 1,rgb(255,255,255)
        rectangle 0,13/20*height(%hwnd) - width(%hwnd),height(%hwnd)

        whileloop h&

            usepen 0,7,rgb(200,200,100)
            line &Boucle*width(%hwnd)/30,(14*height(%hwnd)/20) - &Boucle*width(%hwnd)/30, 19/20*height(%hwnd)
            usepen 0,14,rgb(230,70,0)
            line &Boucle*width(%hwnd)/30,(14*height(%hwnd)/20) - &Boucle*width(%hwnd)/30, 14/20*height(%hwnd)

        endwhile

    endproc