From 9b08b6df3cb5513eacb1a56a138ed6e5c48c4379 Mon Sep 17 00:00:00 2001 From: Jorge Acereda Date: Mon, 11 May 2020 16:10:35 +0200 Subject: [PATCH] Merge --- core/GLFW.carp | 12 +-- core/IO.carp | 2 +- core/OpenGL.carp | 2 + core/SDL.carp | 8 +- core/SDL_image.carp | 4 +- core/SDL_mixer.carp | 8 +- core/SDL_ttf.carp | 12 +-- core/String.carp | 4 +- core/carp_char.h | 16 ++-- core/carp_pattern.h | 16 ++-- core/carp_string.h | 36 ++++++-- core/core.h | 2 + default.nix | 4 +- docs/core/String.html | 94 ++++++++++---------- docs/sdl/IMG.html | 14 +-- docs/sdl/Mixer.html | 82 +++++++++--------- docs/sdl/SDL.html | 196 +++++++++++++++++++++--------------------- docs/sdl/TTF.html | 54 ++++++------ examples/fonts.carp | 2 +- examples/sounds.carp | 6 +- src/Types.hs | 2 +- test/pointer.carp | 4 +- test/unicode.carp | 24 ++++++ 23 files changed, 326 insertions(+), 278 deletions(-) create mode 100644 test/unicode.carp 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
- +
@@ -169,10 +169,10 @@ (Fn [(Ref String a), (Ref String b)] Bool)

- +

- +

@@ -188,10 +188,10 @@ (Fn [(Ref String a), (Ref String b)] Bool)

- +

- +

@@ -207,10 +207,10 @@ (Fn [(Ref String a), (Ref String b)] Bool)

- +

- +

@@ -226,10 +226,10 @@ (Fn [Int, Char] String)

- +

- +

@@ -285,10 +285,10 @@ (Fn [(Ref String a), (Ref String b)] String)

- +

- +

@@ -304,10 +304,10 @@ (Fn [(Ref String a), Int] Char)

- +

- +

@@ -323,10 +323,10 @@ (Fn [(Ref String a)] (Array Char))

- +

- +

@@ -385,7 +385,7 @@ (concat strings)

- +

@@ -438,13 +438,13 @@ external

- (Fn [(Ref String a)] (Ptr Char)) + (Fn [(Ref String a)] (Ptr CChar))

- +

- +

@@ -500,10 +500,10 @@ (Fn [(Ref String a), (Ref String b)] String)

- +

- +

@@ -519,10 +519,10 @@ (Fn [(Ref (Array Char) a)] String)

- +

- +

@@ -535,13 +535,13 @@ external

- (Fn [(Ptr Char)] String) + (Fn [(Ptr CChar)] String)

- +

- +

@@ -560,7 +560,7 @@ (hash k)

- +

@@ -636,10 +636,10 @@ (Fn [(Ref String a), Char] Int)

- +

- +

@@ -655,10 +655,10 @@ (Fn [(Ref String a), Char, Int] Int)

- +

- +

@@ -714,10 +714,10 @@ (Fn [(Ref String a)] Int)

- +

- +

@@ -836,7 +836,7 @@ (prefix s a)

- +

@@ -852,10 +852,10 @@ (Fn [(Ref String a)] String)

- +

- +

@@ -874,7 +874,7 @@ (random-sized n)

- +

@@ -933,7 +933,7 @@ (slice s a b)

- +

@@ -989,10 +989,10 @@ (Fn [(Ref String a)] String)

- +

- +

@@ -1008,10 +1008,10 @@ (Fn [(Ref String a), Int, Char] ())

- +

- +

@@ -1027,10 +1027,10 @@ (Fn [(Ref String a), Int, (Ref String b)] ())

- +

- +

@@ -1049,7 +1049,7 @@ (suffix s b)

- +

@@ -1085,10 +1085,10 @@ (Fn [(Ref String a)] String)

- +

- +

diff --git a/docs/sdl/IMG.html b/docs/sdl/IMG.html index 0fb58440..ccef1d5e 100644 --- a/docs/sdl/IMG.html +++ b/docs/sdl/IMG.html @@ -54,7 +54,7 @@ IMG
- +
@@ -66,13 +66,13 @@ external

- (Fn [(Ptr Char)] (Ptr SDL_Surface)) + (Fn [(Ptr CChar)] (Ptr SDL_Surface))

