...lo stesso codice con ulteriori modificazioni, poiché in questo caso l'ho trasportato in
'******************************************************************************************************************************************
' Il presente codice è la traduzione in Gambas, effettuata dal membro del foro gambas-it.org "vuott", con variazioni ed integrazioni,
' del codice originale, scritto in linguaggio C, del progetto di Kjetil Erga, chiamato "SDL Pong".
'
'
' Copyright (c) 2007 Kjetil Erga
'
' Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation
' files (the "Software"), to deal in the Software without restriction, including without limitation the rights to use,
' copy, modify, merge, publish, distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom
' the Software is Furnished to do so, subject to the following conditions:
' The above copyright notice and this permission notice shall be included in all copies or substantial portions of the Software.
' THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
' OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS
' BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
' OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
'******************************************************************************************************************************************
Private Const GAME_SPEED As Integer = 20
Private Const SCREEN_WIDTH As Integer = 640
Private Const SCREEN_HEIGHT As Integer = 480
Private Const PLAYER_WIDTH As Integer = 10
Private Const PLAYER_HEIGHT As Integer = 40
Private Const BALL_SIZE As Integer = 10
Private Const BALL_SPEED_INC As Integer = 1
Private Const CPU_ACCEL_DEF As Integer = 5
Private Const MOVING_UP As Integer = 1
Private Const MOVING_DOWN As Integer = 2
Private Const MOVING_UP_INT As Integer = 3
Private Const MOVING_DOWN_INT As Integer = 4
Private Const RAND_MAX As Integer = 2147483647
Private ball_vector_x As Single
Private ball_vector_y As Single
Private ball_speed As Integer
Library "libSDL2-2.0:0.10.0"
Public Struct SDL_Rect
x As Integer
y As Integer
w As Integer
h As Integer
End Struct
Private ball As New SDL_Rect
Private utente As New SDL_Rect
Private cpu As New SDL_Rect
Private background As New SDL_Rect
Private Const SDL_INIT_VIDEO As Integer = 32
Private Const SDL_WINDOW_SHOWN As Integer = 4
Private Const SDL_KEYDOWN As Integer = 768
Private Const SDL_KEYUP As Integer = 769
Private Const SDLK_q As Byte = 20
Private Const SDLK_DOWN As Short = 81
Private Const SDLK_UP As Short = 82
Private Enum SDL_RENDERER_SOFTWARE = 1, SDL_RENDERER_ACCELERATED, SDL_RENDERER_PRESENTVSYNC = 4, SDL_RENDERER_TARGETTEXTURE = 8
' int SDL_Init (Uint32 flags)
' Loads the SDL dynamically linked library and initializes the subsystems specified by 'flags'.
Private Extern SDL_Init(flags As Integer) As Integer
' char * SDL_GetError (void)
' Retrieves a message about the last error that occurred.
Private Extern SDL_GetError() As String
' SDL_Window* SDL_CreateWindow(const char* title, int x, int y, int w, int h, Uint32 flags)
' Creates a window with the specified position, dimensions, and flags.
Private Extern SDL_CreateWindow(title As String, xI As Integer, yI As Integer, width As Integer, height As Integer, flags As Integer) As Pointer
' SDL_Renderer* SDL_CreateRenderer(SDL_Window* window, int index, Uint32 flags)
' Creates a 2D rendering context for a window.
Private Extern SDL_CreateRenderer(sdl_window As Pointer, index As Integer, flags As Integer) As Pointer
' int SDL_SetRenderDrawColor(SDL_Renderer * renderer, Uint8 r, Uint8 g, Uint8 b, Uint8 a)
' Sets the color used for drawing operations (Rect, Line and Clear).
Private Extern SDL_SetRenderDrawColor(renderer As Pointer, rB As Byte, gB As Byte, bB As Byte, aB As Byte) As Integer
' int SDL_RenderClear(SDL_Renderer* renderer)
' Clears the current rendering target with the drawing color.
Private Extern SDL_RenderClear(renderer As Pointer) As Integer
' void SDL_SetWindowTitle(SDL_Window* window, const char* title)
' Sets the title of a window.
Private Extern SDL_SetWindowTitle(sdl_window As Pointer, title As String)
' int SDL_PollEvent (SDL_Event *event)
' Polls for currently pending events.
Private Extern SDL_PollEvent(SDL_ev As Pointer) As Integer
' int SDL_RenderDrawRect(SDL_Renderer * renderer, const SDL_Rect* rect)
' Draws a rectangle on the current rendering target.
Private Extern SDL_RenderDrawRect(renderer As Pointer, rect As SDL_Rect) As Integer
' int SDL_RenderFillRect(SDL_Renderer * renderer, const SDL_Rect* rect)
' Fills a rectangle on the current rendering target with the drawing color.
Private Extern SDL_RenderFillRect(renderer As Pointer, rect As SDL_Rect) As Integer
' void SDL_RenderPresent(SDL_Renderer * renderer)
' Update the screen with rendering performed.
Private Extern SDL_RenderPresent(renderer As Pointer)
' int SDL_Delay (Uint32 ms)
' Waits a specified number of milliseconds before returning.
Private Extern SDL_Delay(ms As Integer) As Integer
' void SDL_DestroyRenderer(SDL_Renderer* renderer)
' Destroy the rendering context for a window and free associated textures.
Private Extern SDL_DestroyRenderer(renderer As Pointer)
' void SDL_DestroyWindow(SDL_Window* window)
' Destroy a window.
Private Extern SDL_DestroyWindow(sdl_window As Pointer)
' void SDL_Quit (void)
' Cleans up all initialized subsystems.
Private Extern SDL_Quit()
Public Sub Main()
Dim err, user_moving, cpu_moving, user_acceleration As Integer
Dim cpu_acceleration, cpu_accel_factor, user_score, cpu_score As Integer
Dim scr, rend, ev As Pointer
cpu_accel_factor = CPU_ACCEL_DEF
With utente
.x = 0 ' Ad laevam semper
.y = (SCREEN_HEIGHT / 2) - (PLAYER_HEIGHT / 2)
.w = PLAYER_WIDTH
.h = PLAYER_HEIGHT
End With
With cpu
.x = SCREEN_WIDTH - PLAYER_WIDTH ' Ad dexteram semper
.y = (SCREEN_HEIGHT / 2) - (PLAYER_HEIGHT / 2)
.w = PLAYER_WIDTH
.h = PLAYER_HEIGHT
End With
With background
.w = SCREEN_WIDTH
.h = SCREEN_HEIGHT
End With
err = SDL_Init(SDL_INIT_VIDEO)
If err <> 0 Then Error.Raise("Imposible inicializar la libreria 'SDL': " & SDL_GetError())
scr = SDL_CreateWindow("SDL2 Ping-Pong", 50, 50, SCREEN_WIDTH, SCREEN_HEIGHT, SDL_WINDOW_SHOWN)
If scr = 0 Then Error.Raise("Imposibile configurar la modalidad video: " & SDL_GetError())
rend = SDL_CreateRenderer(scr, 0, SDL_RENDERER_ACCELERATED)
If rend = 0 Then Error.Raise("Functio 'SDL_CreateRenderer' errorem fecit: " & SDL_GetError())
SDL_SetRenderDrawColor(rend, 0, 0, 0, 255)
SDL_RenderClear(rend)
update_scores(scr, user_score, cpu_score)
reset_ball()
ev = Alloc(56)
' Kyklos:
While True
If SDL_PollEvent(ev) = 1 Then
Select Case Int@(ev)
Case SDL_KEYDOWN
Select Case Int@(ev + 16)
Case SDLK_q
Chiude(scr, rend, ev)
Case SDLK_UP
If user_moving = 0 Then
user_moving = MOVING_UP
Else If user_moving = MOVING_DOWN
user_moving = MOVING_DOWN_INT
Endif
Case SDLK_DOWN
If (user_moving = 0) Then
user_moving = MOVING_DOWN
Else If user_moving = MOVING_UP
user_moving = MOVING_UP_INT
Endif
End Select
Case SDL_KEYUP
Select Case Int@(ev + 16)
Case SDLK_UP
If user_moving = MOVING_UP_INT Then
user_moving = MOVING_DOWN
Else
user_moving = 0
user_acceleration = 0
Endif
Case SDLK_DOWN
If (user_moving = MOVING_DOWN_INT)
user_moving = MOVING_UP
Else
user_moving = 0
user_acceleration = 0
Endif
End Select
End Select
Endif
If (user_moving = MOVING_UP) Or (user_moving = MOVING_UP_INT) Then
Dec utente.y
Inc user_acceleration
utente.y -= user_acceleration
If utente.y < 0 Then utente.y = 0
Else If (user_moving = MOVING_DOWN) Or (user_moving = MOVING_DOWN_INT)
Inc utente.y
Inc user_acceleration
utente.y += user_acceleration
If utente.y > SCREEN_HEIGHT - PLAYER_HEIGHT Then utente.y = SCREEN_HEIGHT - PLAYER_HEIGHT
Endif
If (cpu.y + (PLAYER_HEIGHT / 2)) > (ball.y + (BALL_SIZE / 2)) Then
If cpu_moving = MOVING_DOWN Then
cpu_acceleration -= cpu_accel_factor
cpu_moving = MOVING_DOWN
Else
cpu_acceleration += cpu_accel_factor
cpu_moving = MOVING_UP
Endif
cpu.y += cpu_acceleration
Else
If cpu_moving = MOVING_UP Then
cpu_acceleration -= cpu_accel_factor
cpu_moving = MOVING_UP
Else
cpu_acceleration += cpu_accel_factor
cpu_moving = MOVING_DOWN
Endif
cpu.y += cpu_acceleration
Endif
If cpu.y > (SCREEN_HEIGHT - PLAYER_HEIGHT) Then
cpu.y = SCREEN_HEIGHT - PLAYER_HEIGHT
cpu_acceleration = 0
Else If cpu.y < 0
cpu.y = 0
cpu_acceleration = 0
Endif
ball.x += ball_vector_x * ball_speed
If ball.x > (SCREEN_WIDTH - BALL_SIZE) Then
ball.x = SCREEN_WIDTH - BALL_SIZE
Else If ball.x < 0
ball.x = 0
Endif
ball.y += ball_vector_y * ball_speed
If ball.y > (SCREEN_HEIGHT - BALL_SIZE) Then
ball.y = SCREEN_HEIGHT - BALL_SIZE
Else If (ball.y < 0)
ball.y = 0
Endif
If ball.y = (SCREEN_HEIGHT - BALL_SIZE) Then
ball_vector_y = - ball_vector_y
Inc ball_speed
Endif
If ball.y = 0 Then
ball_vector_y = - ball_vector_y
Inc ball_speed
Endif
If ball.x = (SCREEN_WIDTH - BALL_SIZE) Then
If ((ball.y + BALL_SIZE) >= cpu.y) And (ball.y <= (cpu.y + PLAYER_HEIGHT)) Then
ball_vector_x = - ball_vector_x
Inc ball_speed
ball.x = SCREEN_WIDTH - BALL_SIZE - PLAYER_WIDTH - 1
Else
Inc user_score
update_scores(scr, user_score, cpu_score)
reset_ball()
Endif
Endif
If ball.x = 0 Then
If ((ball.y + BALL_SIZE) >= utente.y) And (ball.y <= (utente.y + PLAYER_HEIGHT)) Then
ball_vector_x = - ball_vector_x
If ((user_moving = MOVING_DOWN) Or (user_moving = MOVING_DOWN_INT)) And (ball_vector_y < 0) Then
ball_vector_y = - ball_vector_y
Endif
If ((user_moving = MOVING_UP) Or (user_moving = MOVING_UP_INT)) And ball_vector_y > 0 Then
ball_vector_y = - ball_vector_y
Endif
Inc ball_speed
ball.x = PLAYER_WIDTH + 1
Else
Inc cpu_score
update_scores(scr, user_score, cpu_score)
reset_ball()
Endif
Endif
If (ball.x >= (SCREEN_WIDTH - BALL_SIZE - PLAYER_WIDTH)) And (ball.x < (SCREEN_WIDTH - BALL_SIZE)) Then
If ((ball.y + BALL_SIZE) >= cpu.y) And (ball.y <= (cpu.y + PLAYER_HEIGHT)) Then
ball_vector_x = - ball_vector_x
Inc ball_speed
ball.x = SCREEN_WIDTH - BALL_SIZE - PLAYER_WIDTH
Endif
Endif
If (ball.x <= PLAYER_WIDTH) And (ball.x > 0) Then
If ((ball.y + BALL_SIZE) >= utente.y) And (ball.y <= (utente.y + PLAYER_HEIGHT)) Then
ball_vector_x = - ball_vector_x
If ((user_moving = MOVING_DOWN) Or (user_moving = MOVING_DOWN_INT)) And (ball_vector_y < 0) Then ball_vector_y = - ball_vector_y
If ((user_moving = MOVING_UP) Or (user_moving = MOVING_UP_INT)) And (ball_vector_y > 0) Then ball_vector_y = - ball_vector_y
Inc ball_speed
ball.x = PLAYER_WIDTH
Endif
Endif
SDL_SetRenderDrawColor(rend, 0, 0, 0, 255)
SDL_RenderDrawRect(rend, background)
SDL_RenderFillRect(rend, background)
SDL_SetRenderDrawColor(rend, 255, 255, 0, 255)
SDL_RenderDrawRect(rend, utente)
SDL_RenderFillRect(rend, utente)
SDL_SetRenderDrawColor(rend, 0, 255, 255, 255)
SDL_RenderDrawRect(rend, cpu)
SDL_RenderFillRect(rend, cpu)
SDL_SetRenderDrawColor(rend, 255, 255, 255, 255)
SDL_RenderDrawRect(rend, ball)
SDL_RenderFillRect(rend, ball)
SDL_RenderPresent(rend)
SDL_Delay(GAME_SPEED)
SDL_SetRenderDrawColor(rend, 0, 0, 0, 255)
SDL_RenderDrawRect(rend, utente)
SDL_RenderFillRect(rend, utente)
SDL_SetRenderDrawColor(rend, 0, 0, 0, 255)
SDL_RenderDrawRect(rend, cpu)
SDL_RenderFillRect(rend, cpu)
SDL_SetRenderDrawColor(rend, 0, 0, 0, 255)
SDL_RenderFillRect(rend, ball)
SDL_RenderPresent(rend)
Wend
End
Private Procedure update_scores(win As Pointer, n1 As Integer, n2 As Integer)
Dim titolo As String
If n1 > 9999 Then n1 = 9999
If n2 > 9999 Then n2 = 9999
titolo = "SDL2 Ping-Pong " & CStr(n1) & ":" & CStr(n2)
SDL_SetWindowTitle(win, titolo)
End
Private Procedure reset_ball()
With ball
.x = (SCREEN_WIDTH / 2) - (BALL_SIZE / 2)
.y = (SCREEN_HEIGHT / 2) - (BALL_SIZE / 2)
.w = BALL_SIZE
.h = BALL_SIZE
End With
ball_vector_x = CSingle(0.2 * (Rand(0, RAND_MAX) Mod 5 + 1))
ball_vector_y = CSingle(0.2 * (Rand(0, RAND_MAX) Mod 5 + 1))
ball_vector_x = IIf(Rand(0, RAND_MAX) Mod 2, ball_vector_x, - ball_vector_x)
ball_vector_y = IIf(Rand(0, RAND_MAX) Mod 2, ball_vector_y, - ball_vector_y)
ball_speed = 5
End
Private Procedure Chiude(sc As Pointer, rn As Pointer, evn As Pointer)
Free(evn)
SDL_DestroyRenderer(rn)
SDL_DestroyWindow(sc)
SDL_Quit()
Quit
End