;Stapeln Revolution!

;Gossi-Soft
;sir_gossi@freenet.de

;Spielregeln.
;Chips müssen einen Stein überspringen, um dahinter auf einem anderen Stein zu landen.
;Drei übereinander gestapelte Steine sind Jumper. Sie können 2 Felder überspringen, vorausgesetzt,
;dass mindestens eins dieser Felder ein Chip ist. Das geht nicht, falls eins der beiden Felder ei
;Stein ist. Vier gestapelte Chips sind ein Tower. Tower können ebenfalls 2 Felder überspringen,
;solange kein Stein dabei ist und mindestens ein Chip. Ein Chip, der von einem Tower übersprungen
;wird, wird zerstört. Fünf gestapelte Chips ergeben einen Power-Tower. Er kann sich nur noch ein Feld
;weiter bewegen und zerstört sich selbst, und alle umliegenden Chips mit sich. Sechs gestapelte
;Chips ergeben einen Hyper-Tower, der nach einem weiteren Feld alle angrenzenden und deren angrenzen-
;den Chips zerstört, bis auf die Steine.


;BB-User-Freundlich:
Const DEACTIVATE_FILE_OPERATIONS_FOR_BB_FORUM_ONLINE_TESTS=True


Graphics 1024,768,16,1
SetBuffer BackBuffer()
AppTitle "Stapeln"
SeedRnd MilliSecs()


Global bestpoints
Global bestplayer$

ShowInfos()


Const BLOCK_SIZE=32
Const AREA_WIDTH=1024/BLOCK_SIZE
Const AREA_HEIGHT=768/BLOCK_SIZE

Dim area(AREA_WIDTH-1,AREA_HEIGHT-1)
Dim chips(AREA_WIDTH-1,AREA_HEIGHT-1)

Const GENERATOR_ROUNDS=7
Const GENERATOR_WAIT=500
Const GENERATOR_RANDOM=15
ShowStoneGenerator()

Function GenerateStones()
	Dim area(AREA_WIDTH-1,AREA_HEIGHT-1)
	Local xx,yy
	For xx=0 To AREA_WIDTH-1
		For yy=0 To AREA_HEIGHT-1
			Local setStone=Rand(1,GENERATOR_RANDOM)
			If setStone=1 area(xx,yy)=True
		Next
	Next
End Function

Function ShowStoneGenerator()
	Local rounds
	For rounds=1 To GENERATOR_ROUNDS
		GenerateStones()
		Cls
		ShowArea()
		Flip
		Delay GENERATOR_WAIT
		If KeyHit(1) End
	Next
End Function

Function DrawChip(kind,x,y)
	Local OFS#=BLOCK_SIZE/5
	Select kind
		Case SIZE_CHIP
			Color 0,100,0
			Rect x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
		Case SIZE_BIG_CHIP
			Color 0,100,0
			Rect x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 0,250,0
			Rect x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,0
		Case SIZE_JUMPER
			Color 0,100,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 0,250,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,0
		Case SIZE_TOWER
			Color 150,150,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 250,250,0
			Oval x+OFS-1,y+OFS-1,BLOCK_SIZE-2*OFS+2,BLOCK_SIZE-2*OFS+2,0
		Case SIZE_POWER_TOWER
			Color 200,200,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 200,0,0
			Oval x+OFS-1,y+OFS-1,BLOCK_SIZE-2*OFS+2,BLOCK_SIZE-2*OFS+2,0
		Case SIZE_HYPER_TOWER
			Color 200,200,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 200,0,0
			Oval x+OFS-1,y+OFS-1,BLOCK_SIZE-2*OFS+2,BLOCK_SIZE-2*OFS+2,0
			Rect x+BLOCK_SIZE/2-1,y+OFS,2,BLOCK_SIZE-2*OFS,1
			Rect x+OFS,y+BLOCK_SIZE/2-1,BLOCK_SIZE-2*OFS,2,1
		Default
			Color 200,200,0
			Oval x+OFS,y+OFS,BLOCK_SIZE-2*OFS,BLOCK_SIZE-2*OFS,1
			Color 200,0,0
			Oval x+OFS-1,y+OFS-1,BLOCK_SIZE-2*OFS+2,BLOCK_SIZE-2*OFS+2,0
			Rect x+BLOCK_SIZE/2-1,y+OFS,2,BLOCK_SIZE-2*OFS,1
			Rect x+OFS,y+BLOCK_SIZE/2-1,BLOCK_SIZE-2*OFS,2,1
	End Select
