Small puzzle game

User projects written in or related to FreeBASIC.
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Small puzzle game

Postby badidea » May 09, 2010 23:24

Hello all,

I made small game in which you have to place tetris-like tiles in a square. There are about 2000 unique solutions, but finding 1 can be hard. I think a screen shot explains it all:

Image

My parents used to have this small puzzle game in real, so probably there is a patent on it. I would like to know if anyone has seen this in reality or as a software program before.

Controls are:
- Mouse left button to pick and place tiles
- Mouse wheel to rotate the selected tile

Made with:
- FBIde: 0.4.6
- fbc: FreeBASIC Compiler - Version 0.16 for win32 (target:win32)
- OS: Windows XP (build 2600, Service Pack 2)

Thanks to all the people who made freebasic reality!

Code: Select all

OPTION EXPLICIT
OPTION BYVAL

#DEFINE DEBUG 1
#DEFINE SHAPE_COUNT 12
#DEFINE SHAPE_MAX_ORIENTATION 8
#DEFINE SHAPE_SQUARES 5

#DEFINE SHAPE_C 0
#DEFINE SHAPE_X 1
#DEFINE SHAPE_T 2
#DEFINE SHAPE_F 3
#DEFINE SHAPE_W 4
#DEFINE SHAPE_I 5
#DEFINE SHAPE_Z 6
#DEFINE SHAPE_P 7
#DEFINE SHAPE_L 8
#DEFINE SHAPE_V 9
#DEFINE SHAPE_H 10
#DEFINE SHAPE_R 11

#DEFINE SQUARE_BORDER -1
#DEFINE SQUARE_EMPTY -2
#DEFINE BORDER_COLOR &H00505050

#DEFINE MOUSE_IDLE 0
#DEFINE MOUSE_POS_CHANGED 1
#DEFINE MOUSE_LB_PRESSED 2
#DEFINE MOUSE_LB_RELEASED 3
#DEFINE MOUSE_RB_PRESSED 4
#DEFINE MOUSE_RB_RELEASED 5
#DEFINE MOUSE_MB_PRESSED 6
#DEFINE MOUSE_MB_RELEASED 7
#DEFINE MOUSE_WHEEL_UP 8
#DEFINE MOUSE_WHEEL_DOWN 9

'never change these:
#DEFINE GRID 40
#DEFINE BOARD_X 800\GRID
#DEFINE BOARD_Y 600\GRID

#DEFINE MIDDLE_X1 5
#DEFINE MIDDLE_X2 MIDDLE_X1 + 10
#DEFINE MIDDLE_Y1 5
#DEFINE MIDDLE_Y2 MIDDLE_Y1 + 6

#DEFINE SQUARE_TEST_OUT 2
#DEFINE SQUARE_TEST_INOK 1


'------------------------- Type defenitions -------------------------

type shapeType
  x(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  y(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  rotate as integer
  mirror as integer
  orientations as integer
  colour as integer
  symbol as string
  xActual as integer 'actual position
  yActual as integer 'actual position
  oActual as integer 'actual orientation
  xStart as integer 'original position
  yStart as integer 'original position
  oStart as integer 'original orientation
end type

type mouseType
 x as integer
 y as integer
 wheel as integer
 buttons as integer
 lb as integer 'left button
 rb as integer 'right button
 mb as integer 'middle button
end type

'------------------------- Functions declarations -------------------------

declare function checkFinish()
declare sub showBoard
declare sub initBoard
declare sub showAllShapes
declare function testShape(x as integer, y as integer, number as integer, o as integer)
declare sub setShape(x as integer, y as integer, number as integer, o as integer)
declare sub deleteShape(number as integer)
declare sub resetShape(number as integer)
declare sub drawShape(x as integer, y as integer, number as integer, o as integer)
declare sub initShapes()
declare function handleMouse(byref mouse as mouseType)

'------------------------- Variable declarations -------------------------

dim shared as shapeType shape(SHAPE_COUNT-1)
dim as integer i, j, k, x, y
dim as mousetype mouse
dim as integer mouseEvent
dim as integer dragShape = 0
dim as integer xGrid, yGrid
dim shared as integer board(BOARD_X-1, BOARD_Y-1)
dim as integer shapeSelected = -1
dim as integer orientSelected = 0
dim as integer shapePosTest = 0

'------------------------- Here program begins -------------------------

initShapes()
initBoard()

screen 19, 32

showBoard()


while inkey$ = ""
  mouseEvent = handleMouse(mouse)
  if (mouseEvent = 0) then sleep 10
  if (mouse.x = -1) then xGrid = -1 else xGrid = mouse.x\GRID
  if (mouse.y = -1) then yGrid = -1 else yGrid = mouse.y\GRID
  if(DEBUG) then locate 1, 1: print xGrid; " ";
  if(DEBUG) then locate 2, 1: print yGrid; " ";
  'locate 22, 2: print mouse.x; "   ";
  'locate 23, 2: print mouse.y; "   ";
  'locate 22, 2: print mouseEvent; "   ";

  select case mouseEvent
  case MOUSE_IDLE
    sleep 10
  case MOUSE_POS_CHANGED
  case MOUSE_LB_PRESSED
    if (shapeSelected = -1) then
      shapeSelected = board(xGrid, yGrid)
      if (shapeSelected = SQUARE_BORDER or shapeSelected = SQUARE_EMPTY) then
        shapeSelected = -1
      else
        orientSelected = shape(shapeSelected).oActual
        deleteShape(shapeSelected)
      end if
    else 'action if a shape is placed
      'moveShape(xGrid, yGrid, shapeSelected, orientSelected)
      shapePosTest = testShape(xGrid, yGrid, shapeSelected, orientSelected)
      if (shapePosTest = SQUARE_TEST_INOK) then
        setShape(xGrid, yGrid, shapeSelected, orientSelected)
        shapeSelected = -1
      end if
      if (shapePosTest = SQUARE_TEST_OUT) then
        resetShape(shapeSelected)
        shapeSelected = -1
      end if
    end if
  case MOUSE_WHEEL_UP
    if (shapeSelected <> -1) then
      orientSelected += 1
      if(orientSelected >= shape(shapeSelected).orientations) then orientSelected = 0
    end if
  case MOUSE_WHEEL_DOWN
    if (shapeSelected <> -1) then
      orientSelected -= 1
      if(orientSelected < 0) then orientSelected = shape(shapeSelected).orientations - 1
    end if
  case MOUSE_RB_PRESSED
    if(DEBUG) then
      cls
      showAllShapes()
      sleep 2500
    end if
  case else
  end select

  if (mouseEvent <> MOUSE_IDLE) then
    screensync
    showBoard()
    if (shapeSelected <> -1 and mouse.x <> -1) then
      drawShape(xGrid, yGrid, shapeSelected, orientSelected)
    end if
    if (checkFinish) then
      Locate 19,45: Print "Finished!";     
    end if
  end if

wend

end

'------------------------- Here subroutines start -------------------------

function checkFinish()
  dim as integer x, y
  for y = MIDDLE_Y1 to MIDDLE_Y2 - 1
    for x = MIDDLE_X1 to MIDDLE_X2 - 1
      if (board(x,y) = SQUARE_EMPTY) then return 0
    next
  next
  return 1
end function

sub showBoard
  dim as integer x, y, c, iSquare
  for y = 0 to BOARD_Y-1
    for x = 0 to BOARD_X-1
      iSquare = board(x, y)
      if (iSquare = SQUARE_EMPTY) then
        line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), &H00000000, bf
      else
        if (iSquare = SQUARE_BORDER) then
          line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), BORDER_COLOR, bf
        else
          if (iSquare < 0 or iSquare >= 12) then beep
          c = shape(iSquare).colour
          line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), c, bf
        end if
      end if
    next
  next
