'2048 in Qbasic

'
'Fellippe Heitor <fellippepip@gmail.com> 2 de maio de 2014 01:51
'Para: me@gabrielecirulli.com
'
'Hey there! I loved the simplicity and genius of your 2048 game and
'it inspired me to write my own version of it in QuickBASIC 4.5.
'If you care to take a look, it's here (source included - you'll
'probably need DosBOX to run it): https://www....
'
'Re: 2048 in Qbasic
'1 mensagem
'Gabriele Cirulli <me@gabrielecirulli.com> 18 de maio de 2014 14:50
'Para: Fellippe Heitor <fellippepip@icloud.com>
'
'That sounds very nice! I'm on a mac so I probably won't be able to play,
'but congrats and thank you for putting effort into it!
'
'Gabriele
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'That's how this game was born. The idea's not mine, but all the code is.
'I wrote this originally in QB4.5 (as you can read above) and it worked
'in screen 0. I'm really proud of it, actually! But then I met QB64 and
'the new challenge was to port it to graphics mode, while retaining most
'of the code. That's why you'll see lots of text coordinates being converted
'to graphics coordinates by using _FONTWIDTH and _FONTHEIGHT.
'
'If you enjoy it, please send feedback!
'email: fellippepip@gmail.com
'twitter: fellippeheitor
'-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
'New in version 2.1.01:
' - Help screen, triggered by clicking the help icon on the screen or F1.
' - Sounds can be switched on/off using F2.
'
'New in version 2.1.02:
' - Sounds. If the sound files are present, they are played instead of
' PLAY sounds. Sound files are licensed under the Creative Commons 0
' License or Sampling Plus 1.0, and come from the following sources:
' - https://www.freesound.org/people/blue2107/sounds/59978/
' "Bubble Pop" byuser blue2107
'
' - http://soundbible.com/1441-Elevator-Ding.html
' "Elevator Ding" by user Corsica
'
' - http://soundbible.com/2068-Woosh.html
' "Woosh" by user Mark DiAngelo
'
_TITLE "2048"
$RESIZE:STRETCH

'Constants
CONST MinAchievement = 32

CONST NoAnimation = 0
CONST FastAnimation = 1
CONST NormalAnimation = 2

CONST SameColor = -1
CONST DirUp = 8
CONST DirDown = 2
CONST DirLeft = 4
CONST DirRight = 6

CONST CellWidth = 16
CONST CellHeight = 7

CONST Line1 = 6
CONST Line2 = Line1 + CellHeight
CONST Line3 = Line2 + CellHeight
CONST Line4 = Line3 + CellHeight

CONST Column1 = 18
CONST Column2 = Column1 + CellWidth
CONST Column3 = Column2 + CellWidth
CONST Column4 = Column3 + CellWidth

'Our "sound files". Instructions for the PLAY commands throughout the game
CONST SoundForMovement = "MB O0 L64 C"
CONST SoundForSum = "MB O2 L64 E,G"
CONST SoundForAchievement = "MB O2 L32 E,G,> C E,G,> C"

CONST True = -1
CONST False = NOT True

CONST WriteSettings = True

CONST ReadSettings = False

CONST Editing = True

CONST NotEditing = False

CONST UserWantsToQuit = 16

'Type declarations
TYPE BoardControl
CellValue AS INTEGER
PreviousValue AS INTEGER
WasSummed AS INTEGER
END TYPE

TYPE Coordinates
x AS INTEGER
y AS INTEGER
END TYPE

TYPE HighestScoresType
PlayerName AS STRING * 8
Points AS LONG
END TYPE

'Variables used to handle colors

DIM SHARED CellFGColor(0 TO 2048) AS LONG, CellBGColor(0 TO 2048) AS LONG
DIM SHARED MainScreenBackground AS LONG, BoardBack AS LONG
DIM SHARED r&, g&, b&, ColorPalette(0 TO 15) AS LONG

'Variables used for game flow

DIM SHARED DidSum AS INTEGER, DidMove AS INTEGER, GlobalMove AS INTEGER
DIM SHARED ShowAchievement AS _BYTE, AchievementRow AS INTEGER
DIM SHARED Achievement AS INTEGER, HideAchievement AS _BYTE
DIM SHARED BoardArray(1 TO 4, 1 TO 4) AS BoardControl
DIM SHARED LastMovement AS _BYTE, LastSum AS INTEGER
DIM SHARED Won AS _BYTE

'Variables used as TIMER handles and timer control

DIM SHARED AchievementTimer%, AchievementShown#
DIM SHARED StatusBarTimer AS INTEGER
DIM SHARED ThisDelay AS DOUBLE

'Edit mode variables

DIM SHARED BlinkState AS _BYTE, EditX AS INTEGER, EditY AS INTEGER
DIM SHARED EditMode AS _BYTE, Grabbed AS _BYTE

'Highscore variables
DIM SHARED HighestScore AS LONG, CatchError AS INTEGER
DIM SHARED HighScores(1 TO 11) AS HighestScoresType
DIM SHARED Restored AS _BYTE
DIM SHARED Score AS LONG

'Screen coordinates variables

DIM SHARED BoxTop AS INTEGER, BoxHeight AS INTEGER
DIM SHARED PrintRows(1 TO 4, 1 TO 4) AS INTEGER
DIM SHARED PrintCols(1 TO 4, 1 TO 4) AS INTEGER
DIM x AS INTEGER, y AS INTEGER

'Variables used in the help system

DIM SHARED HelpIcon AS LONG, HelpIconX AS INTEGER, HelpIconY AS INTEGER
DIM SHARED HelpIconW AS INTEGER, HelpIconH AS INTEGER
DIM SHARED HelpScreen AS LONG

'Variables to hold sounds

DIM SHARED Blop AS LONG 'SoundForSum
DIM SHARED Woosh AS LONG 'SoundForMovement
DIM SHARED Ding AS LONG 'SoundForAchievement

'Misc variables
DIM SHARED GameScreen AS LONG
DIM SHARED InputCol AS INTEGER
DIM SHARED CheatSuspend AS _BYTE
DIM SHARED Cheat AS STRING
DIM SHARED SoundSwitch AS _BYTE
DIM SHARED GlobalSum AS _BYTE
DIM SHARED QuitAttempt AS INTEGER
DIM i AS INTEGER

'Load sounds, if present

Blop = _SNDOPEN("blop.wav", "SYNC")
Woosh = _SNDOPEN("woosh.wav", "SYNC")
Ding = _SNDOPEN("ding.wav", "SYNC")

'Set a game screen that's just slightly different to default 800x600 resolution
'so that we have no unreachable text lines, considering _FONT16 default
GameScreen = _NEWIMAGE(800, 592, 32)
SCREEN GameScreen

RESTORE Colors32
FOR i = 0 TO 15
 READ r&, g&, b&
ColorPalette(i) = _RGB32(r&, g&, b&)
NEXT

Colors32: 'Palette for 32bit color screen, emulating screen 0 colors

DATA 0,0,0
DATA 0,0,168
DATA 0,168,0
DATA 0,168,168
DATA 168,0,0
DATA 168,0,168
DATA 168,84,0
DATA 168,168,168
DATA 84,84,84
DATA 84,84,252
DATA 84,252,84
DATA 84,252,252
DATA 252,84,84
DATA 252,84,252
DATA 252,252,84
DATA 252,252,252

'Cells color definitions

CellFGColor(0) = ColorPalette(8): CellBGColor(0) = ColorPalette(8)
CellFGColor(2) = ColorPalette(15): CellBGColor(2) = ColorPalette(2)
CellFGColor(4) = ColorPalette(15): CellBGColor(4) = ColorPalette(3)
CellFGColor(8) = ColorPalette(15): CellBGColor(8) = ColorPalette(9)
CellFGColor(16) = ColorPalette(15): CellBGColor(16) = ColorPalette(4)
CellFGColor(32) = ColorPalette(15): CellBGColor(32) = ColorPalette(5)
CellFGColor(64) = ColorPalette(15): CellBGColor(64) = ColorPalette(12)
CellFGColor(128) = ColorPalette(0): CellBGColor(128) = ColorPalette(11)
CellFGColor(256) = ColorPalette(15): CellBGColor(256) = ColorPalette(6)
CellFGColor(512) = ColorPalette(8): CellBGColor(512) = ColorPalette(14)
CellFGColor(1024) = ColorPalette(8): CellBGColor(1024) = ColorPalette(15)
CellFGColor(2048) = ColorPalette(15): CellBGColor(2048) = ColorPalette(10)

MainScreenBackground = ColorPalette(15)
BoardBack = CellBGColor(0)

FOR i = 1 TO 11
HighScores(i).PlayerName = "-"
HighScores(i).Points = 0
NEXT i

SoundSwitch = True
LastMovement = False
LastSum = 0
Achievement = MinAchievement

Settings ReadSettings
HighestScore = 0

FOR i = 1 TO 11
IF HighScores(i).Points > HighestScore THEN
HighestScore = HighScores(i).Points
END IF
NEXT i

FOR x = 1 TO 4
 FOR y = 1 TO 4
SELECT CASE x
CASE 1: PrintRows(x, y) = Line1
CASE 2: PrintRows(x, y) = Line2
CASE 3: PrintRows(x, y) = Line3
CASE 4: PrintRows(x, y) = Line4
END SELECT
SELECT CASE y
CASE 1: PrintCols(x, y) = Column1
CASE 2: PrintCols(x, y) = Column2
CASE 3: PrintCols(x, y) = Column3
CASE 4: PrintCols(x, y) = Column4
END SELECT
NEXT y
NEXT x

HideAchievement = False
ShowAchievement = False
AchievementRow = 1

EditMode = NotEditing

Intro
CLS , MainScreenBackground
DisplayEmptyBoard 'Just because I want it to have a shadow

'Place help icon on the screen

ShowHelpIcon

RANDOMIZE TIMER

CheatSuspend = False
Won = False

DisplayBoard
IF Score = 0 AND Restored = False THEN GenerateNewNumber 2, True
DisplayScore

Backup
DO
_LIMIT 30
k$ = ""
DO WHILE k$ = ""
_LIMIT 30
QuitAttempt = _EXIT
IF QuitAttempt > 0 AND Score > 0 THEN
EndGame UserWantsToQuit
ELSEIF QuitAttempt > 0 AND Score = 0 THEN
SYSTEM
END IF
IF ClickedOnHelpButton THEN ShowHelp
k$ = INKEY$
LOOP

SELECT CASE k$
CASE CHR$(27)
EndGame False
CASE CHR$(0) + CHR$(72) 'Up
 MoveCells DirUp
CASE CHR$(0) + CHR$(80) 'Down
MoveCells DirDown
CASE CHR$(0) + CHR$(75) 'Left
MoveCells DirLeft
CASE CHR$(0) + CHR$(77) 'Right
MoveCells DirRight
CASE CHR$(0) + CHR$(59) 'F1
ShowHelp
CASE CHR$(0) + CHR$(63) 'F5
COLOR ColorPalette(0), MainScreenBackground
CLS
ShowHelpIcon
ClearBoard
DisplayEmptyBoard
GenerateNewNumber 2, True
Score = 0
DisplayScore
CASE CHR$(26) 'CTRL + Z
IF LastMovement THEN
RestoreBackup
Score = Score - LastSum
LastSum = 0
LastMovement = False
DisplayBoard
DisplayScore
LOCATE BottomLine, 1: COLOR ColorPalette(7), MainScreenBackground
PRINT "UNDONE ";
StartStatusBarTimer
ELSE
LOCATE BottomLine, 1: COLOR ColorPalette(7), MainScreenBackground
PRINT "NO UNDO ";
StartStatusBarTimer
END IF
CASE CHR$(0) + CHR$(60) 'F2
SoundSwitch = NOT SoundSwitch
LOCATE BottomLine, 1: COLOR ColorPalette(7), MainScreenBackground
PRINT "Sound";
IF SoundSwitch THEN PRINT " ON"; ELSE PRINT "OFF";
StartStatusBarTimer
CASE ELSE
IF NOT CheatSuspend THEN
Cheat = Cheat + k$
LOCATE BottomLine, 1: COLOR ColorPalette(7), MainScreenBackground
PRINT STRING$(LEN(Cheat), "*"); STRING$(8 - LEN(Cheat), " ");
StartStatusBarTimer
END IF
END SELECT

IF LEN(Cheat) = 8 THEN
ClearStatusBar

SELECT CASE UCASE$(Cheat)

CASE "GAMEOVER"
EndGame True
CASE "ALLFOURS"
FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).CellValue = 4
 Achievement = 4
