6 Commits 9cae221217 ... 051dd62a37

Author SHA1 Message Date
  Andrew Whatson 051dd62a37 Add generated C source for game-of-life 2 months ago
  Andrew Whatson 6a8db54831 Add game-of-life demo with ps-grid, ps-sdl2 libs 2 months ago
  Andrew Whatson 93fdd02467 Update generated C sources 2 months ago
  Andrew Whatson e310553387 Tidy up headers and package definitions 2 months ago
  Andrew Whatson a5ab624708 Remove NO_ERRORS definition, fixed upstream 2 months ago
  Andrew Whatson e86253fc26 Update manifest to use latest scheme48-r7rs and prescheme 2 months ago
10 changed files with 648 additions and 8 deletions
  1. 1 1
      .gitignore
  2. 34 3
      Makefile
  3. 5 1
      README.org
  4. 1 1
      append.c
  5. 1 1
      btree.c
  6. 467 0
      game-of-life.c
  7. 133 0
      game-of-life.scm
  8. 1 1
      hello.c
  9. 5 0
      include/ps-init.h
  10. 0 0
      include/ps-sdl2.h

+ 1 - 1
.gitignore

@@ -3,5 +3,5 @@
 /recfun
 /recfun
 /vecfun
 /vecfun
 /btree
 /btree
-/ps-compiler.image
+/game-of-life
 /compile_commands.json
 /compile_commands.json

+ 34 - 3
Makefile

@@ -8,15 +8,22 @@ CFLAGS=-g -Wall
 CFLAGS+=$(shell pkg-config --cflags prescheme)
 CFLAGS+=$(shell pkg-config --cflags prescheme)
 LDLIBS+=$(shell pkg-config --libs prescheme)
 LDLIBS+=$(shell pkg-config --libs prescheme)
 
 
+SDL2_CFLAGS=$(shell pkg-config --cflags sdl2)
+SDL2_LDLIBS=$(shell pkg-config --libs sdl2)
+
 SOURCES= packages.scm \
 SOURCES= packages.scm \
          lib/ps-string.scm \
          lib/ps-string.scm \
-         lib/ps-vector.scm
+         lib/ps-vector.scm \
+         lib/ps-utils.scm \
+         lib/ps-grid.scm \
+         lib/ps-sdl2.scm
 
 
 TARGETS= hello \
 TARGETS= hello \
          append \
          append \
          vecfun \
          vecfun \
          recfun \
          recfun \
-         btree
+         btree \
+         game-of-life
 
 
 all: $(TARGETS)
 all: $(TARGETS)
 
 
@@ -24,7 +31,7 @@ all: $(TARGETS)
 	rm -f $@
 	rm -f $@
 	( echo ",batch"; \
 	( echo ",batch"; \
 	  echo "(prescheme-compiler '$* '(\"packages.scm\") 'ps-init \"$@\""; \
 	  echo "(prescheme-compiler '$* '(\"packages.scm\") 'ps-init \"$@\""; \
-	  echo " '(header \"#include \\\"ps-init.h\\\"\")"; \
+	  echo " '(header \"#include \\\"include/ps-init.h\\\"\")"; \
 	  echo " '(copy (ps-vector vector-unfold1))"; \
 	  echo " '(copy (ps-vector vector-unfold1))"; \
 	  echo " '(copy (ps-vector vector-unfold2))"; \
 	  echo " '(copy (ps-vector vector-unfold2))"; \
 	  echo " '(copy (ps-vector vector-unfold3))"; \
 	  echo " '(copy (ps-vector vector-unfold3))"; \
@@ -45,11 +52,35 @@ all: $(TARGETS)
 	| $(PRESCHEME)
 	| $(PRESCHEME)
 	$(FORMAT) $@
 	$(FORMAT) $@
 
 
+game-of-life.c: game-of-life.scm $(SOURCES)
+	rm -f $@
+	( echo ",batch"; \
+	  echo "(prescheme-compiler '$* '(\"packages.scm\") 'ps-init \"$@\""; \
+	  echo " '(header \"#include \\\"include/ps-init.h\\\"\")"; \
+	  echo " '(header \"#include \\\"include/ps-sdl2.h\\\"\")"; \
+	  echo " '(header \"#include <time.h>\")"; \
+	  echo " '(copy (ps-grid grid-index))"; \
+	  echo " '(copy (ps-grid grid-fold))"; \
+	  echo " '(copy (ps-grid grid-for-each))"; \
+	  echo " '(copy (ps-grid grid-update!))"; \
+	  echo " '(copy (ps-grid grid-unfold))"; \
+	  echo ")"; \
+	  echo ",exit" ) \
+	| $(PRESCHEME)
+	$(FORMAT) $@
+
+game-of-life.o: game-of-life.c
+	$(CC) $(CPPFLAGS) $(CFLAGS) $(SDL2_CFLAGS) -c $^ -o $@
+
+game-of-life: game-of-life.o
+	$(CC) $(LDFLAGS) $^ $(LDLIBS) $(SDL2_LDLIBS) -o $@
+
 clean:
 clean:
 	rm -f $(TARGETS)
 	rm -f $(TARGETS)
 	rm -f $(TARGETS:=.o)
 	rm -f $(TARGETS:=.o)
 	rm -f $(TARGETS:=.c)
 	rm -f $(TARGETS:=.c)
 
 
 .PRECIOUS: $(TARGETS:=.c)
 .PRECIOUS: $(TARGETS:=.c)
+.INTERMEDIATE: game-of-life.o
 
 
 .PHONY: all clean
 .PHONY: all clean

+ 5 - 1
README.org

@@ -10,14 +10,18 @@ https://groups.scheme.org/prescheme/1.3/
 ** Source files
 ** Source files
 
 
 - packages.scm - package definitions
 - packages.scm - package definitions
+- lib/ps-utils.scm - utility macros
 - lib/ps-string.scm - string utility functions
 - lib/ps-string.scm - string utility functions
 - lib/ps-vector.scm - vector functions based on SRFI-43
 - lib/ps-vector.scm - vector functions based on SRFI-43
+- lib/ps-grid.scm - an ASCII grid data-type
+- lib/ps-sdl2.scm - minimal SDL2 bindings
 
 
 - hello.scm - "Hello World" in Pre-Scheme, from the manual
 - hello.scm - "Hello World" in Pre-Scheme, from the manual
 - append.scm - Yes, you can string-append in Pre-Scheme
 - append.scm - Yes, you can string-append in Pre-Scheme
 - vecfun.scm - Showing off Pre-Scheme polymorphism with vectors
 - vecfun.scm - Showing off Pre-Scheme polymorphism with vectors
 - recfun.scm - Simple demonstration of records (structs)
 - recfun.scm - Simple demonstration of records (structs)
 - btree.scm - Example of a recursive record type
 - btree.scm - Example of a recursive record type
+- game-of-life.scm - Conway's Game of Life in Pre-Scheme with SDL2
 
 
 The generated C for each of the demo programs is also included, so you
 The generated C for each of the demo programs is also included, so you
 can review the code generation without needing to build anything.
 can review the code generation without needing to build anything.
@@ -30,7 +34,7 @@ compilation is handled by the Makefile.
 To build the demos yourself:
 To build the demos yourself:
 
 
 #+BEGIN_SRC sh
 #+BEGIN_SRC sh
-git clone https://notabug.org/flatwhatson/prescheme-demo.git
+git clone https://codeberg.org/prescheme/prescheme-demo.git
 cd prescheme-demo
 cd prescheme-demo
 guix shell -m manifest.scm
 guix shell -m manifest.scm
 make
 make

+ 1 - 1
append.c

@@ -1,5 +1,5 @@
+#include "include/ps-init.h"
 #include "prescheme.h"
 #include "prescheme.h"
-#include "ps-init.h"
 #include <stdio.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <stdlib.h>
 #include <string.h>
 #include <string.h>

+ 1 - 1
btree.c

@@ -1,5 +1,5 @@
+#include "include/ps-init.h"
 #include "prescheme.h"
 #include "prescheme.h"
-#include "ps-init.h"
 #include <stdio.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <stdlib.h>
 #include <string.h>
 #include <string.h>

+ 467 - 0
game-of-life.c

@@ -0,0 +1,467 @@
+#include "include/ps-init.h"
+#include "include/ps-sdl2.h"
+#include "prescheme.h"
+#include <stdio.h>
+#include <stdlib.h>
+#include <string.h>
+#include <time.h>
+
+struct sdl_window {};
+struct sdl_renderer {};
+struct sdl_event {};
+struct grid {
+  long width;
+  long height;
+  long size;
+  char *front_buffer;
+  char *back_buffer;
+};
+static long handle_sdl_error(char *);
+long main(long, char **);
+
+static long handle_sdl_error(char *message_0X) {
+  char *v_2X;
+  FILE *out_1X;
+  {
+    out_1X = stderr;
+    ps_write_string(message_0X, out_1X);
+    ps_write_string(": ", out_1X);
+    v_2X = SDL_GetError();
+    ps_write_string(v_2X, out_1X);
+    {
+      long ignoreXX;
+      PS_WRITE_CHAR(10, out_1X, ignoreXX)
+    }
+    return -1;
+  }
+}
+long main(long argc_3X, char **argv_4X) {
+  char arg3K0;
+  long arg1K2;
+  long arg1K1;
+  long arg1K0;
+  struct grid *arg0K0;
+  long merged_arg1K2;
+  long merged_arg1K1;
+  struct grid *merged_arg0K0;
+
+#ifdef USE_DIRECT_THREADING
+  void *grid_ref_return_address;
+#else
+  int grid_ref_return_tag;
+#endif
+  long grid_ref0_return_value;
+  struct grid *grid_5X;
+  long x_6X;
+  long y_7X;
+  long y_57X;
+  long rem_56X;
+  long m_55X;
+  long x_54X;
+  long rem_53X;
+  long m_52X;
+  long value_51X;
+  long y_50X;
+  long x_49X;
+  long ix_48X;
+  long live_neighbours_47X;
+  long south_west_46X;
+  long north_45X;
+  long south_44X;
+  long east_43X;
+  long west_42X;
+  long north_east_41X;
+  long north_west_40X;
+  long south_east_39X;
+  long value_38X;
+  long height_37X;
+  long width_36X;
+  char *tmp_35X;
+  long y_34X;
+  long x_33X;
+  long ix_32X;
+  long height_31X;
+  long width_30X;
+  long v_29X;
+  long n_28X;
+  char runningP_27X;
+  long value_26X;
+  long v_25X;
+  char *tmp_24X;
+  long y_23X;
+  long x_22X;
+  long ix_21X;
+  long height_20X;
+  long width_19X;
+  struct grid *grid_18X;
+  long result_17X;
+  long result_16X;
+  struct grid *grid_15X;
+  long v_14X;
+  struct sdl_event *event_13X;
+  long result_12X;
+  struct sdl_renderer *renderer_11X;
+  long result_10X;
+  struct sdl_window *window_9X;
+  long n_8X;
+  {
+    n_8X = SDL_Init(SDL_INIT_VIDEO);
+    if ((0 == n_8X)) {
+      window_9X = PS_SDL_CreateWindow(
+          "Conway's Game of Life", SDL_WINDOWPOS_CENTERED,
+          SDL_WINDOWPOS_CENTERED, 1280, 800, SDL_WINDOW_SHOWN);
+      if ((NULL == window_9X)) {
+        result_10X = handle_sdl_error("Could not create window");
+        arg1K0 = result_10X;
+        goto L1161;
+      } else {
+        renderer_11X =
+            PS_SDL_CreateRenderer(window_9X, -1, SDL_RENDERER_ACCELERATED);
+        if ((NULL == renderer_11X)) {
+          result_12X = handle_sdl_error("Could not create renderer");
+          arg1K0 = result_12X;
+          goto L1180;
+        } else {
+          event_13X = PS_SDL_CreateEvent();
+          v_14X = time(0);
+          srand(v_14X);
+          grid_15X = (struct grid *)malloc(sizeof(struct grid));
+          if ((NULL == grid_15X)) {
+            arg0K0 = grid_15X;
+            goto L1015;
+          } else {
+            grid_15X->width = 256;
+            grid_15X->height = 160;
+            grid_15X->size = 40960;
+            grid_15X->front_buffer = ((char *)malloc(sizeof(char) * 40960));
+            grid_15X->back_buffer = ((char *)malloc(sizeof(char) * 40960));
+            arg0K0 = grid_15X;
+            goto L1015;
+          }
+        }
+      }
+    } else {
+      return handle_sdl_error("Could not initialize SDL");
+    }
+  }
+L1161 : {
+  result_16X = arg1K0;
+  SDL_Quit();
+  return result_16X;
+}
+L1180 : {
+  result_17X = arg1K0;
+  PS_SDL_DestroyWindow(window_9X);
+  arg1K0 = result_17X;
+  goto L1161;
+}
+L1015 : {
+  grid_18X = arg0K0;
+  width_19X = grid_18X->width;
+  height_20X = grid_18X->height;
+  arg1K0 = 0;
+  arg1K1 = 0;
+  arg1K2 = 0;
+  goto L1027;
+}
+L1027 : {
+  ix_21X = arg1K0;
+  x_22X = arg1K1;
+  y_23X = arg1K2;
+  if ((y_23X == height_20X)) {
+    tmp_24X = grid_18X->front_buffer;
+    grid_18X->front_buffer = (grid_18X->back_buffer);
+    grid_18X->back_buffer = tmp_24X;
+    arg3K0 = 1;
+    goto L1056;
+  } else {
+    if ((x_22X == width_19X)) {
+      arg1K0 = ix_21X;
+      arg1K1 = 0;
+      arg1K2 = (1 + y_23X);
+      goto L1027;
+    } else {
+      v_25X = rand();
+      value_26X = v_25X % 2;
+      *((grid_18X->back_buffer) + ix_21X) = (((char)value_26X));
+      arg1K0 = (1 + ix_21X);
+      arg1K1 = (1 + x_22X);
+      arg1K2 = y_23X;
+      goto L1027;
+    }
+  }
+}
+L1056 : {
+  runningP_27X = arg3K0;
+  if (runningP_27X) {
+    n_28X = PS_SDL_PollEvent(event_13X);
+    if ((1 == n_28X)) {
+      v_29X = PS_SDL_EventType(event_13X);
+      if ((SDL_QUIT == v_29X)) {
+        arg3K0 = 0;
+        goto L1056;
+      } else {
+        arg3K0 = 1;
+        goto L1056;
+      }
+    } else {
+      width_30X = grid_18X->width;
+      height_31X = grid_18X->height;
+      arg1K0 = 0;
+      arg1K1 = 0;
+      arg1K2 = 0;
+      goto L964;
+    }
+  } else {
+    free((grid_18X->front_buffer));
+    free((grid_18X->back_buffer));
+    free(grid_18X);
+    PS_SDL_DestroyEvent(event_13X);
+    PS_SDL_DestroyRenderer(renderer_11X);
+    arg1K0 = 0;
+    goto L1180;
+  }
+}
+L964 : {
+  ix_32X = arg1K0;
+  x_33X = arg1K1;
+  y_34X = arg1K2;
+  if ((y_34X == height_31X)) {
+    tmp_35X = grid_18X->front_buffer;
+    grid_18X->front_buffer = (grid_18X->back_buffer);
+    grid_18X->back_buffer = tmp_35X;
+    PS_SDL_SetRenderDrawColor(renderer_11X, 0, 0, 0, 255);
+    PS_SDL_RenderClear(renderer_11X);
+    PS_SDL_SetRenderDrawColor(renderer_11X, 255, 255, 255, 255);
+    width_36X = grid_18X->width;
+    height_37X = grid_18X->height;
+    arg1K0 = 0;
+    arg1K1 = 0;
+    arg1K2 = 0;
+    goto L791;
+  } else {
+    if ((x_33X == width_30X)) {
+      arg1K0 = ix_32X;
+      arg1K1 = 0;
+      arg1K2 = (1 + y_34X);
+      goto L964;
+    } else {
+      value_38X = ((unsigned char)(*((grid_18X->front_buffer) + ix_32X)));
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (1 + x_33X);
+      merged_arg1K2 = (1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_0;
+#else
+      grid_ref_return_tag = 0;
+#endif
+      goto grid_ref;
+    grid_ref_return_0:
+      south_east_39X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (-1 + x_33X);
+      merged_arg1K2 = (-1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_1;
+#else
+      grid_ref_return_tag = 1;
+#endif
+      goto grid_ref;
+    grid_ref_return_1:
+      north_west_40X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (1 + x_33X);
+      merged_arg1K2 = (-1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_2;
+#else
+      grid_ref_return_tag = 2;
+#endif
+      goto grid_ref;
+    grid_ref_return_2:
+      north_east_41X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (-1 + x_33X);
+      merged_arg1K2 = y_34X;
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_3;
+#else
+      grid_ref_return_tag = 3;
+#endif
+      goto grid_ref;
+    grid_ref_return_3:
+      west_42X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (1 + x_33X);
+      merged_arg1K2 = y_34X;
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_4;
+#else
+      grid_ref_return_tag = 4;
+#endif
+      goto grid_ref;
+    grid_ref_return_4:
+      east_43X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = x_33X;
+      merged_arg1K2 = (1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_5;
+#else
+      grid_ref_return_tag = 5;
+#endif
+      goto grid_ref;
+    grid_ref_return_5:
+      south_44X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = x_33X;
+      merged_arg1K2 = (-1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_6;
+#else
+      grid_ref_return_tag = 6;
+#endif
+      goto grid_ref;
+    grid_ref_return_6:
+      north_45X = grid_ref0_return_value;
+      merged_arg0K0 = grid_18X;
+      merged_arg1K1 = (-1 + x_33X);
+      merged_arg1K2 = (1 + y_34X);
+#ifdef USE_DIRECT_THREADING
+      grid_ref_return_address = &&grid_ref_return_7;
+#else
+      grid_ref_return_tag = 7;
+#endif
+      goto grid_ref;
+    grid_ref_return_7:
+      south_west_46X = grid_ref0_return_value;
+      live_neighbours_47X =
+          ((((((north_45X + south_44X) + east_43X) + west_42X) +
+             north_east_41X) +
+            north_west_40X) +
+           south_east_39X) +
+          south_west_46X;
+      if ((1 == value_38X)) {
+        if ((live_neighbours_47X < 2)) {
+          arg1K0 = 0;
+          goto L968;
+        } else {
+          if ((3 < live_neighbours_47X)) {
+            arg1K0 = 0;
+            goto L968;
+          } else {
+            arg1K0 = 1;
+            goto L968;
+          }
+        }
+      } else {
+        if ((3 == live_neighbours_47X)) {
+          arg1K0 = 1;
+          goto L968;
+        } else {
+          arg1K0 = 0;
+          goto L968;
+        }
+      }
+    }
+  }
+}
+L791 : {
+  ix_48X = arg1K0;
+  x_49X = arg1K1;
+  y_50X = arg1K2;
+  if ((y_50X == height_37X)) {
+    PS_SDL_RenderPresent(renderer_11X);
+    SDL_Delay(50);
+    arg3K0 = 1;
+    goto L1056;
+  } else {
+    if ((x_49X == width_36X)) {
+      arg1K0 = ix_48X;
+      arg1K1 = 0;
+      arg1K2 = (1 + y_50X);
+      goto L791;
+    } else {
+      if ((0 == (((unsigned char)(*((grid_18X->front_buffer) + ix_48X)))))) {
+        goto L795;
+      } else {
+        PS_SDL_RenderFillRect(renderer_11X, (5 * x_49X), (5 * y_50X), 5, 5);
+        goto L795;
+      }
+    }
+  }
+}
+L968 : {
+  value_51X = arg1K0;
+  *((grid_18X->back_buffer) + ix_32X) = (((char)value_51X));
+  arg1K0 = (1 + ix_32X);
+  arg1K1 = (1 + x_33X);
+  arg1K2 = y_34X;
+  goto L964;
+}
+L795 : {
+  arg1K0 = (1 + ix_48X);
+  arg1K1 = (1 + x_49X);
+  arg1K2 = y_50X;
+  goto L791;
+}
+grid_ref : {
+  grid_5X = merged_arg0K0;
+  x_6X = merged_arg1K1;
+  y_7X = merged_arg1K2;
+  {
+    m_52X = grid_5X->width;
+    rem_53X = x_6X % m_52X;
+    if ((rem_53X < 0)) {
+      arg1K0 = (rem_53X + m_52X);
+      goto L598;
+    } else {
+      arg1K0 = rem_53X;
+      goto L598;
+    }
+  }
+L598 : {
+  x_54X = arg1K0;
+  m_55X = grid_5X->height;
+  rem_56X = y_7X % m_55X;
+  if ((rem_56X < 0)) {
+    arg1K0 = (rem_56X + m_55X);
+    goto L602;
+  } else {
+    arg1K0 = rem_56X;
+    goto L602;
+  }
+}
+L602 : {
+  y_57X = arg1K0;
+  grid_ref0_return_value = (((unsigned char)(*(
+      (grid_5X->front_buffer) + (x_54X + (y_57X * (grid_5X->width)))))));
+#ifdef USE_DIRECT_THREADING
+  goto *grid_ref_return_address;
+#else
+  goto grid_ref_return;
+#endif
+}
+#ifndef USE_DIRECT_THREADING
+grid_ref_return:
+  switch (grid_ref_return_tag) {
+  case 0:
+    goto grid_ref_return_0;
+  case 1:
+    goto grid_ref_return_1;
+  case 2:
+    goto grid_ref_return_2;
+  case 3:
+    goto grid_ref_return_3;
+  case 4:
+    goto grid_ref_return_4;
+  case 5:
+    goto grid_ref_return_5;
+  case 6:
+    goto grid_ref_return_6;
+  default:
+    goto grid_ref_return_7;
+  }
+#endif
+}
+}

+ 133 - 0
game-of-life.scm

@@ -0,0 +1,133 @@
+;;; game-of-life --- Conway's Game of Life in Pre-Scheme
+
+(define WINDOW_TITLE "Conway's Game of Life")
+(define WINDOW_WIDTH 1280)
+(define WINDOW_HEIGHT 800)
+
+(define CELL_SIZE 5)
+(define FRAME_DELAY 50)
+(define GRID_WIDTH (quotient WINDOW_WIDTH CELL_SIZE))
+(define GRID_HEIGHT (quotient WINDOW_HEIGHT CELL_SIZE))
+
+(define (main argc argv)
+  (ensure-args argc argv)
+  (with-sdl
+   (sdl-init SDL_INIT_VIDEO)
+   (lambda ()
+     (with-sdl-window
+      (sdl-create-window WINDOW_TITLE
+                         SDL_WINDOWPOS_CENTERED
+                         SDL_WINDOWPOS_CENTERED
+                         WINDOW_WIDTH
+                         WINDOW_HEIGHT
+                         SDL_WINDOW_SHOWN)
+      (lambda (window)
+        (with-sdl-renderer
+         (sdl-create-renderer window -1 SDL_RENDERER_ACCELERATED)
+         (lambda (renderer)
+           (with-sdl-event
+            (lambda (event)
+              (run-application window renderer event))))))))))
+
+(define (ensure-args argc argv)
+  ;; type inference hack to get the right signature for main
+  (string-length (vector-ref argv (- argc 1)))
+  (unspecific))
+
+(define (handle-sdl-error message)
+  (define out (current-error-port))
+  (write-string message out)
+  (write-string ": " out)
+  (write-string (sdl-get-error) out)
+  (newline out)
+  -1)
+
+(define (with-sdl initialized? thunk)
+  (if (not initialized?)
+      (handle-sdl-error "Could not initialize SDL")
+      (let ((result (thunk)))
+        (sdl-quit)
+        result)))
+
+(define (with-sdl-window window proc)
+  (if (null-pointer? window)
+      (handle-sdl-error "Could not create window")
+      (let ((result (proc window)))
+        (sdl-destroy-window window)
+        result)))
+
+(define (with-sdl-renderer renderer proc)
+  (if (null-pointer? renderer)
+      (handle-sdl-error "Could not create renderer")
+      (let ((result (proc renderer)))
+        (sdl-destroy-renderer renderer)
+        result)))
+
+(define (with-sdl-event proc)
+  (let* ((event (sdl-create-event))
+         (result (proc event)))
+    (sdl-destroy-event event)
+    result))
+
+(define (run-application window renderer event)
+  (let ((grid (initialize-grid)))
+    (let loop ((running? #t))
+      (when running?
+        (cond ((sdl-poll-event event)
+               (if (= (sdl-event-type event) SDL_QUIT)
+                   (goto loop #f)
+                   (goto loop #t)))
+              (else
+               (update-grid grid)
+               (render-grid grid renderer)
+               (sdl-delay FRAME_DELAY)
+               (goto loop #t)))))
+    (destroy-grid grid)
+    0))
+
+(define (initialize-grid)
+  (define c_srand (external "srand" (=> (integer) unit)))
+  (define c_rand (external "rand" (=> () integer)))
+  (define c_time (external "time" (=> (integer) integer)))
+  (c_srand (c_time 0))
+  (grid-unfold (lambda (ix x y)
+                 (remainder (c_rand) 2))
+               GRID_WIDTH GRID_HEIGHT))
+
+(define (update-grid grid)
+  (grid-update! (lambda (ix x y value)
+                  (let ((north (grid-ref grid x (- y 1)))
+                        (south (grid-ref grid x (+ y 1)))
+                        (east  (grid-ref grid (+ x 1) y))
+                        (west  (grid-ref grid (- x 1) y))
+                        (north-east (grid-ref grid (+ x 1) (- y 1)))
+                        (north-west (grid-ref grid (- x 1) (- y 1)))
+                        (south-east (grid-ref grid (+ x 1) (+ y 1)))
+                        (south-west (grid-ref grid (- x 1) (+ y 1))))
+                    (let ((alive? (one? value))
+                          (live-neighbours (+ north south east west
+                                              north-east north-west
+                                              south-east south-west)))
+                      (if alive?
+                          (cond ((< live-neighbours 2) 0) ;; underpopulation
+                                ((> live-neighbours 3) 0) ;; overpopulation
+                                (else 1))
+                          (cond ((= live-neighbours 3) 1) ;; reproduction
+                                (else 0))))))
+                grid))
+
+(define (render-grid grid renderer)
+  (sdl-set-render-draw-color renderer 0 0 0 255)
+  (sdl-render-clear renderer)
+  (sdl-set-render-draw-color renderer 255 255 255 255)
+  (grid-for-each (lambda (ix x y value)
+                   (unless (zero? value)
+                     (sdl-render-fill-rect renderer
+                                           (* x CELL_SIZE)
+                                           (* y CELL_SIZE)
+                                           CELL_SIZE
+                                           CELL_SIZE)
+                     (unspecific)))
+                 grid)
+  (sdl-render-present renderer)
+  (unspecific))

+ 1 - 1
hello.c

@@ -1,5 +1,5 @@
+#include "include/ps-init.h"
 #include "prescheme.h"
 #include "prescheme.h"
-#include "ps-init.h"
 #include <stdio.h>
 #include <stdio.h>
 #include <stdlib.h>
 #include <stdlib.h>
 #include <string.h>
 #include <string.h>

+ 5 - 0
include/ps-init.h

@@ -0,0 +1,5 @@
+/*
+ * Call Pre-Scheme static initialization before main.
+ */
+__attribute__((constructor))
+void ps_init(void);

+ 0 - 0
include/ps-sdl2.h


Some files were not shown because too many files changed in this diff