


download link
or
copy the sourcecode below and manually download the picture used in the puzzle :
pic link
Code: Select all
;Public domain image source obtained from http://en.wikipedia.org/wiki/Theo_van_Gogh_(film_director)
UseJPEGImageDecoder() : #cell_size = 54
win_id = OpenWindow(#PB_Any,#PB_Default,#PB_Default,220,300,"Picture Slider Puzzle",#PB_Window_SystemMenu|#PB_Window_MinimizeGadget|#PB_Window_MaximizeGadget|#PB_Window_ScreenCentered)
menu_id = CreateMenu(#PB_Any,WindowID(win_id))
MenuTitle("&Menu") : MenuItem(1,"&Randomize") : MenuItem(2,"&Solve") : MenuItem(3,"E&xit")
AddKeyboardShortcut(win_id,#PB_Shortcut_Escape,3)
slide_timer1.i = ElapsedMilliseconds() : slide_timer2.i = slide_timer1 : interval.i = 300
original_image_id = LoadImage(#PB_Any,"TheoVanGogh.jpg")
;images_index_id will be used as a reference to check if the picture is solved
x_offset = 0 : y_offset = 0 : Global Dim images_index_id.i(20) ;declared as Global because array will be used in a procedure
For count1 = 0 To 19 Step 1
images_index_id(count1) = GrabImage(original_image_id,#PB_Any,x_offset,y_offset,54,54)
x_offset + 54 : If x_offset > 162 : x_offset = 0 : y_offset + 54 : EndIf
Next count1
Structure objects : status.i : image.i : gadget.i : EndStructure
;<positions> array is stored as, where <status> = -2 indicates the boundary, -1 indicates an empty cell, and 1
;indicating an occupied cell therefore <positions> array has the dimensions col = 6 and row = 7
;note : I've arranged the array this way, so we won't have to deal with the nasty array index out of bounds errors
;-2,-2,-2,-2,-2,-2
;-2, 1, 1, 1, 1,-2
;-2, 1, 1, 1, 1,-2
;-2, 1, 1, 1, 1,-2
;-2, 1, 1, 1, 1,-2
;-2, 1, 1, 1,-1,-2
;-2,-2,-2,-2,-2,-2
Global Dim positions.objects(6,7)
For count1 = 0 To 6 Step 1 : For count2 = 0 To 5 Step 2 : positions(count2,count1)\status = -2 : Next count2 : Next count1
cell = 0 ;position for images_index_id()
For count1 = 1 To 5 Step 1
For count2 = 1 To 4 Step 1
With positions(count2,count1)
\status = 1 : \image = images_index_id(cell)
\gadget = ImageGadget(#PB_Any,(count2 - 1) * 54 + (count2 - 1) * 2,(count1 - 1) * 54 + (count1 - 1) * 2,54,54,ImageID(\image))
EndWith : cell + 1
Next count2
Next count1
With positions(4,5) ;delete this gadget and image for sliding space
FreeImage(\image) : FreeGadget(\gadget) : \status = -1
EndWith
empty_x = 4 : empty_y = 5 ;keep track of the empty cel so we don't have to find it again with a nested for loop
previous_empty_x = empty_x : previous_empty_y = empty_y : redraw = 0 : random_sum = 0 : randomizing = 0
;linked list to keep track of moves made so we can solve the puzzle
Structure solve_struct : x.i : y.i : EndStructure
NewList solve.solve_struct() : solving = 0
Procedure.i CheckPuzzle() ;checks to see if the puzzle is currently solved (returns 1) or not (returns 0)
cell = 0 : sum = 0
For count1 = 1 To 5 Step 1
For count2 = 1 To 4 Step 1
With positions(count2,count1)
If \image = images_index_id(cell) And \status = 1 : sum + 1 : EndIf : cell + 1
EndWith
Next count2
Next count1
If sum = 19 : ProcedureReturn 1 : Else : ProcedureReturn 0 : EndIf
EndProcedure
Repeat
event = WindowEvent()
If event = #PB_Event_Menu
If EventMenu() = 3 : Break : EndIf
If EventMenu() = 2 And solving = 0 And randomizing = 0 And ListSize(solve()) > 0 : solving = 1 : EndIf ;solve puzzle
If EventMenu() = 1 And solving = 0 And randomizing = 0 ;randomize slider puzzle
random_sum = 40 : randomizing = 1 : If CheckPuzzle() = 1 : ClearList(solve()) : EndIf
EndIf
EndIf
If solving = 1 ;solve the puzzle
*element.solve_struct = LastElement(solve()) : mouse_x = *element\x : mouse_y = *element\y : redraw = 1
previous_empty_x = empty_x : previous_empty_y = empty_y : empty_x = mouse_x : empty_y = mouse_y
DeleteElement(solve(),ListSize(solve())) : If ListSize(solve()) = 0 : solving = 0 : Else : Delay(300) : EndIf
If solving = 0 : MessageRequester("","Puzzle has been solved.") : EndIf
EndIf
If random_sum > 0 ;start randomizing puzzle
random = Random(3) ;0 - up, 1 - down, 2 - left, 3 - right
If random = 0 And positions(empty_x,empty_y-1)\status = 1 : mouse_x = empty_x : mouse_y = empty_y - 1 : redraw = 1 : EndIf
If random = 1 And positions(empty_x,empty_y+1)\status = 1 : mouse_x = empty_x : mouse_y = empty_y + 1 : redraw = 1 : EndIf
If random = 2 And positions(empty_x-1,empty_y)\status = 1 : mouse_x = empty_x - 1 : mouse_y = empty_y : redraw = 1 : EndIf
If random = 3 And positions(empty_x+1,empty_y)\status = 1 : mouse_x = empty_x + 1 : mouse_y = empty_y : redraw = 1 : EndIf
If redraw = 1 : random_sum - 1 : previous_empty_x = empty_x : previous_empty_y = empty_y : empty_x = mouse_x : empty_y = mouse_y : EndIf
If redraw = 1 ;add move to linklist <solve>
*element.solve_struct = AddElement(solve()) : *element\x = previous_empty_x : *element\y = previous_empty_y
EndIf
If random_sum = 0 : randomizing = 0 : MessageRequester("","Randomization complete.") : Else : Delay(300) : EndIf
EndIf
;if player clicked an image gadget, see if we can move that cell
If event = #PB_Event_Gadget And EventType() = #PB_EventType_LeftClick And randomizing = 0 And solving = 0
mouse_x = Int(WindowMouseX(win_id) / 54 + 1) : mouse_y = Int(WindowMouseY(win_id) / 54 + 1)
;start checking whether a neigbouring cell is empty
If mouse_x = empty_x And mouse_y - 1 = empty_y : redraw = 1 : EndIf ;if the top cell is an empty cell
If mouse_x = empty_x And mouse_y + 1 = empty_y : redraw = 1 : EndIf ;if bottom cell is an empty cell
If mouse_x - 1 = empty_x And mouse_y = empty_y : redraw = 1 : EndIf ;if left cell is an empty cell
If mouse_x + 1 = empty_x And mouse_y = empty_y : redraw = 1 : EndIf ;if right cell is an empty cell
If redraw = 1 : previous_empty_x = empty_x : previous_empty_y = empty_y : empty_x = mouse_x : empty_y = mouse_y : EndIf
If redraw = 1 ;add move to linklist <solve>
*element.solve_struct = AddElement(solve()) : *element\x = previous_empty_x : *element\y = previous_empty_y
EndIf
EndIf
;redraw the cells (image gadgets that have been swapped), this means destroying the gadget and creating a new one
If redraw = 1
redraw = 0 : temp_image = positions(mouse_x,mouse_y)\image
temp_gadget = positions(mouse_x,mouse_y)\gadget : FreeGadget(temp_gadget)
temp_x = ((previous_empty_x - 1) * 54) + ((previous_empty_x - 1) * 2)
temp_y = ((previous_empty_y - 1) * 54) + ((previous_empty_y - 1) * 2)
temp_gadget = ImageGadget(#PB_Any,temp_x,temp_y,54,54,ImageID(temp_image))
positions(previous_empty_x,previous_empty_y)\status = 1
positions(previous_empty_x,previous_empty_y)\image = temp_image
positions(previous_empty_x,previous_empty_y)\gadget = temp_gadget
positions(mouse_x,mouse_y)\status = -1
If CheckPuzzle() = 1 : ClearList(solve()) : EndIf
EndIf
;debug
;SetWindowTitle(win_id,"x : " + Str(mouse_x) + " / y : " + Str(mouse_y))
;SetWindowTitle(win_id,"status : " + Str(CheckPuzzle()))
If event = #PB_Event_Menu
If EventMenu() = 3 : Break : EndIf
EndIf
Until event = #PB_Event_CloseWindow
End