NEXT y
NEXT x
DisplayBoard
CASE "ALLS512S"
FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).CellValue = 512
NEXT y
NEXT x
DisplayBoard
CASE "TTESTING"
i = 2
FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).CellValue = i
i = i * 2
IF i > 1024 THEN i = 1024
NEXT y
NEXT x
DisplayBoard
CASE "EDITMODE"
CheatSuspend = True
EditMode = Editing
ManageBoard
EditMode = NotEditing
CheatSuspend = False
Grabbed = False
CASE ELSE
LOCATE BottomLine, 1: COLOR ColorPalette(7), MainScreenBackground
PRINT "NICE TRY";
StartStatusBarTimer
END SELECT
Cheat = ""
END IF
LOOP

SYSTEM

SettingsError:
CatchError = ERR
RESUME NEXT

SUB Backup ()
'Creates a copy of the BoardArray so that the player can CTRL+Z the last movement
made
DIM x AS INTEGER, y AS INTEGER

FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).PreviousValue = BoardArray(x, y).CellValue
NEXT y
NEXT x

END SUB

SUB BoxCenter (BoxTop AS INTEGER, BoxWidth AS INTEGER, BoxHeight AS INTEGER,

BgColor AS LONG, HasBorder AS _BYTE, Shadow AS _BYTE)
'Draws a box in the center of the screen from BoxTop to BoxTop + BoxHeight using
BgColor as background color
'This was originally written to be used in screen 0 / text mode only, that's why
_FONTWIDTH and _FONTHEIGHT
'have been used to convert to graphics mode. Shame on me for being so lazy.
DIM BorderColor AS LONG, ShadowColor AS LONG

'Set background color for eventual subsequent PRINT statements, as boxes are
usually displayed
'to show messages to the user.
COLOR , BgColor

'If Shadow was requested, draw it first. Shadow is dark grey with ALPHA (_RGBA32)
IF Shadow THEN
ShadowColor = _RGBA32(100, 100, 100, 100)
LINE ((((_WIDTH \ _FONTWIDTH) \ 2) - BoxWidth \ 2) * _FONTWIDTH, BoxTop *
_FONTHEIGHT - (_FONTHEIGHT \ 2))-STEP(BoxWidth * _FONTWIDTH, BoxHeight *
_FONTHEIGHT), ShadowColor, BF
END IF

'The actual box.

LINE ((((_WIDTH \ _FONTWIDTH) \ 2) - BoxWidth \ 2) * _FONTWIDTH - _FONTWIDTH,
BoxTop * _FONTHEIGHT - _FONTHEIGHT)-STEP(BoxWidth * _FONTWIDTH, BoxHeight *
_FONTHEIGHT), BgColor, BF

'Calculate BorderColor using BgColor and setting it to a darker shade

