Task

Implement a 2D sliding block puzzle game where blocks with numbers are combined to add their values.



Rules of the game

   The rules are that on each turn the player must choose a direction   (up, down, left or right).
   All tiles move as far as possible in that direction, some move more than others. 
   Two adjacent tiles (in that direction only) with matching numbers combine into one bearing the sum of those numbers. 
   A move is valid when at least one tile can be moved,   if only by combination. 
   A new tile with the value of   2   is spawned at the end of each turn at a randomly chosen empty square   (if there is one). 
   Adding a new tile on a blank space.   Most of the time,   a new   2   is to be added,   and occasionally   (10% of the time),   a   4.
   To win,   the player must create a tile with the number   2048. 
   The player loses if no valid moves are possible.


The name comes from the popular open-source implementation of this game mechanic, 2048.



Requirements

   "Non-greedy" movement.   
  The tiles that were created by combining other tiles should not be combined again during the same turn (move).   
  That is to say,   that moving the tile row of:
               [2][2][2][2] 

 to the right should result in: 
               ......[4][4] 

 and not:
               .........[8] 

   "Move direction priority".   
  If more than one variant of combining is possible,   move direction shall indicate which combination will take effect. 
  For example, moving the tile row of:
               ...[2][2][2] 

 to the right should result in:
               ......[2][4] 

 and not:
               ......[4][2] 



   Check for valid moves.   The player shouldn't be able to skip their turn by trying a move that doesn't change the board.
   Check for a  win condition.
   Check for a lose condition.


 
SCREEN 13
PALETTE 1, pColor(35, 33, 31)
PALETTE 2, pColor(46, 46, 51)
PALETTE 3, pColor(59, 56, 50)
PALETTE 4, pColor(61, 44, 30)
PALETTE 5, pColor(61, 37, 25)
PALETTE 6, pColor(62, 31, 24)
PALETTE 7, pColor(62, 24, 15)
PALETTE 8, pColor(59, 52, 29)
PALETTE 9, pColor(59, 51, 24)
PALETTE 10, pColor(59, 50, 20)
PALETTE 11, pColor(59, 49, 16)
PALETTE 12, pColor(59, 49, 12)
PALETTE 13, pColor(15, 15, 13)
PALETTE 14, pColor(23, 22, 20)
 
DIM SHARED gDebug
DIM SHARED gOriginX
DIM SHARED gOriginY
DIM SHARED gTextOriginX
DIM SHARED gTextOriginY
DIM SHARED gSquareSide
DIM SHARED gGridSize
 
gGridSize = 4  ' grid size (4 -> 4x4)
 
DIM SHARED gGrid(gGridSize, gGridSize)
DIM SHARED gScore
 
' Don't touch these numbers, seriously
 
gOriginX = 75 'pixel X of top left of grid
gOriginY = 12 'pixel Y of top right of grid
gTextOriginX = 11
gTextOriginY = 3
gSquareSide = 38 'width/height of block in pixels
 
 
'set up all the things!
gDebug = 0
 
RANDOMIZE TIMER
CLS
 
start:
initGrid
initGraphicGrid
renderGrid
updateScore
 
gScore = 0
 
LOCATE 23, 1
PRINT "Move with arrow keys. (R)estart, (Q)uit"
 
' keyboard input loop
DO
  DO
    k$ = INKEY$
  LOOP UNTIL k$ <> ""
 
  SELECT CASE k$
    CASE CHR$(0) + CHR$(72) 'up
      processMove ("u")
    CASE CHR$(0) + CHR$(80) 'down
      processMove ("d")
    CASE CHR$(0) + CHR$(77) 'right
      processMove ("r")
    CASE CHR$(0) + CHR$(75) 'left
      processMove ("l")
    CASE CHR$(27)           'escape
      GOTO programEnd
    CASE "q"
      GOTO programEnd
    CASE "Q"
      GOTO programEnd
    CASE "r"
      GOTO start
    CASE "R"
      GOTO start
  END SELECT
LOOP
 
programEnd:
 
SUB addblock
  DIM emptyCells(gGridSize * gGridSize, 2)
  emptyCellCount = 0
 
  FOR x = 0 TO gGridSize - 1
    FOR y = 0 TO gGridSize - 1
      IF gGrid(x, y) = 0 THEN
        emptyCells(emptyCellCount, 0) = x
        emptyCells(emptyCellCount, 1) = y
        emptyCellCount = emptyCellCount + 1
      END IF
    NEXT y
  NEXT x
 
  IF emptyCellCount > 0 THEN
    index = INT(RND * emptyCellCount)
    num = CINT(RND + 1) * 2
    gGrid(emptyCells(index, 0), emptyCells(index, 1)) = num
  END IF
 