end sub

sub initBoard
  dim as integer x, y, i
  'draw grey squares
  for y = 0 to BOARD_Y-1
    for x = 0 to BOARD_X-1
      if (y < MIDDLE_Y1 or y >= MIDDLE_Y2 or x < MIDDLE_X1 or x >= MIDDLE_X2) then
        board(x, y) = SQUARE_BORDER
      else
        board(x, y) = SQUARE_EMPTY
      end if
    next
  next
  'draw shape in initial positions
  setShape(1,2,0,0)
  setShape(5,2,1,0)
  setShape(9,2,2,0)
  setShape(13,2,3,0)
  setShape(17,2,4,0)
  setShape(18,6,5,0)
  setShape(2,6,6,0)
  setShape(2,9,7,0)
  setShape(3,13,8,7)
  setShape(17,9,9,3)
  setShape(7,13,10,3)
  setShape(12,13,11,3)
  'copy actual position/orientation to current position/orientation
  for i = 0 to SHAPE_COUNT-1
    shape(i).xStart = shape(i).xActual
    shape(i).yStart = shape(i).yActual
    shape(i).oStart = shape(i).oActual
  next
end sub

sub showAllShapes
  dim as integer i, j, k, x, y
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to shape(i).orientations-1
      x = 50 + i * 60
      y = 50 + j * 60
      line (x-10,y)-(x+10,y), 7
      line (x,y-10)-(x,y+10), 7
      for k = 0 to SHAPE_SQUARES-1
        line (x + shape(i).x(j, k) * 10, y + shape(i).y(j, k) * 10)- step(8,8), shape(i).colour, bf
      next
    next
  next
end sub

function testShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, xi, yi
  dim as integer newPosValid = SQUARE_TEST_INOK
  dim as integer squaresOut = 0
  'Check if move possible
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + x
    yi = shape(number).y(o, i) + y
    'Check all out of middle
    if (yi < MIDDLE_Y1 or yi >= MIDDLE_Y2 or xi < MIDDLE_X1 or xi >= MIDDLE_X2) then
      SquaresOut += 1
    end if
    if (SquaresOut = 5) then return SQUARE_TEST_OUT
    'Check all on empty square
    if (xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      if (board(xi,yi) <> SQUARE_EMPTY) then
        newPosValid = 0 'put on grey tile or on other shape
      end if
    else
      newPosValid = 0 'out of boundaries
    end if
  next
  return newPosValid
end function
 
sub setShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, xi, yi
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + x
    yi = shape(number).y(o, i) + y
    if (xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      board(xi,yi) = number
    else
      beep
    end if
  next
  shape(number).xActual = x
  shape(number).yActual = y
  shape(number).oActual = o
end sub

sub deleteShape(number as integer)
  dim as integer i, xi, yi, o
  o = shape(number).oActual
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + shape(number).xActual
    yi = shape(number).y(o, i) + shape(number).yActual
    if(xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      board(xi,yi) = SQUARE_EMPTY
    else
      beep
    end if
  next
end sub

sub resetShape(number as integer)
  dim as integer x, y, o
  x = shape(number).xStart
  y = shape(number).yStart
  o = shape(number).oStart
  setShape(x, y, number, o)
end sub

sub drawShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, x2, y2
  for i = 0 to SHAPE_SQUARES-1
    x2 = (shape(number).x(o, i) + x) * GRID
    y2 = (shape(number).y(o, i) + Y) * GRID
    line (x2, y2)- step(GRID - 2, GRID - 2), shape(number).colour, b
    line (x2+1, y2+1)- step(GRID - 4, GRID - 4), shape(number).colour, b
    line (x2+2, y2+2)- step(GRID - 6, GRID - 6), shape(number).colour, b
  next
end sub

sub initShapes()
  dim as integer i,j,k
  dim as integer minx, miny, maxx, maxy
  'Init shapes with orientation = 0
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).x(0, j)
      if(DEBUG) then print shape(i).x(0, j);
    next
    if(DEBUG) then print
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).y(0, j)
      if(DEBUG) then print shape(i).y(0, j);
    next
    if(DEBUG) then print
    read shape(i).rotate
    read shape(i).mirror
    read shape(i).colour
    read shape(i).symbol
  next
 
  'Create shapes with other orientations if applicable
  for i = 0 to SHAPE_COUNT-1
    shape(i).orientations = 1
    if(shape(i).rotate = 90) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
      next
      shape(i).orientations *= 2
    end if
    if(shape(i).rotate = 360) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
        shape(i).x(2, j) = -shape(i).y(1, j)
        shape(i).y(2, j) = shape(i).x(1, j)
        shape(i).x(3, j) = -shape(i).y(2, j)
        shape(i).y(3, j) = shape(i).x(2, j)
      next
      shape(i).orientations *= 4
    end if
    if(shape(i).mirror) then
      for k = 0 to shape(i).orientations-1
        for j = 0 to SHAPE_SQUARES-1
          shape(i).x(k+shape(i).orientations, j) = -shape(i).x(k, j)
          shape(i).y(k+shape(i).orientations, j) = shape(i).y(k, j)
        next
      next
      shape(i).orientations *= 2
    end if
    if(DEBUG) then print shape(i).symbol;
    if(DEBUG) then print shape(i).orientations
  next

  'define virtual center of shape + correct
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to shape(i).orientations-1
      minx = +100: miny = +100
      maxx = -100: maxy = -100
      for k = 0 to SHAPE_SQUARES-1
        if(shape(i).x(j,k) > maxx) then maxx = shape(i).x(j,k)
        if(shape(i).y(j,k) > maxy) then maxy = shape(i).y(j,k)
        if(shape(i).x(j,k) < minx) then minx = shape(i).x(j,k)
        if(shape(i).y(j,k) < miny) then miny = shape(i).y(j,k)
      next
      for k = 0 to SHAPE_SQUARES-1
        shape(i).x(j,k) -= (minx + maxx) \ 2.0
        shape(i).y(j,k) -= (miny + maxy) \ 2.0
      next
    next
  next
end sub

function handleMouse(byref mouse as mouseType)
  static previous as mouseType
  dim as integer change = MOUSE_IDLE
  getmouse mouse.x, mouse.y, mouse.wheel, mouse.buttons
  mouse.lb = (mouse.buttons and 1)
  mouse.rb = (mouse.buttons shr 1) and 1
  mouse.mb = (mouse.buttons shr 2) and 1
  if (previous.x <> mouse.x or previous.y <> mouse.y) then
    change = MOUSE_POS_CHANGED
  end if
  if (previous.buttons <> mouse.buttons) then
    if (previous.lb = 0 and mouse.lb = 1) then change = MOUSE_LB_PRESSED
    if (previous.lb = 1 and mouse.lb = 0) then change = MOUSE_LB_RELEASED
    if (previous.rb = 0 and mouse.rb = 1) then change = MOUSE_RB_PRESSED
    if (previous.rb = 1 and mouse.rb = 0) then change = MOUSE_RB_RELEASED
    if (previous.mb = 0 and mouse.mb = 1) then change = MOUSE_MB_PRESSED
    if (previous.mb = 1 and mouse.mb = 0) then change = MOUSE_MB_RELEASED
  end if
  if (mouse.wheel > previous.wheel) then change = MOUSE_WHEEl_UP
  if (mouse.wheel < previous.wheel) then change = MOUSE_WHEEl_DOWN
  previous = mouse
  return change
end function

'Shape 0: "C"
data 0, 1, 0 ,0, 1 'x
data 0, 0, 1, 2, 2 'y
data 360, 0 'rotate, mirror
data &H00DF0000, "C" 'colour, symbol
'Shape 1: "X"
data 1, 0, 1 ,2, 1 'x
data 0, 1, 1, 1, 2 'y
data 0, 0 'rotate, mirror
data &H0000DF00, "X" 'colour, symbol
'Shape 2: "T"
data 0, 1, 2 ,1, 1 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H000000DF, "T" 'colour, symbol
'Shape 3: "F"
data 1, 2, 0 ,1, 1 'x
data 0, 0, 1, 1, 2 'y
data 360, 1 'rotate, mirror
data &H00DF00DF, "F" 'colour, symbol
'Shape 4: "W"
data 1, 2, 0 ,1, 0 'x
data 0, 0, 1, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00DFDF00, "W" 'colour, symbol
'Shape 5: "I"
data 0, 0, 0 ,0, 0 'x
data 0, 1, 2, 3, 4 'y
data 90, 0 'rotate, mirror
data &H0000DFDF, "I" 'colour, symbol
'Shape 6: "Z"
data 0, 1, 1 ,1, 2 'x
data 0, 0, 1, 2, 2 'y
data 90, 1 'rotate, mirror
data &H00DFDFDF, "Z" 'colour, symbol
'Shape 7: "P"
data 0, 1, 2 ,0, 1 'x
data 0, 0, 0, 1, 1 'y
data 360, 1 'rotate, mirror
data &H007777FF, "P" 'colour, symbol
'Shape 8: "L"
data 0, 0, 0 ,0, 1 'x
data 0, 1, 2, 3, 3 'y
data 360, 1 'rotate, mirror
data &H0077FF77, "L" 'colour, symbol
'Shape 9: "V"
data 0, 1, 2 ,0, 0 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00FF7777, "V" 'colour, symbol
'Shape 10: "H"
data 1, 1, 0 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FF77DF, "H" 'colour, symbol
'Shape 11: "R"
data 0, 0, 1 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FFDF77, "R" 'colour, symbol

Last edited by badidea on Jan 16, 2011 17:43, edited 3 times in total.
Ophelius
Posts: 428
Joined: Feb 26, 2006 1:57

Postby Ophelius » May 10, 2010 4:16

Great puzzle. This will keep me busy for a while ;)
rolliebollocks
Posts: 2655
Joined: Aug 28, 2008 10:54
Location: new york

Postby rolliebollocks » May 10, 2010 17:03

Cool! You should download a new copy of the compiler... There's a newer version availible. Also, you need to add:

Code: Select all

#lang "fblite"


at the very top for it compile under .20 which is what I'm using.
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Postby agamemnus » May 10, 2010 18:21

Nice!

I'd write more but I'm trying to solve the puzzle!
dkl
Site Admin
Posts: 3210
Joined: Jul 28, 2005 14:45
Location: Germany

Postby dkl » May 10, 2010 19:33

Cool graphics, nicely done!

