Slide Puzzle

by Stan Munson

INSTRUCTIONS:
Select a picture from the listbox.
Select a level of difficulty.
Click Play to scramble the picture.
Click the free tiles to put the picture back together. Moves are counted for fun.

SlidePuzzle.lgo

TO SETUP
 ERASE.EXISTING.NAMES
 SETUP.GLOBALS
 SETUP.SCREEN
 SHOW.CONTROLS
END

TO ERASE.EXISTING.NAMES
 ERASE "RADIOBUTTON
 ERASE "SIZE.NOTE
 ERASE "BUTTON
 ERASE "SIZE.3
 ERASE "SIZE.2
 ERASE "SIZE.1
 ERASE "LISTBOX
 ERASE "STATICTEXT
 ERASE "PICTURE.NOTE
 ERASE "PLAY.BUTTON
 ERASE "MOVES
 ERASE "PICLISTBOX
END

TO SETUP.GLOBALS
 MAKE "ROWS 3
 MAKE "COLS 3
 MAKE "PUZZLE.SIZE 300
 MAKE "CELL.SIZE :PUZZLE.SIZE / :ROWS
 MAKE "BLANK.CELL (:ROWS * :COLS) - 1
 MAKE "BLANK.TILE :BLANK.CELL
 MAKE "BLANK.POSITION []
 MAKE "LAST.MOVE :BLANK.CELL
 MAKE "SCRAMBLE.FACTOR 40
 MAKE "SCRAMBLE.COUNT :ROWS * :SCRAMBLE.FACTOR
 MAKE "MOVE.COUNT 0
END

TO SETUP.SCREEN
 FULLSCREEN
 SETBG "INDIANRED

 HIDETURTLE

; create the controls 

 DECLARE "STATICTEXT "SIZE.NOTE
 PPROPS "SIZE.NOTE [SIZE [130 16] POSITION [0 140] TEXT |Level of difficulty| "TOOLTIP "||]

 DECLARE "RADIOBUTTON "SIZE.1
 PPROPS "SIZE.1 [SIZE [130 18] POSITION [0 122] TEXT |3 x 3 puzzle| RUN [SWITCH.SIZE 1] "TOOLTIP "||]
 PPROP "SIZE.1 "STATE TRUE

 DECLARE "RADIOBUTTON "SIZE.2
 PPROPS "SIZE.2 [SIZE [130 18] POSITION [0 104] TEXT |4 x 4 puzzle| RUN [SWITCH.SIZE 2] "TOOLTIP "||]

 DECLARE "RADIOBUTTON "SIZE.3
 PPROPS "SIZE.3 [SIZE [130 18] POSITION [0 86] TEXT |5 x 5 puzzle| RUN [SWITCH.SIZE 3] "TOOLTIP "||]

 DECLARE "STATICTEXT "PICTURE.NOTE
 PPROPS "PICTURE.NOTE [SIZE [130 140] POSITION [0 -10] TEXT |** INSTRUCTIONS ** Select a picture from the listbox. Select a level of difficulty. Click Play to scramble the picture. Click the free tiles to put the picture back together. Moves are counted for fun.| "TOOLTIP "||]

 DECLARE "STATICTEXT "MOVES
 PPROPS "MOVES [SIZE [130 16] POSITION [0 -100] TEXT |Moves:| "TOOLTIP "||]

 DECLARE "BUTTON "PLAY.BUTTON
 PPROPS "PLAY.BUTTON [SIZE [130 30] POSITION [0 -130] TEXT |Play| RUN [PLAY.PUZZLE] "TOOLTIP "||]

 TELL 0 PU SETXY [-90 -160]
 PD STAMPRECT 175 320 PU

; eventually get rid of the Listener
 PPROP "LISTENER "VISIBLE FALSE

 MAKE.PICLIST
END

TO SHOW.CONTROLS
 FOREACH [SIZE.NOTE SIZE.1 SIZE.2 SIZE.3 PICTURE.NOTE MOVES PLAY.BUTTON INSTRUCTIONS.BUTTON QUIT.BUTTON] [
		PPROP "? "VISIBLE TRUE
	]
END

TO HIDE.CONTROLS
	FOREACH [SIZE.NOTE SIZE.1 SIZE.2 SIZE.3 PICTURE.NOTE MOVES PLAY.BUTTON INSTRUCTIONS.BUTTON QUIT.BUTTON] [
		PPROP "? "VISIBLE FALSE
	]