END SUB
 
SUB drawNumber (num, xPos, yPos)
  SELECT CASE num
    CASE 0:    c = 16
    CASE 2:    c = 2
    CASE 4:    c = 3
    CASE 8:    c = 4
    CASE 16:   c = 5
    CASE 32:   c = 6
    CASE 64:   c = 7
    CASE 128:  c = 8
    CASE 256:  c = 9
    CASE 512:  c = 10
    CASE 1024: c = 11
    CASE 2048: c = 12
    CASE 4096: c = 13
    CASE 8192: c = 13
    CASE ELSE: c = 13
  END SELECT
 
  x = xPos * (gSquareSide + 2) + gOriginX + 1
  y = yPos * (gSquareSide + 2) + gOriginY + 1
  LINE (x + 1, y + 1)-(x + gSquareSide - 1, y + gSquareSide - 1), c, BF
 
  IF num > 0 THEN
    LOCATE gTextOriginY + 1 + (yPos * 5), gTextOriginX + (xPos * 5)
    PRINT "    "
    LOCATE gTextOriginY + 2 + (yPos * 5), gTextOriginX + (xPos * 5)
    PRINT pad$(num)
    LOCATE gTextOriginY + 3 + (yPos * 5), gTextOriginX + (xPos * 5)
    'PRINT "    "
  END IF
 
END SUB
 
FUNCTION getAdjacentCell (x, y, d AS STRING)
 
  IF (d = "l" AND x = 0) OR (d = "r" AND x = gGridSize - 1) OR (d = "u" AND y = 0) OR (d = "d" AND y = gGridSize - 1) THEN
    getAdjacentCell = -1
  ELSE
    SELECT CASE d
      CASE "l": getAdjacentCell = gGrid(x - 1, y)
      CASE "r": getAdjacentCell = gGrid(x + 1, y)
 
      CASE "u": getAdjacentCell = gGrid(x, y - 1)
      CASE "d": getAdjacentCell = gGrid(x, y + 1)
    END SELECT
  END IF
 
END FUNCTION
 
'Draws the outside grid (doesn't render tiles)
SUB initGraphicGrid
 
  gridSide = (gSquareSide + 2) * gGridSize
 
  LINE (gOriginX, gOriginY)-(gOriginX + gridSide, gOriginY + gridSide), 14, BF 'outer square, 3 thick
  LINE (gOriginX, gOriginY)-(gOriginX + gridSide, gOriginY + gridSide), 1, B 'outer square, 3 thick
  LINE (gOriginX - 1, gOriginY - 1)-(gOriginX + gridSide + 1, gOriginY + gridSide + 1), 1, B
  LINE (gOriginX - 2, gOriginY - 2)-(gOriginX + gridSide + 2, gOriginY + gridSide + 2), 1, B
 
  FOR x = gOriginX + gSquareSide + 2 TO gOriginX + (gSquareSide + 2) * gGridSize STEP gSquareSide + 2  ' horizontal lines
    LINE (x, gOriginY)-(x, gOriginY + gridSide), 1
  NEXT x
 
  FOR y = gOriginY + gSquareSide + 2 TO gOriginY + (gSquareSide + 2) * gGridSize STEP gSquareSide + 2 ' vertical lines
    LINE (gOriginX, y)-(gOriginX + gridSide, y), 1
  NEXT y
 
END SUB
 
'Init the (data) grid with 0s
SUB initGrid
  FOR x = 0 TO 3
    FOR y = 0 TO 3
      gGrid(x, y) = 0
    NEXT y
  NEXT x
 
  addblock
  addblock
 
END SUB
 
