diff --git a/core/GLFW.carp b/core/GLFW.carp index da4354d6..f8da5e08 100644 --- a/core/GLFW.carp +++ b/core/GLFW.carp @@ -15,11 +15,11 @@ (register set-gamma-ramp (λ [(Ptr GLFWmonitor) (Ptr GLFWgammaramp)] ()) "glfwSetGammaRamp") (register default-window-hints (λ [] ()) "glfwDefaultWindowHints") (register window-hint (λ [Int Int] ()) "glfwWindowHint") - (register create-window (λ [Int Int (Ptr Char) (Ptr GLFWmonitor) (Ptr GLFWwindow)] (Ptr GLFWwindow)) "glfwCreateWindow") + (register create-window (λ [Int Int (Ptr CChar) (Ptr GLFWmonitor) (Ptr GLFWwindow)] (Ptr GLFWwindow)) "glfwCreateWindow") (register destroy-window (λ [(Ptr GLFWwindow)] ()) "glfwDestroyWindow") (register window-should-close (λ [(Ptr GLFWwindow)] Int) "glfwWindowShouldClose") (register set-window-should-close (λ [(Ptr GLFWwindow) Int] ()) "glfwSetWindowShouldClose") - (register set-window-title (λ [(Ptr GLFWwindow) (Ptr Char)] ()) "glfwSetWindowTitle") + (register set-window-title (λ [(Ptr GLFWwindow) (Ptr CChar)] ()) "glfwSetWindowTitle") (register set-window-icon (λ [(Ptr GLFWwindow) Int (Ptr GLFWimage)] ()) "glfwSetWindowIcon") (register get-window-pos (λ [(Ptr GLFWwindow) (Ptr Int) (Ptr Int)] ()) "glfwGetWindowPos") (register set-window-pos (λ [(Ptr GLFWwindow) Int Int] ()) "glfwSetWindowPos") @@ -71,7 +71,7 @@ (register set-drop-callback (λ [(Ptr GLFWwindow) GLFWdropfun] GLFWdropfun) "glfwSetDropCallback") (register joystick-present (λ [Int] Int) "glfwJoystickPresent") (register set-joystick-callback (λ [GLFWjoystickfun] GLFWjoystickfun) "glfwSetJoystickCallback") - (register set-clipboard-string (λ [(Ptr GLFWwindow) (Ptr Char)] ()) "glfwSetClipboardString") + (register set-clipboard-string (λ [(Ptr GLFWwindow) (Ptr CChar)] ()) "glfwSetClipboardString") (register get-time (λ [] Double) "glfwGetTime") (register set-time (λ [Double] ()) "glfwSetTime") (register get-timer-value (λ [] uint64_t) "glfwGetTimerValue") @@ -80,10 +80,10 @@ (register get-current-context (λ [] (Ptr GLFWwindow)) "glfwGetCurrentContext") (register swap-buffers (λ [(Ptr GLFWwindow)] ()) "glfwSwapBuffers") (register swap-interval (λ [Int] ()) "glfwSwapInterval") - (register extension-supported (λ [(Ptr Char)] Int) "glfwExtensionSupported") - (register get-proc-address (λ [(Ptr Char)] GLFWglproc) "glfwGetProcAddress") + (register extension-supported (λ [(Ptr CChar)] Int) "glfwExtensionSupported") + (register get-proc-address (λ [(Ptr CChar)] GLFWglproc) "glfwGetProcAddress") (register vulkan-supported (λ [] Int) "glfwVulkanSupported") - (register get-instance-proc-address (λ [VkInstance (Ptr Char)] GLFWvkproc) "glfwGetInstanceProcAddress") + (register get-instance-proc-address (λ [VkInstance (Ptr CChar)] GLFWvkproc) "glfwGetInstanceProcAddress") (register get-physical-device-presentation-support (λ [VkInstance VkPhysicalDevice uint32_t] Int) "glfwGetPhysicalDevicePresentationSupport") (register create-window-surface (λ [VkInstance (Ptr GLFWwindow) (Ptr VkAllocationCallbacks) (Ptr VkSurfaceKHR)] VkResult) "glfwCreateWindowSurface") ) diff --git a/core/IO.carp b/core/IO.carp index 6d366230..b586b965 100644 --- a/core/IO.carp +++ b/core/IO.carp @@ -74,7 +74,7 @@ (private getenv-) (hidden getenv-) - (register getenv- (Fn [String] (Ptr Char)) "getenv") + (register getenv- (Fn [String] (Ptr CChar)) "getenv") (defn getenv [s] (let [e (getenv- s)] (if (null? e) diff --git a/core/OpenGL.carp b/core/OpenGL.carp index 0ba5bc18..5f823346 100644 --- a/core/OpenGL.carp +++ b/core/OpenGL.carp @@ -1,5 +1,7 @@ (mac-only (add-lib "-framework OpenGL")) +(linux-only + (add-lib "-lGL")) (defmodule GL diff --git a/core/SDL.carp b/core/SDL.carp index b087c357..eaaa4f0d 100644 --- a/core/SDL.carp +++ b/core/SDL.carp @@ -42,15 +42,15 @@ (register INIT_EVERYTHING Int) (register init (Fn [Int] ()) "SDL_Init") (register create-window-and-renderer (Fn [Int Int Int (Ptr (Ptr SDL_Window)) (Ptr (Ptr SDL_Renderer))] ()) "SDL_CreateWindowAndRenderer") - (register set-window-title (Fn [(Ptr SDL_Window) (Ptr Char)] ()) "SDL_SetWindowTitle") + (register set-window-title (Fn [(Ptr SDL_Window) (Ptr CChar)] ()) "SDL_SetWindowTitle") (register delay (Fn [Int] ()) "SDL_Delay") (register destroy-window (Fn [(Ptr SDL_Window)] ()) "SDL_DestroyWindow") (register quit (Fn [] ()) "SDL_Quit") (defmodule Hint - (register set (Fn [(Ptr Char) (Ptr Char)] ()) "SDL_SetHint") - (register render-vsync (Ptr Char) "SDL_HINT_RENDER_VSYNC") - (register video-mac-fullscreen-spaces (Ptr Char) "SDL_HINT_VIDEO_MAC_FULLSCREEN_SPACES")) + (register set (Fn [(Ptr CChar) (Ptr CChar)] ()) "SDL_SetHint") + (register render-vsync (Ptr CChar) "SDL_HINT_RENDER_VSYNC") + (register video-mac-fullscreen-spaces (Ptr CChar) "SDL_HINT_VIDEO_MAC_FULLSCREEN_SPACES")) (defmodule Event (register init (Fn [] SDL_Event)) diff --git a/core/SDL_image.carp b/core/SDL_image.carp index 2b6e0536..fc478c25 100644 --- a/core/SDL_image.carp +++ b/core/SDL_image.carp @@ -8,6 +8,6 @@ (add-lib (str sdl-windows-library-path "SDL2_image.lib "))) (defmodule IMG - (register load-texture (Fn [(Ptr SDL_Renderer) (Ptr Char)] (Ptr SDL_Texture)) "IMG_LoadTexture") - (register load (Fn [(Ptr Char)] (Ptr SDL_Surface)) "IMG_Load") + (register load-texture (Fn [(Ptr SDL_Renderer) (Ptr CChar)] (Ptr SDL_Texture)) "IMG_LoadTexture") + (register load (Fn [(Ptr CChar)] (Ptr SDL_Surface)) "IMG_Load") ) diff --git a/core/SDL_mixer.carp b/core/SDL_mixer.carp index 940bb3a7..cf139c9f 100644 --- a/core/SDL_mixer.carp +++ b/core/SDL_mixer.carp @@ -28,11 +28,11 @@ ;; Loading (register load-wav - (Fn [(Ptr Char)] (Ptr Mix_Chunk)) + (Fn [(Ptr CChar)] (Ptr Mix_Chunk)) "Mix_LoadWAV") (register load-music - (Fn [(Ptr Char)] (Ptr Mix_Music)) + (Fn [(Ptr CChar)] (Ptr Mix_Music)) "Mix_LoadMUS") ;; Playing samples (Mix_Chunk:s) @@ -53,7 +53,7 @@ ;; This function seems flakey, returns NULL? (register get-music-decoder - (Fn [Int] (Ptr Char)) + (Fn [Int] (Ptr CChar)) "Mix_GetMusicDecoder") (register play-music @@ -64,7 +64,7 @@ ;; Error handling (register get-error - (Fn [] (Ptr Char)) + (Fn [] (Ptr CChar)) "Mix_GetError") ;; Helpers diff --git a/core/SDL_ttf.carp b/core/SDL_ttf.carp index 77eee74b..dc46b238 100644 --- a/core/SDL_ttf.carp +++ b/core/SDL_ttf.carp @@ -7,10 +7,10 @@ (defmodule TTF (register init (Fn [] Int) "TTF_Init") (register quit (Fn [] ()) "TTF_Quit") - (register get-error (Fn [] (Ptr Char)) "TTF_GetError") + (register get-error (Fn [] (Ptr CChar)) "TTF_GetError") ;; Loading / unloading - (register open-font (Fn [(Ptr Char) Int] (Ptr TTF_Font)) "TTF_OpenFont") + (register open-font (Fn [(Ptr CChar) Int] (Ptr TTF_Font)) "TTF_OpenFont") (register close-font (Fn [(Ptr TTF_Font)] ()) "TTF_CloseFont") ;; Styles @@ -23,19 +23,19 @@ ;; Render (register render-text-solid - (Fn [(Ptr TTF_Font) (Ptr Char) SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font) (Ptr CChar) SDL_Color] (Ptr SDL_Surface)) "TTF_RenderText_Solid") (register render-text-shaded - (Fn [(Ptr TTF_Font) (Ptr Char) SDL_Color SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font) (Ptr CChar) SDL_Color SDL_Color] (Ptr SDL_Surface)) "TTF_RenderText_Shaded") (register render-text-blended - (Fn [(Ptr TTF_Font) (Ptr Char) SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font) (Ptr CChar) SDL_Color] (Ptr SDL_Surface)) "TTF_RenderText_Blended") (register render-text-blended-wrapped - (Fn [(Ptr TTF_Font) (Ptr Char) SDL_Color Int] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font) (Ptr CChar) SDL_Color Int] (Ptr SDL_Surface)) "TTF_RenderText_Blended_Wrapped") ;; Helpers to make everything a bit nicer diff --git a/core/String.carp b/core/String.carp index 3991483b..818a5527 100644 --- a/core/String.carp +++ b/core/String.carp @@ -9,8 +9,8 @@ (register delete (Fn [String] ())) (register copy (Fn [&String] String)) (register length (Fn [&String] Int)) - (register cstr (Fn [&String] (Ptr Char))) - (register from-cstr (Fn [(Ptr Char)] String)) + (register cstr (Fn [&String] (Ptr CChar))) + (register from-cstr (Fn [(Ptr CChar)] String)) (register str (Fn [&String] String)) (register prn (Fn [&String] String)) (register index-of (Fn [&String Char] Int)) diff --git a/core/carp_char.h b/core/carp_char.h index 4664bd4f..66afbd0f 100644 --- a/core/carp_char.h +++ b/core/carp_char.h @@ -1,24 +1,24 @@ -bool Char__EQ_(char a, char b) { +bool Char__EQ_(Char a, Char b) { return a == b; } -bool Char__LT_(char a, char b) { +bool Char__LT_(Char a, Char b) { return a < b; } -bool Char__GT_(char a, char b) { +bool Char__GT_(Char a, Char b) { return a > b; } -int Char_to_MINUS_int(char c) { - return (int)(unsigned char)c; +int Char_to_MINUS_int(Char c) { + return (int)c; } -char Char_from_MINUS_int(int i) { - return (char)i; +Char Char_from_MINUS_int(int i) { + return (Char)i; } -char Char_copy(const char *c) { +Char Char_copy(const Char *c) { return *c; } diff --git a/core/carp_pattern.h b/core/carp_pattern.h index 596adaa2..cc23f856 100644 --- a/core/carp_pattern.h +++ b/core/carp_pattern.h @@ -9,7 +9,7 @@ #endif /* macro to 'unsign' a character */ -#define uchar(c) ((unsigned char)(c)) +#define uchar(c) ((Char)(c)) /* ** Some sizes are better limited to fit in 'int', but must also fit in @@ -28,7 +28,7 @@ typedef struct PatternMatchState { String p_end; /* end ('\0') of Pattern */ int matchdepth; /* control for recursive depth (to avoid C stack overflow) */ - unsigned char level; /* total number of captures (finished or unfinished) */ + uint8_t level; /* total number of captures (finished or unfinished) */ struct { String init; ptrdiff_t len; @@ -87,9 +87,7 @@ String Pattern_internal_classend(PatternMatchState *ms, String p) { } while (*p != ']'); return p + 1; } - default: { - return p; - } + default: { return p; } } } @@ -156,7 +154,7 @@ int Pattern_internal_singlematch(PatternMatchState *ms, String s, String p, if (s >= ms->src_end) { return 0; } else { - int c = uchar(*s); + Char c = uchar(*s); switch (*p) { case '.': return 1; /* matches any char */ @@ -286,7 +284,7 @@ init: /* using goto's to optimize tail recursion */ } case 'f': { /* frontier? */ String ep; - char previous; + Char previous; p += 2; if (*p != '[') carp_regerror("missing '[' after '%cf' in Pattern", @@ -307,7 +305,7 @@ init: /* using goto's to optimize tail recursion */ case 'r': /* carriage return? */ case 'n': /* newline? */ case 't': { /* tab? */ - char h = *(p + 1); + Char h = *(p + 1); p += 2; if ((*s == '\r' && h == 'r') || (*s == '\n' && h == 'n') || @@ -665,7 +663,7 @@ Array Pattern_global_MINUS_match(Pattern *p, String *s) { return res; } -String Pattern_internal_add_char(String a, char b) { +String Pattern_internal_add_char(String a, Char b) { if (!a) { String buffer = CARP_MALLOC(2); sprintf(buffer, "%c", b); diff --git a/core/carp_string.h b/core/carp_string.h index f729b638..4a8df93e 100644 --- a/core/carp_string.h +++ b/core/carp_string.h @@ -120,23 +120,45 @@ String String_format(const String *str, const String *s) { return buffer; } +static size_t utf8len(const char *s) { + size_t l = 0; + for (size_t i = 0; s[i]; i++) l += (s[i] & 0xC0) != 0x80; + return l; +} + +static size_t wutf8len(const wchar_t *s, size_t cnt) { + size_t l = 0; + for (size_t i = 0; i < cnt; i++) l += snprintf(0, 0, "%lc", s[i]); + return l; +} + Array String_chars(const String *s) { + int r; + Char *data; Array chars; - chars.len = strlen(*s); - chars.capacity = chars.len; - chars.data = String_copy(s); + chars.len = utf8len(*s); + chars.capacity = chars.len + 1; + data = CARP_MALLOC(chars.capacity * sizeof(*data)); + r = sscanf(*s, "%l[^]", (wchar_t *)data); + chars.data = data; + assert(r == 1 || chars.len == 0); return chars; } String String_from_MINUS_chars(const Array *a) { - String s = CARP_MALLOC(a->len + 1); - memcpy(s, a->data, a->len); - s[a->len] = '\0'; + wchar_t *data = (wchar_t *)a->data; + size_t cnt = a->len; + size_t sz = wutf8len(data, cnt) + 1; + String s = CARP_MALLOC(sz); + size_t sofar = 0; + for (size_t i = 0; i < cnt; i++) + sofar += snprintf(s + sofar, sz - sofar, "%lc", data[i]); + s[sofar] = 0; return s; } String String_tail(const String *s) { - int len = strlen(*s); + size_t len = strlen(*s); String news = CARP_MALLOC(len); memcpy(news, (*s) + 1, len - 1); news[len - 1] = '\0'; diff --git a/core/core.h b/core/core.h index 2e40e185..751bb3fa 100644 --- a/core/core.h +++ b/core/core.h @@ -13,6 +13,8 @@ typedef SSIZE_T ssize_t; typedef char *String; typedef char *Pattern; typedef int64_t Long; +typedef uint32_t Char; +typedef char CChar; #if defined NDEBUG #define CHK_INDEX(i, n) diff --git a/default.nix b/default.nix index 3cdd3384..e166d79e 100644 --- a/default.nix +++ b/default.nix @@ -10,7 +10,7 @@ let , darwin, glfw3, SDL2, SDL2_image, SDL2_gfx, SDL2_mixer, SDL2_ttf , clang , makeWrapper - , libXext, libXcursor, libXinerama, libXi, libXrandr, libXScrnSaver, libXxf86vm + , libXext, libXcursor, libXinerama, libXi, libXrandr, libXScrnSaver, libXxf86vm, libpthreadstubs, libXdmcp, libGL }: mkDerivation { pname = "CarpHask"; @@ -29,7 +29,7 @@ let ]; pkgconfigDepends = [ glfw3 SDL2 SDL2_image SDL2_gfx SDL2_mixer SDL2_ttf ] - ++ stdenv.lib.optionals stdenv.isLinux [ libXext libXcursor libXinerama libXi libXrandr libXScrnSaver libXxf86vm ]; + ++ stdenv.lib.optionals stdenv.isLinux [ libXext libXcursor libXinerama libXi libXrandr libXScrnSaver libXxf86vm libpthreadstubs libXdmcp libGL]; executableHaskellDepends = [ base cmdargs containers directory haskeline parsec process clang diff --git a/docs/core/String.html b/docs/core/String.html index 885f675d..53c3431c 100644 --- a/docs/core/String.html +++ b/docs/core/String.html @@ -154,7 +154,7 @@ String
- +
- +
- +
- +
- +
- +
- +
- (Fn [(Ref String a)] (Ptr Char)) + (Fn [(Ref String a)] (Ptr CChar))
- +- +
- +
- +
- (Fn [(Ptr Char)] String) + (Fn [(Ptr CChar)] String)
- +- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- (Fn [(Ptr Char)] (Ptr SDL_Surface)) + (Fn [(Ptr CChar)] (Ptr SDL_Surface))
- +- +
- (Fn [(Ptr SDL_Renderer), (Ptr Char)] (Ptr SDL_Texture)) + (Fn [(Ptr SDL_Renderer), (Ptr CChar)] (Ptr SDL_Texture))
- +- +
diff --git a/docs/sdl/Mixer.html b/docs/sdl/Mixer.html index 3432ca36..459f5548 100644 --- a/docs/sdl/Mixer.html +++ b/docs/sdl/Mixer.html @@ -54,7 +54,7 @@ Mixer- +
- +
- +
- (Fn [] (Ptr Char)) + (Fn [] (Ptr CChar))
- +- +
- (Fn [Int] (Ptr Char)) + (Fn [Int] (Ptr CChar))
- +- +
- +
- (Fn [(Ptr Char)] (Ptr Mix_Music)) + (Fn [(Ptr CChar)] (Ptr Mix_Music))
- +- +
- (Fn [(Ptr Char)] (Ptr Mix_Chunk)) + (Fn [(Ptr CChar)] (Ptr Mix_Chunk))
- +- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- +
- (Fn [(Ptr SDL_Window), (Ptr Char)] ()) + (Fn [(Ptr SDL_Window), (Ptr CChar)] ())
- +- +
- +
- +
- (Fn [] (Ptr Char)) + (Fn [] (Ptr cChar))
- +- +
- +
- +
- (Fn [(Ptr Char), Int] (Ptr TTF_Font)) + (Fn [(Ptr CChar), Int] (Ptr TTF_Font))
- +- +
- +
- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))
- +- +
- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color, Int] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color, Int] (Ptr SDL_Surface))
- +- +
- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color, SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color, SDL_Color] (Ptr SDL_Surface))
- +- +
- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))
- +- +
- +