fifteen (game)

Applications, Games, Tools, User libs and useful stuff coded in PureBasic
Post Reply
AZJIO
Enthusiast
Enthusiast
Posts: 412
Joined: Sun May 14, 2017 1:48 am

fifteen (game)

Post by AZJIO »

fifteen (game)

Download: yandex upload.ee (Linux/Windows + Source)

Image Image

Code: Select all

; AZJIO, converting my code from AutoIt from 2012.07.17
; AZJIO, преобразование моего кода из AutoIt от 2012.07.17

EnableExplicit


#Window = 0
#Refresh = 17
Global s=50, x.b, y.b, i,b, evg, bRefresh = #True
Global Dim aXY.b(16, 4)

Declare reButton(i, z=1)
Declare Refresh()
Declare reArr(o, u, n)



; Определение языка интерфейса и применение
; Определяет язык ОС
CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		Global UserIntLang, *Lang
		If OpenLibrary(0, "kernel32.dll")
			*Lang = GetFunction(0, "GetUserDefaultUILanguage")
			If *Lang
				UserIntLang = CallFunctionFast(*Lang)
			EndIf
			CloseLibrary(0)
		EndIf
	CompilerCase #PB_OS_Linux
		Global UserIntLang$
		If ExamineEnvironmentVariables()
			While NextEnvironmentVariable()
				If Left(EnvironmentVariableName(), 4) = "LANG"
					; 		    		LANG=ru_RU.UTF-8
					; 		    		LANGUAGE=ru
					UserIntLang$ = Left(EnvironmentVariableValue(), 2)
					Break
				EndIf
			Wend
		EndIf
CompilerEndSelect

Global Dim Lng.s(2)
; Строки интерфейса даже если языковой файл не найден
Lng(1) = "Fifteen"
Lng(2) = "Mix"
Lng(0) = "Excellently!"

CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Windows
		If UserIntLang = 1049
	CompilerCase #PB_OS_Linux
		If UserIntLang$ = "ru"
CompilerEndSelect
	Lng(1) = "Пятнашки"
	Lng(2) = "Перемешать"
	Lng(0) = "Молодец!"
EndIf


CompilerSelect #PB_Compiler_OS
	CompilerCase #PB_OS_Linux
		UseGIFImageDecoder()
		; https://www.purebasic.fr/english/viewtopic.php?p=531374#p531374
		ImportC ""
			gtk_window_set_icon(a.l,b.l)
		EndImport
		
		DataSection
			IconTitle:
			IncludeBinary "Fifteen.gif"
			IconTitleend:
		EndDataSection
		CatchImage(0, ?IconTitle)
CompilerEndSelect

