XProfan

WindowTitle "Bachet de Mezirac´s Wägeproblem"
cls:font 2
declare h&,  i&,j&,k&,l&,w&,sum&[121],konf$[121],max&

whileloop -1,1:h&=&Loop

    whileloop -1,1:i&=&Loop

        whileloop -1,1:j&=&Loop

            whileloop -1,1:k&=&Loop

                whileloop -1,1:l&=&Loop

                    w&=3^4*h&+3^3*i&+3^2*j&+3^1*k&+3^0*l&

                    if w&>=0':print w&

                        sum&[w&]=sum&[w&]+1
                        konf$[w&]=str$(int(3^4*h&))+" "+str$(int(3^3*i&))+" "+\
                        str$(int(3^2*j&))+" "+str$(int(3*k&))+" "+str$(int(l&))
                        case w&>max&:max&=w&

                    endif

                endwhile

            endwhile

        endwhile

    endwhile

endwhile

print "\n  Gewichtswert Häufigkeit  Konfiguration(´-´: In Wägegutschale)"

whileloop 0,max&

    print
    print tab(4);&Loop,tab(20);sum&[&Loop],tab(36);translate$(konf$[&Loop],"0",".",)

    if %csrlin>23:waitinput:cls:endif

        print

    endwhile

    print "\n ------------------------------------------------------"
    waitinput