End Function

Function ShowArea()
	Local xx,yy
	For xx=0 To AREA_WIDTH-1
		For yy=0 To AREA_HEIGHT-1
			If area(xx,yy)
				Color(200,100,0)
				Rect(xx*BLOCK_SIZE,yy*BLOCK_SIZE,BLOCK_SIZE,BLOCK_SIZE,1)
			EndIf
			If chips(xx,yy)
				DrawChip(chips(xx,yy),xx*BLOCK_SIZE,yy*BLOCK_SIZE)
			EndIf
		Next
		Color 100,100,100
		Rect xx*BLOCK_SIZE,0,1,768,1
	Next
	Color 100,100,100
	For yy=0 To AREA_HEIGHT-1
		Rect 0,yy*BLOCK_SIZE,1024,1,1
	Next
End Function

ShowChipGenerator()
Const CHIP_ROUNDS=(AREA_WIDTH*AREA_HEIGHT)/2
Const CHIP_WAIT=30
Const CHIPS_PER_ROUND=10

Function GenerateChips()
	Local perRound
	For perRound=1 To CHIPS_PER_ROUND
		Repeat
			Local chipX=Rand(0,AREA_WIDTH-1)
			Local chipY=Rand(0,AREA_HEIGHT-1)
			If area(chipX,chipY)=False And chips(chipX,chipY)=False
				chips(chipX,chipY)=SIZE_CHIP
				Exit
			EndIf
		Forever
	Next
End Function

Function ShowChipGenerator()
	Dim chips(AREA_WIDTH-1,AREA_HEIGHT-1)
	Local rounds
	For rounds=1 To CHIP_ROUNDS Step CHIPS_PER_ROUND
		GenerateChips()
		Cls
		ShowArea()
		Flip
		Delay CHIP_WAIT
		If KeyHit(1) End
	Next
End Function


Const EFF_POWER=50
Const EFF_LENGTH=200
Const EFF_RANDOM=300


Const SIZE_CHIP=1
Const SIZE_BIG_CHIP=2
Const SIZE_JUMPER=3
Const SIZE_TOWER=4
Const SIZE_POWER_TOWER=5
Const SIZE_HYPER_TOWER=6


Const REL_VERTIKAL=0
Const REL_HORIZONTAL=1
Const REL_DIAGONAL=2
Const REL_DEFAULT=3

;Prüft, ob zwei Steine gerade oder diagonal zueinander liegen.
Function CheckChipRelation(x1,y1,x2,y2)
	If x1=x2 Return REL_VERTIKAL
	If y1=y2 Return REL_HORIZONTAL
	If Abs(x1-x2)=Abs(y1-y2) Return REL_DIAGONAL
	Return REL_DEFAULT
End Function

;Gibt die Steine an, die sich gerade oder diagonal zwischen zwei Steinen befinden.
;Es wird vorausgesetzt, dass die beiden Steine gerade oder diagonal zueinander liegen.
;Gibt die genaue Information aus.
Function GetStoneDifference(x1,y1,x2,y2)
	Local relation=CheckChipRelation(x1,y1,x2,y2)
	Select relation
		Case REL_HORIZONTAL Return Abs(x1-x2)-1
		Case REL_VERTIKAL Return Abs(y1-y2)-1
		Case REL_DIAGONAL Return Abs(x1-x2)-1
	End Select
End Function