END

TO SWITCH.SIZE :BUTTON
	TURN.OFF "SIZE. BUTMEMBER :BUTTON [1 2 3]
	MAKE "ROWS :BUTTON + 2
	MAKE "COLS :ROWS
END

TO TURN.OFF :RADIO :BUTTONS
	IF EMPTY? :BUTTONS [STOP]
	PPROP WORD :RADIO FIRST :BUTTONS "STATE FALSE
	TURN.OFF :RADIO BUTFIRST :BUTTONS
END

TO CHOP.PUZZLE
	MAKE "STP.TILES []
	MAKE "STP.BITMAPS []
	TELL 0
	PENUP
	LOCAL "X
	LOCAL "Y
	MAKE "X -450
	MAKE "Y (:PUZZLE.SIZE / 2) - :CELL.SIZE
	MAKE "VALID.MOVES ARRAY (:ROWS * :COLS)
	MAKE "STP.ANCHORS ARRAY (:ROWS * :COLS)
	MAKE "POSITIONS ARRAY (:ROWS * :COLS)
	CHOP.ROWS 0 :X :Y
	MAKE "SOLUTION LISTARRAY :POSITIONS
	MAKE "BLANK.POSITION GPROP THING WORD "TILE. ( (:ROWS * :COLS) - 1) "STP.ANCHOR
END

TO CHOP.ROWS :ROW :X :Y
	IF :ROW = :ROWS [STOP]
	CHOP.COLS 0 :X :Y
	CHOP.ROWS (:ROW + 1) :X (:Y - :CELL.SIZE)
END

TO CHOP.COLS :COL :X :Y
	IF :COL = :COLS [STOP]
	LOCAL "CELL
	MAKE "CELL (:ROW * :ROWS) + :COL
	ASET :POSITIONS :CELL :CELL
	SETXY LIST :X :Y
	MAKE WORD "TILE. :CELL SNAP :CELL.SIZE :CELL.SIZE
	MAKE "STP.TILES SE :STP.TILES WORD "TILE. :CELL
	MAKE "STP.BITMAPS SE :STP.BITMAPS THING WORD "TILE. :CELL
	LOCAL "STP.ANCHOR
	MAKE "STP.ANCHOR LIST (:X + :CELL.SIZE / 2) (:Y + :CELL.SIZE / 2)
	PPROPS THING WORD "TILE. :CELL (LIST "ROW :ROW "COL :COL "CELL :CELL "STP.ANCHOR :STP.ANCHOR "DRAGGABLE FALSE "TOOLTIP "||)
	ASET :STP.ANCHORS :CELL :STP.ANCHOR
	LOCAL "RUN.LIST
	PPROP THING WORD "TILE. :CELL "RUN LIST "CLICK.MOVE :CELL
	ASET :VALID.MOVES :CELL VALID.MOVE :ROW :COL
	CHOP.COLS (:COL + 1) (:X + :CELL.SIZE) :Y
END

TO CLICK.MOVE :TILE
	MOVE.CELL GPROP THING WORD "TILE. :TILE "CELL
END

