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.
 
 
 

121 lines
3.4 KiB

  1. #include <stdio.h>
  2. #include <stdint.h>
  3. #include <chibi/sexp.h>
  4. #include <SDL2/SDL.h>
  5. #define SCREEN_W 1920/2
  6. #define SCREEN_H 1080/2
  7. SDL_Window* sdlWindow;
  8. SDL_Renderer* sdlRenderer;
  9. SDL_Texture* sdlTexture;
  10. uint32_t* pixels;
  11. int running = 1;
  12. void sdl_pixel_put(int x, int y, uint32_t color)
  13. {
  14. *(pixels + y*SCREEN_W + x) = color;
  15. }
  16. static sexp pixel_put(sexp ctx, sexp self, sexp n, sexp sx_x, sexp sx_y, sexp sx_color) {
  17. uint32_t color = (uint32_t)sexp_unbox_fixnum(sx_color);
  18. sdl_pixel_put(sexp_unbox_fixnum(sx_x),sexp_unbox_fixnum(sx_y),(color));
  19. return n;
  20. }
  21. 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) {
  22. uint32_t color = (uint32_t)sexp_uint_value(sx_color);
  23. uint32_t x = (uint32_t)sexp_uint_value(sx_x);
  24. uint32_t y = (uint32_t)sexp_uint_value(sx_y);
  25. uint32_t w = (uint32_t)sexp_uint_value(sx_x2)-x;
  26. uint32_t h = (uint32_t)sexp_uint_value(sx_y2)-y;
  27. for (int iy=0; iy<h; iy++) {
  28. for (int ix=0; ix<w; ix++) {
  29. sdl_pixel_put(x+ix,y+iy,color);
  30. }
  31. }
  32. return n;
  33. }
  34. void scheme_define_ops(sexp ctx, sexp env) {
  35. sexp op = sexp_define_foreign(ctx, env, "pixel-put", 3, (sexp_proc3)pixel_put);
  36. if (sexp_opcodep(op)) {
  37. sexp_opcode_return_type(op) = SEXP_VOID;
  38. } else {
  39. printf("could not register pixel-put!\n");
  40. }
  41. op = sexp_define_foreign(ctx, env, "pixel-rect-fill", 3, (sexp_proc5)pixel_rect_fill);
  42. if (sexp_opcodep(op)) {
  43. sexp_opcode_return_type(op) = SEXP_VOID;
  44. } else {
  45. printf("could not register pixel-rect-fill!\n");
  46. }
  47. }
  48. void scheme_loop(sexp ctx) {
  49. // TODO: error handling
  50. // TODO: record elapsed time and input events and pass to main function for animation stuff?
  51. sexp_eval_string(ctx, "(main)", -1, NULL);
  52. //sdl_pixel_put(20,20,0xffffff);
  53. SDL_UpdateTexture(sdlTexture, NULL, pixels, SCREEN_W * sizeof(uint32_t));
  54. SDL_RenderCopy(sdlRenderer, sdlTexture, NULL, NULL);
  55. SDL_RenderPresent(sdlRenderer);
  56. }
  57. int main(int argc, char** argv) {
  58. sexp ctx;
  59. SDL_Event event;
  60. if (SDL_Init(SDL_INIT_VIDEO) < 0) return 1;
  61. SDL_CreateWindowAndRenderer(SCREEN_W, SCREEN_H, 0, &sdlWindow, &sdlRenderer);
  62. sdlTexture = SDL_CreateTexture(sdlRenderer,
  63. SDL_PIXELFORMAT_ARGB8888,
  64. SDL_TEXTUREACCESS_STREAMING,
  65. SCREEN_W, SCREEN_H);
  66. //SDL_SetHint(SDL_HINT_RENDER_SCALE_QUALITY, "linear"); // make the scaled rendering look smoother.
  67. SDL_RenderSetLogicalSize(sdlRenderer, SCREEN_W, SCREEN_H);
  68. pixels = (uint32_t*)malloc(SCREEN_W*SCREEN_H*sizeof(uint32_t));
  69. sexp_scheme_init();
  70. ctx = sexp_make_eval_context(NULL, NULL, NULL, 1024*1024, 1024*1024);
  71. sexp_load_standard_env(ctx, NULL, SEXP_SEVEN);
  72. sexp_load_standard_ports(ctx, NULL, stdin, stdout, stderr, 1);
  73. scheme_define_ops(ctx, sexp_context_env(ctx));
  74. sexp_gc_var1(obj1);
  75. sexp_gc_preserve1(ctx, obj1);
  76. obj1 = sexp_c_string(ctx, "./init.scm", -1);
  77. sexp_load(ctx, obj1, NULL);
  78. while (running) {
  79. scheme_loop(ctx);
  80. if (SDL_PollEvent(&event)) {
  81. switch (event.type) {
  82. case SDL_QUIT:
  83. running = 0;
  84. break;
  85. case SDL_KEYDOWN:
  86. {
  87. int c = event.key.keysym.sym;
  88. printf("key: %d\n",c);
  89. if (c==27) {
  90. // esc
  91. running = 0;
  92. }
  93. break;
  94. }
  95. }
  96. }
  97. }
  98. sexp_destroy_context(ctx);
  99. SDL_Quit();
  100. free(pixels);
  101. }