;Speichert in den Globalen x und y eines 2-Felder-Abstandes.
;Setzt eine gültige Relation der beiden Randsteine voraus.
;Es wird ebenfals vorausgesetzt, dass es sich um einen 2er-
;Abstand handelt.
Global between1_x,between1_y
Global between2_x,between2_y
Function GetBetweenPositions(x1,y1,x2,y2)
	Local rel=CheckChipRelation(x1,y1,x2,y2)
	Local smaller_x
	Local smaller_y
	If x1<x2 smaller_x=x1 Else smaller_x=x2
	If y1<y2 smaller_y=y1 Else smaller_y=y2
	If rel=REL_HORIZONTAL
		between1_y=y1
		between2_y=y2
		between1_x=smaller_x+1
		between2_x=smaller_x+2
	ElseIf rel=REL_VERTIKAL
		between1_x=x1
		between2_x=x2
		between1_y=smaller_y+1
		between2_y=smaller_y+2
	ElseIf rel=REL_DIAGONAL
		between1_x=smaller_x+1
		between2_x=smaller_x+2
		Local y_right,y_left
		If x1<x2 y_left=y1 y_right=y2 Else y_left=y2 y_right=y1
		If y_right<y_left	;Nach oben rechts.
			between1_y=y_left-1
			between2_y=y_left-2
		Else	;Nach unten rechts.
			between1_y=y_left+1
			between2_y=y_left+2
		EndIf
	EndIf
End Function


Function ShowInfos()
	If DEACTIVATE_FILE_OPERATIONS_FOR_BB_FORUM_ONLINE_TESTS=False
	If FileType("Data.dat")
	Local high=ReadFile("Data.dat")
	bestplayer$=ReadString(high)
	bestpoints=ReadInt(high)
	CloseFile high
	EndIf
	EndIf
	Cls
	Color 170,170,0
	Text 10,10,"Willkommen, Freund, in STAPELN REVOLUTION"
	Text 10,30,"In Stapeln Revolution hast du die Kontrolle über ein Feld voll Stapelchips. Deine"
	Text 10,50,"Aufgabe ist es, so viele Stapelchips wie möglich übereinander zu stapeln oder zu"
	Text 10,70,"zerstören. Ziel ist es, dadurch das Spielfeld so weit es geht zu entleeren."
	Text 10,90,""
	Text 10,110,"Das Spiel wird hauptsächlich mit der Maus gespielt. Um einen Stapelchip zu"
	Text 10,130,"markieren, klicke mit der linken Maustaste auf ihn. Um die Markierung wieder"
	Text 10,150,"zu entfernen, klicke erneut mit der linken Maustaste auf ihn. Um den Chip an"
	Text 10,170,"eine andere Stelle springen zu lassen, klicke mit der linken Maustaste auf das"
	Text 10,190,"Zielfeld. Bedenke, dass jeder Chip eine andere Sprungreichweite hat. Klicke mit"
	Text 10,210,"der rechten Maustaste auf einen Chip, um Informationen über seine Sprungreich-"
	Text 10,230,"weite anzeigen zu lassen. Klicke Esc um das Spiel zu beenden."
	Text 10,250,""
	Text 10,270,"Ein Chip kann horizontal, vertikal oder diagonal springen. Dabei muss ein Chip"
	Text 10,290,"mindestens EINEN anderen Chip überspringen, der zwischen dem Zielfeld und dem"
	Text 10,310,"angeklickten Chip liegt. Kann der Chip bis zu 2 Felder überspringen, muss nur eins"
	Text 10,330,"der beiden Felder einen Chip zum überspringen beherbergen. Das andere Feld kann"
	Text 10,350,"leer sein. Die beiden stärksten Chips können nur ein Feld setzen, und brauchen"
	Text 10,370,"deswegen keinen anderen Chip überspringen. Wenn ein Chip auf einen anderen landet,"
	Text 10,390,"stapeln sich diese übereinander und werden zu anderen Chips. Hier ist eine Liste"
	Text 10,410,"von Chips und ihren Eigenschaften:"
	Text 10,430,"CHIP - 1 Chip - normaler Chip, der nur ein anderes Feld überspringen kann"
	Text 10,450,"BIG CHIP - 2 Chips - hat die gleichen Eigenschaften, wie ein normaler Chip"
	Text 10,470,"JUMPER - 3 Chips - kann bis zu 2 Felder überspringen"
	Text 10,490,"TOWER - 4 Chips - überspringt bis zu 2 Felder und zerstört dessen Chips"
	Text 10,510,"POWER TOWER - 5 Chips - bewegt sich 1 Feld und explodiert schwach"
	Text 10,530,"HYPER TOWER - 6 Chips - zieht 1 Feld und explodiert dann stark"
	Text 10,550,"GOLEM - ein fester Chip des Spielfeldes, der nicht übersprungen werden kann"
	Text 10,570,""
	Text 10,590,"Deine Punkte werden angezeigt, wenn du die F1-Taste drückst. Wenn du nicht weiter"
	Text 10,610,"weist, drücke ESC um deine Punkte zu kassieren und das Spiel zu beenden. Mit etwas"
	Text 10,630,"Glück landest du dann hier:"
	Text 10,650,""
	If DEACTIVATE_FILE_OPERATIONS_FOR_BB_FORUM_ONLINE_TESTS
		Color 0,200,200
		Text 10,670,"Deaktiviere die erste Zeile des Programmcodes um die Highscore-Funktion zu nutzen."
		Text 10,690,"Für gemütliche Tests der BB-Forum-User ist die Highscore-Sperre standardmäßig aktiviert."
	Else
	Color 0,200,200
	Text 10,670,bestplayer$
	Color 0,200,200
	Text 10,690,bestpoints+" Punkte"
	EndIf
	Color 170,170,0
	Text 10,730,"In diesem Sinne viel Erfolg!"
	Text 10,750,"<Drücke eine Maustaste um das Spiel zu beginnen!>"
	Flip
	WaitMouse
