;Galgenmännchen - von Thomas Decker - begonnen 16.9.2005
Const xr = 800, yr = 600, fps = 60
Graphics xr, yr, 16, 2
AppTitle("Galgenmännchen")
SetBuffer BackBuffer()


bchar0_font = LoadFont("Arial", 16, 1)
bchar1_font = LoadFont("Arial", 24, 1)
pfeil0_font = LoadFont("Arial", 30, 0)
pfeil1_font = LoadFont("Arial", 30, 1)
haupt_font = LoadFont("Arial", 32, 1)





   ;Begriff auswürfeln
   SeedRnd MilliSecs()
   Restore Begriffe
      Read anz
      b = Rand(1, anz)
      For i = 1 To b
         Read Begriff$
      Next
      Begriff$ = Upper(Begriff$)
      wl = Len(Begriff$)
   
   Dim beg_chars$(wl)
   For i = 1 To wl
   If Asc(Mid$(Begriff$, i, 1)) >= 65 And Asc(Mid$(Begriff$, i, 1)) <= 90 Then
      beg_chars$(i) = "_"
   Else
      beg_chars$(i) = Mid$(Begriff$, i, 1)
   End If
   Next
   
   
   







   

   cg = 50    ;Abstand der Buchstaben in der ABC-leiste
   cab = 35   ;Abstand der Buchstaben in der Hauptleiste
   s = 0      ;wird zum scrollen der ABC-Leiste benötigt
   l = 65      ;und das wird auch zum scrollen der ABC-Leiste benötigt


   
   Global mouse_x, mouse_y   
   fpsTimer = CreateTimer(fps)
   Repeat
   
      mouse_x = MouseX()
      mouse_y = MouseY()


   b_scrollleft = clickedInRect(b_scrollleft, 0, yr - cg, cg, yr)
   b_scrollright = clickedInRect(b_scrollright, xr - cg, yr - cg, xr, yr)
   
   
   If b_scrollleft > 0 Then s = s + 5: If s > cg Then s = s - cg: l = l - 1: If l < 65 Then l = 90
   If b_scrollright > 0 Then s = s - 5: If s < 0 Then s = cg + s: l = l + 1: If l > 90 Then l = 65
   
   
   
   

   Cls
      
      ;Scrollen
      Color 100, 100, 100
      If b_scrollleft = 1 Then SetFont pfeil1_font Else SetFont pfeil0_font
      Text (cg - StringWidth("<")) / 2, yr - cg + (cg - StringHeight("3"))/2, "<"
      If b_scrollright = 1 Then SetFont pfeil1_font Else SetFont pfeil0_font
      Text xr - cg + (cg - StringWidth(">")) / 2, yr - cg + (cg - StringHeight(">"))/2, ">"
      

      


   
   ;Die Hauptleiste anzeigen
   Color 255, 255, 255
   SetFont haupt_font
   For i = 1 To wl
      ;Rect (xr - cab * wl) / 2 + (i - 1) * cab, yr - cg * 2, cab, cab, 0
      Text (xr - cab * wl) / 2 + (i - 1) * cab + (cab - StringWidth("_")) / 2, yr - cg * 2, beg_chars$(i)
   Next

   
   c = l
   wahl = 0
   
   ;Eingabe durch Maus (ABC-Leiste)
   For i = 2 To ((xr / cg) - 2)
      If c > 90 Then c = 65
      If c < 65 Then c = l
      ;Rect  (i - 1) * cg+s, yr - cg, cg, cg, 0
      Color 255, 255, 255
      SetFont bchar0_font
      If mouseInRect ((i - 1) * cg + s, yr - cg, i * cg + s, yr) Then
         ;Rect (i - 1) * cg + s, yr - cg, cg, cg, 0
         b_char = clickedInRect(b_char, (i - 1) * cg + s + 1, yr - cg, i * cg + s - 1, yr)
         If b_char = 1 Then SetFont bchar1_font: ib = i
         If b_char = 3 And ib = i Then wahl = c
      End If
      Text (i - 1) * cg + (cg - StringWidth(Chr$(c))) / 2 + s, yr - cg + (cg - StringHeight(Chr$(c))) / 2, Chr$(c)
      c = c + 1
   Next
   
   
   ;Eingabe durch Tasten
   t = GetKey()
   If t > 0 Then    taste$ = Upper$(Chr$(t)): t = Asc(taste$)
   If t >= 65 And t <=90 Then wahl = t
   
   ;Wenn der Spieler einen Buchstaben gewählt hat
   If wahl > 0 Then
      For i = 1 To wl
         If Mid$(Begriff$, i, 1) = Chr$(wahl) Then beg_chars$(i) = Chr$(wahl)
      Next
   End If
   
   
   ;Check auf win
   gewonnen = True
   For i = 1 To wl
      If Mid$(Begriff$, i, 1) <> beg_chars$(i) Then gewonnen = False: Exit
   Next
      

   

   Flip(0)
   WaitTimer(fpsTimer)
   
   Until KeyDown(1) Or gewonnen
   
   
   
   
   ;Gewinnanimation
   If gewonnen Then
         ;rocket(1, 1) = 400 ;pos
         ;rocket(1,2) = 500   ;pos
         ;rocket(1,3) = 20 ;Sprungkraft
         ;rocket(1,4) = -2 ;seitwärts
         ;rocket(1,5) = 1 ;Fallkraft
      Dim rocket(wl, 5)
      For i = 1 To wl
         rocket(i, 1) = (xr - cab * wl) / 2 + (i - 1) * cab + (cab - StringWidth("_")) / 2
         rocket(i, 2) =  yr - cg * 2
         rocket(i, 3) = Rand(20, 50)
         rocket(i, 4) = 10 - Rand(20)
         rocket(i, 5) = Rand(1, 3)
      Next
      

      SetFont haupt_font
      Repeat
   
         Cls
            f = 0
            For i = 1 To wl
            rocket(i,1) = rocket(i,1) + rocket(i,4)
            rocket(i,2) = rocket(i,2) - rocket(i,3)
            rocket(i,3) = rocket(i,3) - rocket(i,5)
            Text rocket(i, 1), rocket(i, 2), beg_chars$(i)
            If rocket(i, 2) > yr Then f = f + 1
            Next
            
            ;Text 0,0, f + "," + wl
      
         Flip(0)
         WaitTimer(fpsTimer)
      
      Until KeyDown(1) Or f = wl
   
   End If



End






;Diese Funktion prüft, ob die Maus sich innerhalb des angegebenen Rechtecks befindet und liefert
;entsprechend true oder false zurück
Function mouseInRect (x1, y1, x2, y2)
   If mouse_x < x1 Then Return False
   If mouse_x > x2 Then Return False
   If mouse_y < y1 Then Return False
   If mouse_y > y2 Then Return False
   Return True
End Function


;Diese Funktion prüft, ob die Maus sich in einem Feld befindet(1), ob ein Mausknopf gedrückt ist(2) und
;ob der Mausknopf losgelassen wurde(3) (also, ob geklickt wurde)
Function clickedInRect (status, x1, y1, x2, y2, t = 1)
   If mouseInRect(x1, y1, x2, y2) Then
   
      If status = 0 Then
         If MouseDown(t) = 0 Then Return 1
         Return 0
      End If
      
      If status = 1 Then
         If MouseDown(t) = 1 Then Return 2
         Return 1
      End If
      
      If status = 2 Then
         If MouseDown(t) = 0 Then Return 3
         Return 2
      End If
      
   End If
   Return 0
End Function   








.Begriffe
;Begriffe müssen maximal 22 Zeichen lang, da sie sonst über den Bildschirmrand hinausragen
;Die erste Data-zeile gibt an, wieviele Begriffe es gibt
Data 5
Data "Flaschenzug"
Data "Hundekuchen"
Data "Zimtstange"
Data "Scrubs - Die Anfaenger"
Data "Spongebob Schwammkopf"

Graphics 400,300,16,2
SetBuffer BackBuffer()
ClsColor 128,128,128

;deklinieren...
Type TLoesung
   Field Buchstabe.TBuchstabe
   Field gesammt
End Type

Type TBuchstabe
   Field letter$
   Field erraten
End Type

Global Loesung.TLoesung = New TLoesung

Global Arial_gross = LoadFont("Arial",32,1)
Global Arial_klein = LoadFont("Arial",16)
Global dick = LoadFont("Arial",48,1)

Global key$
Global aktiv

menue
;************************************************MENUE
Function menue()
ClsColor 128,128,128
Color 255,255,255
Repeat
Cls

If status=0 Then summand=summand+1
If summand > 255 Then status=1
If status=1 Then summand=summand-1
If summand < 1 Then status=0

SetFont Arial_Gross
If button=1 Then Color 255,255,0
Text 200,75,"Start",1,1
Color 255,255,255
If button=2 Then Color 50,0,255
Text 200, 150, "Anleitung",1,1
Color 255,255,255
If button=3 Then Color 128,0,128
Text 200, 225, "Beenden",1,1
Color 255,255,255

SetFont dick
Text 200,20,"Galgenmännchen",1,1

For i=0 To 3
If button=1 Then Color 0+summand,0,0
Line 50,50+i,350,50+i
If button=1 Then Color 0,0+summand,0
Line 50+i,50,50+i,100
If button=1 Then Color 0,0,0+summand
Line 50,100+i,350,100+i
If button=1 Then Color 0+summand,0,0+summand
Line 350-i,50,350-i,100
Color 255,255,255

If button=2 Then Color 0+summand,0+summand,0
Line 50,125+i,350,125+i
If button=2 Then Color 0,0+summand,0+summand
Line 50+i,125,50+i,175
If button=2 Then Color 0+summand,0,0+summand
Line 50,175+i,350,175+i
If button=2 Then Color 0+summand,0,0
Line 350-i,125,350-i,175
Color 255,255,255

If button=3 Then Color 0+summand,0,0+summand
Line 50,200+i,350,200+i
If button=3 Then Color 0,0,0+summand
Line 50+i,200,50+i,250
If button=3 Then Color 0+summand,50,0
Line 50,250+i,350,250+i
If button=3 Then Color 50,0+summand,50
Line 350-i,200,350-i,250
Color 255,255,255
Next

button=0
If MouseX()> 50 And MouseX()<350 Then
If MouseY()> 50 And MouseY()<100 Then button=1
If MouseY()>125 And MouseY()<175 Then button=2
If MouseY()>200 And MouseY()<250 Then button=3
EndIf

If MouseHit(1) Then
If button=1 Then spiel
If button=2 Then anleitung
If button=3 Then End
EndIf

Delay(25)
Flip
Forever
End Function
;************************************************
Function anleitung()
End Function
;************************************************
Function verloren()
Repeat
Cls

SetFont Arial_Gross
Text 200, 25, "Galgenmännchen",1,1
SetFont Arial_klein
Text 200, 135, "Verloren!",1,1
SetFont Arial_Gross
buchstabieren(220,12,1)

Flip
Forever
End Function
;************************************************
Function gewonnen()

Repeat
Cls

SetFont Arial_Gross
Text 200, 25, "Galgenmännchen",1,1
SetFont dick
Text 200, 135, "GEWONNEN!",1,1
SetFont Arial_Gross
buchstabieren(260,10,2)

If button=1 Then Color 0,0,0
SetFont arial_klein
Text 200,195,"Zum Menü",1,1
For i=0 To 1
Line 100,180+i,300,180+i
Line 100+i,180,100+i,210
Line 100,210+i,300,210+i
Line 300+i,210,300+i,180
Next
Color 255,255,255

button=0
If MouseX()>100 And MouseX()<300 And MouseY()>180 And MouseY()<210 Then button=1
If MouseHit(1) And button=1 Then menue

Flip
Forever

End Function
;************************************************Eingabefunktion
Function eingabe()
If KeyHit(30) Then Key$="A":aktiv = 1 ;A
If KeyHit(48) Then Key$="B":aktiv = 1 ;B
If KeyHit(46) Then Key$="C":aktiv = 1 ;C
If KeyHit(32) Then Key$="D":aktiv = 1 ;D
If KeyHit(18) Then Key$="E":aktiv = 1 ;E
If KeyHit(33) Then Key$="F":aktiv = 1 ;F
If KeyHit(34) Then Key$="G":aktiv = 1 ;G
If KeyHit(35) Then Key$="H":aktiv = 1 ;H
If KeyHit(23) Then Key$="I":aktiv = 1 ;I
If KeyHit(36) Then Key$="J":aktiv = 1 ;J
If KeyHit(37) Then Key$="K":aktiv = 1 ;K 
If KeyHit(38) Then Key$="L":aktiv = 1 ;L
If KeyHit(50) Then Key$="M":aktiv = 1 ;M
If KeyHit(49) Then Key$="N":aktiv = 1 ;N
If KeyHit(24) Then Key$="O":aktiv = 1 ;O
If KeyHit(25) Then Key$="P":aktiv = 1 ;P
If KeyHit(16) Then Key$="Q":aktiv = 1 ;Q
If KeyHit(19) Then Key$="R":aktiv = 1 ;R
If KeyHit(31) Then Key$="S":aktiv = 1 ;S
If KeyHit(20) Then Key$="T":aktiv = 1 ;T
If KeyHit(22) Then Key$="U":aktiv = 1 ;U
If KeyHit(47) Then Key$="V":aktiv = 1 ;V
If KeyHit(17) Then Key$="W":aktiv = 1 ;W
If KeyHit(45) Then Key$="X":aktiv = 1 ;X
If KeyHit(44) Then Key$="Y":aktiv = 1 ;Y
If KeyHit(21) Then Key$="Z":aktiv = 1 ;Z
End Function
;**********************************************Männchen zeichnen
Function zeichnen(menge)