r& = _RED(BgColor) * 20 / 100
g& = _GREEN(BgColor) * 20 / 100
b& = _BLUE(BgColor) * 20 / 100

'The border.
IF HasBorder THEN
BorderColor = _RGB32(r&, g&, b&)

LINE ((((_WIDTH \ _FONTWIDTH) \ 2) - BoxWidth \ 2) * _FONTWIDTH - _FONTWIDTH +

1, BoxTop * _FONTHEIGHT - _FONTHEIGHT + 1)-STEP(BoxWidth * _FONTWIDTH - 2,
BoxHeight * _FONTHEIGHT - 2), BorderColor, B
END IF
END SUB

SUB BoxAt (BoxLeft AS INTEGER, BoxTop AS INTEGER, BoxWidth AS INTEGER, BoxHeight AS

INTEGER, BgColor AS LONG, Border AS _BYTE)
'Draws a box in the given coordinates. Also used to draw cells on the board.
'This was originally written to be used in screen 0 / text mode only, that's why
_FONTWIDTH and _FONTHEIGHT
'have been used to convert to graphics mode. Shame on me for being so lazy.

'Set background color for eventual subsequent PRINT statements, as boxes are
usually displayed
'to show messages to the user.
COLOR , BgColor

'The actual box.

LINE (BoxLeft * _FONTWIDTH - _FONTWIDTH, BoxTop * _FONTHEIGHT - _FONTHEIGHT)-
STEP(BoxWidth * _FONTWIDTH, BoxHeight * _FONTHEIGHT), BgColor, BF

'Calculate BorderColor using BgColor and setting it to a darker shade

r& = _RED(BgColor) * 20 / 100
g& = _GREEN(BgColor) * 20 / 100
b& = _BLUE(BgColor) * 20 / 100
BorderColor = _RGB32(r&, g&, b&)

'The border, if requested.

IF Border THEN LINE (BoxLeft * _FONTWIDTH - _FONTWIDTH, BoxTop * _FONTHEIGHT -
_FONTHEIGHT)-STEP(BoxWidth * _FONTWIDTH, BoxHeight * _FONTHEIGHT), BorderColor, B

END SUB

SUB Center (Row AS INTEGER, TextToPrint AS STRING)

'Centers text on the screen.

IF LEN(TextToPrint) = 0 THEN EXIT SUB

LOCATE Row, ((_WIDTH \ _FONTWIDTH) \ 2) - LEN(TextToPrint) \ 2

PRINT TextToPrint;

END SUB

FUNCTION CenterCol (Text AS STRING)

'Returns the text column for centered printing/inputting, without actually printing
Text
CenterCol = ((_WIDTH \ _FONTWIDTH) \ 2) - LEN(Text) \ 2

END FUNCTION

SUB ClearHighScores ()
'Asks user to confirm before clearing high scores (<DELETE> key)
DIM i AS INTEGER

ThisDelay = .03

COLOR ColorPalette(15), ColorPalette(12)

FOR i = 1 TO 3
Center i, STRING$(31, " ")
_DELAY ThisDelay
NEXT i

Center 2, "Hit DELETE again to confirm"

k$ = ""
DO WHILE k$ = ""
_LIMIT 30
k$ = INKEY$
LOOP

IF k$ = CHR$(0) + CHR$(83) THEN

FOR i = 1 TO 11
HighScores(i).PlayerName = "-"
HighScores(i).Points = 0
NEXT i
END IF

COLOR ColorPalette(0), MainScreenBackground

FOR i = 3 TO 1 STEP -1
Center i, STRING$(31, " ")
_DELAY ThisDelay
NEXT i
END SUB

SUB EndGame (GameOver AS INTEGER)

'This subprocedure is triggered either programatically or when
'a victory/defeat is detected.
DIM Message AS STRING, Question AS STRING

CheatSuspend = True

BoxHeight = 18
BoxTop = ((_HEIGHT \ _FONTHEIGHT) \ 2) - (BoxHeight \ 2)
IF Won = True THEN WinAnimation

IF GameOver = True THEN

Message = "Game Over"
Question = "Restart"
ELSEIF GameOver = False THEN
IF Won THEN
Message = "You win!"
Question = "Restart"
ELSE
Message = "Game paused"
Question = "Resume"
BoxHeight = 5
BoxTop = ((_HEIGHT \ _FONTHEIGHT) \ 2) - (BoxHeight \ 2)
END IF
ELSEIF GameOver = UserWantsToQuit THEN
Message = "Quit"
Question = "Save your progress"
BoxHeight = 5
BoxTop = ((_HEIGHT \ _FONTHEIGHT) \ 2) - (BoxHeight \ 2)
END IF

COLOR ColorPalette(14), ColorPalette(8)

BoxCenter BoxTop, 30, BoxHeight, ColorPalette(7), True, True
Center BoxTop + 1, Message
COLOR ColorPalette(14), ColorPalette(7)

IF GameOver = True OR Won THEN SetHighScores GameOver

HideHelpIcon

COLOR ColorPalette(8), ColorPalette(7)

Center BoxTop + BoxHeight - 2, Question + "? (Y/N)"

DO
k$ = ""
DO WHILE k$ = ""
_LIMIT 30
k$ = INKEY$
QuitAttempt = _EXIT
IF QuitAttempt > 0 THEN k$ = "N"
LOOP
SELECT CASE UCASE$(k$)
CASE CHR$(27), "N"
COLOR ColorPalette(7), ColorPalette(8)
IF GameOver = True OR Won OR GameOver = UserWantsToQuit THEN
ClearBoard
Score = 0
 END IF
Settings WriteSettings
SYSTEM
CASE "Y"
IF GameOver = True OR Won THEN
Score = 0: Won = False
GameOver = False
COLOR ColorPalette(0), MainScreenBackground
CLS
ShowHelpIcon
ClearBoard
DisplayEmptyBoard
GenerateNewNumber 2, True
DisplayScore
CheatSuspend = False
EXIT SUB
ELSEIF GameOver = UserWantsToQuit THEN
Settings WriteSettings
SYSTEM
ELSE
DisplayBoard
DisplayScore
CheatSuspend = False
HideAchievement = True: ShowAchievement = False
AchievementTimer% = _FREETIMER
AchievementShown# = TIMER - 1
ON TIMER(AchievementTimer%, .05) TopMessageTimerAction
TIMER(AchievementTimer%) ON
EXIT SUB
END IF
CASE CHR$(0) + CHR$(83) 'Delete Key
IF GameOver = True OR Won THEN
ClearHighScores
COLOR ColorPalette(7), ColorPalette(0)
ShowHighScores
END IF
END SELECT
LOOP
END SUB

SUB GenerateNewNumber (HowMany AS INTEGER, ShowNumber AS INTEGER)

'Generates a new number in a random cell
DIM NewCell AS INTEGER
DIM FreeCells(1 TO 16) AS Coordinates, TotalFreeCells AS INTEGER
DIM InitialValue AS INTEGER, i AS INTEGER

'Fills a matrix with all free cells addresses

FOR i = 1 TO HowMany
TotalFreeCells = 0
FOR x = 1 TO 4
FOR y = 1 TO 4
IF BoardArray(x, y).CellValue = 0 THEN
TotalFreeCells = TotalFreeCells + 1
FreeCells(TotalFreeCells).x = x
FreeCells(TotalFreeCells).y = y
END IF
NEXT y
NEXT x
 IF TotalFreeCells = 0 THEN
EXIT SUB
END IF

'Randomly picks one of the free cells and fills it with either a 2 or a 4
NewCell = INT(RND * TotalFreeCells) + 1

InitialValue = INT(RND * 4) + 1
IF InitialValue < 2 THEN InitialValue = 2
IF InitialValue > 2 THEN InitialValue = 4

BoardArray(FreeCells(NewCell).x, FreeCells(NewCell).y).CellValue = InitialValue

IF ShowNumber THEN PutCell FreeCells(NewCell).x, FreeCells(NewCell).y,
BoardBack, InitialValue, NormalAnimation
NEXT i
END SUB

SUB Intro ()
'Displays the initial screen with credits.
DIM StartRow AS INTEGER

CLS , ColorPalette(0)
StartRow = ((_HEIGHT \ _FONTHEIGHT) \ 2) - 2
ThisDelay = .03
ZoomBox 0, 0, _WIDTH, _HEIGHT, ColorPalette(0), ColorPalette(15), 10
ZoomBox ((_WIDTH \ 2) - ((45 \ 2) * 8)) - 8, StartRow * _FONTHEIGHT - _FONTHEIGHT,
45 * 8, 6 * _FONTHEIGHT, ColorPalette(15), ColorPalette(7), 10
COLOR ColorPalette(8), ColorPalette(7)
Center StartRow + 1, "2048"
'Center 13, "programmed in QuickBASIC 4.5"
Center StartRow + 3, "Fellippe Heitor (@FellippeHeitor)"
Center StartRow + 4, "(based on the work of Gabriele Cirulli)"
_DELAY 1

END SUB

SUB ClearBoard ()
'Erases all values on the board, to restart the game
DIM x AS INTEGER, y AS INTEGER
FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).CellValue = 0
NEXT y
NEXT x
END SUB

SUB ManageBoard ()
'Edit mode, only reachable through the use of a cheat code
'(made for testing purposes)
DIM k$
DIM PreviousX AS INTEGER, PreviousY AS INTEGER
DIM i AS INTEGER, BlinkTimer AS INTEGER

CLS , ColorPalette(7)
DisplayEmptyBoard
LOCATE BottomLine, 1
COLOR ColorPalette(0), ColorPalette(7)
PRINT "EDIT MODE: Arrows move; ENTER grabs/releases cell; <V> to change value.";
EditX = 1
EditY = 1
Grabbed = False
BlinkState = False

BlinkTimer = _FREETIMER
ON TIMER(BlinkTimer, .5) MakeCellBlink
TIMER(BlinkTimer) ON
DO
DisplayBoard
k$ = ""
PreviousX = EditX
PreviousY = EditY
DO WHILE k$ = "": _LIMIT 30: k$ = INKEY$: LOOP

SELECT CASE k$
CASE CHR$(27)
CLS , MainScreenBackground
ShowHelpIcon
DisplayBoard
DisplayScore
TIMER(BlinkTimer) FREE
EXIT SUB
CASE CHR$(13) 'Enter
Grabbed = NOT Grabbed
PutCell EditX, EditY, BoardBack, BoardArray(EditX, EditY).CellValue,
NormalAnimation
CASE "v", "V" 'Changes cell value. <Shift> cycles backwards through
possible values.
IF LCASE$(k$) = k$ THEN
IF BoardArray(EditX, EditY).CellValue = 0 THEN
BoardArray(EditX, EditY).CellValue = 2
ELSEIF BoardArray(EditX, EditY).CellValue >= 1024 THEN
BoardArray(EditX, EditY).CellValue = 0
ELSE
BoardArray(EditX, EditY).CellValue = BoardArray(EditX,
EditY).CellValue * 2
END IF
ELSE
IF BoardArray(EditX, EditY).CellValue = 0 THEN
BoardArray(EditX, EditY).CellValue = 1024
ELSEIF BoardArray(EditX, EditY).CellValue = 2 THEN
BoardArray(EditX, EditY).CellValue = 0
ELSE
BoardArray(EditX, EditY).CellValue = BoardArray(EditX,
EditY).CellValue \ 2
END IF
END IF
CASE CHR$(0) + CHR$(72) 'Up
EditX = EditX - 1
IF EditX = 0 THEN EditX = 1
IF Grabbed THEN
IF NOT (PreviousX = EditX) THEN
SWAP BoardArray(EditX, EditY).CellValue, BoardArray(EditX + 1,
EditY).CellValue
END IF
END IF
CASE CHR$(0) + CHR$(80) 'Down
EditX = EditX + 1
 IF EditX = 5 THEN EditX = 4
IF Grabbed THEN
IF NOT (PreviousX = EditX) THEN
SWAP BoardArray(EditX, EditY).CellValue, BoardArray(EditX - 1,
EditY).CellValue
END IF
END IF
CASE CHR$(0) + CHR$(75) 'Left
EditY = EditY - 1
IF EditY = 0 THEN EditY = 1
IF Grabbed THEN
IF NOT (PreviousY = EditY) THEN
SWAP BoardArray(EditX, EditY).CellValue, BoardArray(EditX,
EditY + 1).CellValue
END IF
END IF
CASE CHR$(0) + CHR$(77) 'Right
EditY = EditY + 1
IF EditY = 5 THEN EditY = 4
IF Grabbed THEN
IF NOT (PreviousY = EditY) THEN
SWAP BoardArray(EditX, EditY).CellValue, BoardArray(EditX,
EditY - 1).CellValue
END IF
END IF
END SELECT
LOOP
TIMER(BlinkTimer) FREE
END SUB

SUB WinAnimation ()
DIM Ascii2048(1 TO 7) AS STRING, Image2048 AS LONG
DIM i AS INTEGER, ColorToShow AS INTEGER
DIM x AS INTEGER, y AS INTEGER
DIM ImageX AS INTEGER, ImageY AS INTEGER
DIM AnimationSteps AS INTEGER

'Image is 28 x 7 characters
Ascii2048(1) = " ���� ���� � � ���� "
Ascii2048(2) = "� � � � � � � �"
Ascii2048(3) = " � � � � � � �"
Ascii2048(4) = " �� � � ����� ���� "
Ascii2048(5) = " � � � � � �"
Ascii2048(6) = "� � � � � �"
Ascii2048(7) = "������ ���� � ���� "

Image2048 = _NEWIMAGE(224, 128, 32)

_DEST Image2048
COLOR ColorPalette(15), _RGBA32(0, 0, 0, 0)
FOR i = 1 TO 7
PRINT Ascii2048(i);
NEXT i
_DEST 0

FOR x = 1 TO 4
FOR y = 1 TO 4
PutCell x, y, SameColor, 2048, NormalAnimation
IF SoundSwitch THEN
IF Blop THEN
 _SNDPLAYCOPY Blop
ELSE
PLAY SoundForSum
END IF
END IF
NEXT y
NEXT x

ColorToShow = 512 'Will show a huge cell (the actual board size) with values/colors
equivalent to 512, 1024 and then 2048
DO
ThisDelay = .5
AnimationSteps = 30
ThisDelay = ThisDelay / AnimationSteps

ZoomBox Column1 * 8 - 8, Line1 * _FONTHEIGHT - _FONTHEIGHT, CellWidth * 4 * 8,

CellHeight * 4 * _FONTHEIGHT, ColorPalette(15), CellBGColor(ColorToShow),
AnimationSteps

IF SoundSwitch THEN
IF Blop THEN
_SNDPLAYCOPY Blop
ELSE
PLAY SoundForSum
END IF
END IF

COLOR CellFGColor(ColorToShow), CellBGColor(ColorToShow)

ImageX = Column1 * _FONTWIDTH '(Column1 + ((CellWidth * 4) \ 2) -
(LEN(Ascii2048(1)) \ 2) - 1) * _FONTWIDTH
ImageY = Line1 * _FONTHEIGHT '(Line1 + ((CellHeight * 4) \ 2) -
(UBOUND(ascii2048) \ 2) - 1) * _FONTHEIGHT

