An die hochwohlgeborene Jury - also alle anderen Teilnehmer !
Habe ein Uralt-Teil von mir, das ursprünglich für Kinder gedacht war, in XProfan-Old Style übersetzt und die höheren Level per Zufallsgenerator etwas interessanter gestaltet. Man kann das Ganze sicher viel viel kompakter und eleganter programmieren, mir gings aber nur um den Spaßfaktor.
Tipp: Auf die Farben-Reihenfolge achten!
Gruss
http://postimage.org/image/ghfs3ko6r/
Code
Windowtitle "LOLogik - Klicke auf die Felder so, "+\
"daß alle Flächen GLEICHFARBIG werden. ESC = End-Auswertung"
'(W) Wettbewerbsbeitrag ;-) 2013-02 by P.Specht@gmx.at
WindowStyle 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:
select a&
caseof 0:f&=r&
caseof 1:f&=g&
caseof 2:f&=b&
endselect
print a&
usebrush 1,f&
rectangle x0&,y0& - x1&,y1&
select bb&
caseof 0:f&=r&
caseof 1:f&=g&
caseof 2:f&=b&
endselect
usebrush 1,f&
rectangle x2&,y2& - x3&,y3&
select c&
caseof 0:f&=r&
caseof 1:f&=g&
caseof 2:f&=b&
endselect
usebrush 1,f&
rectangle x4&,y4& - x5&,y5&
select 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
print " ";m&;". Runde, ";
print " ";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)
case (a&=bb&) AND (bb&=c&) AND (c&=d&) : goto "rept"
s&=s&+m&*m&-n&+3
print " Score: ";s&;" ";
inc m&
n&=0
sound 1500,150
locate 16,31:PRINT "BRAVO, RICHTIG!"
waitinput 4000
case %key=27:goto "auswert"
beep
goto "loop"
endif
print " Score: ";s&;" ";
waitinput
if %key=27
auswert:
llq!=s&/m&*100
locate 17,15:Print " Ihr LOLogik-Quotient beträgt: ";format$("%g",llq!);" "
locate 19,15:Print " Das ist ... ";
if llq!>=1000:print " ABSOLUTE SPITZE!";
elseif between(llq!,400,1000):print "SUPER! ";
elseif between(llq!,100,400):print "SEHR GUT! ";
elseif between(llq!,50,100):print "GUT! ";
elseif between(llq!,25,50):print "RECHT GUT! ";
elseif between(llq!,10,25):print "SO LALA! ";
elseif between(llq!,0,10):print "HMMM, NAJA, ÄH... ";
elseif llq!< 0:print "NOCH VERBESSERBAR! ";
endif
waitinput 20000:end
endif
if mouse(x0&,y0& - x1&,y1&)
case l&[0,0,m&]:inc a&:a&=a& mod 3
case l&[1,0,m&]:inc bb&:bb&=bb& mod 3
case l&[2,0,m&]:inc c&:c&=c& mod 3
case l&[3,0,m&]:inc d&:d&=d& mod 3
elseif mouse(x2&,y2& - x3&,y3&)
case l&[0,1,m&]:inc a&:a&=a& mod 3
case l&[1,1,m&]:inc bb&:bb&=bb& mod 3
case l&[2,1,m&]:inc c&:c&=c& mod 3
case l&[3,1,m&]:inc d&:d&=d& mod 3
elseif mouse(x4&,y4& - x5&,y5&)
case l&[0,2,m&]:inc a&:a&=a& mod 3
case l&[1,2,m&]:inc bb&:bb&=bb& mod 3
case l&[2,2,m&]:inc c&:c&=c& mod 3
case l&[3,2,m&]:inc d&:d&=d& mod 3
elseif mouse(x6&,y6& - x7&,y7&)
case l&[0,3,m&]:inc a&:a&=a& mod 3
case l&[1,3,m&]:inc bb&:bb&=bb& mod 3
case l&[2,3,m&]:inc c&:c&=c& mod 3
case 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
Alles anzeigen