XProfan

Windowtitle "LOLogik - Klicke sur qui Felder so, "+\
"daß alle Flächen GLEICHFARBIG volonté. ESC = Fin-Auswertung"
'(W) Wettbewerbsbeitrag ;-) 2013-02 by P.Specht@gmx.at
Fenêtre Style 1024 | 16 | 8
font 2:cls:usepen 0,1,rgb(255,255,255)
declare f&,a&,bb&,c&,d&,r&,g&,b&
declare x0&,y0&,x1&,y1&, x2&,y2&,x3&,y3&
declare x4&,y4&,x5&,y5&, x6&,y6&,x7&,y7&
declare ga&,gb&,gc&,gd&,n&,m&,s&,i&,j&,k&,l&[3,3,39],llq!
getfirstlevelslogic
gethigherlevellogic
randomize
a&=rnd(3):b&=rnd(3):c&=rnd(3):d&=rnd(3):m&=1
r&=rgb(255,0,0):g&=rgb(0,255,0):b&=rgb(0,0,255)
x0&=0:y0&=0:x1&=width(%hwnd)\2:y1&=height(%hwnd)\2
x2&=0:y2&=height(%hwnd)\2:x3&=width(%hwnd)\2:y3&=height(%hwnd)
x4&=width(%hwnd)\2:y4&=0:x5&=width(%hwnd):y5&=height(%hwnd)\2
x6&=width(%hwnd)\2:y6&=height(%hwnd)\2:x7&=width(%hwnd):y7&=height(%hwnd)
loop:

sélectionner a&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

imprimer a&
usebrush 1,f&
rectangle x0&,y0& - x1&,y1&

sélectionner bb&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

usebrush 1,f&
rectangle x2&,y2& - x3&,y3&

sélectionner c&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

usebrush 1,f&
rectangle x4&,y4& - x5&,y5&

sélectionner d&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

usebrush 1,f&
rectangle x6&,y6& - x7&,y7&
ga&=getpixel(x0&+3,y0&+3)
gb&=getpixel(x2&+3,y2&+3)
gc&=getpixel(x4&+3,y4&+3)
gd&=getpixel(x6&+3,y6&+3)
locate 1,1
imprimer " ";m&;". Runde, ";
imprimer " ";n&;" Clicks ";'ga&,gb&,gc&,gd&

si (ga&=gb&) AND (gb&=gc&) AND (gc&=gd&)

    rept:
    a&=rnd(3):bb&=rnd(3):c&=rnd(3):d&=rnd(3)
    cas (a&=bb&) AND (bb&=c&) AND (c&=d&) : goto "rept"
    s&=s&+m&*m&-n&+3
    imprimer " Score: ";s&;" ";
    inc m&
    n&=0
    sound 1500,150
    locate 16,31:PRINT "BRAVO, RICHTIG!"
    waitinput 4000
    cas %clé=27:goto "auswert"
    beep
    goto "loop"

endif

imprimer " Score: ";s&;" ";
waitinput

si %clé=27

    auswert:
    llq!=s&/m&*100
    locate 17,15:Imprimer " son LOLogik-Quotient beträgt: ";format$("%g",llq!);" "
    locate 19,15:Imprimer " c'est ... ";

    si llq!>=1000:imprimer " ABSOLUTE SPITZE!";

    elseif between(llq!,400,1000):imprimer "SUPER! ";

    elseif between(llq!,100,400):imprimer "SEHR GUT! ";

    elseif between(llq!,50,100):imprimer "GUT! ";

    elseif between(llq!,25,50):imprimer "RECHT GUT! ";

    elseif between(llq!,10,25):imprimer "SO LALA! ";

    elseif between(llq!,0,10):imprimer "HMMM, NAJA, ÄH... ";

    elseif llq!< 0:imprimer "NOCH VERBESSERBAR! ";

    endif

    waitinput 20000:end

endif

si mouse(x0&,y0& - x1&,y1&)

    cas l&[0,0,m&]:inc a&:a&=a& mod 3
    cas l&[1,0,m&]:inc bb&:bb&=bb& mod 3
    cas l&[2,0,m&]:inc c&:c&=c& mod 3
    cas l&[3,0,m&]:inc d&:d&=d& mod 3

elseif mouse(x2&,y2& - x3&,y3&)

    cas l&[0,1,m&]:inc a&:a&=a& mod 3
    cas l&[1,1,m&]:inc bb&:bb&=bb& mod 3
    cas l&[2,1,m&]:inc c&:c&=c& mod 3
    cas l&[3,1,m&]:inc d&:d&=d& mod 3

elseif mouse(x4&,y4& - x5&,y5&)

    cas l&[0,2,m&]:inc a&:a&=a& mod 3
    cas l&[1,2,m&]:inc bb&:bb&=bb& mod 3
    cas l&[2,2,m&]:inc c&:c&=c& mod 3
    cas l&[3,2,m&]:inc d&:d&=d& mod 3

elseif mouse(x6&,y6& - x7&,y7&)

    cas l&[0,3,m&]:inc a&:a&=a& mod 3
    cas l&[1,3,m&]:inc bb&:bb&=bb& mod 3
    cas l&[2,3,m&]:inc c&:c&=c& mod 3
    cas l&[3,3,m&]:inc d&:d&=d& mod 3

endif

inc n&
goto "loop"

proc gethigherlevellogic

    'l&[i:to,j:à partir de,m:level]

    whileLoop 4,39:k&=&Boucle

        whileLoop 0,3:i&=&Boucle

            whileLoop 0,3:j&=&Boucle

                l&[i&,j&,k&]=rnd(2)
                l&[i&,i&,k&]=1

            endwhile

        endwhile

    endwhile

endproc

proc getfirstlevelslogic

    'l&[à partir de,to,level]
    l&[0,0,1]=1
    l&[1,1,1]=1
    l&[2,2,1]=1
    l&[3,3,1]=1
    l&[0,0,2]=1: l&[0,1,2]=1
    l&[1,1,2]=1: l&[1,3,2]=1
    l&[2,2,2]=1: l&[2,2,2]=1
    l&[3,3,2]=1: l&[3,0,2]=1
    l&[0,0,3]=0: l&[0,1,3]=1
    l&[1,1,3]=0: l&[1,3,3]=1
    l&[2,2,3]=1: l&[2,2,3]=1
    l&[3,3,3]=1: l&[3,0,3]=1

endproc