Scheme playground.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
This repo is archived. You can view files and clone it, but cannot push or open issues/pull-requests.
 
 
 

362 lines
12 KiB

  1. #include <stdio.h>
  2. #include <stdint.h>
  3. #include <chibi/sexp.h> // Interface with Chibi Scheme
  4. #include <SDL2/SDL.h> // SDL2 standard functions
  5. #include <SDL2/SDL2_gfxPrimitives.h> // SDL2 shapes and other handy abstractions.
  6. // Include SDL's audio mixing components
  7. #include <SDL2/SDL_mixer.h>
  8. // Include a .h file containing the math for generating a frequency.
  9. #include "tone.h"
  10. SDL_Window* sdlWindow;
  11. SDL_Renderer* sdlRenderer;
  12. SDL_Texture* sdlTexture;
  13. uint32_t* pixels;
  14. int running = 1;
  15. uint32_t SCREEN_W = 1920/2;
  16. uint32_t SCREEN_H = 1080/2;
  17. // music, a pointer for all our SDL audio objects. My original idea
  18. // was to set this pointer to NULL every time we need to load an audio
  19. // file, but it may be cleaner to have a (make-audio name1 "file.wav")
  20. // function from Scheme, which is callable with (play-audio name1) and
  21. // (ause-audio name1).
  22. Mix_Music *music = NULL;
  23. typedef struct scheme_input {
  24. uint32_t mouse_buttons;
  25. int32_t mouse_x;
  26. int32_t mouse_y;
  27. int32_t keycode;
  28. } scheme_input_t;
  29. static scheme_input_t scheme_input;
  30. void sdl_pixel_put(int x, int y, uint32_t color)
  31. {
  32. *(pixels + y*SCREEN_W + x) = color;
  33. }
  34. static sexp pixel_put(sexp ctx, sexp self, sexp n, sexp sx_x, sexp sx_y, sexp sx_color) {
  35. uint32_t color = (uint32_t)sexp_unbox_fixnum(sx_color);
  36. sdl_pixel_put(sexp_unbox_fixnum(sx_x),sexp_unbox_fixnum(sx_y),(color));
  37. return n;
  38. }
  39. // Scheme function to set the window width/height
  40. static sexp set_window_dimensions(sexp ctx, sexp self, sexp n, sexp sx_height, sexp sx_width) {
  41. uint32_t height = (uint32_t)sexp_uint_value(sx_height);
  42. uint32_t width = (uint32_t)sexp_uint_value(sx_width);
  43. SCREEN_H = height;
  44. SCREEN_W = width;
  45. return SEXP_TRUE;
  46. }
  47. static sexp pixel_rect_fill(sexp ctx, sexp self, sexp n, sexp sx_x, sexp sx_y, sexp sx_x2, sexp sx_y2, sexp sx_color) {
  48. uint32_t color = (uint32_t)sexp_uint_value(sx_color);
  49. uint32_t x = (uint32_t)sexp_uint_value(sx_x);
  50. uint32_t y = (uint32_t)sexp_uint_value(sx_y);
  51. uint32_t w = (uint32_t)sexp_uint_value(sx_x2)-x;
  52. uint32_t h = (uint32_t)sexp_uint_value(sx_y2)-y;
  53. for (int iy=0; iy<h; iy++) {
  54. for (int ix=0; ix<w; ix++) {
  55. sdl_pixel_put(x+ix,y+iy,color);
  56. }
  57. }
  58. return n;
  59. }
  60. // pixel_ellipse_fill, which turns SDL2_gfxPrimitives'
  61. // filledEllipseColor into a Scheme function. This currently does not
  62. // work properly. You can call it but the most that it will be able to
  63. // display is a single pixel. Will probably be fixed soon.
  64. static sexp pixel_ellipse_fill(sexp ctx, sexp self, sexp n, sexp sx_x, sexp sx_y, sexp sx_w, sexp sx_h, sexp sx_color) {
  65. uint32_t color = (uint32_t)sexp_uint_value(sx_color);
  66. uint32_t x = (uint32_t)sexp_uint_value(sx_x);
  67. uint32_t y = (uint32_t)sexp_uint_value(sx_y);
  68. uint32_t w = (uint32_t)sexp_uint_value(sx_w);
  69. uint32_t h = (uint32_t)sexp_uint_value(sx_h);
  70. uint8_t coloro[4];
  71. coloro[3] = (color & 0x000000ff);
  72. coloro[2] = (color & 0x0000ff00) >> 8;
  73. coloro[1] = (color & 0x00ff0000) >> 16;
  74. coloro[0] = (color & 0xff000000) >> 24;
  75. filledEllipseRGBA(sdlRenderer, x, y, w, h, coloro[0], coloro[1], coloro[2], coloro[3]);
  76. return n;
  77. }
  78. // stroke_line, a simple function for drawing a line.
  79. // color is a uint32_t, like 0xFF00FFFF, but SDL_SetRenderDrawColor
  80. // takes 4 Uint8's as parameters, so we want to split our uint32 into
  81. // 4 uint8's, and use the 4 fractions as arguments for the color.
  82. // Note that you MUST also specify the alpha by using 8-bits
  83. // (like 0xFFFFFFFF instead of 0xFFFFFF or 0xFFF).
  84. void sdl_stroke_line(int x1, int y1, int x2, int y2, uint32_t color) {
  85. uint8_t coloro[4]; // array of colors, a Uint32_t split into 4-parts.
  86. coloro[3] = (color & 0x000000ff);
  87. coloro[2] = (color & 0x0000ff00) >> 8;
  88. coloro[1] = (color & 0x00ff0000) >> 16;
  89. coloro[0] = (color & 0xff000000) >> 24;
  90. SDL_SetRenderDrawColor(sdlRenderer, coloro[0], coloro[1], coloro[2], coloro[3]);
  91. SDL_RenderDrawLine(sdlRenderer, x1, y1, x2, y2); // Draw the line.
  92. }
  93. // This is the s-expression function to call sdl_stroke_line.
  94. // Maybe we should make a sexp->uint32_t convert function
  95. // for readability in the future.
  96. sexp stroke_line(sexp ctx, sexp self, sexp n, sexp sx_x1,
  97. sexp sx_y1, sexp sx_x2, sexp sx_y2, sexp sx_color) {
  98. uint32_t color = (uint32_t)sexp_uint_value(sx_color);
  99. uint32_t x1 = sexp_unbox_fixnum(sx_x1);
  100. uint32_t y1 = sexp_unbox_fixnum(sx_y1);
  101. uint32_t x2 = sexp_unbox_fixnum(sx_x2);
  102. uint32_t y2 = sexp_unbox_fixnum(sx_y2);
  103. sdl_stroke_line(x1, y1, x2, y2, (color));
  104. // returning n yields a segmentation fault.
  105. // using sx_x1 just because it works.
  106. return sx_x1;
  107. }
  108. sexp get_mouse_x(sexp ctx, sexp self, sexp n) {
  109. return sexp_make_integer(ctx, scheme_input.mouse_x);
  110. }
  111. sexp get_mouse_y(sexp ctx, sexp self, sexp n) {
  112. return sexp_make_integer(ctx, scheme_input.mouse_y);
  113. }
  114. sexp get_mouse_buttons(sexp ctx, sexp self, sexp n) {
  115. return sexp_make_integer(ctx, scheme_input.mouse_buttons);
  116. }
  117. sexp get_key(sexp ctx, sexp self, sexp n) {
  118. return sexp_make_integer(ctx, scheme_input.keycode);
  119. }
  120. ////////////////////// BEGIN MAIN AUDIO CODE
  121. // generate_tone, allows us to make a beep sound from Scheme, with:
  122. // (generate-tone 440.0 0.5) ;;440Hz is the key of A, 0.5 seconds.
  123. // Requires much more testing.
  124. static sexp generate_tone(sexp ctx, sexp self, sexp n,
  125. sexp sx_tone, sexp sx_duration) {
  126. float tone = (float)sexp_flonum_value(sx_tone);
  127. float duration = (float)sexp_flonum_value(sx_duration);
  128. sdl_generate_tone(tone, duration);
  129. return SEXP_TRUE;
  130. }
  131. // Load a WAV file. 'filename' is the wav file,
  132. // loopp is a number specifying whether the audio
  133. // should loop forever.
  134. int sdl_play_wav_file(char* filename, int loopp) {
  135. //INIT AUDIO
  136. if (Mix_OpenAudio(44100, MIX_DEFAULT_FORMAT, 2, 2048) < 0) {
  137. printf("Can't start SDL_mixer! %s\n", Mix_GetError());
  138. return 1;
  139. }
  140. music = Mix_LoadMUS(filename);
  141. Mix_PlayMusic(music, loopp);
  142. if (music == NULL) {
  143. printf("Can't start music! %s\n", Mix_GetError());
  144. return 1;
  145. }
  146. return 0;
  147. }
  148. // The S-Expression version of sdl_play_wav_file,
  149. // that we provide to Scheme.
  150. sexp play_wav_file(sexp ctx, sexp self, sexp n,
  151. sexp filename, sexp sx_loopp) {
  152. uint32_t loopp = sexp_unbox_fixnum(sx_loopp);
  153. char* filen = sexp_string_data(filename);
  154. sdl_play_wav_file(filen, loopp);
  155. return n;
  156. }
  157. ////////////////////// END OF AUDIO SECTION
  158. // 'provide', a shortcut for sexp_define_foreign.
  159. void provide(sexp ctx, sexp env, char* name, int num_args, int return_type, void* func) {
  160. sexp op = sexp_define_foreign(ctx, env, name, num_args, func);
  161. if (sexp_opcodep(op)) {
  162. if (return_type == 0) {
  163. sexp_opcode_return_type(op) = SEXP_VOID;
  164. } else {
  165. sexp_opcode_return_type(op) = SEXP_OBJECT;
  166. }
  167. } else {
  168. printf("could not register %s!\n", name);
  169. }
  170. }
  171. // This is where we send C functions to be used in Scheme.
  172. // TODO: 'provide' might be too generic of a name
  173. // (and thus, may conflict in the future).
  174. void scheme_define_ops(sexp ctx, sexp env) {
  175. provide(ctx, env, "pixel-put", 3, 0, (sexp_proc4)pixel_put);
  176. provide(ctx, env, "stroke-line", 5, 0, (sexp_proc6)stroke_line);
  177. provide(ctx, env, "pixel-rect-fill", 5, 0, (sexp_proc6)pixel_rect_fill);
  178. provide(ctx, env, "pixel-ellipse-fill", 5, 0, (sexp_proc6)pixel_ellipse_fill);
  179. provide(ctx, env, "set-window-dimensions!", 2, 0, (sexp_proc1)set_window_dimensions);
  180. provide(ctx, env, "mouse-x", 0, 1, (sexp_proc1)get_mouse_x);
  181. provide(ctx, env, "mouse-y", 0, 1, (sexp_proc1)get_mouse_y);
  182. provide(ctx, env, "mouse-buttons", 0, 1, (sexp_proc1)get_mouse_buttons);
  183. provide(ctx, env, "keyboard", 0, 1, (sexp_proc1)get_key);
  184. provide(ctx, env, "play-wav-file", 2, 0, (sexp_proc1)play_wav_file);
  185. provide(ctx, env, "generate-tone", 2, 0, (sexp_proc1)generate_tone);
  186. }
  187. void scheme_loop(sexp ctx) {
  188. // TODO: record elapsed time and input events and pass to main function for animation stuff?
  189. SDL_UpdateTexture(sdlTexture, NULL, pixels, SCREEN_W * sizeof(uint32_t));
  190. SDL_RenderCopy(sdlRenderer, sdlTexture, NULL, NULL);
  191. // evaluate the (main) function and print any errors
  192. sexp res;
  193. res = sexp_eval_string(ctx, "(main)", -1, NULL);
  194. if (sexp_exceptionp(res)) {
  195. sexp_print_exception(ctx, res, sexp_current_error_port(ctx));
  196. }
  197. SDL_RenderPresent(sdlRenderer);
  198. }
  199. int main(int argc, char** argv) {
  200. sexp ctx;
  201. SDL_Event event;
  202. sexp_scheme_init();
  203. ctx = sexp_make_eval_context(NULL, NULL, NULL, 1024*1024*64, 1024*1024*1024);
  204. sexp res;
  205. res = sexp_load_standard_env(ctx, NULL, SEXP_SEVEN);
  206. if (sexp_exceptionp (res)) {
  207. sexp_print_exception(ctx, res, sexp_current_error_port(ctx));
  208. exit(1);
  209. }
  210. sexp_load_standard_ports(ctx, NULL, stdin, stdout, stderr, 1);
  211. scheme_define_ops(ctx, sexp_context_env(ctx));
  212. sexp_gc_var1(obj1);
  213. sexp_gc_preserve1(ctx, obj1);
  214. if (argc == 2) { // If the user specified a file
  215. obj1 = sexp_c_string(ctx, argv[1], -1);
  216. } else if (argc > 2) {
  217. printf("Too many arguments!\n");
  218. } else { // If 0 arguments, use the default file.
  219. obj1 = sexp_c_string(ctx, "./init.scm", -1);
  220. }
  221. SDL_UpdateTexture(sdlTexture, NULL, pixels, SCREEN_W * sizeof(uint32_t));
  222. SDL_RenderCopy(sdlRenderer, sdlTexture, NULL, NULL);
  223. /*If the Scheme file has errors in it, we want to print those errors
  224. to the console. We put each Scheme operation in a 'result' variable
  225. (res), which is passed to sexp_exceptionp() to check for errors. */
  226. res = sexp_load(ctx, obj1, NULL); // Load obj1, the Scheme file
  227. if (sexp_exceptionp (res)) { // If there was an exception (error)
  228. // Print the error to the current error port.
  229. sexp_print_exception(ctx, res, sexp_current_error_port(ctx));
  230. exit(1);
  231. }
  232. // Initialize the SDL video/audio components.
  233. if (SDL_Init(SDL_INIT_VIDEO | SDL_INIT_AUDIO) < 0) {
  234. printf("Couldn't initialize SDL! %s\n", SDL_GetError());
  235. return 1;
  236. }
  237. // Uncommenting the following two lines turns on pixel smoothing.
  238. // SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "linear");
  239. // SDL_GL_SetAttribute(SDL_GL_MULTISAMPLEBUFFERS, 1);
  240. // The SDL window defines the window title, position, and size,
  241. // along with how to render it.
  242. sdlWindow = SDL_CreateWindow("SomeTitle",
  243. SDL_WINDOWPOS_UNDEFINED,
  244. SDL_WINDOWPOS_UNDEFINED,
  245. SCREEN_W, SCREEN_H,
  246. SDL_WINDOW_OPENGL);
  247. if (!sdlWindow) {
  248. printf("Can't open window! %s\n", SDL_GetError());
  249. return 1;
  250. }
  251. // The SDL renderer describes what window to draw on, -1
  252. // automatically picks the rendering driver to initialize, and
  253. // "SDL_RENDERER_ACCELERATED | SDL_RENDERER_PRESENTVSYNC" specify to
  254. // match the FPS to the monitor framerate. Note that
  255. // SDL_RENDERER_PRESENTVSYNC is not present. This flag slows down
  256. // the rendering too much and needs further testing.
  257. sdlRenderer = SDL_CreateRenderer(sdlWindow, -1, SDL_RENDERER_ACCELERATED);
  258. if (!sdlRenderer) {
  259. printf("Can't start renderer! %s\n", SDL_GetError());
  260. return 1;
  261. }
  262. // Create a texture as big as the screen.
  263. // The texture is the actual pixel data.
  264. sdlTexture = SDL_CreateTexture(sdlRenderer,
  265. SDL_PIXELFORMAT_ARGB8888,
  266. SDL_TEXTUREACCESS_STREAMING,
  267. SCREEN_W, SCREEN_H);
  268. SDL_RenderSetLogicalSize(sdlRenderer, SCREEN_W, SCREEN_H);
  269. pixels = (uint32_t*)malloc(SCREEN_W*SCREEN_H*sizeof(uint32_t));
  270. // The game loop starts here.
  271. while (running) {
  272. if (SDL_PollEvent(&event)) {
  273. switch (event.type) {
  274. case SDL_QUIT:
  275. running = 0;
  276. break;
  277. case SDL_KEYDOWN:
  278. {
  279. int c = event.key.keysym.sym;
  280. // FIXME this is obvs. very primitive (only 1 key allowed at a time)
  281. scheme_input.keycode = c;
  282. if (c==27) {
  283. // Escape
  284. running = 0;
  285. }
  286. break;
  287. }
  288. case SDL_KEYUP:
  289. {
  290. int c = event.key.keysym.sym;
  291. scheme_input.keycode = 0;
  292. break;
  293. }
  294. case SDL_MOUSEMOTION:
  295. {
  296. scheme_input.mouse_x = event.motion.x;
  297. scheme_input.mouse_y = event.motion.y;
  298. break;
  299. }
  300. case SDL_MOUSEBUTTONDOWN:
  301. {
  302. scheme_input.mouse_buttons |= (1<<(event.button.button-1));
  303. break;
  304. }
  305. case SDL_MOUSEBUTTONUP:
  306. {
  307. scheme_input.mouse_buttons &= ~(1<<(event.button.button-1));
  308. break;
  309. }
  310. }
  311. }
  312. scheme_loop(ctx);
  313. }
  314. sexp_destroy_context(ctx);
  315. SDL_Quit();
  316. free(pixels);
  317. }