File ocaml-tsdl.patch of Package ocaml-tsdl
---
config/discover.ml | 21
config/dune | 3
dune-project | 33
src/async_function_description.ml | 23
src/dune | 47
src/function_description.ml | 1571 +++++++++++
src/top/dune | 4
src/tsdl.ml | 5276 ++++++++++----------------------------
src/tsdl.mli | 20
src/type_description.ml | 1800 ++++++++++++
10 files changed, 5041 insertions(+), 3757 deletions(-)
--- /dev/null
+++ b/config/discover.ml
@@ -0,0 +1,21 @@
+module C = Configurator.V1
+
+let () =
+C.main ~name:"tsdl" (fun c ->
+let default : C.Pkg_config.package_conf =
+ { libs = ["-lsdl2"]
+ ; cflags = []
+ }
+in
+let conf =
+ match C.Pkg_config.get c with
+ | None -> default
+ | Some pc ->
+ match (C.Pkg_config.query pc ~package:"sdl2") with
+ | None -> default
+ | Some deps -> deps
+in
+
+
+C.Flags.write_sexp "c_flags.sexp" conf.cflags;
+C.Flags.write_sexp "c_library_flags.sexp" conf.libs)
--- /dev/null
+++ b/config/dune
@@ -0,0 +1,3 @@
+(executable
+ (name discover)
+ (libraries dune-configurator))
--- /dev/null
+++ b/dune-project
@@ -0,0 +1,33 @@
+(lang dune 3.15)
+(using ctypes 0.3)
+
+(license ISC)
+(authors "The tsdl programmers")
+(maintainers "Daniel Bünzli <daniel.buenzl i@erratique.ch>")
+(source (uri "git+https://erratique.ch/repos/tsdl.git"))
+(homepage "https://erratique.ch/software/tsdl")
+(bug_reports "https://github.com/dbuenzli/tsdl/issues")
+
+(package
+ (name tsdl)
+ (synopsis "Thin bindings to SDL for OCaml")
+ (description
+ "\| Tsdl is an OCaml library providing thin bindings to the cross-platform
+ "\| [SDL library].
+ "\|
+ "\| Tsdl depends on the C library SDL 2.0.18 (or later),
+ "\| [ocaml-ctypes][ctypes]. Tsdl is distributed under the ISC license.
+ "\|
+ "\| [SDL library]: https://www.libsdl.org/
+ "\| [ctypes]: https://github.com/ocamllabs/ocaml-ctypes
+ )
+ (documentation "https://erratique.ch/software/tsdl/doc/")
+ (tags ("audio" "bindings" "graphics" "media" "opengl" "input" "hci"
+ "org:erratique"))
+ (depends
+ (ocaml (>= 4.08.0))
+ conf-sdl2
+ (ctypes (>= 0.21.1))
+ (ctypes-foreign (>= 0.21.1))))
+
+(generate_opam_files)
--- /dev/null
+++ b/src/async_function_description.ml
@@ -0,0 +1,23 @@
+open Ctypes
+
+module Types = Types_generated
+
+module Functions (F : FOREIGN) = struct
+ let delay =
+ F.(foreign "SDL_Delay" (int32_t @-> returning void))
+
+ let render_present =
+ F.(foreign "SDL_RenderPresent" (ptr Types.Renderer.t @-> returning void))
+
+ let wait_event =
+ F.(foreign "SDL_WaitEvent" (ptr Types.Event.t @-> returning int))
+
+ let wait_event_timeout =
+ F.(foreign "SDL_WaitEventTimeout"
+ (ptr Types.Event.t @-> int @-> returning bool))
+
+ let load_wav_rw =
+ F.(foreign "SDL_LoadWAV_RW"
+ (Types.rw_ops @-> int @-> ptr Types.audio_spec @-> ptr (ptr uint8_t) @->
+ ptr uint32_t @-> returning (ptr_opt Types.audio_spec)))
+end
--- /dev/null
+++ b/src/dune
@@ -0,0 +1,47 @@
+(rule
+ (targets c_flags.sexp c_library_flags.sexp)
+ (action
+ (run ../config/discover.exe)))
+
+(library
+ (name tsdl)
+ (public_name tsdl)
+ (modules
+ (:standard \ Tsdl_top_init))
+ (c_library_flags
+ (:include c_library_flags.sexp))
+ (libraries ctypes-foreign)
+ (flags
+ (:standard -w -9-27))
+ (foreign_stubs
+ (language c)
+ (names tsdl_stubs)
+ (flags
+ (:include c_flags.sexp)))
+ (ctypes
+ (external_library_name sdl2)
+ (headers
+ (preamble
+ "#define SDL_MAIN_HANDLED 1
+ #include \"SDL.h\"
+ #define CAML_NAME_SPACE
+ #include \"SDL_vulkan.h\"
+ #undef main"))
+ (build_flags_resolver pkg_config)
+ (type_description
+ (instance Types)
+ (functor Type_description))
+ (function_description
+ (instance Functions)
+ (functor Function_description))
+ (function_description
+ (instance Async_functions)
+ (concurrency unlocked)
+ (functor Async_function_description))
+ (generated_entry_point C)))
+
+(install
+ (section lib)
+ (package tsdl)
+ (files
+ (tsdl_top_init.ml as top/tsdl_top_init.ml)))
--- /dev/null
+++ b/src/function_description.ml
@@ -0,0 +1,1571 @@
+open Ctypes
+
+module Types = Types_generated
+
+let const_string_opt =
+ Ctypes_std_views.nullable_view string Ctypes_static.(const char)
+
+module Functions (F : FOREIGN) = struct
+ let get_error =
+ F.(foreign "SDL_GetError" (void @-> returning string))
+ let sdl_free = F.(foreign "SDL_free" (ptr void @-> returning void))
+ let set_main_ready = F.(foreign "SDL_SetMainReady" (void @-> returning void))
+ let init =
+ F.(foreign "SDL_Init" (uint32_t @-> returning int))
+ let init_sub_system =
+ F.(foreign "SDL_InitSubSystem" (uint32_t @-> returning int))
+ let was_init =
+ F.(foreign "SDL_WasInit" (uint32_t @-> returning uint32_t))
+ let quit =
+ F.(foreign "SDL_Quit" (void @-> returning void))
+ let quit_sub_system =
+ F.(foreign "SDL_QuitSubSystem" (uint32_t @-> returning void))
+
+ module Hint = struct
+ let framebuffer_acceleration =
+ F.foreign_value "SDL_HINT_FRAMEBUFFER_ACCELERATION" (array 29 char)
+ let idle_timer_disabled =
+ F.foreign_value "SDL_HINT_IDLE_TIMER_DISABLED" (array 28 char)
+ let mouse_focus_clickthrough =
+ F.foreign_value "SDL_HINT_MOUSE_FOCUS_CLICKTHROUGH" (array 29 char)
+ let orientations =
+ F.foreign_value "SDL_HINT_ORIENTATIONS" (array 21 char)
+ let render_driver =
+ F.foreign_value "SDL_HINT_RENDER_DRIVER" (array 18 char)
+ let render_opengl_shaders =
+ F.foreign_value "SDL_HINT_RENDER_OPENGL_SHADERS" (array 26 char)
+ let render_logical_size_mode =
+ F.foreign_value "SDL_HINT_RENDER_LOGICAL_SIZE_MODE" (array 29 char)
+ let render_scale_quality =
+ F.foreign_value "SDL_HINT_RENDER_SCALE_QUALITY" (array 25 char)
+ let render_vsync =
+ F.foreign_value "SDL_HINT_RENDER_VSYNC" (array 17 char)
+
+ let no_signal_handlers =
+ F.foreign_value "SDL_HINT_NO_SIGNAL_HANDLERS" (array 23 char)
+ let thread_stack_size =
+ F.foreign_value "SDL_HINT_THREAD_STACK_SIZE" (array 22 char)
+ let window_frame_usable_while_cursor_hidden =
+ F.foreign_value
+ "SDL_HINT_WINDOW_FRAME_USABLE_WHILE_CURSOR_HIDDEN" (array 44 char)
+
+ let audio_resampling_mode =
+ F.foreign_value "SDL_HINT_AUDIO_RESAMPLING_MODE" (array 26 char)
+ let mouse_normal_speed_scale =
+ F.foreign_value "SDL_HINT_MOUSE_NORMAL_SPEED_SCALE" (array 29 char)
+ let mouse_relative_speed_scale =
+ F.foreign_value "SDL_HINT_MOUSE_RELATIVE_SPEED_SCALE" (array 31 char)
+ let touch_mouse_events =
+ F.foreign_value "SDL_HINT_TOUCH_MOUSE_EVENTS" (array 23 char)
+ let mouse_touch_events =
+ F.foreign_value "SDL_HINT_MOUSE_TOUCH_EVENTS" (array 23 char)
+ end
+
+ let clear_hints =
+ F.(foreign "SDL_ClearHints" (void @-> returning void))
+
+ let get_hint =
+ F.(foreign "SDL_GetHint" (string @-> returning const_string_opt))
+
+ let get_hint_boolean =
+ F.(foreign "SDL_GetHintBoolean" (string @-> bool @-> returning bool))
+
+ let set_hint =
+ F.(foreign "SDL_SetHint" (string @-> string @-> returning bool))
+
+ let set_hint_with_priority =
+ F.(foreign "SDL_SetHintWithPriority"
+ (string @-> string @-> int @-> returning bool))
+
+ (* Errors *)
+
+ let clear_error =
+ F.(foreign "SDL_ClearError" (void @-> returning void))
+
+ let set_error =
+ F.(foreign "SDL_SetError" (string @-> returning int))
+
+ (* Log *)
+
+ let log_get_priority =
+ F.(foreign "SDL_LogGetPriority" (int @-> returning int))
+
+ let log_reset_priorities =
+ F.(foreign "SDL_LogResetPriorities" (void @-> returning void))
+
+ let log_set_all_priority =
+ F.(foreign "SDL_LogSetAllPriority" (int @-> returning void))
+
+ let log_set_priority =
+ F.(foreign "SDL_LogSetPriority" (int @-> int @-> returning void))
+
+ (* Version *)
+
+ let get_version =
+ F.(foreign "SDL_GetVersion" (ptr Types.version @-> returning void))
+
+ let get_revision =
+ F.(foreign "SDL_GetRevision" (void @-> returning string))
+
+ (* IO absraction *)
+
+ let load_file_rw =
+ F.(foreign "SDL_LoadFile_RW"
+ (Types.rw_ops @-> ptr size_t @-> bool @-> returning string_opt))
+
+ let rw_close =
+ F.(foreign "SDL_RWclose" (Types.rw_ops @-> returning int))
+
+ let rw_from_file =
+ F.(foreign "SDL_RWFromFile"
+ (string @-> string @-> returning Types.rw_ops_opt))
+
+ let rw_from_const_mem =
+ F.(foreign "SDL_RWFromConstMem"
+ (ocaml_string @-> int @-> returning Types.rw_ops_opt))
+
+ let rw_from_mem =
+ F.(foreign "SDL_RWFromMem"
+ (ocaml_bytes @-> int @-> returning Types.rw_ops_opt))
+
+ (* File system paths *)
+
+ let get_base_path =
+ F.(foreign "SDL_GetBasePath" (void @-> returning (ptr char)))
+
+ let get_pref_path =
+ F.(foreign "SDL_GetPrefPath" (string @-> string @-> returning (ptr char)))
+
+ (* Rectangles *)
+
+ let enclose_points =
+ F.(foreign "SDL_EnclosePoints"
+ (ptr void @-> int @-> ptr Types.Rect.t @-> ptr Types.Rect.t @->
+ returning bool))
+
+ let has_intersection =
+ F.(foreign "SDL_HasIntersection"
+ (ptr Types.Rect.t @-> ptr Types.Rect.t @-> returning bool))
+
+ let intersect_rect =
+ F.(foreign "SDL_IntersectRect"
+ (ptr Types.Rect.t @-> ptr Types.Rect.t @-> ptr Types.Rect.t @->
+ returning bool))
+
+ let intersect_rect_and_line =
+ F.(foreign "SDL_IntersectRectAndLine"
+ (ptr Types.Rect.t @-> ptr int @-> ptr int @-> ptr int @-> ptr int @->
+ returning bool))
+
+ let point_in_rect =
+ F.(foreign "SDL_PointInRect"
+ (ptr Types.Point.t @-> ptr Types.Rect.t @-> returning bool))
+
+ let rect_empty =
+ F.(foreign "SDL_RectEmpty" (ptr Types.Rect.t @-> returning bool))
+
+ let rect_equals =
+ F.(foreign "SDL_RectEquals"
+ (ptr Types.Rect.t @-> ptr Types.Rect.t @-> returning bool))
+
+ let union_rect =
+ F.(foreign "SDL_UnionRect"
+ (ptr Types.Rect.t @-> ptr Types.Rect.t @-> ptr Types.Rect.t @->
+ returning void))
+
+ let alloc_palette =
+ F.(foreign "SDL_AllocPalette" (int @-> returning (ptr_opt Types.palette)))
+
+ let free_palette =
+ F.(foreign "SDL_FreePalette" (ptr Types.palette @-> returning void))
+
+ let set_palette_colors =
+ F.(foreign "SDL_SetPaletteColors"
+ (ptr Types.palette @-> ptr void(*Types.Color.t*) @-> int @-> int @-> returning int))
+
+ (* See https://github.com/yallop/ocaml-ctypes/issues/109 for why (*u*) *)
+ let calculate_gamma_ramp =
+ F.(foreign "SDL_CalculateGammaRamp" (float @-> ptr (*u*)int16_t @-> returning void))
+
+ let compose_custom_blend_mode =
+ F.(foreign "SDL_ComposeCustomBlendMode"
+ (int @-> int @-> int @-> int @-> int @-> int @-> returning Types.Blend.mode))
+
+ let alloc_format =
+ F.(foreign "SDL_AllocFormat"
+ (uint32_t @-> returning (ptr_opt Types.pixel_format)))
+
+ let free_format =
+ F.(foreign "SDL_FreeFormat" (ptr Types.pixel_format @-> returning void))
+
+ let get_pixel_format_name =
+ F.(foreign "SDL_GetPixelFormatName" (uint32_t @-> returning string))
+
+ let get_rgb =
+ F.(foreign "SDL_GetRGB"
+ (uint32_t @-> ptr Types.pixel_format @-> ptr uint8_t @->
+ ptr uint8_t @-> ptr uint8_t @-> returning void))
+
+ let get_rgba =
+ F.(foreign "SDL_GetRGBA"
+ (uint32_t @-> ptr Types.pixel_format @-> ptr uint8_t @->
+ ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @-> returning void))
+
+ let map_rgb =
+ F.(foreign "SDL_MapRGB"
+ (ptr Types.pixel_format @-> uint8_t @-> uint8_t @-> uint8_t @->
+ returning uint32_t))
+
+ let map_rgba =
+ F.(foreign "SDL_MapRGBA"
+ (ptr Types.pixel_format @-> uint8_t @-> uint8_t @-> uint8_t @->
+ uint8_t @-> returning uint32_t))
+
+ let masks_to_pixel_format_enum =
+ F.(foreign "SDL_MasksToPixelFormatEnum"
+ (int @-> uint32_t @-> uint32_t @-> uint32_t @-> uint32_t @->
+ returning uint32_t))
+
+ let pixel_format_enum_to_masks =
+ F.(foreign "SDL_PixelFormatEnumToMasks"
+ (uint32_t @-> ptr int @->
+ ptr uint32_t @-> ptr uint32_t @-> ptr uint32_t @-> ptr uint32_t @->
+ returning bool))
+
+ let set_pixel_format_palette =
+ F.(foreign "SDL_SetPixelFormatPalette"
+ (ptr Types.pixel_format @-> ptr Types.palette @-> returning int))
+
+ let blit_scaled =
+ (* SDL_BlitScaled is #ifdef'd to SDL_UpperBlitScaled *)
+ F.(foreign "SDL_UpperBlitScaled"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> ptr Types.surface @->
+ ptr Types.Rect.t @-> returning int))
+
+ let blit_surface =
+ (* SDL_BlitSurface is #ifdef'd to SDL_UpperBlit *)
+ F.(foreign "SDL_UpperBlit"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> ptr Types.surface @->
+ ptr Types.Rect.t @-> returning int))
+
+ let convert_pixels =
+ F.(foreign "SDL_ConvertPixels"
+ (int @-> int @-> uint32_t @-> ptr void @-> int @-> uint32_t @->
+ ptr void @-> int @-> returning int))
+
+ let convert_surface =
+ F.(foreign "SDL_ConvertSurface"
+ (ptr Types.surface @-> ptr Types.pixel_format @-> uint32_t @->
+ returning (ptr_opt Types.surface)))
+
+ let convert_surface_format =
+ F.(foreign "SDL_ConvertSurfaceFormat"
+ (ptr Types.surface @-> uint32_t @-> uint32_t @->
+ returning (ptr_opt Types.surface)))
+
+ let create_rgb_surface =
+ F.(foreign "SDL_CreateRGBSurface"
+ (uint32_t @-> int @-> int @-> int @-> uint32_t @-> uint32_t @->
+ uint32_t @-> uint32_t @-> returning (ptr_opt Types.surface)))
+
+ let create_rgb_surface_from =
+ F.(foreign "SDL_CreateRGBSurfaceFrom"
+ (ptr void @-> int @-> int @-> int @-> int @-> uint32_t @->
+ uint32_t @-> uint32_t @-> uint32_t @->
+ returning (ptr_opt Types.surface)))
+
+ let create_rgb_surface_with_format =
+ F.(foreign "SDL_CreateRGBSurfaceWithFormat"
+ (uint32_t @-> int @-> int @-> int @-> uint32_t @->
+ returning (ptr_opt Types.surface)))
+
+ let create_rgb_surface_with_format_from =
+ F.(foreign "SDL_CreateRGBSurfaceWithFormatFrom"
+ (ptr void @-> int @-> int @-> int @-> int @-> uint32_t @->
+ returning (ptr_opt Types.surface)))
+
+ let duplicate_surface =
+ F.(foreign "SDL_DuplicateSurface"
+ (ptr Types.surface @-> returning (ptr Types.surface)))
+
+ let fill_rect =
+ F.(foreign "SDL_FillRect"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> uint32_t @->
+ returning int))
+
+ let fill_rects =
+ F.(foreign "SDL_FillRects"
+ (ptr Types.surface @-> ptr void (* Types.Rect.t *) @-> int @->
+ uint32_t @-> returning int))
+
+ let free_surface =
+ F.(foreign "SDL_FreeSurface" (ptr Types.surface @-> returning void))
+
+ let get_clip_rect =
+ F.(foreign "SDL_GetClipRect"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> returning void))
+
+ let get_color_key =
+ F.(foreign "SDL_GetColorKey"
+ (ptr Types.surface @-> ptr uint32_t @-> returning int))
+
+ let get_surface_alpha_mod =
+ F.(foreign "SDL_GetSurfaceAlphaMod"
+ (ptr Types.surface @-> ptr uint8_t @-> returning int))
+
+ let get_surface_blend_mode =
+ F.(foreign "SDL_GetSurfaceBlendMode"
+ (ptr Types.surface @-> ptr Types.Blend.mode @-> returning int))
+
+ let get_surface_color_mod =
+ F.(foreign "SDL_GetSurfaceColorMod"
+ (ptr Types.surface @-> ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @->
+ returning int))
+
+ let load_bmp_rw =
+ F.(foreign "SDL_LoadBMP_RW"
+ (Types.rw_ops @-> bool @-> returning (ptr_opt Types.surface)))
+
+ let lock_surface =
+ F.(foreign "SDL_LockSurface" (ptr Types.surface @-> returning int))
+
+ let lower_blit =
+ F.(foreign "SDL_LowerBlit"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> ptr Types.surface @->
+ ptr Types.Rect.t @-> returning int))
+
+ let lower_blit_scaled =
+ F.(foreign "SDL_LowerBlitScaled"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> ptr Types.surface @->
+ ptr Types.Rect.t @-> returning int))
+
+ let save_bmp_rw =
+ F.(foreign "SDL_SaveBMP_RW"
+ (ptr Types.surface @-> Types.rw_ops @-> bool @-> returning int))
+
+ let set_clip_rect =
+ F.(foreign "SDL_SetClipRect"
+ (ptr Types.surface @-> ptr Types.Rect.t @-> returning bool))
+
+ let set_color_key =
+ F.(foreign "SDL_SetColorKey"
+ (ptr Types.surface @-> bool @-> uint32_t @-> returning int))
+
+ let set_surface_alpha_mod =
+ F.(foreign "SDL_SetSurfaceAlphaMod"
+ (ptr Types.surface @-> uint8_t @-> returning int))
+
+ let set_surface_blend_mode =
+ F.(foreign "SDL_SetSurfaceBlendMode"
+ (ptr Types.surface @-> Types.Blend.mode @-> returning int))
+
+ let set_surface_color_mod =
+ F.(foreign "SDL_SetSurfaceColorMod"
+ (ptr Types.surface @-> uint8_t @-> uint8_t @-> uint8_t @->
+ returning int))
+
+ let set_surface_palette =
+ F.(foreign "SDL_SetSurfacePalette"
+ (ptr Types.surface @-> ptr Types.palette @-> returning int))
+
+ let set_surface_rle =
+ F.(foreign "SDL_SetSurfaceRLE"
+ (ptr Types.surface @-> bool @-> returning int))
+
+ let unlock_surface =
+ F.(foreign "SDL_UnlockSurface" (ptr Types.surface @-> returning void))
+
+ let create_renderer =
+ F.(foreign "SDL_CreateRenderer"
+ (Types.Window.t @-> int @-> uint32_t @->
+ returning (ptr_opt Types.Renderer.t)))
+
+ let create_software_renderer =
+ F.(foreign "SDL_CreateSoftwareRenderer"
+ (ptr Types.surface @-> returning (ptr_opt Types.Renderer.t)))
+
+ let destroy_renderer =
+ F.(foreign "SDL_DestroyRenderer" (ptr Types.Renderer.t @-> returning void))
+
+ let get_num_render_drivers =
+ F.(foreign "SDL_GetNumRenderDrivers" (void @-> returning int))
+
+ let get_render_draw_blend_mode =
+ F.(foreign "SDL_GetRenderDrawBlendMode"
+ (ptr Types.Renderer.t @-> ptr Types.Blend.mode @-> returning int))
+
+ let get_render_draw_color =
+ F.(foreign "SDL_GetRenderDrawColor"
+ (ptr Types.Renderer.t @-> ptr uint8_t @-> ptr uint8_t @->
+ ptr uint8_t @-> ptr uint8_t @-> returning int))
+
+ let get_render_driver_info =
+ F.(foreign "SDL_GetRenderDriverInfo"
+ (int @-> ptr Types.renderer_info @-> returning int))
+
+ let get_render_target =
+ F.(foreign "SDL_GetRenderTarget"
+ (ptr Types.Renderer.t @-> returning (ptr_opt Types.Texture.t)))
+
+ let get_renderer =
+ F.(foreign "SDL_GetRenderer"
+ (Types.Window.t @-> returning (ptr_opt Types.Renderer.t)))
+
+ let get_renderer_info =
+ F.(foreign "SDL_GetRendererInfo"
+ (ptr Types.Renderer.t @-> ptr Types.renderer_info @-> returning int))
+
+ let get_renderer_output_size =
+ F.(foreign "SDL_GetRendererOutputSize"
+ (ptr Types.Renderer.t @-> ptr int @-> ptr int @-> returning int))
+
+ let render_clear =
+ F.(foreign "SDL_RenderClear" (ptr Types.Renderer.t @-> returning int))
+
+ let render_copy =
+ F.(foreign "SDL_RenderCopy"
+ (ptr Types.Renderer.t @-> ptr Types.Texture.t @-> ptr Types.Rect.t @->
+ ptr Types.Rect.t @-> returning int))
+
+ let render_copy_ex =
+ F.(foreign "SDL_RenderCopyEx"
+ (ptr Types.Renderer.t @-> ptr Types.Texture.t @-> ptr Types.Rect.t @->
+ ptr Types.Rect.t @-> double @-> ptr Types.Point.t @-> int @->
+ returning int))
+
+ let render_draw_line =
+ F.(foreign "SDL_RenderDrawLine"
+ (ptr Types.Renderer.t @-> int @-> int @-> int @-> int @->
+ returning int))
+
+ let render_draw_line_f =
+ F.(foreign "SDL_RenderDrawLineF"
+ (ptr Types.Renderer.t @-> float @-> float @-> float @-> float @->
+ returning int))
+
+ let render_draw_lines =
+ F.(foreign "SDL_RenderDrawLines"
+ (ptr Types.Renderer.t @-> ptr void @-> int @-> returning int))
+
+ let render_draw_point =
+ F.(foreign "SDL_RenderDrawPoint"
+ (ptr Types.Renderer.t @-> int @-> int @-> returning int))
+
+ let render_draw_points =
+ F.(foreign "SDL_RenderDrawPoints"
+ (ptr Types.Renderer.t @-> ptr void @-> int @-> returning int))
+
+ let render_draw_point_f =
+ F.(foreign "SDL_RenderDrawPointF"
+ (ptr Types.Renderer.t @-> float @-> float @-> returning int))
+
+ let render_draw_points_f =
+ F.(foreign "SDL_RenderDrawPointsF"
+ (ptr Types.Renderer.t @-> ptr void @-> int @-> returning int))
+
+ let render_draw_rect =
+ F.(foreign "SDL_RenderDrawRect"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning int))
+
+ let render_draw_rects =
+ F.(foreign "SDL_RenderDrawRects"
+ (ptr Types.Renderer.t @-> ptr void @-> int @-> returning int))
+
+ let render_fill_rect =
+ F.(foreign "SDL_RenderFillRect"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning int))
+
+ let render_fill_rects =
+ F.(foreign "SDL_RenderFillRects"
+ (ptr Types.Renderer.t @-> ptr void @-> int @-> returning int))
+
+ let render_geometry =
+ F.(foreign "SDL_RenderGeometry"
+ (ptr Types.Renderer.t @-> ptr_opt Types.Texture.t @->
+ ptr Types.Vertex.t @-> int @-> ptr_opt int @-> int @-> returning int))
+
+ let render_geometry_raw =
+ F.(foreign "SDL_RenderGeometryRaw"
+ (ptr Types.Renderer.t @-> ptr_opt Types.Texture.t @->
+ ptr float @-> int @->
+ ptr void (*Types.Color.t*) @-> int @->
+ ptr float @-> int @->
+ int @-> ptr void @-> int @-> int @-> returning int))
+
+ let render_get_clip_rect =
+ F.(foreign "SDL_RenderGetClipRect"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning void))
+
+ let render_is_clip_enabled =
+ F.(foreign "SDL_RenderIsClipEnabled"
+ (ptr Types.Renderer.t @-> returning bool))
+
+ let render_get_integer_scale =
+ F.(foreign "SDL_RenderGetIntegerScale"
+ (ptr Types.Renderer.t @-> returning bool))
+
+ let render_get_logical_size =
+ F.(foreign "SDL_RenderGetLogicalSize"
+ (ptr Types.Renderer.t @-> ptr int @-> ptr int @-> returning void))
+
+ let render_get_scale =
+ F.(foreign "SDL_RenderGetScale"
+ (ptr Types.Renderer.t @-> ptr float @-> ptr float @-> returning void))
+
+ let render_get_viewport =
+ F.(foreign "SDL_RenderGetViewport"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning void))
+
+ let render_read_pixels =
+ F.(foreign "SDL_RenderReadPixels"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> uint32_t @->
+ ptr void @-> int @-> returning int))
+
+ let render_set_clip_rect =
+ F.(foreign "SDL_RenderSetClipRect"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning int))
+
+ let render_set_integer_scale =
+ F.(foreign "SDL_RenderSetIntegerScale"
+ (ptr Types.Renderer.t @-> bool @-> returning int))
+
+ let render_set_logical_size =
+ F.(foreign "SDL_RenderSetLogicalSize"
+ (ptr Types.Renderer.t @-> int @-> int @-> returning int))
+
+ let render_set_scale =
+ F.(foreign "SDL_RenderSetScale"
+ (ptr Types.Renderer.t @-> float @-> float @-> returning int))
+
+ let render_set_viewport =
+ F.(foreign "SDL_RenderSetViewport"
+ (ptr Types.Renderer.t @-> ptr Types.Rect.t @-> returning int))
+
+ let render_target_supported =
+ F.(foreign "SDL_RenderTargetSupported"
+ (ptr Types.Renderer.t @-> returning bool))
+
+ let set_render_draw_blend_mode =
+ F.(foreign "SDL_SetRenderDrawBlendMode"
+ (ptr Types.Renderer.t @-> Types.Blend.mode @-> returning int))
+
+ let set_render_draw_color =
+ F.(foreign "SDL_SetRenderDrawColor"
+ (ptr Types.Renderer.t @-> uint8_t @-> uint8_t @-> uint8_t @->
+ uint8_t @-> returning int))
+
+ let set_render_target =
+ F.(foreign "SDL_SetRenderTarget"
+ (ptr Types.Renderer.t @-> ptr_opt Types.Texture.t @-> returning int))
+
+ let create_texture =
+ F.(foreign "SDL_CreateTexture"
+ (ptr Types.Renderer.t @-> uint32_t @-> int @-> int @-> int @->
+ returning (ptr_opt Types.Texture.t)))
+
+ let create_texture_from_surface =
+ F.(foreign "SDL_CreateTextureFromSurface"
+ (ptr Types.Renderer.t @-> ptr Types.surface @->
+ returning (ptr_opt Types.Texture.t)))
+
+ let destroy_texture =
+ F.(foreign "SDL_DestroyTexture" (ptr Types.Texture.t @-> returning void))
+
+ let get_texture_alpha_mod =
+ F.(foreign "SDL_GetTextureAlphaMod"
+ (ptr Types.Texture.t @-> ptr uint8_t @-> returning int))
+
+ let get_texture_blend_mode =
+ F.(foreign "SDL_GetTextureBlendMode"
+ (ptr Types.Texture.t @-> ptr Types.Blend.mode @-> returning int))
+
+ let get_texture_color_mod =
+ F.(foreign "SDL_GetTextureColorMod"
+ (ptr Types.Texture.t @-> ptr uint8_t @-> ptr uint8_t @->
+ ptr uint8_t @-> returning int))
+
+ let query_texture =
+ F.(foreign "SDL_QueryTexture"
+ (ptr Types.Texture.t @-> ptr uint32_t @-> ptr int @-> ptr int @->
+ ptr int @-> returning int))
+
+ let lock_texture =
+ F.(foreign "SDL_LockTexture"
+ (ptr Types.Texture.t @-> ptr Types.Rect.t @-> ptr (ptr void) @->
+ ptr int @-> returning int))
+
+ let set_texture_alpha_mod =
+ F.(foreign "SDL_SetTextureAlphaMod"
+ (ptr Types.Texture.t @-> uint8_t @-> returning int))
+
+ let set_texture_blend_mode =
+ F.(foreign "SDL_SetTextureBlendMode"
+ (ptr Types.Texture.t @-> Types.Blend.mode @-> returning int))
+
+ let set_texture_color_mod =
+ F.(foreign "SDL_SetTextureColorMod"
+ (ptr Types.Texture.t @-> uint8_t @-> uint8_t @-> uint8_t @-> returning int))
+
+ let unlock_texture =
+ F.(foreign "SDL_UnlockTexture" (ptr Types.Texture.t @-> returning void))
+
+ let update_texture =
+ F.(foreign "SDL_UpdateTexture"
+ (ptr Types.Texture.t @-> ptr Types.Rect.t @-> ptr void @-> int @->
+ returning int))
+
+ let update_yuv_texture =
+ F.(foreign "SDL_UpdateYUVTexture"
+ (ptr Types.Texture.t @-> ptr Types.Rect.t @->
+ ptr (*u*)int8_t @-> int @-> ptr (*u*)int8_t @-> int @->
+ ptr (*u*)int8_t @-> int @-> returning int))
+
+ (* Video drivers *)
+
+ let get_current_video_driver =
+ F.(foreign "SDL_GetCurrentVideoDriver" (void @-> returning const_string_opt))
+
+ let get_num_video_drivers =
+ F.(foreign "SDL_GetNumVideoDrivers" (void @-> returning int))
+
+ let get_video_driver =
+ F.(foreign "SDL_GetVideoDriver" (int @-> returning const_string_opt))
+
+ let video_init =
+ F.(foreign "SDL_VideoInit" (string_opt @-> returning int))
+
+ let video_quit =
+ F.(foreign "SDL_VideoQuit" (void @-> returning void))
+
+ (* Displays *)
+
+ let get_closest_display_mode =
+ F.(foreign "SDL_GetClosestDisplayMode"
+ (int @-> ptr Types.display_mode @-> ptr Types.display_mode @->
+ returning (ptr_opt void)))
+
+ let get_current_display_mode =
+ F.(foreign "SDL_GetCurrentDisplayMode"
+ (int @-> ptr Types.display_mode @-> returning int))
+
+ let get_desktop_display_mode =
+ F.(foreign "SDL_GetDesktopDisplayMode"
+ (int @-> ptr Types.display_mode @-> returning int))
+
+ let get_display_bounds =
+ F.(foreign "SDL_GetDisplayBounds"
+ (int @-> ptr Types.Rect.t @-> returning int))
+
+ let get_display_dpi =
+ F.(foreign "SDL_GetDisplayDPI"
+ (int @-> ptr float @-> ptr float @-> ptr float @-> returning int))
+
+ let get_display_mode =
+ F.(foreign "SDL_GetDisplayMode"
+ (int @-> int @-> ptr Types.display_mode @-> returning int))
+
+ let get_display_usable_bounds =
+ F.(foreign "SDL_GetDisplayUsableBounds"
+ (int @-> ptr Types.Rect.t @-> returning int))
+
+ let get_num_display_modes =
+ F.(foreign "SDL_GetNumDisplayModes" (int @-> returning int))
+
+ let get_display_name =
+ F.(foreign "SDL_GetDisplayName" (int @-> returning const_string_opt))
+
+ let get_num_video_displays =
+ F.(foreign "SDL_GetNumVideoDisplays" (void @-> returning int))
+
+ let create_window =
+ F.(foreign "SDL_CreateWindow"
+ (string @-> int @-> int @-> int @-> int @-> uint32_t @->
+ returning Types.Window.opt))
+
+ let create_window_and_renderer =
+ F.(foreign "SDL_CreateWindowAndRenderer"
+ (int @-> int @-> uint32_t @-> ptr Types.Window.t @->
+ ptr (ptr Types.Renderer.t) @-> (returning int)))
+
+ let destroy_window =
+ F.(foreign "SDL_DestroyWindow" (Types.Window.t @-> returning void))
+
+ let get_window_brightness =
+ F.(foreign "SDL_GetWindowBrightness" (Types.Window.t @-> returning float))
+
+ let get_window_borders_size =
+ F.(foreign "SDL_GetWindowBordersSize"
+ (Types.Window.t @-> ptr int @-> ptr int @-> ptr int @-> ptr int @->
+ returning int))
+
+ let get_window_display_index =
+ F.(foreign "SDL_GetWindowDisplayIndex" (Types.Window.t @-> returning int))
+
+ let get_window_display_mode =
+ F.(foreign "SDL_GetWindowDisplayMode"
+ (Types.Window.t @-> (ptr Types.display_mode) @-> returning int))
+
+ let get_window_flags =
+ F.(foreign "SDL_GetWindowFlags" (Types.Window.t @-> returning uint32_t))
+
+ let get_window_from_id =
+ F.(foreign "SDL_GetWindowFromID"
+ (uint32_t @-> returning Types.Window.opt))
+
+ let get_window_gamma_ramp =
+ F.(foreign "SDL_GetWindowGammaRamp"
+ (Types.Window.t @-> ptr (*u*)int16_t @-> ptr (*u*)int16_t @->
+ ptr (*u*)int16_t @-> returning int))
+
+ let get_window_grab =
+ F.(foreign "SDL_GetWindowGrab" (Types.Window.t @-> returning bool))
+
+ let get_grabbed_window =
+ F.(foreign "SDL_GetGrabbedWindow" (void @-> returning Types.Window.t))
+
+ let get_window_id =
+ F.(foreign "SDL_GetWindowID" (Types.Window.t @-> returning uint32_t))
+
+ let get_window_maximum_size =
+ F.(foreign "SDL_GetWindowMaximumSize"
+ (Types.Window.t @-> (ptr int) @-> (ptr int) @-> returning void))
+
+ let get_window_minimum_size =
+ F.(foreign "SDL_GetWindowMinimumSize"
+ (Types.Window.t @-> (ptr int) @-> (ptr int) @-> returning void))
+
+ let get_window_opacity =
+ F.(foreign "SDL_GetWindowOpacity"
+ (Types.Window.t @-> (ptr float) @-> returning int))
+
+ let get_window_pixel_format =
+ F.(foreign "SDL_GetWindowPixelFormat"
+ (Types.Window.t @-> returning uint32_t))
+
+ let get_window_position =
+ F.(foreign "SDL_GetWindowPosition"
+ (Types.Window.t @-> (ptr int) @-> (ptr int) @-> returning void))
+
+ let get_window_size =
+ F.(foreign "SDL_GetWindowSize"
+ (Types.Window.t @-> (ptr int) @-> (ptr int) @-> returning void))
+
+ let get_window_surface =
+ F.(foreign "SDL_GetWindowSurface"
+ (Types.Window.t @-> returning (ptr_opt Types.surface)))
+
+ let get_window_title =
+ F.(foreign "SDL_GetWindowTitle" (Types.Window.t @-> returning string))
+
+ let hide_window =
+ F.(foreign "SDL_HideWindow" (Types.Window.t @-> returning void))
+
+ let maximize_window =
+ F.(foreign "SDL_MaximizeWindow" (Types.Window.t @-> returning void))
+
+ let minimize_window =
+ F.(foreign "SDL_MinimizeWindow" (Types.Window.t @-> returning void))
+
+ let raise_window =
+ F.(foreign "SDL_RaiseWindow" (Types.Window.t @-> returning void))
+
+ let restore_window =
+ F.(foreign "SDL_RestoreWindow" (Types.Window.t @-> returning void))
+
+ let set_window_bordered =
+ F.(foreign "SDL_SetWindowBordered"
+ (Types.Window.t @-> bool @-> returning void))
+
+ let set_window_brightness =
+ F.(foreign "SDL_SetWindowBrightness"
+ (Types.Window.t @-> float @-> returning int))
+
+ let set_window_display_mode =
+ F.(foreign "SDL_SetWindowDisplayMode"
+ (Types.Window.t @-> (ptr Types.display_mode) @-> returning int))
+
+ let set_window_fullscreen =
+ F.(foreign "SDL_SetWindowFullscreen"
+ (Types.Window.t @-> uint32_t @-> returning int))
+
+ let set_window_gamma_ramp =
+ F.(foreign "SDL_SetWindowGammaRamp"
+ (Types.Window.t @-> ptr (*u*)int16_t @-> ptr (*u*)int16_t @->
+ ptr (*u*)int16_t @-> returning int))
+
+ let set_window_grab =
+ F.(foreign "SDL_SetWindowGrab" (Types.Window.t @-> bool @-> returning void))
+
+ let set_window_icon =
+ F.(foreign "SDL_SetWindowIcon"
+ (Types.Window.t @-> ptr Types.surface @-> returning void))
+
+ let set_window_input_focus =
+ F.(foreign "SDL_SetWindowInputFocus" (Types.Window.t @-> returning int))
+
+ let set_window_maximum_size =
+ F.(foreign "SDL_SetWindowMaximumSize"
+ (Types.Window.t @-> int @-> int @-> returning void))
+
+ let set_window_minimum_size =
+ F.(foreign "SDL_SetWindowMinimumSize"
+ (Types.Window.t @-> int @-> int @-> returning void))
+
+ let set_window_modal_for =
+ F.(foreign "SDL_SetWindowModalFor"
+ (Types.Window.t @-> Types.Window.t @-> returning int))
+
+ let set_window_opacity =
+ F.(foreign "SDL_SetWindowOpacity"
+ (Types.Window.t @-> float @-> returning int))
+
+ let set_window_position =
+ F.(foreign "SDL_SetWindowPosition"
+ (Types.Window.t @-> int @-> int @-> returning void))
+
+ let set_window_resizable =
+ F.(foreign "SDL_SetWindowResizable"
+ (Types.Window.t @-> bool @-> returning void))
+
+ let set_window_size =
+ F.(foreign "SDL_SetWindowSize"
+ (Types.Window.t @-> int @-> int @-> returning void))
+
+ let set_window_title =
+ F.(foreign "SDL_SetWindowTitle"
+ (Types.Window.t @-> string @-> returning void))
+
+ let show_window =
+ F.(foreign "SDL_ShowWindow" (Types.Window.t @-> returning void))
+
+ let update_window_surface =
+ F.(foreign "SDL_UpdateWindowSurface"
+ (Types.Window.t @-> returning int))
+
+ let update_window_surface_rects =
+ F.(foreign "SDL_UpdateWindowSurfaceRects"
+ (Types.Window.t @-> ptr void @-> int @-> returning int))
+
+ let gl_bind_texture =
+ F.(foreign "SDL_GL_BindTexture"
+ (ptr Types.Texture.t @-> ptr float @-> ptr float @-> returning int))
+
+ let gl_create_context =
+ F.(foreign "SDL_GL_CreateContext"
+ (Types.Window.t @-> returning (ptr_opt Types.Gl.context)))
+
+ let gl_delete_context =
+ F.(foreign "SDL_GL_DeleteContext" (ptr Types.Gl.context @-> returning void))
+
+ let gl_extension_supported =
+ F.(foreign "SDL_GL_ExtensionSupported" (string @-> returning bool))
+
+ let gl_get_attribute =
+ F.(foreign "SDL_GL_GetAttribute" (int @-> (ptr int) @-> returning int))
+
+ let gl_get_current_context =
+ F.(foreign "SDL_GL_GetCurrentContext"
+ (void @-> returning (ptr_opt Types.Gl.context)))
+
+ let gl_get_drawable_size =
+ F.(foreign "SDL_GL_GetDrawableSize"
+ (Types.Window.t @-> ptr int @-> ptr int @-> returning void))
+
+ let gl_get_swap_interval =
+ F.(foreign "SDL_GL_GetSwapInterval" (void @-> returning int))
+
+ let gl_make_current =
+ F.(foreign "SDL_GL_MakeCurrent"
+ (Types.Window.t @-> ptr Types.Gl.context @-> returning int))
+
+ let gl_reset_attributes =
+ F.(foreign "SDL_GL_ResetAttributes" (void @-> returning void))
+
+ let gl_set_attribute =
+ F.(foreign "SDL_GL_SetAttribute" (int @-> int @-> returning int))
+
+ let gl_set_swap_interval =
+ F.(foreign "SDL_GL_SetSwapInterval" (int @-> returning int))
+
+ let gl_swap_window =
+ F.(foreign "SDL_GL_SwapWindow" (Types.Window.t @-> returning void))
+
+ let gl_unbind_texture =
+ F.(foreign "SDL_GL_UnbindTexture" (ptr Types.Texture.t @-> returning int))
+
+ module Vulkan = struct
+ let load_library =
+ F.(foreign "SDL_Vulkan_LoadLibrary" (const_string_opt @-> returning int))
+
+ let unload_library =
+ F.(foreign "SDL_Vulkan_UnloadLibrary" (void @-> returning void))
+
+ let get_instance_extensions =
+ F.(foreign "SDL_Vulkan_GetInstanceExtensions"
+ (Types.Window.t @-> ptr int @-> ptr string @-> returning bool))
+
+ let create_surface =
+ F.(foreign "SDL_Vulkan_CreateSurface"
+ (Types.Window.t @-> ptr void @-> ptr Types.Vulkan.surface @->
+ returning bool))
+
+ let get_drawable_size =
+ F.(foreign "SDL_Vulkan_GetDrawableSize"
+ (Types.Window.t @-> ptr int @-> ptr int @-> returning void))
+ end
+
+ let disable_screen_saver =
+ F.(foreign "SDL_DisableScreenSaver" (void @-> returning void))
+
+ let enable_screen_saver =
+ F.(foreign "SDL_EnableScreenSaver" (void @-> returning void))
+
+ let is_screen_saver_enabled =
+ F.(foreign "SDL_IsScreenSaverEnabled" (void @-> returning bool))
+
+ module Message_box = struct
+ let show =
+ F.(foreign "SDL_ShowMessageBox"
+ (ptr Types.Message_box.data @-> ptr int @-> returning int))
+
+ let show_simple =
+ F.(foreign "SDL_ShowSimpleMessageBox"
+ (uint32_t @-> string @-> string @-> Types.Window.opt @-> returning int))
+ end
+
+ let get_clipboard_text =
+ F.(foreign "SDL_GetClipboardText" (void @-> returning (ptr char)))
+
+ let has_clipboard_text =
+ F.(foreign "SDL_HasClipboardText" (void @-> returning bool))
+
+ let set_clipboard_text =
+ F.(foreign "SDL_SetClipboardText" (string @-> returning int))
+
+ let scancode = int
+ let keycode = int
+ let keymod = uint16_t
+
+ let get_keyboard_focus =
+ F.(foreign "SDL_GetKeyboardFocus" (void @-> returning Types.Window.opt))
+
+ let get_keyboard_state =
+ F.(foreign "SDL_GetKeyboardState" (ptr int @-> returning (ptr (const uint8_t))))
+
+ let get_key_from_name =
+ F.(foreign "SDL_GetKeyFromName" (string @-> returning keycode))
+
+ let get_key_from_scancode =
+ F.(foreign "SDL_GetKeyFromScancode" (scancode @-> returning keycode))
+
+ let get_key_name =
+ F.(foreign "SDL_GetKeyName" (keycode @-> returning string))
+
+ let get_mod_state =
+ F.(foreign "SDL_GetModState" (void @-> returning keymod))
+
+ let get_scancode_from_key =
+ F.(foreign "SDL_GetScancodeFromKey" (keycode @-> returning scancode))
+
+ let get_scancode_from_name =
+ F.(foreign "SDL_GetScancodeFromName" (string @-> returning scancode))
+
+ let get_scancode_name =
+ F.(foreign "SDL_GetScancodeName" (scancode @-> returning string))
+
+ let has_screen_keyboard_support =
+ F.(foreign "SDL_HasScreenKeyboardSupport" (void @-> returning bool))
+
+ let is_screen_keyboard_shown =
+ F.(foreign "SDL_IsScreenKeyboardShown" (Types.Window.t @-> returning bool))
+
+ let is_text_input_active =
+ F.(foreign "SDL_IsTextInputActive" (void @-> returning bool))
+
+ let set_mod_state =
+ F.(foreign "SDL_SetModState" (keymod @-> returning void))
+
+ let set_text_input_rect =
+ F.(foreign "SDL_SetTextInputRect" (ptr Types.Rect.t @-> returning void))
+
+ let start_text_input =
+ F.(foreign "SDL_StartTextInput" (void @-> returning void))
+
+ let stop_text_input =
+ F.(foreign "SDL_StopTextInput" (void @-> returning void))
+
+ let capture_mouse =
+ F.(foreign "SDL_CaptureMouse" (bool @-> returning int))
+
+ let create_color_cursor =
+ F.(foreign "SDL_CreateColorCursor"
+ (ptr Types.surface @-> int @-> int @->
+ returning (ptr_opt Types.cursor)))
+
+ let create_cursor =
+ F.(foreign "SDL_CreateCursor"
+ (ptr (*u*)int8_t @-> ptr (*u*)int8_t @-> int @-> int @-> int @->
+ int @-> returning (ptr_opt Types.cursor)))
+
+ let create_system_cursor =
+ F.(foreign "SDL_CreateSystemCursor"
+ (int @-> returning (ptr_opt Types.cursor)))
+
+ let free_cursor =
+ F.(foreign "SDL_FreeCursor" (ptr Types.cursor @-> returning void))
+
+ let get_cursor =
+ F.(foreign "SDL_GetCursor" (void @-> returning (ptr_opt Types.cursor)))
+
+ let get_default_cursor =
+ F.(foreign "SDL_GetDefaultCursor" (void @-> returning (ptr_opt Types.cursor)))
+
+ let get_global_mouse_state =
+ F.(foreign "SDL_GetGlobalMouseState"
+ (ptr int @-> ptr int @-> returning uint32_t))
+
+ let get_mouse_focus =
+ F.(foreign "SDL_GetMouseFocus" (void @-> returning Types.Window.opt))
+
+ let get_mouse_state =
+ F.(foreign "SDL_GetMouseState"
+ (ptr int @-> ptr int @-> returning uint32_t))
+
+ let get_relative_mouse_mode =
+ F.(foreign "SDL_GetRelativeMouseMode" (void @-> returning bool))
+
+ let get_relative_mouse_state =
+ F.(foreign "SDL_GetRelativeMouseState"
+ (ptr int @-> ptr int @-> returning uint32_t))
+
+ let show_cursor =
+ F.(foreign "SDL_ShowCursor" (int @-> returning int))
+
+ let set_cursor =
+ F.(foreign "SDL_SetCursor" (ptr_opt Types.cursor @-> returning void))
+
+ let set_relative_mouse_mode =
+ F.(foreign "SDL_SetRelativeMouseMode" (bool @-> returning int))
+
+ let warp_mouse_in_window =
+ F.(foreign "SDL_WarpMouseInWindow"
+ (Types.Window.opt @-> int @-> int @-> returning void))
+
+ let warp_mouse_global=
+ F.(foreign "SDL_WarpMouseGlobal" (int @-> int @-> returning int))
+
+ let get_num_touch_devices =
+ F.(foreign "SDL_GetNumTouchDevices" (void @-> returning int))
+
+ let get_num_touch_fingers =
+ F.(foreign "SDL_GetNumTouchFingers" (int64_t @-> returning int))
+
+ let get_touch_device =
+ F.(foreign "SDL_GetTouchDevice" (int @-> returning int64_t))
+
+ let get_touch_finger =
+ F.(foreign "SDL_GetTouchFinger"
+ (int64_t @-> int @-> returning (ptr_opt Types.Finger.t)))
+
+ let load_dollar_templates =
+ F.(foreign "SDL_LoadDollarTemplates"
+ (int64_t @-> Types.rw_ops @-> returning int))
+
+ let record_gesture =
+ F.(foreign "SDL_RecordGesture" (int64_t @-> returning int))
+
+ let save_dollar_template =
+ F.(foreign "SDL_SaveDollarTemplate"
+ (int64_t @-> Types.rw_ops @-> returning int))
+
+ let save_all_dollar_templates =
+ F.(foreign "SDL_SaveAllDollarTemplates" (Types.rw_ops @-> returning int))
+
+ let joystick_close =
+ F.(foreign "SDL_JoystickClose" (ptr Types.joystick @-> returning void))
+
+ let joystick_current_power_level =
+ F.(foreign "SDL_JoystickCurrentPowerLevel"
+ (ptr Types.joystick @-> returning int))
+
+ let joystick_event_state =
+ F.(foreign "SDL_JoystickEventState" (int @-> returning int))
+
+ let joystick_from_instance_id =
+ F.(foreign "SDL_JoystickFromInstanceID"
+ (int32_t @-> returning (ptr Types.joystick)))
+
+ let joystick_get_attached =
+ F.(foreign "SDL_JoystickGetAttached"
+ (ptr Types.joystick @-> returning bool))
+
+ let joystick_get_axis =
+ F.(foreign "SDL_JoystickGetAxis"
+ (ptr Types.joystick @-> int @-> returning int16_t))
+
+ let joystick_get_axis_initial_state =
+ F.(foreign "SDL_JoystickGetAxisInitialState"
+ (ptr Types.joystick @-> int @-> ptr int16_t @-> returning bool))
+
+ let joystick_get_ball =
+ F.(foreign "SDL_JoystickGetBall"
+ (ptr Types.joystick @-> int @-> ptr int @-> ptr int @-> returning int))
+
+ let joystick_get_button =
+ F.(foreign "SDL_JoystickGetButton"
+ (ptr Types.joystick @-> int @-> returning uint8_t))
+
+ let joystick_get_device_guid =
+ F.(foreign "SDL_JoystickGetDeviceGUID" (int @-> returning Types.joystick_guid))
+
+ let joystick_get_device_product =
+ F.(foreign "SDL_JoystickGetDeviceProduct" (int @-> returning uint16_t))
+
+ let joystick_get_device_product_version =
+ F.(foreign "SDL_JoystickGetDeviceProductVersion"
+ (int @-> returning uint16_t))
+
+ let joystick_get_device_type =
+ F.(foreign "SDL_JoystickGetDeviceType" (int @-> returning int))
+
+ let joystick_get_device_instance_id =
+ F.(foreign "SDL_JoystickGetDeviceInstanceID" (int @-> returning int32_t))
+
+ let joystick_get_device_vendor =
+ F.(foreign "SDL_JoystickGetDeviceVendor" (int @-> returning uint16_t))
+
+ let joystick_get_guid =
+ F.(foreign "SDL_JoystickGetGUID"
+ (ptr Types.joystick @-> returning Types.joystick_guid))
+
+ let joystick_get_guid_from_string =
+ F.(foreign "SDL_JoystickGetGUIDFromString"
+ (string @-> returning Types.joystick_guid))
+
+ let joystick_get_guid_string =
+ F.(foreign "SDL_JoystickGetGUIDString"
+ (Types.joystick_guid @-> ptr char @-> int @-> returning void))
+
+ let joystick_get_hat =
+ F.(foreign "SDL_JoystickGetHat"
+ (ptr Types.joystick @-> int @-> returning uint8_t))
+
+ let joystick_get_product =
+ F.(foreign "SDL_JoystickGetProduct"
+ (ptr Types.joystick @-> returning uint16_t))
+
+ let joystick_get_product_version =
+ F.(foreign "SDL_JoystickGetProductVersion"
+ (ptr Types.joystick @-> returning uint16_t))
+
+ let joystick_get_type =
+ F.(foreign "SDL_JoystickGetType" (ptr Types.joystick @-> returning int))
+
+ let joystick_get_vendor =
+ F.(foreign "SDL_JoystickGetVendor"
+ (ptr Types.joystick @-> returning uint16_t))
+
+ let joystick_instance_id =
+ F.(foreign "SDL_JoystickInstanceID"
+ (ptr Types.joystick @-> returning int32_t))
+
+ let joystick_name =
+ F.(foreign "SDL_JoystickName"
+ (ptr Types.joystick @-> returning const_string_opt))
+
+ let joystick_name_for_index =
+ F.(foreign "SDL_JoystickNameForIndex" (int @-> returning const_string_opt))
+
+ let joystick_num_axes =
+ F.(foreign "SDL_JoystickNumAxes" (ptr Types.joystick @-> returning int))
+
+ let joystick_num_balls =
+ F.(foreign "SDL_JoystickNumBalls" (ptr Types.joystick @-> returning int))
+
+ let joystick_num_buttons =
+ F.(foreign "SDL_JoystickNumButtons" (ptr Types.joystick @-> returning int))
+
+ let joystick_num_hats =
+ F.(foreign "SDL_JoystickNumHats" (ptr Types.joystick @-> returning int))
+
+ let joystick_open =
+ F.(foreign "SDL_JoystickOpen" (int @-> returning (ptr_opt Types.joystick)))
+
+ let joystick_update =
+ F.(foreign "SDL_JoystickUpdate" (void @-> returning void))
+
+ let num_joysticks =
+ F.(foreign "SDL_NumJoysticks" (void @-> returning int))
+
+ type _button_bind
+ let button_bind : _button_bind structure typ =
+ structure "SDL_GameControllerButtonBind"
+ let button_bind_bind_type = field button_bind "bindType" int
+ let button_bind_value1 = field button_bind "value1" int (* simplified enum *)
+ let button_bind_value2 = field button_bind "value2" int
+ let () = seal button_bind
+
+ let game_controller_add_mapping =
+ F.(foreign "SDL_GameControllerAddMapping" (string @-> returning int))
+
+ let game_controller_add_mapping_from_rw =
+ F.(foreign "SDL_GameControllerAddMappingsFromRW"
+ (Types.rw_ops @-> bool @-> returning int))
+
+ let game_controller_close =
+ F.(foreign "SDL_GameControllerClose" (ptr Types.game_controller @-> returning void))
+
+ let game_controller_event_state =
+ F.(foreign "SDL_GameControllerEventState" (int @-> returning int))
+
+ let game_controller_from_instance_id =
+ F.(foreign "SDL_GameControllerFromInstanceID"
+ (int32_t @-> returning (ptr Types.game_controller)))
+
+ let game_controller_get_attached =
+ F.(foreign "SDL_GameControllerGetAttached"
+ (ptr Types.game_controller @-> returning bool))
+
+ let game_controller_get_axis =
+ F.(foreign "SDL_GameControllerGetAxis"
+ (ptr Types.game_controller @-> int @-> returning int16_t))
+
+ let game_controller_get_axis_from_string =
+ F.(foreign "SDL_GameControllerGetAxisFromString"
+ (string @-> returning int))
+
+ let game_controller_get_bind_for_axis =
+ F.(foreign "SDL_GameControllerGetBindForAxis"
+ (ptr Types.game_controller @-> int @-> returning button_bind))
+
+ let game_controller_get_bind_for_button =
+ F.(foreign "SDL_GameControllerGetBindForButton"
+ (ptr Types.game_controller @-> int @-> returning button_bind))
+
+ let game_controller_get_button =
+ F.(foreign "SDL_GameControllerGetButton"
+ (ptr Types.game_controller @-> int @-> returning uint8_t))
+
+ let game_controller_get_button_from_string =
+ F.(foreign "SDL_GameControllerGetButtonFromString" (string @-> returning int))
+
+ let game_controller_get_joystick =
+ F.(foreign "SDL_GameControllerGetJoystick"
+ (ptr Types.game_controller @-> returning (ptr_opt Types.joystick)))
+
+ let game_controller_get_product =
+ F.(foreign "SDL_GameControllerGetProduct"
+ (ptr Types.game_controller @-> returning uint16_t))
+
+ let game_controller_get_product_version =
+ F.(foreign "SDL_GameControllerGetProductVersion"
+ (ptr Types.game_controller @-> returning uint16_t))
+
+ let game_controller_get_string_for_axis =
+ F.(foreign "SDL_GameControllerGetStringForAxis"
+ (int @-> returning const_string_opt))
+
+ let game_controller_get_string_for_button =
+ F.(foreign "SDL_GameControllerGetStringForButton"
+ (int @-> returning const_string_opt))
+
+ let game_controller_get_vendor =
+ F.(foreign "SDL_GameControllerGetVendor"
+ (ptr Types.game_controller @-> returning uint16_t))
+
+ let game_controller_mapping =
+ F.(foreign "SDL_GameControllerMapping"
+ (ptr Types.game_controller @-> returning const_string_opt))
+
+ let game_controller_mapping_for_index =
+ F.(foreign "SDL_GameControllerMappingForIndex"
+ (int @-> returning const_string_opt))
+
+ let game_controller_mapping_for_guid =
+ F.(foreign "SDL_GameControllerMappingForGUID"
+ (Types.joystick_guid @-> returning const_string_opt))
+
+ let game_controller_name =
+ F.(foreign "SDL_GameControllerName"
+ (ptr Types.game_controller @-> returning const_string_opt))
+
+ let game_controller_name_for_index =
+ F.(foreign "SDL_GameControllerNameForIndex"
+ (int @-> returning const_string_opt))
+
+ let game_controller_num_mappings =
+ F.(foreign "SDL_GameControllerNumMappings" (void @-> returning int))
+
+ let game_controller_open =
+ F.(foreign "SDL_GameControllerOpen"
+ (int @-> returning (ptr_opt Types.game_controller)))
+
+ let game_controller_update =
+ F.(foreign "SDL_GameControllerUpdate" (void @-> returning void))
+
+ let is_game_controller =
+ F.(foreign "SDL_IsGameController" (int @-> returning bool))
+
+ let event_state =
+ F.(foreign "SDL_EventState" (uint32_t @-> int @-> returning uint8_t))
+
+ let flush_event =
+ F.(foreign "SDL_FlushEvent" (uint32_t @-> returning void))
+
+ let flush_events =
+ F.(foreign "SDL_FlushEvents" (uint32_t @-> uint32_t @-> returning void))
+
+ let has_event =
+ F.(foreign "SDL_HasEvent" (uint32_t @-> returning bool))
+
+ let has_events =
+ F.(foreign "SDL_HasEvents" (uint32_t @-> uint32_t @-> returning bool))
+
+ let poll_event =
+ F.(foreign "SDL_PollEvent" (ptr Types.Event.t @-> returning bool))
+
+ let pump_events =
+ F.(foreign "SDL_PumpEvents" (void @-> returning void))
+
+ let push_event =
+ F.(foreign "SDL_PushEvent" (ptr Types.Event.t @-> returning int))
+
+ let register_events =
+ F.(foreign "SDL_RegisterEvents" (int @-> returning uint32_t))
+
+ (* Force feedback *)
+
+ let haptic_close =
+ F.(foreign "SDL_HapticClose" (ptr Types.Haptic.t @-> returning void))
+
+ let haptic_destroy_effect =
+ F.(foreign "SDL_HapticDestroyEffect"
+ (ptr Types.Haptic.t @-> int @-> returning void))
+
+ let haptic_effect_supported =
+ F.(foreign "SDL_HapticEffectSupported"
+ (ptr Types.Haptic.t @-> ptr Types.Haptic.Effect.t @-> returning int))
+
+ let haptic_get_effect_status =
+ F.(foreign "SDL_HapticGetEffectStatus"
+ (ptr Types.Haptic.t @-> int @-> returning int))
+
+ let haptic_index =
+ F.(foreign "SDL_HapticIndex" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_name =
+ F.(foreign "SDL_HapticName" (int @-> returning const_string_opt))
+
+ let haptic_new_effect =
+ F.(foreign "SDL_HapticNewEffect"
+ (ptr Types.Haptic.t @-> ptr Types.Haptic.Effect.t @-> returning int))
+
+ let haptic_num_axes =
+ F.(foreign "SDL_HapticNumAxes" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_num_effects =
+ F.(foreign "SDL_HapticNumEffects" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_num_effects_playing =
+ F.(foreign "SDL_HapticNumEffectsPlaying" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_open =
+ F.(foreign "SDL_HapticOpen" (int @-> returning (ptr_opt Types.Haptic.t)))
+
+ let haptic_open_from_joystick =
+ F.(foreign "SDL_HapticOpenFromJoystick"
+ (ptr Types.joystick @-> returning (ptr_opt Types.Haptic.t)))
+
+ let haptic_open_from_mouse =
+ F.(foreign "SDL_HapticOpenFromMouse"
+ (void @-> returning (ptr_opt Types.Haptic.t)))
+
+ let haptic_opened =
+ F.(foreign "SDL_HapticOpened" (int @-> returning int))
+
+ let haptic_pause =
+ F.(foreign "SDL_HapticPause" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_query =
+ F.(foreign "SDL_HapticQuery" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_rumble_init =
+ F.(foreign "SDL_HapticRumbleInit" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_rumble_play =
+ F.(foreign "SDL_HapticRumblePlay"
+ (ptr Types.Haptic.t @-> float @-> int32_t @-> returning int))
+
+ let haptic_rumble_stop =
+ F.(foreign "SDL_HapticRumbleStop" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_rumble_supported =
+ F.(foreign "SDL_HapticRumbleSupported" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_run_effect =
+ F.(foreign "SDL_HapticRunEffect"
+ (ptr Types.Haptic.t @-> int @-> int32_t @-> returning int))
+
+ let haptic_set_autocenter =
+ F.(foreign "SDL_HapticSetAutocenter" (ptr Types.Haptic.t @-> int @-> returning int))
+
+ let haptic_set_gain =
+ F.(foreign "SDL_HapticSetGain" (ptr Types.Haptic.t @-> int @-> returning int))
+
+ let haptic_stop_all =
+ F.(foreign "SDL_HapticStopAll" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_stop_effect =
+ F.(foreign "SDL_HapticStopEffect"
+ (ptr Types.Haptic.t @-> int @-> returning int))
+
+ let haptic_unpause =
+ F.(foreign "SDL_HapticUnpause" (ptr Types.Haptic.t @-> returning int))
+
+ let haptic_update_effect =
+ F.(foreign "SDL_HapticUpdateEffect"
+ (ptr Types.Haptic.t @-> int @-> ptr Types.Haptic.Effect.t @->
+ returning int))
+
+ let joystick_is_haptic =
+ F.(foreign "SDL_JoystickIsHaptic" (ptr Types.joystick @-> returning int))
+
+ let mouse_is_haptic =
+ F.(foreign "SDL_MouseIsHaptic" (void @-> returning int))
+
+ let num_haptics =
+ F.(foreign "SDL_NumHaptics" (void @-> returning int))
+
+ (* Audio *)
+
+ (* Audio drivers *)
+
+ let audio_init =
+ F.(foreign "SDL_AudioInit" (const_string_opt @-> returning int))
+
+ let audio_quit =
+ F.(foreign "SDL_AudioQuit" (void @-> returning void))
+
+ let get_audio_driver =
+ F.(foreign "SDL_GetAudioDriver" (int @-> returning const_string_opt))
+
+ let get_current_audio_driver =
+ F.(foreign "SDL_GetCurrentAudioDriver"
+ (void @-> returning const_string_opt))
+
+ let get_num_audio_drivers =
+ F.(foreign "SDL_GetNumAudioDrivers" (void @-> returning int))
+
+ (* Audio devices *)
+
+ let close_audio_device =
+ F.(foreign "SDL_CloseAudioDevice" (uint32_t @-> returning void))
+
+ let free_wav =
+ F.(foreign "SDL_FreeWAV" (ptr void @-> returning void))
+
+ let get_audio_device_name =
+ F.(foreign "SDL_GetAudioDeviceName"
+ (int @-> bool @-> returning const_string_opt))
+
+ let get_audio_device_status =
+ F.(foreign "SDL_GetAudioDeviceStatus" (uint32_t @-> returning int))
+
+ let get_num_audio_devices =
+ F.(foreign "SDL_GetNumAudioDevices" (bool @-> returning int))
+
+ let lock_audio_device =
+ F.(foreign "SDL_LockAudioDevice" (uint32_t @-> returning void))
+
+ let open_audio_device =
+ F.(foreign "SDL_OpenAudioDevice"
+ (const_string_opt @-> bool @-> ptr Types.audio_spec @->
+ ptr Types.audio_spec @-> int @-> returning uint32_t))
+
+ let pause_audio_device =
+ F.(foreign "SDL_PauseAudioDevice" (uint32_t @-> bool @-> returning void))
+
+ let unlock_audio_device =
+ F.(foreign "SDL_UnlockAudioDevice" (uint32_t @-> returning void))
+
+ let queue_audio =
+ F.(foreign "SDL_QueueAudio"
+ (uint32_t @-> ptr void @-> uint32_t @-> returning int))
+
+ let dequeue_audio =
+ F.(foreign "SDL_DequeueAudio"
+ (uint32_t @-> ptr void @-> int @-> returning uint32_t))
+
+ let get_queued_audio_size =
+ F.(foreign "SDL_GetQueuedAudioSize" (uint32_t @-> returning uint32_t))
+
+ let clear_queued_audio =
+ F.(foreign "SDL_ClearQueuedAudio" (uint32_t @-> returning void))
+
+ (* Timer *)
+
+ let get_ticks =
+ F.(foreign "SDL_GetTicks" (void @-> returning int32_t))
+
+ let get_ticks64 =
+ F.(foreign "SDL_GetTicks64" (void @-> returning int64_t))
+
+ let get_performance_counter =
+ F.(foreign "SDL_GetPerformanceCounter" (void @-> returning int64_t))
+
+ let get_performance_frequency =
+ F.(foreign "SDL_GetPerformanceFrequency" (void @-> returning int64_t))
+
+ (* Platform and CPU information *)
+
+ let get_platform =
+ F.(foreign "SDL_GetPlatform" (void @-> returning string))
+
+ let get_cpu_cache_line_size =
+ F.(foreign "SDL_GetCPUCacheLineSize" (void @-> returning int))
+
+ let get_cpu_count =
+ F.(foreign "SDL_GetCPUCount" (void @-> returning int))
+
+ let get_system_ram =
+ F.(foreign "SDL_GetSystemRAM" (void @-> returning int))
+
+ let has_3d_now =
+ F.(foreign "SDL_Has3DNow" (void @-> returning bool))
+
+ let has_altivec =
+ F.(foreign "SDL_HasAltiVec" (void @-> returning bool))
+
+ let has_avx =
+ F.(foreign "SDL_HasAVX" (void @-> returning bool))
+
+ let has_avx2 =
+ F.(foreign "SDL_HasAVX2" (void @-> returning bool))
+
+ let has_mmx =
+ F.(foreign "SDL_HasMMX" (void @-> returning bool))
+
+ let has_neon =
+ F.(foreign "SDL_HasNEON" (void @-> returning bool))
+
+ let has_rdtsc =
+ F.(foreign "SDL_HasRDTSC" (void @-> returning bool))
+
+ let has_sse =
+ F.(foreign "SDL_HasSSE" (void @-> returning bool))
+
+ let has_sse2 =
+ F.(foreign "SDL_HasSSE2" (void @-> returning bool))
+
+ let has_sse3 =
+ F.(foreign "SDL_HasSSE3" (void @-> returning bool))
+
+ let has_sse41 =
+ F.(foreign "SDL_HasSSE41" (void @-> returning bool))
+
+ let has_sse42 =
+ F.(foreign "SDL_HasSSE42" (void @-> returning bool))
+
+ let get_power_info =
+ F.(foreign "SDL_GetPowerInfo" ((ptr int) @-> (ptr int) @-> returning int))
+end
--- /dev/null
+++ b/src/top/dune
@@ -0,0 +1,4 @@
+(library
+ (name tsdl_top)
+ (public_name tsdl.top)
+ (libraries tsdl compiler-libs.toplevel))
--- a/src/tsdl.ml
+++ b/src/tsdl.ml
@@ -6,24 +6,20 @@
let unsafe_get = Array.unsafe_get
open Ctypes
-open Foreign
module Sdl = struct
(* Enum cases and #ifdef'd constants, see support/ in the distribution *)
-open Tsdl_consts
-
(* Formatting with continuation. *)
let kpp k fmt =
- let k fmt = k (Format.flush_str_formatter ()) in
+ let k _fmt = k (Format.flush_str_formatter ()) in
Format.kfprintf k Format.str_formatter fmt
(* Invalid_argument strings *)
let str = Printf.sprintf
-let err_index i = str "invalid index: %d" i
let err_length_mul l mul = str "invalid length: %d not a multiple of %d" l mul
let err_read_field = "cannot read field"
let err_bigarray_pitch pitch ba_el_size =
@@ -39,87 +35,34 @@
(* ctypes views *)
-let write_never _ = assert false
+let char_array_as_string a =
+ Ctypes.(string_from_ptr (CArray.start a) ~length:(CArray.length a))
+
+(* SDL results *)
-let bool =
- view ~read:((<>)0) ~write:(fun b -> compare b false) int;;
+type nonrec 'a result = ( 'a, [ `Msg of string ] ) result
-let int_as_uint8_t =
- view ~read:Unsigned.UInt8.to_int ~write:Unsigned.UInt8.of_int uint8_t
+let get_error = C.Functions.get_error
-let int_as_uint16_t =
- view ~read:Unsigned.UInt16.to_int ~write:Unsigned.UInt16.of_int uint16_t
-
-let int_as_uint32_t =
- view ~read:Unsigned.UInt32.to_int ~write:Unsigned.UInt32.of_int uint32_t
-
-let int_as_int32_t =
- view ~read:Signed.Int32.to_int ~write:Signed.Int32.of_int int32_t
-
-let int32_as_uint32_t =
- view ~read:Unsigned.UInt32.to_int32 ~write:Unsigned.UInt32.of_int32 uint32_t
-
-let string_as_char_array n = (* FIXME: drop this if ctypes proposes better *)
- let n_array = array n char in
- let read a =
- let len = CArray.length a in
- let b = Buffer.create len in
- try
- for i = 0 to len - 1 do
- let c = CArray.get a i in
- if c = '\000' then raise Exit else Buffer.add_char b c
- done;
- Buffer.contents b
- with Exit -> Buffer.contents b
- in
- let write s =
- let a = CArray.make char n in
- let len = min (CArray.length a) (String.length s) in
- for i = 0 to len - 1 do CArray.set a i (s.[i]) done;
- a
- in
- view ~read ~write n_array
+let error () = Error (`Msg (get_error ()))
-let get_error =
- foreign "SDL_GetError" (void @-> returning string)
+let zero_to_ok = function 0 -> Ok () | _ -> error ()
-(* SDL results *)
+let one_to_ok = function 1 -> Ok () | _ -> error ()
-type nonrec 'a result = ( 'a, [ `Msg of string ] ) result
+let bool_to_ok = function 0 -> Ok false | 1 -> Ok true | _ -> error ()
-let error () = Error (`Msg (get_error ()))
+let nat_to_ok = function n when n < 0 -> error () | n -> Ok n
-let zero_to_ok =
- let read = function 0 -> Ok () | err -> error () in
- view ~read ~write:write_never int
-
-let one_to_ok =
- let read = function 1 -> Ok () | err -> error () in
- view ~read ~write:write_never int
-
-let bool_to_ok =
- let read = function 0 -> Ok false | 1 -> Ok true | _ -> error () in
- view ~read ~write:write_never int
-
-let nat_to_ok =
- let read = function n when n < 0 -> error () | n -> Ok n in
- view ~read ~write:write_never int
-
-let some_to_ok t =
- let read = function Some v -> Ok v | None -> error () in
- view ~read ~write:write_never t
+let some_to_ok = function Some v -> Ok v | None -> error ()
-let sdl_free = foreign "SDL_free" (ptr void @-> returning void)
+let sdl_free = C.Functions.sdl_free
(* Since we never let SDL redefine our main make sure this is always
called. *)
let () =
- let set_main_ready = foreign "SDL_SetMainReady" (void @-> returning void) in
- set_main_ready ()
-
-let stub = true
-
+ C.Functions.set_main_ready ()
(* Integer types and maps *)
@@ -147,7 +90,7 @@
| k when k = float64 || k = int64 || k = complex32 -> 8
| k when k = complex64 -> 16
| k when k = int || k = nativeint -> Sys.word_size / 8
- | k -> assert false
+ | _ -> assert false
let access_ptr_typ_of_ba_kind : ('a, 'b) Bigarray.kind -> 'a ptr typ = fun k ->
let open Bigarray in
@@ -168,129 +111,99 @@
| k when k = char -> Obj.magic (ptr Ctypes.char)
| _ -> assert false
-let ba_byte_size ba =
- let el_size = ba_kind_byte_size (Bigarray.Array1.kind ba) in
- el_size * Bigarray.Array1.dim ba
-
(* Basics *)
(* Initialization and shutdown *)
module Init = struct
type t = Unsigned.uint32
- let i = Unsigned.UInt32.of_int
let ( + ) = Unsigned.UInt32.logor
let ( - ) f f' = Unsigned.UInt32.(logand f (lognot f'))
let test f m = Unsigned.UInt32.(compare (logand f m) zero <> 0)
let eq f f' = Unsigned.UInt32.(compare f f' = 0)
- let nothing = i 0
- let timer = i sdl_init_timer
- let audio = i sdl_init_audio
- let video = i sdl_init_video
- let joystick = i sdl_init_joystick
- let haptic = i sdl_init_haptic
- let gamecontroller = i sdl_init_gamecontroller
- let events = i sdl_init_events
- let everything = i sdl_init_everything
- let noparachute = i sdl_init_noparachute
+ let nothing = Unsigned.UInt32.zero
+ include C.Types.Init
end
-let init =
- foreign "SDL_Init" (uint32_t @-> returning zero_to_ok)
-
-let init_sub_system =
- foreign "SDL_InitSubSystem" (uint32_t @-> returning zero_to_ok)
+let init n = zero_to_ok (C.Functions.init n)
-let quit =
- foreign "SDL_Quit" (void @-> returning void)
+let init_sub_system n = zero_to_ok (C.Functions.init_sub_system n)
-let quit_sub_system =
- foreign "SDL_QuitSubSystem" (uint32_t @-> returning void)
+let quit = C.Functions.quit
-let was_init =
- foreign "SDL_WasInit" (uint32_t @-> returning uint32_t)
+let quit_sub_system = C.Functions.quit_sub_system
let was_init = function
-| None -> was_init (Unsigned.UInt32.of_int 0)
-| Some m -> was_init m
+| None -> C.Functions.was_init (Unsigned.UInt32.of_int 0)
+| Some m -> C.Functions.was_init m
(* Hints *)
module Hint = struct
type t = string
- let audio_resampling_mode = sdl_hint_audio_resampling_mode
- let framebuffer_acceleration = sdl_hint_framebuffer_acceleration
- let idle_timer_disabled = sdl_hint_idle_timer_disabled
- let orientations = sdl_hint_orientations
- let mouse_focus_clickthrough = sdl_hint_mouse_focus_clickthrough
- let mouse_normal_speed_scale = sdl_hint_mouse_normal_speed_scale
- let mouse_relative_speed_scale = sdl_hint_mouse_relative_speed_scale
- let render_driver = sdl_hint_render_driver
- let render_logical_size_mode = sdl_hint_render_logical_size_mode
- let render_opengl_shaders = sdl_hint_render_opengl_shaders
- let render_scale_quality = sdl_hint_render_scale_quality
- let render_vsync = sdl_hint_render_vsync
- let no_signal_handlers = sdl_hint_no_signal_handlers
- let thread_stack_size = sdl_hint_thread_stack_size
- let touch_mouse_events = sdl_hint_touch_mouse_events
- let mouse_touch_events = sdl_hint_mouse_touch_events
+ let audio_resampling_mode =
+ char_array_as_string (!@ C.Functions.Hint.audio_resampling_mode)
+ let framebuffer_acceleration =
+ char_array_as_string (!@ C.Functions.Hint.framebuffer_acceleration)
+ let idle_timer_disabled =
+ char_array_as_string (!@ C.Functions.Hint.idle_timer_disabled)
+ let orientations = char_array_as_string (!@ C.Functions.Hint.orientations)
+ let mouse_focus_clickthrough =
+ char_array_as_string (!@ C.Functions.Hint.mouse_focus_clickthrough)
+ let mouse_normal_speed_scale =
+ char_array_as_string (!@ C.Functions.Hint.mouse_normal_speed_scale)
+ let mouse_relative_speed_scale =
+ char_array_as_string (!@ C.Functions.Hint.mouse_relative_speed_scale)
+ let render_driver = char_array_as_string (!@ C.Functions.Hint.render_driver)
+ let render_logical_size_mode =
+ char_array_as_string (!@ C.Functions.Hint.render_logical_size_mode)
+ let render_opengl_shaders =
+ char_array_as_string (!@ C.Functions.Hint.render_opengl_shaders)
+ let render_scale_quality =
+ char_array_as_string (!@ C.Functions.Hint.render_scale_quality)
+ let render_vsync = char_array_as_string (!@ C.Functions.Hint.render_vsync)
+ let no_signal_handlers =
+ char_array_as_string (!@ C.Functions.Hint.no_signal_handlers)
+ let thread_stack_size =
+ char_array_as_string (!@ C.Functions.Hint.thread_stack_size)
+ let touch_mouse_events =
+ char_array_as_string (!@ C.Functions.Hint.touch_mouse_events)
+ let mouse_touch_events =
+ char_array_as_string (!@ C.Functions.Hint.mouse_touch_events)
let window_frame_usable_while_cursor_hidden =
- sdl_hint_window_frame_usable_while_cursor_hidden
+ char_array_as_string
+ (!@ C.Functions.Hint.window_frame_usable_while_cursor_hidden)
type priority = int
- let default = sdl_hint_default
- let normal = sdl_hint_normal
- let override = sdl_hint_override
+ include C.Types.Hint
end
-let clear_hints =
- foreign "SDL_ClearHints" (void @-> returning void)
+let clear_hints = C.Functions.clear_hints
-let get_hint =
- foreign "SDL_GetHint" (string @-> returning string_opt)
+let get_hint x = C.Functions.get_hint x
-let get_hint_boolean =
- foreign "SDL_GetHintBoolean" (string @-> bool @-> returning bool)
+let get_hint_boolean = C.Functions.get_hint_boolean
-let set_hint =
- foreign "SDL_SetHint" (string @-> string @-> returning bool)
+let set_hint = C.Functions.set_hint
-let set_hint_with_priority =
- foreign "SDL_SetHintWithPriority"
- (string @-> string @-> int @-> returning bool)
+let set_hint_with_priority = C.Functions.set_hint_with_priority
(* Errors *)
-let clear_error =
- foreign "SDL_ClearError" (void @-> returning void)
-
-let set_error =
- foreign "SDL_SetError" (string @-> returning int)
+let clear_error = C.Functions.clear_error
let set_error fmt =
- kpp (fun s -> ignore (set_error s)) fmt
+ kpp (fun s -> ignore (C.Functions.set_error s)) fmt
(* Log *)
module Log = struct
type category = int
- let category_application = sdl_log_category_application
- let category_error = sdl_log_category_error
- let category_system = sdl_log_category_system
- let category_audio = sdl_log_category_audio
- let category_video = sdl_log_category_video
- let category_render = sdl_log_category_render
- let category_input = sdl_log_category_input
- let category_custom = sdl_log_category_custom
type priority = int
let priority_compare : int -> int -> int = compare
- let priority_verbose = sdl_log_priority_verbose
- let priority_debug = sdl_log_priority_debug
- let priority_info = sdl_log_priority_info
- let priority_warn = sdl_log_priority_warn
- let priority_error = sdl_log_priority_error
- let priority_critical = sdl_log_priority_critical
+
+ include C.Types.Log
end
external log_message : int -> int -> string -> unit = "ocaml_tsdl_log_message"
@@ -304,87 +217,37 @@
let log_verbose c fmt = log_message c Log.priority_verbose fmt
let log_warn c fmt = log_message c Log.priority_warn fmt
-let log_get_priority =
- foreign "SDL_LogGetPriority" (int @-> returning int)
+let log_get_priority = C.Functions.log_get_priority
-let log_reset_priorities =
- foreign "SDL_LogResetPriorities" (void @-> returning void)
+let log_reset_priorities = C.Functions.log_reset_priorities
-let log_set_all_priority =
- foreign "SDL_LogSetAllPriority" (int @-> returning void)
+let log_set_all_priority = C.Functions.log_set_all_priority
-let log_set_priority =
- foreign "SDL_LogSetPriority" (int @-> int @-> returning void)
+let log_set_priority = C.Functions.log_set_priority
(* Version *)
-
-let version = structure "SDL_version"
-let version_major = field version "major" uint8_t
-let version_minor = field version "minor" uint8_t
-let version_patch = field version "patch" uint8_t
-let () = seal version
-
-let get_version =
- foreign "SDL_GetVersion" (ptr version @-> returning void)
-
let get_version () =
let get v f = Unsigned.UInt8.to_int (getf v f) in
- let v = make version in
- get_version (addr v);
- (get v version_major), (get v version_minor), (get v version_patch)
-
-let get_revision =
- foreign "SDL_GetRevision" (void @-> returning string)
-
-let get_revision_number =
- foreign "SDL_GetRevisionNumber" (void @-> returning int)
-
-(* IO absraction *)
-
-type _rw_ops
-let rw_ops_struct : _rw_ops structure typ = structure "SDL_RWops"
-let rw_ops : _rw_ops structure ptr typ = ptr rw_ops_struct
-let rw_ops_opt : _rw_ops structure ptr option typ = ptr_opt rw_ops_struct
-
-let rw_ops_size = field rw_ops_struct "size"
- (funptr (rw_ops @-> returning int64_t))
-let rw_ops_seek = field rw_ops_struct "seek"
- (funptr (rw_ops @-> int64_t @-> int @-> returning int64_t))
-let rw_ops_read = field rw_ops_struct "read"
- (funptr (rw_ops @-> ptr void @-> size_t @-> size_t @-> returning size_t))
-let rw_ops_write = field rw_ops_struct "write"
- (funptr (rw_ops @-> ptr void @-> size_t @-> size_t @-> returning size_t))
-let rw_ops_close = field rw_ops_struct "close"
- (funptr (rw_ops @-> returning int))
-let _ = field rw_ops_struct "type" uint32_t
-(* ... #ifdef'd union follows, we don't care we don't use Ctypes.make *)
-let () = seal rw_ops_struct
-
-type rw_ops = _rw_ops structure ptr
-
-let load_file_rw =
- foreign "SDL_LoadFile_RW"
- (rw_ops @-> ptr int @-> bool @-> returning (some_to_ok string_opt))
+ let v = make C.Types.version in
+ C.Functions.get_version (addr v);
+ C.Types.((get v version_major), (get v version_minor), (get v version_patch))
-let load_file_rw rw_ops close =
- load_file_rw rw_ops (coerce (ptr void) (ptr int) null) close
+let get_revision = C.Functions.get_revision
-let rw_from_file =
- foreign "SDL_RWFromFile"
- (string @-> string @-> returning (some_to_ok rw_ops_opt))
+type rw_ops = C.Types.rw_ops
-let rw_from_const_mem =
- foreign "SDL_RWFromConstMem"
- (ocaml_string @-> int @-> returning (some_to_ok rw_ops_opt))
+let load_file_rw rw_ops close =
+ some_to_ok (C.Functions.load_file_rw
+ rw_ops (coerce (ptr void) (ptr size_t) null) close)
-let rw_from_const_mem str = rw_from_const_mem
- (ocaml_string_start str) (String.length str)
+let rw_from_file x y = some_to_ok (C.Functions.rw_from_file x y)
-let rw_from_mem =
- foreign "SDL_RWFromMem"
- (ocaml_bytes @-> int @-> returning (some_to_ok rw_ops_opt))
+let rw_from_const_mem str =
+ some_to_ok (C.Functions.rw_from_const_mem
+ (ocaml_string_start str) (String.length str))
-let rw_from_mem b = rw_from_mem (ocaml_bytes_start b) (Bytes.length b)
+let rw_from_mem b =
+ some_to_ok (C.Functions.rw_from_mem (ocaml_bytes_start b) (Bytes.length b))
let load_file filename = (* defined as a macro in SDL_rwops.h *)
match rw_from_file filename "rb" with
@@ -392,359 +255,248 @@
| Ok rw -> load_file_rw rw true
let rw_close ops =
- let close = getf (!@ ops) rw_ops_close in
- if close ops = 0 then Ok () else (error ())
+ if C.Functions.rw_close ops = 0 then Ok () else (error ())
-let unsafe_rw_ops_of_ptr addr : rw_ops =
- from_voidp rw_ops_struct (ptr_of_raw_address addr)
+let unsafe_rw_ops_of_ptr addr : C.Types.rw_ops =
+ from_voidp C.Types.rw_ops_struct (ptr_of_raw_address addr)
let unsafe_ptr_of_rw_ops rw_ops =
raw_address_of_ptr (to_voidp rw_ops)
(* File system paths *)
-let get_base_path =
- foreign "SDL_GetBasePath" (void @-> returning (ptr char))
-
let get_base_path () =
- let p = get_base_path () in
- let path = coerce (ptr char) (some_to_ok string_opt) p in
+ let p = C.Functions.get_base_path () in
+ let path = coerce (ptr char) string_opt p in
sdl_free (coerce (ptr char) (ptr void) p);
- path
-
-let get_pref_path =
- foreign "SDL_GetPrefPath" (string @-> string @-> returning (ptr char))
+ some_to_ok path
let get_pref_path ~org ~app =
- let p = get_pref_path org app in
- let path = coerce (ptr char) (some_to_ok string_opt) p in
+ let p = C.Functions.get_pref_path org app in
+ let path = coerce (ptr char) string_opt p in
sdl_free (coerce (ptr char) (ptr void) p);
- path
-
-(* Video *)
-
-type window = unit ptr
-let window : window typ = ptr void
-let window_opt : window option typ = ptr_opt void
-
-let unsafe_window_of_ptr addr : window =
- ptr_of_raw_address addr
-let unsafe_ptr_of_window window =
- raw_address_of_ptr (to_voidp window)
+ some_to_ok path
(* Colors *)
-type _color
-type color = _color structure
-let color : color typ = structure "SDL_Color"
-let color_r = field color "r" uint8_t
-let color_g = field color "g" uint8_t
-let color_b = field color "b" uint8_t
-let color_a = field color "a" uint8_t
-let () = seal color
-
module Color = struct
let create ~r ~g ~b ~a =
- let c = make color in
- setf c color_r (Unsigned.UInt8.of_int r);
- setf c color_g (Unsigned.UInt8.of_int g);
- setf c color_b (Unsigned.UInt8.of_int b);
- setf c color_a (Unsigned.UInt8.of_int a);
+ let c = make C.Types.Color.t in
+ setf c C.Types.Color.r (Unsigned.UInt8.of_int r);
+ setf c C.Types.Color.g (Unsigned.UInt8.of_int g);
+ setf c C.Types.Color.b (Unsigned.UInt8.of_int b);
+ setf c C.Types.Color.a (Unsigned.UInt8.of_int a);
c
- let r c = Unsigned.UInt8.to_int (getf c color_r)
- let g c = Unsigned.UInt8.to_int (getf c color_g)
- let b c = Unsigned.UInt8.to_int (getf c color_b)
- let a c = Unsigned.UInt8.to_int (getf c color_a)
-
- let set_r c r = setf c color_r (Unsigned.UInt8.of_int r)
- let set_g c g = setf c color_g (Unsigned.UInt8.of_int g)
- let set_b c b = setf c color_b (Unsigned.UInt8.of_int b)
- let set_a c a = setf c color_a (Unsigned.UInt8.of_int a)
+ let r c = Unsigned.UInt8.to_int (getf c C.Types.Color.r)
+ let g c = Unsigned.UInt8.to_int (getf c C.Types.Color.g)
+ let b c = Unsigned.UInt8.to_int (getf c C.Types.Color.b)
+ let a c = Unsigned.UInt8.to_int (getf c C.Types.Color.a)
+
+ let set_r c r = setf c C.Types.Color.r (Unsigned.UInt8.of_int r)
+ let set_g c g = setf c C.Types.Color.g (Unsigned.UInt8.of_int g)
+ let set_b c b = setf c C.Types.Color.b (Unsigned.UInt8.of_int b)
+ let set_a c a = setf c C.Types.Color.a (Unsigned.UInt8.of_int a)
end
-(* Points *)
+type color = C.Types.Color.t
+let color = C.Types.Color.t
-type _point
-type point = _point structure
-let point : point typ = structure "SDL_Point"
-let point_x = field point "x" int
-let point_y = field point "y" int
-let () = seal point
+(* Points *)
+type point = C.Types.Point.t
module Point = struct
let create ~x ~y =
- let p = make point in
- setf p point_x x;
- setf p point_y y;
+ let p = make C.Types.Point.t in
+ setf p C.Types.Point.x x;
+ setf p C.Types.Point.y y;
p
- let x p = getf p point_x
- let y p = getf p point_y
+ let x p = getf p C.Types.Point.x
+ let y p = getf p C.Types.Point.y
- let set_x p x = setf p point_x x
- let set_y p y = setf p point_y y
+ let set_x p x = setf p C.Types.Point.x x
+ let set_y p y = setf p C.Types.Point.y y
let opt_addr = function
- | None -> coerce (ptr void) (ptr point) null
+ | None -> coerce (ptr void) (ptr C.Types.Point.t) null
| Some v -> addr v
end
(* Float Points *)
-
-type _fpoint
-type fpoint = _fpoint structure
-let fpoint : fpoint typ = structure "SDL_FPoint"
-let fpoint_x = field fpoint "x" float
-let fpoint_y = field fpoint "y" float
-let () = seal fpoint
+type fpoint = C.Types.Fpoint.t
module Fpoint = struct
let create ~x ~y =
- let p = make fpoint in
- setf p fpoint_x x;
- setf p fpoint_y y;
+ let p = make C.Types.Fpoint.t in
+ setf p C.Types.Fpoint.x x;
+ setf p C.Types.Fpoint.y y;
p
- let x p = getf p fpoint_x
- let y p = getf p fpoint_y
+ let x p = getf p C.Types.Fpoint.x
+ let y p = getf p C.Types.Fpoint.y
- let set_x p x = setf p fpoint_x x
- let set_y p y = setf p fpoint_y y
-
- let opt_addr = function
- | None -> coerce (ptr void) (ptr fpoint) null
- | Some v -> addr v
+ let set_x p x = setf p C.Types.Fpoint.x x
+ let set_y p y = setf p C.Types.Fpoint.y y
end
(* Vertices *)
-type _vertex
-type vertex = _vertex structure
-let vertex : vertex typ = structure "SDL_Vertex"
-let vertex_position = field vertex "position" fpoint
-let vertex_color = field vertex "color" color
-let vertex_tex_coord = field vertex "tex_coord" fpoint
-let () = seal vertex
+type vertex = C.Types.Vertex.t
module Vertex = struct
+ open C.Types
+
let create ~position ~color ~tex_coord =
- let v = make vertex in
- setf v vertex_position position;
- setf v vertex_color color;
- setf v vertex_tex_coord tex_coord;
+ let v = make Vertex.t in
+ setf v Vertex.position position;
+ setf v Vertex.color color;
+ setf v Vertex.tex_coord tex_coord;
v
- let position v = getf v vertex_position
- let color v = getf v vertex_color
- let tex_coord v = getf v vertex_tex_coord
-
- let set_position v position = setf v vertex_position position
- let set_color v color = setf v vertex_color color
- let set_tex_coord v tex_coord = setf v vertex_tex_coord tex_coord
-
- let opt_addr = function
- | None -> coerce (ptr void) (ptr vertex) null
- | Some v -> addr v
+ let position v = getf v Vertex.position
+ let color v = getf v Vertex.color
+ let tex_coord v = getf v Vertex.tex_coord
+
+ let set_position v position = setf v Vertex.position position
+ let set_color v color = setf v Vertex.color color
+ let set_tex_coord v tex_coord = setf v Vertex.tex_coord tex_coord
end
(* Rectangle *)
-type _rect
-type rect = _rect structure
-let rect : rect typ = structure "SDL_Rect"
-let rect_x = field rect "x" int
-let rect_y = field rect "y" int
-let rect_w = field rect "w" int
-let rect_h = field rect "h" int
-let () = seal rect
+type rect = C.Types.Rect.t
module Rect = struct
let create ~x ~y ~w ~h =
- let r = make rect in
- setf r rect_x x;
- setf r rect_y y;
- setf r rect_w w;
- setf r rect_h h;
+ let r = make C.Types.Rect.t in
+ setf r C.Types.Rect.x x;
+ setf r C.Types.Rect.y y;
+ setf r C.Types.Rect.w w;
+ setf r C.Types.Rect.h h;
r
- let x r = getf r rect_x
- let y r = getf r rect_y
- let w r = getf r rect_w
- let h r = getf r rect_h
-
- let set_x r x = setf r rect_x x
- let set_y r y = setf r rect_y y
- let set_w r w = setf r rect_w w
- let set_h r h = setf r rect_h h
+ let x r = getf r C.Types.Rect.x
+ let y r = getf r C.Types.Rect.y
+ let w r = getf r C.Types.Rect.w
+ let h r = getf r C.Types.Rect.h
+
+ let set_x r x = setf r C.Types.Rect.x x
+ let set_y r y = setf r C.Types.Rect.y y
+ let set_w r w = setf r C.Types.Rect.w w
+ let set_h r h = setf r C.Types.Rect.h h
let opt_addr = function
- | None -> coerce (ptr void) (ptr rect) null
+ | None -> coerce (ptr void) (ptr C.Types.Rect.t) null
| Some v -> addr v
end
(* Float Rectangle *)
-type _frect
-type frect = _frect structure
-let frect : frect typ = structure "SDL_FRect"
-let frect_x = field frect "x" float
-let frect_y = field frect "y" float
-let frect_w = field frect "w" float
-let frect_h = field frect "h" float
-let () = seal frect
+type frect = C.Types.Frect.t
module Frect = struct
let create ~x ~y ~w ~h =
- let r = make frect in
- setf r frect_x x;
- setf r frect_y y;
- setf r frect_w w;
- setf r frect_h h;
+ let r = make C.Types.Frect.t in
+ setf r C.Types.Frect.x x;
+ setf r C.Types.Frect.y y;
+ setf r C.Types.Frect.w w;
+ setf r C.Types.Frect.h h;
r
- let x r = getf r frect_x
- let y r = getf r frect_y
- let w r = getf r frect_w
- let h r = getf r frect_h
-
- let set_x r x = setf r frect_x x
- let set_y r y = setf r frect_y y
- let set_w r w = setf r frect_w w
- let set_h r h = setf r frect_h h
-
- let opt_addr = function
- | None -> coerce (ptr void) (ptr rect) null
- | Some v -> addr v
+ let x r = getf r C.Types.Frect.x
+ let y r = getf r C.Types.Frect.y
+ let w r = getf r C.Types.Frect.w
+ let h r = getf r C.Types.Frect.h
+
+ let set_x r x = setf r C.Types.Frect.x x
+ let set_y r y = setf r C.Types.Frect.y y
+ let set_w r w = setf r C.Types.Frect.w w
+ let set_h r h = setf r C.Types.Frect.h h
end
-let enclose_points =
- foreign "SDL_EnclosePoints"
- (ptr void @-> int @-> ptr rect @-> ptr rect @-> returning bool)
-
let enclose_points_ba ?clip ps =
let len = Bigarray.Array1.dim ps in
if len mod 2 <> 0 then invalid_arg (err_length_mul len 2) else
let count = len / 2 in
let ps = to_voidp (bigarray_start array1 ps) in
- let res = make rect in
- if enclose_points ps count (Rect.opt_addr clip) (addr res)
+ let res = make C.Types.Rect.t in
+ if C.Functions.enclose_points ps count (Rect.opt_addr clip) (addr res)
then Some res
else None
let enclose_points ?clip ps =
- let a = CArray.of_list point ps in
+ let a = CArray.of_list C.Types.Point.t ps in
let ps = to_voidp (CArray.start a) in
- let res = make rect in
- if enclose_points ps (CArray.length a) (Rect.opt_addr clip) (addr res)
+ let res = make C.Types.Rect.t in
+ if C.Functions.enclose_points ps (CArray.length a) (Rect.opt_addr clip) (addr res)
then Some res
else None
-let has_intersection =
- foreign "SDL_HasIntersection"
- (ptr rect @-> ptr rect @-> returning bool)
-
let has_intersection a b =
- has_intersection (addr a) (addr b)
-
-let intersect_rect =
- foreign "SDL_IntersectRect"
- (ptr rect @-> ptr rect @-> ptr rect @-> returning bool)
+ C.Functions.has_intersection (addr a) (addr b)
let intersect_rect a b =
- let res = make rect in
- if intersect_rect (addr a) (addr b) (addr res) then Some res else None
-
-let intersect_rect_and_line =
- foreign "SDL_IntersectRectAndLine"
- (ptr rect @-> ptr int @-> ptr int @-> ptr int @-> ptr int @->
- returning bool)
+ let res = make C.Types.Rect.t in
+ if C.Functions.intersect_rect (addr a) (addr b) (addr res)
+ then Some res
+ else None
let intersect_rect_and_line r x1 y1 x2 y2 =
let alloc v = allocate int v in
let x1, y1 = alloc x1, alloc y1 in
let x2, y2 = alloc x2, alloc y2 in
- if intersect_rect_and_line (addr r) x1 y1 x2 y2
+ if C.Functions.intersect_rect_and_line (addr r) x1 y1 x2 y2
then Some ((!@x1, !@y1), (!@x2, !@y2))
else None
-let point_in_rect p r =
- (* SDL_FORCE_INLINE *)
- let px = Point.x p in
- let py = Point.y p in
- let rx = Rect.x r in
- let ry = Rect.y r in
- px >= rx && px < rx + Rect.w r && py >= ry && py < ry + Rect.h r
-
-let rect_empty r =
- (* symbol doesn't exist: SDL_FORCE_INLINE directive
- foreign "SDL_RectEmpty" (ptr rect @-> returning bool) *)
- Rect.w r <= 0 || Rect.h r <= 0
-
-let rect_equals a b =
- (* symbol doesn't exist: SDL_FORCE_INLINE directive
- foreign "SDL_RectEquals" (ptr rect @-> ptr rect @-> returning bool) *)
- (Rect.x a = Rect.x b) && (Rect.y a = Rect.y b) &&
- (Rect.w a = Rect.w b) && (Rect.h a = Rect.h b)
-
-let union_rect =
- foreign "SDL_UnionRect"
- (ptr rect @-> ptr rect @-> ptr rect @-> returning void)
+let point_in_rect p r = C.Functions.point_in_rect (addr p) (addr r)
+
+let rect_empty r = C.Functions.rect_empty (addr r)
+
+let rect_equals a b = C.Functions.rect_equals (addr a) (addr b)
let union_rect a b =
- let res = make rect in
- union_rect (addr a) (addr b) (addr res);
+ let res = make C.Types.Rect.t in
+ C.Functions.union_rect (addr a) (addr b) (addr res);
res
(* Palettes *)
-type _palette
-type palette_struct = _palette structure
-let palette_struct : palette_struct typ = structure "SDL_Palette"
-let palette_ncolors = field palette_struct "ncolors" int
-let palette_colors = field palette_struct "colors" (ptr color)
-let _ = field palette_struct "version" uint32_t
-let _ = field palette_struct "refcount" int
-let () = seal palette_struct
-
-type palette = palette_struct ptr
-let palette : palette typ = ptr palette_struct
-let palette_opt : palette option typ = ptr_opt palette_struct
+type palette = C.Types.palette ptr
let unsafe_palette_of_ptr addr : palette =
- from_voidp palette_struct (ptr_of_raw_address addr)
+ from_voidp C.Types.palette (ptr_of_raw_address addr)
let unsafe_ptr_of_palette palette =
raw_address_of_ptr (to_voidp palette)
-let alloc_palette =
- foreign "SDL_AllocPalette"
- (int @-> returning (some_to_ok palette_opt))
+let alloc_palette x = some_to_ok (C.Functions.alloc_palette x)
-let free_palette =
- foreign "SDL_FreePalette" (palette @-> returning void)
+let free_palette = C.Functions.free_palette
let get_palette_ncolors p =
- getf (!@ p) palette_ncolors
+ getf (!@ p) C.Types.palette_ncolors
let get_palette_colors p =
let ps = !@ p in
CArray.to_list
- (CArray.from_ptr (getf ps palette_colors) (getf ps palette_ncolors))
+ (CArray.from_ptr
+ (getf ps C.Types.palette_colors)
+ (getf ps C.Types.palette_ncolors))
let get_palette_colors_ba p =
let ps = !@ p in
(* FIXME: ctypes should have a CArray.copy function *)
- let n = getf ps palette_ncolors in
+ let n = getf ps C.Types.palette_ncolors in
let ba = Bigarray.(Array1.create int8_unsigned c_layout (n * 4)) in
let ba_ptr =
CArray.from_ptr (coerce (ptr int) (ptr color) (bigarray_start array1 ba)) n
in
- let ca = CArray.from_ptr (getf ps palette_colors) n in
+ let ca = CArray.from_ptr (getf ps C.Types.palette_colors) n in
for i = 0 to n - 1 do CArray.set ba_ptr i (CArray.get ca i) done;
ba
-let set_palette_colors =
- foreign "SDL_SetPaletteColors"
- (palette @-> ptr void @-> int @-> int @-> returning zero_to_ok)
+let set_palette_colors x y z t =
+ zero_to_ok (C.Functions.set_palette_colors x y z t)
let set_palette_colors_ba p cs ~fst =
let len = Bigarray.Array1.dim cs in
@@ -761,251 +513,119 @@
type gamma_ramp = (int, Bigarray.int16_unsigned_elt) bigarray
-let calculate_gamma_ramp =
- foreign "SDL_CalculateGammaRamp"
- (float @-> ptr void @-> returning void)
-
let calculate_gamma_ramp g =
let ba = Bigarray.(Array1.create int16_unsigned c_layout 256) in
- calculate_gamma_ramp g (to_voidp (bigarray_start array1 ba));
+ C.Functions.calculate_gamma_ramp g (bigarray_start array1 ba);
ba
module Blend = struct
- type mode = int
- let mode_none = sdl_blendmode_none
- let mode_blend = sdl_blendmode_blend
- let mode_add = sdl_blendmode_add
- let mode_mod = sdl_blendmode_mod
-
type operation = int
- let add = sdl_blendoperation_add
- let subtract = sdl_blendoperation_subtract
- let rev_subtract = sdl_blendoperation_rev_subtract
- let minimum = sdl_blendoperation_minimum
- let maximum = sdl_blendoperation_maximum
-
type factor = int
- let zero = sdl_blendfactor_zero
- let one = sdl_blendfactor_one
- let src_color = sdl_blendfactor_src_color
- let one_minus_src_color = sdl_blendfactor_one_minus_src_color
- let src_alpha = sdl_blendfactor_src_alpha
- let one_minus_src_alpha = sdl_blendfactor_one_minus_src_alpha
- let dst_color = sdl_blendfactor_dst_color
- let one_minus_dst_color = sdl_blendfactor_one_minus_dst_color
- let dst_alpha = sdl_blendfactor_dst_alpha
- let one_minus_dst_alpha = sdl_blendfactor_one_minus_dst_alpha
-
+ include C.Types.Blend
end
-let compose_custom_blend_mode =
- foreign "SDL_ComposeCustomBlendMode"
- (int @-> int @-> int @-> int @-> int @-> int @-> returning int)
+let compose_custom_blend_mode = C.Functions.compose_custom_blend_mode
module Pixel = struct
type format_enum = Unsigned.UInt32.t
- let i = Unsigned.UInt32.of_int32
let to_uint32 = Unsigned.UInt32.to_int32
let eq f f' = Unsigned.UInt32.(compare f f' = 0)
- let format_unknown = i sdl_pixelformat_unknown
- let format_index1lsb = i sdl_pixelformat_index1lsb
- let format_index1msb = i sdl_pixelformat_index1msb
- let format_index4lsb = i sdl_pixelformat_index4lsb
- let format_index4msb = i sdl_pixelformat_index4msb
- let format_index8 = i sdl_pixelformat_index8
- let format_rgb332 = i sdl_pixelformat_rgb332
- let format_rgb444 = i sdl_pixelformat_rgb444
- let format_rgb555 = i sdl_pixelformat_rgb555
- let format_bgr555 = i sdl_pixelformat_bgr555
- let format_argb4444 = i sdl_pixelformat_argb4444
- let format_rgba4444 = i sdl_pixelformat_rgba4444
- let format_abgr4444 = i sdl_pixelformat_abgr4444
- let format_bgra4444 = i sdl_pixelformat_bgra4444
- let format_argb1555 = i sdl_pixelformat_argb1555
- let format_rgba5551 = i sdl_pixelformat_rgba5551
- let format_abgr1555 = i sdl_pixelformat_abgr1555
- let format_bgra5551 = i sdl_pixelformat_bgra5551
- let format_rgb565 = i sdl_pixelformat_rgb565
- let format_bgr565 = i sdl_pixelformat_bgr565
- let format_rgb24 = i sdl_pixelformat_rgb24
- let format_bgr24 = i sdl_pixelformat_bgr24
- let format_rgb888 = i sdl_pixelformat_rgb888
- let format_rgbx8888 = i sdl_pixelformat_rgbx8888
- let format_bgr888 = i sdl_pixelformat_bgr888
- let format_bgrx8888 = i sdl_pixelformat_bgrx8888
- let format_argb8888 = i sdl_pixelformat_argb8888
- let format_rgba8888 = i sdl_pixelformat_rgba8888
- let format_abgr8888 = i sdl_pixelformat_abgr8888
- let format_bgra8888 = i sdl_pixelformat_bgra8888
- let format_argb2101010 = i sdl_pixelformat_argb2101010
- let format_yv12 = i sdl_pixelformat_yv12
- let format_iyuv = i sdl_pixelformat_iyuv
- let format_yuy2 = i sdl_pixelformat_yuy2
- let format_uyvy = i sdl_pixelformat_uyvy
- let format_yvyu = i sdl_pixelformat_yvyu
+ include C.Types.Pixel
end
(* Note. Giving direct access to the palette field of SDL_PixelFormat
is problematic. We can't ensure the pointer won't become invalid at
a certain point. *)
-type _pixel_format
-type pixel_format_struct = _pixel_format structure
-let pixel_format_struct : pixel_format_struct typ = structure "SDL_PixelFormat"
-let pf_format = field pixel_format_struct "format" uint32_t
-let pf_palette = field pixel_format_struct "palette" palette
-let pf_bits_per_pixel = field pixel_format_struct "BitsPerPixel" uint8_t
-let pf_bytes_per_pixel = field pixel_format_struct "BytesPerPixel" uint8_t
-let _ = field pixel_format_struct "padding" uint16_t
-let _ = field pixel_format_struct "Rmask" uint32_t
-let _ = field pixel_format_struct "Gmask" uint32_t
-let _ = field pixel_format_struct "Bmask" uint32_t
-let _ = field pixel_format_struct "Amask" uint32_t
-let _ = field pixel_format_struct "Rloss" uint8_t
-let _ = field pixel_format_struct "Gloss" uint8_t
-let _ = field pixel_format_struct "Bloss" uint8_t
-let _ = field pixel_format_struct "Aloss" uint8_t
-let _ = field pixel_format_struct "Rshift" uint8_t
-let _ = field pixel_format_struct "Gshift" uint8_t
-let _ = field pixel_format_struct "Bshift" uint8_t
-let _ = field pixel_format_struct "Ashift" uint8_t
-let _ = field pixel_format_struct "refcount" int
-let _ = field pixel_format_struct "next" (ptr pixel_format_struct)
-let () = seal pixel_format_struct
-
-type pixel_format = pixel_format_struct ptr
-let pixel_format : pixel_format typ = ptr pixel_format_struct
-let pixel_format_opt : pixel_format option typ = ptr_opt pixel_format_struct
+type pixel_format = C.Types.pixel_format ptr
let unsafe_pixel_format_of_ptr addr : pixel_format =
- from_voidp pixel_format_struct (ptr_of_raw_address addr)
+ from_voidp C.Types.pixel_format (ptr_of_raw_address addr)
let unsafe_ptr_of_pixel_format pixel_format =
raw_address_of_ptr (to_voidp pixel_format)
-let alloc_format =
- foreign "SDL_AllocFormat"
- (uint32_t @-> returning (some_to_ok pixel_format_opt))
+let alloc_format x = some_to_ok (C.Functions.alloc_format x)
-let free_format =
- foreign "SDL_FreeFormat" (pixel_format @-> returning void)
+let free_format = C.Functions.free_format
-let get_pixel_format_name =
- foreign "SDL_GetPixelFormatName" (uint32_t @-> returning string)
+let get_pixel_format_name = C.Functions.get_pixel_format_name
let get_pixel_format_format pf =
- getf (!@ pf) pf_format
+ getf (!@ pf) C.Types.pf_format
let get_pixel_format_bits_pp pf =
- Unsigned.UInt8.to_int (getf (!@ pf) pf_bits_per_pixel)
+ Unsigned.UInt8.to_int (getf (!@ pf) C.Types.pf_bits_per_pixel)
let get_pixel_format_bytes_pp pf =
- Unsigned.UInt8.to_int (getf (!@ pf) pf_bytes_per_pixel)
-
-let get_rgb =
- foreign "SDL_GetRGB"
- (int32_as_uint32_t @-> pixel_format @-> ptr uint8_t @->
- ptr uint8_t @-> ptr uint8_t @-> returning void)
+ Unsigned.UInt8.to_int (getf (!@ pf) C.Types.pf_bytes_per_pixel)
let get_rgb pf p =
let alloc () = allocate uint8_t Unsigned.UInt8.zero in
let to_int = Unsigned.UInt8.to_int in
let r, g, b = alloc (), alloc (), alloc () in
- get_rgb p pf r g b;
+ C.Functions.get_rgb (Unsigned.UInt32.of_int32 p) pf r g b;
to_int (!@ r), to_int (!@ g), to_int (!@ b)
-let get_rgba =
- foreign "SDL_GetRGBA"
- (int32_as_uint32_t @-> pixel_format @-> ptr uint8_t @->
- ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @-> returning void)
-
let get_rgba pf p =
let alloc () = allocate uint8_t Unsigned.UInt8.zero in
let to_int = Unsigned.UInt8.to_int in
let r, g, b, a = alloc (), alloc (), alloc (), alloc () in
- get_rgba p pf r g b a;
+ C.Functions.get_rgba (Unsigned.UInt32.of_int32 p) pf r g b a;
to_int (!@ r), to_int (!@ g), to_int (!@ b), to_int (!@ a)
-let map_rgb =
- foreign "SDL_MapRGB"
- (pixel_format @-> int_as_uint8_t @-> int_as_uint8_t @-> int_as_uint8_t @->
- returning int32_as_uint32_t)
-
-let map_rgba =
- foreign "SDL_MapRGBA"
- (pixel_format @-> int_as_uint8_t @-> int_as_uint8_t @-> int_as_uint8_t @->
- int_as_uint8_t @-> returning int32_as_uint32_t)
-
-let masks_to_pixel_format_enum =
- foreign "SDL_MasksToPixelFormatEnum"
- (int @-> int32_as_uint32_t @-> int32_as_uint32_t @-> int32_as_uint32_t @->
- int32_as_uint32_t @-> returning uint32_t)
-
-let pixel_format_enum_to_masks =
- foreign "SDL_PixelFormatEnumToMasks"
- (uint32_t @-> ptr int @->
- ptr uint32_t @-> ptr uint32_t @-> ptr uint32_t @-> ptr uint32_t @->
- returning bool)
-
let pixel_format_enum_to_masks pf =
let ui () = allocate uint32_t (Unsigned.UInt32.of_int 0) in
let get iptr = Unsigned.UInt32.to_int32 (!@ iptr) in
let bpp = allocate int 0 in
let rm, gm, bm, am = ui (), ui (), ui (), ui () in
- if not (pixel_format_enum_to_masks pf bpp rm gm bm am) then error () else
- Ok (!@ bpp, get rm, get gm, get bm, get am)
+ if not (C.Functions.pixel_format_enum_to_masks pf bpp rm gm bm am)
+ then error ()
+ else Ok (!@ bpp, get rm, get gm, get bm, get am)
+
+let map_rgb pf r g b =
+ Unsigned.UInt32.to_int32
+ (C.Functions.map_rgb
+ pf
+ (Unsigned.UInt8.of_int r)
+ (Unsigned.UInt8.of_int g)
+ (Unsigned.UInt8.of_int b))
+
+let map_rgba pf r g b a =
+ Unsigned.UInt32.to_int32
+ (C.Functions.map_rgba
+ pf
+ (Unsigned.UInt8.of_int r)
+ (Unsigned.UInt8.of_int g)
+ (Unsigned.UInt8.of_int b)
+ (Unsigned.UInt8.of_int a))
+
+let masks_to_pixel_format_enum bpp rm gm bm am =
+ C.Functions.masks_to_pixel_format_enum
+ bpp
+ (Unsigned.UInt32.of_int32 rm)
+ (Unsigned.UInt32.of_int32 gm)
+ (Unsigned.UInt32.of_int32 bm)
+ (Unsigned.UInt32.of_int32 am)
-let set_pixel_format_palette =
- foreign "SDL_SetPixelFormatPalette"
- (pixel_format @-> palette @-> returning zero_to_ok)
+let set_pixel_format_palette x y =
+ zero_to_ok (C.Functions.set_pixel_format_palette x y)
(* Surface *)
-type _surface
-type surface_struct = _surface structure
-let surface_struct : surface_struct typ = structure "SDL_Surface"
-let _ = field surface_struct "flags" uint32_t
-let surface_format = field surface_struct "format" pixel_format
-let surface_w = field surface_struct "w" int
-let surface_h = field surface_struct "h" int
-let surface_pitch = field surface_struct "pitch" int
-let surface_pixels = field surface_struct "pixels" (ptr void)
-let _ = field surface_struct "userdata" (ptr void)
-let _ = field surface_struct "locked" int
-let _ = field surface_struct "lock_data" (ptr void)
-let _ = field surface_struct "clip_rect" rect
-let _ = field surface_struct "map" (ptr void)
-let _ = field surface_struct "refcount" int
-let () = seal surface_struct
-
-type surface = surface_struct ptr
-let surface : surface typ = ptr surface_struct
-let surface_opt : surface option typ = ptr_opt surface_struct
+type surface = C.Types.surface ptr
let unsafe_surface_of_ptr addr : surface =
- from_voidp surface_struct (ptr_of_raw_address addr)
+ from_voidp C.Types.surface (ptr_of_raw_address addr)
let unsafe_ptr_of_surface surface =
raw_address_of_ptr (to_voidp surface)
-let blit_scaled =
- (* SDL_BlitScaled is #ifdef'd to SDL_UpperBlitScaled *)
- foreign "SDL_UpperBlitScaled"
- (surface @-> ptr rect @-> surface @-> ptr rect @-> returning zero_to_ok)
-
let blit_scaled ~src sr ~dst dr =
- blit_scaled src (Rect.opt_addr sr) dst (Rect.opt_addr dr)
-
-let blit_surface =
- (* SDL_BlitSurface is #ifdef'd to SDL_UpperBlit *)
- foreign "SDL_UpperBlit"
- (surface @-> ptr rect @-> surface @-> ptr rect @-> returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.blit_scaled src (Rect.opt_addr sr) dst (Rect.opt_addr dr))
let blit_surface ~src sr ~dst dr =
- blit_surface src (Rect.opt_addr sr) dst (Rect.opt_addr dr)
-
-let convert_pixels =
- foreign "SDL_ConvertPixels"
- (int @-> int @-> uint32_t @-> ptr void @-> int @-> uint32_t @->
- ptr void @-> int @-> returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.blit_surface src (Rect.opt_addr sr) dst (Rect.opt_addr dr))
let convert_pixels ~w ~h ~src sp spitch ~dst dp dpitch =
(* FIXME: we could try check bounds. *)
@@ -1013,145 +633,101 @@
let dpitch = ba_kind_byte_size (Bigarray.Array1.kind dp) * dpitch in
let sp = to_voidp (bigarray_start array1 sp) in
let dp = to_voidp (bigarray_start array1 dp) in
- convert_pixels w h src sp spitch dst dp dpitch
-
-let convert_surface =
- foreign "SDL_ConvertSurface"
- (surface @-> pixel_format @-> uint32_t @->
- returning (some_to_ok surface_opt))
+ zero_to_ok (C.Functions.convert_pixels w h src sp spitch dst dp dpitch)
let convert_surface s pf =
- convert_surface s pf Unsigned.UInt32.zero
-
-let convert_surface_format =
- foreign "SDL_ConvertSurfaceFormat"
- (surface @-> uint32_t @-> uint32_t @-> returning (some_to_ok surface_opt))
+ some_to_ok (C.Functions.convert_surface s pf Unsigned.UInt32.zero)
let convert_surface_format s pf =
- convert_surface_format s pf Unsigned.UInt32.zero
-
-let create_rgb_surface =
- foreign "SDL_CreateRGBSurface"
- (uint32_t @-> int @-> int @-> int @-> int32_as_uint32_t @->
- int32_as_uint32_t @-> int32_as_uint32_t @-> int32_as_uint32_t @->
- returning (some_to_ok surface_opt))
+ some_to_ok (C.Functions.convert_surface_format s pf Unsigned.UInt32.zero)
let create_rgb_surface ~w ~h ~depth rmask gmask bmask amask =
- create_rgb_surface Unsigned.UInt32.zero w h depth rmask gmask bmask amask
-
-let create_rgb_surface_from =
- foreign "SDL_CreateRGBSurfaceFrom"
- (ptr void @-> int @-> int @-> int @-> int @-> int32_as_uint32_t @->
- int32_as_uint32_t @-> int32_as_uint32_t @-> int32_as_uint32_t @->
- returning (some_to_ok surface_opt))
+ some_to_ok
+ (C.Functions.create_rgb_surface
+ Unsigned.UInt32.zero w h depth
+ (Unsigned.UInt32.of_int32 rmask)
+ (Unsigned.UInt32.of_int32 gmask)
+ (Unsigned.UInt32.of_int32 bmask)
+ (Unsigned.UInt32.of_int32 amask))
let create_rgb_surface_from p ~w ~h ~depth ~pitch rmask gmask bmask amask =
(* FIXME: we could try check bounds. *)
let pitch = ba_kind_byte_size (Bigarray.Array1.kind p) * pitch in
let p = to_voidp (bigarray_start array1 p) in
- create_rgb_surface_from p w h depth pitch rmask gmask bmask amask
-
-let create_rgb_surface_with_format =
- foreign "SDL_CreateRGBSurfaceWithFormat"
- (uint32_t @-> int @-> int @-> int @-> uint32_t @->
- returning (some_to_ok surface_opt))
+ some_to_ok
+ (C.Functions.create_rgb_surface_from
+ p w h depth pitch
+ (Unsigned.UInt32.of_int32 rmask)
+ (Unsigned.UInt32.of_int32 gmask)
+ (Unsigned.UInt32.of_int32 bmask)
+ (Unsigned.UInt32.of_int32 amask))
let create_rgb_surface_with_format ~w ~h ~depth format =
- create_rgb_surface_with_format Unsigned.UInt32.zero w h depth format
-
-let create_rgb_surface_with_format_from =
- foreign "SDL_CreateRGBSurfaceWithFormatFrom"
- (ptr void @-> int @-> int @-> int @-> int @-> uint32_t @->
- returning (some_to_ok surface_opt))
+ some_to_ok
+ (C.Functions.create_rgb_surface_with_format
+ Unsigned.UInt32.zero w h depth format)
let create_rgb_surface_with_format_from p ~w ~h ~depth ~pitch format =
(* FIXME: check bounds? *)
let pitch = ba_kind_byte_size (Bigarray.Array1.kind p) * pitch in
let p = to_voidp (bigarray_start array1 p) in
- create_rgb_surface_with_format_from p w h depth pitch format
-
-let duplicate_surface =
- foreign "SDL_DuplicateSurface" (surface @-> returning surface)
+ some_to_ok
+ (C.Functions.create_rgb_surface_with_format_from p w h depth pitch format)
-let fill_rect =
- foreign "SDL_FillRect"
- (surface @-> ptr rect @-> int32_as_uint32_t @-> returning zero_to_ok)
+let duplicate_surface = C.Functions.duplicate_surface
let fill_rect s r c =
- fill_rect s (Rect.opt_addr r) c
-
-let fill_rects =
- foreign "SDL_FillRects"
- (surface @-> ptr void @-> int @-> int32_as_uint32_t @->
- returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.fill_rect s (Rect.opt_addr r) (Unsigned.UInt32.of_int32 c))
let fill_rects_ba s rs col =
let len = Bigarray.Array1.dim rs in
if len mod 4 <> 0 then invalid_arg (err_length_mul len 4) else
let count = len / 4 in
let rs = to_voidp (bigarray_start array1 rs) in
- fill_rects s rs count col
+ zero_to_ok (C.Functions.fill_rects s rs count (Unsigned.UInt32.of_int32 col))
let fill_rects s rs col =
- let a = CArray.of_list rect rs in
- fill_rects s (to_voidp (CArray.start a)) (CArray.length a) col
+ let a = CArray.of_list C.Types.Rect.t rs in
+ let col = Unsigned.UInt32.of_int32 col in
+ zero_to_ok
+ (C.Functions.fill_rects s (to_voidp (CArray.start a)) (CArray.length a) col)
-let free_surface =
- foreign "SDL_FreeSurface" (surface @-> returning void)
-
-let get_clip_rect =
- foreign "SDL_GetClipRect" (surface @-> ptr rect @-> returning void)
+let free_surface = C.Functions.free_surface
let get_clip_rect s =
- let r = make rect in
- (get_clip_rect s (addr r); r)
-
-let get_color_key =
- foreign "SDL_GetColorKey"
- (surface @-> ptr uint32_t @-> returning zero_to_ok)
+ let r = make C.Types.Rect.t in
+ (C.Functions.get_clip_rect s (addr r); r)
let get_color_key s =
let key = allocate uint32_t Unsigned.UInt32.zero in
- match get_color_key s key with
- | Ok () -> Ok (Unsigned.UInt32.to_int32 (!@ key)) | Error _ as e -> e
-
-let get_surface_alpha_mod =
- foreign "SDL_GetSurfaceAlphaMod"
- (surface @-> ptr uint8_t @-> returning zero_to_ok)
+ match C.Functions.get_color_key s key with
+ | 0 -> Ok (Unsigned.UInt32.to_int32 (!@ key)) | _ -> error ()
let get_surface_alpha_mod s =
let alpha = allocate uint8_t Unsigned.UInt8.zero in
- match get_surface_alpha_mod s alpha with
- | Ok () -> Ok (Unsigned.UInt8.to_int (!@ alpha)) | Error _ as e -> e
-
-let get_surface_blend_mode =
- foreign "SDL_GetSurfaceBlendMode"
- (surface @-> ptr int @-> returning zero_to_ok)
+ match C.Functions.get_surface_alpha_mod s alpha with
+ | 0 -> Ok (Unsigned.UInt8.to_int (!@ alpha)) | _ -> error ()
let get_surface_blend_mode s =
- let mode = allocate int 0 in
- match get_surface_blend_mode s mode with
- Ok () -> Ok (!@ mode) | Error _ as e -> e
-
-let get_surface_color_mod =
- foreign "SDL_GetSurfaceColorMod"
- (surface @-> ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @->
- returning zero_to_ok)
+ let mode = allocate Blend.mode Blend.mode_invalid in
+ match C.Functions.get_surface_blend_mode s mode with
+ 0 -> Ok (!@ mode) | _ -> error ()
let get_surface_color_mod s =
let alloc () = allocate uint8_t Unsigned.UInt8.zero in
let get v = Unsigned.UInt8.to_int (!@ v) in
let r, g, b = alloc (), alloc (), alloc () in
- match get_surface_color_mod s r g b with
- | Ok () -> Ok (get r, get g, get b) | Error _ as e -> e
+ match C.Functions.get_surface_color_mod s r g b with
+ | 0 -> Ok (get r, get g, get b) | _ -> error ()
let get_surface_format_enum s =
(* We don't give direct access to the format field. This prevents
memory ownership problems. *)
- get_pixel_format_format (getf (!@ s) surface_format)
+ get_pixel_format_format (getf (!@ s) C.Types.surface_format)
let get_surface_pitch s =
- getf (!@ s) surface_pitch
+ getf (!@ s) C.Types.surface_pitch
let get_surface_pixels s kind =
let pitch = get_surface_pitch s in
@@ -1159,21 +735,17 @@
if pitch mod kind_size <> 0
then invalid_arg (err_bigarray_pitch pitch kind_size)
else
- let h = getf (!@ s) surface_h in
+ let h = getf (!@ s) C.Types.surface_h in
let ba_size = (pitch * h) / kind_size in
- let pixels = getf (!@ s) surface_pixels in
+ let pixels = getf (!@ s) C.Types.surface_pixels in
let pixels = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) pixels in
bigarray_of_ptr array1 ba_size kind pixels
let get_surface_size s =
- getf (!@ s) surface_w, getf (!@ s) surface_h
-
-let load_bmp_rw =
- foreign "SDL_LoadBMP_RW"
- (rw_ops @-> bool @-> returning (some_to_ok surface_opt))
+ getf (!@ s) C.Types.surface_w, getf (!@ s) C.Types.surface_h
let load_bmp_rw rw ~close =
- load_bmp_rw rw close
+ some_to_ok (C.Functions.load_bmp_rw rw close)
let load_bmp file =
(* SDL_LoadBMP is cpp based *)
@@ -1181,29 +753,17 @@
| Error _ as e -> e
| Ok rw -> load_bmp_rw rw ~close:true
-let lock_surface =
- foreign "SDL_LockSurface" (surface @-> returning zero_to_ok)
-
-let lower_blit =
- foreign "SDL_LowerBlit"
- (surface @-> ptr rect @-> surface @-> ptr rect @-> returning zero_to_ok)
+let lock_surface x = zero_to_ok (C.Functions.lock_surface x)
let lower_blit ~src sr ~dst dr =
- lower_blit src (addr sr) dst (addr dr)
-
-let lower_blit_scaled =
- foreign "SDL_LowerBlitScaled"
- (surface @-> ptr rect @-> surface @-> ptr rect @-> returning zero_to_ok)
+ zero_to_ok (C.Functions.lower_blit src (addr sr) dst (addr dr))
let lower_blit_scaled ~src sr ~dst dr =
- lower_blit_scaled src (addr sr) dst (addr dr)
-
-let save_bmp_rw =
- foreign "SDL_SaveBMP_RW"
- (surface @-> rw_ops @-> bool @-> returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.lower_blit_scaled src (addr sr) dst (addr dr))
let save_bmp_rw s rw ~close =
- save_bmp_rw s rw close
+ zero_to_ok (C.Functions.save_bmp_rw s rw close)
let save_bmp s file =
(* SDL_SaveBMP is cpp based *)
@@ -1211,81 +771,65 @@
| Error _ as e -> e
| Ok rw -> save_bmp_rw s rw ~close:true
-let set_clip_rect =
- foreign "SDL_SetClipRect" (surface @-> ptr rect @-> returning bool)
-
let set_clip_rect s r =
- set_clip_rect s (addr r)
+ C.Functions.set_clip_rect s (addr r)
+
+let set_color_key s b x =
+ zero_to_ok (C.Functions.set_color_key s b (Unsigned.UInt32.of_int32 x))
+
+let set_surface_alpha_mod s x =
+ zero_to_ok (C.Functions.set_surface_alpha_mod s (Unsigned.UInt8.of_int x))
-let set_color_key =
- foreign "SDL_SetColorKey"
- (surface @-> bool @-> int32_as_uint32_t @-> returning zero_to_ok)
-
-let set_surface_alpha_mod =
- foreign "SDL_SetSurfaceAlphaMod"
- (surface @-> int_as_uint8_t @-> returning zero_to_ok)
-
-let set_surface_blend_mode =
- foreign "SDL_SetSurfaceBlendMode"
- (surface @-> int @-> returning zero_to_ok)
-
-let set_surface_color_mod =
- foreign "SDL_SetSurfaceColorMod"
- (surface @-> int_as_uint8_t @-> int_as_uint8_t @-> int_as_uint8_t @->
- returning zero_to_ok)
-
-let set_surface_palette =
- foreign "SDL_SetSurfacePalette"
- (surface @-> palette @-> returning zero_to_ok)
+let set_surface_blend_mode s x =
+ zero_to_ok (C.Functions.set_surface_blend_mode s x)
-let set_surface_rle =
- foreign "SDL_SetSurfaceRLE" (surface @-> bool @-> returning zero_to_ok)
+let set_surface_color_mod s x y z =
+ zero_to_ok
+ (C.Functions.set_surface_color_mod
+ s
+ (Unsigned.UInt8.of_int x)
+ (Unsigned.UInt8.of_int y)
+ (Unsigned.UInt8.of_int z))
-let unlock_surface =
- foreign "SDL_UnlockSurface" (surface @-> returning void)
+let set_surface_palette s p =
+ zero_to_ok (C.Functions.set_surface_palette s p)
+
+let set_surface_rle s b =
+ zero_to_ok (C.Functions.set_surface_rle s b)
+
+let unlock_surface = C.Functions.unlock_surface
(* Renderers *)
type flip = int
module Flip = struct
let ( + ) = ( lor )
- let none = sdl_flip_none
- let horizontal = sdl_flip_horizontal
- let vertical = sdl_flip_vertical
+ include C.Types.Flip
end
-type texture = unit ptr
-let texture : texture typ = ptr void
-let texture_opt : texture option typ = ptr_opt void
+type texture = C.Types.Texture.t ptr
let unsafe_texture_of_ptr addr : texture =
- ptr_of_raw_address addr
+ from_voidp C.Types.Texture.t (ptr_of_raw_address addr)
let unsafe_ptr_of_texture texture =
raw_address_of_ptr (to_voidp texture)
-type renderer = unit ptr
-let renderer : renderer typ = ptr void
-let renderer_opt : renderer option typ = ptr_opt void
-
-let unsafe_renderer_of_ptr addr : renderer =
- ptr_of_raw_address addr
-let unsafe_ptr_of_renderer renderer =
- raw_address_of_ptr (to_voidp renderer)
-
module Renderer = struct
type flags = Unsigned.uint32
- let i = Unsigned.UInt32.of_int
let ( + ) = Unsigned.UInt32.logor
let ( - ) f f' = Unsigned.UInt32.(logand f (lognot f'))
let test f m = Unsigned.UInt32.(compare (logand f m) zero <> 0)
let eq f f' = Unsigned.UInt32.(compare f f' = 0)
- let none = Unsigned.UInt32.zero
- let software = i sdl_renderer_software
- let accelerated = i sdl_renderer_accelerated
- let presentvsync = i sdl_renderer_presentvsync
- let targettexture = i sdl_renderer_targettexture
+ include C.Types.Renderer
end
+type renderer = Renderer.t ptr
+
+let unsafe_renderer_of_ptr addr : renderer =
+ from_voidp Renderer.t (Ctypes.ptr_of_raw_address addr)
+let unsafe_ptr_of_renderer renderer =
+ raw_address_of_ptr (to_voidp renderer)
+
type renderer_info =
{ ri_name : string;
ri_flags : Renderer.flags;
@@ -1293,268 +837,177 @@
ri_max_texture_width : int;
ri_max_texture_height : int; }
-let renderer_info = structure "SDL_RendererInfo"
-let ri_name = field renderer_info "name" string
-let ri_flags = field renderer_info "flags" uint32_t
-let ri_num_tf = field renderer_info "num_texture_formats" uint32_t
-let ri_tfs = field renderer_info "texture_formats" (array 16 uint32_t)
-let ri_max_texture_width = field renderer_info "max_texture_width" int
-let ri_max_texture_height = field renderer_info "max_texture_height" int
-let () = seal renderer_info
-
let renderer_info_of_c c =
- let ri_name = getf c ri_name in
- let ri_flags = getf c ri_flags in
- let num_tf = Unsigned.UInt32.to_int (getf c ri_num_tf) in
- let tfs = getf c ri_tfs in
+ let ri_name = getf c C.Types.ri_name in
+ let ri_flags = getf c C.Types.ri_flags in
+ let num_tf = Unsigned.UInt32.to_int (getf c C.Types.ri_num_tf) in
+ let tfs = getf c C.Types.ri_tfs in
let ri_texture_formats =
let acc = ref [] in
for i = 0 to num_tf - 1 do acc := (CArray.get tfs i) :: !acc done;
List.rev !acc
in
- let ri_max_texture_width = getf c ri_max_texture_width in
- let ri_max_texture_height = getf c ri_max_texture_height in
+ let ri_max_texture_width = getf c C.Types.ri_max_texture_width in
+ let ri_max_texture_height = getf c C.Types.ri_max_texture_height in
{ ri_name; ri_flags; ri_texture_formats; ri_max_texture_width;
ri_max_texture_height }
-let create_renderer =
- foreign "SDL_CreateRenderer"
- (window @-> int @-> uint32_t @-> returning (some_to_ok renderer_opt))
-
let create_renderer ?(index = -1) ?(flags = Unsigned.UInt32.zero) w =
- create_renderer w index flags
+ some_to_ok (C.Functions.create_renderer w index flags)
-let create_software_renderer =
- foreign "SDL_CreateSoftwareRenderer"
- (surface @-> returning (some_to_ok renderer_opt))
+let create_software_renderer s =
+ some_to_ok (C.Functions.create_software_renderer s)
-let destroy_renderer =
- foreign "SDL_DestroyRenderer" (renderer @-> returning void)
+let destroy_renderer = C.Functions.destroy_renderer
-let get_num_render_drivers =
- foreign "SDL_GetNumRenderDrivers" (void @-> returning nat_to_ok)
-
-let get_render_draw_blend_mode =
- foreign "SDL_GetRenderDrawBlendMode"
- (renderer @-> ptr int @-> returning zero_to_ok)
+let get_num_render_drivers () =
+ nat_to_ok (C.Functions.get_num_render_drivers ())
let get_render_draw_blend_mode r =
- let m = allocate int 0 in
- match get_render_draw_blend_mode r m with
- | Ok () -> Ok !@m | Error _ as e -> e
-
-let get_render_draw_color =
- foreign "SDL_GetRenderDrawColor"
- (renderer @-> ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @->
- ptr uint8_t @-> returning zero_to_ok)
+ let m = allocate Blend.mode Blend.mode_invalid in
+ match C.Functions.get_render_draw_blend_mode r m with
+ | 0 -> Ok !@m | _ -> error ()
let get_render_draw_color rend =
let alloc () = allocate uint8_t Unsigned.UInt8.zero in
let get v = Unsigned.UInt8.to_int (!@ v) in
let r, g, b, a = alloc (), alloc (), alloc (), alloc () in
- match get_render_draw_color rend r g b a with
- | Ok () -> Ok (get r, get g, get b, get a) | Error _ as e -> e
-
-let get_render_driver_info =
- foreign "SDL_GetRenderDriverInfo"
- (int @-> ptr renderer_info @-> returning zero_to_ok)
+ match C.Functions.get_render_draw_color rend r g b a with
+ | 0 -> Ok (get r, get g, get b, get a) | _ -> error ()
let get_render_driver_info i =
- let info = make renderer_info in
- match get_render_driver_info i (addr info) with
- | Ok () -> Ok (renderer_info_of_c info) | Error _ as e -> e
-
-let get_render_target =
- foreign "SDL_GetRenderTarget" (renderer @-> returning texture_opt)
-
-let get_renderer =
- foreign "SDL_GetRenderer"
- (window @-> returning (some_to_ok renderer_opt))
-
-let get_renderer_info =
- foreign "SDL_GetRendererInfo"
- (renderer @-> ptr renderer_info @-> returning zero_to_ok)
+ let info = make C.Types.renderer_info in
+ match C.Functions.get_render_driver_info i (addr info) with
+ | 0 -> Ok (renderer_info_of_c info) | _ -> error ()
+
+let get_render_target = C.Functions.get_render_target
+
+let get_renderer w =
+ some_to_ok (C.Functions.get_renderer w)
let get_renderer_info r =
- let info = make renderer_info in
- match get_renderer_info r (addr info) with
- | Ok () -> Ok (renderer_info_of_c info) | Error _ as e -> e
-
-let get_renderer_output_size =
- foreign "SDL_GetRendererOutputSize"
- (renderer @-> ptr int @-> ptr int @-> returning zero_to_ok)
+ let info = make C.Types.renderer_info in
+ match C.Functions.get_renderer_info r (addr info) with
+ | 0 -> Ok (renderer_info_of_c info) | _ -> error ()
let get_renderer_output_size r =
let w = allocate int 0 in
let h = allocate int 0 in
- match get_renderer_output_size r w h with
- | Ok () -> Ok (!@ w, !@ h) | Error _ as e -> e
-
-let render_clear =
- foreign "SDL_RenderClear" (renderer @-> returning zero_to_ok)
+ match C.Functions.get_renderer_output_size r w h with
+ | 0 -> Ok (!@ w, !@ h) | _ -> error ()
-let render_copy =
- foreign "SDL_RenderCopy"
- (renderer @-> texture @-> ptr rect @-> ptr rect @->
- returning zero_to_ok)
+let render_clear r =
+ zero_to_ok (C.Functions.render_clear r)
let render_copy ?src ?dst r t =
- render_copy r t (Rect.opt_addr src) (Rect.opt_addr dst)
-
-let render_copy_ex =
- foreign "SDL_RenderCopyEx"
- (renderer @-> texture @-> ptr rect @-> ptr rect @-> double @->
- ptr point @-> int @-> returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.render_copy r t (Rect.opt_addr src) (Rect.opt_addr dst))
let render_copy_ex ?src ?dst r t angle c flip =
- render_copy_ex r t (Rect.opt_addr src) (Rect.opt_addr dst) angle
- (Point.opt_addr c) flip
+ zero_to_ok
+ (C.Functions.render_copy_ex r t (Rect.opt_addr src) (Rect.opt_addr dst)
+ angle (Point.opt_addr c) flip)
-let render_draw_line =
- foreign "SDL_RenderDrawLine"
- (renderer @-> int @-> int @-> int @-> int @-> returning zero_to_ok)
-
-let render_draw_line_f =
- foreign "SDL_RenderDrawLineF"
- (renderer @-> float @-> float @-> float @-> float @-> returning zero_to_ok)
-
-let render_draw_lines =
- foreign "SDL_RenderDrawLines"
- (renderer @-> ptr void @-> int @-> returning zero_to_ok)
+let render_draw_line r a b c d =
+ zero_to_ok (C.Functions.render_draw_line r a b c d)
+
+let render_draw_line_f r a b c d =
+ zero_to_ok (C.Functions.render_draw_line_f r a b c d)
let render_draw_lines_ba r ps =
let len = Bigarray.Array1.dim ps in
if len mod 2 <> 0 then invalid_arg (err_length_mul len 2) else
let count = len / 2 in
let ps = to_voidp (bigarray_start array1 ps) in
- render_draw_lines r ps count
+ zero_to_ok (C.Functions.render_draw_lines r ps count)
let render_draw_lines r ps =
- let a = CArray.of_list point ps in
- render_draw_lines r (to_voidp (CArray.start a)) (CArray.length a)
+ let a = CArray.of_list C.Types.Point.t ps in
+ zero_to_ok (C.Functions.render_draw_lines
+ r (to_voidp (CArray.start a)) (CArray.length a))
-let render_draw_point =
- foreign "SDL_RenderDrawPoint"
- (renderer @-> int @-> int @-> returning zero_to_ok)
-
-let render_draw_points =
- foreign "SDL_RenderDrawPoints"
- (renderer @-> ptr void @-> int @-> returning zero_to_ok)
+let render_draw_point r a b =
+ zero_to_ok (C.Functions.render_draw_point r a b)
let render_draw_points_ba r ps =
let len = Bigarray.Array1.dim ps in
if len mod 2 <> 0 then invalid_arg (err_length_mul len 2) else
let count = len / 2 in
let ps = to_voidp (bigarray_start array1 ps) in
- render_draw_points r ps count
+ zero_to_ok (C.Functions.render_draw_points r ps count)
let render_draw_points r ps =
- let a = CArray.of_list point ps in
- render_draw_points r (to_voidp (CArray.start a)) (CArray.length a)
+ let a = CArray.of_list C.Types.Point.t ps in
+ zero_to_ok (C.Functions.render_draw_points
+ r (to_voidp (CArray.start a)) (CArray.length a))
-let render_draw_point_f =
- foreign "SDL_RenderDrawPointF"
- (renderer @-> float @-> float @-> returning zero_to_ok)
-
-let render_draw_points_f =
- foreign "SDL_RenderDrawPointsF"
- (renderer @-> ptr void @-> int @-> returning zero_to_ok)
+let render_draw_point_f r a b =
+ zero_to_ok (C.Functions.render_draw_point_f r a b)
let render_draw_points_f_ba r ps =
let len = Bigarray.Array1.dim ps in
if len mod 2 <> 0 then invalid_arg (err_length_mul len 2) else
let count = len / 2 in
let ps = to_voidp (bigarray_start array1 ps) in
- render_draw_points_f r ps count
+ zero_to_ok (C.Functions.render_draw_points_f r ps count)
let render_draw_points_f r ps =
- let a = CArray.of_list fpoint ps in
- render_draw_points_f r (to_voidp (CArray.start a)) (CArray.length a)
-
-let render_draw_rect =
- foreign "SDL_RenderDrawRect"
- (renderer @-> ptr rect @-> returning zero_to_ok)
+ let a = CArray.of_list C.Types.Fpoint.t ps in
+ zero_to_ok (C.Functions.render_draw_points_f
+ r (to_voidp (CArray.start a)) (CArray.length a))
let render_draw_rect rend r =
- render_draw_rect rend (Rect.opt_addr r)
-
-let render_draw_rects =
- foreign "SDL_RenderDrawRects"
- (renderer @-> ptr void @-> int @-> returning zero_to_ok)
+ zero_to_ok (C.Functions.render_draw_rect rend (Rect.opt_addr r))
let render_draw_rects_ba r rs =
let len = Bigarray.Array1.dim rs in
if len mod 4 <> 0 then invalid_arg (err_length_mul len 4) else
let count = len / 4 in
let rs = to_voidp (bigarray_start array1 rs) in
- render_draw_rects r rs count
+ zero_to_ok (C.Functions.render_draw_rects r rs count)
let render_draw_rects r rs =
- let a = CArray.of_list rect rs in
- render_draw_rects r (to_voidp (CArray.start a)) (CArray.length a)
-
-let render_fill_rect =
- foreign "SDL_RenderFillRect"
- (renderer @-> ptr rect @-> returning zero_to_ok)
+ let a = CArray.of_list C.Types.Rect.t rs in
+ zero_to_ok (C.Functions.render_draw_rects
+ r (to_voidp (CArray.start a)) (CArray.length a))
let render_fill_rect rend r =
- render_fill_rect rend (Rect.opt_addr r)
-
-let render_fill_rects =
- foreign "SDL_RenderFillRects"
- (renderer @-> ptr void @-> int @-> returning zero_to_ok)
+ zero_to_ok (C.Functions.render_fill_rect rend (Rect.opt_addr r))
let render_fill_rects_ba r rs =
let len = Bigarray.Array1.dim rs in
if len mod 4 <> 0 then invalid_arg (err_length_mul len 4) else
let count = len / 4 in
let rs = to_voidp (bigarray_start array1 rs) in
- render_fill_rects r rs count
+ zero_to_ok (C.Functions.render_fill_rects r rs count)
let render_fill_rects r rs =
- let a = CArray.of_list rect rs in
- render_fill_rects r (to_voidp (CArray.start a)) (CArray.length a)
-
-let render_geometry =
- foreign "SDL_RenderGeometry"
- (renderer @-> texture @-> ptr void @-> int @-> ptr void @-> int @->
- returning zero_to_ok)
+ let a = CArray.of_list C.Types.Rect.t rs in
+ zero_to_ok (C.Functions.render_fill_rects
+ r (to_voidp (CArray.start a)) (CArray.length a))
let render_geometry ?indices ?texture r vertices =
- let a1 = CArray.of_list vertex vertices in
- let t = match texture with
- | None -> null | Some texture -> texture
- in
+ let a1 = CArray.of_list C.Types.Vertex.t vertices in
let a2_ptr, a2_len = match indices with
- | None -> (null, 0)
+ | None -> (None, 0)
| Some is ->
let a2 = CArray.of_list int is in
- (to_voidp (CArray.start a2), CArray.length a2)
+ (Some (CArray.start a2), CArray.length a2)
in
- render_geometry
- r t (to_voidp (CArray.start a1)) (CArray.length a1) a2_ptr a2_len
-
-let render_geometry_raw =
- foreign "SDL_RenderGeometryRaw"
- (renderer @-> texture @->
- ptr void @-> int @->
- ptr void @-> int @->
- ptr void @-> int @->
- int @-> ptr void @-> int @-> int @-> returning zero_to_ok)
+ zero_to_ok
+ (C.Functions.render_geometry
+ r texture (CArray.start a1) (CArray.length a1) a2_ptr a2_len)
let render_geometry_raw
?indices ?texture r ~xy ?(xy_stride = 8) ~color ?(color_stride = 4)
~uv ?(uv_stride = 8) ~num_vertices ()
=
- let t = match texture with
- | None -> null | Some texture -> texture
- in
let i_ptr, i_len = match indices with
| None -> null, 0
| Some is -> to_voidp (bigarray_start array1 is), Bigarray.Array1.dim is
in
let i_stride = 4 in (* indices are assumed to be 4-byte integers *)
- let xy_ptr = to_voidp (bigarray_start array1 xy) in
+ let xy_ptr = bigarray_start array1 xy in
let xy_len_bytes = Bigarray.Array1.dim xy * 4 in
let xy_exp_bytes = num_vertices * xy_stride - (xy_stride - 8) in
if xy_len_bytes < xy_exp_bytes then begin
@@ -1570,7 +1023,7 @@
in
invalid_arg msg
end;
- let uv_ptr = to_voidp (bigarray_start array1 uv) in
+ let uv_ptr = bigarray_start array1 uv in
let uv_len_bytes = Bigarray.Array1.dim uv * 4 in
let uv_exp_bytes = num_vertices * uv_stride - (uv_stride - 8) in
if uv_len_bytes < uv_exp_bytes then begin
@@ -1579,191 +1032,114 @@
in
invalid_arg msg
end;
- render_geometry_raw
- r t xy_ptr xy_stride color_ptr color_stride uv_ptr uv_stride num_vertices
- i_ptr i_len i_stride
-
-let render_get_clip_rect =
- foreign "SDL_RenderGetClipRect"
- (renderer @-> ptr rect @-> returning void)
+ zero_to_ok
+ (C.Functions.render_geometry_raw
+ r texture xy_ptr xy_stride color_ptr color_stride uv_ptr uv_stride
+ num_vertices i_ptr i_len i_stride)
let render_get_clip_rect rend =
- let r = make rect in
- render_get_clip_rect rend (addr r);
+ let r = make C.Types.Rect.t in
+ C.Functions.render_get_clip_rect rend (addr r);
r
-let render_is_clip_enabled =
- foreign "SDL_RenderIsClipEnabled" (renderer @-> returning bool)
+let render_is_clip_enabled = C.Functions.render_is_clip_enabled
-let render_get_integer_scale =
- foreign "SDL_RenderGetIntegerScale"
- (renderer @-> returning bool)
-
-let render_get_logical_size =
- foreign "SDL_RenderGetLogicalSize"
- (renderer @-> ptr int @-> ptr int @-> returning void)
+let render_get_integer_scale = C.Functions.render_get_integer_scale
let render_get_logical_size r =
let w = allocate int 0 in
let h = allocate int 0 in
- render_get_logical_size r w h;
+ C.Functions.render_get_logical_size r w h;
!@ w, !@ h
-let render_get_scale =
- foreign "SDL_RenderGetScale"
- (renderer @-> ptr float @-> ptr float @-> returning void)
-
let render_get_scale r =
let x = allocate float 0. in
let y = allocate float 0. in
- render_get_scale r x y;
+ C.Functions.render_get_scale r x y;
!@ x, !@ y
-let render_get_viewport =
- foreign "SDL_RenderGetViewport"
- (renderer @-> ptr rect @-> returning void)
-
let render_get_viewport rend =
- let r = make rect in
- render_get_viewport rend (addr r);
+ let r = make C.Types.Rect.t in
+ C.Functions.render_get_viewport rend (addr r);
r
-let render_present =
- foreign ~release_runtime_lock:true "SDL_RenderPresent"
- (renderer @-> returning void)
-
-let render_read_pixels =
- foreign "SDL_RenderReadPixels"
- (renderer @-> ptr rect @-> uint32_t @-> ptr void @-> int @->
- returning zero_to_ok)
+let render_present = C.Async_functions.render_present
let render_read_pixels r rect format pixels pitch =
let format = match format with None -> Unsigned.UInt32.zero | Some f -> f in
let pixels = to_voidp (bigarray_start array1 pixels) in
- render_read_pixels r (Rect.opt_addr rect) format pixels pitch
-
-let render_set_clip_rect =
- foreign "SDL_RenderSetClipRect"
- (renderer @-> ptr rect @-> returning zero_to_ok)
+ zero_to_ok (C.Functions.render_read_pixels
+ r (Rect.opt_addr rect) format pixels pitch)
let render_set_clip_rect rend r =
- render_set_clip_rect rend (Rect.opt_addr r)
+ zero_to_ok (C.Functions.render_set_clip_rect rend (Rect.opt_addr r))
+
+let render_set_integer_scale r b =
+ zero_to_ok (C.Functions.render_set_integer_scale r b)
+
+let render_set_logical_size r x y =
+ zero_to_ok (C.Functions.render_set_logical_size r x y)
-let render_set_integer_scale =
- foreign "SDL_RenderSetIntegerScale"
- (renderer @-> bool @-> returning zero_to_ok)
-
-let render_set_logical_size =
- foreign "SDL_RenderSetLogicalSize"
- (renderer @-> int @-> int @-> returning zero_to_ok)
-
-let render_set_scale =
- foreign "SDL_RenderSetScale"
- (renderer @-> float @-> float @-> returning zero_to_ok)
-
-let render_set_viewport =
- foreign "SDL_RenderSetViewport"
- (renderer @-> ptr rect @-> returning zero_to_ok)
+let render_set_scale r x y =
+ zero_to_ok (C.Functions.render_set_scale r x y)
let render_set_viewport rend r =
- render_set_viewport rend (Rect.opt_addr r)
+ zero_to_ok (C.Functions.render_set_viewport rend (Rect.opt_addr r))
-let render_target_supported =
- foreign "SDL_RenderTargetSupported" (renderer @-> returning bool)
+let render_target_supported = C.Functions.render_target_supported
-let set_render_draw_blend_mode =
- foreign "SDL_SetRenderDrawBlendMode"
- (renderer @-> int @-> returning zero_to_ok)
-
-let set_render_draw_color =
- foreign "SDL_SetRenderDrawColor"
- (renderer @-> int_as_uint8_t @-> int_as_uint8_t @-> int_as_uint8_t @->
- int_as_uint8_t @-> returning zero_to_ok)
-
-let set_render_target =
- foreign "SDL_SetRenderTarget"
- (renderer @-> texture @-> returning zero_to_ok)
+let set_render_draw_blend_mode r x =
+ zero_to_ok (C.Functions.set_render_draw_blend_mode r x)
+
+let set_render_draw_color r a b c d =
+ zero_to_ok (C.Functions.set_render_draw_color r
+ (Unsigned.UInt8.of_int a)
+ (Unsigned.UInt8.of_int b)
+ (Unsigned.UInt8.of_int c)
+ (Unsigned.UInt8.of_int d))
let set_render_target r t =
- let t = match t with None -> null | Some t -> t in
- set_render_target r t
+ zero_to_ok (C.Functions.set_render_target r t)
(* Textures *)
module Texture = struct
type access = int
- let access_static = sdl_textureaccess_static
- let access_streaming = sdl_textureaccess_streaming
- let access_target = sdl_textureaccess_target
-
- let i = Unsigned.UInt32.of_int
type modulate = Unsigned.uint32
- let modulate_none = i sdl_texturemodulate_none
- let modulate_color = i sdl_texturemodulate_color
- let modulate_alpha = i sdl_texturemodulate_alpha
+ include C.Types.Texture
end
-let create_texture =
- foreign "SDL_CreateTexture"
- (renderer @-> uint32_t @-> int @-> int @-> int @->
- returning (some_to_ok renderer_opt))
-
let create_texture r pf access ~w ~h =
- create_texture r pf access w h
+ some_to_ok (C.Functions.create_texture r pf access w h)
-let create_texture_from_surface =
- foreign "SDL_CreateTextureFromSurface"
- (renderer @-> surface @-> returning (some_to_ok texture_opt))
-
-let destroy_texture =
- foreign "SDL_DestroyTexture" (texture @-> returning void)
-
-let get_texture_alpha_mod =
- foreign "SDL_GetTextureAlphaMod"
- (texture @-> ptr uint8_t @-> returning zero_to_ok)
+let create_texture_from_surface r s =
+ some_to_ok (C.Functions.create_texture_from_surface r s)
+
+let destroy_texture = C.Functions.destroy_texture
let get_texture_alpha_mod t =
let alpha = allocate uint8_t Unsigned.UInt8.zero in
- match get_texture_alpha_mod t alpha with
- | Ok () -> Ok (Unsigned.UInt8.to_int (!@ alpha)) | Error _ as e -> e
-
-let get_texture_blend_mode =
- foreign "SDL_GetTextureBlendMode"
- (texture @-> ptr int @-> returning zero_to_ok)
+ match C.Functions.get_texture_alpha_mod t alpha with
+ | 0 -> Ok (Unsigned.UInt8.to_int (!@ alpha)) | _ -> error ()
let get_texture_blend_mode t =
- let m = allocate int 0 in
- match get_texture_blend_mode t m with
- | Ok () -> Ok (!@ m) | Error _ as e -> e
-
-let get_texture_color_mod =
- foreign "SDL_GetTextureColorMod"
- (renderer @-> ptr uint8_t @-> ptr uint8_t @-> ptr uint8_t @->
- returning zero_to_ok)
+ let m = allocate Blend.mode Blend.mode_invalid in
+ match C.Functions.get_texture_blend_mode t m with
+ | 0 -> Ok (!@ m) | _ -> error ()
let get_texture_color_mod t =
let alloc () = allocate uint8_t Unsigned.UInt8.zero in
let get v = Unsigned.UInt8.to_int (!@ v) in
let r, g, b = alloc (), alloc (), alloc () in
- match get_texture_color_mod t r g b with
- | Ok () -> Ok (get r, get g, get b) | Error _ as e -> e
-
-let query_texture =
- foreign "SDL_QueryTexture"
- (texture @-> ptr uint32_t @-> ptr int @-> ptr int @-> ptr int @->
- returning zero_to_ok)
+ match C.Functions.get_texture_color_mod t r g b with
+ | 0 -> Ok (get r, get g, get b) | _ -> error ()
let _texture_height t =
let h = allocate int 0 in
let unull = coerce (ptr void) (ptr uint32_t) null in
let inull = coerce (ptr void) (ptr int) null in
- match query_texture t unull inull inull h with
- | Ok () -> Ok (!@ h) | Error _ as e -> e
-
-let lock_texture =
- foreign "SDL_LockTexture"
- (texture @-> ptr rect @-> ptr (ptr void) @-> ptr int @->
- returning zero_to_ok)
+ match C.Functions.query_texture t unull inull inull h with
+ | 0 -> Ok (!@ h) | _ -> error ()
let lock_texture t r kind =
match (match r with None -> _texture_height t | Some r -> Ok (Rect.h r)) with
@@ -1771,9 +1147,8 @@
| Ok h ->
let pitch = allocate int 0 in
let p = allocate (ptr void) null in
- match lock_texture t (Rect.opt_addr r) p pitch with
- | Error _ as e -> e
- | Ok () ->
+ match C.Functions.lock_texture t (Rect.opt_addr r) p pitch with
+ | 0 ->
let p = !@ p in
let pitch = !@ pitch in
let kind_size = ba_kind_byte_size kind in
@@ -1783,73 +1158,59 @@
let ba_size = (pitch * h) / kind_size in
let pixels = coerce (ptr void) (access_ptr_typ_of_ba_kind kind) p in
Ok (bigarray_of_ptr array1 ba_size kind pixels, pitch / kind_size)
+ | _ -> error ()
let query_texture t =
let pf = allocate uint32_t Unsigned.UInt32.zero in
let access = allocate int 0 in
let w = allocate int 0 in
let h = allocate int 0 in
- match query_texture t pf access w h with
- | Ok () -> Ok (!@ pf, !@ access, (!@ w, !@ h)) | Error _ as e -> e
+ match C.Functions.query_texture t pf access w h with
+ | 0 -> Ok (!@ pf, !@ access, (!@ w, !@ h)) | _ -> error ()
+
+let set_texture_alpha_mod t a =
+ zero_to_ok (C.Functions.set_texture_alpha_mod t (Unsigned.UInt8.of_int a))
-let set_texture_alpha_mod =
- foreign "SDL_SetTextureAlphaMod"
- (texture @-> int_as_uint8_t @-> returning zero_to_ok)
-
-let set_texture_blend_mode =
- foreign "SDL_SetTextureBlendMode"
- (texture @-> int @-> returning zero_to_ok)
-
-let set_texture_color_mod =
- foreign "SDL_SetTextureColorMod"
- (texture @-> int_as_uint8_t @-> int_as_uint8_t @-> int_as_uint8_t @->
- returning zero_to_ok)
-
-let unlock_texture =
- foreign "SDL_UnlockTexture" (texture @-> returning void)
-
-let update_texture =
- foreign "SDL_UpdateTexture"
- (texture @-> ptr rect @-> ptr void @-> int @-> returning zero_to_ok)
+let set_texture_blend_mode t b =
+ zero_to_ok (C.Functions.set_texture_blend_mode t b)
+
+let set_texture_color_mod t a b c =
+ zero_to_ok (C.Functions.set_texture_color_mod
+ t
+ (Unsigned.UInt8.of_int a)
+ (Unsigned.UInt8.of_int b)
+ (Unsigned.UInt8.of_int c))
+
+let unlock_texture = C.Functions.unlock_texture
let update_texture t rect pixels pitch =
let pitch = pitch * (ba_kind_byte_size (Bigarray.Array1.kind pixels)) in
let pixels = to_voidp (bigarray_start array1 pixels) in
- update_texture t (Rect.opt_addr rect) pixels pitch
-
-let update_yuv_texture =
- foreign "SDL_UpdateYUVTexture"
- (texture @-> ptr rect @->
- ptr void @-> int @-> ptr void @-> int @-> ptr void @-> int @->
- returning zero_to_ok)
+ zero_to_ok (C.Functions.update_texture t (Rect.opt_addr rect) pixels pitch)
let update_yuv_texture r rect ~y ypitch ~u upitch ~v vpitch =
- let yp = to_voidp (bigarray_start array1 y) in
- let up = to_voidp (bigarray_start array1 u) in
- let vp = to_voidp (bigarray_start array1 v) in
- update_yuv_texture r (Rect.opt_addr rect) yp ypitch up upitch vp vpitch
+ let yp = bigarray_start array1 y in
+ let up = bigarray_start array1 u in
+ let vp = bigarray_start array1 v in
+ zero_to_ok (C.Functions.update_yuv_texture
+ r (Rect.opt_addr rect) yp ypitch up upitch vp vpitch)
(* Video drivers *)
-let get_current_video_driver =
- foreign "SDL_GetCurrentVideoDriver" (void @-> returning string_opt)
+let get_current_video_driver = C.Functions.get_current_video_driver
-let get_num_video_drivers =
- foreign "SDL_GetNumVideoDrivers" (void @-> returning nat_to_ok)
+let get_num_video_drivers () =
+ nat_to_ok (C.Functions.get_num_video_drivers ())
-let get_video_driver =
- foreign "SDL_GetVideoDriver" (int @-> returning (some_to_ok string_opt))
+let get_video_driver x = some_to_ok (C.Functions.get_video_driver x)
-let video_init =
- foreign "SDL_VideoInit" (string_opt @-> returning zero_to_ok)
+let video_init s = zero_to_ok (C.Functions.video_init s)
-let video_quit =
- foreign "SDL_VideoQuit" (void @-> returning void)
+let video_quit = C.Functions.video_quit
(* Displays *)
type driverdata = unit ptr
-let driverdata = ptr_opt void
type display_mode =
{ dm_format : Pixel.format_enum;
@@ -1858,627 +1219,384 @@
dm_refresh_rate : int option;
dm_driverdata : driverdata option }
-type _display_mode
-let display_mode : _display_mode structure typ = structure "SDL_DisplayMode"
-let dm_format = field display_mode "format" uint32_t
-let dm_w = field display_mode "w" int
-let dm_h = field display_mode "h" int
-let dm_refresh_rate = field display_mode "refresh_rate" int
-let dm_driverdata = field display_mode "driverdata" driverdata
-let () = seal display_mode
-
let display_mode_to_c o =
- let c = make display_mode in
+ let c = make C.Types.display_mode in
let rate = match o.dm_refresh_rate with None -> 0 | Some r -> r in
- setf c dm_format o.dm_format;
- setf c dm_w o.dm_w;
- setf c dm_h o.dm_h;
- setf c dm_refresh_rate rate;
- setf c dm_driverdata o.dm_driverdata;
+ setf c C.Types.dm_format o.dm_format;
+ setf c C.Types.dm_w o.dm_w;
+ setf c C.Types.dm_h o.dm_h;
+ setf c C.Types.dm_refresh_rate rate;
+ setf c C.Types.dm_driverdata o.dm_driverdata;
c
let display_mode_of_c c =
- let dm_format = getf c dm_format in
- let dm_w = getf c dm_w in
- let dm_h = getf c dm_h in
- let dm_refresh_rate = match getf c dm_refresh_rate with
+ let dm_format = getf c C.Types.dm_format in
+ let dm_w = getf c C.Types.dm_w in
+ let dm_h = getf c C.Types.dm_h in
+ let dm_refresh_rate = match getf c C.Types.dm_refresh_rate with
| 0 -> None | r -> Some r
in
- let dm_driverdata = getf c dm_driverdata in
+ let dm_driverdata = getf c C.Types.dm_driverdata in
{ dm_format; dm_w; dm_h; dm_refresh_rate; dm_driverdata }
-let get_closest_display_mode =
- foreign "SDL_GetClosestDisplayMode"
- (int @-> ptr display_mode @-> ptr display_mode @->
- returning (ptr_opt void))
-
let get_closest_display_mode i m =
let mode = display_mode_to_c m in
- let closest = make display_mode in
- match get_closest_display_mode i (addr mode) (addr closest) with
+ let closest = make C.Types.display_mode in
+ match C.Functions.get_closest_display_mode i (addr mode) (addr closest) with
| None -> None
| Some _ -> Some (display_mode_of_c closest)
-let get_current_display_mode =
- foreign "SDL_GetCurrentDisplayMode"
- (int @-> ptr display_mode @-> returning zero_to_ok)
-
let get_current_display_mode i =
- let mode = make display_mode in
- match get_current_display_mode i (addr mode) with
- | Ok () -> Ok (display_mode_of_c mode) | Error _ as e -> e
-
-let get_desktop_display_mode =
- foreign "SDL_GetDesktopDisplayMode"
- (int @-> ptr display_mode @-> returning zero_to_ok)
+ let mode = make C.Types.display_mode in
+ match C.Functions.get_current_display_mode i (addr mode) with
+ | 0 -> Ok (display_mode_of_c mode) | _ -> error ()
let get_desktop_display_mode i =
- let mode = make display_mode in
- match get_desktop_display_mode i (addr mode) with
- | Ok () -> Ok (display_mode_of_c mode) | Error _ as e -> e
-
-let get_display_bounds =
- foreign "SDL_GetDisplayBounds"
- (int @-> ptr rect @-> returning zero_to_ok)
+ let mode = make C.Types.display_mode in
+ match C.Functions.get_desktop_display_mode i (addr mode) with
+ | 0 -> Ok (display_mode_of_c mode) | _ -> error ()
let get_display_bounds i =
- let r = make rect in
- match get_display_bounds i (addr r) with
- | Ok () -> Ok r | Error _ as e -> e
-
-let get_display_dpi =
- foreign "SDL_GetDisplayDPI"
- (int @-> ptr float @-> ptr float @-> ptr float @-> returning zero_to_ok)
+ let r = make C.Types.Rect.t in
+ match C.Functions.get_display_bounds i (addr r) with
+ | 0 -> Ok r | _ -> error ()
let get_display_dpi display =
let diagonal = allocate float 0. in
let horizontal = allocate float 0. in
let vertical = allocate float 0. in
- match get_display_dpi display diagonal horizontal vertical with
- | Ok () -> Ok (!@diagonal,!@horizontal,!@vertical)
- | Error _ as err -> err
-
-let get_display_mode =
- foreign "SDL_GetDisplayMode"
- (int @-> int @-> ptr display_mode @-> returning zero_to_ok)
+ match C.Functions.get_display_dpi display diagonal horizontal vertical with
+ | 0 -> Ok (!@diagonal,!@horizontal,!@vertical)
+ | _ -> error ()
let get_display_mode d i =
- let mode = make display_mode in
- match get_display_mode d i (addr mode) with
- | Ok () -> Ok (display_mode_of_c mode) | Error _ as e -> e
-
-let get_display_usable_bounds =
- foreign "SDL_GetDisplayUsableBounds"
- (int @-> ptr rect @-> returning zero_to_ok)
+ let mode = make C.Types.display_mode in
+ match C.Functions.get_display_mode d i (addr mode) with
+ | 0 -> Ok (display_mode_of_c mode) | _ -> error ()
let get_display_usable_bounds i =
- let r = make rect in
- match get_display_usable_bounds i (addr r) with
- | Ok () -> Ok r | Error _ as e -> e
+ let r = make C.Types.Rect.t in
+ match C.Functions.get_display_usable_bounds i (addr r) with
+ | 0 -> Ok r | _ -> error ()
-let get_num_display_modes =
- foreign "SDL_GetNumDisplayModes" (int @-> returning nat_to_ok)
+let get_num_display_modes x = nat_to_ok (C.Functions.get_num_display_modes x)
-let get_display_name =
- foreign "SDL_GetDisplayName" (int @-> returning (some_to_ok string_opt))
+let get_display_name x = some_to_ok (C.Functions.get_display_name x)
-let get_num_video_displays =
- foreign "SDL_GetNumVideoDisplays" (void @-> returning nat_to_ok)
+let get_num_video_displays () =
+ nat_to_ok (C.Functions.get_num_video_displays ())
(* Windows *)
module Window = struct
- let pos_undefined = sdl_windowpos_undefined
- let pos_centered = sdl_windowpos_centered
-
type flags = Unsigned.uint32
- let i = Unsigned.UInt32.of_int
let ( + ) = Unsigned.UInt32.logor
let ( - ) f f' = Unsigned.UInt32.(logand f (lognot f'))
let test f m = Unsigned.UInt32.(compare (logand f m) zero <> 0)
let eq f f' = Unsigned.UInt32.(compare f f' = 0)
- let windowed = i 0
- let fullscreen = i sdl_window_fullscreen
- let fullscreen_desktop = i sdl_window_fullscreen_desktop
- let opengl = i sdl_window_opengl
- let shown = i sdl_window_shown
- let hidden = i sdl_window_hidden
- let borderless = i sdl_window_borderless
- let resizable = i sdl_window_resizable
- let minimized = i sdl_window_minimized
- let maximized = i sdl_window_maximized
- let input_grabbed = i sdl_window_input_grabbed
- let input_focus = i sdl_window_input_focus
- let mouse_focus = i sdl_window_mouse_focus
- let foreign = i sdl_window_foreign
- let allow_highdpi = i sdl_window_allow_highdpi
- let mouse_capture = i sdl_window_mouse_capture
- let always_on_top = i sdl_window_always_on_top
- let skip_taskbar = i sdl_window_skip_taskbar
- let utility = i sdl_window_utility
- let popup_menu = i sdl_window_popup_menu
- let vulkan = i sdl_window_vulkan
+ let windowed = Unsigned.UInt32.zero
+ include C.Types.Window
end
-let create_window =
- foreign "SDL_CreateWindow"
- (string @-> int @-> int @-> int @-> int @-> uint32_t @->
- returning (some_to_ok window_opt))
+(* Video *)
-let create_window t ?(x = Window.pos_undefined) ?(y = Window.pos_undefined)
- ~w ~h flags = create_window t x y w h flags
+type window = Window.t
-let create_window_and_renderer =
- foreign "SDL_CreateWindowAndRenderer"
- (int @-> int @-> uint32_t @-> ptr window @-> ptr renderer @->
- (returning zero_to_ok))
+let unsafe_window_of_ptr addr : Window.t =
+ from_voidp Window.raw (ptr_of_raw_address addr)
+let unsafe_ptr_of_window window =
+ raw_address_of_ptr (to_voidp window)
+
+let create_window t ?(x = Window.pos_undefined) ?(y = Window.pos_undefined)
+ ~w ~h flags = some_to_ok (C.Functions.create_window t x y w h flags)
let create_window_and_renderer ~w ~h flags =
- let win = allocate window null in
- let r = allocate renderer null in
- match create_window_and_renderer w h flags win r with
- | Ok () -> Ok (!@ win, !@ r) | Error _ as e -> e
-
-let destroy_window =
- foreign "SDL_DestroyWindow" (window @-> returning void)
-
-let get_window_brightness =
- foreign "SDL_GetWindowBrightness" (window @-> returning float)
-
-let get_window_borders_size =
- foreign "SDL_GetWindowBordersSize"
- (window @-> ptr int @-> ptr int @-> ptr int @-> ptr int @->
- returning zero_to_ok)
+ let win = allocate Window.t (from_voidp Window.raw null) in
+ let r = allocate (ptr Renderer.t) (from_voidp Renderer.t null) in
+ match C.Functions.create_window_and_renderer w h flags win r with
+ | 0 -> Ok (!@ win, !@ r) | _ -> error ()
+
+let destroy_window = C.Functions.destroy_window
+
+let get_window_brightness = C.Functions.get_window_brightness
let get_window_borders_size w =
let top = allocate int 0 in
let left = allocate int 0 in
let bottom = allocate int 0 in
let right = allocate int 0 in
- match get_window_borders_size w top bottom left right with
- | Ok () -> Ok (!@ top, !@ left, !@ bottom, !@ right)
- | Error _ as err -> err
-
-let get_window_display_index =
- foreign "SDL_GetWindowDisplayIndex" (window @-> returning nat_to_ok)
-
-let get_window_display_mode =
- foreign "SDL_GetWindowDisplayMode"
- (window @-> (ptr display_mode) @-> returning int)
+ match C.Functions.get_window_borders_size w top bottom left right with
+ | 0 -> Ok (!@ top, !@ left, !@ bottom, !@ right)
+ | _ -> error ()
+
+let get_window_display_index w =
+ nat_to_ok (C.Functions.get_window_display_index w)
let get_window_display_mode w =
- let mode = make display_mode in
- match get_window_display_mode w (addr mode) with
- | 0 -> Ok (display_mode_of_c mode) | err -> error ()
-
-let get_window_flags =
- foreign "SDL_GetWindowFlags" (window @-> returning uint32_t)
-
-let get_window_from_id =
- foreign "SDL_GetWindowFromID"
- (int_as_uint32_t @-> returning (some_to_ok window_opt))
-
-let get_window_gamma_ramp =
- foreign "SDL_GetWindowGammaRamp"
- (window @-> ptr void @-> ptr void @-> ptr void @-> returning zero_to_ok)
+ let mode = make C.Types.display_mode in
+ match C.Functions.get_window_display_mode w (addr mode) with
+ | 0 -> Ok (display_mode_of_c mode) | _err -> error ()
+
+let get_window_flags = C.Functions.get_window_flags
+
+let get_window_from_id x =
+ some_to_ok (C.Functions.get_window_from_id (Unsigned.UInt32.of_int x))
let get_window_gamma_ramp w =
let create_ramp () = ba_create Bigarray.int16_unsigned 256 in
let r, g, b = create_ramp (), create_ramp (), create_ramp () in
- let ramp_ptr r = to_voidp (bigarray_start array1 r) in
- match get_window_gamma_ramp w (ramp_ptr r) (ramp_ptr g) (ramp_ptr b) with
- | Ok () -> Ok (r, g, b) | Error _ as e -> e
-
-let get_window_grab =
- foreign "SDL_GetWindowGrab" (window @-> returning bool)
-
-let get_grabbed_window =
- foreign "SDL_GetGrabbedWindow" (void @-> returning window)
-
-let get_window_id =
- foreign "SDL_GetWindowID" (window @-> returning int_as_uint32_t)
-
-let get_window_maximum_size =
- foreign "SDL_GetWindowMaximumSize"
- (window @-> (ptr int) @-> (ptr int) @-> returning void)
+ let ramp_ptr r = bigarray_start array1 r in
+ match C.Functions.get_window_gamma_ramp
+ w (ramp_ptr r) (ramp_ptr g) (ramp_ptr b) with
+ | 0 -> Ok (r, g, b) | _ -> error ()
+
+let get_window_grab = C.Functions.get_window_grab
+
+let get_grabbed_window = C.Functions.get_grabbed_window
+
+let get_window_id w = Unsigned.UInt32.to_int (C.Functions.get_window_id w)
let get_window_maximum_size win =
let w = allocate int 0 in
let h = allocate int 0 in
- get_window_maximum_size win w h;
+ C.Functions.get_window_maximum_size win w h;
!@ w, !@ h
-let get_window_minimum_size =
- foreign "SDL_GetWindowMinimumSize"
- (window @-> (ptr int) @-> (ptr int) @-> returning void)
-
let get_window_minimum_size win =
let w = allocate int 0 in
let h = allocate int 0 in
- get_window_minimum_size win w h;
+ C.Functions.get_window_minimum_size win w h;
!@ w, !@ h
-let get_window_opacity =
- foreign "SDL_GetWindowOpacity"
- (window @-> (ptr float) @-> returning zero_to_ok)
-
let get_window_opacity win =
let x = allocate float 0. in
- match get_window_opacity win x with
- | Ok () -> Ok !@x
- | Error _ as e -> e
-
-let get_window_pixel_format =
- foreign "SDL_GetWindowPixelFormat" (window @-> returning uint32_t)
+ match C.Functions.get_window_opacity win x with
+ | 0 -> Ok !@x
+ | _ -> error ()
-let get_window_position =
- foreign "SDL_GetWindowPosition"
- (window @-> (ptr int) @-> (ptr int) @-> returning void)
+let get_window_pixel_format = C.Functions.get_window_pixel_format
let get_window_position win =
let x = allocate int 0 in
let y = allocate int 0 in
- get_window_position win x y;
+ C.Functions.get_window_position win x y;
!@ x, !@ y
-let get_window_size =
- foreign "SDL_GetWindowSize"
- (window @-> (ptr int) @-> (ptr int) @-> returning void)
-
let get_window_size win =
let w = allocate int 0 in
let h = allocate int 0 in
- get_window_size win w h;
+ C.Functions.get_window_size win w h;
!@ w, !@ h
-let get_window_surface =
- foreign "SDL_GetWindowSurface"
- (window @-> returning (some_to_ok surface_opt))
-
-let get_window_title =
- foreign "SDL_GetWindowTitle" (window @-> returning string)
+let get_window_surface w =
+ some_to_ok (C.Functions.get_window_surface w)
-let hide_window =
- foreign "SDL_HideWindow" (window @-> returning void)
+let get_window_title = C.Functions.get_window_title
-let maximize_window =
- foreign "SDL_MaximizeWindow" (window @-> returning void)
+let hide_window = C.Functions.hide_window
-let minimize_window =
- foreign "SDL_MinimizeWindow" (window @-> returning void)
+let maximize_window = C.Functions.maximize_window
-let raise_window =
- foreign "SDL_RaiseWindow" (window @-> returning void)
+let minimize_window = C.Functions.minimize_window
-let restore_window =
- foreign "SDL_RestoreWindow" (window @-> returning void)
+let raise_window = C.Functions.raise_window
-let set_window_bordered =
- foreign "SDL_SetWindowBordered" (window @-> bool @-> returning void)
+let restore_window = C.Functions.restore_window
-let set_window_brightness =
- foreign "SDL_SetWindowBrightness"
- (window @-> float @-> returning zero_to_ok)
+let set_window_bordered = C.Functions.set_window_bordered
-let set_window_display_mode =
- foreign "SDL_SetWindowDisplayMode"
- (window @-> (ptr display_mode) @-> returning zero_to_ok)
+let set_window_brightness w x =
+ zero_to_ok (C.Functions.set_window_brightness w x)
let set_window_display_mode w m =
let mode = display_mode_to_c m in
- set_window_display_mode w (addr mode)
+ zero_to_ok (C.Functions.set_window_display_mode w (addr mode))
-let set_window_fullscreen =
- foreign "SDL_SetWindowFullscreen"
- (window @-> uint32_t @-> returning zero_to_ok)
-
-let set_window_gamma_ramp =
- foreign "SDL_SetWindowGammaRamp"
- (window @-> ptr void @-> ptr void @-> ptr void @->
- returning zero_to_ok)
+let set_window_fullscreen w x =
+ zero_to_ok (C.Functions.set_window_fullscreen w x)
let set_window_gamma_ramp w r g b =
- let ramp_ptr r = to_voidp (bigarray_start array1 r) in
- set_window_gamma_ramp w (ramp_ptr r) (ramp_ptr g) (ramp_ptr b)
-
-let set_window_grab =
- foreign "SDL_SetWindowGrab" (window @-> bool @-> returning void)
+ let ramp_ptr r = bigarray_start array1 r in
+ zero_to_ok (C.Functions.set_window_gamma_ramp
+ w (ramp_ptr r) (ramp_ptr g) (ramp_ptr b))
-let set_window_icon =
- foreign "SDL_SetWindowIcon" (window @-> surface @-> returning void)
+let set_window_grab = C.Functions.set_window_grab
-let set_window_input_focus =
- foreign "SDL_SetWindowInputFocus" (window @-> returning zero_to_ok)
+let set_window_icon = C.Functions.set_window_icon
-let set_window_maximum_size =
- foreign "SDL_SetWindowMaximumSize"
- (window @-> int @-> int @-> returning void)
+let set_window_input_focus w =
+ zero_to_ok (C.Functions.set_window_input_focus w)
let set_window_maximum_size win ~w ~h =
- set_window_maximum_size win w h
-
-let set_window_minimum_size =
- foreign "SDL_SetWindowMinimumSize"
- (window @-> int @-> int @-> returning void)
+ C.Functions.set_window_maximum_size win w h
let set_window_minimum_size win ~w ~h =
- set_window_minimum_size win w h
-
-let set_window_modal_for =
- foreign "SDL_SetWindowModalFor" ( window @-> window @-> returning zero_to_ok)
-
-let set_window_modal_for ~modal ~parent = set_window_modal_for modal parent
+ C.Functions.set_window_minimum_size win w h
-let set_window_opacity =
- foreign "SDL_SetWindowOpacity" ( window @-> float @-> returning zero_to_ok)
+let set_window_modal_for ~modal ~parent =
+ zero_to_ok (C.Functions.set_window_modal_for modal parent)
-let set_window_position =
- foreign "SDL_SetWindowPosition"
- (window @-> int @-> int @-> returning void)
+let set_window_opacity w x =
+ zero_to_ok (C.Functions.set_window_opacity w x)
let set_window_position win ~x ~y =
- set_window_position win x y
+ C.Functions.set_window_position win x y
-let set_window_resizable =
- foreign "SDL_SetWindowResizable" (window @-> bool @-> returning void)
-
-let set_window_size =
- foreign "SDL_SetWindowSize" (window @-> int @-> int @-> returning void)
+let set_window_resizable = C.Functions.set_window_resizable
let set_window_size win ~w ~h =
- set_window_size win w h
-
-let set_window_title =
- foreign "SDL_SetWindowTitle" (window @-> string @-> returning void)
+ C.Functions.set_window_size win w h
-let show_window =
- foreign "SDL_ShowWindow" (window @-> returning void)
+let set_window_title = C.Functions.set_window_title
-let update_window_surface =
- foreign "SDL_UpdateWindowSurface" (window @-> returning zero_to_ok)
+let show_window = C.Functions.show_window
-let update_window_surface_rects =
- foreign "SDL_UpdateWindowSurfaceRects"
- (window @-> ptr void @-> int @-> returning zero_to_ok)
+let update_window_surface w =
+ zero_to_ok (C.Functions.update_window_surface w)
let update_window_surface_rects_ba w rs =
let len = Bigarray.Array1.dim rs in
if len mod 4 <> 0 then invalid_arg (err_length_mul len 4) else
let count = len / 4 in
let rs = to_voidp (bigarray_start array1 rs) in
- update_window_surface_rects w rs count
+ zero_to_ok (C.Functions.update_window_surface_rects w rs count)
let update_window_surface_rects w rs =
- let a = CArray.of_list rect rs in
+ let a = CArray.of_list C.Types.Rect.t rs in
let rs = to_voidp (CArray.start a) in
- update_window_surface_rects w rs (CArray.length a)
+ zero_to_ok (C.Functions.update_window_surface_rects w rs (CArray.length a))
(* OpenGL contexts *)
-type gl_context = unit ptr
-let gl_context : unit ptr typ = ptr void
-let gl_context_opt : unit ptr option typ = ptr_opt void
-
-let unsafe_gl_context_of_ptr addr : gl_context =
- ptr_of_raw_address addr
-let unsafe_ptr_of_gl_context gl_context =
- raw_address_of_ptr (to_voidp gl_context)
-
module Gl = struct
type context_flags = int
- let context_debug_flag = sdl_gl_context_debug_flag
- let context_forward_compatible_flag = sdl_gl_context_forward_compatible_flag
- let context_robust_access_flag = sdl_gl_context_robust_access_flag
- let context_reset_isolation_flag = sdl_gl_context_reset_isolation_flag
-
type profile = int
- let context_profile_core = sdl_gl_context_profile_core
- let context_profile_compatibility = sdl_gl_context_profile_compatibility
- let context_profile_es = sdl_gl_context_profile_es
-
type attr = int
- let red_size = sdl_gl_red_size
- let green_size = sdl_gl_green_size
- let blue_size = sdl_gl_blue_size
- let alpha_size = sdl_gl_alpha_size
- let buffer_size = sdl_gl_buffer_size
- let doublebuffer = sdl_gl_doublebuffer
- let depth_size = sdl_gl_depth_size
- let stencil_size = sdl_gl_stencil_size
- let accum_red_size = sdl_gl_accum_red_size
- let accum_green_size = sdl_gl_accum_green_size
- let accum_blue_size = sdl_gl_accum_blue_size
- let accum_alpha_size = sdl_gl_accum_alpha_size
- let stereo = sdl_gl_stereo
- let multisamplebuffers = sdl_gl_multisamplebuffers
- let multisamplesamples = sdl_gl_multisamplesamples
- let accelerated_visual = sdl_gl_accelerated_visual
- let context_major_version = sdl_gl_context_major_version
- let context_minor_version = sdl_gl_context_minor_version
- let context_egl = sdl_gl_context_egl
- let context_flags = sdl_gl_context_flags
- let context_profile_mask = sdl_gl_context_profile_mask
- let context_release_behavior = sdl_gl_context_release_behavior
- let share_with_current_context = sdl_gl_share_with_current_context
- let framebuffer_srgb_capable = sdl_gl_framebuffer_srgb_capable
+
+ include C.Types.Gl
end
-let gl_bind_texture =
- foreign "SDL_GL_BindTexture"
- (texture @-> ptr float @-> ptr float @-> returning zero_to_ok)
+type gl_context = C.Types.Gl.context ptr
+
+let unsafe_gl_context_of_ptr addr : gl_context =
+ from_voidp C.Types.Gl.context (ptr_of_raw_address addr)
+let unsafe_ptr_of_gl_context gl_context =
+ raw_address_of_ptr (to_voidp gl_context)
let gl_bind_texture t =
let w = allocate float 0. in
let h = allocate float 0. in
- match gl_bind_texture t w h with
- | Ok () -> Ok (!@ w, !@ h) | Error _ as e -> e
-
-let gl_create_context =
- foreign "SDL_GL_CreateContext"
- (window @-> returning (some_to_ok gl_context_opt))
+ match C.Functions.gl_bind_texture t w h with
+ | 0 -> Ok (!@ w, !@ h) | _ -> error ()
-let gl_delete_context =
- foreign "SDL_GL_DeleteContext" (gl_context @-> returning void)
+let gl_create_context w =
+ some_to_ok (C.Functions.gl_create_context w)
-let gl_extension_supported =
- foreign "SDL_GL_ExtensionSupported" (string @-> returning bool)
+let gl_delete_context = C.Functions.gl_delete_context
-let gl_get_attribute =
- foreign "SDL_GL_GetAttribute" (int @-> (ptr int) @-> returning int)
+let gl_extension_supported = C.Functions.gl_extension_supported
let gl_get_attribute att =
let value = allocate int 0 in
- match gl_get_attribute att value with
- | 0 -> Ok (!@ value) | err -> error ()
+ match C.Functions.gl_get_attribute att value with
+ | 0 -> Ok (!@ value) | _err -> error ()
-let gl_get_current_context =
- foreign "SDL_GL_GetCurrentContext"
- (void @-> returning (some_to_ok gl_context_opt))
-
-let gl_get_drawable_size =
- foreign "SDL_GL_GetDrawableSize"
- (window @-> ptr int @-> ptr int @-> returning void)
+let gl_get_current_context () =
+ some_to_ok (C.Functions.gl_get_current_context ())
let gl_get_drawable_size win =
let w = allocate int 0 in
let h = allocate int 0 in
- gl_get_drawable_size win w h;
+ C.Functions.gl_get_drawable_size win w h;
(!@ w, !@ h)
-let int_to_ok =
- let read n = Ok n in
- view ~read ~write:write_never int
-
-let gl_get_swap_interval =
- foreign "SDL_GL_GetSwapInterval" (void @-> returning int_to_ok)
+let gl_get_swap_interval () = Ok (C.Functions.gl_get_swap_interval ())
-let gl_make_current =
- foreign "SDL_GL_MakeCurrent"
- (window @-> gl_context @-> returning zero_to_ok)
+let gl_make_current w g =
+ zero_to_ok (C.Functions.gl_make_current w g)
-let gl_reset_attributes =
- foreign "SDL_GL_ResetAttributes" ~stub (void @-> returning void)
+let gl_reset_attributes = C.Functions.gl_reset_attributes
-let gl_set_attribute =
- foreign "SDL_GL_SetAttribute" (int @-> int @-> returning zero_to_ok)
+let gl_set_attribute x y =
+ zero_to_ok (C.Functions.gl_set_attribute x y)
-let gl_set_swap_interval =
- foreign "SDL_GL_SetSwapInterval" (int @-> returning zero_to_ok)
+let gl_set_swap_interval x =
+ zero_to_ok (C.Functions.gl_set_swap_interval x)
-let gl_swap_window =
- foreign "SDL_GL_SwapWindow" (window @-> returning void)
+let gl_swap_window = C.Functions.gl_swap_window
-let gl_unbind_texture =
- foreign "SDL_GL_UnbindTexture" (texture @-> returning zero_to_ok)
+let gl_unbind_texture t =
+ zero_to_ok (C.Functions.gl_unbind_texture t)
(* Vulkan *)
module Vulkan = struct
type instance = unit ptr
- let instance = ptr void
let unsafe_ptr_of_instance = raw_address_of_ptr
let unsafe_instance_of_ptr x = ptr_of_raw_address x
- type surface = uint64
- let surface = int64_t
- let unsafe_uint64_of_surface x = x
- let unsafe_surface_of_uint64 x = x
-
- let load_library =
- foreign "SDL_Vulkan_LoadLibrary" (string_opt @-> returning zero_to_ok)
-
- let unload_library =
- foreign "SDL_Vulkan_UnloadLibrary" (void @-> returning void)
-
- let get_instance_extensions =
- foreign "SDL_Vulkan_GetInstanceExtensions"
- (window @-> ptr int @-> ptr string @-> returning bool)
+ type surface = C.Types.Vulkan.surface
+ let unsafe_uint64_of_surface x =
+ Int64.of_nativeint (raw_address_of_ptr (to_voidp x))
+ let unsafe_surface_of_uint64 x =
+ from_voidp C.Types.Vulkan.raw_surface
+ (ptr_of_raw_address (Int64.to_nativeint x))
+
+ let load_library s =
+ zero_to_ok (C.Functions.Vulkan.load_library s)
+
+ let unload_library = C.Functions.Vulkan.unload_library
let get_instance_extensions window =
let n = allocate int 0 in
- match get_instance_extensions window n
+ match C.Functions.Vulkan.get_instance_extensions window n
(Ctypes.coerce (ptr void) (ptr string) null) with
| false -> None
| true ->
let exts = allocate_n string ~count:(!@n) in
- match get_instance_extensions window n exts with
+ match C.Functions.Vulkan.get_instance_extensions window n exts with
| false -> None
| true -> Some CArray.(to_list @@ from_ptr exts (!@n))
- let create_surface =
- foreign "SDL_Vulkan_CreateSurface"
- (window @-> instance @-> ptr surface @-> returning bool)
-
let create_surface window instance =
- let s = allocate_n surface ~count:1 in
- if create_surface window instance s then
+ let s = allocate_n C.Types.Vulkan.surface ~count:1 in
+ if C.Functions.Vulkan.create_surface window instance s then
Some !@s
else
None
- let get_drawable_size =
- foreign "SDL_Vulkan_GetDrawableSize"
- (window @-> ptr int @-> ptr int @-> returning void)
-
let get_drawable_size window =
let w = allocate int 0 in
let h = allocate int 0 in
- get_drawable_size window w h;
+ C.Functions.Vulkan.get_drawable_size window w h;
!@w, !@h
end
(* Screen saver *)
-let disable_screen_saver =
- foreign "SDL_DisableScreenSaver" (void @-> returning void)
+let disable_screen_saver = C.Functions.disable_screen_saver
-let enable_screen_saver =
- foreign "SDL_EnableScreenSaver" (void @-> returning void)
+let enable_screen_saver = C.Functions.enable_screen_saver
-let is_screen_saver_enabled =
- foreign "SDL_IsScreenSaverEnabled" (void @-> returning bool)
+let is_screen_saver_enabled = C.Functions.is_screen_saver_enabled
(* Message boxes *)
module Message_box = struct
- let i = Unsigned.UInt32.of_int
+ include C.Types.Message_box
type button_flags = Unsigned.uint32
- let button_no_default = i 0
- let button_returnkey_default = i sdl_messagebox_button_returnkey_default
- let button_escapekey_default = i sdl_messagebox_button_escapekey_default
+ let button_no_default = Unsigned.UInt32.zero
type button_data =
{ button_flags : button_flags;
button_id : int;
button_text : string }
- let button_data = structure "SDL_MessageBoxButtonData"
- let button_flags = field button_data "flags" uint32_t
- let button_buttonid = field button_data "buttonid" int
- let button_text = field button_data "text" string
- let () = seal button_data
-
type flags = Unsigned.uint32
- let error = i sdl_messagebox_error
- let warning = i sdl_messagebox_warning
- let information = i sdl_messagebox_information
type color = int * int * int
- let color = structure "SDL_MessageBoxColor"
- let color_r = field color "r" uint8_t
- let color_g = field color "g" uint8_t
- let color_b = field color "b" uint8_t
- let () = seal color
-
- type color_type = int
- let color_background = sdl_messagebox_color_background
- let color_text = sdl_messagebox_color_text
- let color_button_border = sdl_messagebox_color_button_border
- let color_button_background = sdl_messagebox_color_button_background
- let color_button_selected = sdl_messagebox_color_button_selected
- let color_button_max = sdl_messagebox_color_max
type color_scheme =
{ color_background : color;
@@ -2487,28 +1605,14 @@
color_button_background : color;
color_button_selected : color; }
- let color_scheme = structure "SDL_MessageBoxColorScheme"
- let colors = field color_scheme "colors" (array color_button_max color)
- let () = seal color_scheme
-
type data =
{ flags : flags;
- window : window option;
+ window : Window.t option;
title : string;
message : string;
buttons : button_data list;
color_scheme : color_scheme option }
- let data = structure "SDL_MessageBoxData"
- let d_flags = field data "flags" uint32_t
- let d_window = field data "window" window
- let d_title = field data "title" string
- let d_message = field data "message" string
- let d_numbuttons = field data "numbuttons" int
- let d_buttons = field data "buttons" (ptr button_data)
- let d_color_scheme = field data "colorScheme" (ptr color_scheme)
- let () = seal data
-
let buttons_to_c bl =
let button_data_to_c b =
let bt = make button_data in
@@ -2521,12 +1625,12 @@
let color_scheme_to_c s =
let st = make color_scheme in
- let colors = getf st colors in
+ let arr = getf st colors in
let set i (rv, gv, bv) =
- let ct = CArray.get colors i in
+ let ct = CArray.get arr i in
setf ct color_r (Unsigned.UInt8.of_int rv);
- setf ct color_g (Unsigned.UInt8.of_int rv);
- setf ct color_b (Unsigned.UInt8.of_int rv);
+ setf ct color_g (Unsigned.UInt8.of_int gv);
+ setf ct color_b (Unsigned.UInt8.of_int bv);
in
set color_background s.color_background;
set color_text s.color_text;
@@ -2538,43 +1642,29 @@
let data_to_c d =
let dt = make data in
setf dt d_flags d.flags;
- setf dt d_window (match d.window with None -> null | Some w -> w);
+ setf dt d_window d.window;
setf dt d_title d.title;
setf dt d_message d.message;
setf dt d_numbuttons (List.length d.buttons);
setf dt d_buttons (buttons_to_c d.buttons);
setf dt d_color_scheme
- begin match d.color_scheme with
- | None -> coerce (ptr void) (ptr color_scheme) null
- | Some s -> addr (color_scheme_to_c s)
- end;
+ (Option.map (fun s -> addr (color_scheme_to_c s)) d.color_scheme);
dt
end
-let show_message_box =
- foreign "SDL_ShowMessageBox"
- (ptr Message_box.data @-> ptr int @-> returning zero_to_ok)
-
let show_message_box d =
let d = addr (Message_box.data_to_c d) in
let ret = allocate int 0 in
- match show_message_box d ret with
- | Ok () -> Ok (!@ ret) | Error _ as e -> e
-
-let show_simple_message_box =
- foreign "SDL_ShowSimpleMessageBox"
- (uint32_t @-> string @-> string @-> window_opt @-> returning zero_to_ok)
+ match C.Functions.Message_box.show d ret with
+ | 0 -> Ok (!@ ret) | _ -> error ()
let show_simple_message_box t ~title msg w =
- show_simple_message_box t title msg w
+ zero_to_ok (C.Functions.Message_box.show_simple t title msg w)
(* Clipboard *)
-let get_clipboard_text =
- foreign "SDL_GetClipboardText" (void @-> returning (ptr char))
-
let get_clipboard_text () =
- let p = get_clipboard_text () in
+ let p = C.Functions.get_clipboard_text () in
if (to_voidp p) = null then error () else
let b = Buffer.create 255 in
let ptr = ref p in
@@ -2585,270 +1675,27 @@
sdl_free (to_voidp p);
Ok (Buffer.contents b)
-let has_clipboard_text =
- foreign "SDL_HasClipboardText" (void @-> returning bool)
+let has_clipboard_text = C.Functions.has_clipboard_text
-let set_clipboard_text =
- foreign "SDL_SetClipboardText" (string @-> returning zero_to_ok)
+let set_clipboard_text s =
+ zero_to_ok (C.Functions.set_clipboard_text s)
(* Input *)
-type button_state = uint8
-let pressed = sdl_pressed
-let released = sdl_released
-
-type toggle_state = uint8
-let disable = sdl_disable
-let enable = sdl_enable
+type button_state = Unsigned.uint8
+let pressed = C.Types.pressed
+let released = C.Types.released
+
+type toggle_state = Unsigned.uint8
+let disable = C.Types.disable
+let enable = C.Types.enable
(* Keyboard *)
type scancode = int
-let scancode = int
module Scancode = struct
- let num_scancodes = sdl_num_scancodes
- let unknown = sdl_scancode_unknown
- let a = sdl_scancode_a
- let b = sdl_scancode_b
- let c = sdl_scancode_c
- let d = sdl_scancode_d
- let e = sdl_scancode_e
- let f = sdl_scancode_f
- let g = sdl_scancode_g
- let h = sdl_scancode_h
- let i = sdl_scancode_i
- let j = sdl_scancode_j
- let k = sdl_scancode_k
- let l = sdl_scancode_l
- let m = sdl_scancode_m
- let n = sdl_scancode_n
- let o = sdl_scancode_o
- let p = sdl_scancode_p
- let q = sdl_scancode_q
- let r = sdl_scancode_r
- let s = sdl_scancode_s
- let t = sdl_scancode_t
- let u = sdl_scancode_u
- let v = sdl_scancode_v
- let w = sdl_scancode_w
- let x = sdl_scancode_x
- let y = sdl_scancode_y
- let z = sdl_scancode_z
- let k1 = sdl_scancode_1
- let k2 = sdl_scancode_2
- let k3 = sdl_scancode_3
- let k4 = sdl_scancode_4
- let k5 = sdl_scancode_5
- let k6 = sdl_scancode_6
- let k7 = sdl_scancode_7
- let k8 = sdl_scancode_8
- let k9 = sdl_scancode_9
- let k0 = sdl_scancode_0
- let return = sdl_scancode_return
- let escape = sdl_scancode_escape
- let backspace = sdl_scancode_backspace
- let tab = sdl_scancode_tab
- let space = sdl_scancode_space
- let minus = sdl_scancode_minus
- let equals = sdl_scancode_equals
- let leftbracket = sdl_scancode_leftbracket
- let rightbracket = sdl_scancode_rightbracket
- let backslash = sdl_scancode_backslash
- let nonushash = sdl_scancode_nonushash
- let semicolon = sdl_scancode_semicolon
- let apostrophe = sdl_scancode_apostrophe
- let grave = sdl_scancode_grave
- let comma = sdl_scancode_comma
- let period = sdl_scancode_period
- let slash = sdl_scancode_slash
- let capslock = sdl_scancode_capslock
- let f1 = sdl_scancode_f1
- let f2 = sdl_scancode_f2
- let f3 = sdl_scancode_f3
- let f4 = sdl_scancode_f4
- let f5 = sdl_scancode_f5
- let f6 = sdl_scancode_f6
- let f7 = sdl_scancode_f7
- let f8 = sdl_scancode_f8
- let f9 = sdl_scancode_f9
- let f10 = sdl_scancode_f10
- let f11 = sdl_scancode_f11
- let f12 = sdl_scancode_f12
- let printscreen = sdl_scancode_printscreen
- let scrolllock = sdl_scancode_scrolllock
- let pause = sdl_scancode_pause
- let insert = sdl_scancode_insert
- let home = sdl_scancode_home
- let pageup = sdl_scancode_pageup
- let delete = sdl_scancode_delete
- let kend = sdl_scancode_end
- let pagedown = sdl_scancode_pagedown
- let right = sdl_scancode_right
- let left = sdl_scancode_left
- let down = sdl_scancode_down
- let up = sdl_scancode_up
- let numlockclear = sdl_scancode_numlockclear
- let kp_divide = sdl_scancode_kp_divide
- let kp_multiply = sdl_scancode_kp_multiply
- let kp_minus = sdl_scancode_kp_minus
- let kp_plus = sdl_scancode_kp_plus
- let kp_enter = sdl_scancode_kp_enter
- let kp_1 = sdl_scancode_kp_1
- let kp_2 = sdl_scancode_kp_2
- let kp_3 = sdl_scancode_kp_3
- let kp_4 = sdl_scancode_kp_4
- let kp_5 = sdl_scancode_kp_5
- let kp_6 = sdl_scancode_kp_6
- let kp_7 = sdl_scancode_kp_7
- let kp_8 = sdl_scancode_kp_8
- let kp_9 = sdl_scancode_kp_9
- let kp_0 = sdl_scancode_kp_0
- let kp_period = sdl_scancode_kp_period
- let nonusbackslash = sdl_scancode_nonusbackslash
- let application = sdl_scancode_application
- let kp_equals = sdl_scancode_kp_equals
- let f13 = sdl_scancode_f13
- let f14 = sdl_scancode_f14
- let f15 = sdl_scancode_f15
- let f16 = sdl_scancode_f16
- let f17 = sdl_scancode_f17
- let f18 = sdl_scancode_f18
- let f19 = sdl_scancode_f19
- let f20 = sdl_scancode_f20
- let f21 = sdl_scancode_f21
- let f22 = sdl_scancode_f22
- let f23 = sdl_scancode_f23
- let f24 = sdl_scancode_f24
- let execute = sdl_scancode_execute
- let help = sdl_scancode_help
- let menu = sdl_scancode_menu
- let select = sdl_scancode_select
- let stop = sdl_scancode_stop
- let again = sdl_scancode_again
- let undo = sdl_scancode_undo
- let cut = sdl_scancode_cut
- let copy = sdl_scancode_copy
- let paste = sdl_scancode_paste
- let find = sdl_scancode_find
- let mute = sdl_scancode_mute
- let volumeup = sdl_scancode_volumeup
- let volumedown = sdl_scancode_volumedown
- let kp_comma = sdl_scancode_kp_comma
- let kp_equalsas400 = sdl_scancode_kp_equalsas400
- let international1 = sdl_scancode_international1
- let international2 = sdl_scancode_international2
- let international3 = sdl_scancode_international3
- let international4 = sdl_scancode_international4
- let international5 = sdl_scancode_international5
- let international6 = sdl_scancode_international6
- let international7 = sdl_scancode_international7
- let international8 = sdl_scancode_international8
- let international9 = sdl_scancode_international9
- let lang1 = sdl_scancode_lang1
- let lang2 = sdl_scancode_lang2
- let lang3 = sdl_scancode_lang3
- let lang4 = sdl_scancode_lang4
- let lang5 = sdl_scancode_lang5
- let lang6 = sdl_scancode_lang6
- let lang7 = sdl_scancode_lang7
- let lang8 = sdl_scancode_lang8
- let lang9 = sdl_scancode_lang9
- let alterase = sdl_scancode_alterase
- let sysreq = sdl_scancode_sysreq
- let cancel = sdl_scancode_cancel
- let clear = sdl_scancode_clear
- let prior = sdl_scancode_prior
- let return2 = sdl_scancode_return2
- let separator = sdl_scancode_separator
- let out = sdl_scancode_out
- let oper = sdl_scancode_oper
- let clearagain = sdl_scancode_clearagain
- let crsel = sdl_scancode_crsel
- let exsel = sdl_scancode_exsel
- let kp_00 = sdl_scancode_kp_00
- let kp_000 = sdl_scancode_kp_000
- let thousandsseparator = sdl_scancode_thousandsseparator
- let decimalseparator = sdl_scancode_decimalseparator
- let currencyunit = sdl_scancode_currencyunit
- let currencysubunit = sdl_scancode_currencysubunit
- let kp_leftparen = sdl_scancode_kp_leftparen
- let kp_rightparen = sdl_scancode_kp_rightparen
- let kp_leftbrace = sdl_scancode_kp_leftbrace
- let kp_rightbrace = sdl_scancode_kp_rightbrace
- let kp_tab = sdl_scancode_kp_tab
- let kp_backspace = sdl_scancode_kp_backspace
- let kp_a = sdl_scancode_kp_a
- let kp_b = sdl_scancode_kp_b
- let kp_c = sdl_scancode_kp_c
- let kp_d = sdl_scancode_kp_d
- let kp_e = sdl_scancode_kp_e
- let kp_f = sdl_scancode_kp_f
- let kp_xor = sdl_scancode_kp_xor
- let kp_power = sdl_scancode_kp_power
- let kp_percent = sdl_scancode_kp_percent
- let kp_less = sdl_scancode_kp_less
- let kp_greater = sdl_scancode_kp_greater
- let kp_ampersand = sdl_scancode_kp_ampersand
- let kp_dblampersand = sdl_scancode_kp_dblampersand
- let kp_verticalbar = sdl_scancode_kp_verticalbar
- let kp_dblverticalbar = sdl_scancode_kp_dblverticalbar
- let kp_colon = sdl_scancode_kp_colon
- let kp_hash = sdl_scancode_kp_hash
- let kp_space = sdl_scancode_kp_space
- let kp_at = sdl_scancode_kp_at
- let kp_exclam = sdl_scancode_kp_exclam
- let kp_memstore = sdl_scancode_kp_memstore
- let kp_memrecall = sdl_scancode_kp_memrecall
- let kp_memclear = sdl_scancode_kp_memclear
- let kp_memadd = sdl_scancode_kp_memadd
- let kp_memsubtract = sdl_scancode_kp_memsubtract
- let kp_memmultiply = sdl_scancode_kp_memmultiply
- let kp_memdivide = sdl_scancode_kp_memdivide
- let kp_plusminus = sdl_scancode_kp_plusminus
- let kp_clear = sdl_scancode_kp_clear
- let kp_clearentry = sdl_scancode_kp_clearentry
- let kp_binary = sdl_scancode_kp_binary
- let kp_octal = sdl_scancode_kp_octal
- let kp_decimal = sdl_scancode_kp_decimal
- let kp_hexadecimal = sdl_scancode_kp_hexadecimal
- let lctrl = sdl_scancode_lctrl
- let lshift = sdl_scancode_lshift
- let lalt = sdl_scancode_lalt
- let lgui = sdl_scancode_lgui
- let rctrl = sdl_scancode_rctrl
- let rshift = sdl_scancode_rshift
- let ralt = sdl_scancode_ralt
- let rgui = sdl_scancode_rgui
- let mode = sdl_scancode_mode
- let audionext = sdl_scancode_audionext
- let audioprev = sdl_scancode_audioprev
- let audiostop = sdl_scancode_audiostop
- let audioplay = sdl_scancode_audioplay
- let audiomute = sdl_scancode_audiomute
- let mediaselect = sdl_scancode_mediaselect
- let www = sdl_scancode_www
- let mail = sdl_scancode_mail
- let calculator = sdl_scancode_calculator
- let computer = sdl_scancode_computer
- let ac_search = sdl_scancode_ac_search
- let ac_home = sdl_scancode_ac_home
- let ac_back = sdl_scancode_ac_back
- let ac_forward = sdl_scancode_ac_forward
- let ac_stop = sdl_scancode_ac_stop
- let ac_refresh = sdl_scancode_ac_refresh
- let ac_bookmarks = sdl_scancode_ac_bookmarks
- let brightnessdown = sdl_scancode_brightnessdown
- let brightnessup = sdl_scancode_brightnessup
- let displayswitch = sdl_scancode_displayswitch
- let kbdillumtoggle = sdl_scancode_kbdillumtoggle
- let kbdillumdown = sdl_scancode_kbdillumdown
- let kbdillumup = sdl_scancode_kbdillumup
- let eject = sdl_scancode_eject
- let sleep = sdl_scancode_sleep
- let app1 = sdl_scancode_app1
- let app2 = sdl_scancode_app2
-
+ include C.Types.Scancode
let enum_of_scancode = [|
`Unknown; `Unknown; `Unknown; `Unknown; `A; `B; `C; `D; `E; `F;
`G; `H; `I; `J; `K; `L; `M; `N; `O; `P; `Q; `R; `S; `T; `U; `V;
@@ -2902,1280 +1749,399 @@
end
type keycode = int
-let keycode = int
-module K = struct
- let scancode_mask = sdlk_scancode_mask
- let unknown = sdlk_unknown
- let return = sdlk_return
- let escape = sdlk_escape
- let backspace = sdlk_backspace
- let tab = sdlk_tab
- let space = sdlk_space
- let exclaim = sdlk_exclaim
- let quotedbl = sdlk_quotedbl
- let hash = sdlk_hash
- let percent = sdlk_percent
- let dollar = sdlk_dollar
- let ampersand = sdlk_ampersand
- let quote = sdlk_quote
- let leftparen = sdlk_leftparen
- let rightparen = sdlk_rightparen
- let asterisk = sdlk_asterisk
- let plus = sdlk_plus
- let comma = sdlk_comma
- let minus = sdlk_minus
- let period = sdlk_period
- let slash = sdlk_slash
- let k0 = sdlk_0
- let k1 = sdlk_1
- let k2 = sdlk_2
- let k3 = sdlk_3
- let k4 = sdlk_4
- let k5 = sdlk_5
- let k6 = sdlk_6
- let k7 = sdlk_7
- let k8 = sdlk_8
- let k9 = sdlk_9
- let colon = sdlk_colon
- let semicolon = sdlk_semicolon
- let less = sdlk_less
- let equals = sdlk_equals
- let greater = sdlk_greater
- let question = sdlk_question
- let at = sdlk_at
- let leftbracket = sdlk_leftbracket
- let backslash = sdlk_backslash
- let rightbracket = sdlk_rightbracket
- let caret = sdlk_caret
- let underscore = sdlk_underscore
- let backquote = sdlk_backquote
- let a = sdlk_a
- let b = sdlk_b
- let c = sdlk_c
- let d = sdlk_d
- let e = sdlk_e
- let f = sdlk_f
- let g = sdlk_g
- let h = sdlk_h
- let i = sdlk_i
- let j = sdlk_j
- let k = sdlk_k
- let l = sdlk_l
- let m = sdlk_m
- let n = sdlk_n
- let o = sdlk_o
- let p = sdlk_p
- let q = sdlk_q
- let r = sdlk_r
- let s = sdlk_s
- let t = sdlk_t
- let u = sdlk_u
- let v = sdlk_v
- let w = sdlk_w
- let x = sdlk_x
- let y = sdlk_y
- let z = sdlk_z
- let capslock = sdlk_capslock
- let f1 = sdlk_f1
- let f2 = sdlk_f2
- let f3 = sdlk_f3
- let f4 = sdlk_f4
- let f5 = sdlk_f5
- let f6 = sdlk_f6
- let f7 = sdlk_f7
- let f8 = sdlk_f8
- let f9 = sdlk_f9
- let f10 = sdlk_f10
- let f11 = sdlk_f11
- let f12 = sdlk_f12
- let printscreen = sdlk_printscreen
- let scrolllock = sdlk_scrolllock
- let pause = sdlk_pause
- let insert = sdlk_insert
- let home = sdlk_home
- let pageup = sdlk_pageup
- let delete = sdlk_delete
- let kend = sdlk_end
- let pagedown = sdlk_pagedown
- let right = sdlk_right
- let left = sdlk_left
- let down = sdlk_down
- let up = sdlk_up
- let numlockclear = sdlk_numlockclear
- let kp_divide = sdlk_kp_divide
- let kp_multiply = sdlk_kp_multiply
- let kp_minus = sdlk_kp_minus
- let kp_plus = sdlk_kp_plus
- let kp_enter = sdlk_kp_enter
- let kp_1 = sdlk_kp_1
- let kp_2 = sdlk_kp_2
- let kp_3 = sdlk_kp_3
- let kp_4 = sdlk_kp_4
- let kp_5 = sdlk_kp_5
- let kp_6 = sdlk_kp_6
- let kp_7 = sdlk_kp_7
- let kp_8 = sdlk_kp_8
- let kp_9 = sdlk_kp_9
- let kp_0 = sdlk_kp_0
- let kp_period = sdlk_kp_period
- let application = sdlk_application
- let power = sdlk_power
- let kp_equals = sdlk_kp_equals
- let f13 = sdlk_f13
- let f14 = sdlk_f14
- let f15 = sdlk_f15
- let f16 = sdlk_f16
- let f17 = sdlk_f17
- let f18 = sdlk_f18
- let f19 = sdlk_f19
- let f20 = sdlk_f20
- let f21 = sdlk_f21
- let f22 = sdlk_f22
- let f23 = sdlk_f23
- let f24 = sdlk_f24
- let execute = sdlk_execute
- let help = sdlk_help
- let menu = sdlk_menu
- let select = sdlk_select
- let stop = sdlk_stop
- let again = sdlk_again
- let undo = sdlk_undo
- let cut = sdlk_cut
- let copy = sdlk_copy
- let paste = sdlk_paste
- let find = sdlk_find
- let mute = sdlk_mute
- let volumeup = sdlk_volumeup
- let volumedown = sdlk_volumedown
- let kp_comma = sdlk_kp_comma
- let kp_equalsas400 = sdlk_kp_equalsas400
- let alterase = sdlk_alterase
- let sysreq = sdlk_sysreq
- let cancel = sdlk_cancel
- let clear = sdlk_clear
- let prior = sdlk_prior
- let return2 = sdlk_return2
- let separator = sdlk_separator
- let out = sdlk_out
- let oper = sdlk_oper
- let clearagain = sdlk_clearagain
- let crsel = sdlk_crsel
- let exsel = sdlk_exsel
- let kp_00 = sdlk_kp_00
- let kp_000 = sdlk_kp_000
- let thousandsseparator = sdlk_thousandsseparator
- let decimalseparator = sdlk_decimalseparator
- let currencyunit = sdlk_currencyunit
- let currencysubunit = sdlk_currencysubunit
- let kp_leftparen = sdlk_kp_leftparen
- let kp_rightparen = sdlk_kp_rightparen
- let kp_leftbrace = sdlk_kp_leftbrace
- let kp_rightbrace = sdlk_kp_rightbrace
- let kp_tab = sdlk_kp_tab
- let kp_backspace = sdlk_kp_backspace
- let kp_a = sdlk_kp_a
- let kp_b = sdlk_kp_b
- let kp_c = sdlk_kp_c
- let kp_d = sdlk_kp_d
- let kp_e = sdlk_kp_e
- let kp_f = sdlk_kp_f
- let kp_xor = sdlk_kp_xor
- let kp_power = sdlk_kp_power
- let kp_percent = sdlk_kp_percent
- let kp_less = sdlk_kp_less
- let kp_greater = sdlk_kp_greater
- let kp_ampersand = sdlk_kp_ampersand
- let kp_dblampersand = sdlk_kp_dblampersand
- let kp_verticalbar = sdlk_kp_verticalbar
- let kp_dblverticalbar = sdlk_kp_dblverticalbar
- let kp_colon = sdlk_kp_colon
- let kp_hash = sdlk_kp_hash
- let kp_space = sdlk_kp_space
- let kp_at = sdlk_kp_at
- let kp_exclam = sdlk_kp_exclam
- let kp_memstore = sdlk_kp_memstore
- let kp_memrecall = sdlk_kp_memrecall
- let kp_memclear = sdlk_kp_memclear
- let kp_memadd = sdlk_kp_memadd
- let kp_memsubtract = sdlk_kp_memsubtract
- let kp_memmultiply = sdlk_kp_memmultiply
- let kp_memdivide = sdlk_kp_memdivide
- let kp_plusminus = sdlk_kp_plusminus
- let kp_clear = sdlk_kp_clear
- let kp_clearentry = sdlk_kp_clearentry
- let kp_binary = sdlk_kp_binary
- let kp_octal = sdlk_kp_octal
- let kp_decimal = sdlk_kp_decimal
- let kp_hexadecimal = sdlk_kp_hexadecimal
- let lctrl = sdlk_lctrl
- let lshift = sdlk_lshift
- let lalt = sdlk_lalt
- let lgui = sdlk_lgui
- let rctrl = sdlk_rctrl
- let rshift = sdlk_rshift
- let ralt = sdlk_ralt
- let rgui = sdlk_rgui
- let mode = sdlk_mode
- let audionext = sdlk_audionext
- let audioprev = sdlk_audioprev
- let audiostop = sdlk_audiostop
- let audioplay = sdlk_audioplay
- let audiomute = sdlk_audiomute
- let mediaselect = sdlk_mediaselect
- let www = sdlk_www
- let mail = sdlk_mail
- let calculator = sdlk_calculator
- let computer = sdlk_computer
- let ac_search = sdlk_ac_search
- let ac_home = sdlk_ac_home
- let ac_back = sdlk_ac_back
- let ac_forward = sdlk_ac_forward
- let ac_stop = sdlk_ac_stop
- let ac_refresh = sdlk_ac_refresh
- let ac_bookmarks = sdlk_ac_bookmarks
- let brightnessdown = sdlk_brightnessdown
- let brightnessup = sdlk_brightnessup
- let displayswitch = sdlk_displayswitch
- let kbdillumtoggle = sdlk_kbdillumtoggle
- let kbdillumdown = sdlk_kbdillumdown
- let kbdillumup = sdlk_kbdillumup
- let eject = sdlk_eject
- let sleep = sdlk_sleep
-end
+module K = C.Types.K
type keymod = int
-let keymod = int_as_uint16_t
-
-module Kmod = struct
- let none = kmod_none
- let lshift = kmod_lshift
- let rshift = kmod_rshift
- let lctrl = kmod_lctrl
- let rctrl = kmod_rctrl
- let lalt = kmod_lalt
- let ralt = kmod_ralt
- let lgui = kmod_lgui
- let rgui = kmod_rgui
- let num = kmod_num
- let caps = kmod_caps
- let mode = kmod_mode
- let reserved = kmod_reserved
- let ctrl = kmod_ctrl
- let shift = kmod_shift
- let alt = kmod_alt
- let gui = kmod_gui
-end
-let get_keyboard_focus =
- foreign "SDL_GetKeyboardFocus" (void @-> returning window_opt)
+module Kmod = C.Types.Kmod
-let get_keyboard_state =
- foreign "SDL_GetKeyboardState" (ptr int @-> returning (ptr int))
+let get_keyboard_focus = C.Functions.get_keyboard_focus
let get_keyboard_state () =
let count = allocate int 0 in
- let p = get_keyboard_state count in
- bigarray_of_ptr array1 (!@ count) Bigarray.int8_unsigned p
+ let p = C.Functions.get_keyboard_state count in
+ let p' = coerce (ptr uint8_t) (ptr int) p in
+ let a = CArray.from_ptr p' (!@ count) in
+ bigarray_of_array array1 Bigarray.int8_unsigned a
-let get_key_from_name =
- foreign "SDL_GetKeyFromName" (string @-> returning keycode)
+let get_key_from_name = C.Functions.get_key_from_name
-let get_key_from_scancode =
- foreign "SDL_GetKeyFromScancode" (scancode @-> returning keycode)
+let get_key_from_scancode = C.Functions.get_key_from_scancode
-let get_key_name =
- foreign "SDL_GetKeyName" (keycode @-> returning string)
+let get_key_name = C.Functions.get_key_name
-let get_mod_state =
- foreign "SDL_GetModState" (void @-> returning keymod)
+let get_mod_state () = Unsigned.UInt16.to_int (C.Functions.get_mod_state ())
-let get_scancode_from_key =
- foreign "SDL_GetScancodeFromKey" (keycode @-> returning scancode)
+let get_scancode_from_key = C.Functions.get_scancode_from_key
-let get_scancode_from_name =
- foreign "SDL_GetScancodeFromName" (string @-> returning scancode)
+let get_scancode_from_name = C.Functions.get_scancode_from_name
-let get_scancode_name =
- foreign "SDL_GetScancodeName" (scancode @-> returning string)
+let get_scancode_name = C.Functions. get_scancode_name
-let has_screen_keyboard_support =
- foreign "SDL_HasScreenKeyboardSupport" (void @-> returning bool)
+let has_screen_keyboard_support = C.Functions.has_screen_keyboard_support
-let is_screen_keyboard_shown =
- foreign "SDL_IsScreenKeyboardShown" (window @-> returning bool)
+let is_screen_keyboard_shown = C.Functions.is_screen_keyboard_shown
-let is_text_input_active =
- foreign "SDL_IsTextInputActive" (void @-> returning bool)
+let is_text_input_active = C.Functions.is_text_input_active
-let set_mod_state =
- foreign "SDL_SetModState" (keymod @-> returning void)
-
-let set_text_input_rect =
- foreign "SDL_SetTextInputRect" (ptr rect @-> returning void)
+let set_mod_state m = C.Functions.set_mod_state (Unsigned.UInt16.of_int m)
let set_text_input_rect r =
- set_text_input_rect (Rect.opt_addr r)
+ C.Functions.set_text_input_rect (Rect.opt_addr r)
-let start_text_input =
- foreign "SDL_StartTextInput" (void @-> returning void)
+let start_text_input = C.Functions.start_text_input
-let stop_text_input =
- foreign "SDL_StopTextInput" (void @-> returning void)
+let stop_text_input = C.Functions.stop_text_input
(* Mouse *)
-type cursor = unit ptr
-let cursor : cursor typ = ptr void
-let cursor_opt : cursor option typ = ptr_opt void
+type cursor = C.Types.cursor ptr
let unsafe_cursor_of_ptr addr : cursor =
- ptr_of_raw_address addr
+ from_voidp C.Types.cursor (ptr_of_raw_address addr)
let unsafe_ptr_of_cursor cursor =
raw_address_of_ptr (to_voidp cursor)
module System_cursor = struct
type t = int
- let arrow = sdl_system_cursor_arrow
- let ibeam = sdl_system_cursor_ibeam
- let wait = sdl_system_cursor_wait
- let crosshair = sdl_system_cursor_crosshair
- let waitarrow = sdl_system_cursor_waitarrow
- let size_nw_se = sdl_system_cursor_sizenwse
- let size_ne_sw = sdl_system_cursor_sizenesw
- let size_we = sdl_system_cursor_sizewe
- let size_ns = sdl_system_cursor_sizens
- let size_all = sdl_system_cursor_sizeall
- let no = sdl_system_cursor_no
- let hand = sdl_system_cursor_hand
-end
-
-module Button = struct
- let left = sdl_button_left
- let right = sdl_button_right
- let middle = sdl_button_middle
- let x1 = sdl_button_x1
- let x2 = sdl_button_x2
-
- let i = Int32.of_int
- let lmask = i sdl_button_lmask
- let mmask = i sdl_button_mmask
- let rmask = i sdl_button_rmask
- let x1mask = i sdl_button_x1mask
- let x2mask = i sdl_button_x2mask
+ include C.Types.System_cursor
end
-let capture_mouse =
- foreign "SDL_CaptureMouse" (bool @-> returning zero_to_ok)
+module Button = C.Types.Button
-let create_color_cursor =
- foreign "SDL_CreateColorCursor"
- (surface @-> int @-> int @-> returning (some_to_ok cursor_opt))
+let capture_mouse b = zero_to_ok (C.Functions.capture_mouse b)
let create_color_cursor s ~hot_x ~hot_y =
- create_color_cursor s hot_x hot_y
-
-let create_cursor =
- foreign "SDL_CreateCursor"
- (ptr void @-> ptr void @-> int @-> int @-> int @-> int @->
- returning (some_to_ok cursor_opt))
+ some_to_ok (C.Functions.create_color_cursor s hot_x hot_y)
let create_cursor d m ~w ~h ~hot_x ~hot_y =
(* FIXME: we could try to check bounds *)
- let d = to_voidp (bigarray_start array1 d) in
- let m = to_voidp (bigarray_start array1 m) in
- create_cursor d m w h hot_x hot_y
-
-let create_system_cursor =
- foreign "SDL_CreateSystemCursor"
- (int @-> returning (some_to_ok cursor_opt))
-
-let free_cursor =
- foreign "SDL_FreeCursor" (cursor @-> returning void)
-
-let get_cursor =
- foreign "SDL_GetCursor" (void @-> returning cursor_opt)
-
-let get_default_cursor =
- foreign "SDL_GetDefaultCursor" (void @-> returning cursor_opt)
-
-let get_global_mouse_state =
- foreign "SDL_GetGlobalMouseState"
- (ptr int @-> ptr int @-> returning int32_as_uint32_t)
+ let d = bigarray_start array1 d in
+ let m = bigarray_start array1 m in
+ some_to_ok (C.Functions.create_cursor d m w h hot_x hot_y)
+
+let create_system_cursor i =
+ some_to_ok (C.Functions.create_system_cursor i)
+
+let free_cursor = C.Functions.free_cursor
+
+let get_cursor = C.Functions.get_cursor
+
+let get_default_cursor = C.Functions.get_default_cursor
let get_global_mouse_state () =
let x = allocate int 0 in
let y = allocate int 0 in
- let s = get_global_mouse_state x y in
- s, (!@ x, !@ y)
+ let s = C.Functions.get_global_mouse_state x y in
+ Unsigned.UInt32.to_int32 s, (!@ x, !@ y)
let get_mouse_focus =
- foreign "SDL_GetMouseFocus" (void @-> returning window_opt)
-
-let get_mouse_state =
- foreign "SDL_GetMouseState"
- (ptr int @-> ptr int @-> returning int32_as_uint32_t)
+ C.Functions.get_mouse_focus
let get_mouse_state () =
let x = allocate int 0 in
let y = allocate int 0 in
- let s = get_mouse_state x y in
- s, (!@ x, !@ y)
+ let s = C.Functions.get_mouse_state x y in
+ Unsigned.UInt32.to_int32 s, (!@ x, !@ y)
-let get_relative_mouse_mode =
- foreign "SDL_GetRelativeMouseMode" (void @-> returning bool)
+let get_relative_mouse_mode = C.Functions.get_relative_mouse_mode
-let get_relative_mouse_state =
- foreign "SDL_GetRelativeMouseState"
- (ptr int @-> ptr int @-> returning int32_as_uint32_t)
-
-let get_relative_mouse_state () =
+ let get_relative_mouse_state () =
let x = allocate int 0 in
let y = allocate int 0 in
- let s = get_relative_mouse_state x y in
- s, (!@ x, !@ y)
-
-let show_cursor =
- foreign "SDL_ShowCursor" (int @-> returning bool_to_ok)
+ let s = C.Functions.get_relative_mouse_state x y in
+ Unsigned.UInt32.to_int32 s, (!@ x, !@ y)
let get_cursor_shown () =
- show_cursor (-1)
+ bool_to_ok (C.Functions.show_cursor (-1))
-let set_cursor =
- foreign "SDL_SetCursor" (cursor_opt @-> returning void)
+let set_cursor = C.Functions.set_cursor
-let set_relative_mouse_mode =
- foreign "SDL_SetRelativeMouseMode" (bool @-> returning zero_to_ok)
+let set_relative_mouse_mode b =
+ zero_to_ok (C.Functions.set_relative_mouse_mode b)
let show_cursor b =
- show_cursor (if b then 1 else 0)
-
-let warp_mouse_in_window =
- foreign "SDL_WarpMouseInWindow"
- (window_opt @-> int @-> int @-> returning void)
+ bool_to_ok (C.Functions.show_cursor (if b then 1 else 0))
let warp_mouse_in_window w ~x ~y =
- warp_mouse_in_window w x y
-
-let warp_mouse_global=
- foreign "SDL_WarpMouseGlobal" (int @-> int @-> returning zero_to_ok)
+ C.Functions.warp_mouse_in_window w x y
let warp_mouse_global ~x ~y =
- warp_mouse_global x y
+ zero_to_ok (C.Functions.warp_mouse_global x y)
(* Touch *)
type touch_id = int64
-let touch_id = int64_t
-let touch_mouse_id = Int64.of_int32 (sdl_touch_mouseid)
+let touch_mouse_id = C.Types.touch_mouseid
type gesture_id = int64
-let gesture_id = int64_t
type finger_id = int64
-let finger_id = int64_t
-
-type _finger
-type finger = _finger structure
-let finger : finger typ = structure "SDL_Finger"
-let finger_finger_id = field finger "id" finger_id
-let finger_x = field finger "x" float
-let finger_y = field finger "y" float
-let finger_pressure = field finger "pressure" float
-let () = seal finger
module Finger = struct
- let id f = getf f finger_finger_id
- let x f = getf f finger_x
- let y f = getf f finger_y
- let pressure f = getf f finger_pressure
-end
+ include C.Types.Finger
-let get_num_touch_devices =
- foreign "SDL_GetNumTouchDevices" (void @-> returning int)
+ let id f = getf f id
+ let x f = getf f x
+ let y f = getf f y
+ let pressure f = getf f pressure
+end
+type finger = Finger.t
-let get_num_touch_fingers =
- foreign "SDL_GetNumTouchFingers" (touch_id @-> returning int)
+let get_num_touch_devices = C.Functions.get_num_touch_devices
-let get_touch_device =
- foreign "SDL_GetTouchDevice" (int @-> returning touch_id)
+let get_num_touch_fingers = C.Functions.get_num_touch_fingers
let get_touch_device i =
- match get_touch_device i with
+ match C.Functions.get_touch_device i with
| 0L -> error () | id -> Ok id
-let get_touch_finger =
- foreign "SDL_GetTouchFinger"
- (touch_id @-> int @-> returning (ptr_opt finger))
-
let get_touch_finger id i =
- match get_touch_finger id i with
+ match C.Functions.get_touch_finger id i with
| None -> None | Some p -> Some (!@ p)
-let load_dollar_templates =
- foreign "SDL_LoadDollarTemplates"
- (touch_id @-> rw_ops @-> returning zero_to_ok)
-
-let record_gesture =
- foreign "SDL_RecordGesture" (touch_id @-> returning one_to_ok)
-
-let save_dollar_template =
- foreign "SDL_SaveDollarTemplate"
- (gesture_id @-> rw_ops @-> returning zero_to_ok)
+let load_dollar_templates x y =
+ zero_to_ok (C.Functions.load_dollar_templates x y)
-let save_all_dollar_templates =
- foreign "SDL_SaveAllDollarTemplates" (rw_ops @-> returning zero_to_ok)
+let record_gesture i =
+ one_to_ok (C.Functions.record_gesture i)
+
+let save_dollar_template x y =
+ zero_to_ok (C.Functions.save_dollar_template x y)
+
+let save_all_dollar_templates o =
+ zero_to_ok (C.Functions.save_all_dollar_templates o)
(* Joystick *)
-type _joystick_guid
-type joystick_guid = _joystick_guid structure
-let joystick_guid : joystick_guid typ = structure "SDL_JoystickGUID"
-(* FIXME: No array here, see
- https://github.com/ocamllabs/ocaml-ctypes/issues/113 *)
-(* let _= field joystick_guid "data" (array 16 uint8_t) *)
-let _= field joystick_guid "data0" uint8_t
-let _= field joystick_guid "data1" uint8_t
-let _= field joystick_guid "data2" uint8_t
-let _= field joystick_guid "data3" uint8_t
-let _= field joystick_guid "data4" uint8_t
-let _= field joystick_guid "data5" uint8_t
-let _= field joystick_guid "data6" uint8_t
-let _= field joystick_guid "data7" uint8_t
-let _= field joystick_guid "data8" uint8_t
-let _= field joystick_guid "data9" uint8_t
-let _= field joystick_guid "data10" uint8_t
-let _= field joystick_guid "data11" uint8_t
-let _= field joystick_guid "data12" uint8_t
-let _= field joystick_guid "data13" uint8_t
-let _= field joystick_guid "data14" uint8_t
-let _= field joystick_guid "data15" uint8_t
-let () = seal joystick_guid
+type joystick_guid = C.Types.guid
type joystick_id = int32
-let joystick_id = int32_t
-type joystick = unit ptr
-let joystick : joystick typ = ptr void
-let joystick_opt : joystick option typ = ptr_opt void
+type joystick = C.Types.joystick ptr
let unsafe_joystick_of_ptr addr : joystick =
- ptr_of_raw_address addr
+ from_voidp C.Types.joystick (ptr_of_raw_address addr)
let unsafe_ptr_of_joystick joystick =
raw_address_of_ptr (to_voidp joystick)
-module Hat = struct
- type t = int
- let centered = sdl_hat_centered
- let up = sdl_hat_up
- let right = sdl_hat_right
- let down = sdl_hat_down
- let left = sdl_hat_left
- let rightup = sdl_hat_rightup
- let rightdown = sdl_hat_rightdown
- let leftup = sdl_hat_leftup
- let leftdown = sdl_hat_leftdown
-end
+module Hat = C.Types.Hat
-module Joystick_power_level = struct
- type t = int
- let unknown = sdl_joystick_power_unknown
- let low = sdl_joystick_power_low
- let medium = sdl_joystick_power_medium
- let full = sdl_joystick_power_full
- let wired = sdl_joystick_power_wired
- let max = sdl_joystick_power_max
-end
+module Joystick_power_level = C.Types.Joystick_power_level
-module Joystick_type = struct
- type t = int
- let unknown = sdl_joystick_type_unknown
- let gamecontroller = sdl_joystick_type_gamecontroller
- let wheel = sdl_joystick_type_wheel
- let arcade_stick = sdl_joystick_type_arcade_stick
- let flight_stick = sdl_joystick_type_flight_stick
- let dance_pad = sdl_joystick_type_dance_pad
- let guitar = sdl_joystick_type_guitar
- let drum_kit = sdl_joystick_type_drum_kit
- let arcade_pad = sdl_joystick_type_arcade_pad
- let throttle = sdl_joystick_type_throttle
-end
+module Joystick_type = C.Types.Joystick_type
-let joystick_close =
- foreign "SDL_JoystickClose" (joystick @-> returning void)
+let joystick_close = C.Functions.joystick_close
-let joystick_current_power_level =
- foreign "SDL_JoystickCurrentPowerLevel"
- (joystick @-> returning int)
+let joystick_current_power_level = C.Functions.joystick_current_power_level
-let joystick_event_state =
- foreign "SDL_JoystickEventState" (int @-> returning nat_to_ok)
+let joystick_event_state i =
+ C.Functions.joystick_event_state i |> nat_to_ok |> Result.map Unsigned.UInt8.of_int
-let joystick_from_instance_id =
- foreign "SDL_JoystickFromInstanceID" (joystick_id @-> returning joystick)
+let joystick_from_instance_id = C.Functions.joystick_from_instance_id
let joystick_get_event_state () =
- joystick_event_state sdl_query
+ joystick_event_state C.Types.sdl_query
let joystick_set_event_state s =
- joystick_event_state s
-
-let joystick_get_attached =
- foreign "SDL_JoystickGetAttached" (joystick @-> returning bool)
+ joystick_event_state (Unsigned.UInt8.to_int s)
-let joystick_get_axis =
- foreign "SDL_JoystickGetAxis" (joystick @-> int @-> returning int16_t)
+let joystick_get_attached = C.Functions.joystick_get_attached
-let joystick_get_axis_initial_state =
- foreign "SDL_JoystickGetAxisInitialState"
- (joystick @-> int @-> returning int16_t)
+let joystick_get_axis = C.Functions.joystick_get_axis
-let joystick_get_ball =
- foreign "SDL_JoystickGetBall"
- (joystick @-> int @-> (ptr int) @-> (ptr int) @-> returning int)
+let joystick_get_axis_initial_state j i =
+ let out = allocate int16_t 0 in
+ (* FIXME: should probably be an option, no? *)
+ if C.Functions.joystick_get_axis_initial_state j i out then !@ out else 0
let joystick_get_ball j i =
let x = allocate int 0 in
let y = allocate int 0 in
- match joystick_get_ball j i x y with
+ match C.Functions.joystick_get_ball j i x y with
| 0 -> Ok (!@ x, !@ y) | _ -> error ()
-let joystick_get_button =
- foreign "SDL_JoystickGetButton"
- (joystick @-> int @-> returning int_as_uint8_t)
+let joystick_get_button j i =
+ Unsigned.UInt8.to_int (C.Functions.joystick_get_button j i)
-let joystick_get_device_guid =
- foreign "SDL_JoystickGetDeviceGUID" (int @-> returning joystick_guid)
+let joystick_get_device_guid = C.Functions.joystick_get_device_guid
-let joystick_get_device_product =
- foreign "SDL_JoystickGetDeviceProduct" (int @-> returning int_as_uint16_t)
+let joystick_get_device_product i =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_device_product i)
-let joystick_get_device_product_version =
- foreign "SDL_JoystickGetDeviceProductVersion"
- (int @-> returning int_as_uint16_t)
+let joystick_get_device_product_version i =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_device_product_version i)
-let joystick_get_device_type =
- foreign "SDL_JoystickGetDeviceType" (int @-> returning int)
+let joystick_get_device_type = C.Functions.joystick_get_device_type
-let joystick_get_device_instance_id =
- foreign "SDL_JoystickGetDeviceInstanceID" (int @-> returning joystick_id)
+let joystick_get_device_instance_id = C.Functions.joystick_get_device_instance_id
-let joystick_get_device_vendor =
- foreign "SDL_JoystickGetDeviceVendor" (int @-> returning int_as_uint16_t)
+let joystick_get_device_vendor i =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_device_vendor i)
-let joystick_get_guid =
- foreign "SDL_JoystickGetGUID" (joystick @-> returning joystick_guid)
+let joystick_get_guid = C.Functions.joystick_get_guid
-let joystick_get_guid_from_string =
- foreign "SDL_JoystickGetGUIDFromString" (string @-> returning joystick_guid)
-
-let joystick_get_guid_string =
- foreign "SDL_JoystickGetGUIDString"
- (joystick_guid @-> ptr char @-> int @-> returning void)
+let joystick_get_guid_from_string = C.Functions.joystick_get_guid_from_string
let joystick_get_guid_string guid =
let len = 33 in
let s = CArray.start (CArray.make char 33) in
- joystick_get_guid_string guid s len;
+ C.Functions.joystick_get_guid_string guid s len;
coerce (ptr char) string s
-let joystick_get_hat =
- foreign "SDL_JoystickGetHat" (joystick @-> int @-> returning int_as_uint8_t)
-
-let joystick_get_product =
- foreign "SDL_JoystickGetProduct" (joystick @-> returning int_as_uint16_t)
+let joystick_get_hat j i =
+ Unsigned.UInt8.to_int (C.Functions.joystick_get_hat j i)
-let joystick_get_product_version =
- foreign "SDL_JoystickGetProductVersion"
- (joystick @-> returning int_as_uint16_t)
+let joystick_get_product j =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_product j)
-let joystick_get_type =
- foreign "SDL_JoystickGetType" (joystick @-> returning int)
+let joystick_get_product_version j =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_product_version j)
-let joystick_get_vendor =
- foreign "SDL_JoystickGetVendor" (joystick @-> returning int_as_uint16_t)
+let joystick_get_type = C.Functions.joystick_get_type
-let joystick_instance_id =
- foreign "SDL_JoystickInstanceID" (joystick @-> returning joystick_id)
+let joystick_get_vendor j =
+ Unsigned.UInt16.to_int (C.Functions.joystick_get_vendor j)
let joystick_instance_id j =
- match joystick_instance_id j with
+ match C.Functions.joystick_instance_id j with
| n when n < 0l -> error () | n -> Ok n
-let joystick_name =
- foreign "SDL_JoystickName" (joystick @-> returning (some_to_ok string_opt))
+let joystick_name j =
+ some_to_ok (C.Functions.joystick_name j)
-let joystick_name_for_index =
- foreign "SDL_JoystickNameForIndex" (int @-> returning (some_to_ok string_opt))
+let joystick_name_for_index i =
+ some_to_ok (C.Functions.joystick_name_for_index i)
-let joystick_num_axes =
- foreign "SDL_JoystickNumAxes" (joystick @-> returning nat_to_ok)
+let joystick_num_axes j =
+ nat_to_ok (C.Functions.joystick_num_axes j)
-let joystick_num_balls =
- foreign "SDL_JoystickNumBalls" (joystick @-> returning nat_to_ok)
+let joystick_num_balls j =
+ nat_to_ok (C.Functions.joystick_num_balls j)
-let joystick_num_buttons =
- foreign "SDL_JoystickNumButtons" (joystick @-> returning nat_to_ok)
+let joystick_num_buttons j =
+ nat_to_ok (C.Functions.joystick_num_buttons j)
-let joystick_num_hats =
- foreign "SDL_JoystickNumHats" (joystick @-> returning nat_to_ok)
+let joystick_num_hats j =
+ nat_to_ok (C.Functions.joystick_num_hats j)
-let joystick_open =
- foreign "SDL_JoystickOpen" (int @-> returning (some_to_ok joystick_opt))
+let joystick_open i =
+ some_to_ok (C.Functions.joystick_open i)
-let joystick_update =
- foreign "SDL_JoystickUpdate" (void @-> returning void)
+let joystick_update = C.Functions.joystick_update
-let num_joysticks =
- foreign "SDL_NumJoysticks" (void @-> returning nat_to_ok)
+let num_joysticks () =
+ nat_to_ok (C.Functions.num_joysticks ())
(* Game controller *)
-type game_controller = unit ptr
-let game_controller : game_controller typ = ptr void
-let game_controller_opt : game_controller option typ = ptr_opt void
+type game_controller = C.Types._game_controller structure ptr
let unsafe_game_controller_of_ptr addr : game_controller =
- ptr_of_raw_address addr
+ from_voidp C.Types.game_controller (ptr_of_raw_address addr)
let unsafe_ptr_of_game_controller game_controller =
raw_address_of_ptr (to_voidp game_controller)
-type _button_bind
-let button_bind : _button_bind structure typ =
- structure "SDL_GameControllerBindType"
-let button_bind_bind_type = field button_bind "bindType" int
-let button_bind_value1 = field button_bind "value1" int (* simplified enum *)
-let button_bind_value2 = field button_bind "value2" int
-let () = seal button_bind
-
module Controller = struct
- type bind_type = int
- let bind_type_none = sdl_controller_bindtype_none
- let bind_type_button = sdl_controller_bindtype_button
- let bind_type_axis = sdl_controller_bindtype_axis
- let bind_type_hat = sdl_controller_bindtype_hat
-
- type axis = int
- let axis_invalid = sdl_controller_axis_invalid
- let axis_left_x = sdl_controller_axis_leftx
- let axis_left_y = sdl_controller_axis_lefty
- let axis_right_x = sdl_controller_axis_rightx
- let axis_right_y = sdl_controller_axis_righty
- let axis_trigger_left = sdl_controller_axis_triggerleft
- let axis_trigger_right = sdl_controller_axis_triggerright
- let axis_max = sdl_controller_axis_max
-
- type button = int
- let button_invalid = sdl_controller_button_invalid
- let button_a = sdl_controller_button_a
- let button_b = sdl_controller_button_b
- let button_x = sdl_controller_button_x
- let button_y = sdl_controller_button_y
- let button_back = sdl_controller_button_back
- let button_guide = sdl_controller_button_guide
- let button_start = sdl_controller_button_start
- let button_left_stick = sdl_controller_button_leftstick
- let button_right_stick = sdl_controller_button_rightstick
- let button_left_shoulder = sdl_controller_button_leftshoulder
- let button_right_shoulder = sdl_controller_button_rightshoulder
- let button_dpad_up = sdl_controller_button_dpad_up
- let button_dpad_down = sdl_controller_button_dpad_down
- let button_dpad_left = sdl_controller_button_dpad_left
- let button_dpad_right = sdl_controller_button_dpad_right
- let button_max = sdl_controller_button_max
-
- type button_bind = _button_bind structure
- let bind_type v = getf v button_bind_bind_type
- let bind_button_value v = getf v button_bind_value1
- let bind_axis_value v = getf v button_bind_value1
- let bind_hat_value v = getf v button_bind_value1, getf v button_bind_value2
+ include C.Types.Controller
+
+ type button_bind = C.Functions._button_bind structure
+ let bind_type v = getf v C.Functions.button_bind_bind_type
+ let bind_button_value v = getf v C.Functions.button_bind_value1
+ let bind_axis_value v = getf v C.Functions.button_bind_value1
+ let bind_hat_value v =
+ getf v C.Functions.button_bind_value1, getf v C.Functions.button_bind_value2
end
-let game_controller_add_mapping =
- foreign "SDL_GameControllerAddMapping" (string @-> returning bool_to_ok)
+let game_controller_add_mapping s =
+ bool_to_ok (C.Functions.game_controller_add_mapping s)
+
+let game_controller_add_mapping_from_rw r b =
+ nat_to_ok (C.Functions.game_controller_add_mapping_from_rw r b)
-let game_controller_add_mapping_from_rw =
- foreign "SDL_GameControllerAddMappingsFromRW"
- ~stub (rw_ops @-> bool @-> returning nat_to_ok)
-
-let game_controller_close =
- foreign "SDL_GameControllerClose" (game_controller @-> returning void)
-
-let game_controller_event_state =
- foreign "SDL_GameControllerEventState" (int @-> returning nat_to_ok)
-
-let game_controller_from_instance_id =
- foreign "SDL_GameControllerFromInstanceID"
- (joystick_id @-> returning game_controller)
+let game_controller_close = C.Functions.game_controller_close
+
+let game_controller_event_state i =
+ C.Functions.game_controller_event_state i |> nat_to_ok |> Result.map Unsigned.UInt8.of_int
+
+let game_controller_from_instance_id = C.Functions.game_controller_from_instance_id
let game_controller_get_event_state () =
- game_controller_event_state sdl_query
+ game_controller_event_state C.Types.sdl_query
let game_controller_set_event_state t =
- game_controller_event_state t
+ game_controller_event_state (Unsigned.UInt8.to_int t)
-let game_controller_get_attached =
- foreign "SDL_GameControllerGetAttached" (game_controller @-> returning bool)
+let game_controller_get_attached = C.Functions.game_controller_get_attached
-let game_controller_get_axis =
- foreign "SDL_GameControllerGetAxis"
- (game_controller @-> int @-> returning int16_t)
+let game_controller_get_axis = C.Functions.game_controller_get_axis
let game_controller_get_axis_from_string =
- foreign "SDL_GameControllerGetAxisFromString"
- (string @-> returning int)
+ C.Functions.game_controller_get_axis_from_string
let game_controller_get_bind_for_axis =
- foreign "SDL_GameControllerGetBindForAxis"
- (game_controller @-> int @-> returning button_bind)
+ C.Functions.game_controller_get_bind_for_axis
let game_controller_get_bind_for_button =
- foreign "SDL_GameControllerGetBindForButton"
- (game_controller @-> int @-> returning button_bind)
+ C.Functions.game_controller_get_bind_for_button
-let game_controller_get_button =
- foreign "SDL_GameControllerGetButton"
- (game_controller @-> int @-> returning int_as_uint8_t)
+let game_controller_get_button c i =
+ Unsigned.UInt8.to_int (C.Functions.game_controller_get_button c i)
let game_controller_get_button_from_string =
- foreign "SDL_GameControllerGetButtonFromString" (string @-> returning int)
+ C.Functions.game_controller_get_button_from_string
+
+let game_controller_get_joystick c =
+ some_to_ok (C.Functions.game_controller_get_joystick c)
-let game_controller_get_joystick =
- foreign "SDL_GameControllerGetJoystick"
- (game_controller @-> returning (some_to_ok joystick_opt))
-
-let game_controller_get_product =
- foreign "SDL_GameControllerGetProduct"
- (game_controller @-> returning int_as_uint16_t)
-
-let game_controller_get_product_version =
- foreign "SDL_GameControllerGetProductVersion"
- (game_controller @-> returning int_as_uint16_t)
+let game_controller_get_product t =
+ Unsigned.UInt16.to_int (C.Functions.game_controller_get_product t)
+
+let game_controller_get_product_version t =
+ Unsigned.UInt16.to_int (C.Functions.game_controller_get_product_version t)
let game_controller_get_string_for_axis =
- foreign "SDL_GameControllerGetStringForAxis" (int @-> returning string_opt)
+ C.Functions.game_controller_get_string_for_axis
let game_controller_get_string_for_button =
- foreign "SDL_GameControllerGetStringForButton" (int @-> returning string_opt)
+ C.Functions.game_controller_get_string_for_button
-let game_controller_get_vendor =
- foreign "SDL_GameControllerGetVendor"
- (game_controller @-> returning int_as_uint16_t)
+let game_controller_get_vendor t =
+ Unsigned.UInt16.to_int (C.Functions.game_controller_get_vendor t)
-let game_controller_mapping =
- foreign "SDL_GameControllerMapping"
- (game_controller @-> returning (some_to_ok string_opt))
+let game_controller_mapping c =
+ some_to_ok (C.Functions.game_controller_mapping c)
-let game_controller_mapping_for_index =
- foreign "SDL_GameControllerMappingForIndex"
- (int @-> returning (some_to_ok string_opt))
+let game_controller_mapping_for_index i =
+ some_to_ok (C.Functions.game_controller_mapping_for_index i)
-let game_controller_mapping_for_guid =
- foreign "SDL_GameControllerMappingForGUID"
- (joystick_guid @-> returning (some_to_ok string_opt))
+let game_controller_mapping_for_guid g =
+ some_to_ok (C.Functions.game_controller_mapping_for_guid g)
-let game_controller_name =
- foreign "SDL_GameControllerName"
- (game_controller @-> returning (some_to_ok string_opt))
+let game_controller_name c =
+ some_to_ok (C.Functions.game_controller_name c)
-let game_controller_name_for_index =
- foreign "SDL_GameControllerNameForIndex"
- (int @-> returning (some_to_ok string_opt))
+let game_controller_name_for_index i =
+ some_to_ok (C.Functions.game_controller_name_for_index i)
-let game_controller_num_mappings =
- foreign "SDL_GameControllerNumMappings" (void @-> returning int)
+let game_controller_num_mappings = C.Functions.game_controller_num_mappings
-let game_controller_open =
- foreign "SDL_GameControllerOpen"
- (int @-> returning (some_to_ok game_controller_opt))
+let game_controller_open i =
+ some_to_ok (C.Functions.game_controller_open i)
-let game_controller_update =
- foreign "SDL_GameControllerUpdate" (void @-> returning void)
+let game_controller_update = C.Functions.game_controller_update
-let is_game_controller =
- foreign "SDL_IsGameController" (int @-> returning bool)
+let is_game_controller = C.Functions.is_game_controller
(* Events *)
type event_type = int
-let event_type : event_type typ = int_as_uint32_t
module Event = struct
-
+ include C.Types.Event
(* Event structures *)
- module Common = struct
- type t
- let t : t structure typ = structure "SDL_CommonEvent"
- let typ = field t "type" int_as_uint32_t
- let timestamp = field t "timestamp" int32_as_uint32_t
- let () = seal t
- end
-
- module Controller_axis_event = struct
- type t
- let t : t structure typ = structure "SDL_ControllerAxisEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let axis = field t "axis" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let _ = field t "padding3" uint8_t
- let value = field t "value" int16_t
- let _ = field t "padding4" uint16_t
- let () = seal t
- end
-
- module Controller_button_event = struct
- type t
- let t : t structure typ = structure "SDL_ControllerButtonEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let button = field t "button" int_as_uint8_t
- let state = field t "state" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let () = seal t
- end
-
- module Controller_device_event = struct
- type t
- let t : t structure typ = structure "SDL_ControllerDeviceEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let () = seal t
- end
-
- module Dollar_gesture_event = struct
- type t
- let t : t structure typ = structure "SDL_DollarGestureEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let touch_id = field t "touchId" touch_id
- let gesture_id = field t "gestureId" gesture_id
- let num_fingers = field t "numFingers" int_as_uint32_t
- let error = field t "error" float
- let x = field t "x" float
- let y = field t "y" float
- let () = seal t
- end
-
- module Drop_event = struct
- type t
- let t : t structure typ = structure "SDL_DropEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let file = field t "file" (ptr char)
- let window_id = field t "windowID" int_as_uint32_t
- let () = seal t
- end
-
- module Keyboard_event = struct
- type t
- let t : t structure typ = structure "SDL_KeyboardEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let state = field t "state" int_as_uint8_t
- let repeat = field t "repeat" int_as_uint8_t
- let padding2 = field t "padding2" uint8_t
- let padding3 = field t "padding3" uint8_t
- (* We inline the definition of SDL_Keysym *)
- let scancode = field t "scancode" scancode
- let keycode = field t "sym" keycode
- let keymod = field t "mod" keymod
- let unused = field t "unused" uint32_t
- let () = seal t
- end
-
- module Joy_axis_event = struct
- type t
- let t : t structure typ = structure "SDL_JoyAxisEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let axis = field t "axis" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let _ = field t "padding3" uint8_t
- let value = field t "value" int16_t
- let _ = field t "padding4" uint16_t
- let () = seal t
- end
-
- module Joy_ball_event = struct
- type t
- let t : t structure typ = structure "SDL_JoyBallEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let ball = field t "ball" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let _ = field t "padding3" uint8_t
- let xrel = field t "xrel" int16_t
- let yrel = field t "yrel" int16_t
- let () = seal t
- end
-
- module Joy_button_event = struct
- type t
- let t : t structure typ = structure "SDL_JoyButtonEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let button = field t "button" int_as_uint8_t
- let state = field t "state" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let () = seal t
- end
-
- module Joy_device_event = struct
- type t
- let t : t structure typ = structure "SDL_JoyDeviceEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let () = seal t
- end
-
- module Joy_hat_event = struct
- type t
- let t : t structure typ = structure "SDL_JoyHatEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" joystick_id
- let hat = field t "hat" int_as_uint8_t
- let value = field t "value" int_as_uint8_t
- let _ = field t "padding1" uint8_t
- let _ = field t "padding2" uint8_t
- let () = seal t
- end
-
- module Mouse_button_event = struct
- type t
- let t : t structure typ = structure "SDL_MouseButtonEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let which = field t "which" int32_as_uint32_t
- let button = field t "button" int_as_uint8_t
- let state = field t "state" int_as_uint8_t
- let clicks = field t "clicks" int_as_uint8_t
- let _ = field t "padding1" int_as_uint8_t
- let x = field t "x" int_as_int32_t
- let y = field t "y" int_as_int32_t
- let () = seal t
- end
-
- module Mouse_motion_event = struct
- type t
- let t : t structure typ = structure "SDL_MouseMotionEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let which = field t "which" int32_as_uint32_t
- let state = field t "state" int32_as_uint32_t
- let x = field t "x" int_as_int32_t
- let y = field t "y" int_as_int32_t
- let xrel = field t "xrel" int_as_int32_t
- let yrel = field t "yrel" int_as_int32_t
- let () = seal t
- end
-
- type mouse_wheel_direction = int
- let mouse_wheel_normal = sdl_mousewheel_normal
- let mouse_wheel_flipped = sdl_mousewheel_flipped
-
- module Mouse_wheel_event = struct
- type t
- let t : t structure typ = structure "SDL_MouseWheelEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let which = field t "which" int32_as_uint32_t
- let x = field t "x" int_as_int32_t
- let y = field t "y" int_as_int32_t
- let direction = field t "direction" int_as_uint32_t
- let () = seal t
- end
-
- module Multi_gesture_event = struct
- type t
- let t : t structure typ = structure "SDL_MultiGestureEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let touch_id = field t "touchId" touch_id
- let dtheta = field t "dTheta" float
- let ddist = field t "ddist" float
- let x = field t "x" float
- let y = field t "y" float
- let num_fingers = field t "numFingers" int_as_uint16_t
- let _ = field t "padding" uint16_t
- let () = seal t
- end
-
- module Sensor_event = struct
- type t
- let t : t structure typ = structure "SDL_SensorEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let which = field t "which" int32_as_uint32_t
- (* FIXME: No array here, see
- https://github.com/ocamllabs/ocaml-ctypes/issues/113 *)
- let data0 = field t "data0" float
- let data1 = field t "data1" float
- let data2 = field t "data2" float
- let data3 = field t "data3" float
- let data4 = field t "data4" float
- let data5 = field t "data5" float
- let () = seal t
- end
-
- module Quit_event = struct
- type t
- let t : t structure typ = structure "SDL_QuitEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let () = seal t
- end
-
- module Sys_wm_event = struct
- type t
- let t : t structure typ = structure "SDL_SysWMEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let _ = field t "msg" (ptr void)
- let () = seal t
- end
-
- module Text_editing_event = struct
- type t
- let t : t structure typ = structure "SDL_TextEditingEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let text = field t "text" (string_as_char_array
- sdl_texteditingevent_text_size)
- let start = field t "start" int_as_int32_t
- let length = field t "end" int_as_int32_t
- let () = seal t
- end
-
- module Text_input_event = struct
- type t
- let t : t structure typ = structure "SDL_TextIfmtsnputEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let text = field t "text" (string_as_char_array
- sdl_textinputevent_text_size)
- let () = seal t
- end
-
- module Touch_finger_event = struct
- type t
- let t : t structure typ = structure "SDL_TouchFingerEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let touch_id = field t "touchId" touch_id
- let finger_id = field t "fingerId" finger_id
- let x = field t "x" float
- let y = field t "y" float
- let dx = field t "dx" float
- let dy = field t "dy" float
- let pressure = field t "pressure" float
- let () = seal t
- end
-
- module User_event = struct
- type t
- let t : t structure typ = structure "SDL_UserEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let code = field t "code" int_as_int32_t
- let _ = field t "data1" (ptr void)
- let _ = field t "data2" (ptr void)
- let () = seal t
- end
-
- module Window_event = struct
- type t
- let t : t structure typ = structure "SDL_WindowEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let window_id = field t "windowID" int_as_uint32_t
- let event = field t "event" int_as_uint8_t
- let padding1 = field t "padding1" uint8_t
- let padding2 = field t "padding2" uint8_t
- let padding3 = field t "padding3" uint8_t
- let data1 = field t "data1" int32_t
- let data2 = field t "data2" int32_t
- let () = seal t
- end
-
- module Display_event = struct
- type t
- let t : t structure typ = structure "SDL_DisplayEvent"
- let _ = field t "type" int_as_uint32_t
- let _ = field t "timestamp" int32_as_uint32_t
- let display = field t "display" int32_as_uint32_t
- let event = field t "event" int_as_uint8_t
- let padding1 = field t "padding1" uint8_t
- let padding2 = field t "padding2" uint8_t
- let padding3 = field t "padding3" uint8_t
- let data1 = field t "data1" int32_t
- let () = seal t
- end
-
- module Audio_device_event = struct
- type t
- let t : t structure typ = structure "SDL_AudioDevice"
- let _ = field t "type" int_as_uint32_t
- let timestamp = field t "timestamp" int32_as_uint32_t
- let which = field t "which" int32_as_uint32_t
- let iscapture = field t "iscapture" int_as_uint8_t
- let () = seal t
- end
-
- type t
- let t : t union typ = union "SDL_Event"
- let typ = field t "type" int_as_uint32_t
- let audio_device_event = field t "adevice" Audio_device_event.t
- let common = field t "common" Common.t
- let controller_axis_event = field t "caxis" Controller_axis_event.t
- let controller_button_event = field t "cbutton" Controller_button_event.t
- let controller_device_event = field t "cdevice" Controller_device_event.t
- let dollar_gesture_event = field t "dgesture" Dollar_gesture_event.t
- let drop_event = field t "drop" Drop_event.t
- let joy_axis_event = field t "jaxis" Joy_axis_event.t
- let joy_ball_event = field t "jball" Joy_ball_event.t
- let joy_button_event = field t "jbutton" Joy_button_event.t
- let joy_device_event = field t "jdevice" Joy_device_event.t
- let joy_hat_event = field t "jhat" Joy_hat_event.t
- let keyboard_event = field t "key" Keyboard_event.t
- let mouse_button_event = field t "button" Mouse_button_event.t
- let mouse_motion_event = field t "motion" Mouse_motion_event.t
- let mouse_wheel_event = field t "wheel" Mouse_wheel_event.t
- let multi_gesture_event = field t "mgesture" Multi_gesture_event.t
- let quit_event = field t "quit" Quit_event.t
- let sys_wm_event = field t "syswm" Sys_wm_event.t
- let text_editing_event = field t "edit" Text_editing_event.t
- let text_input_event = field t "text" Text_input_event.t
- let touch_finger_event = field t "tfinger" Touch_finger_event.t
- let user_event = field t "user" User_event.t
- let window_event = field t "window" Window_event.t
- let display_event = field t "display" Display_event.t
- let sensor_event = field t "sensor" Sensor_event.t
- let padding = field t "padding"
- (abstract ~name:"padding" ~size:tsdl_sdl_event_size ~alignment:1)
- let () = seal t
-
let create () = make t
let opt_addr = function
| None -> coerce (ptr void) (ptr t) null
@@ -4184,85 +2150,60 @@
type _ field =
F : (* existential to hide the 'a structure *)
(('a structure, t union) Ctypes.field *
- ('b, 'a structure) Ctypes.field) -> 'b field
+ ('b, 'a structure) Ctypes.field *
+ ('b -> 'c) * ('b -> 'c -> 'b)) -> 'c field
- let get e (F (s, f)) = getf (getf e s) f
- let set e (F (s, f)) v = setf (getf e s) f v
-
- (* Aliases *)
-
- let first_event = sdl_firstevent
- let last_event = sdl_lastevent
+ let get e (F (s, f, c, _)) = c (getf (getf e s) f)
+ let set e (F (s, f, _, c)) v = let x = getf e s in setf x f (c (getf x f) v)
(* Common *)
- let typ = F (common, Common.typ)
- let timestamp = F (common, Common.timestamp)
-
- (* Application events. *)
-
- let app_terminating = sdl_app_terminating
- let app_low_memory = sdl_app_lowmemory
- let app_will_enter_background = sdl_app_willenterbackground
- let app_did_enter_background = sdl_app_didenterbackground
- let app_will_enter_foreground = sdl_app_willenterforeground
- let app_did_enter_foreground = sdl_app_didenterforeground
-
- (* Clipboard events *)
-
- let clipboard_update = sdl_clipboardupdate
+ let typ =
+ F (common, Common.typ,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let timestamp =
+ F (common, Common.timestamp,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
(* Controller events *)
- let controller_axis_motion = sdl_controlleraxismotion
- let controller_button_down = sdl_controllerbuttondown
- let controller_button_up = sdl_controllerbuttonup
- let controller_device_added = sdl_controllerdeviceadded
- let controller_device_remapped = sdl_controllerdeviceremapped
- let controller_device_removed = sdl_controllerdeviceremoved
-
let controller_axis_which =
- F (controller_axis_event, Controller_axis_event.which)
+ F (controller_axis_event, Controller_axis_event.which, Fun.id, (fun _ x -> x))
let controller_axis_axis =
- F (controller_axis_event, Controller_axis_event.axis)
+ F (controller_axis_event, Controller_axis_event.axis,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
let controller_axis_value =
- F (controller_axis_event, Controller_axis_event.value)
+ F (controller_axis_event, Controller_axis_event.value, Fun.id, (fun _ x -> x))
let controller_button_which =
- F (controller_button_event, Controller_button_event.which)
+ F (controller_button_event, Controller_button_event.which, Fun.id, (fun _ x -> x))
let controller_button_button =
- F (controller_button_event, Controller_button_event.button)
+ F (controller_button_event, Controller_button_event.button,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
let controller_button_state =
- F (controller_button_event, Controller_button_event.state)
+ F (controller_button_event, Controller_button_event.state, Fun.id, (fun _ x -> x))
let controller_device_which =
- F (controller_device_event, Controller_device_event.which)
-
- (* Dollar gesture events *)
-
- let dollar_gesture = sdl_dollargesture
- let dollar_record = sdl_dollarrecord
+ F (controller_device_event, Controller_device_event.which, Fun.id, (fun _ x -> x))
let dollar_gesture_touch_id =
- F (dollar_gesture_event, Dollar_gesture_event.touch_id)
+ F (dollar_gesture_event, Dollar_gesture_event.touch_id, Fun.id, (fun _ x -> x))
let dollar_gesture_gesture_id =
- F (dollar_gesture_event, Dollar_gesture_event.gesture_id)
+ F (dollar_gesture_event, Dollar_gesture_event.gesture_id, Fun.id, (fun _ x -> x))
let dollar_gesture_num_fingers =
- F (dollar_gesture_event, Dollar_gesture_event.num_fingers)
+ F (dollar_gesture_event, Dollar_gesture_event.num_fingers,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
let dollar_gesture_error =
- F (dollar_gesture_event, Dollar_gesture_event.error)
- let dollar_gesture_x = F (dollar_gesture_event, Dollar_gesture_event.x)
- let dollar_gesture_y = F (dollar_gesture_event, Dollar_gesture_event.y)
-
- (* Drop file event *)
-
- let drop_file = sdl_dropfile
- let drop_text = sdl_droptext
- let drop_begin = sdl_dropbegin
- let drop_complete = sdl_dropcomplete
-
- let drop_file_file = F (drop_event, Drop_event.file)
- let drop_window_id = F (drop_event, Drop_event.window_id)
+ F (dollar_gesture_event, Dollar_gesture_event.error, Fun.id, (fun _ x -> x))
+ let dollar_gesture_x =
+ F (dollar_gesture_event, Dollar_gesture_event.x, Fun.id, (fun _ x -> x))
+ let dollar_gesture_y =
+ F (dollar_gesture_event, Dollar_gesture_event.y, Fun.id, (fun _ x -> x))
+
+ let drop_file_file = F (drop_event, Drop_event.file, Fun.id, (fun _ x -> x))
+ let drop_window_id =
+ F (drop_event, Drop_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
let drop_file_free e =
let sp = to_voidp (get e drop_file_file) in
@@ -4274,160 +2215,202 @@
(* Touch events *)
- let finger_down = sdl_fingerdown
- let finger_motion = sdl_fingermotion
- let finger_up = sdl_fingerup
-
- let touch_finger_touch_id = F (touch_finger_event,Touch_finger_event.touch_id)
+ let touch_finger_touch_id =
+ F (touch_finger_event,Touch_finger_event.touch_id, Fun.id, (fun _ x -> x))
let touch_finger_finger_id =
- F (touch_finger_event, Touch_finger_event.finger_id)
- let touch_finger_x = F (touch_finger_event, Touch_finger_event.x)
- let touch_finger_y = F (touch_finger_event, Touch_finger_event.y)
- let touch_finger_dx = F (touch_finger_event, Touch_finger_event.dx)
- let touch_finger_dy = F (touch_finger_event, Touch_finger_event.dy)
+ F (touch_finger_event, Touch_finger_event.finger_id, Fun.id, (fun _ x -> x))
+ let touch_finger_x =
+ F (touch_finger_event, Touch_finger_event.x, Fun.id, (fun _ x -> x))
+ let touch_finger_y =
+ F (touch_finger_event, Touch_finger_event.y, Fun.id, (fun _ x -> x))
+ let touch_finger_dx =
+ F (touch_finger_event, Touch_finger_event.dx, Fun.id, (fun _ x -> x))
+ let touch_finger_dy =
+ F (touch_finger_event, Touch_finger_event.dy, Fun.id, (fun _ x -> x))
let touch_finger_pressure =
- F (touch_finger_event, Touch_finger_event.pressure)
+ F (touch_finger_event, Touch_finger_event.pressure, Fun.id, (fun _ x -> x))
(* Joystick events. *)
- let joy_axis_motion = sdl_joyaxismotion
- let joy_ball_motion = sdl_joyballmotion
- let joy_button_down = sdl_joybuttondown
- let joy_button_up = sdl_joybuttonup
- let joy_device_added = sdl_joydeviceadded
- let joy_device_removed = sdl_joydeviceremoved
- let joy_hat_motion = sdl_joyhatmotion
-
- let joy_axis_which = F (joy_axis_event, Joy_axis_event.which)
- let joy_axis_axis = F (joy_axis_event, Joy_axis_event.axis)
- let joy_axis_value = F (joy_axis_event, Joy_axis_event.value)
-
- let joy_ball_which = F (joy_ball_event, Joy_ball_event.which)
- let joy_ball_ball = F (joy_ball_event, Joy_ball_event.ball)
- let joy_ball_xrel = F (joy_ball_event, Joy_ball_event.xrel)
- let joy_ball_yrel = F (joy_ball_event, Joy_ball_event.yrel)
-
- let joy_button_which = F (joy_button_event, Joy_button_event.which)
- let joy_button_button = F (joy_button_event, Joy_button_event.button)
- let joy_button_state = F (joy_button_event, Joy_button_event.state)
-
- let joy_device_which = F (joy_device_event, Joy_device_event.which)
-
- let joy_hat_which = F (joy_hat_event, Joy_hat_event.which)
- let joy_hat_hat = F (joy_hat_event, Joy_hat_event.hat)
- let joy_hat_value = F (joy_hat_event, Joy_hat_event.value)
+ let joy_axis_which =
+ F (joy_axis_event, Joy_axis_event.which, Fun.id, (fun _ x -> x))
+ let joy_axis_axis =
+ F (joy_axis_event, Joy_axis_event.axis,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let joy_axis_value =
+ F (joy_axis_event, Joy_axis_event.value, Fun.id, (fun _ x -> x))
+
+ let joy_ball_which =
+ F (joy_ball_event, Joy_ball_event.which, Fun.id, (fun _ x -> x))
+ let joy_ball_ball =
+ F (joy_ball_event, Joy_ball_event.ball,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let joy_ball_xrel =
+ F (joy_ball_event, Joy_ball_event.xrel, Fun.id, (fun _ x -> x))
+ let joy_ball_yrel =
+ F (joy_ball_event, Joy_ball_event.yrel, Fun.id, (fun _ x -> x))
+
+ let joy_button_which =
+ F (joy_button_event, Joy_button_event.which, Fun.id, (fun _ x -> x))
+ let joy_button_button =
+ F (joy_button_event, Joy_button_event.button,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let joy_button_state =
+ F (joy_button_event, Joy_button_event.state, Fun.id, (fun _ x -> x))
+
+ let joy_device_which =
+ F (joy_device_event, Joy_device_event.which, Fun.id, (fun _ x -> x))
+
+ let joy_hat_which =
+ F (joy_hat_event, Joy_hat_event.which, Fun.id, (fun _ x -> x))
+ let joy_hat_hat =
+ F (joy_hat_event, Joy_hat_event.hat,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let joy_hat_value =
+ F (joy_hat_event, Joy_hat_event.value,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
(* Keyboard events *)
- let key_down = sdl_keydown
- let key_up = sdl_keyup
- let keymap_changed = sdl_keymapchanged
-
- let keyboard_window_id = F (keyboard_event, Keyboard_event.window_id)
- let keyboard_repeat = F (keyboard_event, Keyboard_event.repeat)
- let keyboard_state = F (keyboard_event, Keyboard_event.state)
- let keyboard_scancode = F (keyboard_event, Keyboard_event.scancode)
- let keyboard_keycode = F (keyboard_event, Keyboard_event.keycode)
- let keyboard_keymod = F (keyboard_event, Keyboard_event.keymod)
+ let keyboard_window_id =
+ F (keyboard_event, Keyboard_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let keyboard_repeat =
+ F (keyboard_event, Keyboard_event.repeat,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let keyboard_state =
+ F (keyboard_event, Keyboard_event.state, Fun.id, (fun _ x -> x))
+ let keyboard_scancode =
+ F (keyboard_event, Keyboard_event.keysym,
+ (fun k -> getf k Keyboard_event.scancode),
+ (fun k v -> let () = setf k Keyboard_event.scancode v in k))
+ let keyboard_keycode =
+ F (keyboard_event, Keyboard_event.keysym,
+ (fun k -> getf k Keyboard_event.keycode),
+ (fun k v -> let () = setf k Keyboard_event.keycode v in k))
+ let keyboard_keymod =
+ F (keyboard_event, Keyboard_event.keysym,
+ (fun k -> Unsigned.UInt16.to_int (getf k Keyboard_event.keymod)),
+ (fun k v ->
+ let () = setf k Keyboard_event.keymod (Unsigned.UInt16.of_int v) in k))
(* Mouse events *)
- let mouse_button_down = sdl_mousebuttondown
- let mouse_button_up = sdl_mousebuttonup
- let mouse_motion = sdl_mousemotion
- let mouse_wheel = sdl_mousewheel
-
let mouse_button_window_id =
- F (mouse_button_event, Mouse_button_event.window_id)
- let mouse_button_which = F (mouse_button_event, Mouse_button_event.which)
- let mouse_button_state = F (mouse_button_event, Mouse_button_event.state)
- let mouse_button_button = F (mouse_button_event, Mouse_button_event.button)
- let mouse_button_clicks = F (mouse_button_event, Mouse_button_event.clicks)
- let mouse_button_x = F (mouse_button_event, Mouse_button_event.x)
- let mouse_button_y = F (mouse_button_event, Mouse_button_event.y)
+ F (mouse_button_event, Mouse_button_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let mouse_button_which =
+ F (mouse_button_event, Mouse_button_event.which,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
+ let mouse_button_state =
+ F (mouse_button_event, Mouse_button_event.state, Fun.id, (fun _ x -> x))
+ let mouse_button_button =
+ F (mouse_button_event, Mouse_button_event.button,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let mouse_button_clicks =
+ F (mouse_button_event, Mouse_button_event.clicks,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let mouse_button_x =
+ F (mouse_button_event, Mouse_button_event.x,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_button_y =
+ F (mouse_button_event, Mouse_button_event.y,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
let mouse_motion_window_id =
- F (mouse_motion_event, Mouse_motion_event.window_id)
- let mouse_motion_which = F (mouse_motion_event, Mouse_motion_event.which)
- let mouse_motion_state = F (mouse_motion_event, Mouse_motion_event.state)
- let mouse_motion_x = F (mouse_motion_event, Mouse_motion_event.x)
- let mouse_motion_y = F (mouse_motion_event, Mouse_motion_event.y)
- let mouse_motion_xrel = F (mouse_motion_event, Mouse_motion_event.xrel)
- let mouse_motion_yrel = F (mouse_motion_event, Mouse_motion_event.yrel)
-
- let mouse_wheel_window_id = F (mouse_wheel_event, Mouse_wheel_event.window_id)
- let mouse_wheel_which = F (mouse_wheel_event, Mouse_wheel_event.which)
- let mouse_wheel_x = F (mouse_wheel_event, Mouse_wheel_event.x)
- let mouse_wheel_y = F (mouse_wheel_event, Mouse_wheel_event.y)
- let mouse_wheel_direction = F(mouse_wheel_event, Mouse_wheel_event.direction)
+ F (mouse_motion_event, Mouse_motion_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let mouse_motion_which =
+ F (mouse_motion_event, Mouse_motion_event.which,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
+ let mouse_motion_state =
+ F (mouse_motion_event, Mouse_motion_event.state,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
+ let mouse_motion_x =
+ F (mouse_motion_event, Mouse_motion_event.x,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_motion_y =
+ F (mouse_motion_event, Mouse_motion_event.y,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_motion_xrel =
+ F (mouse_motion_event, Mouse_motion_event.xrel,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_motion_yrel =
+ F (mouse_motion_event, Mouse_motion_event.yrel,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+
+ let mouse_wheel_window_id =
+ F (mouse_wheel_event, Mouse_wheel_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let mouse_wheel_which =
+ F (mouse_wheel_event, Mouse_wheel_event.which,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
+ let mouse_wheel_x =
+ F (mouse_wheel_event, Mouse_wheel_event.x,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_wheel_y =
+ F (mouse_wheel_event, Mouse_wheel_event.y,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let mouse_wheel_direction =
+ F(mouse_wheel_event, Mouse_wheel_event.direction,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
(* Multi gesture events *)
- let multi_gesture = sdl_multigesture
-
let multi_gesture_touch_id =
- F (multi_gesture_event, Multi_gesture_event.touch_id)
- let multi_gesture_dtheta = F (multi_gesture_event, Multi_gesture_event.dtheta)
- let multi_gesture_ddist = F (multi_gesture_event, Multi_gesture_event.ddist)
- let multi_gesture_x = F (multi_gesture_event, Multi_gesture_event.x)
- let multi_gesture_y = F (multi_gesture_event, Multi_gesture_event.y)
+ F (multi_gesture_event, Multi_gesture_event.touch_id, Fun.id, (fun _ x -> x))
+ let multi_gesture_dtheta =
+ F (multi_gesture_event, Multi_gesture_event.dtheta, Fun.id, (fun _ x -> x))
+ let multi_gesture_ddist =
+ F (multi_gesture_event, Multi_gesture_event.ddist, Fun.id, (fun _ x -> x))
+ let multi_gesture_x =
+ F (multi_gesture_event, Multi_gesture_event.x, Fun.id, (fun _ x -> x))
+ let multi_gesture_y =
+ F (multi_gesture_event, Multi_gesture_event.y, Fun.id, (fun _ x -> x))
let multi_gesture_num_fingers =
- F (multi_gesture_event, Multi_gesture_event.num_fingers)
-
- (* Quit events *)
-
- let quit = sdl_quit
-
- (* System window manager events *)
-
- let sys_wm_event = sdl_syswmevent
-
- (* Text events *)
-
- let text_editing = sdl_textediting
- let text_input = sdl_textinput
+ F (multi_gesture_event, Multi_gesture_event.num_fingers,
+ Unsigned.UInt16.to_int, (fun _ x -> Unsigned.UInt16.of_int x))
let text_editing_window_id =
- F (text_editing_event, Text_editing_event.window_id)
- let text_editing_text = F (text_editing_event, Text_editing_event.text)
- let text_editing_start = F (text_editing_event, Text_editing_event.start)
- let text_editing_length = F (text_editing_event, Text_editing_event.length)
-
- let text_input_window_id = F (text_input_event, Text_input_event.window_id)
- let text_input_text = F (text_input_event, Text_input_event.text)
+ F (text_editing_event, Text_editing_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let text_editing_text =
+ F (text_editing_event, Text_editing_event.text,
+ (fun p -> string_from_ptr (CArray.start p) ~length:texteditingevent_text_size),
+ (fun _ x -> CArray.of_string x))
+ let text_editing_start =
+ F (text_editing_event, Text_editing_event.start,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+ let text_editing_length =
+ F (text_editing_event, Text_editing_event.length,
+ Int32.to_int, (fun _ x -> Int32.of_int x))
+
+ let text_input_window_id =
+ F (text_input_event, Text_input_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let text_input_text =
+ F (text_input_event, Text_input_event.text,
+ (fun p -> string_from_ptr (CArray.start p) ~length:textinputevent_text_size),
+ (fun _ x -> CArray.of_string x))
(* User events *)
- let user_window_id = F (user_event, User_event.window_id)
- let user_code = F (user_event, User_event.code)
- let user_event = sdl_userevent
-
- (* Window events *)
-
- type window_event_id = int
- let window_event_shown = sdl_windowevent_shown
- let window_event_hidden = sdl_windowevent_hidden
- let window_event_exposed = sdl_windowevent_exposed
- let window_event_moved = sdl_windowevent_moved
- let window_event_resized = sdl_windowevent_resized
- let window_event_size_changed = sdl_windowevent_size_changed
- let window_event_minimized = sdl_windowevent_minimized
- let window_event_maximized = sdl_windowevent_maximized
- let window_event_restored = sdl_windowevent_restored
- let window_event_enter = sdl_windowevent_enter
- let window_event_leave = sdl_windowevent_leave
- let window_event_focus_gained = sdl_windowevent_focus_gained
- let window_event_focus_lost = sdl_windowevent_focus_lost
- let window_event_close = sdl_windowevent_close
- let window_event_take_focus = sdl_windowevent_take_focus
- let window_event_hit_test = sdl_windowevent_hit_test
-
- let window_window_id = F (window_event, Window_event.window_id)
- let window_event_id = F (window_event, Window_event.event)
- let window_data1 = F (window_event, Window_event.data1)
- let window_data2 = F (window_event, Window_event.data2)
-
- let window_event = sdl_windowevent
+ let user_window_id =
+ F (_user_event, User_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let user_code =
+ F (_user_event, User_event.code, Int32.to_int, (fun _ x -> Int32.of_int x))
+
+ let window_window_id =
+ F (_window_event, Window_event.window_id,
+ Unsigned.UInt32.to_int, (fun _ x -> Unsigned.UInt32.of_int x))
+ let window_event_id =
+ F (_window_event, Window_event.event,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
+ let window_data1 =
+ F (_window_event, Window_event.data1, Fun.id, (fun _ x -> x))
+ let window_data2 =
+ F (_window_event, Window_event.data2, Fun.id, (fun _ x -> x))
(* Window event id enum *)
@@ -4438,8 +2421,8 @@
| `Unknown of window_event_id ]
let enum_of_window_event_id =
- let add acc (k, v) = Imap.add k v acc in
- let enums = [
+ (*let add acc (k, v) = Imap.add k v acc in*)
+ let enums = [
window_event_shown, `Shown;
window_event_hidden, `Hidden;
window_event_exposed, `Exposed;
@@ -4457,67 +2440,73 @@
window_event_take_focus, `Take_focus;
window_event_hit_test, `Hit_test; ]
in
- List.fold_left add Imap.empty enums
+ (*List.fold_left add Imap.empty*) enums
let window_event_enum id =
- try Imap.find id enum_of_window_event_id with Not_found -> `Unknown id
+ try List.assoc id enum_of_window_event_id with Not_found -> `Unknown id
(* Display event *)
let display_display =
- F (display_event, Display_event.display)
+ F (_display_event, Display_event.display,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
let display_event_id =
- F (display_event, Display_event.event)
+ F (_display_event, Display_event.event,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
let display_data1 =
- F (display_event, Display_event.data1)
-
- let display_event = sdl_displayevent
+ F (_display_event, Display_event.data1, Fun.id, (fun _ x -> x))
(* Sensor event *)
let sensor_which =
- F (sensor_event, Sensor_event.which)
+ F (sensor_event, Sensor_event.which,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
let sensor_data0 =
- F (sensor_event, Sensor_event.data0)
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 0),
+ (fun a x -> let () = CArray.set a 0 x in a))
let sensor_data1 =
- F (sensor_event, Sensor_event.data1)
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 1),
+ (fun a x -> let () = CArray.set a 1 x in a))
let sensor_data2 =
- F (sensor_event, Sensor_event.data2)
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 2),
+ (fun a x -> let () = CArray.set a 2 x in a))
let sensor_data3 =
- F (sensor_event, Sensor_event.data3)
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 3),
+ (fun a x -> let () = CArray.set a 3 x in a))
let sensor_data4 =
- F (sensor_event, Sensor_event.data4)
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 4),
+ (fun a x -> let () = CArray.set a 4 x in a))
let sensor_data5 =
- F (sensor_event, Sensor_event.data5)
-
- let sensor_update = sdl_sensorupdate
-
- (* Render events *)
-
- let render_targets_reset = sdl_render_targets_reset
- let render_device_reset = sdl_render_device_reset
+ F (sensor_event, Sensor_event.data,
+ (fun a -> CArray.get a 5),
+ (fun a x -> let () = CArray.set a 5 x in a))
(* Audio device event *)
- let audio_device_added = sdl_audiodeviceadded
- let audio_device_removed = sdl_audiodeviceremoved
-
let audio_device_timestamp =
- F (audio_device_event, Audio_device_event.timestamp)
+ F (audio_device_event, Audio_device_event.timestamp,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
let audio_device_which =
- F (audio_device_event, Audio_device_event.which)
+ F (audio_device_event, Audio_device_event.which,
+ Unsigned.UInt32.to_int32, (fun _ x -> Unsigned.UInt32.of_int32 x))
let audio_device_is_capture =
- F (audio_device_event, Audio_device_event.iscapture)
+ F (audio_device_event, Audio_device_event.iscapture,
+ Unsigned.UInt8.to_int, (fun _ x -> Unsigned.UInt8.of_int x))
(* Event type enum *)
@@ -4589,10 +2578,10 @@
sys_wm_event, `Sys_wm_event;
text_editing, `Text_editing;
text_input, `Text_input;
- user_event, `User_event;
+ C.Types.Event.user_event, `User_event;
quit, `Quit;
- window_event, `Window_event;
- display_event, `Display_event;
+ C.Types.Event.window_event, `Window_event;
+ C.Types.Event.display_event, `Display_event;
sensor_update, `Sensor_update; ]
in
List.fold_left add Imap.empty enums
@@ -4603,592 +2592,434 @@
type event = Event.t union
-let event_state =
- foreign "SDL_EventState" (event_type @-> int @-> returning int_as_uint8_t)
-
let get_event_state e =
- event_state e sdl_query
+ C.Functions.event_state (Unsigned.UInt32.of_int e) C.Types.sdl_query
let set_event_state e s =
- ignore (event_state e s)
-
-let flush_event =
- foreign "SDL_FlushEvent" (event_type @-> returning void)
+ ignore (C.Functions.event_state
+ (Unsigned.UInt32.of_int e) (Unsigned.UInt8.to_int s))
-let flush_events =
- foreign "SDL_FlushEvents" (event_type @-> event_type @-> returning void)
+let flush_event e = C.Functions.flush_event (Unsigned.UInt32.of_int e)
-let has_event =
- foreign "SDL_HasEvent" (event_type @-> returning bool)
+let flush_events f t =
+ C.Functions.flush_events (Unsigned.UInt32.of_int f) (Unsigned.UInt32.of_int t)
-let has_events =
- foreign "SDL_HasEvents" (event_type @-> event_type @-> returning bool)
+let has_event e = C.Functions.has_event (Unsigned.UInt32.of_int e)
-let poll_event =
- foreign "SDL_PollEvent" (ptr Event.t @-> returning bool)
+let has_events f t =
+ C.Functions.has_events (Unsigned.UInt32.of_int f) (Unsigned.UInt32.of_int t)
let poll_event e =
- poll_event (Event.opt_addr e)
+ C.Functions.poll_event (Event.opt_addr e)
-let pump_events =
- foreign "SDL_PumpEvents" (void @-> returning void)
-
-let push_event =
- foreign "SDL_PushEvent" (ptr Event.t @-> returning bool_to_ok)
+let pump_events = C.Functions.pump_events
let push_event e =
- push_event (addr e)
-
-let register_events =
- foreign "SDL_RegisterEvents" (int @-> returning uint32_t)
-
-let register_event () = match Unsigned.UInt32.to_int32 (register_events 1) with
-| -1l -> None | t -> Some (Int32.to_int t)
+ bool_to_ok (C.Functions.push_event (addr e))
-let wait_event =
- foreign ~release_runtime_lock:true
- "SDL_WaitEvent" (ptr Event.t @-> returning int)
+let register_event () =
+ let out = C.Functions.register_events 1 in
+ if Unsigned.UInt32.(equal out max_int) then None else Some (Unsigned.UInt32.to_int out)
-let wait_event e = match wait_event (Event.opt_addr e) with
+let wait_event e = match C.Async_functions.wait_event (Event.opt_addr e) with
| 1 -> Ok () | _ -> error ()
-let wait_event_timeout =
- foreign "SDL_WaitEventTimeout" ~release_runtime_lock:true
- (ptr Event.t @-> int @-> returning bool)
-
let wait_event_timeout e t =
- wait_event_timeout (Event.opt_addr e) t
+ C.Async_functions.wait_event_timeout (Event.opt_addr e) t
(* Force feedback *)
-type haptic = unit ptr
-let haptic : haptic typ = ptr void
-let haptic_opt : haptic option typ = ptr_opt void
-
-let unsafe_haptic_of_ptr addr : haptic =
- ptr_of_raw_address addr
-let unsafe_ptr_of_haptic haptic =
- raw_address_of_ptr (to_voidp haptic)
-
module Haptic = struct
- let infinity = -1l
-
- (* Features *)
-
- type feature = int
- let gain = sdl_haptic_gain
- let autocenter = sdl_haptic_autocenter
- let status = sdl_haptic_status
- let pause = sdl_haptic_pause
-
- (* Directions *)
-
- type direction_type = int
- let polar = sdl_haptic_polar
- let cartesian = sdl_haptic_cartesian
- let spherical = sdl_haptic_spherical
+ include C.Types.Haptic
module Direction = struct
- type _t
- type t = _t structure
- let t : _t structure typ = structure "SDL_HapticDirection"
- let typ = field t "type" int_as_uint8_t
- let dir_0 = field t "dir0" int32_t
- let dir_1 = field t "dir1" int32_t
- let dir_2 = field t "dir2" int32_t
- let () = seal t
+ include Direction
let create typv d0 d1 d2 =
let d = make t in
- setf d typ typv;
- setf d dir_0 d0;
- setf d dir_1 d1;
- setf d dir_2 d2;
+ setf d typ (Unsigned.UInt8.of_int typv);
+ let dir = getf d dir in
+ CArray.set dir 0 d0;
+ CArray.set dir 1 d1;
+ CArray.set dir 2 d2;
d
- let typ d = getf d typ
- let dir_0 d = getf d dir_0
- let dir_1 d = getf d dir_1
- let dir_2 d = getf d dir_2
- end
-
- (* Effects *)
-
- module Constant = struct
- type t
- let t : t structure typ = structure "SDL_HapticConstant"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
- let delay = field t "delay" int_as_uint16_t
- let button = field t "button" int_as_uint16_t
- let interval = field t "interval" int_as_uint16_t
-
- let level = field t "level" int16_t
- let attack_length = field t "attack_length" int_as_uint16_t
- let attack_level = field t "attack_level" int_as_uint16_t
- let fade_length = field t "fade_length" int_as_uint16_t
- let fade_level = field t "fade_level" int_as_uint16_t
- let () = seal t
- end
-
- module Periodic = struct
- type t
- let t : t structure typ = structure "SDL_HapticPeriodic"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
- let delay = field t "delay" int_as_uint16_t
- let button = field t "button" int_as_uint16_t
- let interval = field t "interval" int_as_uint16_t
-
- let period = field t "period" int_as_uint16_t
- let magnitude = field t "magnitude" int16_t
- let offset = field t "offset" int16_t
- let phase = field t "phase" int_as_uint16_t
- let attack_length = field t "attack_length" int_as_uint16_t
- let attack_level = field t "attack_level" int_as_uint16_t
- let fade_length = field t "fade_length" int_as_uint16_t
- let fade_level = field t "fade_level" int_as_uint16_t
- let () = seal t
- end
-
- module Condition = struct
- type t
- let t : t structure typ = structure "SDL_HapticCondition"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
- let delay = field t "delay" int_as_uint16_t
- let button = field t "button" int_as_uint16_t
- let interval = field t "interval" int_as_uint16_t
-
- let right_sat_0 = field t "right_sat[0]" int_as_uint16_t
- let right_sat_1 = field t "right_sat[1]" int_as_uint16_t
- let right_sat_2 = field t "right_sat[2]" int_as_uint16_t
- let left_sat_0 = field t "left_sat[0]" int_as_uint16_t
- let left_sat_1 = field t "left_sat[1]" int_as_uint16_t
- let left_sat_2 = field t "left_sat[2]" int_as_uint16_t
- let right_coeff_0 = field t "right_coeff[0]" int16_t
- let right_coeff_1 = field t "right_coeff[1]" int16_t
- let right_coeff_2 = field t "right_coeff[2]" int16_t
- let left_coeff_0 = field t "left_coeff[0]" int16_t
- let left_coeff_1 = field t "left_coeff[1]" int16_t
- let left_coeff_2 = field t "left_coeff[2]" int16_t
- let deadband_0 = field t "deadband[0]" int_as_uint16_t
- let deadband_1 = field t "deadband[1]" int_as_uint16_t
- let deadband_2 = field t "deadband[2]" int_as_uint16_t
- let center_0 = field t "center[0]" int16_t
- let center_1 = field t "center[1]" int16_t
- let center_2 = field t "center[2]" int16_t
- let () = seal t
- end
-
- module Ramp = struct
- type t
- let t : t structure typ = structure "SDL_HapticRamp"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
- let delay = field t "delay" int_as_uint16_t
- let button = field t "button" int_as_uint16_t
- let interval = field t "interval" int_as_uint16_t
-
- let start = field t "start" int16_t
- let end_ = field t "end" int16_t
- let attack_length = field t "attack_length" int_as_uint16_t
- let attack_level = field t "attack_level" int_as_uint16_t
- let fade_length = field t "fade_length" int_as_uint16_t
- let fade_level = field t "fade_level" int_as_uint16_t
- let () = seal t
- end
-
- module Left_right = struct
- type t
- let t : t structure typ = structure "SDL_HapticLeftRight"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
-
- let large_magnitude = field t "large_magnitude" int_as_uint16_t
- let small_magnitude = field t "small_magnitude" int_as_uint16_t
- let () = seal t
- end
-
- module Custom = struct
- let int_list_as_uint16_t_ptr =
- let read _ = invalid_arg err_read_field in
- let write l =
- let l = List.map Unsigned.UInt16.of_int l in
- let a = CArray.of_list uint16_t l in
- CArray.start a
- in
- view ~read ~write (ptr uint16_t)
-
- type t
- let t : t structure typ = structure "SDL_HapticCustom"
- let typ = field t "type" int_as_uint16_t
- let direction = field t "direction" Direction.t
- let length = field t "length" int32_as_uint32_t
- let delay = field t "delay" int_as_uint16_t
- let button = field t "button" int_as_uint16_t
- let interval = field t "interval" int_as_uint16_t
-
- let channels = field t "channels" int_as_uint8_t
- let period = field t "period" int_as_uint16_t
- let samples = field t "samples" int_as_uint16_t
- let data = field t "data" int_list_as_uint16_t_ptr
- let attack_length = field t "attack_length" int_as_uint16_t
- let attack_level = field t "attack_level" int_as_uint16_t
- let fade_length = field t "fade_length" int_as_uint16_t
- let fade_level = field t "fade_level" int_as_uint16_t
- let () = seal t
- end
-
- module Effect = struct
- type t
- let t : t union typ = union "SDL_HapticEffect"
- let typ = field t "type" int_as_uint16_t
- let constant = field t "constant" Constant.t
- let periodic = field t "periodic" Periodic.t
- let condition = field t "condition" Condition.t
- let ramp = field t "ramp" Ramp.t
- let left_right = field t "condition" Left_right.t
- let custom = field t "custom" Custom.t
- let () = seal t
+ let typ d = Unsigned.UInt8.to_int (getf d typ)
+ let dir_0 d = CArray.get (getf d dir) 0
+ let dir_1 d = CArray.get (getf d dir) 1
+ let dir_2 d = CArray.get (getf d dir) 2
end
type effect_type = int
let create_effect () = make Effect.t
- let opt_addr = function
- | None -> coerce (ptr void) (ptr Effect.t) null
- | Some v -> addr v
type _ field =
F : (* existential to hide the 'a structure *)
(('a structure, Effect.t union) Ctypes.field *
- ('b, 'a structure) Ctypes.field) -> 'b field
+ ('b, 'a structure) Ctypes.field *
+ ('b -> 'c) * ('c -> 'b)) -> 'c field
+
+ let get e (F (s, f, c, _)) = c (getf (getf e s) f)
+ let set e (F (s, f, _, c)) v = setf (getf e s) f (c v)
- let get e (F (s, f)) = getf (getf e s) f
- let set e (F (s, f)) v = setf (getf e s) f v
- let typ = F (Effect.constant, Constant.typ) (* same in each enum *)
+ let typ = F (Effect.constant, Constant.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ (* same in each enum *)
(* Constant *)
- let constant = sdl_haptic_constant
- let constant_type = F (Effect.constant, Constant.typ)
- let constant_direction = F (Effect.constant, Constant.direction)
- let constant_length = F (Effect.constant, Constant.length)
- let constant_delay = F (Effect.constant, Constant.delay)
- let constant_button = F (Effect.constant, Constant.button)
- let constant_interval = F (Effect.constant, Constant.interval)
- let constant_level = F (Effect.constant, Constant.level)
- let constant_attack_length = F (Effect.constant, Constant.attack_length)
- let constant_attack_level = F (Effect.constant, Constant.attack_level)
- let constant_fade_length = F (Effect.constant, Constant.fade_length)
- let constant_fade_level = F (Effect.constant, Constant.fade_level)
+ let constant_type =
+ F (Effect.constant, Constant.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_direction =
+ F (Effect.constant, Constant.direction, Fun.id, Fun.id)
+ let constant_length =
+ F (Effect.constant, Constant.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
+ let constant_delay =
+ F (Effect.constant, Constant.delay,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_button =
+ F (Effect.constant, Constant.button,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_interval =
+ F (Effect.constant, Constant.interval,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_level =
+ F (Effect.constant, Constant.level, Fun.id, Fun.id)
+ let constant_attack_length =
+ F (Effect.constant, Constant.attack_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_attack_level =
+ F (Effect.constant, Constant.attack_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_fade_length =
+ F (Effect.constant, Constant.fade_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let constant_fade_level =
+ F (Effect.constant, Constant.fade_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
(* Periodic *)
- let sine = sdl_haptic_sine
- let left_right = sdl_haptic_leftright
- let triangle = sdl_haptic_triangle
- let sawtooth_up = sdl_haptic_sawtoothup
- let sawtooth_down = sdl_haptic_sawtoothdown
-
- let periodic_type = F (Effect.periodic, Periodic.typ)
- let periodic_direction = F (Effect.periodic, Periodic.direction)
- let periodic_length = F (Effect.periodic, Periodic.length)
- let periodic_delay = F (Effect.periodic, Periodic.delay)
- let periodic_button = F (Effect.periodic, Periodic.button)
- let periodic_interval = F (Effect.periodic, Periodic.interval)
- let periodic_period = F (Effect.periodic, Periodic.period)
- let periodic_magnitude = F (Effect.periodic, Periodic.magnitude)
- let periodic_offset = F (Effect.periodic, Periodic.offset)
- let periodic_phase = F (Effect.periodic, Periodic.phase)
- let periodic_attack_length = F (Effect.periodic, Periodic.attack_length)
- let periodic_attack_level = F (Effect.periodic, Periodic.attack_level)
- let periodic_fade_length = F (Effect.periodic, Periodic.fade_length)
- let periodic_fade_level = F (Effect.periodic, Periodic.fade_level)
+ let periodic_type =
+ F (Effect.periodic, Periodic.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_direction =
+ F (Effect.periodic, Periodic.direction, Fun.id, Fun.id)
+ let periodic_length =
+ F (Effect.periodic, Periodic.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
+ let periodic_delay =
+ F (Effect.periodic, Periodic.delay,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_button =
+ F (Effect.periodic, Periodic.button,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_interval =
+ F (Effect.periodic, Periodic.interval,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_period =
+ F (Effect.periodic, Periodic.period,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_magnitude =
+ F (Effect.periodic, Periodic.magnitude, Fun.id, Fun.id)
+ let periodic_offset =
+ F (Effect.periodic, Periodic.offset, Fun.id, Fun.id)
+ let periodic_phase =
+ F (Effect.periodic, Periodic.phase,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_attack_length =
+ F (Effect.periodic, Periodic.attack_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_attack_level =
+ F (Effect.periodic, Periodic.attack_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_fade_length =
+ F (Effect.periodic, Periodic.fade_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let periodic_fade_level =
+ F (Effect.periodic, Periodic.fade_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
(* Condition *)
- let spring = sdl_haptic_spring
- let damper = sdl_haptic_damper
- let inertia = sdl_haptic_inertia
- let friction = sdl_haptic_friction
-
- let condition_type = F (Effect.condition, Condition.typ)
- let condition_direction = F (Effect.condition, Condition.direction)
- let condition_length = F (Effect.condition, Condition.length)
- let condition_delay = F (Effect.condition, Condition.delay)
- let condition_button = F (Effect.condition, Condition.button)
- let condition_interval = F (Effect.condition, Condition.interval)
- let condition_right_sat_0 = F (Effect.condition, Condition.right_sat_0)
- let condition_right_sat_1 = F (Effect.condition, Condition.right_sat_1)
- let condition_right_sat_2 = F (Effect.condition, Condition.right_sat_2)
- let condition_left_sat_0 = F (Effect.condition, Condition.left_sat_0)
- let condition_left_sat_1 = F (Effect.condition, Condition.left_sat_1)
- let condition_left_sat_2 = F (Effect.condition, Condition.left_sat_2)
- let condition_right_coeff_0 = F (Effect.condition, Condition.right_coeff_0)
- let condition_right_coeff_1 = F (Effect.condition, Condition.right_coeff_1)
- let condition_right_coeff_2 = F (Effect.condition, Condition.right_coeff_2)
- let condition_left_coeff_0 = F (Effect.condition, Condition.left_coeff_0)
- let condition_left_coeff_1 = F (Effect.condition, Condition.left_coeff_1)
- let condition_left_coeff_2 = F (Effect.condition, Condition.left_coeff_2)
- let condition_deadband_0 = F (Effect.condition, Condition.deadband_0)
- let condition_deadband_1 = F (Effect.condition, Condition.deadband_1)
- let condition_deadband_2 = F (Effect.condition, Condition.deadband_2)
- let condition_center_0 = F (Effect.condition, Condition.center_0)
- let condition_center_1 = F (Effect.condition, Condition.center_1)
- let condition_center_2 = F (Effect.condition, Condition.center_2)
+ let condition_type =
+ F (Effect.condition, Condition.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_direction =
+ F (Effect.condition, Condition.direction, Fun.id, Fun.id)
+ let condition_length =
+ F (Effect.condition, Condition.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
+ let condition_delay =
+ F (Effect.condition, Condition.delay,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_button =
+ F (Effect.condition, Condition.button,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_interval =
+ F (Effect.condition, Condition.interval,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_right_sat_0 =
+ F (Effect.condition, Condition.right_sat_0,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_right_sat_1 =
+ F (Effect.condition, Condition.right_sat_1,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_right_sat_2 =
+ F (Effect.condition, Condition.right_sat_2,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_left_sat_0 =
+ F (Effect.condition, Condition.left_sat_0,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_left_sat_1 =
+ F (Effect.condition, Condition.left_sat_1,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_left_sat_2 =
+ F (Effect.condition, Condition.left_sat_2,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_right_coeff_0 =
+ F (Effect.condition, Condition.right_coeff_0, Fun.id, Fun.id)
+ let condition_right_coeff_1 =
+ F (Effect.condition, Condition.right_coeff_1, Fun.id, Fun.id)
+ let condition_right_coeff_2 =
+ F (Effect.condition, Condition.right_coeff_2, Fun.id, Fun.id)
+ let condition_left_coeff_0 =
+ F (Effect.condition, Condition.left_coeff_0, Fun.id, Fun.id)
+ let condition_left_coeff_1 =
+ F (Effect.condition, Condition.left_coeff_1, Fun.id, Fun.id)
+ let condition_left_coeff_2 =
+ F (Effect.condition, Condition.left_coeff_2, Fun.id, Fun.id)
+ let condition_deadband_0 =
+ F (Effect.condition, Condition.deadband_0,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_deadband_1 =
+ F (Effect.condition, Condition.deadband_1,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_deadband_2 =
+ F (Effect.condition, Condition.deadband_2,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let condition_center_0 =
+ F (Effect.condition, Condition.center_0, Fun.id, Fun.id)
+ let condition_center_1 =
+ F (Effect.condition, Condition.center_1, Fun.id, Fun.id)
+ let condition_center_2 =
+ F (Effect.condition, Condition.center_2, Fun.id, Fun.id)
(* Ramp *)
- let ramp = sdl_haptic_ramp
-
- let ramp_type = F (Effect.ramp, Ramp.typ)
- let ramp_direction = F (Effect.ramp, Ramp.direction)
- let ramp_length = F (Effect.ramp, Ramp.length)
- let ramp_delay = F (Effect.ramp, Ramp.delay)
- let ramp_button = F (Effect.ramp, Ramp.button)
- let ramp_interval = F (Effect.ramp, Ramp.interval)
- let ramp_start = F (Effect.ramp, Ramp.start)
- let ramp_end = F (Effect.ramp, Ramp.end_)
- let ramp_attack_length = F (Effect.ramp, Ramp.attack_length)
- let ramp_attack_level = F (Effect.ramp, Ramp.attack_level)
- let ramp_fade_length = F (Effect.ramp, Ramp.fade_length)
- let ramp_fade_level = F (Effect.ramp, Ramp.fade_level)
+ let ramp_type =
+ F (Effect.ramp, Ramp.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_direction =
+ F (Effect.ramp, Ramp.direction, Fun.id, Fun.id)
+ let ramp_length =
+ F (Effect.ramp, Ramp.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
+ let ramp_delay =
+ F (Effect.ramp, Ramp.delay,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_button =
+ F (Effect.ramp, Ramp.button,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_interval =
+ F (Effect.ramp, Ramp.interval,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_start =
+ F (Effect.ramp, Ramp.start, Fun.id, Fun.id)
+ let ramp_end =
+ F (Effect.ramp, Ramp.end_, Fun.id, Fun.id)
+ let ramp_attack_length =
+ F (Effect.ramp, Ramp.attack_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_attack_level =
+ F (Effect.ramp, Ramp.attack_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_fade_length =
+ F (Effect.ramp, Ramp.fade_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let ramp_fade_level =
+ F (Effect.ramp, Ramp.fade_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
(* Left right *)
- let left_right_type = F (Effect.left_right, Left_right.typ)
- let left_right_length = F (Effect.left_right, Left_right.length)
+ let left_right_type =
+ F (Effect.left_right, Left_right.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let left_right_length =
+ F (Effect.left_right, Left_right.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
let left_right_large_magnitude =
- F (Effect.left_right, Left_right.large_magnitude)
+ F (Effect.left_right, Left_right.large_magnitude,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
let left_right_small_magnitude =
- F (Effect.left_right, Left_right.small_magnitude)
+ F (Effect.left_right, Left_right.small_magnitude,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
(* Custom *)
- let custom = sdl_haptic_custom
-
- let custom_type = F (Effect.custom, Custom.typ)
- let custom_direction = F (Effect.custom, Custom.direction)
- let custom_length = F (Effect.custom, Custom.length)
- let custom_delay = F (Effect.custom, Custom.delay)
- let custom_button = F (Effect.custom, Custom.button)
- let custom_interval = F (Effect.custom, Custom.interval)
- let custom_channels = F (Effect.custom, Custom.channels)
- let custom_period = F (Effect.custom, Custom.period)
- let custom_samples = F (Effect.custom, Custom.samples)
- let custom_data = F (Effect.custom, Custom.data)
- let custom_attack_length = F (Effect.custom, Custom.attack_length)
- let custom_attack_level = F (Effect.custom, Custom.attack_level)
- let custom_fade_length = F (Effect.custom, Custom.fade_length)
- let custom_fade_level = F (Effect.custom, Custom.fade_level)
+ let custom_type =
+ F (Effect.custom, Custom.typ,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_direction =
+ F (Effect.custom, Custom.direction, Fun.id, Fun.id)
+ let custom_length =
+ F (Effect.custom, Custom.length,
+ Unsigned.UInt32.to_int32, Unsigned.UInt32.of_int32)
+ let custom_delay =
+ F (Effect.custom, Custom.delay,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_button =
+ F (Effect.custom, Custom.button,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_interval =
+ F (Effect.custom, Custom.interval,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_channels =
+ F (Effect.custom, Custom.channels,
+ Unsigned.UInt8.to_int, Unsigned.UInt8.of_int)
+ let custom_period =
+ F (Effect.custom, Custom.period,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_samples =
+ F (Effect.custom, Custom.samples,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_data =
+ F (Effect.custom, Custom.data,
+ (fun p -> invalid_arg err_read_field),
+ (fun l ->
+ let l = List.map Unsigned.UInt16.of_int l in
+ let a = Ctypes.CArray.of_list Ctypes.uint16_t l in
+ Ctypes.CArray.start a))
+ let custom_attack_length =
+ F (Effect.custom, Custom.attack_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_attack_level =
+ F (Effect.custom, Custom.attack_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_fade_length =
+ F (Effect.custom, Custom.fade_length,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
+ let custom_fade_level =
+ F (Effect.custom, Custom.fade_level,
+ Unsigned.UInt16.to_int, Unsigned.UInt16.of_int)
end
+type haptic = Haptic.t ptr
+
type haptic_effect = Haptic.Effect.t union
type haptic_effect_id = int
-let haptic_effect_id : int typ = int
-let haptic_close =
- foreign "SDL_HapticClose" (haptic @-> returning void)
+let haptic_close = C.Functions.haptic_close
-let haptic_destroy_effect =
- foreign "SDL_HapticDestroyEffect"
- (haptic @-> int @-> returning void)
-
-let haptic_effect_supported =
- foreign "SDL_HapticEffectSupported"
- (haptic @-> ptr Haptic.Effect.t @-> returning bool_to_ok)
+let haptic_destroy_effect = C.Functions.haptic_destroy_effect
let haptic_effect_supported h e =
- haptic_effect_supported h (addr e)
+ bool_to_ok (C.Functions.haptic_effect_supported h (addr e))
-let haptic_get_effect_status =
- foreign "SDL_HapticGetEffectStatus"
- (haptic @-> haptic_effect_id @-> returning bool_to_ok)
+let haptic_get_effect_status h i =
+ bool_to_ok (C.Functions.haptic_get_effect_status h i)
-let haptic_index =
- foreign "SDL_HapticIndex" (haptic @-> returning nat_to_ok)
+let haptic_index h = nat_to_ok (C.Functions.haptic_index h)
-let haptic_name =
- foreign "SDL_HapticName" (int @-> returning (some_to_ok string_opt))
-
-let haptic_new_effect =
- foreign "SDL_HapticNewEffect"
- (haptic @-> ptr Haptic.Effect.t @-> returning nat_to_ok)
+let haptic_name i = some_to_ok (C.Functions.haptic_name i)
let haptic_new_effect h e =
- haptic_new_effect h (addr e)
-
-let haptic_num_axes =
- foreign "SDL_HapticNumAxes" (haptic @-> returning nat_to_ok)
+ nat_to_ok (C.Functions.haptic_new_effect h (addr e))
-let haptic_num_effects =
- foreign "SDL_HapticNumEffects" (haptic @-> returning nat_to_ok)
+let haptic_num_axes h =
+ nat_to_ok (C.Functions.haptic_num_axes h)
-let haptic_num_effects_playing =
- foreign "SDL_HapticNumEffectsPlaying" (haptic @-> returning nat_to_ok)
+let haptic_num_effects h =
+ nat_to_ok (C.Functions.haptic_num_effects h)
-let haptic_open =
- foreign "SDL_HapticOpen" (int @-> returning (some_to_ok haptic_opt))
+let haptic_num_effects_playing h =
+ nat_to_ok (C.Functions.haptic_num_effects_playing h)
-let haptic_open_from_joystick =
- foreign "SDL_HapticOpenFromJoystick"
- (joystick @-> returning (some_to_ok haptic_opt))
+let haptic_open i = some_to_ok (C.Functions.haptic_open i)
-let haptic_open_from_mouse =
- foreign "SDL_HapticOpenFromMouse"
- (void @-> returning (some_to_ok haptic_opt))
+let haptic_open_from_joystick j =
+ some_to_ok (C.Functions.haptic_open_from_joystick j)
-let haptic_opened =
- foreign "SDL_HapticOpened" (int @-> returning int)
+let haptic_open_from_mouse () =
+ some_to_ok (C.Functions.haptic_open_from_mouse ())
-let haptic_opened i = match haptic_opened i with
+let haptic_opened i = match C.Functions.haptic_opened i with
| 0 -> false | 1 -> true | _ -> assert false
-let haptic_pause =
- foreign "SDL_HapticPause" (haptic @-> returning zero_to_ok)
+let haptic_pause h = zero_to_ok (C.Functions.haptic_pause h)
-let haptic_query =
- foreign "SDL_HapticQuery" (haptic @-> returning int)
+let haptic_query = C.Functions.haptic_query
-let haptic_rumble_init =
- foreign "SDL_HapticRumbleInit" (haptic @-> returning zero_to_ok)
+let haptic_rumble_init h =
+ zero_to_ok (C.Functions.haptic_rumble_init h)
-let haptic_rumble_play =
- foreign "SDL_HapticRumblePlay"
- (haptic @-> float @-> int32_t @-> returning zero_to_ok)
+let haptic_rumble_play h x y =
+ zero_to_ok (C.Functions.haptic_rumble_play h x y)
-let haptic_rumble_stop =
- foreign "SDL_HapticRumbleStop" (haptic @-> returning zero_to_ok)
+let haptic_rumble_stop h =
+ zero_to_ok (C.Functions.haptic_rumble_stop h)
-let haptic_rumble_supported =
- foreign "SDL_HapticRumbleSupported" (haptic @-> returning bool_to_ok)
+let haptic_rumble_supported h =
+ bool_to_ok (C.Functions.haptic_rumble_supported h)
-let haptic_run_effect =
- foreign "SDL_HapticRunEffect"
- (haptic @-> haptic_effect_id @-> int32_t @-> returning zero_to_ok)
+let haptic_run_effect h i n =
+ zero_to_ok (C.Functions.haptic_run_effect h i n)
-let haptic_set_autocenter =
- foreign "SDL_HapticSetAutocenter" (haptic @-> int @-> returning zero_to_ok)
+let haptic_set_autocenter h n =
+ zero_to_ok (C.Functions.haptic_set_autocenter h n)
-let haptic_set_gain =
- foreign "SDL_HapticSetGain" (haptic @-> int @-> returning zero_to_ok)
+let haptic_set_gain h n = zero_to_ok (C.Functions.haptic_set_gain h n)
-let haptic_stop_all =
- foreign "SDL_HapticStopAll" (haptic @-> returning zero_to_ok)
+let haptic_stop_all h = zero_to_ok (C.Functions.haptic_stop_all h)
-let haptic_stop_effect =
- foreign "SDL_HapticStopEffect"
- (haptic @-> haptic_effect_id @-> returning zero_to_ok)
+let haptic_stop_effect h i = zero_to_ok (C.Functions.haptic_stop_effect h i)
-let haptic_unpause =
- foreign "SDL_HapticUnpause" (haptic @-> returning zero_to_ok)
-
-let haptic_update_effect =
- foreign "SDL_HapticUpdateEffect"
- (haptic @-> haptic_effect_id @-> ptr Haptic.Effect.t @->
- returning zero_to_ok)
+let haptic_unpause h = zero_to_ok (C.Functions.haptic_unpause h)
let haptic_update_effect h id e =
- haptic_update_effect h id (addr e)
+ zero_to_ok (C.Functions.haptic_update_effect h id (addr e))
-let joystick_is_haptic =
- foreign "SDL_JoystickIsHaptic"
- (joystick @-> returning bool_to_ok)
+let joystick_is_haptic j = bool_to_ok (C.Functions.joystick_is_haptic j)
-let mouse_is_haptic =
- foreign "SDL_MouseIsHaptic" (void @-> returning bool_to_ok)
+let mouse_is_haptic () = bool_to_ok (C.Functions.mouse_is_haptic ())
-let num_haptics =
- foreign "SDL_NumHaptics" (void @-> returning nat_to_ok)
+let num_haptics () = nat_to_ok (C.Functions.num_haptics ())
(* Audio *)
(* Audio drivers *)
-let audio_init =
- foreign "SDL_AudioInit" (string_opt @-> returning zero_to_ok)
+let audio_init s = zero_to_ok (C.Functions.audio_init s)
-let audio_quit =
- foreign "SDL_AudioQuit" (void @-> returning void)
+let audio_quit = C.Functions.audio_quit
-let get_audio_driver =
- foreign "SDL_GetAudioDriver"
- (int @-> returning (some_to_ok string_opt))
+let get_audio_driver i = some_to_ok (C.Functions.get_audio_driver i)
-let get_current_audio_driver =
- foreign "SDL_GetCurrentAudioDriver" (void @-> returning string_opt)
+let get_current_audio_driver = C.Functions.get_current_audio_driver
-let get_num_audio_drivers =
- foreign "SDL_GetNumAudioDrivers" (void @-> returning nat_to_ok)
+let get_num_audio_drivers () =
+ nat_to_ok (C.Functions.get_num_audio_drivers ())
(* Audio devices *)
-module Audio = struct
- type status = int
- let stopped = sdl_audio_stopped
- let playing = sdl_audio_playing
- let paused = sdl_audio_paused
-
- type format = int
- let format = int_as_uint16_t
- let s8 = audio_s8
- let u8 = audio_u8
- let s16_lsb = audio_s16lsb
- let s16_msb = audio_s16msb
- let s16_sys = audio_s16sys
- let s16 = audio_s16
- let s16_lsb = audio_s16lsb
- let u16_lsb = audio_u16lsb
- let u16_msb = audio_u16msb
- let u16_sys = audio_u16sys
- let u16 = audio_u16
- let u16_lsb = audio_u16lsb
- let s32_lsb = audio_s32lsb
- let s32_msb = audio_s32msb
- let s32_sys = audio_s32sys
- let s32 = audio_s32
- let s32_lsb = audio_s32lsb
- let f32_lsb = audio_f32lsb
- let f32_msb = audio_f32msb
- let f32_sys = audio_f32sys
- let f32 = audio_f32
-
- type allow = int
- let allow = int
- let allow_frequency_change = sdl_audio_allow_frequency_change
- let allow_format_change = sdl_audio_allow_format_change
- let allow_channels_change = sdl_audio_allow_channels_change
- let allow_any_change = sdl_audio_allow_any_change
-end
+module Audio = C.Types.Audio
-type audio_device_id = int32
-let audio_device_id = int32_as_uint32_t
+type audio_device_id = uint32
type audio_callback =
unit Ctypes_static.ptr -> Unsigned.uint8 Ctypes_static.ptr -> int -> unit
-let audio_callback kind f =
- let kind_bytes = ba_kind_byte_size kind in
- let ba_ptr_typ = access_ptr_typ_of_ba_kind kind in
- fun _ p len ->
- let p = coerce (ptr uint8_t) ba_ptr_typ p in
- let len = len / kind_bytes in
- f (bigarray_of_ptr array1 len kind p)
-
type audio_spec =
{ as_freq : int;
as_format : Audio.format;
as_channels : uint8;
as_silence : uint8;
- as_samples : uint8;
+ as_samples : uint16;
as_size : uint32;
as_callback : audio_callback option; }
@@ -5201,77 +3032,53 @@
f (bigarray_of_ptr array1 len kind p)
let as_callback =
- (ptr void @-> ptr uint8_t @-> int @-> returning void)
-
-type _audio_spec
-let audio_spec : _audio_spec structure typ = structure "SDL_AudioSpec"
-let as_freq = field audio_spec "freq" int
-let as_format = field audio_spec "format" Audio.format
-let as_channels = field audio_spec "channels" int_as_uint8_t
-let as_silence = field audio_spec "silence" int_as_uint8_t
-let as_samples = field audio_spec "samples" int_as_uint16_t
-let _ = field audio_spec "padding" uint16_t
-let as_size = field audio_spec "size" int32_as_uint32_t
-let as_callback =
- field audio_spec "callback"
- (funptr_opt ~thread_registration:true ~runtime_lock:true as_callback)
-
-let as_userdata = field audio_spec "userdata" (ptr void)
-let () = seal audio_spec
+ Foreign.funptr_opt ~thread_registration:true ~runtime_lock:true C.Types.as_callback_type
let audio_spec_of_c c =
- let as_freq = getf c as_freq in
- let as_format = getf c as_format in
- let as_channels = getf c as_channels in
- let as_silence = getf c as_silence in
- let as_samples = getf c as_samples in
- let as_size = getf c as_size in
+ let as_freq = getf c C.Types.as_freq in
+ let as_format = Unsigned.UInt16.to_int (getf c C.Types.as_format) in
+ let as_channels = Unsigned.UInt8.to_int (getf c C.Types.as_channels) in
+ let as_silence = Unsigned.UInt8.to_int (getf c C.Types.as_silence) in
+ let as_samples = Unsigned.UInt16.to_int (getf c C.Types.as_samples) in
+ let as_size = Unsigned.UInt32.to_int32 (getf c C.Types.as_size) in
let as_callback = None in
{ as_freq; as_format; as_channels; as_silence; as_samples; as_size;
as_callback; }
let audio_spec_to_c a =
- let c = make audio_spec in
- setf c as_freq a.as_freq;
- setf c as_format a.as_format;
- setf c as_channels a.as_channels;
- setf c as_silence a.as_silence; (* irrelevant *)
- setf c as_samples a.as_samples;
- setf c as_size a.as_size; (* irrelevant *)
- setf c as_callback a.as_callback;
- setf c as_userdata null;
+ let c = make C.Types.audio_spec in
+ setf c C.Types.as_freq a.as_freq;
+ setf c C.Types.as_format (Unsigned.UInt16.of_int a.as_format);
+ setf c C.Types.as_channels (Unsigned.UInt8.of_int a.as_channels);
+ setf c C.Types.as_silence (Unsigned.UInt8.of_int a.as_silence); (* irrelevant *)
+ setf c C.Types.as_samples (Unsigned.UInt16.of_int a.as_samples);
+ setf c C.Types.as_size (Unsigned.UInt32.of_int32 a.as_size); (* irrelevant *)
+ setf c C.Types.as_callback
+ (coerce as_callback (static_funptr C.Types.as_callback_type) a.as_callback);
+ setf c C.Types.as_userdata null;
c
-let close_audio_device =
- foreign "SDL_CloseAudioDevice" (audio_device_id @-> returning void)
-
-let free_wav =
- foreign "SDL_FreeWAV" (ptr void @-> returning void)
+let close_audio_device d =
+ C.Functions.close_audio_device (Unsigned.UInt32.of_int32 d)
let free_wav ba =
- free_wav (to_voidp (bigarray_start array1 ba))
+ C.Functions.free_wav (to_voidp (bigarray_start array1 ba))
-let get_audio_device_name =
- foreign "SDL_GetAudioDeviceName"
- (int @-> bool @-> returning (some_to_ok string_opt))
-
-let get_audio_device_status =
- foreign "SDL_GetAudioDeviceStatus" (audio_device_id @-> returning int)
-
-let get_num_audio_devices =
- foreign "SDL_GetNumAudioDevices" (bool @-> returning nat_to_ok)
-
-let load_wav_rw =
- foreign ~release_runtime_lock:true "SDL_LoadWAV_RW"
- (rw_ops @-> int @-> ptr audio_spec @-> ptr (ptr void) @-> ptr uint32_t @->
- returning (some_to_ok (ptr_opt audio_spec)))
+let get_audio_device_name i b =
+ some_to_ok (C.Functions.get_audio_device_name i b)
+
+let get_audio_device_status d =
+ C.Functions.get_audio_device_status (Unsigned.UInt32.of_int32 d)
+
+let get_num_audio_devices b = nat_to_ok (C.Functions.get_num_audio_devices b)
let load_wav_rw ops spec kind =
- let d = allocate (ptr void) null in
+ let d = allocate (ptr uint8_t) (from_voidp uint8_t null) in
let len = allocate uint32_t Unsigned.UInt32.zero in
- match load_wav_rw ops 0 (addr (audio_spec_to_c spec)) d len with
- | Error _ as e -> e
- | Ok r ->
+ match C.Async_functions.load_wav_rw
+ ops 0 (addr (audio_spec_to_c spec)) d len with
+ | None -> error ()
+ | Some r ->
let rspec = audio_spec_of_c (!@ r) in
let kind_size = ba_kind_byte_size kind in
let len = Unsigned.UInt32.to_int (!@ len) in
@@ -5280,122 +3087,96 @@
else
let ba_size = len / kind_size in
let ba_ptr = access_ptr_typ_of_ba_kind kind in
- let d = coerce (ptr void) ba_ptr (!@ d) in
+ let d = coerce (ptr uint8_t) ba_ptr (!@ d) in
Ok (rspec, bigarray_of_ptr array1 ba_size kind d)
-let lock_audio_device =
- foreign "SDL_LockAudioDevice" (audio_device_id @-> returning void)
-
-let open_audio_device =
- foreign "SDL_OpenAudioDevice"
- (string_opt @-> bool @-> ptr audio_spec @-> ptr audio_spec @->
- Audio.allow @-> returning int32_as_uint32_t)
+let lock_audio_device d =
+ C.Functions.lock_audio_device (Unsigned.UInt32.of_int32 d)
let open_audio_device dev capture desired allow =
let desiredc = audio_spec_to_c desired in
- let obtained = make audio_spec in
- match open_audio_device dev capture (addr desiredc) (addr obtained) allow
+ let obtained = make C.Types.audio_spec in
+ match C.Functions.open_audio_device
+ dev capture (addr desiredc) (addr obtained) allow
with
- | id when id = Int32.zero -> error ()
- | id -> Ok (id, audio_spec_of_c obtained)
-
-let pause_audio_device =
- foreign "SDL_PauseAudioDevice" (audio_device_id @-> bool @-> returning void)
+ | id when Unsigned.UInt32.(equal id zero) -> error ()
+ | id -> Ok (Unsigned.UInt32.to_int32 id, audio_spec_of_c obtained)
-let unlock_audio_device =
- foreign "SDL_UnlockAudioDevice" (audio_device_id @-> returning void)
+let pause_audio_device d =
+ C.Functions.pause_audio_device (Unsigned.UInt32.of_int32 d)
-let queue_audio =
- foreign "SDL_QueueAudio"
- (audio_device_id @-> ptr void @-> int_as_uint32_t @-> returning zero_to_ok)
+let unlock_audio_device d =
+ C.Functions.unlock_audio_device (Unsigned.UInt32.of_int32 d)
let queue_audio dev ba =
let len = Bigarray.Array1.dim ba in
let kind_size = ba_kind_byte_size (Bigarray.Array1.kind ba) in
- queue_audio dev (to_voidp (bigarray_start array1 ba)) (len * kind_size)
-
-let dequeue_audio =
- foreign "SDL_DequeueAudio"
- (audio_device_id @-> ptr void @-> int @-> returning int_as_uint32_t)
+ zero_to_ok (C.Functions.queue_audio
+ (Unsigned.UInt32.of_int32 dev)
+ (to_voidp (bigarray_start array1 ba))
+ (Unsigned.UInt32.of_int (len * kind_size)))
let dequeue_audio dev ba =
let len = Bigarray.Array1.dim ba in
let kind_size = ba_kind_byte_size (Bigarray.Array1.kind ba) in
- dequeue_audio dev (to_voidp (bigarray_start array1 ba)) (len * kind_size)
+ Unsigned.UInt32.to_int
+ (C.Functions.dequeue_audio
+ (Unsigned.UInt32.of_int32 dev)
+ (to_voidp (bigarray_start array1 ba)) (len * kind_size))
+
+let get_queued_audio_size d =
+ Unsigned.UInt32.to_int
+ (C.Functions.get_queued_audio_size (Unsigned.UInt32.of_int32 d))
-let get_queued_audio_size =
- foreign "SDL_GetQueuedAudioSize"
- (audio_device_id @-> returning int_as_uint32_t)
-
-let clear_queued_audio =
- foreign "SDL_ClearQueuedAudio" (audio_device_id @-> returning void)
+let clear_queued_audio d =
+ C.Functions.clear_queued_audio (Unsigned.UInt32.of_int32 d)
(* Timer *)
-let delay =
- foreign ~release_runtime_lock:true "SDL_Delay" (int32_t @-> returning void)
+let delay = C.Async_functions.delay
-let get_ticks =
- foreign "SDL_GetTicks" (void @-> returning int32_t)
+let get_ticks = C.Functions.get_ticks
-let get_ticks64 =
- foreign "SDL_GetTicks64" (void @-> returning int64_t)
+let get_ticks64 = C.Functions.get_ticks64
-let get_performance_counter =
- foreign "SDL_GetPerformanceCounter" (void @-> returning int64_t)
+let get_performance_counter = C.Functions.get_performance_counter
-let get_performance_frequency =
- foreign "SDL_GetPerformanceFrequency" (void @-> returning int64_t)
+let get_performance_frequency = C.Functions.get_performance_frequency
(* Platform and CPU information *)
-let get_platform =
- foreign "SDL_GetPlatform" (void @-> returning string)
+let get_platform = C.Functions.get_platform
-let get_cpu_cache_line_size =
- foreign "SDL_GetCPUCacheLineSize" (void @-> returning nat_to_ok)
+let get_cpu_cache_line_size () =
+ nat_to_ok (C.Functions.get_cpu_cache_line_size ())
-let get_cpu_count =
- foreign "SDL_GetCPUCount" (void @-> returning int)
+let get_cpu_count = C.Functions.get_cpu_count
-let get_system_ram =
- foreign "SDL_GetSystemRAM" (void @-> returning int)
+let get_system_ram = C.Functions.get_system_ram
-let has_3d_now =
- foreign "SDL_Has3DNow" (void @-> returning bool)
+let has_3d_now = C.Functions.has_3d_now
-let has_altivec =
- foreign "SDL_HasAltiVec" (void @-> returning bool)
+let has_altivec = C.Functions.has_altivec
-let has_avx =
- foreign ~stub "SDL_HasAVX" (void @-> returning bool)
+let has_avx = C.Functions.has_avx
-let has_avx2 =
- foreign "SDL_HasAVX2" (void @-> returning bool)
+let has_avx2 = C.Functions.has_avx2
-let has_mmx =
- foreign "SDL_HasMMX" (void @-> returning bool)
+let has_mmx = C.Functions.has_mmx
-let has_neon =
- foreign "SDL_HasNEON" (void @-> returning bool)
+let has_neon = C.Functions.has_neon
-let has_rdtsc =
- foreign "SDL_HasRDTSC" (void @-> returning bool)
+let has_rdtsc = C.Functions.has_rdtsc
-let has_sse =
- foreign "SDL_HasSSE" (void @-> returning bool)
+let has_sse = C.Functions.has_sse
-let has_sse2 =
- foreign "SDL_HasSSE2" (void @-> returning bool)
+let has_sse2 = C.Functions.has_sse2
-let has_sse3 =
- foreign "SDL_HasSSE3" (void @-> returning bool)
+let has_sse3 = C.Functions.has_sse3
-let has_sse41 =
- foreign "SDL_HasSSE41" (void @-> returning bool)
+let has_sse41 = C.Functions.has_sse41
-let has_sse42 =
- foreign "SDL_HasSSE42" (void @-> returning bool)
+let has_sse42 = C.Functions.has_sse42
(* Power management *)
@@ -5403,24 +3184,21 @@
[ `Unknown | `On_battery | `No_battery | `Charging | `Charged ]
let power_state =
- [ sdl_powerstate_unknown, `Unknown;
- sdl_powerstate_on_battery, `On_battery;
- sdl_powerstate_no_battery, `No_battery;
- sdl_powerstate_charging, `Charging;
- sdl_powerstate_charged, `Charged; ]
+ C.Types.Powerstate.[ unknown, `Unknown;
+ on_battery, `On_battery;
+ no_battery, `No_battery;
+ charging, `Charging;
+ charged, `Charged; ]
type power_info =
{ pi_state : power_state;
pi_secs : int option;
pi_pct : int option; }
-let get_power_info =
- foreign "SDL_GetPowerInfo" ((ptr int) @-> (ptr int) @-> returning int)
-
let get_power_info () =
let secs = allocate int 0 in
let pct = allocate int 0 in
- let s = get_power_info secs pct in
+ let s = C.Functions.get_power_info secs pct in
let pi_state = try List.assoc s power_state with Not_found -> assert false in
let pi_secs = match !@ secs with -1 -> None | secs -> Some secs in
let pi_pct = match !@ pct with -1 -> None | pct -> Some pct in
--- a/src/tsdl.mli
+++ b/src/tsdl.mli
@@ -229,6 +229,7 @@
val category_video : category
val category_render : category
val category_input : category
+ val category_custom : category
(** {1:priority Priority} *)
@@ -291,10 +292,6 @@
val get_revision : unit -> string
(** {{:http://wiki.libsdl.org/SDL2/SDL_GetRevision}SDL_GetRevision} *)
-val get_revision_number : unit -> int
-(** {{:http://wiki.libsdl.org/SDL2/SDL_GetRevisionNumber}
- SDL_GetRevisionNumber} *)
-
(** {1:fileabstraction Files and IO abstraction} *)
(** {2:io {{:https://wiki.libsdl.org/SDL2/CategoryIO}IO abstraction}} *)
@@ -1110,6 +1107,7 @@
module Texture : sig
type access
(** {{:https://wiki.libsdl.org/SDL2/SDL_TextureAccess}SDL_TextureAccess} *)
+
val access_static : access
val access_streaming : access
val access_target : access
@@ -1288,6 +1286,7 @@
val windowed : flags
(** Equal to [0]. The flag doesn't exist in SDL, it's for using with
{!set_window_fullscreen}. *)
+
val fullscreen : flags
val fullscreen_desktop : flags
val opengl : flags
@@ -1304,6 +1303,7 @@
val allow_highdpi : flags
val mouse_capture: flags
val always_on_top: flags
+ val skip_taskbar: flags
val utility: flags
val popup_menu:flags
val vulkan: flags
@@ -1544,6 +1544,7 @@
val context_flags : attr
val context_profile_mask : attr
val context_release_behavior: attr (** 2.04.0 *)
+
val share_with_current_context : attr
val framebuffer_srgb_capable : attr
end
@@ -2610,6 +2611,9 @@
val joystick_get_axis : joystick -> int -> int16
(** {{:http://wiki.libsdl.org/SDL2/SDL_JoystickGetAxis}SDL_JoystickGetAxis} *)
+val joystick_get_axis_initial_state : joystick -> int -> int16
+(** {{:http://wiki.libsdl.org/SDL_JoystickGetAxis}SDL_JoystickGetAxisInitialState} *)
+
val joystick_get_ball : joystick -> int -> (int * int) result
(** {{:http://wiki.libsdl.org/SDL2/SDL_JoystickGetBall}SDL_JoystickGetBall} *)
@@ -3106,6 +3110,7 @@
val mouse_button_button : uint8 field
val mouse_button_state : button_state field
val mouse_button_clicks : uint8 field (** SDL 2.0.2 *)
+
val mouse_button_x : int field
val mouse_button_y : int field
@@ -3661,8 +3666,6 @@
val s16_msb : format
val s16_sys : format
val s16 : format
- val s16_lsb : format
- val u16_lsb : format
val u16_msb : format
val u16_sys : format
val u16 : format
@@ -3671,7 +3674,6 @@
val s32_msb : format
val s32_sys : format
val s32 : format
- val s32_lsb : format
val f32_lsb : format
val f32_msb : format
val f32_sys : format
@@ -3981,7 +3983,9 @@
{- {{:http://wiki.libsdl.org/SDL2/SDL_PauseAudio}SDL_PauseAudio}
(SDL legacy function)}
{- {{:http://wiki.libsdl.org/SDL2/SDL_UnlockAudio}SDL_UnlockAudio}
- (SDL legacy function)}} *)
+ (SDL legacy function)}
+ {- {{:http://wiki.libsdl.org/SDL2/SDL_GetRevisionNumber}
+ SDL_GetRevisionNumber} (SDL legacy function)}} *)
end
(** {1:conventions Binding conventions}
--- /dev/null
+++ b/src/type_description.ml
@@ -0,0 +1,1800 @@
+module Types (F : Ctypes.TYPE) = struct
+
+ module Init = struct
+ let timer = F.constant "SDL_INIT_TIMER" F.uint32_t
+ let audio = F.constant "SDL_INIT_AUDIO" F.uint32_t
+ let video = F.constant "SDL_INIT_VIDEO" F.uint32_t
+ let joystick = F.constant "SDL_INIT_JOYSTICK" F.uint32_t
+ let haptic = F.constant "SDL_INIT_HAPTIC" F.uint32_t
+ let gamecontroller = F.constant "SDL_INIT_GAMECONTROLLER" F.uint32_t
+ let events = F.constant "SDL_INIT_EVENTS" F.uint32_t
+ let everything = F.constant "SDL_INIT_EVERYTHING" F.uint32_t
+ let noparachute = F.constant "SDL_INIT_NOPARACHUTE" F.uint32_t
+ end
+
+ module Hint = struct
+ let default = F.constant "SDL_HINT_DEFAULT" F.int
+ let normal = F.constant "SDL_HINT_NORMAL" F.int
+ let override = F.constant "SDL_HINT_OVERRIDE" F.int
+ end
+
+ module Log = struct
+ let category_application = F.constant "SDL_LOG_CATEGORY_APPLICATION" F.int
+ let category_error = F.constant "SDL_LOG_CATEGORY_ERROR" F.int
+ let category_system = F.constant "SDL_LOG_CATEGORY_SYSTEM" F.int
+ let category_audio = F.constant "SDL_LOG_CATEGORY_AUDIO" F.int
+ let category_video = F.constant "SDL_LOG_CATEGORY_VIDEO" F.int
+ let category_render = F.constant "SDL_LOG_CATEGORY_RENDER" F.int
+ let category_input = F.constant "SDL_LOG_CATEGORY_INPUT" F.int
+ let category_custom = F.constant "SDL_LOG_CATEGORY_CUSTOM" F.int
+
+ let priority_verbose = F.constant "SDL_LOG_PRIORITY_VERBOSE" F.int
+ let priority_debug = F.constant "SDL_LOG_PRIORITY_DEBUG" F.int
+ let priority_info = F.constant "SDL_LOG_PRIORITY_INFO" F.int
+ let priority_warn = F.constant "SDL_LOG_PRIORITY_WARN" F.int
+ let priority_error = F.constant "SDL_LOG_PRIORITY_ERROR" F.int
+ let priority_critical = F.constant "SDL_LOG_PRIORITY_CRITICAL" F.int
+ end
+
+ type version
+ let version : version Ctypes_static.structure F.typ = F.structure "SDL_version"
+ let version_major = F.field version "major" F.uint8_t
+ let version_minor = F.field version "minor" F.uint8_t
+ let version_patch = F.field version "patch" F.uint8_t
+ let () = F.seal version
+
+ (* IO absraction *)
+
+ type _rw_ops
+ type rw_ops = _rw_ops Ctypes_static.structure Ctypes_static.ptr
+ let rw_ops_struct : _rw_ops Ctypes_static.structure F.typ = F.structure "SDL_RWops"
+ let rw_ops : rw_ops F.typ = F.ptr rw_ops_struct
+ let rw_ops_opt : rw_ops option F.typ = F.ptr_opt rw_ops_struct
+
+ let _rw_ops_size = F.field rw_ops_struct "size"
+ F.(static_funptr (rw_ops @-> returning int64_t))
+ let _rw_ops_seek = F.field rw_ops_struct "seek"
+ F.(static_funptr (rw_ops @-> int64_t @-> int @-> returning int64_t))
+ let _rw_ops_read = F.field rw_ops_struct "read"
+ F.(static_funptr (rw_ops @-> ptr void @-> size_t @-> size_t @-> returning size_t))
+ let _rw_ops_write = F.field rw_ops_struct "write"
+ F.(static_funptr (rw_ops @-> ptr void @-> size_t @-> size_t @-> returning size_t))
+ let _rw_ops_close = F.field rw_ops_struct "close"
+ F.(static_funptr (rw_ops @-> returning int))
+ let _ = F.field rw_ops_struct "type" F.uint32_t
+ (* ... #ifdef'd union follows, we don't care we don't use Ctypes.make *)
+ let () = F.seal rw_ops_struct
+
+ module Color = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Color"
+ let r = F.field t "r" F.uint8_t
+ let g = F.field t "g" F.uint8_t
+ let b = F.field t "b" F.uint8_t
+ let a = F.field t "a" F.uint8_t
+ let () = F.seal t
+ end
+
+ module Point = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Point"
+ let x = F.field t "x" F.int
+ let y = F.field t "y" F.int
+ let () = F.seal t
+ end
+
+ module Fpoint = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_FPoint"
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let () = F.seal t
+ end
+
+ module Vertex = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Vertex"
+ let position = F.field t "position" Fpoint.t
+ let color = F.field t "color" Color.t
+ let tex_coord = F.field t "tex_coord" Fpoint.t
+ let () = F.seal t
+ end
+
+ module Rect = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Rect"
+ let x = F.field t "x" F.int
+ let y = F.field t "y" F.int
+ let w = F.field t "w" F.int
+ let h = F.field t "h" F.int
+ let () = F.seal t
+ end
+
+ module Frect = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_FRect"
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let w = F.field t "w" F.float
+ let h = F.field t "h" F.float
+ let () = F.seal t
+ end
+
+ type _palette
+ type palette = _palette Ctypes_static.structure
+ let palette : palette F.typ = F.structure "SDL_Palette"
+ let palette_ncolors = F.field palette "ncolors" F.int
+ let palette_colors = F.field palette "colors" (F.ptr Color.t)
+ let _ = F.field palette "version" F.uint32_t
+ let _ = F.field palette "refcount" F.int
+ let () = F.seal palette
+
+ module Blend = struct
+ type mode = Unsigned.UInt.t
+ let mode_none = F.constant "SDL_BLENDMODE_NONE" F.uint
+ let mode_blend = F.constant "SDL_BLENDMODE_BLEND" F.uint
+ let mode_add = F.constant "SDL_BLENDMODE_ADD" F.uint
+ let mode_mod = F.constant "SDL_BLENDMODE_MOD" F.uint
+ let mode_mul = F.constant "SDL_BLENDMODE_MUL" F.uint
+ let mode_invalid = F.constant "SDL_BLENDMODE_INVALID" F.uint
+ let mode = F.uint
+
+ let add = F.constant "SDL_BLENDOPERATION_ADD" F.int
+ let subtract = F.constant "SDL_BLENDOPERATION_SUBTRACT" F.int
+ let rev_subtract = F.constant "SDL_BLENDOPERATION_REV_SUBTRACT" F.int
+ let maximum = F.constant "SDL_BLENDOPERATION_MAXIMUM" F.int
+ let minimum = F.constant "SDL_BLENDOPERATION_MINIMUM" F.int
+
+ let zero = F.constant "SDL_BLENDFACTOR_ZERO" F.int
+ let one = F.constant "SDL_BLENDFACTOR_ONE" F.int
+ let src_color = F.constant "SDL_BLENDFACTOR_SRC_COLOR" F.int
+ let one_minus_src_color = F.constant "SDL_BLENDFACTOR_ONE_MINUS_SRC_COLOR" F.int
+ let src_alpha = F.constant "SDL_BLENDFACTOR_SRC_ALPHA" F.int
+ let one_minus_src_alpha = F.constant "SDL_BLENDFACTOR_ONE_MINUS_SRC_ALPHA" F.int
+ let dst_color = F.constant "SDL_BLENDFACTOR_DST_COLOR" F.int
+ let one_minus_dst_color = F.constant "SDL_BLENDFACTOR_ONE_MINUS_DST_COLOR" F.int
+ let dst_alpha = F.constant "SDL_BLENDFACTOR_DST_ALPHA" F.int
+ let one_minus_dst_alpha = F.constant "SDL_BLENDFACTOR_ONE_MINUS_DST_ALPHA" F.int
+ end
+
+ module Pixel = struct
+ let format_unknown = F.constant "SDL_PIXELFORMAT_UNKNOWN" F.uint32_t
+ let format_index1lsb = F.constant "SDL_PIXELFORMAT_INDEX1LSB" F.uint32_t
+ let format_index1msb = F.constant "SDL_PIXELFORMAT_INDEX1MSB" F.uint32_t
+ let format_index4lsb = F.constant "SDL_PIXELFORMAT_INDEX4LSB" F.uint32_t
+ let format_index4msb = F.constant "SDL_PIXELFORMAT_INDEX4MSB" F.uint32_t
+ let format_index8 = F.constant "SDL_PIXELFORMAT_INDEX8" F.uint32_t
+ let format_rgb332 = F.constant "SDL_PIXELFORMAT_RGB332" F.uint32_t
+ let format_rgb444 = F.constant "SDL_PIXELFORMAT_RGB444" F.uint32_t
+ let format_rgb555 = F.constant "SDL_PIXELFORMAT_RGB555" F.uint32_t
+ let format_bgr555 = F.constant "SDL_PIXELFORMAT_BGR555" F.uint32_t
+ let format_argb4444 = F.constant "SDL_PIXELFORMAT_ARGB4444" F.uint32_t
+ let format_rgba4444 = F.constant "SDL_PIXELFORMAT_RGBA4444" F.uint32_t
+ let format_abgr4444 = F.constant "SDL_PIXELFORMAT_ABGR4444" F.uint32_t
+ let format_bgra4444 = F.constant "SDL_PIXELFORMAT_BGRA4444" F.uint32_t
+ let format_argb1555 = F.constant "SDL_PIXELFORMAT_ARGB1555" F.uint32_t
+ let format_rgba5551 = F.constant "SDL_PIXELFORMAT_RGBA5551" F.uint32_t
+ let format_abgr1555 = F.constant "SDL_PIXELFORMAT_ABGR1555" F.uint32_t
+ let format_bgra5551 = F.constant "SDL_PIXELFORMAT_BGRA5551" F.uint32_t
+ let format_rgb565 = F.constant "SDL_PIXELFORMAT_RGB565" F.uint32_t
+ let format_bgr565 = F.constant "SDL_PIXELFORMAT_BGR565" F.uint32_t
+ let format_rgb24 = F.constant "SDL_PIXELFORMAT_RGB24" F.uint32_t
+ let format_bgr24 = F.constant "SDL_PIXELFORMAT_BGR24" F.uint32_t
+ let format_rgb888 = F.constant "SDL_PIXELFORMAT_RGB888" F.uint32_t
+ let format_rgbx8888 = F.constant "SDL_PIXELFORMAT_RGBX8888" F.uint32_t
+ let format_bgr888 = F.constant "SDL_PIXELFORMAT_BGR888" F.uint32_t
+ let format_bgrx8888 = F.constant "SDL_PIXELFORMAT_BGRX8888" F.uint32_t
+ let format_argb8888 = F.constant "SDL_PIXELFORMAT_ARGB8888" F.uint32_t
+ let format_rgba8888 = F.constant "SDL_PIXELFORMAT_RGBA8888" F.uint32_t
+ let format_abgr8888 = F.constant "SDL_PIXELFORMAT_ABGR8888" F.uint32_t
+ let format_bgra8888 = F.constant "SDL_PIXELFORMAT_BGRA8888" F.uint32_t
+ let format_argb2101010 = F.constant "SDL_PIXELFORMAT_ARGB2101010" F.uint32_t
+ let format_yv12 = F.constant "SDL_PIXELFORMAT_YV12" F.uint32_t
+ let format_iyuv = F.constant "SDL_PIXELFORMAT_IYUV" F.uint32_t
+ let format_yuy2 = F.constant "SDL_PIXELFORMAT_YUY2" F.uint32_t
+ let format_uyvy = F.constant "SDL_PIXELFORMAT_UYVY" F.uint32_t
+ let format_yvyu = F.constant "SDL_PIXELFORMAT_YVYU" F.uint32_t
+ end
+
+ type _pixel_format
+ type pixel_format = _pixel_format Ctypes_static.structure
+ let pixel_format : pixel_format F.typ = F.structure "SDL_PixelFormat"
+ let pf_format = F.field pixel_format "format" F.uint32_t
+ let _pf_palette = F.field pixel_format "palette" (F.ptr palette)
+ let pf_bits_per_pixel = F.field pixel_format "BitsPerPixel" F.uint8_t
+ let pf_bytes_per_pixel = F.field pixel_format "BytesPerPixel" F.uint8_t
+ let _ = F.field pixel_format "padding" F.uint16_t
+ let _ = F.field pixel_format "Rmask" F.uint32_t
+ let _ = F.field pixel_format "Gmask" F.uint32_t
+ let _ = F.field pixel_format "Bmask" F.uint32_t
+ let _ = F.field pixel_format "Amask" F.uint32_t
+ let _ = F.field pixel_format "Rloss" F.uint8_t
+ let _ = F.field pixel_format "Gloss" F.uint8_t
+ let _ = F.field pixel_format "Bloss" F.uint8_t
+ let _ = F.field pixel_format "Aloss" F.uint8_t
+ let _ = F.field pixel_format "Rshift" F.uint8_t
+ let _ = F.field pixel_format "Gshift" F.uint8_t
+ let _ = F.field pixel_format "Bshift" F.uint8_t
+ let _ = F.field pixel_format "Ashift" F.uint8_t
+ let _ = F.field pixel_format "refcount" F.int
+ let _ = F.field pixel_format "next" (F.ptr pixel_format)
+ let () = F.seal pixel_format
+
+ type _surface
+ type surface = _surface Ctypes_static.structure
+ let surface : surface F.typ = F.structure "SDL_Surface"
+ let _ = F.field surface "flags" F.uint32_t
+ let surface_format = F.field surface "format" (F.ptr pixel_format)
+ let surface_w = F.field surface "w" F.int
+ let surface_h = F.field surface "h" F.int
+ let surface_pitch = F.field surface "pitch" F.int
+ let surface_pixels = F.field surface "pixels" F.(ptr void)
+ let _ = F.field surface "userdata" F.(ptr void)
+ let _ = F.field surface "locked" F.int
+ let _ = F.field surface "list_blitmap" F.(ptr void)
+ let _ = F.field surface "clip_rect" Rect.t
+ let _ = F.field surface "map" F.(ptr void)
+ let _ = F.field surface "refcount" F.int
+ let () = F.seal surface
+
+ module Flip = struct
+ let none = F.constant "SDL_FLIP_NONE" F.int
+ let horizontal = F.constant "SDL_FLIP_HORIZONTAL" F.int
+ let vertical = F.constant "SDL_FLIP_VERTICAL" F.int
+ end
+
+ module Renderer = struct
+ let software = F.constant "SDL_RENDERER_SOFTWARE" F.uint32_t
+ let accelerated = F.constant "SDL_RENDERER_ACCELERATED" F.uint32_t
+ let presentvsync = F.constant "SDL_RENDERER_PRESENTVSYNC" F.uint32_t
+ let targettexture = F.constant "SDL_RENDERER_TARGETTEXTURE" F.uint32_t
+
+ type _renderer
+
+ type t = _renderer Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Renderer"
+ end
+
+ type renderer_info
+ let renderer_info : renderer_info Ctypes_static.structure F.typ = F.structure "SDL_RendererInfo"
+ let ri_name = F.field renderer_info "name" F.string
+ let ri_flags = F.field renderer_info "flags" F.uint32_t
+ let ri_num_tf = F.field renderer_info "num_texture_formats" F.uint32_t
+ let ri_tfs = F.field renderer_info "texture_formats" F.(array 16 uint32_t)
+ let ri_max_texture_width = F.field renderer_info "max_texture_width" F.int
+ let ri_max_texture_height = F.field renderer_info "max_texture_height" F.int
+ let () = F.seal renderer_info
+
+ module Texture = struct
+ let access_static = F.constant "SDL_TEXTUREACCESS_STATIC" F.int
+ let access_streaming = F.constant "SDL_TEXTUREACCESS_STREAMING" F.int
+ let access_target = F.constant "SDL_TEXTUREACCESS_TARGET" F.int
+
+ let modulate_none = F.constant "SDL_TEXTUREMODULATE_NONE" F.uint32_t
+ let modulate_color = F.constant "SDL_TEXTUREMODULATE_COLOR" F.uint32_t
+ let modulate_alpha = F.constant "SDL_TEXTUREMODULATE_ALPHA" F.uint32_t
+
+ type _t
+
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Texture"
+ end
+
+ type _display_mode
+ let display_mode : _display_mode Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_display_mode") "SDL_DisplayMode"
+ let dm_format = F.field display_mode "format" F.uint32_t
+ let dm_w = F.field display_mode "w" F.int
+ let dm_h = F.field display_mode "h" F.int
+ let dm_refresh_rate = F.field display_mode "refresh_rate" F.int
+ let dm_driverdata = F.field display_mode "driverdata" F.(ptr_opt void)
+ let () = F.seal display_mode
+
+ module Window = struct
+ type _t
+ type t = _t Ctypes_static.structure Ctypes_static.ptr
+ let raw : _t Ctypes_static.structure F.typ = F.structure "SDL_Window"
+ let t = F.ptr raw
+ let opt = F.ptr_opt raw
+
+ let fullscreen = F.constant "SDL_WINDOW_FULLSCREEN" F.uint32_t
+ let fullscreen_desktop = F.constant "SDL_WINDOW_FULLSCREEN_DESKTOP" F.uint32_t
+ let opengl = F.constant "SDL_WINDOW_OPENGL" F.uint32_t
+ let shown = F.constant "SDL_WINDOW_SHOWN" F.uint32_t
+ let hidden = F.constant "SDL_WINDOW_HIDDEN" F.uint32_t
+ let borderless = F.constant "SDL_WINDOW_BORDERLESS" F.uint32_t
+ let resizable = F.constant "SDL_WINDOW_RESIZABLE" F.uint32_t
+ let minimized = F.constant "SDL_WINDOW_MINIMIZED" F.uint32_t
+ let maximized = F.constant "SDL_WINDOW_MAXIMIZED" F.uint32_t
+ let input_grabbed = F.constant "SDL_WINDOW_INPUT_GRABBED" F.uint32_t
+ let input_focus = F.constant "SDL_WINDOW_INPUT_FOCUS" F.uint32_t
+ let mouse_focus = F.constant "SDL_WINDOW_MOUSE_FOCUS" F.uint32_t
+ let foreign = F.constant "SDL_WINDOW_FOREIGN" F.uint32_t
+ let allow_highdpi = F.constant "SDL_WINDOW_ALLOW_HIGHDPI" F.uint32_t
+ let mouse_capture = F.constant "SDL_WINDOW_MOUSE_CAPTURE" F.uint32_t
+ let always_on_top = F.constant "SDL_WINDOW_ALWAYS_ON_TOP" F.uint32_t
+ let skip_taskbar = F.constant "SDL_WINDOW_SKIP_TASKBAR" F.uint32_t
+ let utility = F.constant "SDL_WINDOW_UTILITY" F.uint32_t
+ let popup_menu = F.constant "SDL_WINDOW_POPUP_MENU" F.uint32_t
+ let vulkan = F.constant "SDL_WINDOW_VULKAN" F.uint32_t
+
+ let pos_centered = F.constant "SDL_WINDOWPOS_CENTERED" F.int
+ let pos_undefined = F.constant "SDL_WINDOWPOS_UNDEFINED" F.int
+ end
+
+ module Gl = struct
+
+ (* contextFlag *)
+
+ let context_debug_flag = F.constant "SDL_GL_CONTEXT_DEBUG_FLAG" F.int
+ let context_forward_compatible_flag = F.constant "SDL_GL_CONTEXT_FORWARD_COMPATIBLE_FLAG" F.int
+ let context_robust_access_flag = F.constant "SDL_GL_CONTEXT_ROBUST_ACCESS_FLAG" F.int
+ let context_reset_isolation_flag = F.constant "SDL_GL_CONTEXT_RESET_ISOLATION_FLAG" F.int
+ let context_release_behavior = F.constant "SDL_GL_CONTEXT_RELEASE_BEHAVIOR" F.int
+
+ (* profile *)
+
+ let context_profile_core = F.constant "SDL_GL_CONTEXT_PROFILE_CORE" F.int
+ let context_profile_compatibility = F.constant "SDL_GL_CONTEXT_PROFILE_COMPATIBILITY" F.int
+ let context_profile_es = F.constant "SDL_GL_CONTEXT_PROFILE_ES" F.int
+
+ (* attr *)
+
+ let red_size = F.constant "SDL_GL_RED_SIZE" F.int
+ let green_size = F.constant "SDL_GL_GREEN_SIZE" F.int
+ let blue_size = F.constant "SDL_GL_BLUE_SIZE" F.int
+ let alpha_size = F.constant "SDL_GL_ALPHA_SIZE" F.int
+ let buffer_size = F.constant "SDL_GL_BUFFER_SIZE" F.int
+ let doublebuffer = F.constant "SDL_GL_DOUBLEBUFFER" F.int
+ let depth_size = F.constant "SDL_GL_DEPTH_SIZE" F.int
+ let stencil_size = F.constant "SDL_GL_STENCIL_SIZE" F.int
+ let accum_red_size = F.constant "SDL_GL_ACCUM_RED_SIZE" F.int
+ let accum_green_size = F.constant "SDL_GL_ACCUM_GREEN_SIZE" F.int
+ let accum_blue_size = F.constant "SDL_GL_ACCUM_BLUE_SIZE" F.int
+ let accum_alpha_size = F.constant "SDL_GL_ACCUM_ALPHA_SIZE" F.int
+ let stereo = F.constant "SDL_GL_STEREO" F.int
+ let multisamplebuffers = F.constant "SDL_GL_MULTISAMPLEBUFFERS" F.int
+ let multisamplesamples = F.constant "SDL_GL_MULTISAMPLESAMPLES" F.int
+ let accelerated_visual = F.constant "SDL_GL_ACCELERATED_VISUAL" F.int
+ let context_major_version = F.constant "SDL_GL_CONTEXT_MAJOR_VERSION" F.int
+ let context_minor_version = F.constant "SDL_GL_CONTEXT_MINOR_VERSION" F.int
+ let context_egl = F.constant "SDL_GL_CONTEXT_EGL" F.int
+ let context_flags = F.constant "SDL_GL_CONTEXT_FLAGS" F.int
+ let context_profile_mask = F.constant "SDL_GL_CONTEXT_PROFILE_MASK" F.int
+ let share_with_current_context = F.constant "SDL_GL_SHARE_WITH_CURRENT_CONTEXT" F.int
+ let framebuffer_srgb_capable = F.constant "SDL_GL_FRAMEBUFFER_SRGB_CAPABLE" F.int
+
+ type _context
+ type context = _context Ctypes_static.structure
+ let context : context F.typ = F.structure "SDL_GLContext"
+ end
+
+ module Vulkan = struct
+ type _surface
+ type surface = _surface Ctypes_static.structure Ctypes_static.ptr
+
+ let raw_surface : _surface Ctypes_static.structure F.typ =
+ F.structure "VkSurfaceKHR_T"
+ let surface : surface F.typ = F.ptr raw_surface
+ end
+
+ module Message_box = struct
+ let error = F.constant "SDL_MESSAGEBOX_ERROR" F.uint32_t
+ let warning = F.constant "SDL_MESSAGEBOX_WARNING" F.uint32_t
+ let information = F.constant "SDL_MESSAGEBOX_INFORMATION" F.uint32_t
+
+ let button_returnkey_default = F.constant "SDL_MESSAGEBOX_BUTTON_RETURNKEY_DEFAULT" F.uint32_t
+ let button_escapekey_default = F.constant "SDL_MESSAGEBOX_BUTTON_ESCAPEKEY_DEFAULT" F.uint32_t
+
+ let color_background = F.constant "SDL_MESSAGEBOX_COLOR_BACKGROUND" F.int
+ let color_text = F.constant "SDL_MESSAGEBOX_COLOR_TEXT" F.int
+ let color_button_border = F.constant "SDL_MESSAGEBOX_COLOR_BUTTON_BORDER" F.int
+ let color_button_background = F.constant "SDL_MESSAGEBOX_COLOR_BUTTON_BACKGROUND" F.int
+ let color_button_selected = F.constant "SDL_MESSAGEBOX_COLOR_BUTTON_SELECTED" F.int
+ let color_button_max = F.constant "SDL_MESSAGEBOX_COLOR_MAX" F.int
+
+ type _button_data
+ let button_data : _button_data Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_message_box_button_data") "SDL_MessageBoxButtonData"
+ let button_flags = F.field button_data "flags" F.uint32_t
+ let button_buttonid = F.field button_data "buttonid" F.int
+ let button_text = F.field button_data "text" F.string
+ let () = F.seal button_data
+
+ type _color
+ let color : _color Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_message_box_color") "SDL_MessageBoxColor"
+ let color_r = F.field color "r" F.uint8_t
+ let color_g = F.field color "g" F.uint8_t
+ let color_b = F.field color "b" F.uint8_t
+ let () = F.seal color
+
+ type _color_scheme
+ let color_scheme : _color_scheme Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_SDL_MessageBoxColorScheme") "SDL_MessageBoxColorScheme"
+ let colors = F.field color_scheme "colors" (F.array 5 color)
+ let () = F.seal color_scheme
+
+ type _data
+ let data : _data Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_SDL_MessageBoxData") "SDL_MessageBoxData"
+ let d_flags = F.field data "flags" F.uint32_t
+ let d_window = F.field data "window" Window.opt
+ let d_title = F.field data "title" F.string
+ let d_message = F.field data "message" F.string
+ let d_numbuttons = F.field data "numbuttons" F.int
+ let d_buttons = F.field data "buttons" (F.ptr button_data)
+ let d_color_scheme = F.field data "colorScheme" (F.ptr_opt color_scheme)
+ let () = F.seal data
+ end
+
+ module Scancode = struct
+ let unknown = F.constant "SDL_SCANCODE_UNKNOWN" F.int
+ let a = F.constant "SDL_SCANCODE_A" F.int
+ let b = F.constant "SDL_SCANCODE_B" F.int
+ let c = F.constant "SDL_SCANCODE_C" F.int
+ let d = F.constant "SDL_SCANCODE_D" F.int
+ let e = F.constant "SDL_SCANCODE_E" F.int
+ let f = F.constant "SDL_SCANCODE_F" F.int
+ let g = F.constant "SDL_SCANCODE_G" F.int
+ let h = F.constant "SDL_SCANCODE_H" F.int
+ let i = F.constant "SDL_SCANCODE_I" F.int
+ let j = F.constant "SDL_SCANCODE_J" F.int
+ let k = F.constant "SDL_SCANCODE_K" F.int
+ let l = F.constant "SDL_SCANCODE_L" F.int
+ let m = F.constant "SDL_SCANCODE_M" F.int
+ let n = F.constant "SDL_SCANCODE_N" F.int
+ let o = F.constant "SDL_SCANCODE_O" F.int
+ let p = F.constant "SDL_SCANCODE_P" F.int
+ let q = F.constant "SDL_SCANCODE_Q" F.int
+ let r = F.constant "SDL_SCANCODE_R" F.int
+ let s = F.constant "SDL_SCANCODE_S" F.int
+ let t = F.constant "SDL_SCANCODE_T" F.int
+ let u = F.constant "SDL_SCANCODE_U" F.int
+ let v = F.constant "SDL_SCANCODE_V" F.int
+ let w = F.constant "SDL_SCANCODE_W" F.int
+ let x = F.constant "SDL_SCANCODE_X" F.int
+ let y = F.constant "SDL_SCANCODE_Y" F.int
+ let z = F.constant "SDL_SCANCODE_Z" F.int
+ let k1 = F.constant "SDL_SCANCODE_1" F.int
+ let k2 = F.constant "SDL_SCANCODE_2" F.int
+ let k3 = F.constant "SDL_SCANCODE_3" F.int
+ let k4 = F.constant "SDL_SCANCODE_4" F.int
+ let k5 = F.constant "SDL_SCANCODE_5" F.int
+ let k6 = F.constant "SDL_SCANCODE_6" F.int
+ let k7 = F.constant "SDL_SCANCODE_7" F.int
+ let k8 = F.constant "SDL_SCANCODE_8" F.int
+ let k9 = F.constant "SDL_SCANCODE_9" F.int
+ let k0 = F.constant "SDL_SCANCODE_0" F.int
+ let return = F.constant "SDL_SCANCODE_RETURN" F.int
+ let escape = F.constant "SDL_SCANCODE_ESCAPE" F.int
+ let backspace = F.constant "SDL_SCANCODE_BACKSPACE" F.int
+ let tab = F.constant "SDL_SCANCODE_TAB" F.int
+ let space = F.constant "SDL_SCANCODE_SPACE" F.int
+ let minus = F.constant "SDL_SCANCODE_MINUS" F.int
+ let equals = F.constant "SDL_SCANCODE_EQUALS" F.int
+ let leftbracket = F.constant "SDL_SCANCODE_LEFTBRACKET" F.int
+ let rightbracket = F.constant "SDL_SCANCODE_RIGHTBRACKET" F.int
+ let backslash = F.constant "SDL_SCANCODE_BACKSLASH" F.int
+ let nonushash = F.constant "SDL_SCANCODE_NONUSHASH" F.int
+ let semicolon = F.constant "SDL_SCANCODE_SEMICOLON" F.int
+ let apostrophe = F.constant "SDL_SCANCODE_APOSTROPHE" F.int
+ let grave = F.constant "SDL_SCANCODE_GRAVE" F.int
+ let comma = F.constant "SDL_SCANCODE_COMMA" F.int
+ let period = F.constant "SDL_SCANCODE_PERIOD" F.int
+ let slash = F.constant "SDL_SCANCODE_SLASH" F.int
+ let capslock = F.constant "SDL_SCANCODE_CAPSLOCK" F.int
+ let f1 = F.constant "SDL_SCANCODE_F1" F.int
+ let f2 = F.constant "SDL_SCANCODE_F2" F.int
+ let f3 = F.constant "SDL_SCANCODE_F3" F.int
+ let f4 = F.constant "SDL_SCANCODE_F4" F.int
+ let f5 = F.constant "SDL_SCANCODE_F5" F.int
+ let f6 = F.constant "SDL_SCANCODE_F6" F.int
+ let f7 = F.constant "SDL_SCANCODE_F7" F.int
+ let f8 = F.constant "SDL_SCANCODE_F8" F.int
+ let f9 = F.constant "SDL_SCANCODE_F9" F.int
+ let f10 = F.constant "SDL_SCANCODE_F10" F.int
+ let f11 = F.constant "SDL_SCANCODE_F11" F.int
+ let f12 = F.constant "SDL_SCANCODE_F12" F.int
+ let printscreen = F.constant "SDL_SCANCODE_PRINTSCREEN" F.int
+ let scrolllock = F.constant "SDL_SCANCODE_SCROLLLOCK" F.int
+ let pause = F.constant "SDL_SCANCODE_PAUSE" F.int
+ let insert = F.constant "SDL_SCANCODE_INSERT" F.int
+ let home = F.constant "SDL_SCANCODE_HOME" F.int
+ let pageup = F.constant "SDL_SCANCODE_PAGEUP" F.int
+ let delete = F.constant "SDL_SCANCODE_DELETE" F.int
+ let kend = F.constant "SDL_SCANCODE_END" F.int
+ let pagedown = F.constant "SDL_SCANCODE_PAGEDOWN" F.int
+ let right = F.constant "SDL_SCANCODE_RIGHT" F.int
+ let left = F.constant "SDL_SCANCODE_LEFT" F.int
+ let down = F.constant "SDL_SCANCODE_DOWN" F.int
+ let up = F.constant "SDL_SCANCODE_UP" F.int
+ let numlockclear = F.constant "SDL_SCANCODE_NUMLOCKCLEAR" F.int
+ let kp_divide = F.constant "SDL_SCANCODE_KP_DIVIDE" F.int
+ let kp_multiply = F.constant "SDL_SCANCODE_KP_MULTIPLY" F.int
+ let kp_minus = F.constant "SDL_SCANCODE_KP_MINUS" F.int
+ let kp_plus = F.constant "SDL_SCANCODE_KP_PLUS" F.int
+ let kp_enter = F.constant "SDL_SCANCODE_KP_ENTER" F.int
+ let kp_1 = F.constant "SDL_SCANCODE_KP_1" F.int
+ let kp_2 = F.constant "SDL_SCANCODE_KP_2" F.int
+ let kp_3 = F.constant "SDL_SCANCODE_KP_3" F.int
+ let kp_4 = F.constant "SDL_SCANCODE_KP_4" F.int
+ let kp_5 = F.constant "SDL_SCANCODE_KP_5" F.int
+ let kp_6 = F.constant "SDL_SCANCODE_KP_6" F.int
+ let kp_7 = F.constant "SDL_SCANCODE_KP_7" F.int
+ let kp_8 = F.constant "SDL_SCANCODE_KP_8" F.int
+ let kp_9 = F.constant "SDL_SCANCODE_KP_9" F.int
+ let kp_0 = F.constant "SDL_SCANCODE_KP_0" F.int
+ let kp_period = F.constant "SDL_SCANCODE_KP_PERIOD" F.int
+ let nonusbackslash = F.constant "SDL_SCANCODE_NONUSBACKSLASH" F.int
+ let application = F.constant "SDL_SCANCODE_APPLICATION" F.int
+ let kp_equals = F.constant "SDL_SCANCODE_KP_EQUALS" F.int
+ let f13 = F.constant "SDL_SCANCODE_F13" F.int
+ let f14 = F.constant "SDL_SCANCODE_F14" F.int
+ let f15 = F.constant "SDL_SCANCODE_F15" F.int
+ let f16 = F.constant "SDL_SCANCODE_F16" F.int
+ let f17 = F.constant "SDL_SCANCODE_F17" F.int
+ let f18 = F.constant "SDL_SCANCODE_F18" F.int
+ let f19 = F.constant "SDL_SCANCODE_F19" F.int
+ let f20 = F.constant "SDL_SCANCODE_F20" F.int
+ let f21 = F.constant "SDL_SCANCODE_F21" F.int
+ let f22 = F.constant "SDL_SCANCODE_F22" F.int
+ let f23 = F.constant "SDL_SCANCODE_F23" F.int
+ let f24 = F.constant "SDL_SCANCODE_F24" F.int
+ let execute = F.constant "SDL_SCANCODE_EXECUTE" F.int
+ let help = F.constant "SDL_SCANCODE_HELP" F.int
+ let menu = F.constant "SDL_SCANCODE_MENU" F.int
+ let select = F.constant "SDL_SCANCODE_SELECT" F.int
+ let stop = F.constant "SDL_SCANCODE_STOP" F.int
+ let again = F.constant "SDL_SCANCODE_AGAIN" F.int
+ let undo = F.constant "SDL_SCANCODE_UNDO" F.int
+ let cut = F.constant "SDL_SCANCODE_CUT" F.int
+ let copy = F.constant "SDL_SCANCODE_COPY" F.int
+ let paste = F.constant "SDL_SCANCODE_PASTE" F.int
+ let find = F.constant "SDL_SCANCODE_FIND" F.int
+ let mute = F.constant "SDL_SCANCODE_MUTE" F.int
+ let volumeup = F.constant "SDL_SCANCODE_VOLUMEUP" F.int
+ let volumedown = F.constant "SDL_SCANCODE_VOLUMEDOWN" F.int
+ let kp_comma = F.constant "SDL_SCANCODE_KP_COMMA" F.int
+ let kp_equalsas400 = F.constant "SDL_SCANCODE_KP_EQUALSAS400" F.int
+ let international1 = F.constant "SDL_SCANCODE_INTERNATIONAL1" F.int
+ let international2 = F.constant "SDL_SCANCODE_INTERNATIONAL2" F.int
+ let international3 = F.constant "SDL_SCANCODE_INTERNATIONAL3" F.int
+ let international4 = F.constant "SDL_SCANCODE_INTERNATIONAL4" F.int
+ let international5 = F.constant "SDL_SCANCODE_INTERNATIONAL5" F.int
+ let international6 = F.constant "SDL_SCANCODE_INTERNATIONAL6" F.int
+ let international7 = F.constant "SDL_SCANCODE_INTERNATIONAL7" F.int
+ let international8 = F.constant "SDL_SCANCODE_INTERNATIONAL8" F.int
+ let international9 = F.constant "SDL_SCANCODE_INTERNATIONAL9" F.int
+ let lang1 = F.constant "SDL_SCANCODE_LANG1" F.int
+ let lang2 = F.constant "SDL_SCANCODE_LANG2" F.int
+ let lang3 = F.constant "SDL_SCANCODE_LANG3" F.int
+ let lang4 = F.constant "SDL_SCANCODE_LANG4" F.int
+ let lang5 = F.constant "SDL_SCANCODE_LANG5" F.int
+ let lang6 = F.constant "SDL_SCANCODE_LANG6" F.int
+ let lang7 = F.constant "SDL_SCANCODE_LANG7" F.int
+ let lang8 = F.constant "SDL_SCANCODE_LANG8" F.int
+ let lang9 = F.constant "SDL_SCANCODE_LANG9" F.int
+ let alterase = F.constant "SDL_SCANCODE_ALTERASE" F.int
+ let sysreq = F.constant "SDL_SCANCODE_SYSREQ" F.int
+ let cancel = F.constant "SDL_SCANCODE_CANCEL" F.int
+ let clear = F.constant "SDL_SCANCODE_CLEAR" F.int
+ let prior = F.constant "SDL_SCANCODE_PRIOR" F.int
+ let return2 = F.constant "SDL_SCANCODE_RETURN2" F.int
+ let separator = F.constant "SDL_SCANCODE_SEPARATOR" F.int
+ let out = F.constant "SDL_SCANCODE_OUT" F.int
+ let oper = F.constant "SDL_SCANCODE_OPER" F.int
+ let clearagain = F.constant "SDL_SCANCODE_CLEARAGAIN" F.int
+ let crsel = F.constant "SDL_SCANCODE_CRSEL" F.int
+ let exsel = F.constant "SDL_SCANCODE_EXSEL" F.int
+ let kp_00 = F.constant "SDL_SCANCODE_KP_00" F.int
+ let kp_000 = F.constant "SDL_SCANCODE_KP_000" F.int
+ let thousandsseparator = F.constant "SDL_SCANCODE_THOUSANDSSEPARATOR" F.int
+ let decimalseparator = F.constant "SDL_SCANCODE_DECIMALSEPARATOR" F.int
+ let currencyunit = F.constant "SDL_SCANCODE_CURRENCYUNIT" F.int
+ let currencysubunit = F.constant "SDL_SCANCODE_CURRENCYSUBUNIT" F.int
+ let kp_leftparen = F.constant "SDL_SCANCODE_KP_LEFTPAREN" F.int
+ let kp_rightparen = F.constant "SDL_SCANCODE_KP_RIGHTPAREN" F.int
+ let kp_leftbrace = F.constant "SDL_SCANCODE_KP_LEFTBRACE" F.int
+ let kp_rightbrace = F.constant "SDL_SCANCODE_KP_RIGHTBRACE" F.int
+ let kp_tab = F.constant "SDL_SCANCODE_KP_TAB" F.int
+ let kp_backspace = F.constant "SDL_SCANCODE_KP_BACKSPACE" F.int
+ let kp_a = F.constant "SDL_SCANCODE_KP_A" F.int
+ let kp_b = F.constant "SDL_SCANCODE_KP_B" F.int
+ let kp_c = F.constant "SDL_SCANCODE_KP_C" F.int
+ let kp_d = F.constant "SDL_SCANCODE_KP_D" F.int
+ let kp_e = F.constant "SDL_SCANCODE_KP_E" F.int
+ let kp_f = F.constant "SDL_SCANCODE_KP_F" F.int
+ let kp_xor = F.constant "SDL_SCANCODE_KP_XOR" F.int
+ let kp_power = F.constant "SDL_SCANCODE_KP_POWER" F.int
+ let kp_percent = F.constant "SDL_SCANCODE_KP_PERCENT" F.int
+ let kp_less = F.constant "SDL_SCANCODE_KP_LESS" F.int
+ let kp_greater = F.constant "SDL_SCANCODE_KP_GREATER" F.int
+ let kp_ampersand = F.constant "SDL_SCANCODE_KP_AMPERSAND" F.int
+ let kp_dblampersand = F.constant "SDL_SCANCODE_KP_DBLAMPERSAND" F.int
+ let kp_verticalbar = F.constant "SDL_SCANCODE_KP_VERTICALBAR" F.int
+ let kp_dblverticalbar = F.constant "SDL_SCANCODE_KP_DBLVERTICALBAR" F.int
+ let kp_colon = F.constant "SDL_SCANCODE_KP_COLON" F.int
+ let kp_hash = F.constant "SDL_SCANCODE_KP_HASH" F.int
+ let kp_space = F.constant "SDL_SCANCODE_KP_SPACE" F.int
+ let kp_at = F.constant "SDL_SCANCODE_KP_AT" F.int
+ let kp_exclam = F.constant "SDL_SCANCODE_KP_EXCLAM" F.int
+ let kp_memstore = F.constant "SDL_SCANCODE_KP_MEMSTORE" F.int
+ let kp_memrecall = F.constant "SDL_SCANCODE_KP_MEMRECALL" F.int
+ let kp_memclear = F.constant "SDL_SCANCODE_KP_MEMCLEAR" F.int
+ let kp_memadd = F.constant "SDL_SCANCODE_KP_MEMADD" F.int
+ let kp_memsubtract = F.constant "SDL_SCANCODE_KP_MEMSUBTRACT" F.int
+ let kp_memmultiply = F.constant "SDL_SCANCODE_KP_MEMMULTIPLY" F.int
+ let kp_memdivide = F.constant "SDL_SCANCODE_KP_MEMDIVIDE" F.int
+ let kp_plusminus = F.constant "SDL_SCANCODE_KP_PLUSMINUS" F.int
+ let kp_clear = F.constant "SDL_SCANCODE_KP_CLEAR" F.int
+ let kp_clearentry = F.constant "SDL_SCANCODE_KP_CLEARENTRY" F.int
+ let kp_binary = F.constant "SDL_SCANCODE_KP_BINARY" F.int
+ let kp_octal = F.constant "SDL_SCANCODE_KP_OCTAL" F.int
+ let kp_decimal = F.constant "SDL_SCANCODE_KP_DECIMAL" F.int
+ let kp_hexadecimal = F.constant "SDL_SCANCODE_KP_HEXADECIMAL" F.int
+ let lctrl = F.constant "SDL_SCANCODE_LCTRL" F.int
+ let lshift = F.constant "SDL_SCANCODE_LSHIFT" F.int
+ let lalt = F.constant "SDL_SCANCODE_LALT" F.int
+ let lgui = F.constant "SDL_SCANCODE_LGUI" F.int
+ let rctrl = F.constant "SDL_SCANCODE_RCTRL" F.int
+ let rshift = F.constant "SDL_SCANCODE_RSHIFT" F.int
+ let ralt = F.constant "SDL_SCANCODE_RALT" F.int
+ let rgui = F.constant "SDL_SCANCODE_RGUI" F.int
+ let mode = F.constant "SDL_SCANCODE_MODE" F.int
+ let audionext = F.constant "SDL_SCANCODE_AUDIONEXT" F.int
+ let audioprev = F.constant "SDL_SCANCODE_AUDIOPREV" F.int
+ let audiostop = F.constant "SDL_SCANCODE_AUDIOSTOP" F.int
+ let audioplay = F.constant "SDL_SCANCODE_AUDIOPLAY" F.int
+ let audiomute = F.constant "SDL_SCANCODE_AUDIOMUTE" F.int
+ let mediaselect = F.constant "SDL_SCANCODE_MEDIASELECT" F.int
+ let www = F.constant "SDL_SCANCODE_WWW" F.int
+ let mail = F.constant "SDL_SCANCODE_MAIL" F.int
+ let calculator = F.constant "SDL_SCANCODE_CALCULATOR" F.int
+ let computer = F.constant "SDL_SCANCODE_COMPUTER" F.int
+ let ac_search = F.constant "SDL_SCANCODE_AC_SEARCH" F.int
+ let ac_home = F.constant "SDL_SCANCODE_AC_HOME" F.int
+ let ac_back = F.constant "SDL_SCANCODE_AC_BACK" F.int
+ let ac_forward = F.constant "SDL_SCANCODE_AC_FORWARD" F.int
+ let ac_stop = F.constant "SDL_SCANCODE_AC_STOP" F.int
+ let ac_refresh = F.constant "SDL_SCANCODE_AC_REFRESH" F.int
+ let ac_bookmarks = F.constant "SDL_SCANCODE_AC_BOOKMARKS" F.int
+ let brightnessdown = F.constant "SDL_SCANCODE_BRIGHTNESSDOWN" F.int
+ let brightnessup = F.constant "SDL_SCANCODE_BRIGHTNESSUP" F.int
+ let displayswitch = F.constant "SDL_SCANCODE_DISPLAYSWITCH" F.int
+ let kbdillumtoggle = F.constant "SDL_SCANCODE_KBDILLUMTOGGLE" F.int
+ let kbdillumdown = F.constant "SDL_SCANCODE_KBDILLUMDOWN" F.int
+ let kbdillumup = F.constant "SDL_SCANCODE_KBDILLUMUP" F.int
+ let eject = F.constant "SDL_SCANCODE_EJECT" F.int
+ let sleep = F.constant "SDL_SCANCODE_SLEEP" F.int
+ let app1 = F.constant "SDL_SCANCODE_APP1" F.int
+ let app2 = F.constant "SDL_SCANCODE_APP2" F.int
+ let num_scancodes = F.constant "SDL_NUM_SCANCODES" F.int
+ end
+
+ module K = struct
+ let scancode_mask = F.constant "SDLK_SCANCODE_MASK" F.int
+ let unknown = F.constant "SDLK_UNKNOWN" F.int
+ let return = F.constant "SDLK_RETURN" F.int
+ let escape = F.constant "SDLK_ESCAPE" F.int
+ let backspace = F.constant "SDLK_BACKSPACE" F.int
+ let tab = F.constant "SDLK_TAB" F.int
+ let space = F.constant "SDLK_SPACE" F.int
+ let exclaim = F.constant "SDLK_EXCLAIM" F.int
+ let quotedbl = F.constant "SDLK_QUOTEDBL" F.int
+ let hash = F.constant "SDLK_HASH" F.int
+ let percent = F.constant "SDLK_PERCENT" F.int
+ let dollar = F.constant "SDLK_DOLLAR" F.int
+ let ampersand = F.constant "SDLK_AMPERSAND" F.int
+ let quote = F.constant "SDLK_QUOTE" F.int
+ let leftparen = F.constant "SDLK_LEFTPAREN" F.int
+ let rightparen = F.constant "SDLK_RIGHTPAREN" F.int
+ let asterisk = F.constant "SDLK_ASTERISK" F.int
+ let plus = F.constant "SDLK_PLUS" F.int
+ let comma = F.constant "SDLK_COMMA" F.int
+ let minus = F.constant "SDLK_MINUS" F.int
+ let period = F.constant "SDLK_PERIOD" F.int
+ let slash = F.constant "SDLK_SLASH" F.int
+ let k0 = F.constant "SDLK_0" F.int
+ let k1 = F.constant "SDLK_1" F.int
+ let k2 = F.constant "SDLK_2" F.int
+ let k3 = F.constant "SDLK_3" F.int
+ let k4 = F.constant "SDLK_4" F.int
+ let k5 = F.constant "SDLK_5" F.int
+ let k6 = F.constant "SDLK_6" F.int
+ let k7 = F.constant "SDLK_7" F.int
+ let k8 = F.constant "SDLK_8" F.int
+ let k9 = F.constant "SDLK_9" F.int
+ let colon = F.constant "SDLK_COLON" F.int
+ let semicolon = F.constant "SDLK_SEMICOLON" F.int
+ let less = F.constant "SDLK_LESS" F.int
+ let equals = F.constant "SDLK_EQUALS" F.int
+ let greater = F.constant "SDLK_GREATER" F.int
+ let question = F.constant "SDLK_QUESTION" F.int
+ let at = F.constant "SDLK_AT" F.int
+ let leftbracket = F.constant "SDLK_LEFTBRACKET" F.int
+ let backslash = F.constant "SDLK_BACKSLASH" F.int
+ let rightbracket = F.constant "SDLK_RIGHTBRACKET" F.int
+ let caret = F.constant "SDLK_CARET" F.int
+ let underscore = F.constant "SDLK_UNDERSCORE" F.int
+ let backquote = F.constant "SDLK_BACKQUOTE" F.int
+ let a = F.constant "SDLK_a" F.int
+ let b = F.constant "SDLK_b" F.int
+ let c = F.constant "SDLK_c" F.int
+ let d = F.constant "SDLK_d" F.int
+ let e = F.constant "SDLK_e" F.int
+ let f = F.constant "SDLK_f" F.int
+ let g = F.constant "SDLK_g" F.int
+ let h = F.constant "SDLK_h" F.int
+ let i = F.constant "SDLK_i" F.int
+ let j = F.constant "SDLK_j" F.int
+ let k = F.constant "SDLK_k" F.int
+ let l = F.constant "SDLK_l" F.int
+ let m = F.constant "SDLK_m" F.int
+ let n = F.constant "SDLK_n" F.int
+ let o = F.constant "SDLK_o" F.int
+ let p = F.constant "SDLK_p" F.int
+ let q = F.constant "SDLK_q" F.int
+ let r = F.constant "SDLK_r" F.int
+ let s = F.constant "SDLK_s" F.int
+ let t = F.constant "SDLK_t" F.int
+ let u = F.constant "SDLK_u" F.int
+ let v = F.constant "SDLK_v" F.int
+ let w = F.constant "SDLK_w" F.int
+ let x = F.constant "SDLK_x" F.int
+ let y = F.constant "SDLK_y" F.int
+ let z = F.constant "SDLK_z" F.int
+ let capslock = F.constant "SDLK_CAPSLOCK" F.int
+ let f1 = F.constant "SDLK_F1" F.int
+ let f2 = F.constant "SDLK_F2" F.int
+ let f3 = F.constant "SDLK_F3" F.int
+ let f4 = F.constant "SDLK_F4" F.int
+ let f5 = F.constant "SDLK_F5" F.int
+ let f6 = F.constant "SDLK_F6" F.int
+ let f7 = F.constant "SDLK_F7" F.int
+ let f8 = F.constant "SDLK_F8" F.int
+ let f9 = F.constant "SDLK_F9" F.int
+ let f10 = F.constant "SDLK_F10" F.int
+ let f11 = F.constant "SDLK_F11" F.int
+ let f12 = F.constant "SDLK_F12" F.int
+ let printscreen = F.constant "SDLK_PRINTSCREEN" F.int
+ let scrolllock = F.constant "SDLK_SCROLLLOCK" F.int
+ let pause = F.constant "SDLK_PAUSE" F.int
+ let insert = F.constant "SDLK_INSERT" F.int
+ let home = F.constant "SDLK_HOME" F.int
+ let pageup = F.constant "SDLK_PAGEUP" F.int
+ let delete = F.constant "SDLK_DELETE" F.int
+ let kend = F.constant "SDLK_END" F.int
+ let pagedown = F.constant "SDLK_PAGEDOWN" F.int
+ let right = F.constant "SDLK_RIGHT" F.int
+ let left = F.constant "SDLK_LEFT" F.int
+ let down = F.constant "SDLK_DOWN" F.int
+ let up = F.constant "SDLK_UP" F.int
+ let numlockclear = F.constant "SDLK_NUMLOCKCLEAR" F.int
+ let kp_divide = F.constant "SDLK_KP_DIVIDE" F.int
+ let kp_multiply = F.constant "SDLK_KP_MULTIPLY" F.int
+ let kp_minus = F.constant "SDLK_KP_MINUS" F.int
+ let kp_plus = F.constant "SDLK_KP_PLUS" F.int
+ let kp_enter = F.constant "SDLK_KP_ENTER" F.int
+ let kp_1 = F.constant "SDLK_KP_1" F.int
+ let kp_2 = F.constant "SDLK_KP_2" F.int
+ let kp_3 = F.constant "SDLK_KP_3" F.int
+ let kp_4 = F.constant "SDLK_KP_4" F.int
+ let kp_5 = F.constant "SDLK_KP_5" F.int
+ let kp_6 = F.constant "SDLK_KP_6" F.int
+ let kp_7 = F.constant "SDLK_KP_7" F.int
+ let kp_8 = F.constant "SDLK_KP_8" F.int
+ let kp_9 = F.constant "SDLK_KP_9" F.int
+ let kp_0 = F.constant "SDLK_KP_0" F.int
+ let kp_period = F.constant "SDLK_KP_PERIOD" F.int
+ let application = F.constant "SDLK_APPLICATION" F.int
+ let power = F.constant "SDLK_POWER" F.int
+ let kp_equals = F.constant "SDLK_KP_EQUALS" F.int
+ let f13 = F.constant "SDLK_F13" F.int
+ let f14 = F.constant "SDLK_F14" F.int
+ let f15 = F.constant "SDLK_F15" F.int
+ let f16 = F.constant "SDLK_F16" F.int
+ let f17 = F.constant "SDLK_F17" F.int
+ let f18 = F.constant "SDLK_F18" F.int
+ let f19 = F.constant "SDLK_F19" F.int
+ let f20 = F.constant "SDLK_F20" F.int
+ let f21 = F.constant "SDLK_F21" F.int
+ let f22 = F.constant "SDLK_F22" F.int
+ let f23 = F.constant "SDLK_F23" F.int
+ let f24 = F.constant "SDLK_F24" F.int
+ let execute = F.constant "SDLK_EXECUTE" F.int
+ let help = F.constant "SDLK_HELP" F.int
+ let menu = F.constant "SDLK_MENU" F.int
+ let select = F.constant "SDLK_SELECT" F.int
+ let stop = F.constant "SDLK_STOP" F.int
+ let again = F.constant "SDLK_AGAIN" F.int
+ let undo = F.constant "SDLK_UNDO" F.int
+ let cut = F.constant "SDLK_CUT" F.int
+ let copy = F.constant "SDLK_COPY" F.int
+ let paste = F.constant "SDLK_PASTE" F.int
+ let find = F.constant "SDLK_FIND" F.int
+ let mute = F.constant "SDLK_MUTE" F.int
+ let volumeup = F.constant "SDLK_VOLUMEUP" F.int
+ let volumedown = F.constant "SDLK_VOLUMEDOWN" F.int
+ let kp_comma = F.constant "SDLK_KP_COMMA" F.int
+ let kp_equalsas400 = F.constant "SDLK_KP_EQUALSAS400" F.int
+ let alterase = F.constant "SDLK_ALTERASE" F.int
+ let sysreq = F.constant "SDLK_SYSREQ" F.int
+ let cancel = F.constant "SDLK_CANCEL" F.int
+ let clear = F.constant "SDLK_CLEAR" F.int
+ let prior = F.constant "SDLK_PRIOR" F.int
+ let return2 = F.constant "SDLK_RETURN2" F.int
+ let separator = F.constant "SDLK_SEPARATOR" F.int
+ let out = F.constant "SDLK_OUT" F.int
+ let oper = F.constant "SDLK_OPER" F.int
+ let clearagain = F.constant "SDLK_CLEARAGAIN" F.int
+ let crsel = F.constant "SDLK_CRSEL" F.int
+ let exsel = F.constant "SDLK_EXSEL" F.int
+ let kp_00 = F.constant "SDLK_KP_00" F.int
+ let kp_000 = F.constant "SDLK_KP_000" F.int
+ let thousandsseparator = F.constant "SDLK_THOUSANDSSEPARATOR" F.int
+ let decimalseparator = F.constant "SDLK_DECIMALSEPARATOR" F.int
+ let currencyunit = F.constant "SDLK_CURRENCYUNIT" F.int
+ let currencysubunit = F.constant "SDLK_CURRENCYSUBUNIT" F.int
+ let kp_leftparen = F.constant "SDLK_KP_LEFTPAREN" F.int
+ let kp_rightparen = F.constant "SDLK_KP_RIGHTPAREN" F.int
+ let kp_leftbrace = F.constant "SDLK_KP_LEFTBRACE" F.int
+ let kp_rightbrace = F.constant "SDLK_KP_RIGHTBRACE" F.int
+ let kp_tab = F.constant "SDLK_KP_TAB" F.int
+ let kp_backspace = F.constant "SDLK_KP_BACKSPACE" F.int
+ let kp_a = F.constant "SDLK_KP_A" F.int
+ let kp_b = F.constant "SDLK_KP_B" F.int
+ let kp_c = F.constant "SDLK_KP_C" F.int
+ let kp_d = F.constant "SDLK_KP_D" F.int
+ let kp_e = F.constant "SDLK_KP_E" F.int
+ let kp_f = F.constant "SDLK_KP_F" F.int
+ let kp_xor = F.constant "SDLK_KP_XOR" F.int
+ let kp_power = F.constant "SDLK_KP_POWER" F.int
+ let kp_percent = F.constant "SDLK_KP_PERCENT" F.int
+ let kp_less = F.constant "SDLK_KP_LESS" F.int
+ let kp_greater = F.constant "SDLK_KP_GREATER" F.int
+ let kp_ampersand = F.constant "SDLK_KP_AMPERSAND" F.int
+ let kp_dblampersand = F.constant "SDLK_KP_DBLAMPERSAND" F.int
+ let kp_verticalbar = F.constant "SDLK_KP_VERTICALBAR" F.int
+ let kp_dblverticalbar = F.constant "SDLK_KP_DBLVERTICALBAR" F.int
+ let kp_colon = F.constant "SDLK_KP_COLON" F.int
+ let kp_hash = F.constant "SDLK_KP_HASH" F.int
+ let kp_space = F.constant "SDLK_KP_SPACE" F.int
+ let kp_at = F.constant "SDLK_KP_AT" F.int
+ let kp_exclam = F.constant "SDLK_KP_EXCLAM" F.int
+ let kp_memstore = F.constant "SDLK_KP_MEMSTORE" F.int
+ let kp_memrecall = F.constant "SDLK_KP_MEMRECALL" F.int
+ let kp_memclear = F.constant "SDLK_KP_MEMCLEAR" F.int
+ let kp_memadd = F.constant "SDLK_KP_MEMADD" F.int
+ let kp_memsubtract = F.constant "SDLK_KP_MEMSUBTRACT" F.int
+ let kp_memmultiply = F.constant "SDLK_KP_MEMMULTIPLY" F.int
+ let kp_memdivide = F.constant "SDLK_KP_MEMDIVIDE" F.int
+ let kp_plusminus = F.constant "SDLK_KP_PLUSMINUS" F.int
+ let kp_clear = F.constant "SDLK_KP_CLEAR" F.int
+ let kp_clearentry = F.constant "SDLK_KP_CLEARENTRY" F.int
+ let kp_binary = F.constant "SDLK_KP_BINARY" F.int
+ let kp_octal = F.constant "SDLK_KP_OCTAL" F.int
+ let kp_decimal = F.constant "SDLK_KP_DECIMAL" F.int
+ let kp_hexadecimal = F.constant "SDLK_KP_HEXADECIMAL" F.int
+ let lctrl = F.constant "SDLK_LCTRL" F.int
+ let lshift = F.constant "SDLK_LSHIFT" F.int
+ let lalt = F.constant "SDLK_LALT" F.int
+ let lgui = F.constant "SDLK_LGUI" F.int
+ let rctrl = F.constant "SDLK_RCTRL" F.int
+ let rshift = F.constant "SDLK_RSHIFT" F.int
+ let ralt = F.constant "SDLK_RALT" F.int
+ let rgui = F.constant "SDLK_RGUI" F.int
+ let mode = F.constant "SDLK_MODE" F.int
+ let audionext = F.constant "SDLK_AUDIONEXT" F.int
+ let audioprev = F.constant "SDLK_AUDIOPREV" F.int
+ let audiostop = F.constant "SDLK_AUDIOSTOP" F.int
+ let audioplay = F.constant "SDLK_AUDIOPLAY" F.int
+ let audiomute = F.constant "SDLK_AUDIOMUTE" F.int
+ let mediaselect = F.constant "SDLK_MEDIASELECT" F.int
+ let www = F.constant "SDLK_WWW" F.int
+ let mail = F.constant "SDLK_MAIL" F.int
+ let calculator = F.constant "SDLK_CALCULATOR" F.int
+ let computer = F.constant "SDLK_COMPUTER" F.int
+ let ac_search = F.constant "SDLK_AC_SEARCH" F.int
+ let ac_home = F.constant "SDLK_AC_HOME" F.int
+ let ac_back = F.constant "SDLK_AC_BACK" F.int
+ let ac_forward = F.constant "SDLK_AC_FORWARD" F.int
+ let ac_stop = F.constant "SDLK_AC_STOP" F.int
+ let ac_refresh = F.constant "SDLK_AC_REFRESH" F.int
+ let ac_bookmarks = F.constant "SDLK_AC_BOOKMARKS" F.int
+ let brightnessdown = F.constant "SDLK_BRIGHTNESSDOWN" F.int
+ let brightnessup = F.constant "SDLK_BRIGHTNESSUP" F.int
+ let displayswitch = F.constant "SDLK_DISPLAYSWITCH" F.int
+ let kbdillumtoggle = F.constant "SDLK_KBDILLUMTOGGLE" F.int
+ let kbdillumdown = F.constant "SDLK_KBDILLUMDOWN" F.int
+ let kbdillumup = F.constant "SDLK_KBDILLUMUP" F.int
+ let eject = F.constant "SDLK_EJECT" F.int
+ let sleep = F.constant "SDLK_SLEEP" F.int
+ end
+
+ module Kmod = struct
+ let none = F.constant "KMOD_NONE" F.int (* F.uint16_t *)
+ let lshift = F.constant "KMOD_LSHIFT" F.int (* F.uint16_t *)
+ let rshift = F.constant "KMOD_RSHIFT" F.int (* F.uint16_t *)
+ let lctrl = F.constant "KMOD_LCTRL" F.int (* F.uint16_t *)
+ let rctrl = F.constant "KMOD_RCTRL" F.int (* F.uint16_t *)
+ let lalt = F.constant "KMOD_LALT" F.int (* F.uint16_t *)
+ let ralt = F.constant "KMOD_RALT" F.int (* F.uint16_t *)
+ let lgui = F.constant "KMOD_LGUI" F.int (* F.uint16_t *)
+ let rgui = F.constant "KMOD_RGUI" F.int (* F.uint16_t *)
+ let num = F.constant "KMOD_NUM" F.int (* F.uint16_t *)
+ let caps = F.constant "KMOD_CAPS" F.int (* F.uint16_t *)
+ let mode = F.constant "KMOD_MODE" F.int (* F.uint16_t *)
+ let reserved = F.constant "KMOD_RESERVED" F.int (* F.uint16_t *)
+ let ctrl = F.constant "KMOD_CTRL" F.int (* F.uint16_t *)
+ let shift = F.constant "KMOD_SHIFT" F.int (* F.uint16_t *)
+ let alt = F.constant "KMOD_ALT" F.int (* F.uint16_t *)
+ let gui = F.constant "KMOD_GUI" F.int (* F.uint16_t *)
+ end
+
+ type _cursor
+ type cursor = _cursor Ctypes_static.structure
+ let cursor : cursor F.typ = F.structure "SDL_Cursor"
+
+ module System_cursor = struct
+ let arrow = F.constant "SDL_SYSTEM_CURSOR_ARROW" F.int
+ let ibeam = F.constant "SDL_SYSTEM_CURSOR_IBEAM" F.int
+ let wait = F.constant "SDL_SYSTEM_CURSOR_WAIT" F.int
+ let crosshair = F.constant "SDL_SYSTEM_CURSOR_CROSSHAIR" F.int
+ let waitarrow = F.constant "SDL_SYSTEM_CURSOR_WAITARROW" F.int
+ let size_nw_se = F.constant "SDL_SYSTEM_CURSOR_SIZENWSE" F.int
+ let size_ne_sw = F.constant "SDL_SYSTEM_CURSOR_SIZENESW" F.int
+ let size_we = F.constant "SDL_SYSTEM_CURSOR_SIZEWE" F.int
+ let size_ns = F.constant "SDL_SYSTEM_CURSOR_SIZENS" F.int
+ let size_all = F.constant "SDL_SYSTEM_CURSOR_SIZEALL" F.int
+ let no = F.constant "SDL_SYSTEM_CURSOR_NO" F.int
+ let hand = F.constant "SDL_SYSTEM_CURSOR_HAND" F.int
+ end
+
+ module Button = struct
+ let left = F.constant "SDL_BUTTON_LEFT" F.int
+ let middle = F.constant "SDL_BUTTON_MIDDLE" F.int
+ let right = F.constant "SDL_BUTTON_RIGHT" F.int
+ let x1 = F.constant "SDL_BUTTON_X1" F.int
+ let x2 = F.constant "SDL_BUTTON_X2" F.int
+
+ let lmask = F.constant "SDL_BUTTON_LMASK" F.int32_t
+ let mmask = F.constant "SDL_BUTTON_MMASK" F.int32_t
+ let rmask = F.constant "SDL_BUTTON_RMASK" F.int32_t
+ let x1mask = F.constant "SDL_BUTTON_X1MASK" F.int32_t
+ let x2mask = F.constant "SDL_BUTTON_X2MASK" F.int32_t
+ end
+
+ (* Touch *)
+ let touch_mouseid = F.constant "SDL_TOUCH_MOUSEID" F.int64_t
+
+ module Finger = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_Finger"
+ let id = F.field t "id" F.int64_t
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let pressure = F.field t "pressure" F.float
+ let () = F.seal t
+ end
+
+ type _guid
+ type guid = _guid Ctypes_static.structure
+ let guid : guid F.typ = F.typedef (F.structure "_guid") "SDL_GUID"
+ let _= F.field guid "data" F.(array 16 uint8_t)
+ let () = F.seal guid
+
+ let joystick_guid = F.typedef guid "SDL_JoystickGUID"
+
+ type _joystick
+ type joystick = _joystick Ctypes_static.structure
+ let joystick : joystick F.typ =
+ F.typedef (F.structure "_SDL_Joystick") "SDL_Joystick"
+
+ module Hat = struct
+ type t = int
+ let centered = F.constant "SDL_HAT_CENTERED" F.int
+ let up = F.constant "SDL_HAT_UP" F.int
+ let right = F.constant "SDL_HAT_RIGHT" F.int
+ let down = F.constant "SDL_HAT_DOWN" F.int
+ let left = F.constant "SDL_HAT_LEFT" F.int
+ let rightup = F.constant "SDL_HAT_RIGHTUP" F.int
+ let rightdown = F.constant "SDL_HAT_RIGHTDOWN" F.int
+ let leftup = F.constant "SDL_HAT_LEFTUP" F.int
+ let leftdown = F.constant "SDL_HAT_LEFTDOWN" F.int
+ end
+
+ module Joystick_power_level = struct
+ type t = int
+ let unknown = F.constant "SDL_JOYSTICK_POWER_UNKNOWN" F.int
+ let low = F.constant "SDL_JOYSTICK_POWER_LOW" F.int
+ let medium = F.constant "SDL_JOYSTICK_POWER_MEDIUM" F.int
+ let full = F.constant "SDL_JOYSTICK_POWER_FULL" F.int
+ let max = F.constant "SDL_JOYSTICK_POWER_MAX" F.int
+ let wired = F.constant "SDL_JOYSTICK_POWER_WIRED" F.int
+ end
+
+ module Joystick_type = struct
+ type t = int
+ let unknown = F.constant "SDL_JOYSTICK_TYPE_UNKNOWN" F.int
+ let gamecontroller = F.constant "SDL_JOYSTICK_TYPE_GAMECONTROLLER" F.int
+ let wheel = F.constant "SDL_JOYSTICK_TYPE_WHEEL" F.int
+ let arcade_stick = F.constant "SDL_JOYSTICK_TYPE_ARCADE_STICK" F.int
+ let flight_stick = F.constant "SDL_JOYSTICK_TYPE_FLIGHT_STICK" F.int
+ let dance_pad = F.constant "SDL_JOYSTICK_TYPE_DANCE_PAD" F.int
+ let guitar = F.constant "SDL_JOYSTICK_TYPE_GUITAR" F.int
+ let drum_kit = F.constant "SDL_JOYSTICK_TYPE_DRUM_KIT" F.int
+ let arcade_pad = F.constant "SDL_JOYSTICK_TYPE_ARCADE_PAD" F.int
+ let throttle = F.constant "SDL_JOYSTICK_TYPE_THROTTLE" F.int
+ end
+
+ module Controller = struct
+ type bind_type = int
+ let bind_type_none = F.constant "SDL_CONTROLLER_BINDTYPE_NONE" F.int
+ let bind_type_button = F.constant "SDL_CONTROLLER_BINDTYPE_BUTTON" F.int
+ let bind_type_axis = F.constant "SDL_CONTROLLER_BINDTYPE_AXIS" F.int
+ let bind_type_hat = F.constant "SDL_CONTROLLER_BINDTYPE_HAT" F.int
+
+ type axis = int
+ let axis_invalid = F.constant "SDL_CONTROLLER_AXIS_INVALID" F.int
+ let axis_left_x = F.constant "SDL_CONTROLLER_AXIS_LEFTX" F.int
+ let axis_left_y = F.constant "SDL_CONTROLLER_AXIS_LEFTY" F.int
+ let axis_right_x = F.constant "SDL_CONTROLLER_AXIS_RIGHTX" F.int
+ let axis_right_y = F.constant "SDL_CONTROLLER_AXIS_RIGHTY" F.int
+ let axis_trigger_left = F.constant "SDL_CONTROLLER_AXIS_TRIGGERLEFT" F.int
+ let axis_trigger_right = F.constant "SDL_CONTROLLER_AXIS_TRIGGERRIGHT" F.int
+ let axis_max = F.constant "SDL_CONTROLLER_AXIS_MAX" F.int
+
+ type button = int
+ let button_invalid = F.constant "SDL_CONTROLLER_BUTTON_INVALID" F.int
+ let button_a = F.constant "SDL_CONTROLLER_BUTTON_A" F.int
+ let button_b = F.constant "SDL_CONTROLLER_BUTTON_B" F.int
+ let button_x = F.constant "SDL_CONTROLLER_BUTTON_X" F.int
+ let button_y = F.constant "SDL_CONTROLLER_BUTTON_Y" F.int
+ let button_back = F.constant "SDL_CONTROLLER_BUTTON_BACK" F.int
+ let button_guide = F.constant "SDL_CONTROLLER_BUTTON_GUIDE" F.int
+ let button_start = F.constant "SDL_CONTROLLER_BUTTON_START" F.int
+ let button_left_stick = F.constant "SDL_CONTROLLER_BUTTON_LEFTSTICK" F.int
+ let button_right_stick = F.constant "SDL_CONTROLLER_BUTTON_RIGHTSTICK" F.int
+ let button_left_shoulder = F.constant "SDL_CONTROLLER_BUTTON_LEFTSHOULDER" F.int
+ let button_right_shoulder = F.constant "SDL_CONTROLLER_BUTTON_RIGHTSHOULDER" F.int
+ let button_dpad_up = F.constant "SDL_CONTROLLER_BUTTON_DPAD_UP" F.int
+ let button_dpad_down = F.constant "SDL_CONTROLLER_BUTTON_DPAD_DOWN" F.int
+ let button_dpad_left = F.constant "SDL_CONTROLLER_BUTTON_DPAD_LEFT" F.int
+ let button_dpad_right = F.constant "SDL_CONTROLLER_BUTTON_DPAD_RIGHT" F.int
+ let button_max = F.constant "SDL_CONTROLLER_BUTTON_MAX" F.int
+ end
+
+ type _game_controller
+
+ let game_controller :
+ _game_controller Ctypes_static.structure F.typ =
+ F.typedef (F.structure "_SDL_GameController") "SDL_GameController"
+
+ let sdl_query = F.constant "SDL_QUERY" F.int
+
+ let disable = F.constant "SDL_DISABLE" F.uint8_t
+ let enable = F.constant "SDL_ENABLE" F.uint8_t
+
+ let pressed = F.constant "SDL_PRESSED" F.uint8_t
+ let released = F.constant "SDL_RELEASED" F.uint8_t
+
+
+ module Event = struct
+ let first_event = F.constant "SDL_FIRSTEVENT" F.int (* F.uint32_t *)
+ let last_event = F.constant "SDL_LASTEVENT" F.int (* F.uint32_t *)
+
+ let quit = F.constant "SDL_QUIT" F.int (* F.uint32_t *)
+
+ let app_terminating = F.constant "SDL_APP_TERMINATING" F.int (* F.uint32_t *)
+ let app_low_memory = F.constant "SDL_APP_LOWMEMORY" F.int (* F.uint32_t *)
+ let app_will_enter_background = F.constant "SDL_APP_WILLENTERBACKGROUND" F.int (* F.uint32_t *)
+ let app_did_enter_background = F.constant "SDL_APP_DIDENTERBACKGROUND" F.int (* F.uint32_t *)
+ let app_will_enter_foreground = F.constant "SDL_APP_WILLENTERFOREGROUND" F.int (* F.uint32_t *)
+ let app_did_enter_foreground = F.constant "SDL_APP_DIDENTERFOREGROUND" F.int (* F.uint32_t *)
+
+ let display_event = F.constant "SDL_DISPLAYEVENT" F.int (* F.uint32_t *)
+ let window_event = F.constant "SDL_WINDOWEVENT" F.int (* F.uint32_t *)
+ let sys_wm_event = F.constant "SDL_SYSWMEVENT" F.int (* F.uint32_t *)
+ let sensor_update = F.constant "SDL_SENSORUPDATE" F.int (* F.uint32_t *)
+ let user_event = F.constant "SDL_USEREVENT" F.int (* F.uint32_t *)
+
+ let key_down = F.constant "SDL_KEYDOWN" F.int (* F.uint32_t *)
+ let key_up = F.constant "SDL_KEYUP" F.int (* F.uint32_t *)
+ let keymap_changed = F.constant "SDL_KEYMAPCHANGED" F.int (* F.uint32_t *)
+
+ let text_editing = F.constant "SDL_TEXTEDITING" F.int (* F.uint32_t *)
+ let text_input = F.constant "SDL_TEXTINPUT" F.int (* F.uint32_t *)
+
+ let mouse_motion = F.constant "SDL_MOUSEMOTION" F.int (* F.uint32_t *)
+ let mouse_button_down = F.constant "SDL_MOUSEBUTTONDOWN" F.int (* F.uint32_t *)
+ let mouse_button_up = F.constant "SDL_MOUSEBUTTONUP" F.int (* F.uint32_t *)
+ let mouse_wheel = F.constant "SDL_MOUSEWHEEL" F.int (* F.uint32_t *)
+
+ type mouse_wheel_direction = int
+ let mouse_wheel_normal = F.constant "SDL_MOUSEWHEEL_NORMAL" F.int
+ let mouse_wheel_flipped = F.constant "SDL_MOUSEWHEEL_FLIPPED" F.int
+
+ let joy_axis_motion = F.constant "SDL_JOYAXISMOTION" F.int (* F.uint32_t *)
+ let joy_ball_motion = F.constant "SDL_JOYBALLMOTION" F.int (* F.uint32_t *)
+ let joy_hat_motion = F.constant "SDL_JOYHATMOTION" F.int (* F.uint32_t *)
+ let joy_button_down = F.constant "SDL_JOYBUTTONDOWN" F.int (* F.uint32_t *)
+ let joy_button_up = F.constant "SDL_JOYBUTTONUP" F.int (* F.uint32_t *)
+ let joy_device_added = F.constant "SDL_JOYDEVICEADDED" F.int (* F.uint32_t *)
+ let joy_device_removed = F.constant "SDL_JOYDEVICEREMOVED" F.int (* F.uint32_t *)
+
+ let controller_axis_motion = F.constant "SDL_CONTROLLERAXISMOTION" F.int (* F.uint32_t *)
+ let controller_button_down = F.constant "SDL_CONTROLLERBUTTONDOWN" F.int (* F.uint32_t *)
+ let controller_button_up = F.constant "SDL_CONTROLLERBUTTONUP" F.int (* F.uint32_t *)
+ let controller_device_added = F.constant "SDL_CONTROLLERDEVICEADDED" F.int (* F.uint32_t *)
+ let controller_device_removed = F.constant "SDL_CONTROLLERDEVICEREMOVED" F.int (* F.uint32_t *)
+ let controller_device_remapped = F.constant "SDL_CONTROLLERDEVICEREMAPPED" F.int (* F.uint32_t *)
+
+ let finger_down = F.constant "SDL_FINGERDOWN" F.int (* F.uint32_t *)
+ let finger_up = F.constant "SDL_FINGERUP" F.int (* F.uint32_t *)
+ let finger_motion = F.constant "SDL_FINGERMOTION" F.int (* F.uint32_t *)
+
+ let dollar_gesture = F.constant "SDL_DOLLARGESTURE" F.int (* F.uint32_t *)
+ let dollar_record = F.constant "SDL_DOLLARRECORD" F.int (* F.uint32_t *)
+
+ let multi_gesture = F.constant "SDL_MULTIGESTURE" F.int (* F.uint32_t *)
+
+ let clipboard_update = F.constant "SDL_CLIPBOARDUPDATE" F.int (* F.uint32_t *)
+
+ let drop_file = F.constant "SDL_DROPFILE" F.int (* F.uint32_t *)
+ let drop_text = F.constant "SDL_DROPTEXT" F.int (* F.uint32_t *)
+ let drop_begin = F.constant "SDL_DROPBEGIN" F.int (* F.uint32_t *)
+ let drop_complete = F.constant "SDL_DROPCOMPLETE" F.int (* F.uint32_t *)
+
+ let audio_device_added = F.constant "SDL_AUDIODEVICEADDED" F.int (* F.uint32_t *)
+ let audio_device_removed = F.constant "SDL_AUDIODEVICEREMOVED" F.int (* F.uint32_t *)
+
+ let render_targets_reset = F.constant "SDL_RENDER_TARGETS_RESET" F.int (* F.uint32_t *)
+ let render_device_reset = F.constant "SDL_RENDER_DEVICE_RESET" F.int (* F.uint32_t *)
+
+ let texteditingevent_text_size = F.constant "SDL_TEXTEDITINGEVENT_TEXT_SIZE" F.int
+ let textinputevent_text_size = F.constant "SDL_TEXTINPUTEVENT_TEXT_SIZE" F.int
+
+ (* SDL_WindowEventID *)
+ type window_event_id = int
+ let window_event_shown = F.constant "SDL_WINDOWEVENT_SHOWN" F.int
+ let window_event_hidden = F.constant "SDL_WINDOWEVENT_HIDDEN" F.int
+ let window_event_exposed = F.constant "SDL_WINDOWEVENT_EXPOSED" F.int
+ let window_event_moved = F.constant "SDL_WINDOWEVENT_MOVED" F.int
+ let window_event_resized = F.constant "SDL_WINDOWEVENT_RESIZED" F.int
+ let window_event_size_changed = F.constant "SDL_WINDOWEVENT_SIZE_CHANGED" F.int
+ let window_event_minimized = F.constant "SDL_WINDOWEVENT_MINIMIZED" F.int
+ let window_event_maximized = F.constant "SDL_WINDOWEVENT_MAXIMIZED" F.int
+ let window_event_restored = F.constant "SDL_WINDOWEVENT_RESTORED" F.int
+ let window_event_enter = F.constant "SDL_WINDOWEVENT_ENTER" F.int
+ let window_event_leave = F.constant "SDL_WINDOWEVENT_LEAVE" F.int
+ let window_event_focus_gained = F.constant "SDL_WINDOWEVENT_FOCUS_GAINED" F.int
+ let window_event_focus_lost = F.constant "SDL_WINDOWEVENT_FOCUS_LOST" F.int
+ let window_event_close = F.constant "SDL_WINDOWEVENT_CLOSE" F.int
+ let window_event_take_focus = F.constant "SDL_WINDOWEVENT_TAKE_FOCUS" F.int
+ let window_event_hit_test = F.constant "SDL_WINDOWEVENT_HIT_TEST" F.int
+
+ module Common = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_CommonEvent"
+ let typ = F.field t "type" F.uint32_t
+ let timestamp = F.field t "timestamp" F.uint32_t
+ let () = F.seal t
+ end
+
+ module Controller_axis_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_ControllerAxisEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let axis = F.field t "axis" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let _ = F.field t "padding3" F.uint8_t
+ let value = F.field t "value" F.int16_t
+ let _ = F.field t "padding4" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Controller_button_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_ControllerButtonEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let button = F.field t "button" F.uint8_t
+ let state = F.field t "state" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let () = F.seal t
+ end
+
+ module Controller_device_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_ControllerDeviceEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let () = F.seal t
+ end
+
+ module Dollar_gesture_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_DollarGestureEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let touch_id = F.field t "touchId" F.int64_t
+ let gesture_id = F.field t "gestureId" F.int64_t
+ let num_fingers = F.field t "numFingers" F.uint32_t
+ let error = F.field t "error" F.float
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let () = F.seal t
+ end
+
+ module Drop_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_DropEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let file = F.field t "file" F.(ptr char)
+ let window_id = F.field t "windowID" F.uint32_t
+ let () = F.seal t
+ end
+
+ module Keyboard_event = struct
+ type keysym
+ let keysym: keysym Ctypes_static.structure F.typ = F.structure "SDL_Keysym"
+ let scancode = F.field keysym "scancode" F.int
+ let keycode = F.field keysym "sym" F.int
+ let keymod = F.field keysym "mod" F.uint16_t
+ let _unused = F.field keysym "unused" F.uint32_t
+ let () = F.seal keysym
+
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_KeyboardEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let state = F.field t "state" F.uint8_t
+ let repeat = F.field t "repeat" F.uint8_t
+ let _padding2 = F.field t "padding2" F.uint8_t
+ let _padding3 = F.field t "padding3" F.uint8_t
+ let keysym = F.field t "keysym" keysym
+ let () = F.seal t
+ end
+
+ module Joy_axis_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_JoyAxisEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let axis = F.field t "axis" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let _ = F.field t "padding3" F.uint8_t
+ let value = F.field t "value" F.int16_t
+ let _ = F.field t "padding4" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Joy_ball_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_JoyBallEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let ball = F.field t "ball" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let _ = F.field t "padding3" F.uint8_t
+ let xrel = F.field t "xrel" F.int16_t
+ let yrel = F.field t "yrel" F.int16_t
+ let () = F.seal t
+ end
+
+ module Joy_button_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_JoyButtonEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let button = F.field t "button" F.uint8_t
+ let state = F.field t "state" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let () = F.seal t
+ end
+
+ module Joy_device_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_JoyDeviceEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let () = F.seal t
+ end
+
+ module Joy_hat_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_JoyHatEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.int32_t
+ let hat = F.field t "hat" F.uint8_t
+ let value = F.field t "value" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let _ = F.field t "padding2" F.uint8_t
+ let () = F.seal t
+ end
+
+ module Mouse_button_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_MouseButtonEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let which = F.field t "which" F.uint32_t
+ let button = F.field t "button" F.uint8_t
+ let state = F.field t "state" F.uint8_t
+ let clicks = F.field t "clicks" F.uint8_t
+ let _ = F.field t "padding1" F.uint8_t
+ let x = F.field t "x" F.int32_t
+ let y = F.field t "y" F.int32_t
+ let () = F.seal t
+ end
+
+ module Mouse_motion_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_MouseMotionEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let which = F.field t "which" F.uint32_t
+ let state = F.field t "state" F.uint32_t
+ let x = F.field t "x" F.int32_t
+ let y = F.field t "y" F.int32_t
+ let xrel = F.field t "xrel" F.int32_t
+ let yrel = F.field t "yrel" F.int32_t
+ let () = F.seal t
+ end
+
+ module Mouse_wheel_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_MouseWheelEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let which = F.field t "which" F.uint32_t
+ let x = F.field t "x" F.int32_t
+ let y = F.field t "y" F.int32_t
+ let direction = F.field t "direction" F.uint32_t
+ let () = F.seal t
+ end
+
+ module Multi_gesture_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_MultiGestureEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let touch_id = F.field t "touchId" F.int64_t
+ let dtheta = F.field t "dTheta" F.float
+ let ddist = F.field t "dDist" F.float
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let num_fingers = F.field t "numFingers" F.uint16_t
+ let _ = F.field t "padding" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Sensor_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_SensorEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.uint32_t
+ let data = F.field t "data" F.(array 6 float)
+ let () = F.seal t
+ end
+
+ module Quit_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_QuitEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let () = F.seal t
+ end
+
+ module Sys_wm_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_SysWMEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let _ = F.field t "msg" F.(ptr void)
+ let () = F.seal t
+ end
+
+ module Text_editing_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_TextEditingEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let text = F.field t "text" F.(array 32 char (* FIXME *))
+ let start = F.field t "start" F.int32_t
+ let length = F.field t "length" F.int32_t
+ let () = F.seal t
+ end
+
+ module Text_input_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_TextInputEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let text = F.field t "text" F.(array 32 char (* FIXME *))
+ let () = F.seal t
+ end
+
+ module Touch_finger_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_TouchFingerEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let touch_id = F.field t "touchId" F.int64_t
+ let finger_id = F.field t "fingerId" F.int64_t
+ let x = F.field t "x" F.float
+ let y = F.field t "y" F.float
+ let dx = F.field t "dx" F.float
+ let dy = F.field t "dy" F.float
+ let pressure = F.field t "pressure" F.float
+ let () = F.seal t
+ end
+
+ module User_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_UserEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let code = F.field t "code" F.int32_t
+ let _ = F.field t "data1" F.(ptr void)
+ let _ = F.field t "data2" F.(ptr void)
+ let () = F.seal t
+ end
+
+ module Window_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_WindowEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let window_id = F.field t "windowID" F.uint32_t
+ let event = F.field t "event" F.uint8_t
+ let _padding1 = F.field t "padding1" F.uint8_t
+ let _padding2 = F.field t "padding2" F.uint8_t
+ let _padding3 = F.field t "padding3" F.uint8_t
+ let data1 = F.field t "data1" F.int32_t
+ let data2 = F.field t "data2" F.int32_t
+ let () = F.seal t
+ end
+
+ module Display_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_DisplayEvent"
+ let _ = F.field t "type" F.uint32_t
+ let _ = F.field t "timestamp" F.uint32_t
+ let display = F.field t "display" F.uint32_t
+ let event = F.field t "event" F.uint8_t
+ let _padding1 = F.field t "padding1" F.uint8_t
+ let _padding2 = F.field t "padding2" F.uint8_t
+ let _padding3 = F.field t "padding3" F.uint8_t
+ let data1 = F.field t "data1" F.int32_t
+ let () = F.seal t
+ end
+
+ module Audio_device_event = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_AudioDeviceEvent"
+ let _ = F.field t "type" F.uint32_t
+ let timestamp = F.field t "timestamp" F.uint32_t
+ let which = F.field t "which" F.uint32_t
+ let iscapture = F.field t "iscapture" F.uint8_t
+ let () = F.seal t
+ end
+
+ type t
+ let t : t Ctypes_static.union F.typ = F.union "SDL_Event"
+ let _typ = F.field t "type" F.uint32_t
+ let audio_device_event = F.field t "adevice" Audio_device_event.t
+ let common = F.field t "common" Common.t
+ let controller_axis_event = F.field t "caxis" Controller_axis_event.t
+ let controller_button_event = F.field t "cbutton" Controller_button_event.t
+ let controller_device_event = F.field t "cdevice" Controller_device_event.t
+ let dollar_gesture_event = F.field t "dgesture" Dollar_gesture_event.t
+ let drop_event = F.field t "drop" Drop_event.t
+ let joy_axis_event = F.field t "jaxis" Joy_axis_event.t
+ let joy_ball_event = F.field t "jball" Joy_ball_event.t
+ let joy_button_event = F.field t "jbutton" Joy_button_event.t
+ let joy_device_event = F.field t "jdevice" Joy_device_event.t
+ let joy_hat_event = F.field t "jhat" Joy_hat_event.t
+ let keyboard_event = F.field t "key" Keyboard_event.t
+ let mouse_button_event = F.field t "button" Mouse_button_event.t
+ let mouse_motion_event = F.field t "motion" Mouse_motion_event.t
+ let mouse_wheel_event = F.field t "wheel" Mouse_wheel_event.t
+ let multi_gesture_event = F.field t "mgesture" Multi_gesture_event.t
+ let _quit_event = F.field t "quit" Quit_event.t
+ let _sys_wm_event = F.field t "syswm" Sys_wm_event.t
+ let text_editing_event = F.field t "edit" Text_editing_event.t
+ let text_input_event = F.field t "text" Text_input_event.t
+ let touch_finger_event = F.field t "tfinger" Touch_finger_event.t
+ let _user_event = F.field t "user" User_event.t
+ let _window_event = F.field t "window" Window_event.t
+ let _display_event = F.field t "display" Display_event.t
+ let sensor_event = F.field t "sensor" Sensor_event.t
+ let _padding = F.field t "padding" F.(ptr uint8_t)
+ let () = F.seal t
+ end
+
+ module Haptic = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.typedef (F.structure "_SDL_Haptic") "SDL_Haptic"
+
+ let constant = F.constant "SDL_HAPTIC_CONSTANT" F.int
+
+ let sine = F.constant "SDL_HAPTIC_SINE" F.int
+ let left_right = F.constant "SDL_HAPTIC_LEFTRIGHT" F.int
+ let triangle = F.constant "SDL_HAPTIC_TRIANGLE" F.int
+ let sawtooth_up = F.constant "SDL_HAPTIC_SAWTOOTHUP" F.int
+ let sawtooth_down = F.constant "SDL_HAPTIC_SAWTOOTHDOWN" F.int
+
+ let ramp = F.constant "SDL_HAPTIC_RAMP" F.int
+
+ let spring = F.constant "SDL_HAPTIC_SPRING" F.int
+ let damper = F.constant "SDL_HAPTIC_DAMPER" F.int
+ let inertia = F.constant "SDL_HAPTIC_INERTIA" F.int
+ let friction = F.constant "SDL_HAPTIC_FRICTION" F.int
+
+ let custom = F.constant "SDL_HAPTIC_CUSTOM" F.int
+
+ let infinity = F.constant "SDL_HAPTIC_INFINITY" F.int32_t
+
+ type feature = int
+ let gain = F.constant "SDL_HAPTIC_GAIN" F.int
+ let autocenter = F.constant "SDL_HAPTIC_AUTOCENTER" F.int
+ let status = F.constant "SDL_HAPTIC_STATUS" F.int
+ let pause = F.constant "SDL_HAPTIC_PAUSE" F.int
+
+ type direction_type = int
+ let polar = F.constant "SDL_HAPTIC_POLAR" F.int
+ let cartesian = F.constant "SDL_HAPTIC_CARTESIAN" F.int
+ let spherical = F.constant "SDL_HAPTIC_SPHERICAL" F.int
+
+ module Direction = struct
+ type _t
+ type t = _t Ctypes_static.structure
+ let t : t F.typ = F.structure "SDL_HapticDirection"
+ let typ = F.field t "type" F.uint8_t
+ let dir = F.field t "dir" F.(array 3 int32_t)
+ let () = F.seal t
+ end
+
+ (* Effects *)
+
+ module Constant = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_HapticConstant"
+ let typ = F.field t "type" F.uint16_t
+ let direction = F.field t "direction" Direction.t
+ let length = F.field t "length" F.uint32_t
+ let delay = F.field t "delay" F.uint16_t
+ let button = F.field t "button" F.uint16_t
+ let interval = F.field t "interval" F.uint16_t
+
+ let level = F.field t "level" F.int16_t
+ let attack_length = F.field t "attack_length" F.uint16_t
+ let attack_level = F.field t "attack_level" F.uint16_t
+ let fade_length = F.field t "fade_length" F.uint16_t
+ let fade_level = F.field t "fade_level" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Periodic = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_HapticPeriodic"
+ let typ = F.field t "type" F.uint16_t
+ let direction = F.field t "direction" Direction.t
+ let length = F.field t "length" F.uint32_t
+ let delay = F.field t "delay" F.uint16_t
+ let button = F.field t "button" F.uint16_t
+ let interval = F.field t "interval" F.uint16_t
+
+ let period = F.field t "period" F.uint16_t
+ let magnitude = F.field t "magnitude" F.int16_t
+ let offset = F.field t "offset" F.int16_t
+ let phase = F.field t "phase" F.uint16_t
+ let attack_length = F.field t "attack_length" F.uint16_t
+ let attack_level = F.field t "attack_level" F.uint16_t
+ let fade_length = F.field t "fade_length" F.uint16_t
+ let fade_level = F.field t "fade_level" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Condition = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_HapticCondition"
+ let typ = F.field t "type" F.uint16_t
+ let direction = F.field t "direction" Direction.t
+ let length = F.field t "length" F.uint32_t
+ let delay = F.field t "delay" F.uint16_t
+ let button = F.field t "button" F.uint16_t
+ let interval = F.field t "interval" F.uint16_t
+
+ let right_sat_0 = F.field t "right_sat[0]" F.uint16_t
+ let right_sat_1 = F.field t "right_sat[1]" F.uint16_t
+ let right_sat_2 = F.field t "right_sat[2]" F.uint16_t
+ let left_sat_0 = F.field t "left_sat[0]" F.uint16_t
+ let left_sat_1 = F.field t "left_sat[1]" F.uint16_t
+ let left_sat_2 = F.field t "left_sat[2]" F.uint16_t
+ let right_coeff_0 = F.field t "right_coeff[0]" F.int16_t
+ let right_coeff_1 = F.field t "right_coeff[1]" F.int16_t
+ let right_coeff_2 = F.field t "right_coeff[2]" F.int16_t
+ let left_coeff_0 = F.field t "left_coeff[0]" F.int16_t
+ let left_coeff_1 = F.field t "left_coeff[1]" F.int16_t
+ let left_coeff_2 = F.field t "left_coeff[2]" F.int16_t
+ let deadband_0 = F.field t "deadband[0]" F.uint16_t
+ let deadband_1 = F.field t "deadband[1]" F.uint16_t
+ let deadband_2 = F.field t "deadband[2]" F.uint16_t
+ let center_0 = F.field t "center[0]" F.int16_t
+ let center_1 = F.field t "center[1]" F.int16_t
+ let center_2 = F.field t "center[2]" F.int16_t
+ let () = F.seal t
+ end
+
+ module Ramp = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_HapticRamp"
+ let typ = F.field t "type" F.uint16_t
+ let direction = F.field t "direction" Direction.t
+ let length = F.field t "length" F.uint32_t
+ let delay = F.field t "delay" F.uint16_t
+ let button = F.field t "button" F.uint16_t
+ let interval = F.field t "interval" F.uint16_t
+
+ let start = F.field t "start" F.int16_t
+ let end_ = F.field t "end" F.int16_t
+ let attack_length = F.field t "attack_length" F.uint16_t
+ let attack_level = F.field t "attack_level" F.uint16_t
+ let fade_length = F.field t "fade_length" F.uint16_t
+ let fade_level = F.field t "fade_level" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Left_right = struct
+ type t
+ let t : t Ctypes_static.structure F.typ =
+ F.structure "SDL_HapticLeftRight"
+ let typ = F.field t "type" F.uint16_t
+ let length = F.field t "length" F.uint32_t
+
+ let large_magnitude = F.field t "large_magnitude" F.uint16_t
+ let small_magnitude = F.field t "small_magnitude" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Custom = struct
+ type t
+ let t : t Ctypes_static.structure F.typ = F.structure "SDL_HapticCustom"
+ let typ = F.field t "type" F.uint16_t
+ let direction = F.field t "direction" Direction.t
+ let length = F.field t "length" F.uint32_t
+ let delay = F.field t "delay" F.uint16_t
+ let button = F.field t "button" F.uint16_t
+ let interval = F.field t "interval" F.uint16_t
+
+ let channels = F.field t "channels" F.uint8_t
+ let period = F.field t "period" F.uint16_t
+ let samples = F.field t "samples" F.uint16_t
+ let data = F.field t "data" (F.ptr F.uint16_t)
+ let attack_length = F.field t "attack_length" F.uint16_t
+ let attack_level = F.field t "attack_level" F.uint16_t
+ let fade_length = F.field t "fade_length" F.uint16_t
+ let fade_level = F.field t "fade_level" F.uint16_t
+ let () = F.seal t
+ end
+
+ module Effect = struct
+ type t
+ let t : t Ctypes_static.union F.typ = F.union "SDL_HapticEffect"
+ let _typ = F.field t "type" F.uint16_t
+ let constant = F.field t "constant" Constant.t
+ let periodic = F.field t "periodic" Periodic.t
+ let condition = F.field t "condition" Condition.t
+ let ramp = F.field t "ramp" Ramp.t
+ let left_right = F.field t "leftright" Left_right.t
+ let custom = F.field t "custom" Custom.t
+ let () = F.seal t
+ end
+ end
+
+ module Audio = struct
+ type status = int
+ let stopped = F.constant "SDL_AUDIO_STOPPED" F.int
+ let playing = F.constant "SDL_AUDIO_PLAYING" F.int
+ let paused = F.constant "SDL_AUDIO_PAUSED" F.int
+
+ type format = int
+ let s8 = F.constant "AUDIO_S8" F.int
+ let u8 = F.constant "AUDIO_U8" F.int
+ let s16_lsb = F.constant "AUDIO_S16LSB" F.int
+ let s16_msb = F.constant "AUDIO_S16MSB" F.int
+ let s16_sys = F.constant "AUDIO_S16SYS" F.int
+ let s16 = F.constant "AUDIO_S16" F.int
+ let u16_lsb = F.constant "AUDIO_U16LSB" F.int
+ let u16_msb = F.constant "AUDIO_U16MSB" F.int
+ let u16_sys = F.constant "AUDIO_U16SYS" F.int
+ let u16 = F.constant "AUDIO_U16" F.int
+ let s32_lsb = F.constant "AUDIO_S32LSB" F.int
+ let s32_msb = F.constant "AUDIO_S32MSB" F.int
+ let s32_sys = F.constant "AUDIO_S32SYS" F.int
+ let s32 = F.constant "AUDIO_S32" F.int
+ let f32_lsb = F.constant "AUDIO_F32LSB" F.int
+ let f32_msb = F.constant "AUDIO_F32MSB" F.int
+ let f32_sys = F.constant "AUDIO_F32SYS" F.int
+ let f32 = F.constant "AUDIO_F32" F.int
+
+ type allow = int
+ let allow_frequency_change = F.constant "SDL_AUDIO_ALLOW_FREQUENCY_CHANGE" F.int
+ let allow_format_change = F.constant "SDL_AUDIO_ALLOW_FORMAT_CHANGE" F.int
+ let allow_channels_change = F.constant "SDL_AUDIO_ALLOW_CHANNELS_CHANGE" F.int
+ let allow_any_change = F.constant "SDL_AUDIO_ALLOW_ANY_CHANGE" F.int
+ end
+
+ let as_callback_type =
+ F.(ptr void @-> ptr uint8_t @-> int @-> returning void)
+
+ type _audio_spec
+ let audio_spec : _audio_spec Ctypes_static.structure F.typ =
+ F.structure "SDL_AudioSpec"
+ let as_freq = F.field audio_spec "freq" F.int
+ let as_format = F.field audio_spec "format" F.uint16_t
+ let as_channels = F.field audio_spec "channels" F.uint8_t
+ let as_silence = F.field audio_spec "silence" F.uint8_t
+ let as_samples = F.field audio_spec "samples" F.uint16_t
+ let _ = F.field audio_spec "padding" F.uint16_t
+ let as_size = F.field audio_spec "size" F.uint32_t
+ let as_callback =
+ F.field audio_spec "callback" (F.static_funptr as_callback_type)
+ let as_userdata = F.field audio_spec "userdata" F.(ptr void)
+ let () = F.seal audio_spec
+
+
+ module Powerstate = struct
+ let unknown = F.constant "SDL_POWERSTATE_UNKNOWN" F.int
+ let on_battery = F.constant "SDL_POWERSTATE_ON_BATTERY" F.int
+ let no_battery = F.constant "SDL_POWERSTATE_NO_BATTERY" F.int
+ let charging = F.constant "SDL_POWERSTATE_CHARGING" F.int
+ let charged = F.constant "SDL_POWERSTATE_CHARGED" F.int
+ end
+end
