{{htmlmetatags>metatag-robots=()
metatag-title=( | ugBASIC User Manual)
metatag-keywords=(ugBASIC,Commodore 64,Commodore PLUS/4,ZX Spectrum)
metatag-description=(An isomorphic language for retrocomputers)
metatag-media-og:image=(:ugbasic:logo-ugbasic-fb.png)
metatag-og:title=( | ugBASIC User Manual)
metatag-og:description=(An isomorphic language for retrocomputers)
}}
====== ugBASIC Manuale Utente ======
===== =====
==== SCOPO ====
==== SORGENTE ====
' *****************************************************************************
' * 4 (FOUR) GRAVITY - a connect 4 clone for retrocomputers *
' *****************************************************************************
' * Copyright 2021 Marco Spedaletti (asimov@mclink.it)
' * Powered by ugBASIC (https://ugbasic.iwashere.eu/)
' *
' * Licensed under the Apache License, Version 2.0 (the "License");
' * you may not use this file except in compliance with the License.
' * You may obtain a copy of the License at
' *
' * http://www.apache.org/licenses/LICENSE-2.0
' *
' * Unless required by applicable law or agreed to in writing, software
' * distributed under the License is distributed on an "AS IS" BASIS,
' * WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
' * See the License for the specific language governing permissions and
' * limitations under the License.
' *----------------------------------------------------------------------------
' * Concesso in licenza secondo i termini della Licenza Apache, versione 2.0
' * (la "Licenza"); ? proibito usare questo file se non in conformit? alla
' * Licenza. Una copia della Licenza ? disponibile all'indirizzo:
' *
' * http://www.apache.org/licenses/LICENSE-2.0
' *
' * Se non richiesto dalla legislazione vigente o concordato per iscritto,
' * il software distribuito nei termini della Licenza ? distribuito
' * "COS? COM'?", SENZA GARANZIE O CONDIZIONI DI ALCUN TIPO, esplicite o
' * implicite. Consultare la Licenza per il testo specifico che regola le
' * autorizzazioni e le limitazioni previste dalla medesima.
' ****************************************************************************/
' ============================================================================
' COMPILER OPTIONS (in order to have more spare space)
' ============================================================================
' We ask to define at most 10 independent strings.
' This will free about 1Kb
DEFINE STRING COUNT 16
' We ask to use at most 128 bytes for strings.
' This will free about 2Kb
DEFINE STRING SPACE 256
' ============================================================================
' GAME CONSTANTS
' ============================================================================
' Number of rows for the entire playfield.
' Note that it is 0 based, so the last row is (rows-1).
CONST rows = 6
' Number of columns for the entire playfield.
' Note that it is 0 based, so the last column is (columns-1).
CONST columns = 7
' Number of tokens that can be employed during the entire game.
' Currently, it will be rows x columns.
CONST tokens = rows * columns
' Number of tokens "in a row" to win.
CONST tokensInARowToWin = 4
' Value that represent a free cell inside the playfield.
CONST freeCell = $ff
' Value that represent an unused token inside the tokens' set.
CONST unusedToken = $ff
' This is the constants used to distinguish between tokens of the
' first and the second player.
CONST tokenA = 0
CONST tokenB = 1
' These are the constants used to distinguish between first
' and second player.
CONST noPlayer = 0
CONST player1 = 1
CONST player2 = 2
' These are the constants used to distinguish between human and computer
CONST human = 1
CONST computer = 2
' ============================================================================
' DATA SECTION
' ============================================================================
' This is the matrix that represent the entire playfield. So each cell is
' represented by a single unsigned byte (BYTE, 0...255). Each cell is
' filled with "freeCell" contant (if the cell is free) or with the "color"
' of the token ("tokenA", "tokenB"). This is the internal representation
' used by the various algorithms, to understand if the game is over or not.
DIM playfield AS BYTE WITH freeCell (columns,rows)
' These vectors will contain the actual X, Y and Color for each token.
' Note that they can be filled by "unusedToken" value, that is used as a
' placemark to tell to the various algorithms that the token is not used.
DIM tokenX AS BYTE WITH unusedToken (tokens)
DIM tokenY AS BYTE WITH unusedToken (tokens)
DIM tokenC AS BYTE WITH unusedToken (tokens)
' This variable store the last used token index.
' (we force to be a byte!)
VAR lastUsedToken AS BYTE = unusedToken
' This variable store the last used column.
' (we force to be a byte!)
VAR lastUsedColumn AS BYTE = unusedToken
' This variable store the player that must current play
VAR currentPlayer AS BYTE = player1
' This variable store the player that must current wait
VAR previousPlayer AS BYTE = player2
' This variable store if the player1 is an human or a computer
VAR player1Type AS BYTE = human
' This variable store if the player2 is an human or a computer
VAR player2Type AS BYTE = human
' This variable store the current frame for arrow and direction
VAR arrow AS BYTE = 0
VAR arrowDirection AS BYTE = 1
' This variable store which player won the game
VAR playerWon AS BYTE = noPlayer
' ============================================================================
' CODE SECTION
' ============================================================================
' ----------------------------------------------------------------------------
' --- STARTUP
' ----------------------------------------------------------------------------
' Let's choose an hires graphical mode with enough number of colors,
' and let's clear the screen with a black border.
BITMAP ENABLE (16)
CLS
COLOR BORDER BLACK
' We must add constants on this point because only here we have
' informations about graphical mode selected.
CONST player1MenuLabel = IF(( SCREEN WIDTH > 160), IF(( SCREEN HEIGHT > 200 ),"[1] HUMAN / [2] COMPUTER","1=HUMAN 2=PC"), "1=HUMAN 2=PC")
CONST player2MenuLabel = IF(( SCREEN WIDTH > 160), IF(( SCREEN HEIGHT > 200 ),"[3] HUMAN / [4] COMPUTER","3=HUMAN 4=PC"), "3=HUMAN 4=PC")
' Assign all the graphical resources. Note the use of ":=" direct assing
' operator. This is needed to avoid useless copies.
titleImage := IMAGE LOAD("examples/resources/title.png")
tokenAImage := IMAGE LOAD("examples/resources/tokenAC.png")
tokenBImage := IMAGE LOAD("examples/resources/tokenBC.png")
emptyImage := IMAGE LOAD("examples/resources/emptyC.png")
player1Image := IMAGE LOAD("examples/resources/player1.png")
player2Image := IMAGE LOAD("examples/resources/player2.png")
computer1Image := IMAGE LOAD("examples/resources/computer1.png")
computer2Image := IMAGE LOAD("examples/resources/computer2.png")
arrow1Image := IMAGE LOAD("examples/resources/arrow1.png")
arrow2Image := IMAGE LOAD("examples/resources/arrow2.png")
arrow3Image := IMAGE LOAD("examples/resources/arrow3.png")
clearImage := IMAGE LOAD("examples/resources/clear.png")
' Precalculate the width and the height of the various images.
' They are always of the same size, so it is sufficient to
' take the first image's dimensions.
POSITIVE CONST imageWidth = IMAGE WIDTH(tokenAImage)
POSITIVE CONST imageHeight = IMAGE HEIGHT(tokenAImage)
' Precalculate offsets in order to put the playfield at the center
' of the screen.
POSITIVE CONST offsetWidth = ( SCREEN WIDTH - ( columns * imageWidth ) ) / 2
POSITIVE CONST offsetHeight = ( SCREEN HEIGHT - ( rows * imageHeight ) ) / 2
' Offset of the main title
POSITIVE CONST offsetTitleX = ( SCREEN WIDTH - IMAGE WIDTH(titleImage) ) / 2
POSITIVE CONST offsetTitleY = ( SCREEN HEIGHT - IMAGE HEIGHT(titleImage) - 2 * IMAGE HEIGHT(player1Image) - 4 * 8 ) / 2
' Offset of the main title (final)
POSITIVE CONST offsetYTitle = offsetTitleY
' Precalculate offsets of arrows
POSITIVE CONST arrowX2 = SCREEN WIDTH - IMAGE WIDTH(arrow1Image)
POSITIVE CONST arrowY = SCREEN HEIGHT - IMAGE HEIGHT(player1Image) - IMAGE HEIGHT(arrow1Image)
' Precalculate offsets of players
POSITIVE CONST offsetYPlayers = SCREEN HEIGHT - IMAGE HEIGHT(player1Image)
POSITIVE CONST offsetXPlayer2 = SCREEN WIDTH - IMAGE WIDTH(player1Image)
' Precalculate offsets of menu entries
CONST offsetXMainMenuPlayer IN (0,SCREEN WIDTH) = offsetTitleX - IF(offsetTitleX>( IMAGE WIDTH(player1Image) / 2 ), ( IMAGE WIDTH(player1Image) / 2 ), 0 )
CONST offsetXMainMenu IN (0,SCREEN WIDTH) = ( ( offsetXMainMenuPlayer + IMAGE WIDTH( player1Image ) ) / FONT WIDTH ) + 2
CONST offsetYMainMenu IN (0,SCREEN HEIGHT) = offsetTitleY + IMAGE HEIGHT(titleImage) + 8
CONST offsetYMainMenu2 IN (0,SCREEN HEIGHT) = offsetYMainMenu + IMAGE HEIGHT(player1Image) + 8
' Constant labels
CONST player1Label = IF(( SCREEN WIDTH >= 160) AND ( SCREEN HEIGHT >= 100 ), "PLAYER 1", "PLY1" )
CONST player2Label = IF(( SCREEN WIDTH >= 160) AND ( SCREEN HEIGHT >= 100 ), "PLAYER 2", "PLY2" )
CONST player1XLabel = ( IMAGE WIDTH( player1Image ) / FONT WIDTH ) + 1
CONST player2XLabel = ( SCREEN TILES WIDTH - IMAGE WIDTH( player1Image ) / FONT WIDTH ) - LEN( player2Label ) - 1
POSITIVE CONST screenHeight = SCREEN HEIGHT
POSITIVE CONST lastLine = ( SCREEN HEIGHT / FONT HEIGHT ) - 1
' For commodity, all those variables are global:
GLOBAL playfield, tokenX, tokenY, tokenC
GLOBAL lastUsedToken, lastUsedColumn, currentPlayer, previousPlayer
GLOBAL tokenAImage, tokenBImage, emptyImage
GLOBAL titleImage, player1Image, player2Image
GLOBAL arrow1Image, arrow2Image, arrow3Image
GLOBAL computer1Image, computer2Image
GLOBAL arrow, arrowDirection
GLOBAL clearImage
GLOBAL player1Type, player2Type, playerWon
' ----------------------------------------------------------------------------
' --- GRAPHICAL PROCEDURES
' ----------------------------------------------------------------------------
' This procedure is responsible for initializing all game variables
' before each game. Furthermore, it will also initialize the random number
' generation system. .
PROCEDURE gameInit
' Initialize the random number generator
RANDOMIZE TIMER
' Fill matrix with all free cells
FILL playfield WITH freeCell
' Fill vectors with unused tokens
FILL tokenX WITH unusedToken
FILL tokenY WITH unusedToken
FILL tokenC WITH unusedToken
' No token has been used.
lastUsedToken = # unusedToken
' No column has been filled.
lastUsedColumn = # unusedToken
' Player 1 starts always as first player.
' Next player (or, previous player) is the second player
currentPlayer = # player1
previousPlayer = # player2
' Nobody wins
playerWon = # noPlayer
' Both players start as humans
player1Type = # human
player2Type = # human
' Reset the arrow animation.
arrow = # 0
arrowDirection = # 1
END PROC
' This method is able to draw the movement of a single token.
PROCEDURE drawMovingToken[t AS BYTE]
' Let's take coordinates of the token and the token type.
x = tokenX(t)
y = tokenY(t)
c = tokenC(t)
' The abscissa is fixed, and it is calculated as the pixel
' that starts the playfield plus the relative column given.
' Each column of the playfield is large as a single token.
previousX = offsetWidth + x*imageWidth
' If the ordinate is greater than zero, it means that
' the token is slowly falling on the column...
IF y > 0 THEN
' ... so we calculate the previous position of the
' token, and the actual as the previous plus the
' the height of a token.
previousY = offsetHeight + (y-1)*imageHeight
actualY = previousY + imageHeight
ELSE
' Otherwise, the actual and previous position are the
' very same. This is needed to draw the token as soon
' as it is inserted in the playfield.
actualY = offsetHeight + (y)*imageHeight
previousY = actualY
ENDIF
' Let's clear the previous position of the token.
PUT IMAGE emptyImage AT previousX, previousY
' Now we can draw the token at the actual position.
' We must use the correct image.
IF c == tokenA THEN
PUT IMAGE tokenAImage AT previousX, actualY
ELSE
PUT IMAGE tokenBImage AT previousX, actualY
ENDIF
END PROC
PROCEDURE drawPlayerNames ON C64, DRAGON
' We characterize the player with his/her name.
PEN RED
LOCATE player1XLabel, lastLine: PRINT player1Label;
PEN YELLOW
LOCATE player2XLabel, lastLine: PRINT player2Label;
END PROC
' This procedure is used to draw the game plan.
' As it is drawn only once, it is a very
' simple routine.
PROCEDURE drawPlayfield
' Clear the screen
CLS
IF ( screenHeight >= 100 ) THEN
' Put the title "4 GRAVITY!" at the head of the screen.
PUT IMAGE titleImage AT offsetTitleX, 0
ENDIF
' To draw the various empty squares of the game, we iterate for the rows
' and for the columns. To avoid doing multiplications (which are usually
' slow operations) we use simple increments and reassignments.
dy = # offsetHeight
FOR y = 0 TO rows-1
dx = # offsetWidth
FOR x = 0 TO columns-1
PUT IMAGE emptyImage AT dx, dy
dx = dx + imageWidth
NEXT
dy = dy + imageHeight
NEXT
' Now let's draw the two player icons, on the left (first player, red)
' and on the right of the screen (second player, yellow).
' Clearly, we find ourselves in the situation of having to distinguish
' whether the player is a human or a computer. This distinction is
' necessary for drawing using the correct icon, for both first and
' second player.
IF player1Type == human THEN
PUT IMAGE player1Image AT 0, offsetYPlayers
ELSE
PUT IMAGE computer1Image AT 0, offsetYPlayers
ENDIF
IF player2Type == human THEN
PUT IMAGE player2Image AT offsetXPlayer2, offsetYPlayers
ELSE
PUT IMAGE computer2Image AT offsetXPlayer2, offsetYPlayers
ENDIF
CALL drawPlayerNames
END PROC
' This procedure is used to draw the arrow animation.
PROCEDURE drawArrowAnimation
' To ensure a constant speed animation, we memorize the moment
' in time when we drew the last frame. By doing so, we ensure
' that the animation will always be at the same speed.
SHARED lastTiming
' So, the first time we must register this time
IF lastTiming == 0 THEN
lastTiming = TI
' On the other times...
ELSE
' When at least 1/60 of a second has passed, then we are
' allowed to draw the new arrow frame, if available.
IF ( TI - lastTiming ) > 1 THEN
' The animation is "bounce", so as soon as we get to the
' last frame we have to go back in the animation.
IF arrowDirection == 1 THEN
' Let's increment the number of the frame.
INC arrow
' On the last frame, we revert direction.
IF arrow == 30 THEN
arrowDirection = # 0
ENDIF
ELSE
' Let's decrement the number of the frame.
DEC arrow
' On the first frame, we revert direction.
IF arrow == 0 THEN
arrowDirection = # 1
ENDIF
ENDIF
' We delete the arrow of the player who is not playing now.
IF currentPlayer == player1 THEN
x = # 0
PUT IMAGE clearImage AT arrowX2, arrowY
ELSE
x = # arrowX2
PUT IMAGE clearImage AT 0, arrowY
ENDIF
' We draw, if there is the possibility, the frame of the arrow.
IF arrow == 21 THEN
PUT IMAGE arrow3Image AT x, arrowY
ELSE IF arrow == 11 THEN
PUT IMAGE arrow2Image AT x, arrowY
ELSE IF arrow == 1 THEN
PUT IMAGE arrow3Image AT x, arrowY
ENDIF
' Update timings
lastTiming = TI
ENDIF
ENDIF
END PROC
' This procedure updates the color of the numbers above the columns
' to indicate which player is currently playing.
PROCEDURE drawPlayerStatus ON C64
' The color RED for the first player
' and YELLOW for the second player.
IF currentPlayer == player1 THEN
PEN RED
ELSE
PEN YELLOW
ENDIF
LOCATE 1, 5: CENTER " 1 2 3 4 5 6 7"
END PROC
PROCEDURE informationalMessages ON C64
' To ensure a constant speed animation of informational
' title, we memorize the moment in time when we drew the
' last informational title. By doing so, we ensure
' that the animation will always be at the same speed.
SHARED lastTiming
yt = ( offsetYMainMenu / FONT HEIGHT ) + 8
IF ( screenHeight >= 100 ) THEN
IF (TI-lastTiming) > 600 THEN
IF m == 0 THEN
PEN CYAN
LOCATE 1,yt: CENTER " SEE MORE GAMES AT "
LOCATE 1,yt+1: CENTER "https://retroprogramming.iwashere.eu/"
m = 1
ELSE
PEN BLUE
LOCATE 1,yt: CENTER "POWERED BY ugBASIC"
LOCATE 1,yt+1: CENTER " https://ugbasic.iwashere.eu/ "
m = 0
ENDIF
lastTiming = TI
ENDIF
ENDIF
END PROC
' This procedure deals with designing the initial screen,
' including the menu with which the player can choose the
' game mode (two human players, player against computer,
' computer against computer).
PROCEDURE drawTitleScreen
' Take note of which informational message we are
' going to show (0 = see more games; 1 = ugbasic)
m = 0
' Take note if the SPACE key has been pressed,
' and the game can be started as well.
done = FALSE
' Let's clear the screen
CLS
' We calculate the position in which to write the text.
' In a nutshell, we place ourselves on the right of the
' player icon.
' The title, on the other hand, we position it centrally
' vertically on the screen, but moved slightly upwards.
y = offsetYTitle
' Draw the title ("4 GRAVITY!")
PUT IMAGE titleImage AT offsetTitleX, y
' ' Clear the keyboard buffer, in order to avoid to
' ' detect any WAIT KEY key press as a key pressed.
CLEAR KEY
' ' Let's define the variable that will wait for a key press.
k = ""
' ' Here we start a loop where we will stay until the player
' ' has pressed the SPACE key.
REPEAT
' The main color of the writing will be white.
PEN WHITE
' This is the position from which to start writing.
' It corresponds to the lower edge of the title,
' from which we move down to make room for the icons.
' We calculate manually the equivalend text position.
yt = offsetYMainMenu / FONT HEIGHT
' We design a different icon depending on whether
' it is a human player or a computer (player 1).
IF player1Type == human THEN
PUT IMAGE player1Image AT offsetXMainMenuPlayer, offsetYMainMenu
ELSE
PUT IMAGE computer1Image AT offsetXMainMenuPlayer, offsetYMainMenu
ENDIF
LOCATE offsetXMainMenu,yt: PRINT player1MenuLabel;
' This is the next position from which to start writing.
y = offsetYMainMenu2
' We calculate manually the equivalend text position.
yt = offsetYMainMenu2 / FONT HEIGHT
' We design a different icon depending on whether
' it is a human player or a computer (player 2).
IF player2Type == human THEN
PUT IMAGE player2Image AT offsetXMainMenuPlayer, offsetYMainMenu2
ELSE
PUT IMAGE computer2Image AT offsetXMainMenuPlayer, offsetYMainMenu2
ENDIF
LOCATE offsetXMainMenu,yt: PRINT player2MenuLabel;
INC yt
INC yt
INC yt
' Let's suggest to press the SPACE key to PLAY!
LOCATE 10,yt: CENTER "[SPACE] TO PLAY"
INC yt
INC yt
' A loop to wait for a valid key.
REPEAT
k = INKEY$
' While waiting for a button to be pressed,
' we offer a couple of informational messages.
CALL informationalMessages
UNTIL k<>""
' SPACE equals START GAME!
IF k == " " THEN
done = TRUE
ELSE
' Let's check the key pressed (it is a number?)
v = VAL(k)
IF v == 1 THEN
player1Type = human
ELSE IF v == 2 THEN
player1Type = computer
ELSE IF v == 3 THEN
player2Type = human
ELSE IF v == 4 THEN
player2Type = computer
ENDIF
ENDIF
UNTIL done
END PROC
' This procedure deals with designing the final screen.
PROCEDURE drawFinalScreen[p AS BYTE]
' Clear the screen
CLS
' The title, on the other hand, we position it centrally
' vertically on the screen, but moved slightly upwards.
' Draw the title ("4 GRAVITY!")
PUT IMAGE titleImage AT offsetTitleX, offsetYTitle
' Calculate the position where to write
y = offsetYTitle + 2 * IMAGE HEIGHT(titleImage)
yt = y / FONT HEIGHT
' Position the writing and...
LOCATE 1,yt
' ... if player 1 wins...
IF p == player1 THEN
PEN RED
CENTER "PLAYER 1 WINS"
' ... if player 2 wins...
ELSE IF p == player2 THEN
PEN YELLOW
CENTER "PLAYER 2 WINS"
' ... if nobody wins...
ELSE
PEN WHITE
CENTER "GAME TIE"
ENDIF
' ' Suggest to press any key to start.
LOCATE 10,yt + 4: CENTER "*ANY KEY* TO CONTINUE"
WAIT KEY
END PROC
' ' ----------------------------------------------------------------------------
' ' --- ALGORITHMS PROCEDURES
' ' ----------------------------------------------------------------------------
' This procedure will move the token by one step down.
PROCEDURE moveTokenDown[t AS BYTE]
' Let's take coordinates of the token and the token type.
x = tokenX(t)
y = tokenY(t)
c = tokenC(t)
' If the ordinate is valid, then it means that we have
' to free the actual position on the playfield.
IF y <> unusedToken THEN
playfield(x,y) = freeCell
ENDIF
' Move to the next ordinate.
y = y + 1
' Save the new position.
tokenY(t) = y
' Occupy the playfield cell.
playfield(x,y) = c
' Now we can draw the movement on the graphical playfield.
drawMovingToken[t]
END PROC
' This procedure will check if there are the conditions
' to move down a token by one cell. If so, it will move
' the token down by one step.
PROCEDURE moveToken[t AS BYTE]
' The token cannot be moved if it is not currently used.
EXIT PROC WITH FALSE IF t > lastUsedToken
' The token cannot be moved if it is on the last position.
EXIT PROC WITH FALSE IF tokenY(t) == (rows-1)
' The token can be moved only if the next (vertical) cell
' is free. In that case...
NOP
NOP
IF playfield(tokenX(t),tokenY(t)+1) == freeCell THEN
NOP
NOP
' ... move the token down by one position!
CALL moveTokenDown[t]
' We communicate to the caller that the token has been
' moved. This information will be used to avoid to
' make any check while tokens are moving.
RETURN TRUE
ELSE
' We communicate to the caller that the token has NOT been moved.
RETURN FALSE
ENDIF
END PROC
' This procedure wiill move every (used) tokens
' if the conditions are met.
PROCEDURE moveTokens
VAR i AS BYTE
' There are not used tokens. So we communicate to the caller
' that no token has been moved. This information will be used
' to avoid to make any check while tokens are moving.
EXIT PROC WITH FALSE IF lastUsedToken == unusedToken
' Has any token been moved?
anyMovedToken = FALSE
' Take a look for every used token: is there any token
' that must be moved?
FOR i = 0 TO lastUsedToken
' If so, the infomation about the fact that has
' been moved will be retrieved and returned back.
anyMovedToken = anyMovedToken OR moveToken[i]
NEXT
RETURN anyMovedToken
END PROC
' This procedure will put (if possible) a token on the playfield.
PROCEDURE putTokenAt[x AS BYTE, c AS BYTE]
' No more token available, so... exit!
EXIT PROC WITH FALSE IF lastUsedToken == tokens
' Cannot put a token if another token is moving down...
EXIT PROC WITH FALSE IF lastUsedColumn <> unusedToken
' If the given column is free...
IF playfield(x,0) == freeCell THEN
' Take another token, and initialize
' its position and type.
INC lastUsedToken
t = lastUsedToken
tokenX(t) = x
tokenC(t) = c
lastUsedColumn = x
' Return the information that the token has
' been put on the playfield.
RETURN TRUE
ENDIF
' Token cannot be put.
RETURN FALSE
END PROC
' This is the common procedure between the computer and the human player.
' The aim is to check if there is a possibility to put a token.
' Of course, he also takes care of changing players if that happens.
PROCEDURE pollToken[x AS BYTE]
IF currentPlayer == player1 THEN
actualTokenType = tokenA
nextPlayer = # player2
previousPlayer = # player1
ELSE
actualTokenType = tokenB
nextPlayer = # player1
previousPlayer = # player2
ENDIF
IF putTokenAt[(x-1),actualTokenType] THEN
currentPlayer = nextPlayer
' Little hack to update arrow animation.
lastTiming = TI: arrowDirection = 1: arrow = 0
ENDIF
END PROC
' This procedure will poll the computer for action.
' Here is a little mathematical study to do. According to game theory,
' "connect 4" is not a game that has random components. In fact, it is
' a game where it is possible to define the winning and losing strategies
' in a deterministic way. This is where this somewhat "lateral" algorithm
' comes into play. It is about taking advantage of the principle
' that randomly choosing a position from among those possible, avoiding
' repetitions, can guarantee a good winning performance.
PROCEDURE pollComputerForColumn
' Avoid to use the very same column already used.
SHARED lastComputerColumn
x = ( ( RANDOM BYTE ) MOD columns ) + 1
IF ( x > 0 ) AND ( x <= columns ) AND ( lastComputerColumn <> x ) THEN
CALL pollToken[x]
lastComputerColumn = x
ENDIF
END PROC
' This procedure will poll the keyboard for action from player.
PROCEDURE pollKeyboardForColumn
k = INKEY$
x = VAL(k)
IF ( x > 0 ) AND ( x <= columns ) THEN
CALL pollToken[x]
ENDIF
END PROC
' This routine allows to calculate how many tokens of a certain
' color there are along a certain line, starting from a specific
' position. This is partial information, which however tells us
' if the last move was successful.
PROCEDURE countTokensOfAColorFromXYOnDirection[ c AS BYTE, x AS BYTE, y AS BYTE, dx AS BYTE, dy AS BYTE ]
DIM i AS BYTE
DIM cx AS SIGNED BYTE
DIM cy AS SIGNED BYTE
' Center of counting
cx = x
cy = y
' Number of tokens of the same value.
t = 0
' Loop along at most 3 cells
FOR i=0 TO 3
' Is cell occupied by a different token type
' or it is empty? Let's stop counting!
IF playfield(cx,cy) <> c THEN
EXIT
ENDIF
' Let's increment the number of tokens.
INC t
' Move along the direction, stopping if
' the border of the playfield has been reached.
cx = cx + dx
IF ( cx < 0 ) OR ( cx == columns ) THEN
EXIT
ENDIF
' Move along the direction, stopping if
' the border of the playfield has been reached.
cy = cy + dy
IF ( cy < 0 ) OR ( cy == rows ) THEN
EXIT
ENDIF
NEXT
' Return the number of tokens counted.
RETURN t
END PROC
' This is the overall check procedure, which checks
' whether the last player won or lost. It is a
' "divide and conquer" algorithm; together with a
' check on the last move made.
PROCEDURE checkIfPlayerWon
' Nobody can win if no token has been used.
EXIT PROC WITH FALSE IF lastUsedToken == unusedToken
' Nobody can win if no token has been chosen.
EXIT PROC WITH FALSE IF lastUsedColumn == unusedToken
' Let's take coordinates of the token and the token type.
c = tokenC(lastUsedToken)
cx = tokenX(lastUsedToken)
cy = tokenY(lastUsedToken)
' Nobody can win if last token is moving.
EXIT PROC WITH FALSE IF cy == unusedToken
' Has the player won on NORD EAST direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,1,-1] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on EAST direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,1,0] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on SOUTH EAST direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,1,1] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on SOUTH direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,0,1] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on SOUTH WEST direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,-1,1] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on NORD direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,-1,0] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Has the player won on NORTH WEST direction?
IF countTokensOfAColorFromXYOnDirection[c,cx,cy,-1,-1] >= tokensInARowToWin THEN
GOTO success
ENDIF
' Let's reset the used column.
lastUsedColumn = unusedToken
RETURN FALSE
success:
RETURN previousPlayer
END PROC
' ----------------------------------------------------------------------------
' --- MAIN LOOP
' ----------------------------------------------------------------------------
' This is where the main game loop begins.
BEGIN GAMELOOP
' Initialize the game
CALL gameInit
' Initial screen (and options)
CALL drawTitleScreen
' Initial playfield
CALL drawPlayfield
' When the game start, nobody wins.
playerWon = # noPlayer
' We repeat this loop until someone has won
' (or all the tokens are gone!).
REPEAT
' Draw the arrow to make clear who is playing
CALL drawArrowAnimation
' If tokens are not moving...
IF NOT moveTokens[] THEN
' Check if somebody wins.
playerWon = checkIfPlayerWon[]
' Update the player status.
CALL drawPlayerStatus
' If nobody has win, asks for the next move.
IF playerWon == noPlayer THEN
IF currentPlayer == player1 THEN
IF player1Type == human THEN
CALL pollKeyboardForColumn
ELSE
CALL pollComputerForColumn
ENDIF
ELSE
IF player2Type == human THEN
CALL pollKeyboardForColumn
ELSE
CALL pollComputerForColumn
ENDIF
ENDIF
ENDIF
ENDIF
UNTIL playerWon <> noPlayer OR lastUsedToken == tokens
' Final screen
CALL drawFinalScreen[playerWon]
END GAMELOOP
==== FILE ====
* ''[[https://github.com/spotlessmind1975/ugbasic/tree/main/examples/4gravity.bas|4gravity.bas]]''
==== COME ESEGUIRLO ====
=== Atari 400/800 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore Altirra, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.atari 4gravity.bas -o example.xex
altirra example.xex
# Windows
ugbc.atari.exe 4gravity.bas -o example.xex
altirra example.xex
=== Atari 600XL/800XL/1200XL/XG(SE) ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore Altirra, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.atarixl 4gravity.bas -o example.xex
altirra example.xex
# Windows
ugbc.atarixl.exe 4gravity.bas -o example.xex
altirra example.xex
=== Commodore 64 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore VICE, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.c64 4gravity.bas -o example.prg
x64sc example.prg
# Windows
ugbc.c64.exe 4gravity.bas -o example.prg
x64sc example.prg
=== Commodore PLUS/4 ===
== Usando YAPE ==
Per poter eseguire l'esempio, è necessario disporre dell'emulatore YAPE, e in particolare che l'eseguibile ''yape'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.plus4 4gravity.bas -o example.prg
yape example.prg
# Windows
ugbc.plus4.exe 4gravity.bas -o example.prg
yape example.prg
== Usando VICE ==
Per poter eseguire l'esempio, è necessario disporre dell'emulatore VICE, e in particolare che l'eseguibile ''xplus4'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.plus4 4gravity.bas -o example.prg
xplus4 example.prg
# Windows
ugbc.plus4.exe 4gravity.bas -o example.prg
xplus4 example.prg
=== Dragon 32 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore XROAR, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.d32 4gravity.bas -o example.bin
xroar -rompath (percorso ROM) example.bin
# Windows
ugbc.d32.exe 4gravity.bas -o example.bin
xroar.exe -rompath (percorso ROM) example.bin
=== Dragon 64 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore XROAR, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.d64 4gravity.bas -o example.bin
xroar -rompath (percorso ROM) example.bin
# Windows
ugbc.d64.exe 4gravity.bas -o example.bin
xroar.exe -rompath (percorso ROM) example.bin
=== PC128 Olivetti Prodest ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore DCMOTO, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi i seguenti comandi:
# Linux
ugbc.pc128op 4gravity.bas -o example.bin
dcmoto example.bin
(scegliere example.bin)
(scegliere BASIC 128)
CLEAR,&H2FFF: LOADM"CASS:",R: EXEC
# Windows
ugbc.pc128op.exe 4gravity.bas -o example.bin
dcmoto example.bin
(scegliere BASIC 128)
CLEAR,&H2FFF: LOADM"CASS:",R: EXEC
=== Thomson MO5 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore DCMOTO, e in particolare che l'eseguibile ''x64sc'' sia accessibile.
Digitare quindi i seguenti comandi:
# Linux
ugbc.mo5 4gravity.bas -o example.bin
dcmoto example.bin
(scegliere example.bin)
(scegliere BASIC 128)
CLEAR,&H2FFF: LOADM"CASS:",R: EXEC
# Windows
ugbc.mo5.exe 4gravity.bas -o example.bin
dcmoto example.bin
(scegliere BASIC 128)
CLEAR,&H2FFF: LOADM"CASS:",R: EXEC
=== Commodore VIC-20 ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore XEMU, e in particolare che l'eseguibile ''xmega65'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.vic20 4gravity.bas -o example.prg
xvic --memory 24k example.prg
# Windows
ugbc.vic20.exe 4gravity.bas -o example.prg
xvic --memory 24k example.prg
=== ZX Spectrum ===
Per poter eseguire l'esempio, è necessario disporre dell'emulatore Speccy, e in particolare che l'eseguibile ''speccy'' sia accessibile.
Digitare quindi il seguente comando:
# Linux
ugbc.zx 4gravity.bas -o example.tap
Speccy example.tap
# Windows
ugbc.zx.exe 4gravity.bas -o example.tap
Speccy example.tap
=== ColecoVision ===
Per compilare e mandare in esecuzione l'esempio, hai bisogno di avere l'emulatore openMsx oppure il BlueMSX, e in particolare che il suo eseguibile sia accessibile.
Dopo di che, digita questo comando sulla linea di comando:
== openMSX ==
# Linux
ugbc.coleco 4gravity.bas -o example.rom
openmsx -machine \"COL - ColecoVision\" -cart example.rom
# Windows
ugbc.coleco.exe 4gravity.bas -o example.rom
bluemsx -machine \"COL - ColecoVision\" example.rom
== blueMSX ==
# Linux
ugbc.coleco 4gravity.bas -o example.rom
bluemsx /machine \"COL - ColecoVision\" /rom1 example.rom
# Windows
ugbc.coleco.exe 4gravity.bas -o example.rom
bluemsx /machine \"COL - ColecoVision\" /rom1 example.rom
=== SEGA SC-3000 ===
Per compilare e mandare in esecuzione l'esempio, hai bisogno di avere l'emulatore BlueMSX, e in particolare che il suo eseguibile sia accessibile.
Dopo di che, digita questo comando sulla linea di comando:
# Linux
ugbc.sc3000 4gravity.bas -o example.rom
bluemsx /machine \"SEGA - SC-3000\" /rom1 example.rom
# Windows
ugbc.sc3000.exe 4gravity.bas -o example.rom
bluemsx /machine \"SEGA - SC-3000\" /rom1 example.rom
=== SEGA SG-1000 ===
Per compilare e mandare in esecuzione l'esempio, hai bisogno di avere l'emulatore BlueMSX, e in particolare che il suo eseguibile sia accessibile.
Dopo di che, digita questo comando sulla linea di comando:
# Linux
ugbc.sg1000 4gravity.bas -o example.rom
bluemsx /machine \"SEGA - SG-1000\" /rom1 example.rom
# Windows
ugbc.sg1000.exe 4gravity.bas -o example.rom
bluemsx /machine \"SEGA - SG-1000\" /rom1 example.rom
==== PROBLEMI? ====
Se hai trovato un problema nel cercare di eseguire questo esempio, se pensi che ci sia un bug o, più semplicemente, vorresti che fosse migliorato, [[https://github.com/spotlessmind1975/ugbasic/issues/new?title=MIGLIORARE |apri una segnalazione]] su GitHub per questo specifico esempio. Grazie!===== POWERED BY =====
[[:it:ugbasic:user:examples|{{ :ugbasic:user:logo-ugbasic.png?nolink&600 |}}]]