- +

- +

@@ -85,13 +85,13 @@ external

- (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
- +
@@ -69,10 +69,10 @@ Int

- +

- +

@@ -88,10 +88,10 @@ (Fn [Int] Bool)

- +

- +

@@ -107,10 +107,10 @@ Int

- +

- +

@@ -126,10 +126,10 @@ Int

- +

- +

@@ -142,13 +142,13 @@ external

- (Fn [] (Ptr Char)) + (Fn [] (Ptr CChar))

- +

- +

@@ -161,13 +161,13 @@ external

- (Fn [Int] (Ptr Char)) + (Fn [Int] (Ptr CChar))

- +

- +

@@ -183,10 +183,10 @@ (Fn [Int] Int)

- +

- +

@@ -199,13 +199,13 @@ external

- (Fn [(Ptr Char)] (Ptr Mix_Music)) + (Fn [(Ptr CChar)] (Ptr Mix_Music))

- +

- +

@@ -218,13 +218,13 @@ external

- (Fn [(Ptr Char)] (Ptr Mix_Chunk)) + (Fn [(Ptr CChar)] (Ptr Mix_Chunk))

- +

- +

@@ -240,10 +240,10 @@ Int

- +

- +

@@ -259,10 +259,10 @@ Int

- +

- +

@@ -278,10 +278,10 @@ (Fn [] Int)

- +

- +

@@ -297,10 +297,10 @@ Int

- +

- +

@@ -319,7 +319,7 @@ (ok? error-code)

- +

@@ -335,10 +335,10 @@ (Fn [Int, Int, Int, Int] Int)

- +

- +

@@ -354,10 +354,10 @@ (Fn [Int, (Ptr Mix_Chunk), Int] Int)

- +

- +

@@ -373,10 +373,10 @@ (Fn [(Ptr Mix_Music), Int] Int)

- +

- +

@@ -392,10 +392,10 @@ (Fn [] ())

- +

- +

@@ -414,7 +414,7 @@ (valid-channel? ch)

- +

diff --git a/docs/sdl/SDL.html b/docs/sdl/SDL.html index 84196354..c59ad695 100644 --- a/docs/sdl/SDL.html +++ b/docs/sdl/SDL.html @@ -54,7 +54,7 @@ SDL
- +
@@ -69,10 +69,10 @@ Module

- +

- +

@@ -88,10 +88,10 @@ Module

- +

- +

@@ -107,10 +107,10 @@ Int

- +

- +

@@ -126,10 +126,10 @@ Module

- +

- +

@@ -145,10 +145,10 @@ Module

- +

- +

@@ -164,10 +164,10 @@ Module

- +

- +

@@ -186,7 +186,7 @@ (bg rend color)

- +

@@ -202,10 +202,10 @@ SDL_BlendMode

- +

- +

@@ -221,10 +221,10 @@ SDL_BlendMode

- +

- +

@@ -240,10 +240,10 @@ SDL_BlendMode

- +

- +

@@ -259,10 +259,10 @@ SDL_BlendMode

- +

- +

@@ -278,10 +278,10 @@ (Fn [(Ptr SDL_Surface), (Ptr SDL_Rect), (Ptr SDL_Surface), (Ptr SDL_Rect)] ())

- +

- +

@@ -297,10 +297,10 @@ (Fn [Int, Int, Int, Int, Int, Int, Int, Int] (Ptr SDL_Surface))

- +

- +

@@ -316,10 +316,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Surface)] (Ptr SDL_Texture))

- +

- +

@@ -335,10 +335,10 @@ (Fn [Int, Int, Int, (Ptr (Ptr SDL_Window)), (Ptr (Ptr SDL_Renderer))] ())

- +

- +

@@ -354,10 +354,10 @@ (Fn [Int] ())

- +

- +

@@ -373,10 +373,10 @@ (Fn [(Ptr SDL_Texture)] ())

- +

- +

@@ -392,10 +392,10 @@ (Fn [(Ptr SDL_Window)] ())

- +

- +

@@ -414,7 +414,7 @@ (dimensions texture)

- +

@@ -433,7 +433,7 @@ (draw-texture rend texture point)

- +

@@ -452,7 +452,7 @@ (draw-texture-centered rend texture point)

- +

@@ -468,10 +468,10 @@ SDL_RendererFlip

- +

- +

@@ -487,10 +487,10 @@ SDL_RendererFlip

