It is currently Thu Mar 04, 2021 11:28 pm

All times are UTC + 1 hour




Post new topic Reply to topic  [ 8 posts ] 
Author Message
 Post subject: fifteen (game)
PostPosted: Wed Feb 17, 2021 2:12 pm 
Offline
User
User

Joined: Sun May 14, 2017 1:48 am
Posts: 87
fifteen (game)

Download (Linux/Windows + Source)

Image Image

Code:
; 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 Feb 21, 2021 7:28 pm, edited 9 times in total.

Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Wed Feb 17, 2021 2:18 pm 
Offline
Addict
Addict
User avatar

Joined: Tue Mar 02, 2004 1:20 pm
Posts: 1173
Location: Amphibios 9
What is this? An explanation or a screenshot would be helpful.

_________________
Hygge


Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Wed Feb 17, 2021 2:29 pm 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1326
https://en.wikipedia.org/wiki/15_puzzle


Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Wed Feb 17, 2021 4:08 pm 
Offline
Always Here
Always Here

Joined: Sun Sep 07, 2008 12:45 pm
Posts: 5293
Location: Germany
viewtopic.php?p=328216#p328216


Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Wed Feb 17, 2021 4:18 pm 
Offline
Addict
Addict

Joined: Thu Apr 18, 2019 8:17 am
Posts: 1326
Tiny ASCII version -> https://rosettacode.org/wiki/15_puzzle_game#PureBasic


Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Fri Feb 19, 2021 1:06 pm 
Offline
Addict
Addict
User avatar

Joined: Wed Apr 30, 2003 8:15 am
Posts: 1080
Location: Germany
@AZJIO: nice! Runs also fine as WebApp with SpiderBasic :D

Code:
; 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
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Fri Feb 19, 2021 7:10 pm 
Offline
User
User

Joined: Sun May 14, 2017 1:48 am
Posts: 87
Increased font buttons.
Optimization, mixing occurs virtually, before positioning visually.


Top
 Profile  
Reply with quote  
 Post subject: Re: fifteen (game)
PostPosted: Sun Feb 21, 2021 6:42 pm 
Offline
Addict
Addict
User avatar

Joined: Sun Nov 05, 2006 11:42 pm
Posts: 4871
Location: Lyon - France
Nice game, thanks for sharing 8)
Thanks also to DIGE spider version works too :wink:

_________________
ImageThe happiness is a road...
Not a destination


Top
 Profile  
Reply with quote  
Display posts from previous:  Sort by  
Post new topic Reply to topic  [ 8 posts ] 

All times are UTC + 1 hour


Who is online

Users browsing this forum: No registered users and 5 guests


You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum

Search for:
Jump to:  

 


Powered by phpBB © 2008 phpBB Group
subSilver+ theme by Canver Software, sponsor Sanal Modifiye