From fe8c72739299da04d032b2d750bd759ad3b5be3a Mon Sep 17 00:00:00 2001
From: mehbark <terezi@pyrope.net>
Date: Thu, 21 Dec 2023 14:30:43 -0500
Subject: [PATCH] c test works great. ugh

---
 flake.nix |   2 +
 main.c    |  20 ++++++++++
 main.scm  | 108 +++++++++++++++++++++++++++++++++++++++++++++++++-----
 3 files changed, 121 insertions(+), 9 deletions(-)
 create mode 100644 main.c

diff --git a/flake.nix b/flake.nix
index 7e89ba2..5352a7b 100644
--- a/flake.nix
+++ b/flake.nix
@@ -23,6 +23,8 @@
           ];
 
           LD_LIBRARY_PATH="${pkgs.raylib}/lib";
+          # not necessary
+          LIBRARY_PATH="${pkgs.raylib}/include";
         };
       });
     };
diff --git a/main.c b/main.c
new file mode 100644
index 0000000..9f1e2bb
--- /dev/null
+++ b/main.c
@@ -0,0 +1,20 @@
+#include "raylib.h"
+
+int main() {
+    InitWindow(100, 100, "hello from C");
+
+    Texture2D texture = LoadTexture("skins/xp-flowers.bmp");
+    SetTargetFPS(120);
+
+    while (!WindowShouldClose()) {
+        BeginDrawing();
+            ClearBackground(RAYWHITE);
+            DrawTexture(texture, 50, 50, WHITE);
+        EndDrawing();
+    }
+
+    UnloadTexture(texture);
+    CloseWindow();
+
+    return 0;
+}
diff --git a/main.scm b/main.scm
index 2f4c763..acc697d 100644
--- a/main.scm
+++ b/main.scm
@@ -2,6 +2,7 @@
 ; main thing i'd like to do is be compatible with these:
 ; https://www.mzrg.com/mines/msx/index.html
 ; let's do about the minimum to do what i want
+; keep the names almost exactly the same for googling's sake
 
 (load-shared-object "libraylib.so")
 
@@ -72,6 +73,17 @@
 (define get-fps
   (foreign-procedure #f "GetFPS" () int))
 
+; filesystem
+
+(define get-working-directory
+  (foreign-procedure #f "GetWorkingDirectory" () string))
+
+(define get-application-directory
+  (foreign-procedure #f "GetApplicationDirectory" () string))
+
+(define change-directory
+  (foreign-procedure #f "ChangeDirectory" (string) boolean))
+
 ; text
 
 (define draw-fps
@@ -82,6 +94,7 @@
 
 ; texture
 
+; shouldn't really need to use these structs, just pass them around
 (define-ftype Image
   (struct
     [data    void*]
@@ -90,8 +103,67 @@
     [mipmaps int]
     [format  int]))
 
+(define-ftype Texture
+  (struct
+    [id unsigned]
+    [width   int]   
+    [height  int]   
+    [mipmaps int]   
+    [format  int]))
+
+(define-ftype Texture2D Texture)
+
+; really need this one though
+(define-ftype Rectangle
+  (struct
+    [x float]
+    [y float]
+    [width  float]
+    [height float]))
+
+(define (set-rectangle-x! rect x) (ftype-set! Rectangle (x) rect (exact->inexact x)))
+(define (set-rectangle-y! rect y) (ftype-set! Rectangle (y) rect (exact->inexact y)))
+(define (set-rectangle-width!  rect width)  (ftype-set! Rectangle (width)  rect (exact->inexact width)))
+(define (set-rectangle-height! rect height) (ftype-set! Rectangle (height) rect (exact->inexact height)))
+
+(define rectangle
+  (case-lambda
+    [(x y width) (rectangle x y width width)]
+    [(x y width height)
+     (define rect (make-ftype-pointer Rectangle (foreign-alloc (ftype-sizeof Rectangle))))
+     (set-rectangle-x! rect x)
+     (set-rectangle-y! rect y)
+     (set-rectangle-width!  rect width)
+     (set-rectangle-height! rect height)
+     rect]))
+
+(define-ftype Vector2
+  (struct
+    [x float]
+    [y float]))
+
+(define (set-vector2-x! vec2 x) (ftype-set! Vector2 (x) vec2 (exact->inexact x)))
+(define (set-vector2-y! vec2 y) (ftype-set! Vector2 (y) vec2 (exact->inexact y)))
+
+(define (vector2 x y)
+  (define vec2 (make-ftype-pointer Vector2 (foreign-alloc (ftype-sizeof Vector2))))
+  (set-vector2-x! vec2 x)
+  (set-vector2-y! vec2 y)
+  vec2)
+
 (define load-image
-  (foreign-procedure #f "LoadImage" (string) (& Image)))
+  (foreign-procedure #f "LoadImage" (string) (* Image)))
+
+(define load-texture
+  (foreign-procedure #f "LoadTexture" (string) (* Texture2D)))
+
+(define unload-texture
+  (foreign-procedure #f "UnloadTexture" ((& Texture2D)) void))
+
+(define draw-texture-rec
+  (foreign-procedure #f "DrawTextureRec" ((& Texture2D) (& Rectangle) (& Vector2) (& Color)) void))
+
+; we only really need the rec version
 
 ; scheme magicks
 
@@ -118,18 +190,36 @@
 
 ; my stuff :]
 
+(define *skin-paths* '("./skins" "."))
+
+(define (load-skin filename)
+  (define path
+    (find file-exists?
+	 (map (lambda (p) (string-append p "/" filename))
+	      *skin-paths*)))
+  (unless path
+    (error 'load-skin (string-append "failed to load `" filename "`. tried paths " (with-output-to-string (lambda () (write *skin-paths*))))))
+  (load-texture path))
+
+
 (define (main)
   (init-window 100 100 "hello")
-  (set-target-fps 120)
+  (set-target-fps 60)
 
-  (until (window-should-close?)
-	 (with-draw
-	  (clear-background (color 245 245 245 255))
-	  (draw-fps 0 0)
-	  (draw-text "wow awesome" 0 20 20 (color 0 0 0))))
+  (let ([skin (load-texture "skins/xp-flowers.bmp")])
+    (display skin)
+    (newline)
 
-  (close-window))
+    ; with the actual game, we probably don't have to draw every time
+    (until (window-should-close?)
+	   (with-draw
+	    (clear-background (color 245 245 245))
+	    (draw-texture-rec skin (rectangle 0 0 100) (vector2 0 0) (color 255 255 255))
+	    (draw-fps 0 0)
+	    (draw-text "wow awesome" 0 20 20 (color 0 0 0))))
 
-(main)
+    (unload-texture skin)
+    (close-window)))
 
+;; (main)