TO VALID.MOVE :ROW :COL
	LOCAL "CELLS
	MAKE "CELLS []
	IF (:ROW + 1) < :ROWS [MAKE "CELLS FPUT ( (:ROW + 1) * :ROWS + :COL) :CELLS]
	IF (:ROW - 1) >= 0 [MAKE "CELLS FPUT ( (:ROW - 1) * :ROWS + :COL) :CELLS]
	IF (:COL + 1) < :COLS [MAKE "CELLS FPUT ( (:ROW * :ROWS) + (:COL + 1)) :CELLS]
	IF (:COL - 1) >= 0 [MAKE "CELLS FPUT ( (:ROW * :ROWS) + (:COL - 1)) :CELLS]
	OUTPUT :CELLS
END

TO MOVE.CELL :CELL
	IF NOT MOVEABLE? :CELL [CLUNK STOP]
	SWAP :CELL
	UPDATE.MOVES
	IF SOLVED? [PUZZLE.DONE]
END

TO MOVEABLE? :CELL
	OUTPUT MEMBER? :CELL AGET :VALID.MOVES :BLANK.CELL
END

TO SWAP :CELL
	LOCAL "TILE.IN.CELL
	MAKE "TILE.IN.CELL AGET :POSITIONS :CELL
	LOCAL "OLD.BLANK.POSITION
	LOCAL "OLD.BLANK.CELL
	MAKE "OLD.BLANK.POSITION AGET :STP.ANCHORS :BLANK.CELL
	MAKE "OLD.BLANK.CELL :BLANK.CELL
	ASET :POSITIONS :CELL :BLANK.TILE
	ASET :POSITIONS :BLANK.CELL :TILE.IN.CELL
	MAKE "BLANK.CELL :CELL
	MAKE "BLANK.POSITION AGET :STP.ANCHORS :TILE.IN.CELL
	PPROP THING WORD "TILE. :TILE.IN.CELL "CELL :OLD.BLANK.CELL
	PPROP THING WORD "TILE. :TILE.IN.CELL "POSITION :OLD.BLANK.POSITION
END

TO UPDATE.MOVES
	MAKE "MOVE.COUNT :MOVE.COUNT + 1
	PPROP "MOVES "TEXT WORD "|Moves: | :MOVE.COUNT
END

TO SOLVED?
	OUTPUT EQUAL? :SOLUTION LISTARRAY :POSITIONS
END

TO PUZZLE.DONE
	SAY PICK [ [NOT BAD] [GOOD JOB] [EXCELLENT] [NICE WORK] [WELL DONE] [WONDERFUL]]
	TELL :ACTOR ST
	PPROPS "PLAY.BUTTON [TEXT |Play| RUN [PLAY.PUZZLE]]
	PPROP "PICLISTBOX "ENABLED TRUE
END

TO PLAY.PUZZLE
	LOAD.PUZZLE
	PPROP "PICLISTBOX "ENABLED FALSE
	IF NAME? "STP.BITMAPS [ERASE :STP.BITMAPS]
	PPROPS "PLAY.BUTTON [TEXT |Solve Puzzle| RUN [SOLVE]]
	ASK :ACTOR [STAMP]
	MAKE "CELL.SIZE :PUZZLE.SIZE / :ROWS
	MAKE "SCRAMBLE.COUNT :ROWS * :SCRAMBLE.FACTOR
	MAKE "BLANK.CELL (:ROWS * :COLS) - 1
	MAKE "BLANK.TILE :BLANK.CELL
	MAKE "BLANK.POSITION []
	MAKE "LAST.MOVE :BLANK.CELL
	GRID.LINES
	CHOP.PUZZLE
	TELL 0 PU SETXY [-450 -150]
	SETW 1 SETPC "LIGHTGRAY PD (STAMPRECT 300 300 TRUE) PU
	PLACE.TILES
	SCRAMBLE.PUZZLE
	MAKE "MOVE.COUNT -1
	UPDATE.MOVES
END

TO GRID.LINES
	SETTURTLES :ROWS + 1
	TELLALL 0 :ROWS
	SHOWTURTLE
	PENUP
	SETWIDTH 2
	LOCAL "X
	LOCAL "Y
	MAKE "X -450
	MAKE "Y 150
	EACH [SETX :X + (WHO * :CELL.SIZE)]
	EACH [SETY :Y]
	SETHEADING 180
	PENDOWN
	FORWARD :PUZZLE.SIZE
	PENUP
	EACH [SETX :X]
	EACH [SETY :Y - (WHO * :CELL.SIZE)]
	SETHEADING 90
	PENDOWN
	FORWARD :PUZZLE.SIZE
	PENUP
	HIDETURTLE
END

TO SCRAMBLE.PUZZLE
	REPEAT :SCRAMBLE.COUNT [SWAP PICK.MOVE]
END

TO PICK.MOVE
	LOCAL "MOVE
	MAKE "MOVE PICK BUTMEMBER :LAST.MOVE AGET :VALID.MOVES :BLANK.CELL
	MAKE "LAST.MOVE :MOVE
	OUTPUT :MOVE
END

TO PLACE.TILES
	ASK :ACTOR [HT]
	LOCAL "TILES
	MAKE "TILES (:ROWS * :COLS) - 1	; don't place lower right tile
	PLACE.TILE 0 :TILES
END

TO PLACE.TILE :TILE :TILES
	IF :TILE = :TILES [STOP]
	PPROP THING WORD "TILE. :TILE "VISIBLE TRUE
	PPROP THING WORD "TILE. :TILE "POSITION (GPROP THING WORD "TILE. :TILE "STP.ANCHOR)
	PLACE.TILE (:TILE + 1) :TILES
END

TO CLUNK
	PLAY [M10 N56]
END

TO MAKE.PICLIST
	MAKE "PICLIST []
	MAKE "TOOLBOX [ANIMALS BACKGROUNDS BIRDS PLANTS ROBOTS SEALIFE VEHICLES]

	MAKE "ANIMALS [ANIMALS
		APE.PNG BEE.PNG CAT.PNG CAT2.PNG CHAMELEON.PNG ELEPHANT.PNG FLAMINGO.PNG GIRAFFE.PNG GOAT.PNG LLAMA.PNG OSTRICH.PNG PEACOCK.PNG RABBIT.PNG SEAGULL.PNG TURTLE.PNG ZEBRA.PNG]

	MAKE "BACKGROUNDS [BACKGROUNDS
		CREOLEQUEEN.PNG EARTH.PNG JUNGLE.PNG LANZAROTE.PNG MEADOW.PNG MOUNTAIN1.PNG MOUNTAINROAD.PNG MOUNTAINS.PNG NEWYORK.PNG NORWAY.PNG SNOWMOUNTAIN.PNG SUNSET.PNG TREES.PNG USAMAP.PNG WINTER.PNG YOSEMITE.PNG]

	MAKE "BIRDS [BIRDS
		BIRD1.PNG BIRD2.PNG DUCK1.PNG DUCK2.PNG DUCK3.PNG FLAMINGO.PNG HEN.PNG SPARROW.PNG SPARROW2.PNG SPARROW3.PNG TURKEY.PNG]

	MAKE "PLANTS [PLANTS
		APPLE.PNG AUTUMNLEAF.PNG BLUEFLOWER.PNG PINKFLOWER.PNG ROSE.PNG STRAWBERRY.PNG SUNFLOWER.PNG YELLOWFLOWER.PNG YELLOWROSE.PNG]

	MAKE "ROBOTS [ROBOTS
		|bee-bot.png| BLUEBOT.PNG FINCH.PNG PROBOT.PNG ROOTBOT.PNG S2.PNG]

	MAKE "SEALIFE [SEALIFE
		FISH1.PNG FISH3.PNG FISH4.PNG JELLYFISH.PNG LOBSTER.PNG WHALE1.PNG]

	MAKE "VEHICLES [VEHICLES
		FREIGHTLINER.PNG ISS.PNG TRAIN.PNG]

	FOREACH :TOOLBOX [ADD.PICS FIRST THING "? BF THING "?]

	DECLARE "LISTBOX "PICLISTBOX
	PPROPS "PICLISTBOX [SIZE [300 300] POSITION [300 0] RUN [LOAD.PUZZLE] TOOLTIP |Pictures from the Toolbox|]
	PPROP "PICLISTBOX "ITEMS :PICLIST

	PPROP "PICLISTBOX "INDEX (RANDOM 0 ( (COUNT :PICLIST) - 1))
	LOAD.PUZZLE
