XProfan

WindowTitle "  Situative Awareness deiner Maus bezüglich eines "+\
"Käse-Dreiecks V2.0alpha;      LEERTASTE FÜR NEUES ZUFALLSDREIECK"
' (@) Cheeseware 2013-08 by P. Specht. Jedwede Nutzung auf alleiniges
' Risiko des Anwenders/der Anwenderin. Allf. Fehlerrückmeldungen erbeten!
WindowStyle 1048:font 2:randomize:Window 0,0-%maxx,%maxy
var xm&=width(%hwnd)\2:var ym&=height(%hwnd)\2
Declare x!,y!,xa!,ya!,xb!,yb!,xc!,yc!,ber&
declare gab!,gbc!,gca!,hab!,hbc!,hca!
declare xabh!,yabh!,xbch!,ybch!,xcah!,ycah!
declare xmxb!,ymyb!,rot&,code$,count&
Nochmal:
cls : line xm&,0 - xm&,2*ym& : line 0,ym& - 2*xm&,ym&
'Dreieck A,B,C
xa!=rnd(width(%hwnd))-xm&: ya!=rnd(height(%hwnd))-ym&
xb!=rnd(width(%hwnd))-xm&: yb!=rnd(height(%hwnd))-ym&
xc!=rnd(width(%hwnd))-xm&: yc!=rnd(height(%hwnd))-ym&
rot&=((yc!-ya!)*(xb!-xa!))>((yb!-ya!)*(xc!-xa!))' Drehsinn links = 1
locate 2,2:print "Drehrichtung: " + if(rot&,"links","rechts")
' Dreieck darstellen
usepen 0,2,@rgb(255,0,0)
line xm&+xa!,(ym&-ya!)- xm&+xb!,ym&-yb!
line xm&+xb!,(ym&-yb!)- xm&+xc!,ym&-yc!
line xm&+xc!,(ym&-yc!)- xm&+xa!,ym&-ya!
drawtext xm&+xa!-10,ym&-ya!,"A"
drawtext xm&+xb!+10,ym&-yb!,"B"
drawtext xm&+xc!-10,ym&-yc!,"C"
print "\n\n Deine Maus blickt jetzt auf:"

WHILENOT (%Key=32) or (count&>50)'Space-Taste

    WaitInput 250
    x!=%MouseX-xm&
    y!=ym&-%Mousey
    inc count&
    xabh!=(xa!+xb!)*0.5:yabh!=(ya!+yb!)*0.5
    xbch!=(xb!+xc!)*0.5:ybch!=(yb!+yc!)*0.5
    xcah!=(xc!+xa!)*0.5:ycah!=(yc!+ya!)*0.5
    xmxb!=x!-xb!:ymyb!=y!-yb!
    gab!=(ya!-yb!)*xmxb!-ymyb!*(xa!-xb!)
    gbc!=(yc!-yb!)*xmxb!-ymyb!*(xc!-xb!)
    gca!=(yc!-ya!)*(x!-xa!)-(y!-ya!)*(xc!-xa!)
    hab!=(yabh!-yc!)*(x!-xc!)-(y!-yc!)*(xabh!-xc!)
    hbc!=(ybch!-ya!)*(x!-xa!)-(y!-ya!)*(xbch!-xa!)
    hca!=(ycah!-yb!)*xmxb!-ymyb!*(xcah!-xb!)
    usepen 0,1,if(count& mod 2,@rgb(0,0,255),@rgb(255,255,255))
    line xm&+xabh!,(ym&-yabh!)-xm&+xc!,ym&-yc!
    line xm&+xbch!,(ym&-ybch!)-xm&+xa!,ym&-ya!
    line xm&+xcah!,(ym&-ycah!)-xm&+xb!,ym&-yb!
    ber&=64*(rot&>0)+32*(hca!>0)+16*(hbc!>0)+8*(hab!>0)+4*(gca!>0)+2*(gbc!>0)+(gab!>0)
    locate 13,2 :print right$("00000000"+Bin$(ber&),7)+" = ";
    locate 13,15:print ber&;" "
    locate 7,7
    code$=""

    select ber&

        ifnot rot&

            caseof 8 :code$="B,C, "

            caseof 9 :code$="B,C,A"

            caseof 10:code$="B,C,i"

            caseof 18:code$="C,A,i"

            caseof 20:code$="C,A,B"

            caseof 22:code$="C,A, "

            caseof 24:code$="C,B, "

            caseof 26:code$="C,B,i"

            caseof 28:code$="C,B,A"

            caseof 34:code$="A,B,i"

            caseof 35:code$="A,B, "

            caseof 39:code$="A,B,C"

            caseof 41:code$="B,A,C"

            caseof 42:code$="B,A,i"

            caseof 43:code$="B,A, "

            caseof 50:code$="A,C,i"

            caseof 54:code$="A,C, "

            caseof 55:code$="A,C,B"

        else

            caseof 72 :code$="A,C,B"

            caseof 73 :code$="A,C, "

            caseof 77 :code$="A,C,i"

            caseof 84 :code$="B,A, "

            caseof 85 :code$="B,A,i"

            caseof 86 :code$="B,A,C"

            caseof 88 :code$="A,B,C"

            caseof 92 :code$="A,B, "

            caseof 93 :code$="A,B,i"

            caseof 99 :code$="C,B,A"

            caseof 101:code$="C,B,i"

            caseof 103:code$="C,B, "

            caseof 105:code$="C,A, "

            caseof 107:code$="C,A,B"

            caseof 109:code$="C,A,i"

            caseof 117:code$="B,C,i"

            caseof 118:code$="B,C,A"

            caseof 119:code$="B,C, "

        endif

        otherwise
        print "ERROR! ":sound 2000,20

    endselect

    print code$

ENDWHILE

count&=0
waitinput 2000
goto "Nochmal"