_PUTIMAGE (ImageX, ImageY)-STEP(((CellWidth * 4) - 2) * _FONTWIDTH,

((CellHeight * 4) + 1) * _FONTHEIGHT), Image2048, , , _SMOOTH

ThisDelay = .2
_DELAY ThisDelay
ColorToShow = ColorToShow * 2
IF ColorToShow > 2048 THEN
IF SoundSwitch THEN
IF Ding THEN
_SNDPLAYCOPY Ding
ELSE
PLAY SoundForAchievement
END IF
END IF
EXIT DO
END IF
LOOP
_FREEIMAGE Image2048
END SUB

SUB DisplayIntermediateMovement (Row AS INTEGER, Col AS INTEGER, InitialValue AS

INTEGER, Direction AS INTEGER)
'Routine to smooth the board animation by drawing intermediate frames between moves
DIM VectorX AS INTEGER, VectorY AS INTEGER
DIM i AS INTEGER, IntermediateWidth AS INTEGER
ThisDelay = .02

IntermediateWidth = CellWidth
SELECT CASE Direction
CASE DirUp
VectorX = -1
VectorY = 0
CASE DirDown
VectorX = 1
VectorY = 0
CASE DirLeft
VectorX = 0
VectorY = -1
IntermediateWidth = CellWidth \ 2
CASE DirRight
VectorX = 0
VectorY = 1
END SELECT

COLOR CellFGColor(InitialValue), CellBGColor(InitialValue)

BoxAt PrintCols(Row, Col) + (VectorY * (CellWidth \ 2)), PrintRows(Row, Col) +
(VectorX * (CellHeight \ 2)), IntermediateWidth, CellHeight,
CellBGColor(InitialValue), False

_DELAY ThisDelay
END SUB

SUB PutCell (Row AS INTEGER, Col AS INTEGER, BgColorFrom AS LONG, InitialValue AS

INTEGER, SpeedChoice AS INTEGER)
'Shows a new number on the board (with short animation) or simply
'puts a number on the board when required.

DIM i AS INTEGER
DIM AnimationSteps AS INTEGER
DIM x AS INTEGER, y AS INTEGER
DIM w AS INTEGER, h AS INTEGER

IF SpeedChoice = NoAnimation THEN GOTO SkipAnimation

AnimationSteps = 10

IF SpeedChoice = FastAnimation THEN

ThisDelay = .1
ELSEIF SpeedChoice = NormalAnimation THEN
ThisDelay = .2
END IF

ThisDelay = ThisDelay / AnimationSteps

COLOR CellFGColor(InitialValue), CellBGColor(InitialValue)
IF BgColorFrom = SameColor THEN BgColorFrom = CellBGColor(InitialValue)

ZoomBox PrintCols(Row, Col) * _FONTWIDTH - _FONTWIDTH, PrintRows(Row, Col) *

_FONTHEIGHT - _FONTHEIGHT, CellWidth * _FONTWIDTH, CellHeight * _FONTHEIGHT,
BgColorFrom, CellBGColor(InitialValue), AnimationSteps

SkipAnimation:
BoxAt PrintCols(Row, Col), PrintRows(Row, Col), CellWidth, CellHeight,
CellBGColor(InitialValue), True
LOCATE PrintRows(Row, Col) + (CellHeight \ 2), PrintCols(Row, Col) + (CellWidth \
2) - 2
PRINT InitialValue;
END SUB

SUB ZoomBox (x AS INTEGER, y AS INTEGER, w AS INTEGER, h AS INTEGER, BgColorFrom AS

LONG, BgColor AS LONG, AnimationSteps AS INTEGER)
'Puts a box on the screen, much like BoxCenter and BoxAt do, but animates it's
appearance
'with a zoom in effect and color fading from BgColorFrom to BgColor.
DIM i AS INTEGER, ThisStepX AS INTEGER, ThisStepY AS INTEGER
DIM xx AS INTEGER, yy AS INTEGER, ww AS INTEGER, hh AS INTEGER
DIM RedFrom AS LONG, GreenFrom AS LONG, BlueFrom AS LONG
DIM RedTo AS LONG, GreenTo AS LONG, BlueTo AS LONG
DIM RedStep AS SINGLE, GreenStep AS SINGLE, BlueStep AS SINGLE
DIM ThisStepColor AS LONG

COLOR , BgColor
IF BgColorFrom <> SameColor THEN
RedFrom = _RED(BgColorFrom)
GreenFrom = _GREEN(BgColorFrom)
BlueFrom = _BLUE(BgColorFrom)

RedTo = _RED(BgColor)
GreenTo = _GREEN(BgColor)
BlueTo = _BLUE(BgColor)

RedStep = RedFrom - ((RedTo - RedFrom) / AnimationSteps)

GreenStep = GreenFrom - ((GreenTo - GreenFrom) / AnimationSteps)
BlueStep = BlueFrom - ((BlueTo - BlueFrom) / AnimationSteps)
END IF

ThisStepX = w \ AnimationSteps
ThisStepY = h \ AnimationSteps
IF BgColorFrom = SameColor THEN ThisStepColor = BgColor

FOR i = 1 TO AnimationSteps
IF BgColorFrom <> SameColor THEN
RedStep = RedStep + ((RedTo - RedFrom) / AnimationSteps)
GreenStep = GreenStep + ((GreenTo - GreenFrom) / AnimationSteps)
BlueStep = BlueStep + ((BlueTo - BlueFrom) / AnimationSteps)
ThisStepColor = _RGB32(RedStep, GreenStep, BlueStep)
END IF

xx = x + (w \ 2) - ((ThisStepX * i) \ 2)
yy = y + (h \ 2) - ((ThisStepY * i) \ 2)
ww = ThisStepX * i
hh = ThisStepY * i

LINE (xx, yy)-STEP(ww, hh), ThisStepColor, BF

_DELAY ThisDelay
NEXT i

LINE (x, y)-STEP(w, h), BgColor, BF

END SUB

SUB DisplayScore ()
DIM x AS INTEGER
DIM y AS INTEGER
DIM i AS INTEGER
DIM Msg$

COLOR ColorPalette(0), MainScreenBackground

LOCATE 1, 3
PRINT "Score: "; Score;

COLOR ColorPalette(8), MainScreenBackground

IF HighestScore THEN
LOCATE 2, 3
PRINT "High score: "; HighestScore;
END IF

IF Restored THEN
COLOR ColorPalette(8), MainScreenBackground
Msg$ = "(loaded state; <F5> to start a new game)"
Center BottomLine, Msg$
Restored = False
ELSE
ClearStatusBar
END IF

END SUB

SUB DisplaySummedCells ()
'Updates the board view to show the cells that have collided and been summed.
'Animates each newly summed cell. This is not actually intended. I originally
'planned to animated ALL summed cells at once, but I didn't manage to and ended
'up leaving it as is. Shame on me for being lazy.
DIM i AS INTEGER

ThisDelay = .02

FOR Row = 1 TO 4
FOR Col = 1 TO 4
IF BoardArray(Row, Col).WasSummed = True THEN
COLOR CellFGColor(BoardArray(Row, Col).CellValue),
CellBGColor(BoardArray(Row, Col).CellValue)
PutCell Row, Col, CellBGColor(BoardArray(Row, Col).CellValue / 2),
BoardArray(Row, Col).CellValue, NormalAnimation
IF SoundSwitch THEN
IF Blop THEN
_SNDPLAYCOPY Blop
ELSE
PLAY SoundForSum
END IF
END IF
END IF
NEXT Col
NEXT Row

END SUB

SUB DisplayBoard ()
'Reads the BoardArray and displays the current state on the screen. No animation.
DIM x AS INTEGER
DIM y AS INTEGER
DIM TempValue AS INTEGER
DIM HasBorder AS _BYTE

