Data commit
This commit is contained in:
Ingy döt Net
parent
7387c8f97b
commit
cb5bb5e222
199093 changed files with 3378972 additions and 0 deletions
354
Task/2048/QBasic/2048.basic
Normal file
354
Task/2048/QBasic/2048.basic
Normal file
|
|
@ -0,0 +1,354 @@
|
|||
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
|
||||
Loading…
Add table
Add a link
Reference in a new issue