Quitting with ESC key
angelog0 opened this issue · 18 comments
I tried to write a function to quit an SDL2 Fortran app with ESC key beside the usual quitting,
function quit() result(r)
use sdl2_consts, only: SDL_QUIT_TYPE, SDL_KEY_DOWN, SDL_SCANCODE_ESCAPE
use sdl2_types, only: sdl_event
use sdl2, only: sdl_poll_event
logical :: r
type(sdl_event) :: event
r = .false.
if (sdl_poll_event(event) > 0) then
select case (event%type)
case (SDL_QUIT_TYPE)
r = .true.
case (SDL_KEY_DOWN)
print *, event%key%key_sym%sym
if (event%key%key_sym%sym == SDL_SCANCODE_ESCAPE) r = .true.
end select
end if
end function quit
program main
[...]
do while (.not.quit())
[...]
! Render to window.
call sdl_render_present(renderer)
call sdl_delay(20)
end do
! Quit gracefully.
call sdl_destroy_renderer(renderer)
call sdl_destroy_window(window)
call sdl_quit()
end program
but it does not work for ESC key: the PRINT statement prints always 0 (zero) regardless of the character pressed, so quit() is .true. only when one clicks the upper right X button.
I suspect a bug here...
Just for completeness, I have attached a tar ball (test_case.tar.gz) with a test case in C and rewritten in Fortran. The C code behaves as expected printing (on exiting) the codes of keys pressed and exiting with ESC. The Fortran one prints always 0 for the codes and does not exit if not closing the window.
In comment there is the command line used for the build. The compiler is GCC 8.2.0
I wonder if a library as SDL2 can be completely interfaced in Fortran by means of ISO C BINDING. SDL2 contains C unions which seem excluded from ISO C BINDING.
In this page Interoperability of derived types, under point 4, and (here) one can read:
No Fortran type is interoperable with a C union type, struct type that contains a bit field, or struct type that contains a flexible array member.
Maybe, for confirmation, we need to ask Fortran people...
BTW, just found this discussion.
The following code lets you quit the game with the Escape key:
do while (.not. done)
rc = sdl_poll_event(event)
if (rc > 0) then
select case (event%type)
case (SDL_QUIT_TYPE)
done = .true.
case (SDL_KEY_DOWN)
keys = sdl_get_keyboard_state()
! Quit if player hits Escape:
if (keys(SDL_SCANCODE_ESCAPE) == 1) then
done = .true.
end if
end select
end if
end do
Yes, the Fortran standard does not define any unions. But you can use transfer() to do simple type casting. See sdl_transfer_event() in sdl2.f90.
@interkosmos wrote:
But you can use transfer() to do simple type casting. See sdl_transfer_event()
Hmm... if sdl_poll_event already calls sdl_transfer_event(),
select case (event%type)
! SDL_KeyboardEvent
case (SDL_KEY_DOWN : SDL_KEY_UP)
event%key = transfer(event, event%key)
WHY then
write(*,'(A,i0)') 'KEY = ', event%key%key_sym%sym
prints always 0?
I tried also
event%key%key_sym%sym = transfer(event, event%key%key_sym%sym)
write(*,'(A,i0)') 'KEY = ', event%key%key_sym%sym
if (event%key%key_sym%sym == ESC) quit = 1
but does not work, prints always 768..
@interkosmos wrote:
The following code lets you quit the game with the Escape key:
keys = sdl_get_keyboard_state()
Who is keys? How it is/must be declared?
Just for completeness, compiling with the -Wall option your code, prints these warnings:
gfortran -Wall -std=f2008 `sdl2-config --cflags` ../f03sdl2-master/sdl2.f90 draw_test.f90 -o draw_test `sdl2-config --libs`
../f03sdl2-master/sdl2.f90:1469:47:
function sdl_get_render_target(renderer) bind(c, name='SDL_GetRenderTarget')
1
Warning: Unused dummy argument 'renderer' at (1) [-Wunused-dummy-argument]
../f03sdl2-master/sdl2.f90:1469:8:
function sdl_get_render_target(renderer) bind(c, name='SDL_GetRenderTarget')
1
Warning: Return value of function 'sdl_get_render_target' at (1) not set [-Wreturn-type]
draw_test.f90:181:18:
keys = sdl_get_keyboard_state()
1
Warning: POINTER-valued function appears on right-hand side of assignment at (1) [-Wsurprising]
I think sdl_get_render_target should go in the interface section not in contains section of the module:
$ diff -Naur programming/f03sdl2-master/sdl2.f90~ programming/f03sdl2-master/sdl2.f90
--- programming/f03sdl2-master/sdl2.f90~ 2018-09-08 16:19:29.000000000 +0200
+++ programming/f03sdl2-master/sdl2.f90 2018-09-10 01:57:51.391318300 +0200
@@ -977,6 +977,14 @@
integer(kind=c_int) :: sdl_get_system_ram
end function sdl_get_system_ram
+ ! SDL_Texture *SDL_GetRenderTarget(SDL_Renderer *renderer)
+ function sdl_get_render_target(renderer) bind(c, name='SDL_GetRenderTarget')
+ use, intrinsic :: iso_c_binding
+ implicit none
+ type(c_ptr), intent(in), value :: renderer
+ type(c_ptr) :: sdl_get_render_target
+ end function sdl_get_render_target
+
! Uint32 SDL_GetTicks(void)
function sdl_get_ticks() bind(c, name='SDL_GetTicks')
use, intrinsic :: iso_c_binding
@@ -1465,14 +1473,6 @@
call c_f_pointer(surface%format, sdl_get_pixel_format)
end function
- ! SDL_Texture *SDL_GetRenderTarget(SDL_Renderer *renderer)
- function sdl_get_render_target(renderer) bind(c, name='SDL_GetRenderTarget')
- use, intrinsic :: iso_c_binding
- implicit none
- type(c_ptr), intent(in), value :: renderer
- type(c_ptr) :: sdl_get_render_target
- end function sdl_get_render_target
-
! SDL_Surface *SDL_GetWindowSurface(SDL_Window *window)
function sdl_get_window_surface(window)
!! Calls `sdl_get_window_surface_()` and converts the returned
OK, I think the code you propose for quitting should be
integer(C_INT8_T), pointer :: keys(:) => null()
[...]
do while (.not. done)
rc = sdl_poll_event(event)
if (rc > 0) then
select case (event%type)
case (SDL_QUIT_TYPE)
done = .true.
case (SDL_KEY_DOWN)
keys => sdl_get_keyboard_state() ! SEE HERE
! Quit if player hits Escape:
if (keys(SDL_SCANCODE_ESCAPE) == 1) then
done = .true.
end if
end select
end if
end do
Notice,
keys => sdl_get_keyboard_state()
an association not an assignement:
keys = sdl_get_keyboard_state()
This change suppress also the warning:
POINTER-valued function appears on right-hand side of assignment
Sorry for the incomplete example. The complete one:
integer(kind=8), allocatable :: keys(:)
integer :: rc
do while (.not. is_done)
rc = sdl_poll_event(event)
if (rc > 0) then
select case (event%type)
case (SDL_QUIT_TYPE)
is_done = .true.
case (SDL_KEY_DOWN)
keys = sdl_get_keyboard_state()
! Quit if player hits Escape:
if (is_key(keys, SDL_SCANCODE_ESCAPE)) &
is_done = .true.
end select
end if
end do
The issue with sdl_get_render_target() was solved already, but not commited. Thank you anyway.
I’m still looking for the reason why event%key%key_sym%sym doesn’t contain the corrent value.
@interkosmos, last you code still gives warnings when compiled with -Wall flag:
gfortran -Wall -std=f2008 `sdl2-config --cflags` ../f03sdl2-master/sdl2.f90 draw_test.f90 -o draw_test `sdl2-config --libs`
draw_test.f90:182:18:
keys = sdl_get_keyboard_state()
1
Warning: POINTER-valued function appears on right-hand side of assignment at (1) [-Wsurprising]
draw_test.f90:182:0:
keys = sdl_get_keyboard_state()
Warning: 'keys.offset' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0: Warning: 'keys.dim[0].lbound' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0: Warning: 'keys.dim[0].ubound' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0:
keys = sdl_get_keyboard_state()
Warning: 'keys.dim[0].lbound' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0: Warning: 'keys.dim[0].ubound' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0: Warning: 'keys.dim[0].ubound' may be used uninitialized in this function [-Wmaybe-uninitialized]
draw_test.f90:182:0: Warning: 'keys.dim[0].lbound' may be used uninitialized in this function [-Wmaybe-uninitialized]
Maybe I am wrong, but I think my proposal
integer(C_INT8_T), pointer :: keys(:) => null()
[...]
keys => sdl_get_keyboard_state()
is the right... (See this at section 11.9)
Any way, may you elaborate about this
OOps, just seen your answer, thanks.
Yes, I go d’accord with you. Your proposal seems to be better. See #4 (comment), I’m still clueless.
After last change I had to change this code:
integer(C_INT8_T), pointer :: keys(:) => null()
[...]
keys => sdl_get_keyboard_state()
in
integer(C_UINT8_T), pointer :: keys(:) => null()
[...]
! the same
keys => sdl_get_keyboard_state()
The new code build without warnings but does not work, typing ESC does not exit the program.
Are you sure that in `sdl2_aliases' (why another module and not using the existing sdl2_consts?)
integer, parameter :: c_uint8_t = c_int16_t
is the right thing?
If I remember rightly, Fortran for uint.. types wants int.. types of the same size (int8_t) in this case... but this would break other things, so I think you have to review this carefully...
In other words, uint8_t in C is 1 byte while int16_t is 2 byte.
Just this
integer, parameter :: c_uint8_t = c_int8_t
fixes the issue, and maybe also event%key%key_sym%sym !!!
Thank you very much for all the hints. They have been committed.
Sorry but there are still some issue. From the SDL2 Wiki:
int SDL_SetRenderDrawColor(SDL_Renderer* renderer,
Uint8 r,
Uint8 g,
Uint8 b,
Uint8 a)
but now I find in your code:
! int SDL_SetRenderDrawColor(SDL_Renderer *renderer, Uint8 r, Uint8 g, Uint8 b, Uint8 a)
function sdl_set_render_draw_color_(renderer, r, g, b, a) bind(c, name='SDL_SetRenderDrawColor')
use, intrinsic :: iso_c_binding
use :: sdl2_consts
implicit none
type(c_ptr), intent(in), value :: renderer
integer(kind=c_uint16_t), intent(in), value :: r
integer(kind=c_uint16_t), intent(in), value :: g
integer(kind=c_uint16_t), intent(in), value :: b
integer(kind=c_uint16_t), intent(in), value :: a
integer(kind=c_int) :: sdl_set_render_draw_color_
end function sdl_set_render_draw_color_
[...]
! int SDL_SetRenderDrawColor(SDL_Renderer *renderer, Uint8 r, Uint8 g, Uint8 b, Uint8 a)
function sdl_set_render_draw_color(renderer, r, g, b, a)
!! Converts integer arguments to c_uint32_t before calling
!! `sdl_set_render_draw_color_()`.
use, intrinsic :: iso_c_binding, only: c_ptr
use :: sdl2_consts
implicit none
type(c_ptr), intent(in) :: renderer
integer, intent(in) :: r
integer, intent(in) :: g
integer, intent(in) :: b
integer, intent(in) :: a
integer :: sdl_set_render_draw_color
sdl_set_render_draw_color = sdl_set_render_draw_color_(renderer, &
int(r, kind=c_uint16_t), &
int(g, kind=c_uint16_t), &
int(b, kind=c_uint16_t), &
int(a, kind=c_uint16_t))
end function sdl_set_render_draw_color
which causes
rc = sdl_set_render_draw_color(renderer,int(r,1),int(g,1),int(b,1), &
1
Error: Type mismatch in argument 'r' at (1); passed INTEGER(1) to INTEGER(4)
If I remember, the previous implementation didn't use the wrapper and maybe it was better. I think the best should be not to use the wrapper
! int SDL_SetRenderDrawColor(SDL_Renderer *renderer, Uint8 r, Uint8 g, Uint8 b, Uint8 a)
function sdl_set_render_draw_color(renderer, r, g, b, a) bind(c, name='SDL_SetRenderDrawColor')
use, intrinsic :: iso_c_binding
use :: sdl2_consts
implicit none
type(c_ptr), intent(in), value :: renderer
integer(kind=c_uint8_t), intent(in), value :: r
integer(kind=c_uint8_t), intent(in), value :: g
integer(kind=c_uint8_t), intent(in), value :: b
integer(kind=c_uint8_t), intent(in), value :: a
integer(kind=c_int) :: sdl_set_render_draw_color
end function sdl_set_render_draw_color
I understand you intent (avoid the explicit conversion by the user), but sometime it would be better to reduce the cost to call a function to call a function...
But how do you want to store an integer like 255 in c_int8_t? That will cause an arithmetic overflow.
Without a wrapper function, the programmer always has to do the type conversion manually. Boy, that would be annoying.
@interkosmos wrote:
But how do you want to store an integer like 255 in c_int8_t?
Have you tried? Why it worked in your previous implementation? In my test case I have color defined with (255,0,127), (255,255,255), (0,255,255)... and all colors where right..
BTW, I interfaced (most) Windows itself this way without issue.. I think it is how ISO C BINDING works. Maybe we have to ask Fortran people...
Without a wrapper function, the programmer always has to do the type conversion manually. Boy, that would be annoying.
No No.. It is not annoying if you can save the cost of calling function, subroutine... Instead that code not only has the cost of conversion (int(..,kind=...)) but also one more function call. Any way do at your best.
And... hem hem with last your commit there is this failure:
gfortran -std=f2008 -Wall `sdl2-config --cflags` -o music examples/music/music.f90 sdl2.o sdl2_mixer.o sdl2_ttf.o `sdl2-config --libs` -lSDL2_mixer -lSDL2_ttf
examples/music/music.f90:62:9:
rc = mix_open_audio(MIX_DEFAULT_FREQUENCY, &
1
Error: Type mismatch in argument 'format' at (1); passed INTEGER(4) to INTEGER(2)
make: *** [Makefile:70: music] Error 1
Please see the following example:
program example
use, intrinsic :: iso_c_binding
implicit none
integer(kind=c_int8_t) :: foo = int(127, 1) ! works
integer(kind=c_int8_t) :: bar = int(255, 1) ! doesn't work
print *, foo, bar
end program example
IMHO the correct type is therefore c_uint16_t.
Also this work (a solution adopted in 2006 interfacing for the first time BGI aka WinBGIm v. 3):
$ cat print_uint8_t.c
#include <stdio.h>
#include <stdint.h>
void print_uint8_t(uint8_t u)
{
printf("%u\n",u);
}
$ cat test_c_uint8_t.f90
!
! gcc -c print_uint8_t.c
! gfortran -std=f2008 test_c_uint8_t.f90 -o test_c_uint8_t.out print_uint8_t.o
! ./getch_test.out
!
program test_c_uint8_t
implicit none
interface
subroutine print_u8(u) bind(c, name='print_uint8_t')
use, intrinsic :: iso_c_binding, only: C_CHAR
character(C_CHAR), intent(in), value :: u
end subroutine print_u8
end interface
call print_u8(achar(127))
call print_u8(achar(0))
call print_u8(achar(255))
end program test_c_uint8_t
What I don't like is that c_int16_t is 2 byte while in the original C routine the data passed is 1 byte... The C routine takes only the firs byte of it, but I wonder if this is the main street to adopt for this kind of data. I have asked to Fortran people.
Anyway now your example builds fine.. thanks.
The first assignment in this chapter is easy: create a program with a main function and a separate subfunction called hello, which when called prints "Hello there!". The subfunction does not take any parameters or return any value, just prints the line. Then, to the main function, add a call to the subfunction and two print commands, the first one before the call which says "Lets call the subfunction:", and one after the subfunction call, a print command which prints "Quitting.". If implemented correctly, the program will print the following: