Return 1

Repeat
zeichnen
If zeichnen=1 Then Exit
einwerfen
bgfarbe
Until KeyHit(1)
Goto label1

End

Repeat
i = zeichnen()
If i=1 Then Exit
einwerfen()
bgfarbe()
Until KeyHit(1)
Goto label1

End

Global z=70 ;Maßstab bitte immer in 10er schritten wählen (original=50) funktioniert ab 6, sinnvoll ist über 10
Global f=16 ;Farbtiefe
Global w=2  ;fenster grösse 1 vollbild,2 feste grösse und 3 flexibel (original 2)
Global win = 4   ;gewinnbedingung (original 4)
Global sp_anz=5 ;spieler anzahl (original 2) bei zu vielen müssen in col1 und col2 farben angelegt werden
Global s=7 ;spalten (vertikal) (original 7)
Global r=6 ;reihen (horizontal) (original 6)
Dim gl(3) ;Stufen für das "glühen"
gl(1)=2 ;Stufe 1 -> Hintergrund Fraben (original 2-> ca.1% farbwert wechsel)
gl(2)=7 ;Stufe 2 -> Spielfeld (original 7-> ca.3% farbwert wechsel)
gl(3)=20 ;Stufe 3 -> Chips (original 20-> ca.13% farbwert wechsel)
.neustart ;sprungmarke für den neustart
Dim set(8) ;einstellungsvariablen werden zur einfacheren bearbeitung in ein array kopiert
Dim set_t$(8) ;einstellungsbezeichnungen werden zur einfacheren bearbeitung in ein array kopiert
set(1)=z
set(2)=win
set(3)=sp_anz
set(4)=s
set(5)=r
set(6)=gl(1)
set(7)=gl(2)
set(8)=gl(3)
set_t(1)="Zoomfaktor: "
set_t(2)="Gewinnbedingung: "
set_t(3)="Spielerzahl: "
set_t(4)="Anzahl Spalten: "
set_t(5)="Anzahl Zeilen: "
set_t(6)="Glühen Hintergr.: "
set_t(7)="Glühen Spielfeld: "
set_t(8)="Glühen Chips: "

;Voreinstellungen werden abgefragt
Graphics 640,480,15,2
AppTitle win + " in einer reihe"
fontvariable =LoadFont("Times New Roman",20,False,False,False)
SetFont fontvariable
einstellungen()
Repeat
   If MouseHit(1) Then
      For j=1 To 8 
         If RectsOverlap(MouseX(),MouseY(),1,1,195,10+((j-1)*20),20,20) Then set(j)=set(j)+1
         If RectsOverlap(MouseX(),MouseY(),1,1,245,10+((j-1)*20),20,20) Then set(j)=set(j)-1
      Next
      If RectsOverlap(MouseX(),MouseY(),1,1,100,200,120,30) Then Exit
      einstellungen() 
   EndIf
Until KeyHit(1)
;veränderte werte aus dem hilfsarray werden zurück kopiert:
z=set(1)
win=set(2)
sp_anz=set(3)
s=set(4)
r=set(5)
gl(1)=set(6)
gl(2)=set(7)
gl(3)=set(8)
   
Dim sp_val(sp_anz) ;array für die feldwerte der spieler
For i = 1 To sp_anz sp_val(i)=win*sp_val(i-1)+1 Next ;die werte der spieler werden aus spieleranzahl und gewinnbedingung berechnet
Dim sp_feld(s,r) ;spielfeld array (feld 0 wird ignoriert)
Dim hilf(win,2) ;array für die "gewinnkoordinaten"
Global gewinner=0 ;gewinn variabel
Global sp_nr=1 ;spieler variabel(gesetzt für nr 1)
Global farb_s=6 ;anzahl der Farbstufen
Dim fw(farb_s,3) ;Stufen für die gebräuchlichsten Farbwerte (8-Bit/RGB)
For i=1 To farb_s  fw(i,0)=(i-1)*Int(255/farb_s) Next:fw(farb_s,0)=255
   
Graphics ((s+2)*z),((r+2)*z),f,w ;Fenstergroesse wird aus Spalten,Zeilen und Maßstab berechnet...
SetBuffer BackBuffer()
AppTitle win + " in einer reihe"
fontvariable =LoadFont("Times New Roman",(z/2),False,False,False)
SetFont fontvariable
 