END

TO ADD.PICS :D :L
	FOREACH :L [MAKE "PICLIST SE :PICLIST (WORD :D "/ "?)]
END

TO LOAD.PUZZLE
	TELL 0 PU SETXY [-450 -150]
	SETW 1 SETPC "WHITE PD (STAMPRECT 300 300 TRUE) PU
	IF NAME? "ACTOR [ERASE :ACTOR]
	IF NAME? "STP.BITMAPS [ERASE :STP.BITMAPS]
	MAKE "ACTOR LOADSNAP (WORD "~HOME/TOOLBOX/ GPROP "PICLISTBOX "TEXT)
	PPROPS :ACTOR [SIZE [300 300] POSITION [-300 0]]
	TELL 0 PU SETXY [-450 -150]
	SETW 3 SETPC "BLACK PD STAMPRECT 300 300 PU
END

TO MAIN
	SETUP
END

TO SOLVE
	TELL BL :STP.BITMAPS
	HOME ST
	EACH [SETXY GPROP WHO "STP.ANCHOR]
	PPROPS "PLAY.BUTTON [TEXT |Play| RUN [PLAY.PUZZLE]]
	PPROP "PICLISTBOX "ENABLED TRUE
END

MAIN

---

Procedure	MAIN
Description	Classical sliding tile puzzle game
Level	Advanced
Tags	Game