I know a "hardware" version called Ubongo (http://en.wikipedia.org/wiki/Ubongo), with the same basic idea. There even is a 3D version (you can see it on youtube).
h4tt3n
Posts: 691
Joined: Oct 22, 2005 21:12
Location: Denmark

Postby h4tt3n » May 10, 2010 19:34

Nice, trying to solve...

Reminds me of Machinarium, which has some really great puzzles in it too.

Cheers,
Mike
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Postby badidea » May 10, 2010 20:49

@rolliebollocks:

I will upgrade to the latest compiler version

@dkl

Ubongo, seems to use smaller shapes as well, but this wikipedia item looks useful:

http://en.wikipedia.org/wiki/Pentamino
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Postby agamemnus » May 11, 2010 5:44

Done!.... and cheated... :{

Suggestions:
* Make a key to flip pieces. It's not overly obvious that you can rotate them more than once to flip them.
* Flicker... make it go away. :(
* Tell future users about the thing that happens when you right-click!
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Postby badidea » May 11, 2010 16:36

Good Suggestions.
- Right mouse button is a debug feature (if you define debug 0, it is disabled).
- I have to look in to this flicker, removing 'screensync' in line 173 improves things.
I have plans to implement an automatic solver and/or store found solutions, but this will take some time.

Update:
- Removed the flicker and the right mouse button stuff
- Compatible with 0.20.0
- Requires escape key to end now

Code: Select all

#lang "fblite"

'todo:
' - mirror with 2nd button or keys
' - merge 1 shape
' - add solver
' - add store & retrieve

OPTION EXPLICIT
OPTION BYVAL

#DEFINE DEBUG 0
#DEFINE SHAPE_COUNT 12
#DEFINE SHAPE_MAX_ORIENTATION 8
#DEFINE SHAPE_SQUARES 5

#DEFINE SHAPE_C 0
#DEFINE SHAPE_X 1
#DEFINE SHAPE_T 2
#DEFINE SHAPE_F 3
#DEFINE SHAPE_W 4
#DEFINE SHAPE_I 5
#DEFINE SHAPE_Z 6
#DEFINE SHAPE_P 7
#DEFINE SHAPE_L 8
#DEFINE SHAPE_V 9
#DEFINE SHAPE_H 10
#DEFINE SHAPE_R 11

#DEFINE SQUARE_BORDER -1
#DEFINE SQUARE_EMPTY -2
#DEFINE BORDER_COLOR &H00505050

#DEFINE MOUSE_IDLE 0
#DEFINE MOUSE_POS_CHANGED 1
#DEFINE MOUSE_LB_PRESSED 2
#DEFINE MOUSE_LB_RELEASED 3
#DEFINE MOUSE_RB_PRESSED 4
#DEFINE MOUSE_RB_RELEASED 5
#DEFINE MOUSE_MB_PRESSED 6
#DEFINE MOUSE_MB_RELEASED 7
#DEFINE MOUSE_WHEEL_UP 8
#DEFINE MOUSE_WHEEL_DOWN 9

'never change these:
#DEFINE GRID 40
#DEFINE BOARD_X 800\GRID
#DEFINE BOARD_Y 600\GRID

#DEFINE MIDDLE_X1 5
#DEFINE MIDDLE_X2 MIDDLE_X1 + 10
#DEFINE MIDDLE_Y1 5
#DEFINE MIDDLE_Y2 MIDDLE_Y1 + 6

#DEFINE SQUARE_TEST_OUT 2
#DEFINE SQUARE_TEST_INOK 1


'------------------------- Type defenitions -------------------------

type shapeType
  x(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  y(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  rotate as integer
  mirror as integer
  orientations as integer
  colour as integer
  symbol as string
  xActual as integer 'actual position
  yActual as integer 'actual position
  oActual as integer 'actual orientation
  xStart as integer 'original position
  yStart as integer 'original position
  oStart as integer 'original orientation
end type

type mouseType
 x as integer
 y as integer
 wheel as integer
 buttons as integer
 lb as integer 'left button
 rb as integer 'right button
 mb as integer 'middle button
end type

'------------------------- Functions declarations -------------------------

declare function checkFinish()
declare sub showBoard
declare sub initBoard
declare sub showAllShapes
declare function testShape(x as integer, y as integer, number as integer, o as integer)
declare sub setShape(x as integer, y as integer, number as integer, o as integer)
declare sub deleteShape(number as integer)
declare sub resetShape(number as integer)
declare sub drawShape(x as integer, y as integer, number as integer, o as integer)
declare sub initShapes()
declare function handleMouse(byref mouse as mouseType)

'------------------------- Variable declarations -------------------------

dim shared as shapeType shape(SHAPE_COUNT-1)
dim as integer i, j, k, x, y
dim as mousetype mouse
dim as integer mouseEvent
dim as integer dragShape = 0
dim as integer xGrid, yGrid
dim shared as integer board(BOARD_X-1, BOARD_Y-1)
dim as integer shapeSelected = -1
dim as integer orientSelected = 0
dim as integer shapePosTest = 0
dim as integer screenWorkPage = 0, screenVisiblePage = 1

'------------------------- Here program begins -------------------------

initShapes()
initBoard()

screen 19, 32, 2 '800x600, 32bit, 2 pages
showBoard()
sleep 100 'small delay seems needed for mouse
handleMouse(mouse) 'initialize mouse handler

while inkey$ <> chr$(27) 'escape key
  mouseEvent = handleMouse(mouse)
  if (mouseEvent = 0) then sleep 10
  if (mouse.x = -1) then xGrid = -1 else xGrid = mouse.x\GRID
  if (mouse.y = -1) then yGrid = -1 else yGrid = mouse.y\GRID

  select case mouseEvent
  case MOUSE_IDLE
    sleep 10
  case MOUSE_POS_CHANGED
  case MOUSE_LB_PRESSED
    if (shapeSelected = -1) then
      shapeSelected = board(xGrid, yGrid)
      if (shapeSelected = SQUARE_BORDER or shapeSelected = SQUARE_EMPTY) then
        shapeSelected = -1
      else
        orientSelected = shape(shapeSelected).oActual
        deleteShape(shapeSelected)
      end if
    else 'action if a shape is placed
      'moveShape(xGrid, yGrid, shapeSelected, orientSelected)
      shapePosTest = testShape(xGrid, yGrid, shapeSelected, orientSelected)
      if (shapePosTest = SQUARE_TEST_INOK) then
        setShape(xGrid, yGrid, shapeSelected, orientSelected)
        shapeSelected = -1
      end if
      if (shapePosTest = SQUARE_TEST_OUT) then
        resetShape(shapeSelected)
        shapeSelected = -1
      end if
    end if
  case MOUSE_WHEEL_UP
    if (shapeSelected <> -1) then
      orientSelected += 1
      if(orientSelected >= shape(shapeSelected).orientations) then orientSelected = 0
    end if
  case MOUSE_WHEEL_DOWN
    if (shapeSelected <> -1) then
      orientSelected -= 1
      if(orientSelected < 0) then orientSelected = shape(shapeSelected).orientations - 1
    end if
  case else
  end select

  if (mouseEvent <> MOUSE_IDLE) then
    'screensync
    showBoard()
    if (shapeSelected <> -1 and mouse.x <> -1) then
      drawShape(xGrid, yGrid, shapeSelected, orientSelected)
    end if
    if (checkFinish) then
      Locate 19,45: Print "Finished!";     
    end if
    if(DEBUG) then locate 1, 1: print "x:";xGrid; " ";
    if(DEBUG) then locate 2, 1: print "y:";yGrid; " ";
    if(DEBUG) then locate 3, 1: print "m:";mouseEvent; " ";
    screenWorkPage = screenWorkPage xor 1
    screenVisiblePage = screenVisiblePage xor 1
    screenset screenWorkPage, screenVisiblePage
  end if

wend

end

'------------------------- Here subroutines start -------------------------

function checkFinish()
  dim as integer x, y
  for y = MIDDLE_Y1 to MIDDLE_Y2 - 1
    for x = MIDDLE_X1 to MIDDLE_X2 - 1
      if (board(x,y) = SQUARE_EMPTY) then return 0
    next
  next
  return 1
end function

sub showBoard
  dim as integer x, y, c, iSquare
  for y = 0 to BOARD_Y-1
    for x = 0 to BOARD_X-1
      iSquare = board(x, y)
      if (iSquare = SQUARE_EMPTY) then
        line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), &H00000000, bf
      else
        if (iSquare = SQUARE_BORDER) then
          line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), BORDER_COLOR, bf
        else
          if (iSquare < 0 or iSquare >= 12) then beep
          c = shape(iSquare).colour
          line (x * GRID, y * GRID)-step(GRID - 2, GRID - 2), c, bf
        end if
      end if
    next
  next
end sub

sub initBoard
  dim as integer x, y, i
  'draw grey squares
  for y = 0 to BOARD_Y-1
    for x = 0 to BOARD_X-1
      if (y < MIDDLE_Y1 or y >= MIDDLE_Y2 or x < MIDDLE_X1 or x >= MIDDLE_X2) then
        board(x, y) = SQUARE_BORDER
      else
        board(x, y) = SQUARE_EMPTY
      end if
    next
  next
  'draw shape in initial positions
  setShape(1,2,0,0)
  setShape(5,2,1,0)
  setShape(9,2,2,0)
  setShape(13,2,3,0)
  setShape(17,2,4,0)
  setShape(18,6,5,0)
  setShape(2,6,6,0)
  setShape(2,9,7,0)
  setShape(3,13,8,7)
  setShape(17,9,9,3)
  setShape(7,13,10,3)
  setShape(12,13,11,3)
  'copy actual position/orientation to current position/orientation
  for i = 0 to SHAPE_COUNT-1
    shape(i).xStart = shape(i).xActual
    shape(i).yStart = shape(i).yActual
    shape(i).oStart = shape(i).oActual
  next
end sub

sub showAllShapes
  dim as integer i, j, k, x, y
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to shape(i).orientations-1
      x = 50 + i * 60
      y = 50 + j * 60
      line (x-10,y)-(x+10,y), 7
      line (x,y-10)-(x,y+10), 7
      for k = 0 to SHAPE_SQUARES-1
        line (x + shape(i).x(j, k) * 10, y + shape(i).y(j, k) * 10)- step(8,8), shape(i).colour, bf
      next
    next
  next
end sub

function testShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, xi, yi
  dim as integer newPosValid = SQUARE_TEST_INOK
  dim as integer squaresOut = 0
  'Check if move possible
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + x
    yi = shape(number).y(o, i) + y
    'Check all out of middle
    if (yi < MIDDLE_Y1 or yi >= MIDDLE_Y2 or xi < MIDDLE_X1 or xi >= MIDDLE_X2) then
      SquaresOut += 1
    end if
    if (SquaresOut = 5) then return SQUARE_TEST_OUT
    'Check all on empty square
    if (xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      if (board(xi,yi) <> SQUARE_EMPTY) then
        newPosValid = 0 'put on grey tile or on other shape
      end if
    else
      newPosValid = 0 'out of boundaries
    end if
  next
  return newPosValid
end function
 
sub setShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, xi, yi
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + x
    yi = shape(number).y(o, i) + y
    if (xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      board(xi,yi) = number
    else
      beep
    end if
  next
  shape(number).xActual = x
  shape(number).yActual = y
  shape(number).oActual = o
end sub

sub deleteShape(number as integer)
  dim as integer i, xi, yi, o
  o = shape(number).oActual
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + shape(number).xActual
    yi = shape(number).y(o, i) + shape(number).yActual
    if(xi >= 0 and xi < BOARD_X and yi >= 0 and yi < BOARD_Y) then
      board(xi,yi) = SQUARE_EMPTY
    else
      beep
    end if
  next
end sub

sub resetShape(number as integer)
  dim as integer x, y, o
  x = shape(number).xStart
  y = shape(number).yStart
  o = shape(number).oStart
  setShape(x, y, number, o)
end sub

sub drawShape(x as integer, y as integer, number as integer, o as integer)
  dim as integer i, x2, y2
  for i = 0 to SHAPE_SQUARES-1
    x2 = (shape(number).x(o, i) + x) * GRID
    y2 = (shape(number).y(o, i) + Y) * GRID
    line (x2, y2)- step(GRID - 2, GRID - 2), shape(number).colour, b
    line (x2+1, y2+1)- step(GRID - 4, GRID - 4), shape(number).colour, b
    line (x2+2, y2+2)- step(GRID - 6, GRID - 6), shape(number).colour, b
  next
end sub

sub initShapes()
  dim as integer i,j,k
  dim as integer minx, miny, maxx, maxy
  'Init shapes with orientation = 0
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).x(0, j)
      if(DEBUG) then print shape(i).x(0, j);
    next
    if(DEBUG) then print
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).y(0, j)
      if(DEBUG) then print shape(i).y(0, j);
    next
    if(DEBUG) then print
    read shape(i).rotate
    read shape(i).mirror
    read shape(i).colour
    read shape(i).symbol
  next
 
  'Create shapes with other orientations if applicable
  for i = 0 to SHAPE_COUNT-1
    shape(i).orientations = 1
    if(shape(i).rotate = 90) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
      next
      shape(i).orientations *= 2
    end if
    if(shape(i).rotate = 360) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
        shape(i).x(2, j) = -shape(i).y(1, j)
        shape(i).y(2, j) = shape(i).x(1, j)
        shape(i).x(3, j) = -shape(i).y(2, j)
        shape(i).y(3, j) = shape(i).x(2, j)
      next
      shape(i).orientations *= 4
    end if
    if(shape(i).mirror) then
      for k = 0 to shape(i).orientations-1
        for j = 0 to SHAPE_SQUARES-1
          shape(i).x(k+shape(i).orientations, j) = -shape(i).x(k, j)
          shape(i).y(k+shape(i).orientations, j) = shape(i).y(k, j)
        next
      next
      shape(i).orientations *= 2
    end if
    if(DEBUG) then print shape(i).symbol;
    if(DEBUG) then print shape(i).orientations
  next

  'define virtual center of shape + correct
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to shape(i).orientations-1
      minx = +100: miny = +100
      maxx = -100: maxy = -100
      for k = 0 to SHAPE_SQUARES-1
        if(shape(i).x(j,k) > maxx) then maxx = shape(i).x(j,k)
        if(shape(i).y(j,k) > maxy) then maxy = shape(i).y(j,k)
        if(shape(i).x(j,k) < minx) then minx = shape(i).x(j,k)
        if(shape(i).y(j,k) < miny) then miny = shape(i).y(j,k)
      next
      for k = 0 to SHAPE_SQUARES-1
        shape(i).x(j,k) -= (minx + maxx) \ 2.0
        shape(i).y(j,k) -= (miny + maxy) \ 2.0
      next
    next
  next
end sub

function handleMouse(byref mouse as mouseType)
  static previous as mouseType
  dim as integer change = MOUSE_IDLE
  getmouse mouse.x, mouse.y, mouse.wheel, mouse.buttons
  mouse.lb = (mouse.buttons and 1)
  mouse.rb = (mouse.buttons shr 1) and 1
  mouse.mb = (mouse.buttons shr 2) and 1
  if (previous.x <> mouse.x or previous.y <> mouse.y) then
    change = MOUSE_POS_CHANGED
  end if
  if (previous.buttons <> mouse.buttons) then
    if (previous.lb = 0 and mouse.lb = 1) then change = MOUSE_LB_PRESSED
    if (previous.lb = 1 and mouse.lb = 0) then change = MOUSE_LB_RELEASED
    if (previous.rb = 0 and mouse.rb = 1) then change = MOUSE_RB_PRESSED
    if (previous.rb = 1 and mouse.rb = 0) then change = MOUSE_RB_RELEASED
    if (previous.mb = 0 and mouse.mb = 1) then change = MOUSE_MB_PRESSED
    if (previous.mb = 1 and mouse.mb = 0) then change = MOUSE_MB_RELEASED
  end if
  if (mouse.wheel > previous.wheel) then change = MOUSE_WHEEl_UP
  if (mouse.wheel < previous.wheel) then change = MOUSE_WHEEl_DOWN
  previous = mouse
  return change
end function

'Shape 0: "C"
data 0, 1, 0 ,0, 1 'x
data 0, 0, 1, 2, 2 'y
data 360, 0 'rotate, mirror
data &H00DF0000, "C" 'colour, symbol
'Shape 1: "X"
data 1, 0, 1 ,2, 1 'x
data 0, 1, 1, 1, 2 'y
data 0, 0 'rotate, mirror
data &H0000DF00, "X" 'colour, symbol
'Shape 2: "T"
data 0, 1, 2 ,1, 1 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H000000DF, "T" 'colour, symbol
'Shape 3: "F"
data 1, 2, 0 ,1, 1 'x
data 0, 0, 1, 1, 2 'y
data 360, 1 'rotate, mirror
data &H00DF00DF, "F" 'colour, symbol
'Shape 4: "W"
data 1, 2, 0 ,1, 0 'x
data 0, 0, 1, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00DFDF00, "W" 'colour, symbol
'Shape 5: "I"
data 0, 0, 0 ,0, 0 'x
data 0, 1, 2, 3, 4 'y
data 90, 0 'rotate, mirror
data &H0000DFDF, "I" 'colour, symbol
'Shape 6: "Z"
data 0, 1, 1 ,1, 2 'x
data 0, 0, 1, 2, 2 'y
data 90, 1 'rotate, mirror
data &H00DFDFDF, "Z" 'colour, symbol
'Shape 7: "P"
data 0, 1, 2 ,0, 1 'x
data 0, 0, 0, 1, 1 'y
data 360, 1 'rotate, mirror
data &H007777FF, "P" 'colour, symbol
'Shape 8: "L"
data 0, 0, 0 ,0, 1 'x
data 0, 1, 2, 3, 3 'y
data 360, 1 'rotate, mirror
data &H0077FF77, "L" 'colour, symbol
'Shape 9: "V"
data 0, 1, 2 ,0, 0 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00FF7777, "V" 'colour, symbol
'Shape 10: "H"
data 1, 1, 0 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FF77DF, "H" 'colour, symbol
'Shape 11: "R"
data 0, 0, 1 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FFDF77, "R" 'colour, symbol
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Solver

Postby badidea » Jun 10, 2010 23:07

Hello all,

I completed the automatic solver which finds all 2339 solutions (in 40 seconds on my PC). It is a non-playable version, just a demonstration. Escape key aborts the process. Please, ignore the missing images.

--- Edit: Code deleted, out of bounds array access. Will post a new version soon. ---

Have fun!
Last edited by badidea on Jun 12, 2010 23:41, edited 1 time in total.
segin
Posts: 126
Joined: Dec 27, 2005 5:22
Contact:

Postby segin » Jun 11, 2010 5:38

For compiling with the newest compiler, these errors come up:

tet.bas(2) error 135: Only valid in -lang deprecated or fblite or qb, found 'Option' in 'Option Explicit'
tet.bas(3) error 135: Only valid in -lang deprecated or fblite or qb, found 'Option' in 'Option Byval'
tet.bas(82) error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'Declare Function checkFinish()'
tet.bas(86) error 136: Default types or suffixes are only valid in -lang deprecated or fblite or qb in 'Declare Function testShape(x As Integer, y As Integer, number As Integer, o As Integer)'

I recommend addind this to the top of the code:

Code: Select all

#lang "fblite"
D.J.Peters
Posts: 7903
Joined: May 28, 2005 3:28

Re: Solver

Postby D.J.Peters » Jun 11, 2010 15:17

badidea wrote:... which finds all 2339 solutions (in 40 seconds on my PC).
Must be a very fast box my P4 with 3.2GHz needs ~70 seconds.

Joshy
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Postby badidea » Jun 11, 2010 19:36

It is a Dual Core 3.0 GHz (E8400).
badidea
Posts: 1704
Joined: May 24, 2007 22:10
Location: The Netherlands

Postby badidea » Jun 13, 2010 1:07

I improved the speed, removed the out of array bounds error, and removed all code not needed by the solver. It now takes 18.3 seconds to find all solutions on my system. With -exx compiler option ~70 sec.

Update: New version, 15 seconds.

Code: Select all

#lang "fblite"
#include "vbcompat.bi"

OPTION EXPLICIT
OPTION BYVAL

#DEFINE SHAPE_COUNT 12
#DEFINE SHAPE_MAX_ORIENTATION 8
#DEFINE SHAPE_SQUARES 5

#DEFINE SQUARE_BORDER -1
#DEFINE SQUARE_EMPTY -2
#DEFINE BORDER_COLOR &H00505050
#DEFINE SQUARE_PAINT -3

'never change these:
#DEFINE GRID 40
#DEFINE BOARD_X 20
#DEFINE BOARD_Y 15
#DEFINE PUZZLE_X 10
#DEFINE PUZZLE_Y 6

'MA = Middle Area
#DEFINE MA_X1 5
#DEFINE MA_X2 MA_X1 + 10
#DEFINE MA_Y1 5
#DEFINE MA_Y2 MA_Y1 + 6

'------------------------- Type defenitions -------------------------

type shapeType
  x(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  y(SHAPE_MAX_ORIENTATION-1, SHAPE_SQUARES-1) as integer
  xmin(SHAPE_MAX_ORIENTATION-1) as integer
  xmax(SHAPE_MAX_ORIENTATION-1) as integer
  ymin(SHAPE_MAX_ORIENTATION-1) as integer
  ymax(SHAPE_MAX_ORIENTATION-1) as integer
  rotate as integer
  mirror as integer
  orientations as integer
  colour as integer
  symbol as string
  xActual as integer 'actual position
  yActual as integer 'actual position
  oActual as integer 'actual orientation
  xStart as integer 'original position
  yStart as integer 'original position
  oStart as integer 'original orientation
end type

type puzzlePtrType
  puzzle(PUZZLE_X-1, PUZZLE_Y-1) as byte
end type

'------------------------- Functions declarations -------------------------

declare sub solver_fillGap(x as integer, y as integer)
declare function solver_checkBadGap() as integer
declare sub solve(iShape as integer)
declare sub showPuzzle()
declare sub duplicatePuzzle(srcArray as any ptr, dstArray as any ptr)
declare function timeFromStart() as double
declare sub initShapes()
declare function solver_testShape(x as integer, y as integer, iShape as integer, o as integer) as integer
declare sub solver_setShape(x as integer, y as integer, iShape as integer, o as integer)
declare sub solver_deleteShape(number as integer)

'------------------------- Variable declarations -------------------------

dim shared as shapeType shape(SHAPE_COUNT-1)
dim shared as byte puzzle(PUZZLE_X-1, PUZZLE_Y-1)
dim shared as byte tempPuzzle(PUZZLE_X-1, PUZZLE_Y-1) 'dim global for speed?
dim shared as integer solveCounter
dim shared as integer paintCounter
dim as double dummy

'------------------------- Here program begins -------------------------

initShapes()

screen 19, 32, 2 '800x600, 32bit, 2 pages
  line (0,0)-(799,599), &h00404040, bf
  shape(0).orientations = 2
  shape(0).ymax(0) = 2
  shape(0).xmax(1) = 4
  clear puzzle(0,0), SQUARE_EMPTY, 60
  solveCounter = 0
  dummy = timeFromStart()
  solve(0)
  sleep

end

sub solver_fillGap(x as integer, y as integer)
  'Uses recursive floodFill procedure
  tempPuzzle(x, y) = SQUARE_PAINT
  paintCounter += 1
  if ((x + 1) < PUZZLE_X) then
    if (tempPuzzle(x + 1, y) = SQUARE_EMPTY) then solver_fillGap(x + 1, y)
  end if
  if ((x - 1) >= 0) then
    if (tempPuzzle(x - 1, y) = SQUARE_EMPTY) then solver_fillGap(x - 1, y)
  end if
  if ((y + 1) < PUZZLE_Y) then
    if (tempPuzzle(x, y + 1) = SQUARE_EMPTY) then solver_fillGap(x, y + 1)
  end if
  if ((y - 1) >= 0) then
    if (tempPuzzle(x, y - 1) = SQUARE_EMPTY) then solver_fillGap(x, y - 1)
  end if
end sub

function solver_checkBadGap() as integer
  dim as integer x = any, y = any
  for y = 0 to PUZZLE_Y-1
    for x = 0 to PUZZLE_X-1
      if (tempPuzzle(x, y) = SQUARE_EMPTY) then
        paintCounter = 0
        solver_fillGap(x, y)
        if ((paintCounter mod 5) <> 0) then
          return 1 'bad gap
        end if
      end if
    next
  next
  return 0 'no gap
end function

sub solve(iShape as integer)
  dim as integer x = any, y = any, o = any
  static as integer abort = 0
  if (abort <> 1) then
    for o = 0 to shape(iShape).orientations-1
      for y = shape(iShape).ymin(o) to shape(iShape).ymax(o)
        for x = shape(iShape).xmin(o) to shape(iShape).xmax(o)
          if (solver_testShape(x, y, iShape, o)) then
            solver_setShape(x, y, iShape, o)
            if (iShape = SHAPE_COUNT-1) then
              'Found a solution
              solveCounter += 1
              showPuzzle()
              locate 2,3: print "Solution: " + str(solveCounter);
              locate 3,3: print "Timer: " + format(timeFromStart, "0.000");
              if inkey$ <> "" then abort = 1
            else
              'Check if piece placed nicely
              duplicatePuzzle(@puzzle(0,0), @tempPuzzle(0,0))
              if (solver_checkBadGap() = 0) then
                solve(iShape + 1)
              end if
            end if
            solver_deleteShape(iShape)
          end if
        next
      next
    next
  end if
end sub

sub showPuzzle()
  dim as integer x = any, y = any
  dim as integer xi = any, yi = any
  dim as integer c = any, i = any
  'used by solver
  for yi = 0 to PUZZLE_Y-1
    for xi = 0 to PUZZLE_X-1
      i = puzzle(xi, yi)
      if (i >= 0) and (i < SHAPE_COUNT) then
        c = shape(i).colour
      else
        c = &h00202020
      end if
      x = (xi + MA_X1) * GRID
      y = (yi + MA_Y1) * GRID
      line (x, y)-step(GRID - 2, GRID - 2), c, bf
    next
  next
end sub

sub duplicatePuzzle(srcArray as any ptr, dstArray as any ptr)
 dim as puzzlePtrType ptr scrPtr, dstPtr
 scrPtr = cptr(puzzlePtrType ptr, srcArray)
 dstPtr = cptr(puzzlePtrType ptr, dstArray)
 *dstPtr = *scrPtr
end sub

function timeFromStart as double
  static as double t0 = any
  static as integer init = 0
  if (init = 0) then
    init = 1
    t0 = timer
  end if
  return timer - t0
end function

sub initShapes()
  dim as integer i, j, k
  dim as integer minx, miny, maxx, maxy, offsx, offsy
  'Init shapes with orientation = 0
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).x(0, j)
    next
    for j = 0 to SHAPE_SQUARES-1
      read shape(i).y(0, j)
    next
    read shape(i).rotate
    read shape(i).mirror
    read shape(i).colour
    read shape(i).symbol
  next
  'Create shapes with other orientations if applicable
  for i = 0 to SHAPE_COUNT-1
    shape(i).orientations = 1
    if(shape(i).rotate = 90) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
      next
      shape(i).orientations *= 2
    end if
    if(shape(i).rotate = 360) then
      for j = 0 to SHAPE_SQUARES-1
        shape(i).x(1, j) = -shape(i).y(0, j)
        shape(i).y(1, j) = shape(i).x(0, j)
        shape(i).x(2, j) = -shape(i).y(1, j)
        shape(i).y(2, j) = shape(i).x(1, j)
        shape(i).x(3, j) = -shape(i).y(2, j)
        shape(i).y(3, j) = shape(i).x(2, j)
      next
      shape(i).orientations *= 4
    end if
    if(shape(i).mirror) then
      for k = 0 to shape(i).orientations-1
        for j = 0 to SHAPE_SQUARES-1
          shape(i).x(k+shape(i).orientations, j) = -shape(i).x(k, j)
          shape(i).y(k+shape(i).orientations, j) = shape(i).y(k, j)
        next
      next
      shape(i).orientations *= 2
    end if
  next
  'Define virtual center of shape + correct
  for i = 0 to SHAPE_COUNT-1
    for j = 0 to shape(i).orientations-1
      minx = +100: miny = +100
      maxx = -100: maxy = -100
      for k = 0 to SHAPE_SQUARES-1
        if(shape(i).x(j,k) > maxx) then maxx = shape(i).x(j,k)
        if(shape(i).y(j,k) > maxy) then maxy = shape(i).y(j,k)
        if(shape(i).x(j,k) < minx) then minx = shape(i).x(j,k)
        if(shape(i).y(j,k) < miny) then miny = shape(i).y(j,k)
      next
      for k = 0 to SHAPE_SQUARES-1
        offsx = (minx + maxx) \ 2.0
        offsy = (miny + maxy) \ 2.0
        shape(i).x(j,k) -= offsx
        shape(i).y(j,k) -= offsy
      next
      'And define max/min x/y for each piece
      shape(i).xmin(j) = 0 - (minx - offsx)
      shape(i).xmax(j) = 9 - (maxx - offsx)
      shape(i).ymin(j) = 0 - (miny - offsy)
      shape(i).ymax(j) = 5 - (maxy - offsy)
    next
  next
  'Read starting positions of pieces
  for i = 0 to SHAPE_COUNT-1
    read shape(i).xStart
    read shape(i).yStart
    read shape(i).oStart
  next
end sub

function solver_testShape(x as integer, y as integer, iShape as integer, o as integer) as integer
  dim as integer i = any, xi = any, yi = any
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(iShape).x(o, i) + x
    yi = shape(iShape).y(o, i) + y
    if (puzzle(xi,yi) <> SQUARE_EMPTY) then return 0
  next
  return 1
end function

sub solver_setShape(x as integer, y as integer, iShape as integer, o as integer)
  dim as integer i = any, xi = any, yi = any
  'set shapes on puzzle area
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(iShape).x(o, i) + x
    yi = shape(iShape).y(o, i) + y
    puzzle(xi,yi) = iShape
  next
  'store current position of shape
  shape(iShape).xActual = x
  shape(iShape).yActual = y
  shape(iShape).oActual = o
end sub

sub solver_deleteShape(number as integer)
  dim as integer i = any, xi = any, yi = any, o = any
  o = shape(number).oActual
  for i = 0 to SHAPE_SQUARES-1
    xi = shape(number).x(o, i) + shape(number).xActual
    yi = shape(number).y(o, i) + shape(number).yActual
    puzzle(xi,yi) = SQUARE_EMPTY
  next
end sub


'Shape 0: "C"
data 0, 1, 0 ,0, 1 'x
data 0, 0, 1, 2, 2 'y
data 360, 0 'rotate, mirror
data &H00DF0000, "C" 'colour, symbol
'Shape 1: "X"
data 1, 0, 1 ,2, 1 'x
data 0, 1, 1, 1, 2 'y
data 0, 0 'rotate, mirror
data &H0000DF00, "X" 'colour, symbol
'Shape 2: "T"
data 0, 1, 2 ,1, 1 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H000000DF, "T" 'colour, symbol
'Shape 3: "F"
data 1, 2, 0 ,1, 1 'x
data 0, 0, 1, 1, 2 'y
data 360, 1 'rotate, mirror
data &H00DF00DF, "F" 'colour, symbol
'Shape 4: "W"
data 1, 2, 0 ,1, 0 'x
data 0, 0, 1, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00DFDF00, "W" 'colour, symbol
'Shape 5: "I"
data 0, 0, 0 ,0, 0 'x
data 0, 1, 2, 3, 4 'y
data 90, 0 'rotate, mirror
data &H0000DFDF, "I" 'colour, symbol
'Shape 6: "Z"
data 0, 1, 1 ,1, 2 'x
data 0, 0, 1, 2, 2 'y
data 90, 1 'rotate, mirror
data &H00DFDFDF, "Z" 'colour, symbol
'Shape 8: "L"
data 0, 0, 0 ,0, 1 'x
data 0, 1, 2, 3, 3 'y
data 360, 1 'rotate, mirror
data &H0077FF77, "L" 'colour, symbol
'Shape 9: "V"
data 0, 1, 2 ,0, 0 'x
data 0, 0, 0, 1, 2 'y
data 360, 0 'rotate, mirror
data &H00FF7777, "V" 'colour, symbol
'Shape 10: "H"
data 1, 1, 0 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FF77DF, "H" 'colour, symbol
'Shape 11: "R"
data 0, 0, 1 ,0, 0 'x
data 0, 1, 1, 2, 3 'y
data 360, 1 'rotate, mirror
data &H00FFDF77, "R" 'colour, symbol
'Shape 7: "P"
data 0, 1, 2 ,0, 1 'x
data 0, 0, 0, 1, 1 'y
data 360, 1 'rotate, mirror
data &H007777FF, "P" 'colour, symbol

'Starting position of pice 0...11
data 1, 2, 0
data 5, 2, 0
data 9, 2, 0
data 13,2, 0
data 17,2, 0
data 18,6, 0
data 2, 6, 0
data 3, 13,7
data 17,9, 3
data 7, 13,3
data 12,13,3
data 2, 9, 0
agamemnus
Posts: 1842
Joined: Jun 02, 2005 4:48

Postby agamemnus » Jun 20, 2011 21:17

I actually managed to solve the puzzle, finding one of the 2,000 solutions, in about 5 minutes today... I am happy.

Return to “Projects”

Who is online

Users browsing this forum: No registered users and 1 guest