Some more work

This commit is contained in:
Daniel Ziltener 2024-09-24 16:55:41 +02:00
parent 956f8b843e
commit 0af1300fe0
Signed by: zilti
GPG key ID: B38976E82C9DAE42
9 changed files with 406 additions and 84 deletions

6
.dir-locals.el Normal file
View file

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

View file

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

View file

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

354
lib/sdl3-render-impl.scm Normal file
View file

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

View file

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

View file

@ -1,15 +1,5 @@
{ { lib, stdenv, fetchurl, makeWrapper, darwin, tcc-mob, bootstrap-chicken ? null, testers }:
pkgs,
lib,
stdenv,
fetchgit,
fetchurl,
makeWrapper,
darwin,
tcc-mob,
version ? "git",
testers
}:
let let
platform = with stdenv; platform = with stdenv;
if isDarwin then "macosx" if isDarwin then "macosx"
@ -20,57 +10,27 @@ let
in in
stdenv.mkDerivation (finalAttrs: { stdenv.mkDerivation (finalAttrs: {
pname = "chicken"; pname = "chicken";
inherit version; version = "5.4.0";
binaryVersion = 12; binaryVersion = 11;
srcs = [ src = fetchurl {
(fetchgit { url = "https://code.call-cc.org/releases/${finalAttrs.version}/chicken-${finalAttrs.version}.tar.gz";
url = "git://code.call-cc.org/chicken-core"; sha256 = "sha256-PF1KphwRZ79tm/nq+JHadjC6n188Fb8JUVpwOb/N7F8=";
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=";
})
];
unpackPhase = '' # Disable two broken tests: "static link" and "linking tests"
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
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"
postPatch = '' postPatch = ''
sed -i tests/runtests.sh -e "/static link/,+4 { s/^/# / }" sed -i tests/runtests.sh -e "/static link/,+4 { s/^/# / }"
sed -i tests/runtests.sh -e "/linking tests/,+11 { 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 # -fno-strict-overflow is not a supported argument in clang
hardeningDisable = lib.optionals stdenv.cc.isClang [ "strictoverflow" ]; hardeningDisable = lib.optionals stdenv.cc.isClang [ "strictoverflow" ];
makeFlags = [ makeFlags = [
"PLATFORM=${platform}" "PLATFORM=${platform}"
"PREFIX=$(out)" "PREFIX=$(out)"
"C_COMPILER=${tcc-mob}/bin/tcc" "C_COMPILER=${tcc-mob}/bin/tcc"
@ -87,15 +47,14 @@ stdenv.mkDerivation (finalAttrs: {
nativeBuildInputs = [ nativeBuildInputs = [
makeWrapper makeWrapper
pkgs.hostname
tcc-mob tcc-mob
] ++ lib.optionals (stdenv.isDarwin && stdenv.isAarch64) [ ] ++ lib.optionals (stdenv.isDarwin && stdenv.isAarch64) [
darwin.autoSignDarwinBinariesHook darwin.autoSignDarwinBinariesHook
]; ];
configurePhase = '' buildInputs = lib.optionals (bootstrap-chicken != null) [
./configure --chicken ./chicken-boot --prefix $PREFIX --platform=$PLATFORM --c-compiler "${tcc-mob}/bin/tcc" bootstrap-chicken
''; ];
doCheck = !stdenv.isDarwin; doCheck = !stdenv.isDarwin;
postCheck = '' postCheck = ''
@ -122,5 +81,4 @@ stdenv.mkDerivation (finalAttrs: {
Windows, and many Unix flavours. Windows, and many Unix flavours.
''; '';
}; };
}) })

View file

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

View file

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

6
sdl3-render.scm Normal file
View file

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