Some more work

.dir-locals.el

@@ -0,0 +1,6 @@
+((nil . ((geiser-default-implementation . chicken)
+         (geiser-scheme-implementation . chicken)
+         (geiser-active-implementations . (chicken))
+         (eglot-connect-timeout . 240)
+         (org-confirm-babel-evaluate . nil)))
+ (org . ((org-confirm-babel-evaluate . nil))))

flake.nix

@@ -29,19 +29,12 @@
       (builtins.substring 4 2 longDate)
       (builtins.substring 6 2 longDate)
     ]);
-    version = "6.0.0";
+    version = "5.4.0";
   in {
     overlays = {
-      default = self.overlays.chicken;
+      default = self.overlays.sdl3;
 
-      chicken = final: prev: {
-        tcc-mob = final.callPackage ./nix/tinycc.nix {
-          stdenv = final.gcc13Stdenv;
-        };
-        chicken = final.callPackage ./nix/chicken.nix {
-          stdenv = final.gcc13Stdenv;
-          version = version + "+date=" + (mkDate (self.lastModifiedDate or "19700101")) + "_" + (self.shortRev or "dirty");
-        };
+      sdl3 = final: prev: {
         sdl3 = final.callPackage ./nix/sdl3.nix {
           stdenv = final.gcc13Stdenv;
           version = "2.99.0+date=" + (mkDate (self.lastModifiedDate or "19700101")) + "_" + (self.shortRev or "dirty");
@@ -52,16 +45,16 @@
     devShells = forAllSystems (system: {
       default = let
         pkgs = import nixpkgs {
-          overlays = [ self.overlays.chicken ];
+          overlays = [ self.overlays.sdl3 ];
         };
       in pkgs.mkShell {
-        packages = with pkgs; [ pkg-config rlwrap tcc-mob chicken sdl3 ];
-        shellHook = ''
-          export CC=${pkgs.tcc-mob}/bin/tcc
-          export CHICKEN_INSTALL_REPOSITORY="$(pwd)/.chicken/eggs"
-          export CHICKEN_REPOSITORY_PATH="${pkgs.chicken}/lib/chicken/11:$CHICKEN_REPOSITORY_PATH:$(pwd)/.chicken/eggs"
-          export PATH="$PATH:$CHICKEN_INSTALL_PREFIX/bin"
-        '';
+        packages = with pkgs; [
+          pkg-config rlwrap sdl3
+          chicken chickenPackages_5.chickenEggs.apropos
+        ] ++ (with pkgs.chickenPackages_5.chickenEggs; [
+          apropos chicken-doc srfi-1 srfi-18 lsp-server
+          r7rs srfi-152
+        ]);
       };
     });
   };

internal/utilities.scm

@@ -1,12 +1,14 @@
 (import (scheme)
         (chicken base)
-        (chicken syntax))
+        (chicken syntax)
+        (srfi 152))
 
 (define (snake-upcase in)
   (string-map (lambda (c)
                 (if (char=? #\- c)
                     #\_
-                    (char-upcase c)))))
+                    (char-upcase c)))
+              in))
 
 (define-syntax define-sdl-flag
   (er-macro-transformer

lib/sdl3-render-impl.scm

@@ -0,0 +1,354 @@
+(import (scheme)
+        (chicken base)
+        (chicken foreign))
+(import-for-syntax (sdl3 internal utilities))
+
+(foreign-declare "#include <SDL3/SDL_render.h>")
+
+(define add-vulkan-render-semaphores
+  (foreign-lambda bool "SDL_AddVulkanRenderSemaphores"
+    (c-pointer (struct "SDL_Renderer"))
+    unsigned-int32 integer64 integer64))
+
+(define convert-event-to-render-coordinates
+  (foreign-lambda bool "SDL_ConvertEventToRenderCoordinates"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Event"))))
+
+(define create-renderer
+  (foreign-lambda (c-pointer (struct "SDL_Renderer"))
+      "SDL_CreateRenderer"
+    (c-pointer (struct "SDL_Window"))
+    c-string))
+
+(define create-renderer-with-properties
+  (foreign-lambda (c-pointer (struct "SDL_Renderer"))
+      "SDL_CreateRendererWithProperties"
+    unsigned-int32))
+
+(define create-software-renderer
+  (foreign-lambda (c-pointer (struct "SDL_Renderer"))
+      "SDL_CreateSoftwareRenderer"
+    (c-pointer (struct "SDL_Surface"))))
+
+(define-sdl-enum-values
+  textureaccess int
+  (static streaming target))
+
+(define create-texture
+  (foreign-lambda (c-pointer (struct "SDL_Texture"))
+      "SDL_CreateTexture"
+    (c-pointer (struct "SDL_Renderer"))
+    (enum "SDL_PixelFormat")
+    (enum "SDL_TextureAccess")
+    int int))
+
+(define create-texture-from-surface
+  (foreign-lambda (c-pointer (struct "SDL_Texture"))
+      "SDL_CreateTextureFromSurface"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Surface"))))
+
+(define create-texture-with-properties
+  (foreign-lambda (c-pointer (struct "SDL_Texture"))
+      "SDL_CreateTextureWithProperties"
+    (c-pointer (struct "SDL_Renderer"))
+    unsigned-int32))
+
+;; TODO: SDL_CreateWindowAndRenderer
+
+(define destroy-renderer
+  (foreign-lambda void "SDL_DestroyRenderer" (c-pointer (struct "SDL_Renderer"))))
+
+(define destroy-texture
+  (foreign-lambda void "SDL_DestroyTexture" (c-pointer (struct "SDL_Texture"))))
+
+(define flush-renderer
+  (foreign-lambda bool "SDL_FlushRenderer" (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_GetCurrentRenderOutputSize
+
+(define get-num-render-drivers
+  (foreign-lambda int "SDL_GetNumRenderDrivers"))
+
+;; TODO: SDL_GetRenderClipRect
+
+;; TODO: SDL_GetRenderColorScale
+
+;; TODO: SDL_GetRenderDrawBlendMode
+
+;; TODO: SDL_GetRenderDrawColor
+
+;; TODO: SDL_GetRenderDrawColorFloat
+
+(define get-render-driver
+  (foreign-lambda c-string "SDL_GetRenderDriver" int))
+
+(define get-renderer
+  (foreign-lambda (c-pointer (struct "SDL_Renderer"))
+      "SDL_GetRenderer"
+    (c-pointer (struct "SDL_Window"))))
+
+(define get-renderer-from-texture
+  (foreign-lambda (c-pointer (struct "SDL_Renderer"))
+      "SDL_GetRendererFromTexture"
+    (c-pointer (struct "SDL_Texture"))))
+
+(define get-renderer-name
+  (foreign-lambda c-string "SDL_GetRendererName"
+    (c-pointer (struct "SDL_Renderer"))))
+
+(define get-renderer-properties
+  (foreign-lambda unsigned-int32 "SDL_GetRendererProperties"
+    (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_GetRenderLogicalPresentation
+
+;; TODO: SDL_GetRenderLogicalPresentationRect
+
+(define get-render-metal-command-encoder
+  (foreign-lambda c-pointer "SDL_GetRenderMetalCommandEncoder"
+    (c-pointer (struct "SDL_Renderer"))))
+
+(define get-render-metal-layer
+  (foreign-lambda c-pointer "SDL_GetRenderMetalLayer"
+    (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_GetRenderOutputSize
+
+;; TODO: SDL_GetRenderSafeArea
+
+;; TODO: SDL_GetRenderScale
+
+(define get-render-target
+  (foreign-lambda (c-pointer (struct "SDL_Texture"))
+      "SDL_GetRenderTarget"
+    (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_GetRenderViewport
+
+;; TODO: SDL_GetRenderVSync
+
+(define get-render-window
+  (foreign-lambda (c-pointer (struct "SDL_Window"))
+      "SDL_GetRenderWindow"
+    (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_GetTextureAlphaMod
+
+;; TODO: SDL_GetTextureAlphaModFloat
+
+;; TODO: SDL_GetTextureBlendMode
+
+;; TODO: SDL_GetTextureColorMod
+
+;; TODO: SDL_GetTextureColorModFloat
+
+(define get-texture-properties
+  (foreign-lambda unsigned-int32 "SDL_GetTextureProperties"
+    (c-pointer (struct "SDL_Texture"))))
+
+;; TODO: SDL_GetTextureScaleMode
+
+;; TODO: SDL_GetTextureSize
+
+;; TODO: SDL_LockTexture
+
+;; TODO: SDL_LockTextureToSurface
+
+(define render-clear
+  (foreign-lambda bool "SDL_RenderClear" (c-pointer (struct "SDL_Renderer"))))
+
+(define render-clip-enabled
+  (foreign-lambda bool "SDL_RenderClipEnabled" (c-pointer (struct "SDL_Renderer"))))
+
+;; TODO: SDL_RenderCoordinatesFromWindow
+
+;; TODO: SDL_RenderCoordinatesToWindow
+
+(define render-fill-rect
+  (foreign-lambda bool "SDL_RenderFillRect" (c-pointer (struct "SDL_Renderer"))
+                  (c-pointer (struct "SDL_FRect"))))
+
+;; TODO: SDL_RenderFillRects
+
+;; TODO: SDL_RenderGeometry
+
+;; TODO: SDL_RenderGeometryRaw
+
+(define render-line
+  (foreign-lambda bool "SDL_RenderLine"
+    (c-pointer (struct "SDL_Renderer"))
+    float float float float))
+
+;; TODO: SDL_RenderLines
+
+(define render-point
+  (foreign-lambda bool "SDL_RenderPoint" (c-pointer (struct "SDL_Renderer")) float float))
+
+;; TODO: SDL_RenderPoints
+
+(define render-present
+  (foreign-lambda bool "SDL_RenderPresent" (c-pointer (struct "SDL_Renderer"))))
+
+(define render-read-pixels
+  (foreign-lambda (c-pointer (struct "SDL_Surface"))
+      "SDL_RenderReadPixels"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Rect"))))
+
+(define render-rect
+  (foreign-lambda bool "SDL_RenderRect"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_FRect"))))
+
+;; TODO: SDL_RenderRects
+
+(define render-texture
+  (foreign-lambda bool "SDL_RenderTexture"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Texture"))
+    (c-pointer (struct "SDL_FRect"))
+    (c-pointer (struct "SDL_FRect"))))
+
+(define render-texture-9-grid
+  (foreign-lambda bool "SDL_RenderTexture9Grid"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Texture"))
+    (c-pointer (struct "SDL_FRect"))
+    float float float float float
+    (c-pointer (struct "SDL_FRect"))))
+
+(define-sdl-enum-values
+  flip int
+  (none horizontal vertical))
+
+(define render-texture-rotated
+  (foreign-lambda bool "SDL_RenderTextureRotated"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Texture"))
+    (c-pointer (struct "SDL_FRect"))
+    (c-pointer (struct "SDL_FRect"))
+    double
+    (c-pointer (struct "SDL_FPoint"))
+    (enum "SDL_FlipMode")))
+
+(define render-texture-tiled
+  (foreign-lambda bool "SDL_RenderTextureTiled"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Texture"))
+    (c-pointer (struct "SDL_FRect"))
+    float
+    (c-pointer (struct "SDL_FRect"))))
+
+(define render-viewport-set
+  (foreign-lambda bool "SDL_RenderViewportSet"
+    (c-pointer (struct "SDL_Renderer"))))
+
+(define set-render-clip-rect
+  (foreign-lambda bool "SDL_SetRenderClipRect"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Rect"))))
+
+(define set-render-color-scale
+  (foreign-lambda bool "SDL_SetRenderColorScale"
+    (c-pointer (struct "SDL_Renderer"))
+    float))
+
+(define-sdl-enum-values
+  blendmode unsigned-int32
+  (none blend blend-premultiplied add add premultiplied
+        mod nul invalid))
+
+(define set-render-draw-blend-mode
+  (foreign-lambda bool "SDL_SetRenderDrawBlendMode"
+    (c-pointer (struct "SDL_Renderer"))
+    unsigned-int32))
+
+(define set-render-draw-color
+  (foreign-lambda bool "SDL_SetRenderDrawColor"
+    (c-pointer (struct "SDL_Renderer"))
+    unsigned-byte unsigned-byte unsigned-byte unsigned-byte))
+
+(define set-render-draw-color-float
+  (foreign-lambda bool "SDL_SetRenderDrawColorFloat"
+    (c-pointer (struct "SDL_Renderer"))
+    float float float float))
+
+(define-sdl-enum-values
+  logical-presentation int
+  (disabled stretch letterbox overscan integer-scale))
+
+(define-sdl-enum-values
+  scalemode int
+  (nearest linear))
+
+(define set-render-logical-presentation
+  (foreign-lambda bool "SDL_SetRenderLogicalPresentation"
+    (c-pointer (struct "SDL_Renderer"))
+    int int
+    (enum "SDL_RendererLogicalPresentation")
+    (enum "SDL_ScaleMode")))
+
+(define set-render-scale
+  (foreign-lambda bool "SDL_SetRenderScale"
+    (c-pointer (struct "SDL_Renderer"))
+    float float))
+
+(define set-render-target
+  (foreign-lambda bool "SDL_SetRenderTarget"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Texture"))))
+
+(define set-render-viewport
+  (foreign-lambda bool "SDL_SetRenderViewport"
+    (c-pointer (struct "SDL_Renderer"))
+    (c-pointer (struct "SDL_Rect"))))
+
+(define-sdl-enum-values
+  renderer-vsync int
+  (disabled adaptive))
+
+(define set-render-vsync
+  (foreign-lambda bool "SDL_SetRenderVSync"
+    (c-pointer (struct "SDL_Renderer"))
+    int))
+
+(define set-texture-alpha-mod
+  (foreign-lambda bool "SDL_SetTextureAlphaMod"
+    (c-pointer (struct "SDL_Texture"))
+    unsigned-byte))
+
+(define set-texture-alpha-mod-float
+  (foreign-lambda bool "SDL_SetTextureAlphaModFloat"
+    (c-pointer (struct "SDL_Texture"))
+    float))
+
+(define set-texture-blend-mode
+  (foreign-lambda bool "SDL_SetTextureBlendMode"
+    (c-pointer (struct "SDL_Texture"))
+    unsigned-int32))
+
+(define set-texture-color-mod
+  (foreign-lambda bool "SDL_SetTextureColorMod"
+    (c-pointer (struct "SDL_Texture"))
+    unsigned-byte unsigned-byte unsigned-byte))
+
+(define set-texture-color-mod-float
+  (foreign-lambda bool "SDL_SetTextureColorModFloat"
+    (c-pointer (struct "SDL_Texture"))
+    float float float))
+
+(define set-texture-scale-mode
+  (foreign-lambda bool "SDL_SetTextureScaleMode"
+    (c-pointer (struct "SDL_Texture"))
+    (enum "SDL_ScaleMode")))
+
+(define unlock-texture
+  (foreign-lambda bool "SDL_UnlockTexture" (c-pointer (struct "SDL_Texture"))))
+
+;; TODO: SDL_UpdateNVTexture
+
+;; TODO: SDL_UpdateTexture
+
+;; TODO: SDL_UpdateYUVTexture

lib/sdl3-video-impl.scm

@@ -1,9 +1,7 @@
 (import (scheme)
-        (srfi 152)
         (chicken base)
         (chicken foreign))
-
-(include-relative "../internal/utilities.scm")
+(import-for-syntax (sdl3 internal utilities))
 
 (foreign-declare "#include <SDL3/SDL_video.h>")
 

nix/chicken.nix

@@ -1,15 +1,5 @@
-{
-  pkgs,
-  lib,
-  stdenv,
-  fetchgit,
-  fetchurl,
-  makeWrapper,
-  darwin,
-  tcc-mob,
-  version ? "git",
-  testers
-}:
+{ lib, stdenv, fetchurl, makeWrapper, darwin, tcc-mob, bootstrap-chicken ? null, testers }:
+
 let
   platform = with stdenv;
     if isDarwin then "macosx"
@@ -20,57 +10,27 @@ let
 in
 stdenv.mkDerivation (finalAttrs: {
   pname = "chicken";
-  inherit version;
+  version = "5.4.0";
 
-  binaryVersion = 12;
-  
-  srcs = [
-    (fetchgit {
-      url = "git://code.call-cc.org/chicken-core";
-      rev = "dbffda19e57c3be092e5a9174f1829632f5fa5a7";
-      sha256 = "sha256-zWjf9JS4H1buBlkmUhIv+odCQzXaOPtI7VfIaQUhe6Q=";
-    })
-    (fetchurl {
-      url = "https://code.call-cc.org/dev-snapshots/2024/07/01/chicken-6.0.0-bootstrap.tar.gz";
-      sha256 = "sha256-qkcyWzsaN9+HbMBolmv7zeaPrtbaCTGa9HoF2g/3//o=";
-    })
-  ];
+  binaryVersion = 11;
 
-  unpackPhase = ''
-    cp -r `echo $srcs | awk '{print $1}'`/* .
-    cp -r `echo $srcs | awk '{print $1}'`/.* .
-    chmod -R 777 .
-    mkdir -p boot/snapshot
-    cd boot
-    tar xzf `echo $srcs | awk '{print $2}'`
-    cd ..
-    echo ${version} > buildid
+  src = fetchurl {
+    url = "https://code.call-cc.org/releases/${finalAttrs.version}/chicken-${finalAttrs.version}.tar.gz";
+    sha256 = "sha256-PF1KphwRZ79tm/nq+JHadjC6n188Fb8JUVpwOb/N7F8=";
+  };
 
-    cd boot/chicken-6.0.0
-    case "${platform}" in
-        bsd)
-            mkcmd=gmake;;
-        *)
-            mkcmd=make;;
-    esac
-    export CC="${tcc-mob}/bin/tcc"
-    $mkcmd C_COMPILER=$CC PREFIX="$(pwd)"/../snapshot
-    $mkcmd C_COMPILER=$CC PREFIX="$(pwd)"/../snapshot install
-    cd ../..
-    ./configure --chicken "$(pwd)"/boot/snapshot/bin/chicken --c-compiler "${tcc-mob}/bin/tcc"
-    $mkcmd boot-chicken
-  '';
-
- # Disable two broken tests: "static link" and "linking tests"
+  # Disable two broken tests: "static link" and "linking tests"
   postPatch = ''
     sed -i tests/runtests.sh -e "/static link/,+4 { s/^/# / }"
     sed -i tests/runtests.sh -e "/linking tests/,+11 { s/^/# / }"
   '';
 
+  setupHook = lib.optional (bootstrap-chicken != null) ./setup-hook.sh;
+
   # -fno-strict-overflow is not a supported argument in clang
   hardeningDisable = lib.optionals stdenv.cc.isClang [ "strictoverflow" ];
 
- makeFlags = [
+  makeFlags = [
     "PLATFORM=${platform}"
     "PREFIX=$(out)"
     "C_COMPILER=${tcc-mob}/bin/tcc"
@@ -87,16 +47,15 @@ stdenv.mkDerivation (finalAttrs: {
 
   nativeBuildInputs = [
     makeWrapper
-    pkgs.hostname
     tcc-mob
   ] ++ lib.optionals (stdenv.isDarwin && stdenv.isAarch64) [
     darwin.autoSignDarwinBinariesHook
   ];
 
-  configurePhase = ''
-    ./configure --chicken ./chicken-boot --prefix $PREFIX  --platform=$PLATFORM --c-compiler "${tcc-mob}/bin/tcc"
-  '';
-  
+  buildInputs = lib.optionals (bootstrap-chicken != null) [
+    bootstrap-chicken
+  ];
+
   doCheck = !stdenv.isDarwin;
   postCheck = ''
     ./csi -R chicken.pathname -R chicken.platform \
@@ -121,6 +80,5 @@ stdenv.mkDerivation (finalAttrs: {
       enhancements and extensions. CHICKEN runs on Linux, macOS,
       Windows, and many Unix flavours.
     '';
-  }; 
-  
+  };
 })

nix/sdl3.nix

@@ -6,7 +6,6 @@
   fetchurl,
   makeWrapper,
   darwin,
-  tcc-mob,
   version ? "git",
   testers
 }:
@@ -38,7 +37,6 @@ stdenv.mkDerivation (finalAttrs: {
   nativeBuildInputs = [
     makeWrapper
     pkgs.hostname
-    tcc-mob
     pkgs.cmake
   ] ++ lib.optionals (stdenv.isDarwin && stdenv.isAarch64) [
     darwin.autoSignDarwinBinariesHook

sdl3-internal-utilities.scm

@@ -0,0 +1,7 @@
+(define-library (sdl3 internal utilities)
+  (import (scheme)
+          (chicken base))
+  (export define-sdl-flag
+          define-sdl-enum-values)
+  (begin
+    (include-relative "internal/utilities.scm")))

sdl3-render.scm

@@ -0,0 +1,6 @@
+(define-library (sdl3 render)
+  (import (scheme)
+          (chicken base))
+  (export)
+  (begin
+    (include-relative "lib/sdl3-render-impl.scm")))