c test works great. ugh

This commit is contained in:
mehbark 2023-12-21 14:30:43 -05:00
parent 78cb723004
commit fe8c727392
3 changed files with 121 additions and 9 deletions

View file

@ -23,6 +23,8 @@
];
LD_LIBRARY_PATH="${pkgs.raylib}/lib";
# not necessary
LIBRARY_PATH="${pkgs.raylib}/include";
};
});
};

20
main.c Normal file
View file

@ -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;
}

108
main.scm
View file

@ -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)