XProfan

WindowTitle "DAS SPIEL NIMM"
' (CL) CopyLeft 2014-09 by P. Specht, Wien. Keine wie auch immer geartete Gewähr!
' Es gibt für den Spieler, der beginnt eine Strategie, bei der er nicht verlieren kann.
' Zu Beginn nimmt der spätere Gewinner ein Streichholz. Dann richtet er sich nach seinem
' Gegner bzw. versucht stets eine Viererzahl zu erreichen. Denn wenn er dem Gegner im letzteb
' Zug als Auswahl 4 Hölzchen präsentiert, kann ER das letzte Hölchen nehmen und gewinnt damit.
Windowstyle 24:Randomize : font 2 : declare b&,m&,h&,x&,y&,s$ : h&=9+rnd(21)
Start:
b&=0:m&=0:CLS
Print "\n Der Zufallsgenerator legt in dieser Runde ";h&;" Hölzchen aus."
show h&
Print "\n Wer soll beginnen {1=Spieler, 0=Computer}?: ";:Input b&
print " --------------------------------------------------------"
Loop:

If b&=0 : cls:print "\n Der Computer ist dran."

    else    : print "\n Spieler ist dran.     "

endif

inc m& : print "\n ";int(m&/2);". Zug: Noch liegen ";h&;" Hölzchen auf dem Tisch.\n"
show h&

if b&=0

    ' Gewinn-Zug: Möglichst auf eine Viererzahl bringen
    x&=h& mod 4:case x&=0:x&=1'Pech für Compi: 0 geht nicht!
    print " Computer nimmt ";x&;" Hölzchen weg.     ":h&=h&-x&
    else :nochmal:
    print " Wieviele Hölzchen möchten sie wegnehmen {1,2 oder 3}?: ";:input y&
    case (y&<1) or (y&>3):goto "nochmal"
    print "\n Spieler hat ";y&;" Hölzchen weggenommen.":h&=h&-y&

endif

b&=not(b&)
print "\n Nach dem ";m&;". Zug liegen jetzt ";h&;" Hölzchen auf dem Tisch.\n"
show h&
waitinput 2000

if h&<=0 :print "\n *********************************"

    if b&=0:print " * Spieler gewinnt! Gratulation! *"

        else   :print " *      Computer hat gewonnen.   *"
        endif  :print " *********************************"
        print  "\n Noch ein Spiel {1=Ja}?: ";:input s$:case s$="1":goto "Start"
        print "\n Wiedersehen!":waitinput 6000:end

    else

        print " --------------------------------------------------------"
        waitinput 1000:goto "Loop"

    endif

    END

    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 &Loop*width(%hwnd)/30,(14*height(%hwnd)/20) - &Loop*width(%hwnd)/30, 19/20*height(%hwnd)
            usepen 0,14,rgb(230,70,0)
            line &Loop*width(%hwnd)/30,(14*height(%hwnd)/20) - &Loop*width(%hwnd)/30, 14/20*height(%hwnd)

        endwhile

    endproc