stuff on the screen

This commit is contained in:
mehbark 2023-12-20 21:41:06 -05:00
commit 78cb723004
3 changed files with 204 additions and 0 deletions

40
flake.lock Normal file
View file

@ -0,0 +1,40 @@
{
"nodes": {
"flake-schemas": {
"locked": {
"lastModified": 1697467827,
"narHash": "sha256-j8SR19V1SRysyJwpOBF4TLuAvAjF5t+gMiboN4gYQDU=",
"rev": "764932025c817d4e500a8d2a4d8c565563923d29",
"revCount": 29,
"type": "tarball",
"url": "https://api.flakehub.com/f/pinned/DeterminateSystems/flake-schemas/0.1.2/018b3da8-4cc3-7fbb-8ff7-1588413c53e2/source.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://flakehub.com/f/DeterminateSystems/flake-schemas/%2A.tar.gz"
}
},
"nixpkgs": {
"locked": {
"lastModified": 1702780907,
"narHash": "sha256-blbrBBXjjZt6OKTcYX1jpe9SRof2P9ZYWPzq22tzXAA=",
"rev": "1e2e384c5b7c50dbf8e9c441a9e58d85f408b01f",
"revCount": 553366,
"type": "tarball",
"url": "https://api.flakehub.com/f/pinned/NixOS/nixpkgs/0.2311.553366%2Brev-1e2e384c5b7c50dbf8e9c441a9e58d85f408b01f/018c7bfd-11b9-73fc-856e-ffc78346f98e/source.tar.gz"
},
"original": {
"type": "tarball",
"url": "https://flakehub.com/f/NixOS/nixpkgs/%2A.tar.gz"
}
},
"root": {
"inputs": {
"flake-schemas": "flake-schemas",
"nixpkgs": "nixpkgs"
}
}
},
"root": "root",
"version": 7
}

29
flake.nix Normal file
View file

@ -0,0 +1,29 @@
# This flake was initially generated by fh, the CLI for FlakeHub (version 0.1.9)
{
inputs = {
flake-schemas.url = "https://flakehub.com/f/DeterminateSystems/flake-schemas/*.tar.gz";
nixpkgs.url = "https://flakehub.com/f/NixOS/nixpkgs/*.tar.gz";
};
outputs = { self, flake-schemas, nixpkgs }:
let
supportedSystems = [ "x86_64-linux" ];
forEachSupportedSystem = f: nixpkgs.lib.genAttrs supportedSystems (system: f {
pkgs = import nixpkgs { inherit system; };
});
in {
schemas = flake-schemas.schemas;
devShells = forEachSupportedSystem ({ pkgs }: {
default = pkgs.mkShell {
packages = with pkgs; [
nixpkgs-fmt
chez
raylib
];
LD_LIBRARY_PATH="${pkgs.raylib}/lib";
};
});
};
}

135
main.scm Normal file
View file

@ -0,0 +1,135 @@
#!r6rs
; 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
(load-shared-object "libraylib.so")
; color
(define-ftype Color
(struct
[r unsigned-8]
[g unsigned-8]
[b unsigned-8]
[a unsigned-8]))
(define (set-color-r! color r) (ftype-set! Color (r) color r))
(define (set-color-g! color g) (ftype-set! Color (g) color g))
(define (set-color-b! color b) (ftype-set! Color (b) color b))
(define (set-color-a! color a) (ftype-set! Color (a) color a))
(define (color-r color) (ftype-ref Color (r) color))
(define (color-g color) (ftype-ref Color (g) color))
(define (color-b color) (ftype-ref Color (b) color))
(define (color-a color) (ftype-ref Color (a) color))
(define (color-components c) (list (color-r c) (color-g c) (color-b c) (color-a c)))
(define color
(case-lambda
[(r g b) (color r g b 255)]
[(r g b a)
(define c (make-ftype-pointer Color (foreign-alloc (ftype-sizeof Color))))
(set-color-r! c r)
(set-color-g! c g)
(set-color-b! c b)
(set-color-a! c a)
c]))
;; (define c (color 1 2 3 4))
;; (display (list (color-r c) (color-g c) (color-b c) (color-a c)))
; window
(define init-window
(foreign-procedure #f "InitWindow" (int int string) void))
(define close-window
(foreign-procedure #f "CloseWindow" () void))
(define window-should-close?
(foreign-procedure #f "WindowShouldClose" () boolean))
; drawing
(define clear-background
(foreign-procedure #f "ClearBackground" ((& Color)) void))
(define begin-drawing
(foreign-procedure #f "BeginDrawing" () void))
(define end-drawing
(foreign-procedure #f "EndDrawing" () void))
; timing
(define set-target-fps
(foreign-procedure #f "SetTargetFPS" (int) void))
(define get-frame-time
(foreign-procedure #f "GetFrameTime" () float))
(define get-time
(foreign-procedure #f "GetTime" () double))
(define get-fps
(foreign-procedure #f "GetFPS" () int))
; text
(define draw-fps
(foreign-procedure #f "DrawFPS" (int int) void))
(define draw-text
(foreign-procedure #f "DrawText" (string int int int (& Color)) void))
; texture
(define-ftype Image
(struct
[data void*]
[width int]
[height int]
[mipmaps int]
[format int]))
(define load-image
(foreign-procedure #f "LoadImage" (string) (& Image)))
; scheme magicks
(define-syntax with-draw
(syntax-rules ()
[(_ body ...)
(begin (begin-drawing)
body ...
(end-drawing))]))
(define-syntax while
(syntax-rules ()
[(_ test body ...)
(do []
[(not test) #f]
body ...)]))
(define-syntax until
(syntax-rules ()
[(_ test body ...)
(do []
[test #f]
body ...)]))
; my stuff :]
(define (main)
(init-window 100 100 "hello")
(set-target-fps 120)
(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))))
(close-window))
(main)