XProfan

Windowtitle "LOLogik - Klicke en el Felder así, "+\
"daß todos Flächen GLEICHFARBIG voluntad. ESC = End-Auswertung"
'(W) Wettbewerbsbeitrag ;-) 2013-02 by P.Pájaro carpintero@gmx.at
Ventana de Estilo 1024 | 16 | 8
font 2:cls:usepen 0,1,rgb(255,255,255)
declarar f&,a&,bb&,c&,d&,r&,g&,b&
declarar x0&,y0&,x1&,y1&, x2&,y2&,x3&,y3&
declarar x4&,y4&,x5&,y5&, x6&,y6&,x7&,y7&
declarar 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)
bucle:

seleccionar a&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

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

seleccionar bb&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

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

seleccionar c&

    caseof 0:f&=r&

    caseof 1:f&=g&

    caseof 2:f&=b&

endselect

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

seleccionar 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
imprimir " ";m&;". Runde, ";
imprimir " ";n&;" Clicks ";'ga&,gb&,gc&,gd&

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

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

endif

imprimir " Score: ";s&;" ";
waitinput

if %key=27

    auswert:
    llq!=s&/m&*100
    locate 17,15:Imprimir " Ihr LOLogik-Quotient beträgt: ";format$("%g",llq!);" "
    locate 19,15:Imprimir " Es ... ";

    if llq!>=1000:imprimir " ABSOLUTE SPITZE!";

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

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

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

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

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

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

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

    endif

    waitinput 20000:end

endif

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

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

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

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

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

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

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

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

endif

inc n&
goto "loop"

proc gethigherlevellogic

    'l&[i:to,j:from,m:level]

    whileLoop 4,39:k&=&Loop

        whileLoop 0,3:i&=&Loop

            whileLoop 0,3:j&=&Loop

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

            endwhile

        endwhile

    endwhile

ENDPROC

proc getfirstlevelslogic

    'l&[from,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