If OpenWindow(#Window, 0, 0, 4*s, 4*s + 37, Lng(1), #PB_Window_SystemMenu | #PB_Window_MinimizeGadget | #PB_Window_ScreenCentered)
	CompilerIf  #PB_Compiler_OS = #PB_OS_Linux
		gtk_window_set_icon_(WindowID(#Window), ImageID(0)) ; назначаем иконку в заголовке
	CompilerEndIf
	; 	Генерируем кнопки
	y = 0
	x = 0
	For i = 1 To 16
		aXY(i, 0) = i
		Select i
			Case 1 To 4
				y = 0
				x = 1
			Case 5 To 8
				y = 1
				x = 5
			Case 9 To 12
				y = 2
				x = 9
			Case 13 To 16
				y = 3
				x = 13
		EndSelect
		aXY(i, 2) = i - x
		aXY(i, 3) = y
		; 		Debug aXY(i, 0)
		
		If i < 16
			ButtonGadget(aXY(i, 0), aXY(i, 2) * s, aXY(i, 3) * s, s, s, Str(i))
		EndIf
	Next

	CompilerSelect #PB_Compiler_OS
		CompilerCase #PB_OS_Windows	
			#FontName$ = "Arial"
			#FontSize = 17
		CompilerCase #PB_OS_Linux
			#FontName$ = ""
			#FontSize = 10
	CompilerEndSelect
	If LoadFont(0, #FontName$, #FontSize, #PB_Font_Bold)
		For i = 1 To 15
			SetGadgetFont(aXY(i, 0), FontID(0)) ; Установить загруженный шрифт Arial 16 как новый стандарт
		Next
	EndIf
	; 	конец => Генерируем кнопки
	ButtonGadget(#Refresh, 0, 200, 200, 36, Lng(2))
	
	Repeat
		Select WaitWindowEvent()
			Case #PB_Event_Gadget
				evg = EventGadget()
				Select evg
					Case 1 To 15
						; Debug evg
						If bRefresh
							Refresh()
							Continue
						EndIf
						
						
						If (aXY(evg, 2) = aXY(16, 2) And (aXY(evg, 3) = aXY(16, 3) + 1 Or aXY(evg, 3) = aXY(16, 3) - 1)) Or (aXY(evg, 3) = aXY(16, 3) And (aXY(evg, 2) = aXY(16, 2) + 1 Or aXY(evg, 2) = aXY(16, 2) - 1))
							reButton(evg)
						EndIf
						
						; displacement on 2-3 buttons.
						If aXY(evg, 2) = aXY(16, 2)
							If aXY(evg, 3) = aXY(16, 3) + 2 ; from below upwards
								reArr(0, 1, 2)
							ElseIf aXY(evg, 3) = aXY(16, 3) + 3
								reArr(0, 1, 3)
							ElseIf aXY(evg, 3) = aXY(16, 3) - 2 ; from top to bottom
								reArr(0, -1, 2)
							ElseIf aXY(evg, 3) = aXY(16, 3) - 3
								reArr(0, -1, 3)
							EndIf
						ElseIf aXY(evg, 3) = aXY(16, 3)
							If aXY(evg, 2) = aXY(16, 2) + 2 ; right to left
								reArr(1, 0, 2)
							ElseIf aXY(evg, 2) = aXY(16, 2) + 3
								reArr(1, 0, 3)
							ElseIf aXY(evg, 2) = aXY(16, 2) - 2 ; left to right
								reArr(-1, 0, 2)
							ElseIf aXY(evg, 2) = aXY(16, 2) - 3
								reArr(-1, 0, 3)
							EndIf
						EndIf
						; проверяем с конца последовательности, как наименее вероятную. Проверка только после нажатия кнопки.
						If aXY(16, 2) =  3 And aXY(16, 3) =  3 And aXY(15, 2) =  2 And aXY(15, 3) =  3 And aXY(14, 2) = 1 And aXY(14, 3) =  3 And aXY(13, 2) = 0 And aXY(13, 3) =  3 And aXY(12, 2) =  3 And aXY(12, 3) =  2 And aXY(11, 2) =  2 And aXY(11, 3) =  2 And aXY(10, 2) = 1 And aXY(10, 3) =  2 And aXY(9, 2) = 0 And aXY(9, 3) =  2 And aXY(8, 2) =  3 And aXY(8, 3) = 1 And aXY(7, 2) =  2 And aXY(7, 3) = 1 And aXY(6, 2) = 1 And aXY(6, 3) = 1 And aXY(5, 2) = 0 And aXY(5, 3) = 1 And aXY(4, 2) =  3 And aXY(4, 3) = 0 And aXY(3, 2) =  2 And aXY(3, 3) = 0 And aXY(2, 2) = 1 And aXY(2, 3) = 0 And aXY(1, 2) = 0 And aXY(1, 3) = 0
							bRefresh = #True
							; 								Delay(500)
							MessageRequester("", Lng(0))
							; 	Refresh()
						EndIf
					Case #Refresh
						Refresh()
				EndSelect
			Case #PB_Event_CloseWindow
				CloseWindow(#Window)
				Break
		EndSelect
	ForEver
EndIf

Procedure Refresh()
	Protected u, i
	bRefresh = #False
	For u = 1 To 500
		Select Random(4, 1)
			Case 1
				For i = 1 To 15
					If aXY(i, 2) = aXY(16, 2) + 1 And aXY(i, 3) = aXY(16, 3)
						reButton(i, 0)
					EndIf
				Next
			Case 2
				For i = 1 To 15
					If aXY(i, 2) = aXY(16, 2) - 1 And aXY(i, 3) = aXY(16, 3)
						reButton(i, 0)
					EndIf
				Next
			Case 3
				For i = 1 To 15
					If aXY(i, 2) = aXY(16, 2) And aXY(i, 3) = aXY(16, 3) + 1
						reButton(i, 0)
					EndIf
				Next
			Case 4
				For i = 1 To 15
					If aXY(i, 2) = aXY(16, 2) And aXY(i, 3) = aXY(16, 3) - 1
						reButton(i, 0)
					EndIf
				Next
		EndSelect
	Next
	; 	сначала перемешиваем виртуально координаты, потом перемещаем
	For i = 1 To 15
		ResizeGadget(aXY(i, 0), aXY(i, 2)*s, aXY(i, 3)*s, #PB_Ignore, #PB_Ignore)
	Next
EndProcedure


Procedure reButton(i, z=1)
	Protected tmp
	If z
		ResizeGadget(aXY(i, 0), aXY(16, 2)*s, aXY(16, 3)*s, #PB_Ignore, #PB_Ignore)
	EndIf
	tmp = aXY(i, 2)
	aXY(i, 2) = aXY(16, 2)
	aXY(16, 2) = tmp
	tmp = aXY(i, 3)
	aXY(i, 3) = aXY(16, 3)
	aXY(16, 3) = tmp
EndProcedure

Procedure reArr(o, u, n)
	Protected j, i
	For j = 1 To n
		For i = 1 To 16
			If aXY(i, 2) = aXY(16, 2) + o And aXY(i, 3) = aXY(16, 3) + u
				reButton(i)
				Break
			EndIf
		Next
	Next
EndProcedure
Last edited by AZJIO on Sun Sep 12, 2021 7:35 am, edited 10 times in total.
Top
User avatar
Kiffi
Addict
Addict
Posts: 1223
Joined: Tue Mar 02, 2004 1:20 pm
Location: Amphibios 9

Re: fifteen (game)

Post by Kiffi »

What is this? An explanation or a screenshot would be helpful.
Hygge
Top
BarryG
Addict
Addict
Posts: 2127
Joined: Thu Apr 18, 2019 8:17 am

Re: fifteen (game)

Post by BarryG »

https://en.wikipedia.org/wiki/15_puzzle
Top
infratec
Always Here
Always Here
Posts: 5799
Joined: Sun Sep 07, 2008 12:45 pm
Location: Germany

Re: fifteen (game)

Post by infratec »

viewtopic.php?p=328216#p328216
Top
BarryG
Addict
Addict
Posts: 2127
Joined: Thu Apr 18, 2019 8:17 am

Re: fifteen (game)

Post by BarryG »

Tiny ASCII version -> https://rosettacode.org/wiki/15_puzzle_game#PureBasic
Top
dige
Addict
Addict
Posts: 1141
Joined: Wed Apr 30, 2003 8:15 am
Location: Germany
Contact:
Contact dige

Re: fifteen (game)

Post by dige »

@AZJIO: nice! Runs also fine as WebApp with SpiderBasic :D

Code: Select all

; AZJIO, converting my code from AutoIt from 2012.07.17
; AZJIO, преобразование моего кода из AutoIt от 2012.07.17
; DiGe Adapted for SpiderBasic 2021.02.17

EnableExplicit


#Window = 0
#Refresh = 17
Global s=50, x.b, y.b, i,b, evg, bRefresh = #True
Global Dim aXY(16, 4)

Declare reButton(i)
Declare Refresh()
Declare reArr(o, u, n)


Global Dim Lng.s(2)
; Строки интерфейса даже если языковой файл не найден
Lng(1) = "Fifteen"
Lng(2) = "Mix"
Lng(0) = "Excellently!"

Procedure Events()
  
  evg = EventGadget()
  
  Select evg
  	Case 1 To 15
  		; Debug evg
  		If bRefresh
  			Refresh()
  			ProcedureReturn 
  		EndIf
  
  		If (aXY(evg, 2) = aXY(16, 2) And (aXY(evg, 3) = aXY(16, 3) + 1 Or aXY(evg, 3) = aXY(16, 3) - 1)) Or (aXY(evg, 3) = aXY(16, 3) And (aXY(evg, 2) = aXY(16, 2) + 1 Or aXY(evg, 2) = aXY(16, 2) - 1))
  			reButton(evg)
  		EndIf
  
  		; displacement on 2-3 buttons.
  		If aXY(evg, 2) = aXY(16, 2)
  			If aXY(evg, 3) = aXY(16, 3) + 2 ; from below upwards
  				reArr(0, 1, 2)
  			ElseIf aXY(evg, 3) = aXY(16, 3) + 3
  				reArr(0, 1, 3)
  			ElseIf aXY(evg, 3) = aXY(16, 3) - 2 ; from top to bottom
  				reArr(0, -1, 2)
  			ElseIf aXY(evg, 3) = aXY(16, 3) - 3
  				reArr(0, -1, 3)
  			EndIf
  		ElseIf aXY(evg, 3) = aXY(16, 3)
  			If aXY(evg, 2) = aXY(16, 2) + 2 ; right to left
  				reArr(1, 0, 2)
  			ElseIf aXY(evg, 2) = aXY(16, 2) + 3
  				reArr(1, 0, 3)
  			ElseIf aXY(evg, 2) = aXY(16, 2) - 2 ; left to right
  				reArr(-1, 0, 2)
  			ElseIf aXY(evg, 2) = aXY(16, 2) - 3
  				reArr(-1, 0, 3)
  			EndIf
  		EndIf
  		; проверяем с конца последовательности, как наименее вероятную. Проверка только после нажатия кнопки.
  		If aXY(16, 2) =  3 And aXY(16, 3) =  3 And aXY(15, 2) =  2 And aXY(15, 3) =  3 And aXY(14, 2) = 1 And aXY(14, 3) =  3 And aXY(13, 2) = 0 And aXY(13, 3) =  3 And aXY(12, 2) =  3 And aXY(12, 3) =  2 And aXY(11, 2) =  2 And aXY(11, 3) =  2 And aXY(10, 2) = 1 And aXY(10, 3) =  2 And aXY(9, 2) = 0 And aXY(9, 3) =  2 And aXY(8, 2) =  3 And aXY(8, 3) = 1 And aXY(7, 2) =  2 And aXY(7, 3) = 1 And aXY(6, 2) = 1 And aXY(6, 3) = 1 And aXY(5, 2) = 0 And aXY(5, 3) = 1 And aXY(4, 2) =  3 And aXY(4, 3) = 0 And aXY(3, 2) =  2 And aXY(3, 3) = 0 And aXY(2, 2) = 1 And aXY(2, 3) = 0 And aXY(1, 2) = 0 And aXY(1, 3) = 0
  			bRefresh = #True
  ; 								Delay(500)
  			MessageRequester(Lng(0))
  			; 	Refresh()
  		EndIf
  	Case #Refresh
  		Refresh()
  EndSelect
  
EndProcedure

If OpenWindow(#Window, 0, 0, 4*s, 4*s + 37, "", #PB_Window_SystemMenu | #PB_Window_ScreenCentered)
	
; 	Генерируем кнопки
	y = 0
	x = 0
	For i = 1 To 16
		aXY(i, 0) = i
		Select i
			Case 1 To 4
				y = 0
				x = 1
			Case 5 To 8
				y = 1
				x = 5
			Case 9 To 12
				y = 2
				x = 9
			Case 13 To 16
				y = 3
				x = 13
		EndSelect
		aXY(i, 2) = i - x
		aXY(i, 3) = y
		; 		Debug aXY(i, 0)
		
		If i < 16
		  ButtonGadget(aXY(i, 0), aXY(i, 2) * s, aXY(i, 3) * s, s, s, Str(i))
		  BindGadgetEvent(aXY(i, 0), @Events(), #PB_EventType_LeftClick)
		EndIf
	Next
; 	конец => Генерируем кнопки
	ButtonGadget(#Refresh, 0, 200, 200, 20, Lng(2))
	BindGadgetEvent(#Refresh, @Refresh(), #PB_EventType_LeftClick)
	

EndIf

Procedure Refresh()
	Protected u
	bRefresh = #False
	For u = 1 To 500
		Select Random(4, 1)
			Case 1
				For i = 1 To 16
					If aXY(i, 2) = aXY(16, 2) + 1 And aXY(i, 3) = aXY(16, 3)
						reButton(i)
					EndIf
				Next
			Case 2
				For i = 1 To 16
					If aXY(i, 2) = aXY(16, 2) - 1 And aXY(i, 3) = aXY(16, 3)
						reButton(i)
					EndIf
				Next
			Case 3
				For i = 1 To 16
					If aXY(i, 2) = aXY(16, 2) And aXY(i, 3) = aXY(16, 3) + 1
						reButton(i)
					EndIf
				Next
			Case 4
				For i = 1 To 16
					If aXY(i, 2) = aXY(16, 2) And aXY(i, 3) = aXY(16, 3) - 1
						reButton(i)
					EndIf
				Next
		EndSelect
	Next
EndProcedure

Procedure reButton(i)
	Protected tmp2, tmp3
	ResizeGadget(aXY(i, 0), aXY(16, 2)*s, aXY(16, 3)*s, #PB_Ignore, #PB_Ignore)
	tmp2 = aXY(i, 2)
	tmp3 = aXY(i, 3)
	aXY(i, 2) = aXY(16, 2)
	aXY(i, 3) = aXY(16, 3)
	aXY(16, 2) = tmp2
	aXY(16, 3) = tmp3
EndProcedure

Procedure reArr(o, u, n)
	Protected j, i
	For j = 1 To n
		For i = 1 To 16
			If aXY(i, 2) = aXY(16, 2) + o And aXY(i, 3) = aXY(16, 3) + u
				reButton(i)
				Break
			EndIf
		Next
	Next
EndProcedure
"Daddy, I'll run faster, then it is not so far..."
Top
AZJIO
Enthusiast
Enthusiast
Posts: 412
Joined: Sun May 14, 2017 1:48 am

Re: fifteen (game)

Post by AZJIO »

Increased font buttons.
Optimization, mixing occurs virtually, before positioning visually.
Top
User avatar
Kwai chang caine
Always Here
Always Here
Posts: 5046
Joined: Sun Nov 05, 2006 11:42 pm
Location: Lyon - France

Re: fifteen (game)

Post by Kwai chang caine »

Nice game, thanks for sharing 8)
Thanks also to DIGE spider version works too :wink:
ImageThe happiness is a road...
Not a destination
Top
AZJIO
Enthusiast
Enthusiast
Posts: 412
Joined: Sun May 14, 2017 1:48 am

Re: fifteen (game)

Post by AZJIO »

Added window resize
Top
Post Reply

Return to “Applications - Feedback and Discussion”