SUB moveBlock (sourceX, sourceY, targetX, targetY, merge)
 
  IF sourceX < 0 OR sourceX >= gGridSize OR sourceY < 0 OR sourceY >= gGridSize AND gDebug = 1 THEN
    LOCATE 0, 0
    PRINT "moveBlock: source coords out of bounds"
  END IF
 
  IF targetX < 0 OR targetX >= gGridSize OR targetY < 0 OR targetY >= gGridSize AND gDebug = 1 THEN
    LOCATE 0, 0
    PRINT "moveBlock: source coords out of bounds"
  END IF
 
  sourceSquareValue = gGrid(sourceX, sourceY)
  targetSquareValue = gGrid(targetX, targetY)
 
  IF merge = 1 THEN
 
    IF sourceSquareValue = targetSquareValue THEN
      gGrid(sourceX, sourceY) = 0
      gGrid(targetX, targetY) = targetSquareValue * 2
      gScore = gScore + targetSquareValue * 2 ' Points!
    ELSEIF gDebug = 1 THEN
      LOCATE 0, 0
      PRINT "moveBlock: Attempted to merge unequal sqs"
    END IF
 
  ELSE
 
    IF targetSquareValue = 0 THEN
      gGrid(sourceX, sourceY) = 0
      gGrid(targetX, targetY) = sourceSquareValue
    ELSEIF gDebug = 1 THEN
      LOCATE 0, 0
      PRINT "moveBlock: Attempted to move to non-empty block"
    END IF
 
  END IF
 
END SUB
 
FUNCTION pad$ (num)
  strNum$ = LTRIM$(STR$(num))
 
  SELECT CASE LEN(strNum$)
    CASE 1: pad = "  " + strNum$ + " "
    CASE 2: pad = " " + strNum$ + " "
    CASE 3: pad = " " + strNum$
    CASE 4: pad = strNum$
  END SELECT
 
END FUNCTION
 
FUNCTION pColor (r, g, b)
  pColor = (r + g * 256 + b * 65536)
END FUNCTION
 
SUB processMove (dir AS STRING)
  ' dir can be 'l', 'r', 'u', or 'd'
 
  hasMoved = 0
 
  IF dir = "l" THEN
 
    FOR y = 0 TO gGridSize - 1
      wasMerge = 0
      FOR x = 0 TO gGridSize - 1
        GOSUB processBlock
      NEXT x
    NEXT y
 
  ELSEIF dir = "r" THEN
 
    FOR y = 0 TO gGridSize - 1
      wasMerge = 0
      FOR x = gGridSize - 1 TO 0 STEP -1
        GOSUB processBlock
      NEXT x
    NEXT y
 
  ELSEIF dir = "u" THEN
    FOR x = 0 TO gGridSize - 1
      wasMerge = 0
      FOR y = 0 TO gGridSize - 1
        GOSUB processBlock
      NEXT y
    NEXT x
 
  ELSEIF dir = "d" THEN
    FOR x = 0 TO gGridSize - 1
      wasMerge = 0
      FOR y = gGridSize - 1 TO 0 STEP -1
        GOSUB processBlock
      NEXT y
    NEXT x
 
  END IF
 
  GOTO processMoveEnd
 
moveToObstacle:
    curX = x
    curY = y
 
    DO WHILE getAdjacentCell(curX, curY, dir) = 0
      SELECT CASE dir
        CASE "l": curX = curX - 1
        CASE "r": curX = curX + 1
        CASE "u": curY = curY - 1
        CASE "d": curY = curY + 1
      END SELECT
    LOOP
  RETURN
 
processBlock:
 
    merge = 0
    IF gGrid(x, y) <> 0 THEN ' have block
 
      GOSUB moveToObstacle ' figure out where it can be moved to
      IF getAdjacentCell(curX, curY, dir) = gGrid(x, y) AND wasMerge = 0 THEN  ' obstacle can be merged with
        merge = 1
        wasMerge = 1
      ELSE
        wasMerge = 0
      END IF
 
      IF curX <> x OR curY <> y OR merge = 1 THEN
        mergeDirX = 0
        mergeDirY = 0
        IF merge = 1 THEN
          SELECT CASE dir
            CASE "l": mergeDirX = -1
            CASE "r": mergeDirX = 1
            CASE "u": mergeDirY = -1
            CASE "d": mergeDirY = 1
          END SELECT
        END IF
 
        CALL moveBlock(x, y, curX + mergeDirX, curY + mergeDirY, merge) ' move to before obstacle or merge
        hasMoved = 1
      END IF
    END IF
  RETURN
 
processMoveEnd:
 
  IF hasMoved = 1 THEN addblock
  renderGrid
  updateScore
 
END SUB
 
SUB renderGrid
  FOR x = 0 TO gGridSize - 1
    FOR y = 0 TO gGridSize - 1
      CALL drawNumber(gGrid(x, y), x, y)
    NEXT y
  NEXT x
END SUB
 
SUB updateScore
  LOCATE 1, 10
  PRINT "Score:" + STR$(gScore)
END SUB
 