End Function


Function PlayGame()
	MoveMouse 1024/2,768/2
	FlushMouse()
	
	Repeat
		Cls
		
		ShowArea()
		
		Local mx=MouseX()
		Local my=MouseY()
		Local max=(mx)/BLOCK_SIZE
		Local may=(my)/BLOCK_SIZE
		Color 100,100,100
		Local OFS#=BLOCK_SIZE/5
		Oval max*BLOCK_SIZE-OFS,may*BLOCK_SIZE-OFS,BLOCK_SIZE+2*OFS,BLOCK_SIZE+2*OFS,0
		Color 200,200,0
		If KeyHit(59)
			points=0
			For xx=0 To AREA_WIDTH-1
				For yy=0 To AREA_HEIGHT-1
					If chips(xx,yy)=0 And area(xx,yy)=0 points=points+1
				Next
			Next
		EndIf
		If KeyDown(59) Text 10,10,points+" freie Felder = "+(points*10)+" Punkte"
		If Not MouseDown(2)
			Rect mx-6,my,14,2,1
			Rect mx,my-6,2,14,1
		EndIf
		If selected
			Color 0,200,0
			Rect selX*BLOCK_SIZE,selY*BLOCK_SIZE,BLOCK_SIZE,BLOCK_SIZE,0
		EndIf
		
		If MouseHit(1)
			Local itsRelation=CheckChipRelation(selX,selY,max,may)
			Local length=GetStoneDifference(selX,selY,max,may)
			If selected And chips(max,may)>0 And itsRelation<>REL_DEFAULT And length>=0 And length<=2
				If length=1
					betX=(selX+max)/2
					betY=(selY+may)/2
				Else
					GetBetweenPositions(selX,selY,max,may)
				EndIf
				;Chips.
				If chips(selX,selY)=SIZE_CHIP Or chips(selX,selY)=SIZE_BIG_CHIP
					If length=1 And chips(betX,betY)>0 And chips(max,may)>0
						chips(max,may)=chips(max,may)+chips(selX,selY)
						chips(selX,selY)=0
					EndIf
				;Jumper.
				ElseIf chips(selX,selY)=SIZE_JUMPER
					If length=2
						If chips(between1_x,between1_y) Or chips(between2_x,between2_y)
							If area(between1_x,between1_y)=0 And area(between2_x,between2_y)=0
								chips(max,may)=chips(max,may)+chips(selX,selY)
								chips(selX,selY)=0
							EndIf
						EndIf
					ElseIf length=1 And chips(betX,betY)>0 And chips(max,may)>0
						chips(max,may)=chips(max,may)+chips(selX,selY)
						chips(selX,selY)=0
					EndIf
				;Tower.
				ElseIf chips(selX,selY)=SIZE_TOWER
					If length=2
						If chips(between1_x,between1_y) Or chips(between2_x,between2_y)
							If area(between1_x,between1_y)=0 And area(between2_x,between2_y)=0
								chips(max,may)=chips(max,may)+chips(selX,selY)
								chips(selX,selY)=0
							EndIf
						EndIf
						chips(between1_x,between1_y)=0
						chips(between2_x,between2_y)=0
					ElseIf length=1 And chips(betX,betY)>0 And chips(max,may)>0
						chips(betX,betY)=0
						chips(max,may)=chips(max,may)+chips(selX,selY)
						chips(selX,selY)=0
					EndIf
				;Power-Tower.
				ElseIf chips(selX,selY)=SIZE_POWER_TOWER
					Local destX,destY
					If length=0 And chips(max,may)>0
						For destX=max-1 To max+1
							For destY=may-1 To may+1
								If destY>=0 And destY<=AREA_HEIGHT-1
									If destX>=0 And destX<=AREA_WIDTH-1
										chips(destX,destY)=0
									EndIf
								EndIf
							Next
						Next
						chips(selX,selY)=0
					EndIf
				;Hyper-Tower.
				ElseIf chips(selX,selY)>=SIZE_HYPER_TOWER
					Local destrX,destrY
					If length=0 And chips(max,may)>0
						For destrX=max-2 To max+2
							For destrY=may-2 To may+2
								If destrY>=0 And destrY<=AREA_HEIGHT-1
									If destrX>=0 And destrX<=AREA_WIDTH-1
										chips(destrX,destrY)=0
									EndIf
								EndIf
							Next
						Next
						chips(selX,selY)=0
					EndIf
				EndIf
				selected=False
			ElseIf chips(max,may)
				If selected
					selected=False
				Else
					selected=True
					selX=max
					selY=may
				EndIf
			EndIf
		EndIf

		;Anzeige.
		Color 200,200,0
		If MouseDown(2)
			Local tx=1024/2
			Local ty=768/2
			Select chips(max,may)
				Case SIZE_CHIP
					Text tx,ty,"Überspringt 1 Feld.",1,1
				Case SIZE_BIG_CHIP
					Text tx,ty,"Überspringt 1 Feld.",1,1
				Case SIZE_JUMPER
					Text tx,ty,"Überspringt 1 oder 2 Felder.",1,1
				Case SIZE_TOWER
					Text tx,ty,"Überspringt bis zu 2 Felder und zerstört sie.",1,1
				Case SIZE_POWER_TOWER
					Text tx,ty,"Bewegt sich 1 Feld und explodiert.",1,1
				Case SIZE_HYPER_TOWER
					Text tx,ty,"Bewegt sich 1 Feld und explodiert stark.",1,1
			End Select
		EndIf
		
		If KeyDown(28) Stop
		
		Flip
	Until KeyHit(1)
	
	points=0
	For xx=0 To AREA_WIDTH-1
		For yy=0 To AREA_HEIGHT-1
			If chips(xx,yy)=0 And area(xx,yy)=0 points=points+1
		Next
	Next
	Cls
	Flip
	If points*10>bestpoints
		Color 170,170,0
		Print " Du hast einen neuen neuen Rekord erreicht!"
		Print " Die neue Rekord lautet:"
		Print ""
		Print " "+(points*10)+" Punkte"
		If DEACTIVATE_FILE_OPERATIONS_FOR_BB_FORUM_ONLINE_TESTS
			Print ""
			Print "  Die Highscore-Sperre ist aktiviert und lässt das speichern"
			Print "  der Highscore nicht zu. Deaktiviere die Sperre als BB-Forum-Tester"
			Print "  in der ersten Zeile des Quellcodes. In der kompillierten Version"
			Print "  ist die Highscore normal verfügbar."
		Else
			name$=Input(" Wie ist dein Name? ")
			high=WriteFile("Data.dat")
			WriteString(high,name$)
			WriteInt(high,points*10)
			CloseFile high
			Print ""
			Print " Highscore gespeichert."
		EndIf
		Input(" ")
		End
	Else
		Color 170,170,0
		Print " Schade, aber du hast leider keinen neuen"
		Print " Rekord aufgestellt. Vielleicht beim nächsten Mal..."
		Input(" ")
		End
	EndIf
End Function


PlayGame()