- +

- +

@@ -506,10 +506,10 @@ SDL_RendererFlip

- +

- +

@@ -525,10 +525,10 @@ (Fn [(Ptr SDL_Surface)] ())

- +

- +

@@ -544,10 +544,10 @@ (Fn [] Int)

- +

- +

@@ -563,10 +563,10 @@ (Fn [(Ptr SDL_Window)] Int)

- +

- +

@@ -582,10 +582,10 @@ (Fn [Int] ())

- +

- +

@@ -601,10 +601,10 @@ (Fn [Int, Int] SDL_Point)

- +

- +

@@ -620,10 +620,10 @@ (Fn [(Ptr SDL_Texture), (Ptr Int), (Ptr Int), (Ptr Int), (Ptr Int)] ())

- +

- +

@@ -639,10 +639,10 @@ (Fn [] ())

- +

- +

@@ -658,10 +658,10 @@ (Fn [Int, Int, Int, Int] SDL_Rect)

- +

- +

@@ -677,10 +677,10 @@ (Fn [(Ptr SDL_Renderer)] ())

- +

- +

@@ -696,10 +696,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Texture), (Ptr SDL_Rect), (Ptr SDL_Rect)] ())

- +

- +

@@ -715,10 +715,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Texture), (Ptr SDL_Rect), (Ptr SDL_Rect), Double, (Ptr SDL_Point), SDL_RendererFlip] ())

- +

- +

@@ -734,10 +734,10 @@ (Fn [(Ptr SDL_Renderer), Int, Int, Int, Int] ())

- +

- +

@@ -753,10 +753,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Point), Int] ())

- +

- +

@@ -772,10 +772,10 @@ (Fn [(Ptr SDL_Renderer), Int, Int] ())

- +

- +

@@ -791,10 +791,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Rect)] ())

- +

- +

@@ -810,10 +810,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Rect), Int] ())

- +

- +

@@ -829,10 +829,10 @@ (Fn [(Ptr SDL_Renderer)] ())

- +

- +

@@ -848,10 +848,10 @@ (Fn [(Ptr SDL_Renderer), (Ptr SDL_Rect), Int, (Ptr ()), Int] Int)

- +

- +

@@ -867,10 +867,10 @@ (Fn [Int, Int, Int] SDL_Color)

- +

- +

@@ -886,10 +886,10 @@ (Fn [Int, Int, Int] SDL_Color)

- +

- +

@@ -905,10 +905,10 @@ (Fn [(Ptr SDL_Surface), String] Int)

- +

- +

@@ -924,10 +924,10 @@ (Fn [(Ptr SDL_Renderer), SDL_BlendMode] ())

- +

- +

@@ -943,10 +943,10 @@ (Fn [(Ptr SDL_Renderer), Int, Int, Int, Int] ())

- +

- +

@@ -959,13 +959,13 @@ external

- (Fn [(Ptr SDL_Window), (Ptr Char)] ()) + (Fn [(Ptr SDL_Window), (Ptr CChar)] ())

- +

- +

@@ -981,10 +981,10 @@ (Fn [(Ptr SDL_Surface)] Int)

- +

- +

@@ -1000,10 +1000,10 @@ (Fn [(Ptr SDL_Surface)] (Ptr ()))

- +

- +

diff --git a/docs/sdl/TTF.html b/docs/sdl/TTF.html index ccb9b884..ae91554b 100644 --- a/docs/sdl/TTF.html +++ b/docs/sdl/TTF.html @@ -54,7 +54,7 @@ TTF
- +
@@ -69,10 +69,10 @@ (Fn [(Ptr TTF_Font)] ())

- +

- +

@@ -85,13 +85,13 @@ external

- (Fn [] (Ptr Char)) + (Fn [] (Ptr cChar))

- +

- +

@@ -107,10 +107,10 @@ (Fn [] Int)

- +

- +

@@ -129,7 +129,7 @@ (ok? error-code)

- +

@@ -142,13 +142,13 @@ external

- (Fn [(Ptr Char), Int] (Ptr TTF_Font)) + (Fn [(Ptr CChar), Int] (Ptr TTF_Font))

- +

- +

@@ -164,10 +164,10 @@ (Fn [] ())

- +

- +

@@ -180,13 +180,13 @@ external

- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))

- +

- +

@@ -199,13 +199,13 @@ external

- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color, Int] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color, Int] (Ptr SDL_Surface))