FOR x = 1 TO 4
FOR y = 1 TO 4
IF BoardArray(x, y).WasSummed THEN
TempValue = BoardArray(x, y).CellValue / 2
ELSE
TempValue = BoardArray(x, y).CellValue
END IF

COLOR CellFGColor(TempValue), CellBGColor(TempValue)

'Don't show borders for 0 cells, as they are supposed to be invisible.

IF TempValue = 0 THEN HasBorder = False ELSE HasBorder = True
BoxAt PrintCols(x, y), PrintRows(x, y), CellWidth, CellHeight,
CellBGColor(TempValue), HasBorder

LOCATE PrintRows(x, y) + (CellHeight \ 2), (PrintCols(x, y) + (CellWidth \

2)) - 2
IF TempValue > 0 THEN PRINT TempValue;
NEXT y
NEXT x

END SUB

SUB DisplayEmptyBoard ()
'Shows only the blank board placeholder. Animates board with ZoomBox
ThisDelay = .02
ZoomBox PrintCols(1, 1) * 8 - 8, PrintRows(1, 1) * 16 - 16, CellWidth * 4 * 8,
CellHeight * 4 * 16, ColorPalette(15), BoardBack, 20
BoxCenter PrintRows(1, 1), CellWidth * 4, CellHeight * 4, BoardBack, False, True
END SUB

SUB MoveCells (Direction AS INTEGER)

'Per request, after user input, this routine moves all cells toward the given
Direction.
'Moves are made a row at a time. Detects cells collision and sums theis values
accordingly.
'Moves are animated.
DIM x AS INTEGER, y AS INTEGER
DIM StartBoundary AS INTEGER, FinalBoundary AS INTEGER
DIM Vector AS INTEGER, i AS INTEGER

GlobalMove = False
GlobalSum = False

Backup
LastSum = 0

IF SoundSwitch THEN
IF Woosh THEN
_SNDPLAYCOPY Woosh
ELSE
PLAY SoundForMovement
END IF
END IF
SELECT CASE Direction
CASE DirDown
 StartBoundary = 3
FinalBoundary = 1
Vector = 1
CASE DirUp
StartBoundary = 2
FinalBoundary = 4
Vector = -1
CASE DirRight
StartBoundary = 3
FinalBoundary = 1
Vector = 1
CASE DirLeft
StartBoundary = 2
FinalBoundary = 4
Vector = -1
END SELECT

DO
DidSum = False
DidMove = False

SELECT CASE Direction

CASE DirDown, DirUp
FOR x = StartBoundary TO FinalBoundary STEP (-Vector)
FOR y = 1 TO 4
IF BoardArray(x + Vector, y).CellValue = 0 THEN 'Move to empty
cell (CellValue=0)
IF BoardArray(x, y).CellValue > 0 THEN
DidMove = True
GlobalMove = True
BoardArray(x + Vector, y).CellValue = BoardArray(x,
y).CellValue
BoardArray(x + Vector, y).WasSummed = BoardArray(x,
y).WasSummed
BoardArray(x, y).CellValue = 0
BoardArray(x, y).WasSummed = False
DisplayIntermediateMovement x, y, BoardArray(x +
Vector, y).CellValue, Direction
END IF
ELSE
IF BoardArray(x + Vector, y).CellValue = BoardArray(x,
y).CellValue AND BoardArray(x, y).WasSummed = False AND BoardArray(x + Vector,
y).WasSummed = False THEN
BoardArray(x, y).CellValue = 0
BoardArray(x + Vector, y).CellValue = BoardArray(x +
Vector, y).CellValue * 2
Score = Score + BoardArray(x + Vector, y).CellValue
LastSum = LastSum + BoardArray(x + Vector, y).CellValue
IF Achievement < BoardArray(x + Vector, y).CellValue
THEN
IF SoundSwitch THEN
IF Ding THEN
_SNDPLAYCOPY Ding
ELSE
PLAY SoundForAchievement
END IF
END IF
Achievement = BoardArray(x + Vector, y).CellValue
ShowAchievement = True
 AchievementTimer% = _FREETIMER
ON TIMER(AchievementTimer%, .05)
TopMessageTimerAction
TIMER(AchievementTimer%) ON
AchievementRow = 1
END IF
BoardArray(x + Vector, y).WasSummed = True
BoardArray(x, y).CellValue = 0
BoardArray(x, y).WasSummed = False
DidMove = True: DidSum = True
GlobalMove = True: GlobalSum = True
DisplayScore
END IF
END IF
NEXT y
IF DidMove = False THEN
IF x = FinalBoundary THEN EXIT DO
ELSE
LastMovement = True
DisplayBoard
END IF
NEXT x
CASE DirLeft, DirRight
FOR y = StartBoundary TO FinalBoundary STEP (-Vector)
FOR x = 1 TO 4
IF BoardArray(x, y + Vector).CellValue = 0 THEN 'Move to empty
cell (CellValue=0)
IF BoardArray(x, y).CellValue > 0 THEN
DidMove = True
GlobalMove = True
BoardArray(x, y + Vector).CellValue = BoardArray(x,
y).CellValue
BoardArray(x, y + Vector).WasSummed = BoardArray(x,
y).WasSummed
BoardArray(x, y).CellValue = 0
BoardArray(x, y).WasSummed = False
DisplayIntermediateMovement x, y, BoardArray(x, y +
Vector).CellValue, Direction
END IF
ELSE
IF BoardArray(x, y + Vector).CellValue = BoardArray(x,
y).CellValue AND BoardArray(x, y).WasSummed = False AND BoardArray(x, y +
Vector).WasSummed = False THEN
BoardArray(x, y).CellValue = 0
BoardArray(x, y + Vector).CellValue = BoardArray(x, y +
Vector).CellValue * 2
Score = Score + BoardArray(x, y + Vector).CellValue
LastSum = LastSum + BoardArray(x, y + Vector).CellValue
IF Achievement < BoardArray(x, y + Vector).CellValue
THEN
IF SoundSwitch THEN
IF Ding THEN
_SNDPLAYCOPY Ding
ELSE
PLAY SoundForAchievement
END IF
END IF
Achievement = BoardArray(x, y + Vector).CellValue
ShowAchievement = True
 AchievementTimer% = _FREETIMER
ON TIMER(AchievementTimer%, .05)
TopMessageTimerAction
TIMER(AchievementTimer%) ON
AchievementRow = 1
END IF
BoardArray(x, y + Vector).WasSummed = True
BoardArray(x, y).CellValue = 0
BoardArray(x, y).WasSummed = False
DidMove = True: DidSum = True
GlobalMove = True: GlobalSum = True
DisplayScore
END IF
END IF
NEXT x
IF DidMove = False THEN
IF y = FinalBoundary THEN EXIT DO
ELSE
LastMovement = True
DisplayBoard
END IF
NEXT y
END SELECT
LOOP

IF GlobalMove = True AND GlobalSum = True THEN

DisplaySummedCells
END IF

'Finally, check if after all sums we found a 2048 cell, which means the game was
won
'I gotta be honest here: Not playing the original game, nor playing my own have I
ever
'been able to achieve the 2048 cell without cheating. Shame on me for being so
clumsy.
FOR x = 1 TO 4
FOR y = 1 TO 4
BoardArray(x, y).WasSummed = False
IF BoardArray(x, y).CellValue = 2048 THEN
Won = True
EndGame False
END IF
NEXT y
NEXT x

IF GlobalSum OR GlobalMove THEN

GenerateNewNumber 1, True
END IF

CheckPossibleMoves
END SUB

SUB RestoreBackup ()
'User hit CTRL+Z. If we have a backup copy (only 1 step back is allowed at this
point)
'we restore the backup board. Any points won with the last move will also be lost.
DIM x AS INTEGER, y AS INTEGER