;die Hauptschleife:
Repeat
   If zeichnen()=1 Then Exit
   ;If zeichnen=1 Then Exit
   einwerfen()
   bgfarbe()
Until KeyHit(1)
Goto neustart

End


Function zeichnen()
   blau2():Text (z),(z/3), "Es gewinnt wer zuerst eine reihe aus " + win + " Feldern bildet"
   blau1():Rect z,z,(s*z+(z/10.0)),(r*z+(z/10.0))
   For x = 1 To s 
      For y = 1 To r
         blau2()
         Rect x*z+(z/50.0*3.66),y*z+(z/50.0*3.66),(z/5.0*4.7),(z/5.0*4.7)
         blau3()
         Oval x*z+(z/50.0*3.66),y*z+(z/50.0*3.66),(z/10.0*9),(z/10.0*9)
         gruen1()
         Oval x*z+(z/50.0*9),y*z+(z/50.0*9),(z/10.0*7),(z/10.0*7) 
         For i = 1 To sp_anz
            If sp_feld(x,y) = sp_val(i) Then
               col1(i):Oval x*z+(z/50.0*9),y*z+(z/50.0*9),(z/10.0*7),(z/10.0*7)
               col2(i):Oval x*z+(z/50.0*14),y*z+(z/50.0*14),(z/2.0),(z/2.0)
            EndIf
         Next
      Next
   Next
   If gewinner=0 Then
      For j = 1 To sp_anz
         If sp_nr=j Then col1(j):Text (z),(z*(r+1)+z/3), "Spieler "+ sp_nr +" ist an der Reihe"
      Next
   Else
      ;gewonnen()
      If gewonnen()=1 Then Return 1
   EndIf

End Function

;auf einen korrekten Spielzug warten und Speichern
Function einwerfen()
If MouseHit(1) And MouseX()> z  And MouseX()< z*(s+1) Then
      For x = 1 To s 
         If RectsOverlap(MouseX(),MouseY(),1,1,(x*z),0,(z/10.0*9),(z*s)) Then
            For y = r To 1 Step -1
               If sp_feld(x,y) = 0 Then
                  sp_feld(x,y) = sp_val(sp_nr):pruefen():Exit
               EndIf 
            Next
         EndIf
      Next
   EndIf
End Function

;Pruefen ob jemand gewonnen hat
Function pruefen()   
   For y= 1 To r
      If gewinner <>0 Then Exit
      For x = 1 To (s-win+1)
         If gewinner <>0  Then Exit ;zeilen horizontal 
         If x<(s-win+1) Then
            If gewinner <>0  Then Exit
            sum_spalte=0
            For i = 0 To (win-1) sum_spalte = sum_spalte + sp_feld((x+i),y):hilf(i+1,1)=(x+i):hilf(i+1,2)=y:Next
            pruef(sum_spalte)
         EndIf
         If gewinner <>0 Then Exit ;spalten vertikal
         If y< (s-win+1) Then
            If gewinner <>0  Then Exit
            sum_spalte=0
            For i = 0 To (win-1) sum_spalte = sum_spalte + sp_feld(x,(y+i)):hilf(i+1,1)=x:hilf(i+1,2)=(y+i): Next
            pruef(sum_spalte)
         EndIf
         If gewinner <>0 Then Exit ;zeilen diagonal
         If y <= (r-win+1) And x <= (s-win+1) Then
            If gewinner <>0 Then Exit
            sum_spalte=0
            For i = 0 To (win-1) sum_spalte = sum_spalte + sp_feld((x+i),(y+i)):hilf(i+1,1)=(x+i):hilf(i+1,2)=(y+i): Next
            pruef(sum_spalte)
            If gewinner <>0 Then Exit
            sum_spalte=0
            For i = 0 To (win-1) sum_spalte = sum_spalte + sp_feld((s+1-x-i),(y+i)):hilf(i+1,1)=(s+1-x-i):hilf(i+1,2)=(y+i): Next
            pruef(sum_spalte)
         EndIf       
      Next
   Next   
   If gewinner=0 Then
      If sp_nr < sp_anz Then
         sp_nr=sp_nr+1
      Else
         sp_nr=1
      EndIf
   EndIf     
End Function

;Ausgegliederte unterfunktion zum pruefen wer hat gewonnen
Function pruef(sum_spalte)
   For j = 1 To sp_anz
      If sum_spalte=win*sp_val(j) Then gewinner=j:Exit
   Next