- +

- +

@@ -218,13 +218,13 @@ external

- (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))

- +

- +

@@ -237,13 +237,13 @@ external

- (Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface)) + (Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))

- +

- +

@@ -262,7 +262,7 @@ (render-text-to-texture rend font str color)

- +

diff --git a/examples/fonts.carp b/examples/fonts.carp index 215fec60..915c6875 100644 --- a/examples/fonts.carp +++ b/examples/fonts.carp @@ -47,4 +47,4 @@ (do (set! font (TTF.open-font (cstr "resources/Hasklig.otf") 20)) (set! text1 (TTF.render-text-to-texture rend font "Carp!" (SDL.rgb 0 0 0))) (SDLApp.run-with-callbacks &app event-handler id draw 0)) - (println* "Failed to initialize SDL_ttf: " &(str (TTF.get-error))))))) + (println* "Failed to initialize SDL_ttf: " &(from-cstr (TTF.get-error))))))) diff --git a/examples/sounds.carp b/examples/sounds.carp index 12a2831e..9f8b5612 100644 --- a/examples/sounds.carp +++ b/examples/sounds.carp @@ -33,16 +33,16 @@ (do (let [flags Mixer.mp3-support] (when (/= flags (Mixer.init flags)) - (println* "Mixer.init error: " &(str (Mixer.get-error))))) + (println* "Mixer.init error: " &(from-cstr (Mixer.get-error))))) (if (Mixer.ok? (Mixer.open-audio 22050 Mixer.default-format 2 4096)) () - (println* "Mixer.open-audio error: " &(str (Mixer.get-error)))) + (println* "Mixer.open-audio error: " &(from-cstr (Mixer.get-error)))) (set! fx1 (Mixer.load-wav (cstr "resources/fx1.wav"))) (assert (not-null? fx1)) (let-do [n (Mixer.nr-of-music-decoders)] (println* "Nr of music decoders: " n) (for [i 0 n] - (println* " - " &(str (Mixer.get-music-decoder i))))) + (println* " - " &(from-cstr (Mixer.get-music-decoder i))))) (let-do [music (Mixer.load-music (cstr "resources/song.mp3"))] (println* "Music is " (if (null? music) "null." "not null.")) (println* "Play result: " (Mixer.play-music music -1)) diff --git a/src/Types.hs b/src/Types.hs index 03f99a0f..b527a089 100644 --- a/src/Types.hs +++ b/src/Types.hs @@ -146,7 +146,7 @@ tyToCManglePtr _ LongTy = "Long" tyToCManglePtr _ ByteTy = "uint8_t" tyToCManglePtr _ StringTy = "String" tyToCManglePtr _ PatternTy = "Pattern" -tyToCManglePtr _ CharTy = "char" +tyToCManglePtr _ CharTy = "Char" tyToCManglePtr _ UnitTy = "void" tyToCManglePtr _ (VarTy x) = x tyToCManglePtr _ (FuncTy argTys retTy _) = "Fn__" ++ joinWithUnderscore (map (tyToCManglePtr True) argTys) ++ "_" ++ tyToCManglePtr True retTy diff --git a/test/pointer.carp b/test/pointer.carp index 82658b22..03cbe617 100644 --- a/test/pointer.carp +++ b/test/pointer.carp @@ -13,8 +13,8 @@ ; these tests are sadly a little unsafe (deftest test (assert-equal test - 1l - ; we assume that the width of a char is 1 + 4l + ; we assume that the width of a char is 4 (width (Array.raw (the (Array Char) []))) "Pointer.width works as expected" ) diff --git a/test/unicode.carp b/test/unicode.carp new file mode 100644 index 00000000..badf47fa --- /dev/null +++ b/test/unicode.carp @@ -0,0 +1,24 @@ +(use String) + +(load "Test.carp") +(load "Array.carp") +(use Test) + +(deftest test + (assert-equal test + &[\s \v \e \d \ä \n \g] + &(chars "svedäng") + "chars works as expected") + (assert-equal test + "svedäng" + &(from-chars &[\s \v \e \d \ä \n \g]) + "from-chars works as expected") + (assert-equal test + &[\😀 \😀 \😀] + &(chars "😀😀😀") + "chars splits emoji") + (assert-equal test + "😀😀😀" + &(from-chars &[\😀 \😀 \😀]) + "from-chars joins emoji") + )