mirror of
https://github.com/carp-lang/Carp.git
synced 2024-09-11 05:25:28 +03:00
Merge
This commit is contained in:
parent
83e8c1a874
commit
9b08b6df3c
@ -15,11 +15,11 @@
|
|||||||
(register set-gamma-ramp (λ [(Ptr GLFWmonitor) (Ptr GLFWgammaramp)] ()) "glfwSetGammaRamp")
|
(register set-gamma-ramp (λ [(Ptr GLFWmonitor) (Ptr GLFWgammaramp)] ()) "glfwSetGammaRamp")
|
||||||
(register default-window-hints (λ [] ()) "glfwDefaultWindowHints")
|
(register default-window-hints (λ [] ()) "glfwDefaultWindowHints")
|
||||||
(register window-hint (λ [Int Int] ()) "glfwWindowHint")
|
(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 destroy-window (λ [(Ptr GLFWwindow)] ()) "glfwDestroyWindow")
|
||||||
(register window-should-close (λ [(Ptr GLFWwindow)] Int) "glfwWindowShouldClose")
|
(register window-should-close (λ [(Ptr GLFWwindow)] Int) "glfwWindowShouldClose")
|
||||||
(register set-window-should-close (λ [(Ptr GLFWwindow) Int] ()) "glfwSetWindowShouldClose")
|
(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 set-window-icon (λ [(Ptr GLFWwindow) Int (Ptr GLFWimage)] ()) "glfwSetWindowIcon")
|
||||||
(register get-window-pos (λ [(Ptr GLFWwindow) (Ptr Int) (Ptr Int)] ()) "glfwGetWindowPos")
|
(register get-window-pos (λ [(Ptr GLFWwindow) (Ptr Int) (Ptr Int)] ()) "glfwGetWindowPos")
|
||||||
(register set-window-pos (λ [(Ptr GLFWwindow) Int Int] ()) "glfwSetWindowPos")
|
(register set-window-pos (λ [(Ptr GLFWwindow) Int Int] ()) "glfwSetWindowPos")
|
||||||
@ -71,7 +71,7 @@
|
|||||||
(register set-drop-callback (λ [(Ptr GLFWwindow) GLFWdropfun] GLFWdropfun) "glfwSetDropCallback")
|
(register set-drop-callback (λ [(Ptr GLFWwindow) GLFWdropfun] GLFWdropfun) "glfwSetDropCallback")
|
||||||
(register joystick-present (λ [Int] Int) "glfwJoystickPresent")
|
(register joystick-present (λ [Int] Int) "glfwJoystickPresent")
|
||||||
(register set-joystick-callback (λ [GLFWjoystickfun] GLFWjoystickfun) "glfwSetJoystickCallback")
|
(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 get-time (λ [] Double) "glfwGetTime")
|
||||||
(register set-time (λ [Double] ()) "glfwSetTime")
|
(register set-time (λ [Double] ()) "glfwSetTime")
|
||||||
(register get-timer-value (λ [] uint64_t) "glfwGetTimerValue")
|
(register get-timer-value (λ [] uint64_t) "glfwGetTimerValue")
|
||||||
@ -80,10 +80,10 @@
|
|||||||
(register get-current-context (λ [] (Ptr GLFWwindow)) "glfwGetCurrentContext")
|
(register get-current-context (λ [] (Ptr GLFWwindow)) "glfwGetCurrentContext")
|
||||||
(register swap-buffers (λ [(Ptr GLFWwindow)] ()) "glfwSwapBuffers")
|
(register swap-buffers (λ [(Ptr GLFWwindow)] ()) "glfwSwapBuffers")
|
||||||
(register swap-interval (λ [Int] ()) "glfwSwapInterval")
|
(register swap-interval (λ [Int] ()) "glfwSwapInterval")
|
||||||
(register extension-supported (λ [(Ptr Char)] Int) "glfwExtensionSupported")
|
(register extension-supported (λ [(Ptr CChar)] Int) "glfwExtensionSupported")
|
||||||
(register get-proc-address (λ [(Ptr Char)] GLFWglproc) "glfwGetProcAddress")
|
(register get-proc-address (λ [(Ptr CChar)] GLFWglproc) "glfwGetProcAddress")
|
||||||
(register vulkan-supported (λ [] Int) "glfwVulkanSupported")
|
(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 get-physical-device-presentation-support (λ [VkInstance VkPhysicalDevice uint32_t] Int) "glfwGetPhysicalDevicePresentationSupport")
|
||||||
(register create-window-surface (λ [VkInstance (Ptr GLFWwindow) (Ptr VkAllocationCallbacks) (Ptr VkSurfaceKHR)] VkResult) "glfwCreateWindowSurface")
|
(register create-window-surface (λ [VkInstance (Ptr GLFWwindow) (Ptr VkAllocationCallbacks) (Ptr VkSurfaceKHR)] VkResult) "glfwCreateWindowSurface")
|
||||||
)
|
)
|
||||||
|
@ -74,7 +74,7 @@
|
|||||||
|
|
||||||
(private getenv-)
|
(private getenv-)
|
||||||
(hidden getenv-)
|
(hidden getenv-)
|
||||||
(register getenv- (Fn [String] (Ptr Char)) "getenv")
|
(register getenv- (Fn [String] (Ptr CChar)) "getenv")
|
||||||
(defn getenv [s]
|
(defn getenv [s]
|
||||||
(let [e (getenv- s)]
|
(let [e (getenv- s)]
|
||||||
(if (null? e)
|
(if (null? e)
|
||||||
|
@ -1,5 +1,7 @@
|
|||||||
(mac-only
|
(mac-only
|
||||||
(add-lib "-framework OpenGL"))
|
(add-lib "-framework OpenGL"))
|
||||||
|
(linux-only
|
||||||
|
(add-lib "-lGL"))
|
||||||
|
|
||||||
(defmodule GL
|
(defmodule GL
|
||||||
|
|
||||||
|
@ -42,15 +42,15 @@
|
|||||||
(register INIT_EVERYTHING Int)
|
(register INIT_EVERYTHING Int)
|
||||||
(register init (Fn [Int] ()) "SDL_Init")
|
(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 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 delay (Fn [Int] ()) "SDL_Delay")
|
||||||
(register destroy-window (Fn [(Ptr SDL_Window)] ()) "SDL_DestroyWindow")
|
(register destroy-window (Fn [(Ptr SDL_Window)] ()) "SDL_DestroyWindow")
|
||||||
(register quit (Fn [] ()) "SDL_Quit")
|
(register quit (Fn [] ()) "SDL_Quit")
|
||||||
|
|
||||||
(defmodule Hint
|
(defmodule Hint
|
||||||
(register set (Fn [(Ptr Char) (Ptr Char)] ()) "SDL_SetHint")
|
(register set (Fn [(Ptr CChar) (Ptr CChar)] ()) "SDL_SetHint")
|
||||||
(register render-vsync (Ptr Char) "SDL_HINT_RENDER_VSYNC")
|
(register render-vsync (Ptr CChar) "SDL_HINT_RENDER_VSYNC")
|
||||||
(register video-mac-fullscreen-spaces (Ptr Char) "SDL_HINT_VIDEO_MAC_FULLSCREEN_SPACES"))
|
(register video-mac-fullscreen-spaces (Ptr CChar) "SDL_HINT_VIDEO_MAC_FULLSCREEN_SPACES"))
|
||||||
|
|
||||||
(defmodule Event
|
(defmodule Event
|
||||||
(register init (Fn [] SDL_Event))
|
(register init (Fn [] SDL_Event))
|
||||||
|
@ -8,6 +8,6 @@
|
|||||||
(add-lib (str sdl-windows-library-path "SDL2_image.lib ")))
|
(add-lib (str sdl-windows-library-path "SDL2_image.lib ")))
|
||||||
|
|
||||||
(defmodule IMG
|
(defmodule IMG
|
||||||
(register load-texture (Fn [(Ptr SDL_Renderer) (Ptr Char)] (Ptr SDL_Texture)) "IMG_LoadTexture")
|
(register load-texture (Fn [(Ptr SDL_Renderer) (Ptr CChar)] (Ptr SDL_Texture)) "IMG_LoadTexture")
|
||||||
(register load (Fn [(Ptr Char)] (Ptr SDL_Surface)) "IMG_Load")
|
(register load (Fn [(Ptr CChar)] (Ptr SDL_Surface)) "IMG_Load")
|
||||||
)
|
)
|
||||||
|
@ -28,11 +28,11 @@
|
|||||||
|
|
||||||
;; Loading
|
;; Loading
|
||||||
(register load-wav
|
(register load-wav
|
||||||
(Fn [(Ptr Char)] (Ptr Mix_Chunk))
|
(Fn [(Ptr CChar)] (Ptr Mix_Chunk))
|
||||||
"Mix_LoadWAV")
|
"Mix_LoadWAV")
|
||||||
|
|
||||||
(register load-music
|
(register load-music
|
||||||
(Fn [(Ptr Char)] (Ptr Mix_Music))
|
(Fn [(Ptr CChar)] (Ptr Mix_Music))
|
||||||
"Mix_LoadMUS")
|
"Mix_LoadMUS")
|
||||||
|
|
||||||
;; Playing samples (Mix_Chunk:s)
|
;; Playing samples (Mix_Chunk:s)
|
||||||
@ -53,7 +53,7 @@
|
|||||||
|
|
||||||
;; This function seems flakey, returns NULL?
|
;; This function seems flakey, returns NULL?
|
||||||
(register get-music-decoder
|
(register get-music-decoder
|
||||||
(Fn [Int] (Ptr Char))
|
(Fn [Int] (Ptr CChar))
|
||||||
"Mix_GetMusicDecoder")
|
"Mix_GetMusicDecoder")
|
||||||
|
|
||||||
(register play-music
|
(register play-music
|
||||||
@ -64,7 +64,7 @@
|
|||||||
|
|
||||||
;; Error handling
|
;; Error handling
|
||||||
(register get-error
|
(register get-error
|
||||||
(Fn [] (Ptr Char))
|
(Fn [] (Ptr CChar))
|
||||||
"Mix_GetError")
|
"Mix_GetError")
|
||||||
|
|
||||||
;; Helpers
|
;; Helpers
|
||||||
|
@ -7,10 +7,10 @@
|
|||||||
(defmodule TTF
|
(defmodule TTF
|
||||||
(register init (Fn [] Int) "TTF_Init")
|
(register init (Fn [] Int) "TTF_Init")
|
||||||
(register quit (Fn [] ()) "TTF_Quit")
|
(register quit (Fn [] ()) "TTF_Quit")
|
||||||
(register get-error (Fn [] (Ptr Char)) "TTF_GetError")
|
(register get-error (Fn [] (Ptr CChar)) "TTF_GetError")
|
||||||
|
|
||||||
;; Loading / unloading
|
;; 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")
|
(register close-font (Fn [(Ptr TTF_Font)] ()) "TTF_CloseFont")
|
||||||
|
|
||||||
;; Styles
|
;; Styles
|
||||||
@ -23,19 +23,19 @@
|
|||||||
|
|
||||||
;; Render
|
;; Render
|
||||||
(register render-text-solid
|
(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")
|
"TTF_RenderText_Solid")
|
||||||
|
|
||||||
(register render-text-shaded
|
(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")
|
"TTF_RenderText_Shaded")
|
||||||
|
|
||||||
(register render-text-blended
|
(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")
|
"TTF_RenderText_Blended")
|
||||||
|
|
||||||
(register render-text-blended-wrapped
|
(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")
|
"TTF_RenderText_Blended_Wrapped")
|
||||||
|
|
||||||
;; Helpers to make everything a bit nicer
|
;; Helpers to make everything a bit nicer
|
||||||
|
@ -9,8 +9,8 @@
|
|||||||
(register delete (Fn [String] ()))
|
(register delete (Fn [String] ()))
|
||||||
(register copy (Fn [&String] String))
|
(register copy (Fn [&String] String))
|
||||||
(register length (Fn [&String] Int))
|
(register length (Fn [&String] Int))
|
||||||
(register cstr (Fn [&String] (Ptr Char)))
|
(register cstr (Fn [&String] (Ptr CChar)))
|
||||||
(register from-cstr (Fn [(Ptr Char)] String))
|
(register from-cstr (Fn [(Ptr CChar)] String))
|
||||||
(register str (Fn [&String] String))
|
(register str (Fn [&String] String))
|
||||||
(register prn (Fn [&String] String))
|
(register prn (Fn [&String] String))
|
||||||
(register index-of (Fn [&String Char] Int))
|
(register index-of (Fn [&String Char] Int))
|
||||||
|
@ -1,24 +1,24 @@
|
|||||||
bool Char__EQ_(char a, char b) {
|
bool Char__EQ_(Char a, Char b) {
|
||||||
return a == b;
|
return a == b;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool Char__LT_(char a, char b) {
|
bool Char__LT_(Char a, Char b) {
|
||||||
return a < b;
|
return a < b;
|
||||||
}
|
}
|
||||||
|
|
||||||
bool Char__GT_(char a, char b) {
|
bool Char__GT_(Char a, Char b) {
|
||||||
return a > b;
|
return a > b;
|
||||||
}
|
}
|
||||||
|
|
||||||
int Char_to_MINUS_int(char c) {
|
int Char_to_MINUS_int(Char c) {
|
||||||
return (int)(unsigned char)c;
|
return (int)c;
|
||||||
}
|
}
|
||||||
|
|
||||||
char Char_from_MINUS_int(int i) {
|
Char Char_from_MINUS_int(int i) {
|
||||||
return (char)i;
|
return (Char)i;
|
||||||
}
|
}
|
||||||
|
|
||||||
char Char_copy(const char *c) {
|
Char Char_copy(const Char *c) {
|
||||||
return *c;
|
return *c;
|
||||||
}
|
}
|
||||||
|
|
||||||
|
@ -9,7 +9,7 @@
|
|||||||
#endif
|
#endif
|
||||||
|
|
||||||
/* macro to 'unsign' a character */
|
/* 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
|
** 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 */
|
String p_end; /* end ('\0') of Pattern */
|
||||||
int matchdepth; /* control for recursive depth (to avoid C stack overflow)
|
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 {
|
struct {
|
||||||
String init;
|
String init;
|
||||||
ptrdiff_t len;
|
ptrdiff_t len;
|
||||||
@ -87,9 +87,7 @@ String Pattern_internal_classend(PatternMatchState *ms, String p) {
|
|||||||
} while (*p != ']');
|
} while (*p != ']');
|
||||||
return p + 1;
|
return p + 1;
|
||||||
}
|
}
|
||||||
default: {
|
default: { return p; }
|
||||||
return p;
|
|
||||||
}
|
|
||||||
}
|
}
|
||||||
}
|
}
|
||||||
|
|
||||||
@ -156,7 +154,7 @@ int Pattern_internal_singlematch(PatternMatchState *ms, String s, String p,
|
|||||||
if (s >= ms->src_end) {
|
if (s >= ms->src_end) {
|
||||||
return 0;
|
return 0;
|
||||||
} else {
|
} else {
|
||||||
int c = uchar(*s);
|
Char c = uchar(*s);
|
||||||
switch (*p) {
|
switch (*p) {
|
||||||
case '.':
|
case '.':
|
||||||
return 1; /* matches any char */
|
return 1; /* matches any char */
|
||||||
@ -286,7 +284,7 @@ init: /* using goto's to optimize tail recursion */
|
|||||||
}
|
}
|
||||||
case 'f': { /* frontier? */
|
case 'f': { /* frontier? */
|
||||||
String ep;
|
String ep;
|
||||||
char previous;
|
Char previous;
|
||||||
p += 2;
|
p += 2;
|
||||||
if (*p != '[')
|
if (*p != '[')
|
||||||
carp_regerror("missing '[' after '%cf' in Pattern",
|
carp_regerror("missing '[' after '%cf' in Pattern",
|
||||||
@ -307,7 +305,7 @@ init: /* using goto's to optimize tail recursion */
|
|||||||
case 'r': /* carriage return? */
|
case 'r': /* carriage return? */
|
||||||
case 'n': /* newline? */
|
case 'n': /* newline? */
|
||||||
case 't': { /* tab? */
|
case 't': { /* tab? */
|
||||||
char h = *(p + 1);
|
Char h = *(p + 1);
|
||||||
p += 2;
|
p += 2;
|
||||||
if ((*s == '\r' && h == 'r') ||
|
if ((*s == '\r' && h == 'r') ||
|
||||||
(*s == '\n' && h == 'n') ||
|
(*s == '\n' && h == 'n') ||
|
||||||
@ -665,7 +663,7 @@ Array Pattern_global_MINUS_match(Pattern *p, String *s) {
|
|||||||
return res;
|
return res;
|
||||||
}
|
}
|
||||||
|
|
||||||
String Pattern_internal_add_char(String a, char b) {
|
String Pattern_internal_add_char(String a, Char b) {
|
||||||
if (!a) {
|
if (!a) {
|
||||||
String buffer = CARP_MALLOC(2);
|
String buffer = CARP_MALLOC(2);
|
||||||
sprintf(buffer, "%c", b);
|
sprintf(buffer, "%c", b);
|
||||||
|
@ -120,23 +120,45 @@ String String_format(const String *str, const String *s) {
|
|||||||
return buffer;
|
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) {
|
Array String_chars(const String *s) {
|
||||||
|
int r;
|
||||||
|
Char *data;
|
||||||
Array chars;
|
Array chars;
|
||||||
chars.len = strlen(*s);
|
chars.len = utf8len(*s);
|
||||||
chars.capacity = chars.len;
|
chars.capacity = chars.len + 1;
|
||||||
chars.data = String_copy(s);
|
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;
|
return chars;
|
||||||
}
|
}
|
||||||
|
|
||||||
String String_from_MINUS_chars(const Array *a) {
|
String String_from_MINUS_chars(const Array *a) {
|
||||||
String s = CARP_MALLOC(a->len + 1);
|
wchar_t *data = (wchar_t *)a->data;
|
||||||
memcpy(s, a->data, a->len);
|
size_t cnt = a->len;
|
||||||
s[a->len] = '\0';
|
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;
|
return s;
|
||||||
}
|
}
|
||||||
|
|
||||||
String String_tail(const String *s) {
|
String String_tail(const String *s) {
|
||||||
int len = strlen(*s);
|
size_t len = strlen(*s);
|
||||||
String news = CARP_MALLOC(len);
|
String news = CARP_MALLOC(len);
|
||||||
memcpy(news, (*s) + 1, len - 1);
|
memcpy(news, (*s) + 1, len - 1);
|
||||||
news[len - 1] = '\0';
|
news[len - 1] = '\0';
|
||||||
|
@ -13,6 +13,8 @@ typedef SSIZE_T ssize_t;
|
|||||||
typedef char *String;
|
typedef char *String;
|
||||||
typedef char *Pattern;
|
typedef char *Pattern;
|
||||||
typedef int64_t Long;
|
typedef int64_t Long;
|
||||||
|
typedef uint32_t Char;
|
||||||
|
typedef char CChar;
|
||||||
|
|
||||||
#if defined NDEBUG
|
#if defined NDEBUG
|
||||||
#define CHK_INDEX(i, n)
|
#define CHK_INDEX(i, n)
|
||||||
|
@ -10,7 +10,7 @@ let
|
|||||||
, darwin, glfw3, SDL2, SDL2_image, SDL2_gfx, SDL2_mixer, SDL2_ttf
|
, darwin, glfw3, SDL2, SDL2_image, SDL2_gfx, SDL2_mixer, SDL2_ttf
|
||||||
, clang , makeWrapper
|
, clang , makeWrapper
|
||||||
|
|
||||||
, libXext, libXcursor, libXinerama, libXi, libXrandr, libXScrnSaver, libXxf86vm
|
, libXext, libXcursor, libXinerama, libXi, libXrandr, libXScrnSaver, libXxf86vm, libpthreadstubs, libXdmcp, libGL
|
||||||
}:
|
}:
|
||||||
mkDerivation {
|
mkDerivation {
|
||||||
pname = "CarpHask";
|
pname = "CarpHask";
|
||||||
@ -29,7 +29,7 @@ let
|
|||||||
];
|
];
|
||||||
pkgconfigDepends =
|
pkgconfigDepends =
|
||||||
[ glfw3 SDL2 SDL2_image SDL2_gfx SDL2_mixer SDL2_ttf ]
|
[ 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 = [
|
executableHaskellDepends = [
|
||||||
base cmdargs containers directory haskeline parsec process
|
base cmdargs containers directory haskeline parsec process
|
||||||
clang
|
clang
|
||||||
|
@ -438,7 +438,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ref String a)] (Ptr Char))
|
(Fn [(Ref String a)] (Ptr CChar))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -535,7 +535,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr Char)] String)
|
(Fn [(Ptr CChar)] String)
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
|
@ -66,7 +66,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr Char)] (Ptr SDL_Surface))
|
(Fn [(Ptr CChar)] (Ptr SDL_Surface))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -85,7 +85,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr SDL_Renderer), (Ptr Char)] (Ptr SDL_Texture))
|
(Fn [(Ptr SDL_Renderer), (Ptr CChar)] (Ptr SDL_Texture))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
|
@ -142,7 +142,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [] (Ptr Char))
|
(Fn [] (Ptr CChar))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -161,7 +161,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [Int] (Ptr Char))
|
(Fn [Int] (Ptr CChar))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -199,7 +199,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr Char)] (Ptr Mix_Music))
|
(Fn [(Ptr CChar)] (Ptr Mix_Music))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -218,7 +218,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr Char)] (Ptr Mix_Chunk))
|
(Fn [(Ptr CChar)] (Ptr Mix_Chunk))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
|
@ -959,7 +959,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr SDL_Window), (Ptr Char)] ())
|
(Fn [(Ptr SDL_Window), (Ptr CChar)] ())
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
|
@ -85,7 +85,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [] (Ptr Char))
|
(Fn [] (Ptr cChar))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -142,7 +142,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr Char), Int] (Ptr TTF_Font))
|
(Fn [(Ptr CChar), Int] (Ptr TTF_Font))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -180,7 +180,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface))
|
(Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -199,7 +199,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color, Int] (Ptr SDL_Surface))
|
(Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color, Int] (Ptr SDL_Surface))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -218,7 +218,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(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))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
@ -237,7 +237,7 @@
|
|||||||
external
|
external
|
||||||
</div>
|
</div>
|
||||||
<p class="sig">
|
<p class="sig">
|
||||||
(Fn [(Ptr TTF_Font), (Ptr Char), SDL_Color] (Ptr SDL_Surface))
|
(Fn [(Ptr TTF_Font), (Ptr CChar), SDL_Color] (Ptr SDL_Surface))
|
||||||
</p>
|
</p>
|
||||||
<span>
|
<span>
|
||||||
|
|
||||||
|
@ -47,4 +47,4 @@
|
|||||||
(do (set! font (TTF.open-font (cstr "resources/Hasklig.otf") 20))
|
(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)))
|
(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))
|
(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)))))))
|
||||||
|
@ -33,16 +33,16 @@
|
|||||||
(do
|
(do
|
||||||
(let [flags Mixer.mp3-support]
|
(let [flags Mixer.mp3-support]
|
||||||
(when (/= flags (Mixer.init flags))
|
(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))
|
(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")))
|
(set! fx1 (Mixer.load-wav (cstr "resources/fx1.wav")))
|
||||||
(assert (not-null? fx1))
|
(assert (not-null? fx1))
|
||||||
(let-do [n (Mixer.nr-of-music-decoders)]
|
(let-do [n (Mixer.nr-of-music-decoders)]
|
||||||
(println* "Nr of music decoders: " n)
|
(println* "Nr of music decoders: " n)
|
||||||
(for [i 0 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"))]
|
(let-do [music (Mixer.load-music (cstr "resources/song.mp3"))]
|
||||||
(println* "Music is " (if (null? music) "null." "not null."))
|
(println* "Music is " (if (null? music) "null." "not null."))
|
||||||
(println* "Play result: " (Mixer.play-music music -1))
|
(println* "Play result: " (Mixer.play-music music -1))
|
||||||
|
@ -146,7 +146,7 @@ tyToCManglePtr _ LongTy = "Long"
|
|||||||
tyToCManglePtr _ ByteTy = "uint8_t"
|
tyToCManglePtr _ ByteTy = "uint8_t"
|
||||||
tyToCManglePtr _ StringTy = "String"
|
tyToCManglePtr _ StringTy = "String"
|
||||||
tyToCManglePtr _ PatternTy = "Pattern"
|
tyToCManglePtr _ PatternTy = "Pattern"
|
||||||
tyToCManglePtr _ CharTy = "char"
|
tyToCManglePtr _ CharTy = "Char"
|
||||||
tyToCManglePtr _ UnitTy = "void"
|
tyToCManglePtr _ UnitTy = "void"
|
||||||
tyToCManglePtr _ (VarTy x) = x
|
tyToCManglePtr _ (VarTy x) = x
|
||||||
tyToCManglePtr _ (FuncTy argTys retTy _) = "Fn__" ++ joinWithUnderscore (map (tyToCManglePtr True) argTys) ++ "_" ++ tyToCManglePtr True retTy
|
tyToCManglePtr _ (FuncTy argTys retTy _) = "Fn__" ++ joinWithUnderscore (map (tyToCManglePtr True) argTys) ++ "_" ++ tyToCManglePtr True retTy
|
||||||
|
@ -13,8 +13,8 @@
|
|||||||
; these tests are sadly a little unsafe
|
; these tests are sadly a little unsafe
|
||||||
(deftest test
|
(deftest test
|
||||||
(assert-equal test
|
(assert-equal test
|
||||||
1l
|
4l
|
||||||
; we assume that the width of a char is 1
|
; we assume that the width of a char is 4
|
||||||
(width (Array.raw (the (Array Char) [])))
|
(width (Array.raw (the (Array Char) [])))
|
||||||
"Pointer.width works as expected"
|
"Pointer.width works as expected"
|
||||||
)
|
)
|
||||||
|
24
test/unicode.carp
Normal file
24
test/unicode.carp
Normal file
@ -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")
|
||||||
|
)
|
Loading…
Reference in New Issue
Block a user