End Function

;Ausgabe wer gewonnen hat und neustart
Function gewonnen()
   For i = 1 To sp_anz
      If gewinner=i Then
         col1(i):Text (z),(z*(r+1)+z/3), "Spieler "+ sp_nr +" hat gewonnen"
         For x = 1 To s
            For y = 1 To r
               For j=1 To win
                  If x=hilf(j,1) And y=hilf(j,2) Then
                     col1(i):Oval x*z+(z/50.0*21.5),y*z+(z/50.0*21.5),(z/10.0*2),(z/10.0*2)
                  EndIf
               Next
            Next
         Next
      EndIf
   Next
   If MouseHit(1) Then
      sp_nr=1
      gewinner=0
      Dim sp_feld(s,r)
      Return 1
   EndIf
   ;gew_hilf
   
End Function

;hilfsfunktionen
;Namen fuer die standardfarben als funktionen:
Function blau1()
   Color glow(1,2),glow(1,2),glow(6,2)
End Function

Function blau2()
   Color glow(1,2),glow(1,2),glow(4,2)
End Function

Function blau3()
   Color glow(1,2),glow(1,2),glow(2,2)
End Function

Function bgfarbe()
   Flip 0
   ClsColor glow(1,1),glow(4,1),glow(1,1)
   Cls
End Function
   
Function gruen1()
   Color glow(1,1),glow(3,1),glow(1,1)
End Function

Function col1(i)
If i=1 Then Color glow(6,3),glow(1,3),glow(1,3)
If i=2 Then Color glow(5,3),glow(6,3),glow(1,3)
If i=3 Then Color glow(1,3),glow(6,3),glow(1,3)
If i=4 Then Color glow(1,3),glow(5,3),glow(6,3)
If i=5 Then Color glow(1,3),glow(1,3),glow(6,3)
If i=6 Then Color glow(6,3),glow(1,3),glow(5,3)
If i>6 Then Color Rnd(0,255),Rnd(0,255),Rnd(0,255)
End Function

Function col2(i)
If i=1 Then Color glow(4,3),glow(1,3),glow(1,3)
If i=2 Then Color glow(3,3),glow(4,3),glow(1,3)
If i=3 Then Color glow(1,3),glow(4,3),glow(1,3)
If i=4 Then Color glow(1,3),glow(3,3),glow(4,3)
If i=5 Then Color glow(1,3),glow(1,3),glow(4,3)
If i=6 Then Color glow(4,3),glow(1,3),glow(3,3)
If i>6 Then Color Rnd(0,255),Rnd(0,255),Rnd(0,255)
End Function

Function glow(i,j)
   ;i=farbintensität j=glühstärke
   If fw(i,0)=0 Then fw(i,j)=(Rnd((fw(i,0)),(fw(i,0)+gl(j)))) 
   If fw(i,0)=255 Then fw(i,j)=(Rnd((fw(i,0)-gl(j)),(fw(i,0))))
   If fw(i,0)>0 And fw(i,0)<255 Then fw(i,j)=(Rnd((fw(i,0)-gl(j)/2),(fw(i,0)+gl(j)/2)))
   Return(fw(i,j))
End Function

Function gew_hilf()
   fontvariable =LoadFont("Times New Roman",15,False,False,False)
   SetFont fontvariable
   For i=1 To win
      Color 125,0,0: Text 10,i*25," "+ i + ": x=" + hilf(i,1) + " y=" + hilf(i,2) + " wert=" + sp_feld((hilf(i,1)),(hilf(i,2)))
   Next
   fontvariable =LoadFont("Times New Roman",(z/2),False,False,False)
   SetFont fontvariable
End Function

Function einstellungen()
   Flip 0
   ClsColor 0,150,0
   Cls
   For i =1 To 8
      Color(255,255,255):Rect 195,10+((i-1)*20),20,20:Rect 245,10+((i-1)*20),20,20
      Color(0,0,0):Text 10,10+((i-1)*20), "" + set_t(i) + set(i):Text 200,10+((i-1)*20),"+":Text 250,10+((i-1)*20),"-"
   Next
   Color(255,0,0):Rect 100,200,120,30
   Color(0,0,0):Text 110,205, "Spiel Starten: "
End Function