15 Puzzle

- Sam Lloyd

The classic 15 numbered tiles in a box.

Instructions
Shuffle the tiles and attempt to return them to their initial positions.

Controls Mouse only - no keyboard
Click a tile to slide it into an adjacent space
Click the tabs below the puzzle for more game options

To New
  # set default screen, pen and turtle values
  ResetAll SetScreenSize [400 400] HideTurtle
  SetSC Black SetPC Green SetPS 1 PenUp
End

To Init
  Make "Home [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0]
  Make "Tiles :Home
  Make "TileSets [
    [ [1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 0] [Classic] ]
    [ [a b c d e f g h i j k l m n o 0] [Alphabet] ]
    [ [R A T E Y O U R M I N D P A L 0] [watch those A's !] ]
    [ [i ii iii iv v vi vii viii ix x xi xii xiii xiv xv 0] [Roman] ]
    [ [1 2 3 4 5 6 7 8 9 10 11 12 13 15 14 0] [impossible, 1 swop] ]
    [ [qq qr qs qt rq rr rs rt sq sr ss st tq tr ts tt] [Matrix] ] ]
  Make "TileSel 1 Make "TileSet First (Item :TileSel :TileSets)
  Make "Tabs [ [Quit] [Lights] [Chequer] [Tiles] [Reset] [Shuffle] ]
  Make "GridPos False Make "Count 0
  Make "Light? False Make "Cheque? False
  Make "Shuffle? False Make "Win? False
End

To Title
  # write header
  SetPC White SetFontSize 18
  SetPos [-180 174] Label [15 Puzzle]
End

To Tabs
  For [M -1 4] [
    SetPos ScreenPos List :M 5
    SetPC Gray Button 56 11 Forward 14 SetPC [102 102 102] Fill
    Make "Lab Item (:M+2) :Tabs
    SetPC White SetFontSize 12
    SetX (First Pos) -1 - ((LabelLength :Lab)/2) SetY (Last Pos)
    Label :Lab Wait 4]
End

To Box
  Home
  SetPC [153 51 51] Button 306 40 Fill
  SetPC [222 51 51] SetPW 2 Button 301 38 SetPW 1
  SetPC Black Button 296 35 Button 242 14 Button 252 19
  SetPC [222 51 51] SetPW 2 Button 247 17 SetPW 1
  SetPC DarkGreen Fill
End

To Button :Size :Corner
  # rounded corner shape drawn from centre (tp)
  Back :Size/2 Right 90 Back :Size/2-:Corner PenDown
  Repeat 4 [Forward :Size-2*:Corner LeftArc 90 :Corner]
  PenUp Forward :Size/2-:Corner Left 90 Forward :Size/2   # return to centre
End

To LeftArc :Angle :Radius
  # arc drawn relative to turtle position, angle & radius positive
  PenUp Right 90 Back :Radius Left :Angle
  Arc :Radius Heading Heading+:Angle
  Forward :Radius Left 90 PenDown
End

To DrawGrid
  For [N 0 3] [
    For [M 0 3] [
    DrawTile List :M :N Wait 4] ]
End

To DrawTile :GridMN
  # draw tile at grid position
  SetPos ScreenPos :GridMN
  Make "Num TileNumber :GridMN
  SetPC DarkGreen Button 58 12 FillZone   # erase tile
  If Not (:Num = 0) [
  Make "Icon Item :Num :TileSet
  SetPC Black Button 58 12
  If And :Cheque? OddTile :Num [
  SetPC [0 102 204] Make "Rim [0 153 255] ] [
  SetPC [0 153 204] Make "Rim [0 204 255] ]
  Fill
  SetPC Black Button 48 7
  SetPC :Rim SetPW 2 Button 53 10 SetPW 1
  If And :Light? (:Num = TileID :GridMN) [
  SetPC [204 255 255] ] [SetPC [0 0 51] ]
  SetFontSize 36
  SetX (First Pos) -1 - ((LabelLength :Icon)/2) SetY (Last Pos) - 14
  Label :Icon]
End

To OddTile :Num
  Make "Odd Member :Num [2 4 5 7 10 12 13 15]
  If :Odd = False [Output False] [Output True]
End

To TileNumber :GridMN
  Output Item TileID :GridMN :Tiles
End

To TileID :GridMN
  Output 1+(First :GridMN)+4*(Last :GridMN)
End

To ScreenPos :GridMN
  # return X Y screen position
  Make "X ((First :GridMN)*60) - 90
  Make "Y Minus (((Last :GridMN)*60) - 90)
  Output List :X :Y
End

To User
  Make "Input ReadMouse   # wait for mouse input
  Make "MouseGP Gridd MousePos
  Make "NewGP :MouseGP
  If Not OverTiles :MouseGP [
    Make "NewGP False] [
  If (TileNumber :MouseGP) = 0 [
    Make "NewGP False] ]
  If OverTabs :MouseGP [
    Make "NewGP :MouseGP]
  If :Input = 0 [
    If :NewGP = :GridPos [Stop]
    If Not (:GridPos = False) [
      SetPC Black SetPos ScreenPos :GridPos Button 58 12 ]
    If Not (:NewGP = False) [
      SetPC Yellow SetPos ScreenPos :NewGP Button 58 12 ]
    Make "GridPos :NewGP ]
  If :Input = 1 [
    If :NewGP = False [Stop]
  If OverTabs :MouseGP [
    Run Item (2+(First :NewGP)) :Tabs ] [
      Make "BlankPos BlankNeigh :NewGP
      If :BlankPos = False [Stop]
      TileSwap :NewGP :BlankPos
      If Not :Win? [Counter]
      Make "GridPos False
      If And :Shuffle? (:Tiles = :Home) [
      Make "Win? True Halo Inform [!! Won !!]] ] ]
End

To Gridd :MsePos
  # return grid position from mousepos
  Make "M Round ((First :MsePos)+90) / 60
  Make "N Round ((Minus (Last :MsePos))+90) / 60
  Output List :M :N
End

To OverTiles :GridMN
  # return true if over tile area, else false
  If Or Or Or ((First :GridMN)>3) ((First :GridMN)<0)
      ((Last :GridMN)>3) ((Last :GridMN)<0) [
      Output False] [Output True]
End

To OverTabs :GridMN
  # return true if over tabs area, else false
  If Or Or ((First :GridMN)>4) ((First :GridMN)<-1) (Not (Last :GridMN)=5)     [Output False] [Output True]
End

To BlankNeigh :GridMN
  #return position of blank neighbour, else False
  Make "Tile False
  Repeat 4 [
    Make "J Int Sin 90*RepCount Make "K Int Cos 90*RepCount
    Make "M (First :GridMN) +:J Make "N (Last :GridMN) +:K
    If (OverTiles List :M :N) [
      If (0 =TileNumber List :M :N) [Make "Tile List :M :N] ] ]
  Output :Tile
End

To TileSwap :Tile1 :Tile2
  Make "Num1 TileNumber :Tile1
  Make "Num2 TileNumber :Tile2
  Make "Tiles SetItem :Tiles (TileID :Tile1) :Num2
  Make "Tiles SetItem :Tiles (TileID :Tile2) :Num1
  DrawTile :Tile1
  DrawTile :Tile2
End

To Quit
  Inform [Thanks For Playing !]
  StopAll
End

To Lights
  Make "Light? Not :Light?
  DrawGrid
End

To Chequer
  Make "Cheque? Not :Cheque?
  DrawGrid
End

To Tiles
  Make "TileSel :TileSel+1
  If :TileSel > (Count :TileSets) [Make "TileSel 1]
  Make "TileSet First (Item :TileSel :TileSets)
  DrawGrid
  If Not :Win? [Inform Last (Item :TileSel :TileSets)]
End

To Reset
  ResetCounter
  Make "Shuffle? False
  Make "Tiles [0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0]
  DrawGrid
  Make "Tiles :Home
  DrawGrid
End

To Shuffle
  ResetCounter
  Make "Shuffle? True
  Repeat 16 [
    Make "Swap1 PickTile
    Make "Swap2 :Swap1
    While [:Swap1=:Swap2] [Make "Swap2 PickTile]
    TileSwap :Swap1 :Swap2]
End

To PickTile
  Make "Tile List Random 4 Random 4
  While [ (TileNumber :Tile) = 0] [Make "Tile List Random 4 Random 4]
  Output :Tile
End

To Counter
  # increment counter
  SetPC Black SetPW 18
  SetPos [170 180] PenDown SetX 188 PenUp SetPW 1
  SetPos [164 174] SetFontSize 12 SetPC White
  Make "Count :Count+1 Label :Count
End

To ResetCounter
  SetPC Black SetPW 18
  SetPos [170 180] PenDown SetX 188 PenUp SetPW 1
  Make "Count 0
  If :Win? [Make "Win? False Halo Inform Last (Item :TileSel :TileSets)]
End

To Inform :Info
  SetPos [-100 -138]
  SetPC [153 51 51] SetPW 20
  PenDown SetX 100 PenUp SetPW 1
  If :Win? [SetPC Yellow] [SetPC Black] SetFontSize 18
  SetPos List Minus((LabelLength :Info)/2) Minus 144
  Label :Info
End

To Halo
  If :Win? [SetPC Yellow] [SetPC Black]
  Home For [Size 315 355 10] [Button :Size 50]
End

To Go
  New Init Title Wait 20
  Box Wait 20 Tabs Wait 20 DrawGrid
  Inform "Welcome
  Forever [User]
End

15 Puzzle
15 Puzzle

Procedures blue
Variables pink
Comments green
Library gray