FOR x = 1 TO 4
 FOR y = 1 TO 4
BoardArray(x, y).CellValue = BoardArray(x, y).PreviousValue
NEXT y
NEXT x
END SUB

SUB SetHighScores (GameOver AS INTEGER)

'Checks the High Scores to see if current score
'is a new high score. Shows the current scores
'in the message box. The new score, if applicable,
'is shown "progressing" from the bottom to the top
'on the table.

DIM i AS LONG, StepsToTake AS INTEGER

DIM CheckHighScores AS INTEGER, CurrentHighScore AS INTEGER
DIM SkipAnimation AS _BYTE, k$

ShowHighScores
SkipAnimation = False

CurrentHighScore = 11

'Clear the keyboard buffer so that we can have the animation at least start.
WHILE INKEY$ <> "": WEND

HighScores(CurrentHighScore).PlayerName = "-"
HighScores(CurrentHighScore).Points = 0

StepsToTake = 1
CheckHighScores = 11

IF (GameOver = True) OR (Won = True) THEN

IF Score > 200 THEN StepsToTake = Score \ 50
FOR i = 1 TO Score - 1 STEP StepsToTake
HighScores(CurrentHighScore).Points = i
IF NOT SkipAnimation THEN Center BoxTop + 2, "Score: " + STR$(i)
IF i > HighScores(CheckHighScores - 1).Points THEN
SWAP HighScores(CheckHighScores).Points, HighScores(CheckHighScores -
1).Points
SWAP HighScores(CheckHighScores).PlayerName, HighScores(CheckHighScores
- 1).PlayerName
CheckHighScores = CheckHighScores - 1
CurrentHighScore = CurrentHighScore - 1
IF CheckHighScores < 1 THEN CheckHighScores = 1
IF CurrentHighScore < 1 THEN CurrentHighScore = 1
END IF

IF NOT SkipAnimation THEN ShowHighScores

IF NOT SkipAnimation THEN _DELAY .04

IF SoundSwitch AND NOT SkipAnimation THEN

IF Blop THEN
_SNDPLAYCOPY Blop
ELSE
PLAY SoundForSum
END IF
END IF
k$ = INKEY$
'Ignore arrow keys, since they may still be in the buffer
 SELECT CASE k$
CASE CHR$(0) + CHR$(72) 'Up
CASE CHR$(0) + CHR$(80) 'Down
CASE CHR$(0) + CHR$(75) 'Left
CASE CHR$(0) + CHR$(77) 'Right
CASE ""
CASE ELSE
SkipAnimation = True
END SELECT
NEXT i

HighScores(CurrentHighScore).Points = Score

IF Score > HighestScore THEN

ShowANewHighScoreMessage
COLOR ColorPalette(15), ColorPalette(7)
Center BoxTop + 2, "Score: " + STR$(Score) + " *"
HighestScore = Score
IF SoundSwitch THEN
IF Ding THEN
_SNDPLAYCOPY Ding
ELSE
PLAY SoundForAchievement
END IF
END IF
ELSE
Center BoxTop + 2, "Score: " + STR$(Score)
END IF

ShowHighScores

'If a new highscore was achieved, input user name for the record
IF CurrentHighScore < 11 THEN
LOCATE BoxTop + 3 + CurrentHighScore, InputCol
COLOR ColorPalette(14), ColorPalette(7)
INPUT "", HighScores(CurrentHighScore).PlayerName
HighScores(CurrentHighScore).PlayerName = UCASE$
(HighScores(CurrentHighScore).PlayerName)
IF LTRIM$(RTRIM$(HighScores(CurrentHighScore).PlayerName)) = "" THEN
HighScores(CurrentHighScore).PlayerName = "-"
END IF
COLOR ColorPalette(7), ColorPalette(0)
ShowHighScores
END IF
END IF
DisplayScore
END SUB

SUB Settings (WhatToDo AS INTEGER)

DIM DataFile AS INTEGER
DIM i AS INTEGER
DIM x AS INTEGER, y AS INTEGER

CatchError = 0
SELECT CASE WhatToDo
CASE WriteSettings
'Write sound setting and highest scores to 2048.DAT;
'If file can't be created, exits sub. Not essential anyway.
'Current game state is also saved upon exit.
 DataFile = FREEFILE
ON ERROR GOTO SettingsError
OPEN "2048.DAT" FOR RANDOM AS DataFile
IF CatchError = 57 THEN EXIT SUB

PUT DataFile, 1, SoundSwitch

FOR i = 1 TO 11
PUT DataFile, , HighScores(i).PlayerName
PUT DataFile, , HighScores(i).Points
NEXT i

Restored = False
FOR x = 1 TO 4
FOR y = 1 TO 4
PUT DataFile, , BoardArray(x, y).CellValue
IF BoardArray(x, y).CellValue > 0 THEN Restored = True
NEXT y
NEXT x

PUT DataFile, , Score

PUT DataFile, , Restored

CLOSE DataFile
CASE ReadSettings
'Read sound setting and highest scores from 2048.DAT;
'Last game saved is also restored, if any.
'If file is not found, uses the zeroed highest scores list.

DataFile = FREEFILE
ON ERROR GOTO SettingsError
OPEN "2048.DAT" FOR INPUT AS DataFile
IF CatchError = 53 THEN
Restored = False
EXIT SUB
END IF

CLOSE DataFile
OPEN "2048.DAT" FOR RANDOM AS DataFile

GET DataFile, 1, SoundSwitch

FOR i = 1 TO 11
GET DataFile, , HighScores(i).PlayerName
GET DataFile, , HighScores(i).Points
NEXT i

FOR x = 1 TO 4
FOR y = 1 TO 4
GET DataFile, , BoardArray(x, y).CellValue
IF Achievement < BoardArray(x, y).CellValue THEN
Achievement = BoardArray(x, y).CellValue
END IF
NEXT y
NEXT x

GET DataFile, , Score

GET DataFile, , Restored

CLOSE DataFile
END SELECT
END SUB

SUB ShowANewHighScoreMessage ()
'Displays a banner if a new highscore was achieved.
DIM i AS INTEGER

COLOR ColorPalette(1), ColorPalette(11)

FOR i = 1 TO 3
Center i, STRING$(30, " ")
_DELAY .08
NEXT i

Center 2, "A new highscore!"

END SUB

SUB ShowHighScores ()
'Populate the final dialog with saved highscores
DIM i AS INTEGER, ValueToText AS STRING

FOR i = 1 TO 10
ValueToText = LTRIM$(RTRIM$(STR$(HighScores(i).Points)))
ValueToText = HighScores(i).PlayerName + STRING$(18 - LEN(ValueToText), ".") +
ValueToText
COLOR ColorPalette(8), ColorPalette(7)
Center BoxTop + 3 + i, ValueToText
NEXT i
IF NOT InputCol THEN InputCol = CenterCol(ValueToText)
END SUB

SUB TopMessageTimerAction ()
'Displays achievements banner with a brief animation. Leaves it up there for 1
second.
'If achievement banner is already there, waits until the desired time has passed
'(set using AchievementShown# = TIMER - DesiredTime) and clears it.
IF HideAchievement THEN
IF TIMER - AchievementShown# < 2 THEN EXIT SUB 'Wait before clearing
achievements panel
COLOR ColorPalette(0), MainScreenBackground
Center AchievementRow, STRING$(30, " ")

IF AchievementRow = 1 THEN
HideAchievement = False
TIMER(AchievementTimer%) FREE
ELSE
AchievementRow = AchievementRow - 1
END IF
END IF

IF ShowAchievement THEN
COLOR CellFGColor(Achievement), CellBGColor(Achievement)
Center AchievementRow, STRING$(30, " ")