If menge > 0 Then Rect 100,65,10,200   ;senkrechter Balken
If menge > 1 Then Rect 100, 65, 100, 10   ;horizontaler Balken
If menge > 2 Then                   ;Querverstärkung
For i = 0 To 5
Line 110, 100+i, 135+i, 75
Next
EndIf 
If menge > 3 Then Line 190,75,190,100   ;Seil
If menge > 4 Then Oval 175,100,30,30,0   ;Kopf
If menge > 5 Then Line 190,130,190,200   ;Torso
If menge > 6 Then Line 190,200,170,220   ;Bein links
If menge > 7 Then Line 190,200,210,220   ;Bein rechts
If menge > 8 Then Line 190,140,175,160    ;Arm links
If menge > 9 Then Line 190,140,205,160   ;Arm rechts

End Function
;**********************************************Zentriert buchstabieren
Function buchstabieren(y,abstaende,modus)

start_pos = GraphicsWidth()/2-(Loesung\gesammt*8+abstaende*(Loesung\gesammt-1))/2;Errechnet den Startpunkt, um zu zentrieren

For Loesung\Buchstabe = Each TBuchstabe                              ;Nun die verschiedenen Modi:
If modus=1 And Loesung\Buchstabe\erraten = 0 Then Color 255,0,0            ;Nicht erkannte Buchstaben markieren
If modus=2 Or modus=1 Then Text start_pos+(8+abstaende)*i,y, Loesung\Buchstabe\letter$   ;Einfache Ausgabe
If modus=3 Then                                              ;Strichemodus
If Loesung\Buchstabe\erraten=0 Then
Text start_pos+(8+abstaende)*i,y, "_"
Else Text start_pos+(8+abstaende)*i,y, Loesung\Buchstabe\letter$
EndIf
EndIf
i=i+1
Color 255,255,255
Next

End Function
;**********************************************************************************
;***************************----HAUPT FUNKTION----*********************************
;**********************************************************************************
Function spiel()
ClsColor 128,128,128
Color 255,255,255
;-----------------------------------------------------------------|Vorbereitung
Repeat                       ;Lösungswort eintippen
Cls

SetFont Arial_Gross               ;Ein paar Texte
Text 200, 25, "Galgenmännchen",1,1
SetFont Arial_klein
Text 200, 130, "Bitte Lösungswort eingeben:",1,1
buchstabieren(180,1,2); <----------------------------Der ist wichtig
Text 200, 280, "Mit ENTER bestätigen",1

eingabe                  ;Tastendruck wird verwertet
                        
If aktiv = 1 And Loesung\gesammt <= 15 Then   ;Wenn die Taste gedrückt wurde...
Loesung\Buchstabe = New TBuchstabe;...erstelle einen neuen Buchstaben,... 
Loesung\Buchstabe\letter$ = Key$;...weiße ihm Werte zu...
Loesung\gesammt = Loesung\gesammt+1;...und setze den Index
aktiv = 0
EndIf

If KeyHit(14) Then          ;Die Rücktaste
Loesung\Buchstabe = Last TBuchstabe
Delete Loesung\Buchstabe
Loesung\gesammt = Loesung\gesammt-1
EndIf

Flip
Until KeyHit(28)

Key = ""
aktiv = 1
;-------------------------------------------------------------------| Nun zur eigentlichen Hauptschleife
Repeat
Cls

If KeyDown(59) Then Modus=1            ;Modus wechseln falls vertippt
If KeyDown(59)=0 Then Modus=3

SetFont Arial_Gross                  ;Zeugs texten
Text 200, 25, "Galgenmännchen",1,1
SetFont dick
Text 380,255,Key$,1
SetFont Arial_Gross
buchstabieren(265,12,modus)

If KeyHit(28) And Key$ <> "" Then      ;Ein Buchstabe wurde genannt
treffer=0                        ;Noch kein Buchstabe richtig^^
sieg=1                           ;Vorläufiger Sieg, wird allerdings meistens wieder aberkannt
For Loesung\Buchstabe = Each TBuchstabe   ;Jeder Buchstabe wird geprüft
If Loesung\Buchstabe\letter$ = Key$ Then Loesung\Buchstabe\erraten=1:treffer=1;Sollte er stimmen, wird das gemeldet
If Loesung\Buchstabe\erraten=0 Then sieg=0;Wenn nur EIN Buchstabe nicht stimmt, wird der Sieg aberkannt
Next
If treffer=0 Then fehler=fehler+1      ;Sollte kein Buchstabe stimmen, wird ein Fehler gemeldet
If sieg=1 Then gewonnen               ;Sollte der Sieg NICHT aberkannt werden, wird er *ähem* ANERKANNT :D
key$=""
EndIf

If fehler > 9 Then verloren
eingabe
zeichnen(fehler)

Flip
Forever

End Function