IF AchievementRow = 3 THEN
Center 2, "New Achievement: " + STR$(Achievement) + " tile."
HideAchievement = True
ShowAchievement = False
AchievementShown# = TIMER
ELSE
 AchievementRow = AchievementRow + 1
END IF
END IF
END SUB

SUB CheckPossibleMoves ()
'Can the game go on? Are there still empty cells to move to?
'Are there still cells with the same value aligned and ready
'to be summed? Well, let's see that in this procedure.
DIM x AS INTEGER, y AS INTEGER

FOR x = 1 TO 4
FOR y = 1 TO 4
IF BoardArray(x, y).CellValue = 0 THEN EXIT SUB
SELECT CASE x
CASE 1
SELECT CASE y
CASE 1
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
CASE 2, 3
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
CASE 4
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
END SELECT
CASE 2, 3
SELECT CASE y
CASE 1
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
CASE 2, 3
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
CASE 4
IF BoardArray(x, y).CellValue = BoardArray(x + 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
END SELECT
CASE 4
SELECT CASE y
CASE 1
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
CASE 2, 3
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y +
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
CASE 4
IF BoardArray(x, y).CellValue = BoardArray(x, y -
1).CellValue THEN EXIT SUB
IF BoardArray(x, y).CellValue = BoardArray(x - 1,
y).CellValue THEN EXIT SUB
END SELECT
END SELECT
NEXT y
NEXT x

'Apparently, no more moves. Game over, buddy.

EndGame True
END SUB

FUNCTION BottomLine
'Calculates what the bottom line is in current screen mode, considering
'current font height.
BottomLine = (_HEIGHT \ _FONTHEIGHT)
END FUNCTION

SUB ClearStatusBar
'Clears status bar messages and cheat codes. Frees the timer that invoked the
subprocedure.
LOCATE BottomLine, 1
COLOR , MainScreenBackground
PRINT STRING$(_WIDTH \ _FONTWIDTH, " ");
TIMER(StatusBarTimer) FREE

'If this procedure was invoked while the player tried to use a cheat code,
'this clears what has been typed so far. Gotta type faster next time.
IF LEN(Cheat) < 8 THEN Cheat = ""
END SUB

SUB StartStatusBarTimer
'This subprocedure is invoked everytime a new message is printed
'to the status bar. That way each message only gets to be shown for
'one second.
TIMER(StatusBarTimer) FREE
StatusBarTimer = _FREETIMER
ON TIMER(StatusBarTimer, 1) ClearStatusBar
TIMER(StatusBarTimer) ON
END SUB
SUB MakeCellBlink
'Make cells blink (like a cursor) to indicate edit mode

BlinkState = NOT BlinkState

BoxAt PrintCols(EditX, EditY), PrintRows(EditX, EditY), CellWidth, CellHeight,
CellBGColor(BoardArray(EditX, EditY).CellValue), BlinkState

LOCATE PrintRows(EditX, EditY) + (CellHeight \ 2), PrintCols(EditX, EditY) +

(CellWidth \ 2) - 2

IF BlinkState THEN COLOR ColorPalette(7) ELSE COLOR ColorPalette(15)

IF Grabbed THEN
COLOR , ColorPalette(12)
ELSE
COLOR , CellBGColor(BoardArray(EditX, EditY).CellValue)
END IF
PRINT BoardArray(EditX, EditY).CellValue;
END SUB

FUNCTION ClickedOnHelpButton
DIM mx AS INTEGER, my AS INTEGER, mb AS INTEGER

IF EditMode THEN EXIT SUB

DO WHILE _MOUSEINPUT: LOOP

mx = _MOUSEX
my = _MOUSEY
mb = _MOUSEBUTTON(1)

ClickedOnHelpButton = False
IF mb THEN
IF mx > HelpIconX THEN
IF my > HelpIconY THEN
IF mx < HelpIconX + HelpIconW AND my < HelpIconY + HelpIconH THEN
ClickedOnHelpButton = True
_DELAY .2
END IF
END IF
END IF
END IF
END FUNCTION

SUB ShowHelpIcon
'Place help icon on the screen
HelpIcon = _LOADIMAGE("helpicon.png")

IF HelpIcon < -1 THEN

HelpIconX = _WIDTH - _WIDTH(HelpIcon) - 10
HelpIconY = _HEIGHT - _HEIGHT(HelpIcon) - _FONTHEIGHT
HelpIconW = _WIDTH(HelpIcon)
HelpIconH = _HEIGHT(HelpIcon)
_PUTIMAGE (HelpIconX, HelpIconY), HelpIcon
ELSE
HelpIconX = _WIDTH - 35 - 25
HelpIconY = _HEIGHT - 45 - 26
HelpIconW = 50
HelpIconH = 50
CIRCLE (_WIDTH - 35, _HEIGHT - 45), 25, ColorPalette(1)
 PAINT (_WIDTH - 35, _HEIGHT - 45), ColorPalette(9), ColorPalette(1)
COLOR ColorPalette(15), ColorPalette(9)
_PRINTSTRING (_WIDTH - 39, _HEIGHT - 51), "?"
END IF
IF HelpIcon THEN _FREEIMAGE HelpIcon
END SUB

SUB HideHelpIcon
'Place a box on screen to cover the help icon
LINE (HelpIconX, HelpIconY)-STEP(HelpIconW, HelpIconY), MainScreenBackground, BF
END SUB

SUB ShowHelp
DIM BackupScreen AS LONG, k$, mb AS INTEGER
DIM HelpText(1 TO 19) AS STRING, i AS INTEGER
DIM BoxTop AS INTEGER

HelpText(1) = "Here's the deal: You've got this grid with cells, which"
HelpText(2) = "you move around using arrow keys. Every time you move"
HelpText(3) = "the board, all cells go that way and eventually collide."
HelpText(4) = "If a cell collides with another cell holding the same"
HelpText(5) = "value, they will be merged into a new cell that contains"
HelpText(6) = "the resulting sum. You are supposed to combine cells"
HelpText(7) = "and generate every time higher valued cells."
HelpText(9) = "Your goal is to achieve the mythical 2048 cell."
HelpText(11) = "It's going to be a hypnotical shiny shade of green"
HelpText(12) = "when it appears on your screen."
HelpText(14) = "You can:"
HelpText(15) = "Restart the game with F5"
HelpText(16) = "Toggle sound with F2"
HelpText(17) = "Undo your last move with CTRL+Z"
HelpText(19) = "Hit any key or click here to go back to game"

BackupScreen = _COPYIMAGE(0)
HelpScreen = _LOADIMAGE("helptext.png")

'place a semitransparent box over current screen to give focus to help instructions
LINE (0, 0)-(_WIDTH, _HEIGHT), _RGBA32(255, 255, 255, 150), BF
IF HelpScreen < -1 THEN
_PUTIMAGE (0, 0), HelpScreen
ELSE
BoxTop = ((_HEIGHT \ _FONTHEIGHT) \ 2) - (UBOUND(helptext) \ 2)
BoxCenter BoxTop, 60, UBOUND(helptext) + 2, ColorPalette(8), True, True
COLOR ColorPalette(15), ColorPalette(8)
FOR i = 1 TO UBOUND(helptext)
Center BoxTop + i, HelpText(i)
NEXT i
END IF
k$ = ""
DO
k$ = INKEY$
WHILE _MOUSEINPUT: WEND
mb = _MOUSEBUTTON(1)
IF mb THEN
_DELAY .02
EXIT DO
END IF
LOOP WHILE k$ = ""
WHILE _MOUSEINPUT: WEND
_DELAY .2
_PUTIMAGE (0, 0), BackupScreen
_FREEIMAGE BackupScreen
_FREEIMAGE HelpScreen
END SUB