diff --git a/.gitignore b/.gitignore index 636d271..1b275a2 100644 --- a/.gitignore +++ b/.gitignore @@ -29,3 +29,7 @@ src/backup.bat specbas_dev_notes.txt specbas_log.txt *.log + +# SDL2 backend build: fetched dependencies and build products. +/build-sdl2/vendor/ +/build-sdl2/build/ diff --git a/build-sdl2/Makefile b/build-sdl2/Makefile new file mode 100644 index 0000000..8e3cd0c --- /dev/null +++ b/build-sdl2/Makefile @@ -0,0 +1,135 @@ +# Builds SpecBAS with the SDL2 backend, using Free Pascal on its own. No +# Lazarus, no lazbuild, no .lpi. +# +# make deps fetch the outside pieces into vendor/ +# make build the executable into build/ +# make app macOS only: build build/SpecBAS.app, self-contained +# make clean remove build/ +# make distclean also remove vendor/ +# +# Linking against a framework on macOS: SDL2-for-Pascal's sdl2.pas carries +# {$LINKLIB libSDL2} for Darwin, so fpc always asks the linker for a library +# named libSDL2 and there is no switch that stops it. build/link/ holds one +# symlink, libSDL2.dylib, pointing at the framework's binary. The linker +# follows it, reads that binary's own LC_ID_DYLIB, and records it in the +# executable - @rpath/SDL2.framework/Versions/A/SDL2, which is the +# dependency a bundled framework needs. The symlink exists only at link +# time; nothing is copied and nothing is rewritten, so the framework's +# signature stays valid. +# +# On Linux SDL2 comes from the distribution. sdl2.pas names libSDL2.so, fpc +# turns that into -lSDL2, and the development package supplies it. + +FPC ?= fpc +APP_NAME ?= SpecBAS +BIN_NAME ?= specbas + +HERE := $(patsubst %/,%,$(dir $(abspath $(lastword $(MAKEFILE_LIST))))) +ROOT := $(dir $(HERE)) +SRC := $(ROOT)src +VENDOR := $(HERE)/vendor +BUILD := $(HERE)/build +UNITS := $(VENDOR)/SDL2-for-Pascal/units +FRAMEWORK := $(VENDOR)/SDL2.framework +LINKDIR := $(BUILD)/link +OBJDIR := $(BUILD)/obj +APP := $(BUILD)/$(APP_NAME).app +PROGRAM := $(SRC)/SpecBAS_SDL2.dpr + +UNAME_S := $(shell uname -s) + +# -O1, not -O2: Free Pascal 3.2.2 for aarch64 raises internal error +# 200510011 on SP_FPEditor.pas at -O2. +# +# -MDelphi matches the mode every SpecBAS unit selects for itself. +# +# -Fi$(OBJDIR) is for the generated version include below. +FPCFLAGS := -MDelphi -Sh -O1 -vew -Fu$(SRC) -Fi$(SRC) -Fu$(UNITS) -Fi$(UNITS) \ + -Fi$(OBJDIR) + +# The version SpecBAS shows in Finder, taken from the same file the Windows +# build's VERSIONINFO resource is written in. +VERSION_RC := $(SRC)/SpecBAS.rc +VERSION := $(shell sed -n 's/^FILEVERSION *[0-9]*,[0-9]*,\([0-9]*\),\([0-9]*\).*/\1.\2/p' $(VERSION_RC)) +BUILDNUM := $(shell sed -n 's/^FILEVERSION *[0-9]*,[0-9]*,[0-9]*,\([0-9]*\).*/\1/p' $(VERSION_RC)) + +ifeq ($(UNAME_S),Darwin) +# -WM11.0 pins the deployment target to the macOS 11 floor the SDL2 release +# framework carries, so the build is not tied to whatever macOS built it. +# +# -undefined dynamic_lookup leaves the BASS imports unresolved at link time. +# bass.pas declares them "delayed", which Free Pascal honours on Windows +# only; elsewhere they are ordinary imports and the link fails with no BASS +# library present. SpecBAS loads BASS by hand at startup and runs silent +# when that fails, so nothing calls those symbols while the library is +# absent. +FPCFLAGS += -WM11.0 -Fl$(LINKDIR) -k-rpath -k@executable_path/../Frameworks \ + -k-undefined -kdynamic_lookup +LINKDEPS := $(LINKDIR)/libSDL2.dylib +else +# The same BASS problem, answered in two pieces because GNU ld fails earlier +# than Apple's linker does. +# +# 1. bass.pas names its library libbass.so, which fpc hands to the linker +# as -lbass, so the link dies on a missing library before it reaches +# the symbols. build/link/libbass.so is an empty GNU ld linker script: +# -lbass finds it, it contributes nothing, and unlike a stub shared +# object it leaves no DT_NEEDED behind, so the finished executable does +# not ask for a BASS library at run time either. +# 2. --unresolved-symbols=ignore-all then lets the BASS_ symbols stay +# undefined, which is what "delayed" does on Windows. +FPCFLAGS += -Fl$(LINKDIR) -k--unresolved-symbols=ignore-all +LINKDEPS := $(LINKDIR)/libbass.so +endif + +.PHONY: all deps exe app clean distclean + +all: exe + +deps: + @$(HERE)/fetch-deps.sh + +$(LINKDIR)/libSDL2.dylib: $(FRAMEWORK)/Versions/A/SDL2 + @mkdir -p $(LINKDIR) + @ln -sf $(FRAMEWORK)/Versions/A/SDL2 $@ + +$(LINKDIR)/libbass.so: + @mkdir -p $(LINKDIR) + @printf '/* Empty linker script. See the BASS note in build-sdl2/Makefile. */\n' > $@ + +# The version SpecBAS puts in its window title and in BUILDSTR. +# +# On Windows it comes from the executable's own VERSIONINFO resource, read +# back at run time. src/SpecBAS.rc is where that resource is written, so it +# is the project's one statement of its own version, and this build reads +# the same file rather than keeping a second copy of the number. +# +# Only the last two of the four components are used, because that is what +# the Windows title bar shows: FILEVERSION 0,0,0,1511 is 0.1511 there and +# 0.1511 here. +VERSION_INC := $(OBJDIR)/SpecBAS_Version.inc + +$(VERSION_INC): $(VERSION_RC) + @mkdir -p $(OBJDIR) + @sed -n 's/^FILEVERSION *\([0-9]*\),\([0-9]*\),\([0-9]*\),\([0-9]*\).*/'"'"'\3.\4'"'"'/p' \ + $(VERSION_RC) > $@ + @test -s $@ || { echo "Makefile: no FILEVERSION in $(VERSION_RC)" >&2; rm -f $@; exit 1; } + +exe: $(LINKDEPS) $(VERSION_INC) + @mkdir -p $(OBJDIR) + $(FPC) $(FPCFLAGS) -FU$(OBJDIR) -FE$(OBJDIR) -o$(OBJDIR)/$(BIN_NAME) $(PROGRAM) + +app: exe +ifeq ($(UNAME_S),Darwin) + @$(HERE)/bundle.sh $(OBJDIR)/$(BIN_NAME) $(FRAMEWORK) $(APP) $(BIN_NAME) \ + $(VERSION) $(BUILDNUM) +else + @echo "make app builds a macOS application bundle; on $(UNAME_S) the" + @echo "executable in $(OBJDIR) is the build product." +endif + +clean: + rm -rf $(BUILD) + +distclean: clean + rm -rf $(VENDOR) diff --git a/build-sdl2/bundle.sh b/build-sdl2/bundle.sh new file mode 100755 index 0000000..5783fc2 --- /dev/null +++ b/build-sdl2/bundle.sh @@ -0,0 +1,71 @@ +#!/usr/bin/env bash +# bundle.sh +# +# Assemble a self-contained .app: the executable, an Info.plist, and SDL2 +# inside the bundle. The result runs on a machine with no toolchain and no +# system SDL2. +# +# Three facts have to agree, and none of them is set here: +# +# 1. SDL2.framework's own install name is +# @rpath/SDL2.framework/Versions/A/SDL2, which is what the release +# framework ships with. +# 2. The executable records that same dependency, picked up at link time +# through the symlink the Makefile makes. +# 3. The executable carries an rpath of @executable_path/../Frameworks, +# which from Contents/MacOS is Contents/Frameworks, where the framework +# is copied. +# +# So nothing needs install_name_tool, and because nothing is rewritten the +# framework's signature survives the copy. + +set -euo pipefail + +exe="${1:?executable}" +framework="${2:?SDL2.framework}" +app="${3:?out .app}" +binname="${4:?bin name}" +version="${5:?version}" +buildnum="${6:?build number}" + +contents="${app}/Contents" + +rm -rf "${app}" +mkdir -p "${contents}/MacOS" "${contents}/Frameworks" "${contents}/Resources" + +cp "${exe}" "${contents}/MacOS/${binname}" +# ditto keeps the framework's symlinks and signature; cp -R does not. +ditto "${framework}" "${contents}/Frameworks/SDL2.framework" + +cat > "${contents}/Info.plist" < + + + + CFBundleDevelopmentRegion en + CFBundleExecutable ${binname} + CFBundleIdentifier org.specos.SpecBAS + CFBundleInfoDictionaryVersion 6.0 + CFBundleName $(basename "${app}" .app) + CFBundlePackageType APPL + CFBundleShortVersionString ${version} + CFBundleVersion ${buildnum} + LSMinimumSystemVersion 11.0 + NSHighResolutionCapable + NSPrincipalClass NSApplication + + +PLIST + +# Ad-hoc signature. Apple Silicon refuses to run an unsigned Mach-O. +# --deep is deprecated, so each piece is named, innermost first. +codesign --force --sign - --timestamp=none \ + "${contents}/Frameworks/SDL2.framework" >/dev/null 2>&1 +codesign --force --sign - --timestamp=none \ + "${contents}/MacOS/${binname}" >/dev/null 2>&1 +codesign --force --sign - --timestamp=none "${app}" >/dev/null 2>&1 + +echo "==> ${app}" +codesign --verify --deep --verbose=1 "${app}" 2>&1 | sed 's/^/ /' +echo " executable links:" +otool -L "${contents}/MacOS/${binname}" | tail -n +2 | sed 's/^/ /' diff --git a/build-sdl2/fetch-deps.sh b/build-sdl2/fetch-deps.sh new file mode 100755 index 0000000..734872f --- /dev/null +++ b/build-sdl2/fetch-deps.sh @@ -0,0 +1,120 @@ +#!/usr/bin/env bash +# +# Put the outside pieces the SDL2 build needs into vendor/: +# +# vendor/SDL2-for-Pascal/ the Pascal bindings, all platforms +# vendor/SDL2.framework the SDL2 runtime for the bundle, macOS only +# +# vendor/ is gitignored. Everything fetched here is pinned and checked, so +# this script is the tracked half and vendor/ is disposable. +# +# On Linux SDL2 comes from the distribution instead: the bindings name +# libSDL2.so, fpc turns that into -lSDL2, and the development package +# supplies both. This script checks it is there and says what to install if +# it is not. +# +# On macOS the runtime is the release framework from libsdl.org rather than +# Homebrew's sdl2, which is sdl2-compat: a shim that reaches SDL3 by dlopen +# at run time, so copying it into a bundle copies something that then looks +# for an SDL3 the target machine has no reason to have. Homebrew also builds +# to the host's own macOS version, so the result refuses to load on anything +# older. The release framework is built for this job: its LC_ID_DYLIB is +# already @rpath/SDL2.framework/Versions/A/SDL2, it is universal, and its +# minimum is macOS 11. +# +# The disk image is mounted with hdiutil rather than unpacked with an +# archiver. A framework is held together by symlinks, and an archiver writes +# those out as small text files, which gives a directory that looks right, +# fails to load, and fails codesign. + +set -euo pipefail + +here="$(cd "$(dirname "${BASH_SOURCE[0]}")" && pwd -P)" +vendor="${here}/vendor" +work="${vendor}/.download" + +SDL2_VERSION="2.32.8" +SDL2_DMG_SHA256="de07f71cc85cd8909c977e105c4f2ca419abd09b981c347e003592186caf6fa0" +SDL2_DMG_URL="https://github.com/libsdl-org/SDL/releases/download/release-${SDL2_VERSION}/SDL2-${SDL2_VERSION}.dmg" + +BINDINGS_URL="https://github.com/PascalGameDevelopment/SDL2-for-Pascal.git" +BINDINGS_COMMIT="a48b83efbfa7c13ce548905ebdc954eb6c8384be" + +mkdir -p "${work}" + +# --- SDL2 runtime ------------------------------------------------------ + +case "$(uname -s)" in +Darwin) + if [[ -d "${vendor}/SDL2.framework" ]]; then + echo "==> SDL2.framework already present" + else + dmg="${work}/SDL2-${SDL2_VERSION}.dmg" + if [[ ! -f "${dmg}" ]]; then + echo "==> downloading SDL2 ${SDL2_VERSION}" + curl -fsSL -o "${dmg}" "${SDL2_DMG_URL}" + fi + + got="$(shasum -a 256 "${dmg}" | awk '{print $1}')" + if [[ "${got}" != "${SDL2_DMG_SHA256}" ]]; then + echo "fetch-deps.sh: sha256 mismatch for ${dmg}" >&2 + echo " expected ${SDL2_DMG_SHA256}" >&2 + echo " got ${got}" >&2 + exit 1 + fi + + # The mount point is hdiutil's own choice, read back out of its + # output. Naming one under this directory is refused where the + # repository is on a secondary volume. + echo "==> mounting ${dmg}" + mnt="$(hdiutil attach -nobrowse -readonly "${dmg}" \ + | sed -n 's#.*\(/Volumes/.*\)$#\1#p' | tail -1)" + if [[ -z "${mnt}" || ! -d "${mnt}/SDL2.framework" ]]; then + echo "fetch-deps.sh: could not mount ${dmg}" >&2 + exit 1 + fi + trap 'hdiutil detach -quiet "'"${mnt}"'" >/dev/null 2>&1 || true' EXIT + + echo "==> copying SDL2.framework into vendor/" + # ditto, not cp -R: it keeps the symlinks, permissions and extended + # attributes that leave the framework's signature intact. + ditto "${mnt}/SDL2.framework" "${vendor}/SDL2.framework" + cp "${mnt}/License.txt" "${vendor}/SDL2-License.txt" + + hdiutil detach -quiet "${mnt}" || true + trap - EXIT + fi + + codesign --verify --verbose=1 "${vendor}/SDL2.framework" 2>&1 | sed 's/^/ /' + ;; +Linux) + if command -v sdl2-config >/dev/null 2>&1; then + echo "==> system SDL2 $(sdl2-config --version)" + elif command -v pkg-config >/dev/null 2>&1 && pkg-config --exists sdl2; then + echo "==> system SDL2 $(pkg-config --modversion sdl2)" + else + echo "fetch-deps.sh: SDL2 development files not found." >&2 + echo " Debian, Ubuntu, Raspberry Pi OS: sudo apt install libsdl2-dev" >&2 + echo " Fedora: sudo dnf install SDL2-devel" >&2 + echo " Arch: sudo pacman -S sdl2" >&2 + exit 1 + fi + ;; +*) + echo "==> $(uname -s): assuming SDL2 is supplied by the system" + ;; +esac + +# --- SDL2-for-Pascal --------------------------------------------------- + +if [[ -d "${vendor}/SDL2-for-Pascal/.git" ]]; then + echo "==> SDL2-for-Pascal already present" +else + echo "==> cloning SDL2-for-Pascal" + rm -rf "${vendor}/SDL2-for-Pascal" + git clone --quiet "${BINDINGS_URL}" "${vendor}/SDL2-for-Pascal" +fi +git -C "${vendor}/SDL2-for-Pascal" checkout --quiet "${BINDINGS_COMMIT}" +echo " bindings at $(git -C "${vendor}/SDL2-for-Pascal" rev-parse HEAD)" + +echo "==> vendor/ ready" diff --git a/src/RunTimeCompiler.pas b/src/RunTimeCompiler.pas index d867016..40e335f 100644 --- a/src/RunTimeCompiler.pas +++ b/src/RunTimeCompiler.pas @@ -29,7 +29,9 @@ TPayload = class(TObject) implementation uses - SysUtils, ActiveX, SP_Tokenise, SP_Util, SP_BankFiling, SP_SysVars; + // ActiveX is a Windows unit and supplies IsEqualGUID there. Off Windows + // the same function comes from SysUtils. + SysUtils, {$IFNDEF UNIX}ActiveX, {$ENDIF}SP_Tokenise, SP_Util, SP_BankFiling, SP_SysVars; type TPayloadFooter = packed record diff --git a/src/SP_BankManager.pas b/src/SP_BankManager.pas index f1cdbfe..6c16c26 100644 --- a/src/SP_BankManager.pas +++ b/src/SP_BankManager.pas @@ -224,7 +224,7 @@ interface implementation -Uses MainForm, {$IFNDEF RUNTIMEONLY}SP_FPEditor, SP_BASICEditorHostUnit, SP_ToolTipWindow, {$ENDIF} +Uses {$IFDEF SDL2}SP_SDL2Host{$ELSE}MainForm{$ENDIF}, {$IFNDEF RUNTIMEONLY}SP_FPEditor, SP_BASICEditorHostUnit, SP_ToolTipWindow, {$ENDIF} SP_Graphics, SP_Graphics32, SP_Sound, SP_Main, SP_BaseComponentUnit, SP_3DEngineUnit; Procedure SP_ChangeBankSize(Index: Integer); diff --git a/src/SP_CheckBoxUnit.pas b/src/SP_CheckBoxUnit.pas index 8f024a4..04667a7 100644 --- a/src/SP_CheckBoxUnit.pas +++ b/src/SP_CheckBoxUnit.pas @@ -60,7 +60,7 @@ interface implementation -Uses {$IFNDEF FPC}Windows{$ELSE}LCLType{$ENDIF}, Types, Classes, Math, SP_Interpret_PostFix, SP_Input, SP_Components, SP_Sound, SP_SysVars; +Uses {$IFNDEF FPC}Windows, {$ELSE}{$IFNDEF SDL2}LCLType, {$ENDIF}{$ENDIF}Types, Classes, Math, SP_Interpret_PostFix, SP_Input, SP_Components, SP_Sound, SP_SysVars; // SP_CheckBox diff --git a/src/SP_Components.pas b/src/SP_Components.pas index 91be103..8a82d4f 100644 --- a/src/SP_Components.pas +++ b/src/SP_Components.pas @@ -23,7 +23,7 @@ interface Uses Types, SysUtils, {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, Classes, SyncObjs, Math, - {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}ClipBrd{$ENDIF}, SP_SysVars, SP_FileIO, SP_Util, SP_ButtonUnit, SP_BaseComponentUnit, SP_Errors; + {$IFNDEF FPC}Vcl.ClipBrd, {$ELSE}{$IFNDEF SDL2}ClipBrd, {$ENDIF}{$ENDIF}SP_SysVars, SP_FileIO, SP_Util, SP_ButtonUnit, SP_BaseComponentUnit, SP_Errors; // A collection of UI elements for building UI apps. Based on Windows controls. diff --git a/src/SP_DebugPanel.pas b/src/SP_DebugPanel.pas index 7653138..f59e7be 100644 --- a/src/SP_DebugPanel.pas +++ b/src/SP_DebugPanel.pas @@ -4,7 +4,7 @@ interface -uses Dialogs, Math, Classes, SyncObjs, SysUtils, SP_Util, SP_BaseComponentUnit, SP_ListBoxUnit, SP_ComboBoxUnit, SP_ControlMsgs, SP_ButtonUnit, SP_Input, SP_ContainerUnit, SP_AmigaGuideUnit; +uses {$IFNDEF SDL2}Dialogs, {$ENDIF}Math, Classes, SyncObjs, SysUtils, SP_Util, SP_BaseComponentUnit, SP_ListBoxUnit, SP_ComboBoxUnit, SP_ControlMsgs, SP_ButtonUnit, SP_Input, SP_ContainerUnit, SP_AmigaGuideUnit; Type @@ -73,7 +73,7 @@ interface implementation -Uses {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}ClipBrd{$ENDIF}, SP_FPEditor, SP_Errors, SP_Graphics, SP_BankManager, SP_BankFiling, SP_SysVars, SP_Components, SP_Variables, SP_AnsiStringList, +Uses {$IFNDEF FPC}Vcl.ClipBrd, {$ELSE}{$IFNDEF SDL2}ClipBrd, {$ENDIF}{$ENDIF}SP_FPEditor, SP_Errors, SP_Graphics, SP_BankManager, SP_BankFiling, SP_SysVars, SP_Components, SP_Variables, SP_AnsiStringList, SP_Interpret_PostFix, SP_FileIO, SP_Main, SP_MenuActions, SP_BASICEditorHostUnit, SP_MemoUnit, SP_Debugging, SP_Execute; Procedure SP_UpdateAfterDebug; diff --git a/src/SP_Display.pas b/src/SP_Display.pas index 07c850d..bb8ac25 100644 --- a/src/SP_Display.pas +++ b/src/SP_Display.pas @@ -13,9 +13,11 @@ interface {$ENDIF} MultiMon, {$ELSE} + SysUtils, SyncObjs, Types, {$IFDEF UNIX}Unix, BaseUnix,{$ENDIF} {$ENDIF} - Graphics, Forms, Classes, Math, {$IFNDEF FPC}PNGImage,{$ENDIF} MainForm, + {$IFNDEF SDL2}Graphics, Forms,{$ENDIF} Classes, Math, {$IFNDEF FPC}PNGImage,{$ENDIF} + {$IFDEF SDL2}SP_SDL2Backend, SP_SDL2Host,{$ELSE}MainForm,{$ENDIF} SP_FileIO, {$IFDEF OPENGL} {$IFDEF FPC}OpenGLContext, GL, GLExt,{$ELSE}dglOpenGL,{$ENDIF} @@ -31,7 +33,7 @@ interface End; {$ENDIF} - {$IFDEF FPC} + {$IF DEFINED(FPC) AND NOT DEFINED(SDL2)} Type TPNGImage = TPortableNetworkGraphic; {$ENDIF} @@ -108,6 +110,11 @@ interface // This will store the actual integer scale used for the first NN pass ActualNNScaleFactor: Integer; // Can be float if you allow non-uniform NN scaling {$ENDIF} + {$IFDEF SDL2} + ReScaleFlag: Boolean; + PixArray: Array of Byte; + CurrentOutputWidth, CurrentOutputHeight: Integer; // Actual window client size + {$ENDIF} // DoScale: Boolean = False; // Removed // ScaleFactor: Integer = 1; // Removed ScaleMouseX, ScaleMouseY: aFloat; @@ -159,7 +166,8 @@ interface implementation -Uses SP_SysVars, SP_Graphics, SP_Graphics32, SP_Main, SP_Tokenise, SP_Errors; +Uses SP_SysVars, SP_Graphics, SP_Graphics32, SP_Main, SP_Tokenise, SP_Errors + {$IFDEF SDL2}, FPImage, FPWritePNG{$ENDIF}; procedure SetPerformingDisplayChange(Value: Boolean); begin @@ -487,8 +495,12 @@ function CreateShaderProgram(const VertSource, FragSource: PAnsiChar): GLuint; Var p: TPoint; Begin + {$IFDEF SDL2} + SDLB_GetMousePos(p.X, p.Y); + {$ELSE} GetCursorPos(p); p := Main.ScreenToClient(p); + {$ENDIF} // ScaleMouseX/Y are calculated in SetScaling based on logical vs client size MOUSEX := Integer(Round(p.X / ScaleMouseX)); MOUSEY := Integer(Round(p.Y / ScaleMouseY)); @@ -762,10 +774,25 @@ procedure SmartSleep(const AMilliseconds: aFloat); Result := False; If Not (Quitting or SCREENCHANGE) Then Begin If (Not SCREENLOCK) or UPDATENOW Then Begin + + {$IFDEF SDL2} + // The pointer's rectangle, before the frame is tested for work, and + // started where the image is actually drawn: MOUSEX - MOUSEHSX. + If MOUSEVISIBLE And ((MOUSESTOREX <> MOUSEX) or (MOUSESTOREY <> MOUSEY)) Then Begin + SP_SetDirtyRect(Min(MOUSEX, MOUSESTOREX) - MOUSEHSX, + Min(MOUSEY, MOUSESTOREY) - MOUSEHSY, + Max(MOUSEX, MOUSESTOREX) - MOUSEHSX + MOUSEW, + Max(MOUSEY, MOUSESTOREY) - MOUSEHSY + MOUSEH); + MOUSESTOREX := MOUSEX; + MOUSESTOREY := MOUSEY; + End; + {$ENDIF} + If SCMAXX >= SCMINX Then Begin // SCMINX/Y/MAXX/Y are dirty rect in logical coordinates While SetDR Do Sleep(1); SetDR := True; // Ensure SetDR is thread-safe if accessed elsewhere If SHOWFPS Then PrepFPSVars; + {$IFNDEF SDL2} If (MOUSESTOREX <> MOUSEX) or (MOUSESTOREY <> MOUSEY) Then Begin X1 := Min(MOUSEX, MOUSESTOREX); Y1 := Min(MOUSEY, MOUSESTOREY); @@ -775,6 +802,7 @@ procedure SmartSleep(const AMilliseconds: aFloat); MOUSESTOREX := MOUSEX; MOUSESTOREY := MOUSEY; End; + {$ENDIF} X1 := SCMINX; Y1 := SCMINY; X2 := SCMAXX +1; Y2 := SCMAXY +1; @@ -1007,7 +1035,13 @@ procedure SmartSleep(const AMilliseconds: aFloat); {$ELSE} // Not OPENGL If StartTime = 0 Then StartTime := CB_GetTicks; + {$IFDEF SDL2} + // One upload of the whole logical screen, one stretched copy into the + // window, one present. + SDLB_Present(DISPLAYPOINTER, DISPLAYSTRIDE); + {$ELSE} StretchBlt(Main.Canvas.Handle, 0, 0, Main.ClientWidth, Main.ClientHeight, Bitmap.Canvas.Handle, 0, 0, DISPLAYWIDTH, DISPLAYHEIGHT, SrcCopy); + {$ENDIF} {$ENDIF} // OPENGL End; @@ -1061,10 +1095,40 @@ procedure SmartSleep(const AMilliseconds: aFloat); ReScaleFlag := True; // Signal GLResize/SetupFBO needs to run {$ELSE} + {$IFDEF SDL2} + CurrentOutputWidth := OutputClientWidth; + CurrentOutputHeight := OutputClientHeight; + + if (InternalWidth <= 0) or (InternalHeight <= 0) then + begin + ScaleMouseX := 1.0; + ScaleMouseY := 1.0; + end + else + begin + ScaleMouseX := OutputClientWidth / InternalWidth; + ScaleMouseY := OutputClientHeight / InternalHeight; + end; + + DISPLAYWIDTH := InternalWidth; + DISPLAYHEIGHT := InternalHeight; + DISPLAYSTRIDE := InternalWidth * 4; + If (Length(PixArray) <> DISPLAYSTRIDE * InternalHeight) or (DISPLAYPOINTER = nil) then + Begin + SetLength(PixArray, DISPLAYSTRIDE * InternalHeight); + if Length(PixArray) > 0 then FillChar(PixArray[0], Length(PixArray), 0); + if Length(PixArray) > 0 then DISPLAYPOINTER := @PixArray[0] else DISPLAYPOINTER := nil; + End; + + // The streaming texture is the logical screen, not the window. + SDLB_SetLogicalSize(InternalWidth, InternalHeight); + ReScaleFlag := True; + {$ELSE} Main.CreateGDIBitmap; ScaleMouseX := OutputClientWidth / InternalWidth; ScaleMouseY := OutputClientHeight / InternalHeight; {$ENDIF} + {$ENDIF} End; Function SetScreen(Width, Height, sWidth, sHeight: Integer; FullScreen, AllowResize: Boolean): Integer; @@ -1082,7 +1146,7 @@ procedure SmartSleep(const AMilliseconds: aFloat); {$ENDIF} Try Result := 0; - {$IFDEF OPENGL} + {$IF DEFINED(OPENGL) OR DEFINED(SDL2)} oW := CurrentOutputWidth; // Previously SCALEWIDTH oH := CurrentOutputHeight; // Previously SCALEHEIGHT {$ELSE} @@ -1128,9 +1192,17 @@ procedure SmartSleep(const AMilliseconds: aFloat); {$ENDIF} SetScreenResolution(sWidth, sHeight, FullScreen); // This changes physical screen res / window style End Else - {$IFDEF OpenGL}ReScaleFlag := True{$ENDIF}; // Only scaling parameters changed, or no change - + {$IF DEFINED(OpenGL) OR DEFINED(SDL2)}ReScaleFlag := True{$ENDIF}; // Only scaling parameters changed, or no change + + {$IFDEF SDL2} + // What SPI_GETWORKAREA reports is the desktop less whatever the window + // manager keeps for itself, which is SDL2's usable bounds. + SDLB_GetUsableBounds(r.Left, r.Top, r.Right, r.Bottom); + r.Right := r.Left + r.Right; + r.Bottom := r.Top + r.Bottom; + {$ELSE} SystemParametersInfo(SPI_GETWORKAREA, 0, @r, 0); + {$ENDIF} If FullScreen Then Begin SP_GetMonitorMetrics; // Updates REALSCREENLEFT, TOP, WIDTH, HEIGHT @@ -1184,6 +1256,48 @@ procedure SmartSleep(const AMilliseconds: aFloat); End; End; +{$IFDEF SDL2} +Function GetScreenRefreshRate: aFloat; +Begin + Result := SDLB_GetRefreshRate; + + // Guard against zero/invalid return (a display that reports no rate) + If Result < 10 Then + Result := 50; +End; + +procedure SP_GetMonitorMetrics; +Var + X, Y, W, H: Integer; +Begin + SDLB_GetDisplayBounds(X, Y, W, H); + REALSCREENLEFT := X; + REALSCREENTOP := Y; + REALSCREENWIDTH := W; + REALSCREENHEIGHT := H; +End; + +function TestScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boolean; +Begin + SP_GetMonitorMetrics; + // Fullscreen is desktop fullscreen - the logical screen is stretched to + // the display rather than the display being switched to another mode - so + // any size is available. A window only has to fit, and SDL2 measures it by + // its client area, so there is no border to allow for. + If FullScreen Then + Result := True + Else + Result := (Width <= REALSCREENWIDTH) and (Height <= REALSCREENHEIGHT); +End; + +function SetScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boolean; +Begin + SP_GetMonitorMetrics; + Result := SDLB_SetFullScreen(FullScreen); + SPFULLSCREEN := FullScreen; + SP_SetFPS(GetScreenRefreshrate); // In case we have a changed refresh rate +End; +{$ELSE} Function GetScreenRefreshRate: aFloat; var DeviceMode: TDeviceMode; @@ -1332,6 +1446,7 @@ function SetScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boole End; SP_SetFPS(GetScreenRefreshrate); // In case we have a changed refresh rate end; +{$ENDIF} {$IFDEF OpenGL} Procedure EnsureMainTextureIsSetup; // NEW HELPER specifically for MainTextureID @@ -1476,6 +1591,57 @@ function SetScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boole End; {$ENDIF} +{$IFDEF SDL2} +Procedure ScreenShot(fullWindow: Boolean); +Var + Img: TFPMemoryImage; + Writer: TFPWriterPNG; + Row: pLongWord; + Px: LongWord; + Clr: TFPColor; + X, Y: Integer; + FName, FileName: String; + Error: TSP_ErrorCode; +Begin + // fullWindow makes no difference here. The window shows nothing the + // logical screen does not already hold, because the renderer only ever + // stretches that one buffer to fill it. + If Not Assigned(DISPLAYPOINTER) or (Length(PixArray) = 0) Then Exit; + + If Not DirectoryExists(String(HOMEFOLDER) + PathDelim + 'snaps') Then + CreateDir(String(HOMEFOLDER) + PathDelim + 'snaps'); + + FName := Format('/snaps/%s.png', ['Screenshot_' + FormatDateTime('mm-dd-yyyy-hhnnss', Now())]); + Filename := String(SP_ConvertFilenameToHost(aString(FName), Error)); + + Img := TFPMemoryImage.Create(DISPLAYWIDTH, DISPLAYHEIGHT); + Try + Clr.alpha := alphaOpaque; + For Y := 0 To DISPLAYHEIGHT -1 Do Begin + Row := pLongWord(NativeUInt(DISPLAYPOINTER) + NativeUInt(Y * DISPLAYSTRIDE)); + For X := 0 To DISPLAYWIDTH -1 Do Begin + // A pixel is B, G, R, A in memory. fcl-image wants sixteen bits a + // channel, so each byte is doubled into its channel. + Px := Row^; + Clr.red := ((Px shr 16) and $FF) * $101; + Clr.green := ((Px shr 8) and $FF) * $101; + Clr.blue := (Px and $FF) * $101; + Img.Colors[X, Y] := Clr; + Inc(Row); + End; + End; + Writer := TFPWriterPNG.Create; + Try + Writer.UseAlpha := False; + Img.SaveToFile(Filename, Writer); + Finally + Writer.Free; + End; + Finally + Img.Free; + End; +End; +{$ELSE} Procedure ScreenShot(fullWindow: Boolean); {$IFDEF OPENGL} var @@ -1568,6 +1734,7 @@ function SetScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boole end; {$ENDIF} // OPENGL end; +{$ENDIF} // SDL2 Initialization diff --git a/src/SP_EditUnit.pas b/src/SP_EditUnit.pas index eede001..54d94ec 100644 --- a/src/SP_EditUnit.pas +++ b/src/SP_EditUnit.pas @@ -99,7 +99,7 @@ interface implementation -Uses Math, SysUtils, SP_Components, SP_SysVars, SP_Input, SP_Sound, {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}ClipBrd{$ENDIF}, SP_Interpret_PostFix, SP_BankManager, SP_BankFiling; +Uses Math, SysUtils, SP_Components, SP_SysVars, SP_Input, SP_Sound, {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}{$IFDEF SDL2}SP_SDL2Compat{$ELSE}ClipBrd{$ENDIF}{$ENDIF}, SP_Interpret_PostFix, SP_BankManager, SP_BankFiling; // SP_Edit diff --git a/src/SP_Editor.pas b/src/SP_Editor.pas index fc7563a..460a85a 100644 --- a/src/SP_Editor.pas +++ b/src/SP_Editor.pas @@ -25,7 +25,7 @@ interface -Uses {$IFNDEF FPC}Windows{$ELSE}LCLType{$ENDIF}, Types, Math, SP_SysVars, SysUtils, SP_Util, SP_Graphics, SP_BankManager, SP_Tokenise, SP_Errors, SP_Input, +Uses {$IFNDEF FPC}Windows, {$ELSE}{$IFNDEF SDL2}LCLType, {$ENDIF}{$ENDIF}Types, Math, SP_SysVars, SysUtils, SP_Util, SP_Graphics, SP_BankManager, SP_Tokenise, SP_Errors, SP_Input, Classes, SP_InfixToPostFix, SP_Interpret_PostFix, SP_Variables, SP_Sound, SP_Package, SP_FileIO, SP_Graphics32, SP_BankFiling, SP_AnsiStringlist, RunTimeCompiler; Procedure SP_DrawStripe(Dst: pByte; Width, StripeWidth, StripeHeight: Integer); diff --git a/src/SP_FileIO.pas b/src/SP_FileIO.pas index d1e1bf5..7acbf26 100644 --- a/src/SP_FileIO.pas +++ b/src/SP_FileIO.pas @@ -26,7 +26,7 @@ interface Uses {$IFNDEF FPC}Windows, {$ENDIF}Types, Classes, SysUtils, SyncObjs, SP_Util, SP_Errors, - SP_SysVars, SP_Variables, SP_InfixToPostFix{$IFDEF FPC}, FileUtil{$ENDIF}, SP_AnsiStringlist; + SP_SysVars, SP_Variables, SP_InfixToPostFix{$IFDEF FPC}, {$IFDEF SDL2}SP_SDL2Compat{$ELSE}FileUtil{$ENDIF}{$ENDIF}, SP_AnsiStringlist; Type @@ -138,7 +138,7 @@ implementation If cpy Then Begin SP_PRINT(-1, Round(PRPOSX), Round(PRPOSY), -1, 'Copying '+ aString(DestName), 0, 8, Err); {$IFDEF FPC} - FileUtil.CopyFile(SrcName, DestName, True); + {$IFDEF SDL2}SP_SDL2Compat{$ELSE}FileUtil{$ENDIF}.CopyFile(SrcName, DestName, True); {$ENDIF} End Else SP_PRINT(-1, Round(PRPOSX), Round(PRPOSY), -1, 'Skipped '+ aString(DestName), 2, 8, Err); diff --git a/src/SP_FileListBoxUnit.pas b/src/SP_FileListBoxUnit.pas index 32df295..7acfe0c 100644 --- a/src/SP_FileListBoxUnit.pas +++ b/src/SP_FileListBoxUnit.pas @@ -4,7 +4,7 @@ interface -Uses {$IFNDEF FPC}Windows{$ELSE}LCLType{$ENDIF}, Classes, Math, {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, +Uses {$IFNDEF FPC}Windows, {$ELSE}{$IFNDEF SDL2}LCLType, {$ENDIF}{$ENDIF}Classes, Math, {$IFNDEF FPC}System.Generics.Collections{$ELSE}Generics.Collections{$ENDIF}, SP_BaseComponentUnit, SP_Components, SP_ListBoxUnit, SP_Util, SP_AnsiStringlist, SP_Errors; Type diff --git a/src/SP_Graphics.pas b/src/SP_Graphics.pas index b978c48..e188637 100644 --- a/src/SP_Graphics.pas +++ b/src/SP_Graphics.pas @@ -29,7 +29,7 @@ interface Uses - Types, Math, Classes, GraphUtil, SyncObjs, SP_SysVars, SP_Errors, SP_Util, SP_BankManager, SP_BankFiling, SP_FileIO, SP_Streams, SP_Menu; + Types, Math, Classes, {$IFNDEF SDL2}GraphUtil, {$ENDIF}SyncObjs, SP_SysVars, SP_Errors, SP_Util, SP_BankManager, SP_BankFiling, SP_FileIO, SP_Streams, SP_Menu; Type diff --git a/src/SP_Graphics32.pas b/src/SP_Graphics32.pas index 4c02225..e28e91c 100644 --- a/src/SP_Graphics32.pas +++ b/src/SP_Graphics32.pas @@ -511,6 +511,27 @@ procedure DrawDropShadow(ParentPtr: Pointer; ParentW, ParentH, ParentPitch: Inte // Builds the display using the UpdateRects[] array of non-overlapping rectangles. + {$IFDEF SDL2} + // A shadow blurs from the buffer it blends into, so it must be composited + // whole. Widen the rectangle to any shadow it touches. + For BankIdx := 0 To Length(SP_BankList) - 1 Do Begin + If SP_BankList[BankIdx]^.DataType <> SP_WINDOW_BANK Then Continue; + sPtr := @SP_BankList[BankIdx].Info[0]; + If (Not sPtr^.Visible) or (Not sPtr^.DropShadow) Then Continue; + shadowR := IfThen(sPtr^.ShadowSize > 0, sPtr^.ShadowSize, dsBlurRadius); + sw1 := sPtr^.Left + dsOffsetX - shadowR; + sh1 := sPtr^.Top + dsOffsetY - shadowR; + sw2 := sPtr^.Left + sPtr^.Width - 1 + dsOffsetX + shadowR; + sh2 := sPtr^.Top + sPtr^.Height - 1 + dsOffsetY + shadowR; + If IntersectRect32(sw1, sh1, sw2, sh2, X1, Y1, X2 - 1, Y2 - 1) <> -1 Then Begin + If sw1 < X1 Then X1 := sw1; + If sh1 < Y1 Then Y1 := sh1; + If sw2 + 1 > X2 Then X2 := sw2 + 1; + If sh2 + 1 > Y2 Then Y2 := sh2 + 1; + End; + End; + {$ENDIF} + X1 := InRange(x1, 0, DISPLAYWIDTH); x2 := InRange(x2, 0, DISPLAYWIDTH); y1 := InRange(y1, 0, DISPLAYHEIGHT); @@ -4279,7 +4300,7 @@ procedure SP_VScroll32(Dst: pByte; Width, Height, Amount: Integer; Wrap: Boolean Inc(dPtr); Dec(W); End; - // Advance by remaining pixels in row × 4 bytes. + // Advance by remaining pixels in row � 4 bytes. Inc(pByte(sPtr), (BuffW - Bw) * SizeOf(LongWord)); Inc(pByte(dPtr), DstW - Bw * SizeOf(LongWord)); Dec(Bh); diff --git a/src/SP_InfixToPostFix.pas b/src/SP_InfixToPostFix.pas index 7ef185e..ca184e9 100644 --- a/src/SP_InfixToPostFix.pas +++ b/src/SP_InfixToPostFix.pas @@ -234,7 +234,7 @@ interface implementation -Uses SP_Interpret_PostFix, {$IFDEF FPC}LclIntf{$ELSE}Windows{$ENDIF}, SP_AnsiStringlist, SP_PreRun, SP_3DEngineUnit; +Uses SP_Interpret_PostFix, {$IFDEF FPC}{$IFNDEF SDL2}LclIntf, {$ENDIF}{$ELSE}Windows, {$ENDIF}SP_AnsiStringlist, SP_PreRun, SP_3DEngineUnit; Function CreateToken(tType: Byte; tVarious, tLength: LongWord): aString; Begin diff --git a/src/SP_Interpret_PostFix.pas b/src/SP_Interpret_PostFix.pas index d7dd915..a545317 100644 --- a/src/SP_Interpret_PostFix.pas +++ b/src/SP_Interpret_PostFix.pas @@ -25,9 +25,9 @@ interface -Uses SyncObjs, Forms, {$IFNDEF FPC}IOUtils,{$ELSE}FileUtil,{$ENDIF} SP_Util, SP_Graphics, SP_Graphics32, SP_SysVars, SP_Errors, SP_Components, SP_Tokenise, SP_InfixToPostFix, SP_FileIO, - SP_Input, SP_BankManager, SP_BankFiling, SP_Streams, SP_Sound, SP_Package, Math, Classes, SysUtils, SP_Math, {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}ClipBrd{$ENDIF}, - {$IFDEF FPC}LclIntf{$ELSE}Windows{$ENDIF}, SP_Strings, SP_Menu, SP_Dialogs, SP_AnsiStringlist, SP_Variables, SP_PreRun; +Uses SyncObjs, {$IFNDEF SDL2}Forms, {$ENDIF}{$IFNDEF FPC}IOUtils,{$ELSE}{$IFDEF SDL2}SP_SDL2Compat,{$ELSE}FileUtil,{$ENDIF}{$ENDIF} SP_Util, SP_Graphics, SP_Graphics32, SP_SysVars, SP_Errors, SP_Components, SP_Tokenise, SP_InfixToPostFix, SP_FileIO, + SP_Input, SP_BankManager, SP_BankFiling, SP_Streams, SP_Sound, SP_Package, Math, Classes, SysUtils, SP_Math{$IFNDEF FPC}, Vcl.ClipBrd{$ELSE}{$IFNDEF SDL2}, ClipBrd{$ENDIF}{$ENDIF}, + {$IFDEF FPC}{$IFNDEF SDL2}LclIntf, {$ENDIF}{$ELSE}Windows, {$ENDIF}SP_Strings, SP_Menu, SP_Dialogs, SP_AnsiStringlist, SP_Variables, SP_PreRun; Type diff --git a/src/SP_MemoUnit.pas b/src/SP_MemoUnit.pas index 8bfadb5..313887c 100644 --- a/src/SP_MemoUnit.pas +++ b/src/SP_MemoUnit.pas @@ -34,7 +34,7 @@ interface -Uses Math, SysUtils, {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}ClipBrd{$ENDIF}, Types, +Uses Math, SysUtils, {$IFNDEF FPC}Vcl.ClipBrd{$ELSE}{$IFDEF SDL2}SP_SDL2Compat{$ELSE}ClipBrd{$ENDIF}{$ENDIF}, Types, SP_BaseComponentUnit, SP_ContainerUnit, SP_EditUnit, SP_ButtonUnit, SP_Util, SP_Errors; diff --git a/src/SP_SDL2Backend.pas b/src/SP_SDL2Backend.pas new file mode 100644 index 0000000..7f2c335 --- /dev/null +++ b/src/SP_SDL2Backend.pas @@ -0,0 +1,427 @@ +// Copyright (C) 2026 By D. Rimron-Soutter +// +// This file is part of the SpecBAS BASIC Interpreter, which is in turn +// part of the SpecOS project. +// +// SpecBAS is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// SpecBAS is distributed in the hope that it will be entertaining, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with SpecBAS. If not, see . + +unit SP_SDL2Backend; + +// The host layer in SDL2 terms: one window, one renderer, one streaming +// texture, the clipboard, the display geometry and the clock. +// +// SpecBAS draws its whole picture itself into a 32-bit-per-pixel linear byte +// array. Moving that array to the screen once a frame is the only thing this +// unit does on the picture side: +// +// SDL_UpdateTexture(Tex, nil, Buffer, Pitch) +// SDL_RenderCopy(Ren, Tex, nil, nil) +// SDL_RenderPresent(Ren) +// +// Both rectangles are nil, so the texture is the logical screen size and the +// renderer stretches it to whatever size the window is. Nothing else has to +// know the window was resized. +// +// The texture format is SDL_PIXELFORMAT_ARGB8888, which on a little-endian +// machine lays a pixel down as B, G, R, A. That is the order SpecBAS already +// produces; the Windows OpenGL path uploads the same array as GL_BGRA. +// +// Vertical sync is off. SpecBAS paces its own frames in SP_Display.FrameLoop +// against the rate it was told, and a renderer synchronised to the display +// would pace them against a different number. +// +// Every call below that creates, changes or destroys the window or the +// texture runs on the thread that created the window, and is marshalled +// there when another thread asks for it. SpecBAS asks from its interpreter +// thread: SCREEN FULL reaches SDLB_SetFullScreen that way. On macOS, SDL2 +// answers SDL_SetWindowFullscreen by asking NSApplication for events while +// the transition runs, which AppKit permits from the main thread alone and +// otherwise refuses by raising an Objective-C exception that no Free Pascal +// handler catches. Confining the texture to the same thread serialises it +// with the frame present, which happens there too. + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$INCLUDE SpecBAS.inc} + +interface + +Uses SysUtils, Classes, SDL2; + +Var + + SDLB_Window: PSDL_Window = Nil; + SDLB_Renderer: PSDL_Renderer = Nil; + SDLB_Texture: PSDL_Texture = Nil; + + // The size of the streaming texture, which is SpecBAS's logical screen and + // not the window. + SDLB_TexWidth: Integer = 0; + SDLB_TexHeight: Integer = 0; + + Function SDLB_Start(Const Title: String; W, H: Integer): Boolean; + Procedure SDLB_Stop; + + // Match the texture to a new logical screen size. Idempotent, and cheap + // when the size has not changed. + Function SDLB_SetLogicalSize(W, H: Integer): Boolean; + + // Buffer is the first byte of the logical screen; Pitch is the distance in + // bytes from the start of one row to the start of the next. + Procedure SDLB_Present(Buffer: Pointer; Pitch: Integer); + + Procedure SDLB_SetTitle(Const Title: String); + Procedure SDLB_GetClientSize(Out W, H: Integer); + Procedure SDLB_SetClientSize(W, H: Integer); + Procedure SDLB_GetWindowPos(Out X, Y: Integer); + Procedure SDLB_SetWindowPos(X, Y: Integer); + Function SDLB_SetFullScreen(OnOff: Boolean): Boolean; + + // Bounds of the display the window is on, and the part of it a window may + // use once the desktop has reserved what it wants. + Procedure SDLB_GetDisplayBounds(Out X, Y, W, H: Integer); + Procedure SDLB_GetUsableBounds(Out X, Y, W, H: Integer); + Function SDLB_GetRefreshRate: Integer; + + // Where the pointer is in window coordinates, and whether it is over the + // window at all. + Function SDLB_GetMousePos(Out X, Y: Integer): Boolean; + Procedure SDLB_WarpMouse(X, Y: Integer); + + Function SDLB_GetClipboardText: String; + Procedure SDLB_SetClipboardText(Const S: String); + + // Milliseconds since SDLB_Start, from the high-resolution counter. + // SDL_GetTicks counts whole milliseconds, which is too coarse to pace a + // frame with. + Function SDLB_Milliseconds: Double; + +implementation + +Type + + // One window or texture call, parked for the owning thread to make. Run + // calls straight back into the public procedure, which by then finds + // itself on the owning thread and does the work. + TSDLB_CallKind = (ckFullScreen, ckClientSize, ckWindowPos, ckTitle, ckLogicalSize); + + TSDLB_Call = Class + Kind: TSDLB_CallKind; + W, H: Integer; + OnOff: Boolean; + Title: AnsiString; + Answer: Boolean; + Procedure Run; + End; + +Var + StartCounter: UInt64 = 0; + CounterFreq: Double = 1.0; + +// The window belongs to the thread that created it, which is the thread the +// program started on. +Function OnOwningThread: Boolean; +Begin + Result := GetCurrentThreadId = MainThreadID; +End; + +Function CallOnOwningThread(Kind: TSDLB_CallKind; W, H: Integer; OnOff: Boolean; + Const Title: AnsiString): Boolean; +Var + Call: TSDLB_Call; +Begin + Call := TSDLB_Call.Create; + Try + Call.Kind := Kind; + Call.W := W; + Call.H := H; + Call.OnOff := OnOff; + Call.Title := Title; + Call.Answer := False; + TThread.Synchronize(Nil, Call.Run); + Result := Call.Answer; + Finally + Call.Free; + End; +End; + +Procedure TSDLB_Call.Run; +Begin + Case Kind of + ckFullScreen: Answer := SDLB_SetFullScreen(OnOff); + ckClientSize: SDLB_SetClientSize(W, H); + ckWindowPos: SDLB_SetWindowPos(W, H); + ckTitle: SDLB_SetTitle(String(Title)); + ckLogicalSize: Answer := SDLB_SetLogicalSize(W, H); + End; +End; + +Function SDLB_Milliseconds: Double; +Begin + Result := ((SDL_GetPerformanceCounter - StartCounter) * 1000.0) / CounterFreq; +End; + +Function SDLB_Start(Const Title: String; W, H: Integer): Boolean; +Begin + Result := False; + + If SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER) <> 0 Then Exit; + + CounterFreq := SDL_GetPerformanceFrequency; + If CounterFreq <= 0 Then CounterFreq := 1.0; + StartCounter := SDL_GetPerformanceCounter; + + SDLB_Window := SDL_CreateWindow(PAnsiChar(AnsiString(Title)), + SDL_WINDOWPOS_CENTERED, + SDL_WINDOWPOS_CENTERED, + W, H, + SDL_WINDOW_SHOWN or SDL_WINDOW_RESIZABLE); + If SDLB_Window = Nil Then Exit; + + // No SDL_RENDERER_PRESENTVSYNC; see the note at the top of the unit. + SDLB_Renderer := SDL_CreateRenderer(SDLB_Window, -1, SDL_RENDERER_ACCELERATED); + If SDLB_Renderer = Nil Then + SDLB_Renderer := SDL_CreateRenderer(SDLB_Window, -1, SDL_RENDERER_SOFTWARE); + If SDLB_Renderer = Nil Then Exit; + + If Not SDLB_SetLogicalSize(W, H) Then Exit; + + // SpecBAS draws its own pointer, so the system one stays hidden. + SDL_ShowCursor(SDL_DISABLE); + // Without this SDL2 delivers no SDL_TEXTINPUT event, and that is the only + // event that carries a typed character. + SDL_StartTextInput; + + Result := True; +End; + +Procedure SDLB_Stop; +Begin + If SDLB_Texture <> Nil Then Begin + SDL_DestroyTexture(SDLB_Texture); + SDLB_Texture := Nil; + End; + If SDLB_Renderer <> Nil Then Begin + SDL_DestroyRenderer(SDLB_Renderer); + SDLB_Renderer := Nil; + End; + If SDLB_Window <> Nil Then Begin + SDL_DestroyWindow(SDLB_Window); + SDLB_Window := Nil; + End; + SDL_Quit; +End; + +Function SDLB_SetLogicalSize(W, H: Integer): Boolean; +Begin + Result := False; + If (W <= 0) or (H <= 0) or (SDLB_Renderer = Nil) Then Exit; + If (SDLB_Texture <> Nil) and (W = SDLB_TexWidth) and (H = SDLB_TexHeight) Then Begin + Result := True; + Exit; + End; + If Not OnOwningThread Then Begin + Result := CallOnOwningThread(ckLogicalSize, W, H, False, ''); + Exit; + End; + + If SDLB_Texture <> Nil Then Begin + SDL_DestroyTexture(SDLB_Texture); + SDLB_Texture := Nil; + End; + + SDLB_Texture := SDL_CreateTexture(SDLB_Renderer, SDL_PIXELFORMAT_ARGB8888, + SDL_TEXTUREACCESS_STREAMING, W, H); + If SDLB_Texture = Nil Then Exit; + + SDLB_TexWidth := W; + SDLB_TexHeight := H; + Result := True; +End; + +Procedure SDLB_Present(Buffer: Pointer; Pitch: Integer); +Begin + If (SDLB_Renderer = Nil) or (SDLB_Texture = Nil) or (Buffer = Nil) Then Exit; + SDL_UpdateTexture(SDLB_Texture, Nil, Buffer, Pitch); + SDL_RenderCopy(SDLB_Renderer, SDLB_Texture, Nil, Nil); + SDL_RenderPresent(SDLB_Renderer); +End; + +Procedure SDLB_SetTitle(Const Title: String); +Begin + If SDLB_Window = Nil Then Exit; + If Not OnOwningThread Then Begin + CallOnOwningThread(ckTitle, 0, 0, False, AnsiString(Title)); + Exit; + End; + SDL_SetWindowTitle(SDLB_Window, PAnsiChar(AnsiString(Title))); +End; + +Procedure SDLB_GetClientSize(Out W, H: Integer); +Var + cw, ch: LongInt; +Begin + W := SDLB_TexWidth; + H := SDLB_TexHeight; + If SDLB_Window = Nil Then Exit; + SDL_GetWindowSize(SDLB_Window, @cw, @ch); + W := cw; + H := ch; +End; + +Procedure SDLB_SetClientSize(W, H: Integer); +Begin + If (SDLB_Window = Nil) or (W <= 0) or (H <= 0) Then Exit; + If Not OnOwningThread Then Begin + CallOnOwningThread(ckClientSize, W, H, False, ''); + Exit; + End; + SDL_SetWindowSize(SDLB_Window, W, H); +End; + +Procedure SDLB_GetWindowPos(Out X, Y: Integer); +Var + wx, wy: LongInt; +Begin + X := 0; Y := 0; + If SDLB_Window = Nil Then Exit; + SDL_GetWindowPosition(SDLB_Window, @wx, @wy); + X := wx; + Y := wy; +End; + +Procedure SDLB_SetWindowPos(X, Y: Integer); +Begin + If SDLB_Window = Nil Then Exit; + If Not OnOwningThread Then Begin + CallOnOwningThread(ckWindowPos, X, Y, False, ''); + Exit; + End; + SDL_SetWindowPosition(SDLB_Window, X, Y); +End; + +Function SDLB_SetFullScreen(OnOff: Boolean): Boolean; +Var + Flags: UInt32; +Begin + Result := False; + If SDLB_Window = Nil Then Exit; + If Not OnOwningThread Then Begin + Result := CallOnOwningThread(ckFullScreen, 0, 0, OnOff, ''); + Exit; + End; + // Desktop fullscreen rather than a video mode change: the renderer already + // stretches the logical screen to whatever it is given, so switching the + // monitor's mode would buy nothing. + If OnOff Then Flags := SDL_WINDOW_FULLSCREEN_DESKTOP Else Flags := 0; + Result := SDL_SetWindowFullscreen(SDLB_Window, Flags) = 0; +End; + +Procedure SDLB_GetDisplayBounds(Out X, Y, W, H: Integer); +Var + R: TSDL_Rect; + Idx: Integer; +Begin + X := 0; Y := 0; W := 0; H := 0; + If SDLB_Window = Nil Then Exit; + Idx := SDL_GetWindowDisplayIndex(SDLB_Window); + If Idx < 0 Then Idx := 0; + FillChar(R, SizeOf(R), 0); + If SDL_GetDisplayBounds(Idx, @R) = 0 Then Begin + X := R.x; Y := R.y; W := R.w; H := R.h; + End; +End; + +Procedure SDLB_GetUsableBounds(Out X, Y, W, H: Integer); +Var + R: TSDL_Rect; + Idx: Integer; +Begin + X := 0; Y := 0; W := 0; H := 0; + If SDLB_Window = Nil Then Exit; + Idx := SDL_GetWindowDisplayIndex(SDLB_Window); + If Idx < 0 Then Idx := 0; + FillChar(R, SizeOf(R), 0); + If SDL_GetDisplayUsableBounds(Idx, @R) = 0 Then Begin + X := R.x; Y := R.y; W := R.w; H := R.h; + End; +End; + +Function SDLB_GetRefreshRate: Integer; +Var + Mode: TSDL_DisplayMode; + Idx: Integer; +Begin + Result := 0; + If SDLB_Window = Nil Then Exit; + Idx := SDL_GetWindowDisplayIndex(SDLB_Window); + If Idx < 0 Then Idx := 0; + FillChar(Mode, SizeOf(Mode), 0); + If SDL_GetCurrentDisplayMode(Idx, @Mode) = 0 Then + Result := Mode.refresh_rate; +End; + +Function SDLB_GetMousePos(Out X, Y: Integer): Boolean; +Var + mx, my, wx, wy, ww, wh: LongInt; +Begin + X := 0; Y := 0; + Result := False; + If SDLB_Window = Nil Then Exit; + // The global position is answered whether or not the window has focus, + // which is what SP_Display.HandleMouse needs in order to notice that the + // pointer has left. + SDL_GetGlobalMouseState(@mx, @my); + SDL_GetWindowPosition(SDLB_Window, @wx, @wy); + SDL_GetWindowSize(SDLB_Window, @ww, @wh); + X := mx - wx; + Y := my - wy; + Result := (X >= 0) and (Y >= 0) and (X < ww) and (Y < wh); + // Inside the window, answer the position SDL reports for the window + // itself. Motion events are delivered in that space and the caller marks + // the area to repaint from them, so a position derived a second way can + // put the pointer outside the rectangle drawn for it. + If Result Then Begin + SDL_GetMouseState(@mx, @my); + X := mx; + Y := my; + End; +End; + +Procedure SDLB_WarpMouse(X, Y: Integer); +Begin + If SDLB_Window <> Nil Then + SDL_WarpMouseInWindow(SDLB_Window, X, Y); +End; + +Function SDLB_GetClipboardText: String; +Var + P: PAnsiChar; +Begin + Result := ''; + P := SDL_GetClipboardText; + If P <> Nil Then Begin + Result := String(AnsiString(P)); + SDL_free(P); + End; +End; + +Procedure SDLB_SetClipboardText(Const S: String); +Begin + SDL_SetClipboardText(PAnsiChar(AnsiString(S))); +End; + +end. diff --git a/src/SP_SDL2Compat.pas b/src/SP_SDL2Compat.pas new file mode 100644 index 0000000..0985bdf --- /dev/null +++ b/src/SP_SDL2Compat.pas @@ -0,0 +1,115 @@ +// Copyright (C) 2026 By D. Rimron-Soutter +// +// This file is part of the SpecBAS BASIC Interpreter, which is in turn +// part of the SpecOS project. +// +// SpecBAS is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// SpecBAS is distributed in the hope that it will be entertaining, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with SpecBAS. If not, see . + +unit SP_SDL2Compat; + +// The SDL2 build links no Lazarus, so two things SpecBAS reaches for by name +// have to come from somewhere else. Both keep the name and the shape the +// calling units already use, so those units need nothing but a different +// unit in their uses clause. +// +// Clipboard.AsText SP_EditUnit and SP_MemoUnit copy and paste through +// this one property, which the LCL's ClipBrd supplies. +// SDL2 answers it directly. +// +// CopyFile SP_FileIO and SP_Interpret_PostFix copy a file with +// it. LazUtils supplies it in the Lazarus build, where +// it replaces an existing destination and can carry the +// source's modification time across. + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$INCLUDE SpecBAS.inc} + +interface + +Uses Classes, SysUtils, SP_SDL2Backend; + +Type + + TSDLClipboard = Class + Private + Function GetAsText: String; + Procedure SetAsText(Const Value: String); + Public + Property AsText: String read GetAsText write SetAsText; + End; + + Function Clipboard: TSDLClipboard; + + Function CopyFile(Const SrcName, DestName: String; + PreserveTime: Boolean = False): Boolean; + +implementation + +Var + TheClipboard: TSDLClipboard = Nil; + +Function Clipboard: TSDLClipboard; +Begin + If TheClipboard = Nil Then + TheClipboard := TSDLClipboard.Create; + Result := TheClipboard; +End; + +Function TSDLClipboard.GetAsText: String; +Begin + Result := SDLB_GetClipboardText; +End; + +Procedure TSDLClipboard.SetAsText(Const Value: String); +Begin + SDLB_SetClipboardText(Value); +End; + +Function CopyFile(Const SrcName, DestName: String; + PreserveTime: Boolean = False): Boolean; +Var + Src, Dst: TFileStream; + Age: LongInt; +Begin + Result := False; + If Not FileExists(SrcName) Then Exit; + Age := FileAge(SrcName); + Try + Src := TFileStream.Create(SrcName, fmOpenRead or fmShareDenyWrite); + Try + Dst := TFileStream.Create(DestName, fmCreate); + Try + Dst.CopyFrom(Src, Src.Size); + Finally + Dst.Free; + End; + Finally + Src.Free; + End; + If PreserveTime and (Age <> -1) Then + FileSetDate(DestName, Age); + Result := True; + Except + Result := False; + End; +End; + +Finalization + + FreeAndNil(TheClipboard); + +end. diff --git a/src/SP_SDL2Host.pas b/src/SP_SDL2Host.pas new file mode 100644 index 0000000..de70b8f --- /dev/null +++ b/src/SP_SDL2Host.pas @@ -0,0 +1,1745 @@ +// Copyright (C) 2010 By Paul Dunn +// Copyright (C) 2026 By D. Rimron-Soutter +// +// This file is part of the SpecBAS BASIC Interpreter, which is in turn +// part of the SpecOS project. +// +// SpecBAS is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// SpecBAS is distributed in the hope that it will be entertaining, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with SpecBAS. If not, see . + +unit SP_SDL2Host; + +// What MainForm.pas is to the Lazarus build, this unit is to the SDL2 one. +// It starts the window, starts the interpreter thread, fills in the CB_ +// callback table the rest of SpecBAS reaches the host through, turns SDL2 +// events into SpecBAS's own input, and owns the main loop. +// +// It exports the names MainForm.pas exports and the rest of SpecBAS calls +// for - Main, Quitting, GetTicks, MouseInForm and the others - so a unit +// that wants the host picks between the two in its uses clause and needs no +// other change. +// +// TSDLMain is not a window class. It is a small object over the SDL2 window +// that answers the questions SP_Display.pas asks a form: where the window +// is, how big it is, and how to resize it. + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$INCLUDE SpecBAS.inc} + +interface + +Uses + SysUtils, Classes, Types, Math, SyncObjs, SDL2, + SP_SysVars, SP_Util, SP_Errors, SP_Input, SP_Main, SP_FileIO, + SP_Graphics, SP_Graphics32, SP_BankManager, SP_Menu, SP_Sound, Bass, + SP_Tokenise, SP_Components, SP_BaseComponentUnit, RunTimeCompiler, + SP_SDL2Backend, SP_SDL2Keys; + +Type + + TSDLMain = Class + Private + Function GetClientWidth: Integer; + Function GetClientHeight: Integer; + Procedure SetClientWidth(Value: Integer); + Procedure SetClientHeight(Value: Integer); + Function GetLeft: Integer; + Function GetTop: Integer; + Procedure SetLeft(Value: Integer); + Procedure SetTop(Value: Integer); + Public + Handle: NativeUInt; + // SDL2 measures the window by its client area, so the window size and + // the client size are one number and the border margin SP_Display.pas + // allows for is zero. + Property ClientWidth: Integer read GetClientWidth write SetClientWidth; + Property ClientHeight: Integer read GetClientHeight write SetClientHeight; + Property Width: Integer read GetClientWidth write SetClientWidth; + Property Height: Integer read GetClientHeight write SetClientHeight; + Property Left: Integer read GetLeft write SetLeft; + Property Top: Integer read GetTop write SetTop; + Function ClientRect: TRect; + Function ScreenToClient(Const P: TPoint): TPoint; + Function ClientToScreen(Const P: TPoint): TPoint; + Procedure DoResizeMain(l, t, w, h: Integer); + Procedure FormResize(Sender: TObject); + Procedure CreateGDIBitmap; + End; + + // SP_BankManager.IntLoadImage is called on the interpreter thread and the + // picture has to be decoded on the thread that owns the window, so it + // hands one of these to TThread.Synchronize. + TLoadImageSync = Class + FFilename: aString; + FError: TSP_ErrorCode; + Procedure Run; + End; + + TSpecBAS_Thread = Class(TThread) + Procedure Execute; Override; + End; + + Procedure YieldProc(const ms: aFloat); + Procedure MsgProc; + Procedure GetKeyState; + Function GetTicks: aFloat; + Procedure MouseMoveTo(ToX, ToY: Integer); + Procedure Quit; + Procedure LoadImage(Filename: aString; Var Error: TSP_ErrorCode); + Procedure SaveImage(Filename: aString; w, h: Integer; Pixels, Palette: pByte); + Procedure FreeImageResource; + Procedure SetWindowCaption; + + // Drain the SDL2 event queue once. The main loop calls it every pass, and + // so does MsgProc when the interpreter asks the host to catch up. + Procedure SDLHost_PumpEvents; + + // Window, interpreter, main loop and shutdown. The program calls this and + // nothing else. + Procedure SDLHost_Run; + +Var + + Main: TSDLMain = Nil; + BASThread: TSpecBAS_Thread = Nil; + Quitting: Boolean = False; + InitTime: LongWord; + ImgResource: Array of Byte; + BaseTime: aFloat = 0; + LastMouseX, LastMouseY: Integer; + MouseInForm, AltDown, FormActivated: Boolean; + AltChars: aString; + CaptionString: String; + MainCanResize: Boolean = True; + PendingKeyInfo: SP_KeyInfo; + PendingKeyValid: Boolean = False; + +implementation + +Uses + {$IFNDEF RUNTIMEONLY}SP_FPEditor, SP_ToolTipWindow, SP_BASICEditorHostUnit,{$ENDIF} + SP_Display, SP_WindowMenuUnit, SP_PopUpMenuUnit, SP_BASICInterpreter, + SP_BankFiling, SP_Interpret_PostFix, SP_AnsiStringlist, DynLibs, + // Pictures are decoded and encoded through Free Pascal's own fcl-image. + // There is no LCL here to supply TBitmap, TPortableNetworkGraphic, + // TJPEGImage or TGIFImage. + FPImage, FPReadPNG, FPReadBMP, FPReadJPEG, FPReadGIF, FPWritePNG, FPWriteBMP; + +// ---------------------------------------------------------------- TSDLMain + +Function TSDLMain.GetClientWidth: Integer; +Var + W, H: Integer; +Begin + SDLB_GetClientSize(W, H); + Result := W; +End; + +Function TSDLMain.GetClientHeight: Integer; +Var + W, H: Integer; +Begin + SDLB_GetClientSize(W, H); + Result := H; +End; + +Procedure TSDLMain.SetClientWidth(Value: Integer); +Var + W, H: Integer; +Begin + SDLB_GetClientSize(W, H); + SDLB_SetClientSize(Value, H); +End; + +Procedure TSDLMain.SetClientHeight(Value: Integer); +Var + W, H: Integer; +Begin + SDLB_GetClientSize(W, H); + SDLB_SetClientSize(W, Value); +End; + +Function TSDLMain.GetLeft: Integer; +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + Result := X; +End; + +Function TSDLMain.GetTop: Integer; +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + Result := Y; +End; + +Procedure TSDLMain.SetLeft(Value: Integer); +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + SDLB_SetWindowPos(Value, Y); +End; + +Procedure TSDLMain.SetTop(Value: Integer); +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + SDLB_SetWindowPos(X, Value); +End; + +Function TSDLMain.ClientRect: TRect; +Var + W, H: Integer; +Begin + SDLB_GetClientSize(W, H); + Result := Rect(0, 0, W, H); +End; + +Function TSDLMain.ScreenToClient(Const P: TPoint): TPoint; +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + Result.X := P.X - X; + Result.Y := P.Y - Y; +End; + +Function TSDLMain.ClientToScreen(Const P: TPoint): TPoint; +Var + X, Y: Integer; +Begin + SDLB_GetWindowPos(X, Y); + Result.X := P.X + X; + Result.Y := P.Y + Y; +End; + +Procedure TSDLMain.DoResizeMain(l, t, w, h: Integer); +Begin + MainCanResize := False; + Try + FPSIMAGE := ''; + SDLB_SetClientSize(w, h); + If Not SPFULLSCREEN Then + SDLB_SetWindowPos(l, t); + FormResize(Self); + Finally + SIZINGMAIN := False; + MainCanResize := True; + End; +End; + +Procedure TSDLMain.FormResize(Sender: TObject); +Var + W, H: Integer; +Begin + If Quitting Then Exit; + SDLB_GetClientSize(W, H); + If (W <= 0) or (H <= 0) Then Exit; + SetScaling(DISPLAYWIDTH, DISPLAYHEIGHT, W, H); + DPtrBackup := DISPLAYPOINTER; +End; + +Procedure TSDLMain.CreateGDIBitmap; +Begin + // The device-independent bitmap this builds under Windows is the surface + // StretchBlt draws from. The SDL2 build presents from the frame buffer + // itself, and SetScaling allocates that. +End; + +Procedure TLoadImageSync.Run; +Begin + CB_Load_Image(FFilename, FError); +End; + +// ---------------------------------------------------- interpreter thread + +Procedure TSpecBAS_Thread.Execute; +Var + Interpreter: TSP_BASICInterpreter; +Begin + + NameThreadForDebugging('Interpreter Thread'); + + InterpreterThreadAlive := True; + Priority := tpNormal; + FreeOnTerminate := True; + + Interpreter := TSP_BASICInterpreter.Create(0); + Try + Interpreter.AcquireThreadVars; + SP_MainLoop; + Interpreter.ReleaseThreadVars; + Finally + Interpreter.Free; + End; + + InterpreterThreadAlive := False; + +End; + +// ------------------------------------------------------------- the clock + +// SDL2's performance counter, which is monotonic and finer than a +// millisecond. Free Pascal 3.2.2 declares no clock_gettime on every target +// this build covers, and SDL_GetTicks counts whole milliseconds, which is +// too coarse to pace a frame with. +Function GetTicks: aFloat; +Begin + Result := SDLB_Milliseconds - BaseTime; +End; + +Procedure YieldProc(const ms: aFloat); +Begin + + SmartSleep(ms); + LASTINKEYFRAME := FRAMES; + +End; + +Procedure MsgProc; +Begin + + // The interpreter thread calls this as well, and SDL2's event queue may + // only be drained on the thread that owns the window. + If GetCurrentThreadId = MainThreadID Then + SDLHost_PumpEvents; + +End; + +Procedure GetKeyState; +Var + M: TSDL_KeyMod; +Begin + M := SDL_GetModState; + CAPSLOCK := Ord((M and KMOD_CAPS) <> 0); + NUMLOCK := Ord((M and KMOD_NUM) <> 0); +End; + +Procedure MouseMoveTo(ToX, ToY: Integer); +Begin + + // Into window coordinates from SpecBAS's own. + + SDLB_WarpMouse(Round(ToX * ScaleMouseX), Round(ToY * ScaleMouseY)); + +End; + +Procedure Quit; +Begin + Quitting := True; +End; + +Procedure SetWindowCaption; +Var + s: aString; +Begin + if WCAPTION <> '' Then + s := WCAPTION + Else + s := aString(ChangeFileExt(ExtractFilename(ParamStr(0)), '')); + CaptionString := String(s); + SDLB_SetTitle(CaptionString); +End; + +// The frames-per-second reading in the window title, which the Lazarus host +// refreshes from a TTimer. Nothing here has a timer, so the main loop calls +// this and the interval is kept here. +Const + CaptionInterval = 250; + +Var + LastCaptionTime: aFloat = 0; + +Procedure UpdateCaption; +Var + s: String; + CurTime: aFloat; +Begin + CurTime := GetTicks; + If (CurTime - LastCaptionTime) < CaptionInterval Then Exit; + LastCaptionTime := CurTime; + + If WCAPTION = '' Then Begin + GetOSDString; + If AvgFrameTime > 0 Then + s := Format('%.0f', [1000/AvgFrameTime]) + Else + s := 'INF'; + SDLB_SetTitle(CaptionString + ' ' + String(BUILDSTR) + ' - ' + s + ' fps'); + End Else + SDLB_SetTitle(String(WCAPTION)); +End; + +// -------------------------------------------------------------- pictures + +// fcl-image decodes into a TFPCustomImage whose pixels carry sixteen bits a +// channel. SpecBAS's own ImgWidth, ImgHeight, ImgBpp, ImgStride, ImgPtr and +// ImgPalette are filled in from that here exactly as MainForm.pas fills them +// in from a decoded TBitmap, so SP_BankManager reads what it already +// expects whichever host decoded the picture. +Procedure LoadImage(Filename: aString; Var Error: TSP_ErrorCode); +Var + FS: TFileStream; + MagicBuf: Array[0..7] of Byte; + FirstBytes: aString; + Ext: aString; + Img: TFPMemoryImage; + Reader: TFPCustomImageReader; + BmpBitCount: Word; + X, Y, ci, + ColCount, + Idx: Integer; + Found, + Decoded: Boolean; + ColMap: Array[0..255] of LongWord; + Clr: TFPColor; + Pixel: LongWord; + DPtr: pByte; +Begin + + If Not FileExists(String(Filename)) Then Begin + Error.Code := SP_ERR_FILE_MISSING; + Exit; + End; + + // Detect format from magic bytes - never trust the file extension + FS := TFileStream.Create(String(Filename), fmOpenRead Or fmShareDenyNone); + Try + FS.Read(MagicBuf[0], 8); + Finally + FS.Free; + End; + SetLength(FirstBytes, 8); + Move(MagicBuf[0], FirstBytes[1], 8); + + Ext := ''; + If Copy(FirstBytes, 1, 2) = 'BM' Then Ext := '.bmp'; + If FirstBytes = #137'PNG'#13#10#26#10 Then Ext := '.png'; + If Copy(FirstBytes, 1, 3) = 'GIF' Then Ext := '.gif'; + If Copy(FirstBytes, 1, 2) = #$FF#$D8 Then Ext := '.jpg'; + + If Ext = '' Then Begin + Error.Code := SP_ERR_UNSUPPORTED_IMAGE_FORMAT; + Exit; + End; + + ERRStr := Filename; + + ImgBpp := 32; + Decoded := True; + + Img := TFPMemoryImage.Create(0, 0); + Try + + FS := TFileStream.Create(String(Filename), fmOpenRead Or fmShareDenyNone); + Try + + Reader := Nil; + Try + Try + + If Ext = '.png' Then Begin + + Reader := TFPReaderPNG.Create; + Reader.ImageRead(FS, Img); + // Colour type 0 is greyscale and 3 is indexed; between them + // they never carry more than 256 colours. The rest are true + // colour. This is the IHDR field MainForm.pas reads to make the + // same decision. + If (TFPReaderPNG(Reader).ColorType In [0, 3]) And + (TFPReaderPNG(Reader).BitDepth <= 8) Then + ImgBpp := 8; + + End Else If Ext = '.bmp' Then Begin + + // fcl-image's BMP reader does not report the source depth, so + // it comes from the file: biBitCount sits fourteen bytes into + // the BITMAPINFOHEADER, which follows a fourteen-byte + // BITMAPFILEHEADER. + FS.Position := 28; + FS.Read(BmpBitCount, 2); + FS.Position := 0; + If BmpBitCount <= 8 Then ImgBpp := 8; + Reader := TFPReaderBMP.Create; + Reader.ImageRead(FS, Img); + + End Else If Ext = '.jpg' Then Begin + + // JPEG has no palette support - always 32bpp + Reader := TFPReaderJPEG.Create; + Reader.ImageRead(FS, Img); + + End Else Begin // '.gif' + + // GIF is always palette/indexed - always 8bpp + ImgBpp := 8; + Reader := TFPReaderGIF.Create; + Reader.ImageRead(FS, Img); + + End; + + Except + Decoded := False; + End; + Finally + Reader.Free; + End; + + Finally + FS.Free; + End; + + If Not Decoded Then Begin + Error.Code := SP_ERR_UNSUPPORTED_IMAGE_FORMAT; + Exit; + End; + + ImgWidth := Img.Width; + ImgHeight := Img.Height; + + If ImgBpp = 8 Then Begin + + // 8bpp output: extract palette and build index array from the decoded + // true-colour pixels. fcl-image hands those back rather than the + // source file's indices, exactly as the LCL canvas does on + // MainForm.pas's own Free Pascal path, so the palette is recovered + // the same way: collect the unique colours, then index against them. + // A genuine palette image has no more than 256 of them. + ColCount := 0; + FillChar(ColMap, SizeOf(ColMap), 0); + + For Y := 0 To Img.Height - 1 Do + For X := 0 To Img.Width - 1 Do Begin + Clr := Img.Colors[X, Y]; + Pixel := ((Clr.red Shr 8) Shl 16) Or ((Clr.green Shr 8) Shl 8) Or (Clr.blue Shr 8); + Found := False; + For ci := 0 To ColCount - 1 Do + If ColMap[ci] = Pixel Then Begin Found := True; Break; End; + If Not Found And (ColCount < 256) Then Begin + ColMap[ColCount] := Pixel; + Inc(ColCount); + End; + End; + + For ci := 0 To ColCount - 1 Do Begin + ImgPalette[ci].B := ColMap[ci] And $FF; + ImgPalette[ci].G := (ColMap[ci] Shr 8) And $FF; + ImgPalette[ci].R := (ColMap[ci] Shr 16) And $FF; + End; + + SetLength(ImgResource, Img.Width * Img.Height); + DPtr := @ImgResource[0]; + ImgPtr := DPtr; + For Y := 0 To Img.Height - 1 Do + For X := 0 To Img.Width - 1 Do Begin + Clr := Img.Colors[X, Y]; + Pixel := ((Clr.red Shr 8) Shl 16) Or ((Clr.green Shr 8) Shl 8) Or (Clr.blue Shr 8); + DPtr^ := 0; // default index 0 if not found (shouldn't happen) + For ci := 0 To ColCount - 1 Do + If ColMap[ci] = Pixel Then Begin DPtr^ := ci; Break; End; + Inc(DPtr); + End; + ImgStride := Img.Width; + + End Else Begin + + // 32bpp output: one pixel is B, G, R, A, which is the frame buffer's + // own order. + SetLength(ImgResource, Img.Width * Img.Height * 4); + DPtr := @ImgResource[0]; + ImgPtr := DPtr; + For Y := 0 To Img.Height - 1 Do + For X := 0 To Img.Width - 1 Do Begin + Clr := Img.Colors[X, Y]; + DPtr^ := Clr.blue Shr 8; Inc(DPtr); + DPtr^ := Clr.green Shr 8; Inc(DPtr); + DPtr^ := Clr.red Shr 8; Inc(DPtr); + DPtr^ := Clr.alpha Shr 8; Inc(DPtr); + End; + ImgStride := Img.Width * 4; + + // Patch alpha=0 to $FF for formats that have no alpha channel. + // PNG alpha is preserved as-is (may have genuine transparent pixels). + If (Ext = '.jpg') Or (Ext = '.bmp') Or (Ext = '.gif') Then Begin + DPtr := @ImgResource[3]; // first alpha byte + For Idx := 0 To Img.Width * Img.Height - 1 Do Begin + If DPtr^ = 0 Then DPtr^ := $FF; + Inc(DPtr, 4); + End; + End; + + End; + + Finally + Img.Free; + End; + +End; + +// The picture is written as a palette image carrying SpecBAS's own 256 +// colours, with SpecBAS's own indices in the pixels. That is what the +// Lazarus host writes - MainForm.pas builds a pf8Bit bitmap and calls +// SetDIBColorTable - and it is what makes the file reload as an 8bpp +// graphic bank rather than a true-colour one. +// +// Pixels is therefore read as one palette index per pixel, as MainForm.pas +// reads it: the signature carries no depth alongside the data, so there is +// nothing to tell a 32bpp bank apart from an 8bpp one on either host. +Procedure SaveImage(Filename: aString; w, h: Integer; Pixels, Palette: pByte); +Var + Ext: aString; + Img: TFPMemoryImage; + Writer: TFPCustomImageWriter; + Clr: TFPColor; + Row: pByte; + X, Y: Integer; +Begin + + If (w <= 0) Or (h <= 0) Or (Pixels = Nil) Or (Palette = Nil) Then Exit; + + Ext := Lower(aString(ExtractFileExt(String(Filename)))); + If (Ext <> '.png') And (Ext <> '.bmp') Then Exit; + + If FileExists(String(Filename)) Then + DeleteFile(String(Filename)); + + Img := TFPMemoryImage.Create(w, h); + Try + + Img.UsePalette := True; + Img.Palette.Clear; + For X := 0 To 255 Do Begin + Clr.red := Palette^ * $101; Inc(Palette); + Clr.green := Palette^ * $101; Inc(Palette); + Clr.blue := Palette^ * $101; Inc(Palette, 2); + Clr.alpha := alphaOpaque; + Img.Palette.Add(Clr); + End; + + Row := Pixels; + For Y := 0 To h - 1 Do Begin + For X := 0 To w - 1 Do + Img.Pixels[X, Y] := (Row + X)^; + Inc(Row, w); + End; + + If Ext = '.png' Then Begin + Writer := TFPWriterPNG.Create; + TFPWriterPNG(Writer).UseAlpha := False; + // Without these two the writer emits sixteen bits a channel of true + // colour for a picture that only ever had 256 colours in it. + TFPWriterPNG(Writer).WordSized := False; + TFPWriterPNG(Writer).Indexed := True; + End Else + Writer := TFPWriterBMP.Create; + + Try + Img.SaveToFile(String(Filename), Writer); + Finally + Writer.Free; + End; + + Finally + Img.Free; + End; + +End; + +Procedure FreeImageResource; +Begin + + // Removes an image from memory after loading. + + SetLength(ImgResource, 0); + +End; + +// --------------------------------------------------------------- events + +// Take DisplaySection on the owning thread without ever blocking on it +// alone. +// +// Delivering an event to a SpecBAS control needs this lock, and the +// interpreter thread holds it across SP_Display.SetScreen. Inside SetScreen +// the interpreter asks this thread for the window calls SP_SDL2Backend will +// only make here, and waits for them. A plain wait on the lock would leave +// each thread waiting for the other, so this wait runs the queue those calls +// arrive on. Nothing that reaches the queue takes DisplaySection itself, so +// servicing it from inside the wait cannot re-enter the lock. +Procedure EnterDisplaySection; +Begin + While Not DisplaySection.TryEnter Do + CheckSynchronize(1); +End; + +Procedure HandleKeyDown(Const Ev: TSDL_Event); +Var + Key: Word; + k: Integer; + kInfo: SP_KeyInfo; +Begin + + Key := SDL2_ScanCodeToKey(Ev.key.keysym.scancode); + If Key = 0 Then Exit; + + If Key = K_PAUSE Then Begin // the BREAK key on PC keyboards always saves a screengrab. + ScreenShot(False); + Exit; + End; + + kInfo.CanRepeat := True; + kInfo.IsKey := True; + kInfo.KeyChar := #0; + kInfo.KeyCode := Key And $7F; + kInfo.NextFrameTime := FRAMES; + kInfo.WindowID := FocusedWindow; + + If Not SDL2_IsNonPrintingKey(Key) Then Begin + // The character belongs to the SDL_TEXTINPUT event that follows, which + // is the only thing that reads keyboard layouts, dead keys and input + // methods correctly. + // + // A key held with Control is the exception. It is a shortcut rather + // than typing, and no usable character event follows one: macOS sends + // none at all once a shortcut modifier is down, and where one does + // arrive it carries a control code, which is dropped further on. So the + // character comes from the key itself. SDL2's keycode is the character + // the layout puts on that physical key, which is the answer + // MainForm.pas takes from GetCharFromVirtualKey, and it is what + // SP_Components and the widgets read a shortcut from. + If KEYSTATE[K_CONTROL] = 0 Then Begin + PendingKeyInfo := kInfo; + PendingKeyValid := True; + Exit; + End; + If (Ev.key.keysym.sym > 0) And (Ev.key.keysym.sym < 128) Then + kInfo.KeyChar := aChar(Ev.key.keysym.sym); + End; + + If Key = K_ALT Then Begin // ALT went down + + AltDown := True; + AltChars := ''; + + End Else Begin + + If AltDown Then Begin + + If Key in [K_NUMPAD0..K_NUMPAD9, K_0..K_9] Then Begin + + if Key in [K_NUMPAD0..K_NUMPAD9] Then + k := Key - K_NUMPAD0 + else + k := Key - K_0; + + AltChars := AltChars + IntToString(k); + If Length(AltChars) = 3 Then Begin + kInfo.KeyCode := StringToInt(AltChars); + kInfo.KeyChar := aChar(kInfo.KeyCode); + kInfo.CanRepeat := False; + kInfo.IsKey := False; + AltChars := ''; + End Else + Exit; + + End; + + End; + + End; + + If ControlsAreInUse Then Begin + EnterDisplaySection; + If ControlKeyEvent(kInfo.KeyChar, kInfo.KeyCode, True, kInfo.IsKey) Then Begin + DisplaySection.Leave; + Exit; + End Else + DisplaySection.Leave; + End; + + SP_AddKey(kInfo); + +End; + +Procedure DeliverCharacter(C: aChar); +Var + kInfo: SP_KeyInfo; +Begin + + If (C < ' ') or (C = #127) Then Exit; + + If PendingKeyValid Then Begin + kInfo := PendingKeyInfo; + PendingKeyValid := False; + End Else Begin + // A character with no key-down of its own: a paste, an input method, or + // a string put in by another program. SpecBAS still wants a key code, + // and for letters and digits that code is the upper-case character, so + // the character supplies its own. + kInfo.CanRepeat := True; + kInfo.IsKey := True; + kInfo.KeyCode := Ord(UpCase(Char(C))) and $7F; + kInfo.NextFrameTime := FRAMES; + kInfo.WindowID := FocusedWindow; + End; + + kInfo.KeyChar := C; + + If ControlsAreInUse Then Begin + EnterDisplaySection; + If ControlKeyEvent(kInfo.KeyChar, kInfo.KeyCode, True, kInfo.IsKey) Then Begin + DisplaySection.Leave; + Exit; + End Else + DisplaySection.Leave; + End; + + SP_AddKey(kInfo); + +End; + +Procedure HandleTextInput(Const Ev: TSDL_Event); +Var + i: Integer; + C: aChar; +Begin + // One SDL_TEXTINPUT event may carry several characters: pasted text, an + // input method committing a phrase, a string put in by another program. + // Each byte becomes a key of its own. + // + // The field is UTF-8, and SpecBAS's character set is single-byte, so a + // byte above 127 begins a sequence there is no room for and is dropped + // rather than delivered as one meaningless character. + For i := 0 To SDL_TEXTINPUTEVENT_TEXT_SIZE - 1 Do Begin + C := aChar(Ev.text.text[i]); + If C = #0 Then Break; + If C < #128 Then + DeliverCharacter(C); + End; + PendingKeyValid := False; +End; + +Procedure HandleKeyUp(Const Ev: TSDL_Event); +Var + Key: Word; +Begin + + Key := SDL2_ScanCodeToKey(Ev.key.keysym.scancode); + If Key = 0 Then Exit; + + KEYSTATE[Key] := 0; + cKEYSTATE[Key And $7F] := 0; // always clear - can't be skipped + ControlKeyEvent(#0, Key And $7F, False, True); + SP_RemoveKey(Key And $7F); + + If AltDown And (Key = K_ALT) Then Begin + AltDown := False; + SP_RemoveKey(StringToInt(AltChars)); + AltChars := ''; + End; + +End; + +// The button that changed, for a button-down or button-up event, on the +// 1 (left) / 2 (right) / 4 (middle) bitmask SpecBAS uses everywhere. +Function ButtonMask(Const Ev: TSDL_Event): Integer; +Begin + Case Ev.button.button of + SDL_BUTTON_LEFT: Result := 1; + SDL_BUTTON_RIGHT: Result := 2; + SDL_BUTTON_MIDDLE: Result := 4; + Else + Result := 0; + End; +End; + +// Every button currently held, on the same bitmask. SDL2's own mask bits do +// not sit in those positions, so they are read across one at a time. +Function ButtonStateMask(State: LongWord): Integer; +Begin + Result := 0; + If (State and SDL_BUTTON_LMASK) <> 0 Then Result := Result Or 1; + If (State and SDL_BUTTON_RMASK) <> 0 Then Result := Result Or 2; + If (State and SDL_BUTTON_MMASK) <> 0 Then Result := Result Or 4; +End; + +// TestForWindowMenu takes a TShiftState, which is declared in the RTL's +// Classes unit rather than in the LCL. It reads ssLeft, ssRight and +// ssMiddle and nothing else, which is exactly what the bitmask carries. +Function ToShiftState(Shift: Integer): TShiftState; +Begin + Result := []; + If (Shift and 1) <> 0 Then Include(Result, ssLeft); + If (Shift and 2) <> 0 Then Include(Result, ssRight); + If (Shift and 4) <> 0 Then Include(Result, ssMiddle); +End; + +Procedure HandleMouseMotion(Const Ev: TSDL_Event); +Var + Win: Pointer; + p: TPoint; + Shift, LMenu, LItem, Btn, X, Y, tX, tY, ID, Dx, Dy, NewX, NewY, NewW, NewH: Integer; + Handled: Boolean; + sPtr: pSP_Window_Info; + BankIdx: Integer; + Err: TSP_ErrorCode; +Begin + + X := Ev.motion.x; + Y := Ev.motion.y; + + If ((X = LastMouseX) And (Y = LastMouseY)) or SIZINGMAIN or (ScaleMouseX = 0) Then Exit; + + Handled := False; + LastMouseX := X; + LastMouseY := Y; + If ScaleMouseX > 0 Then + X := Round(X / ScaleMouseX); + If ScaleMouseY > 0 Then + Y := Round(Y / ScaleMouseY); + If (X = LastScaledMouseX) And (Y = LastScaledMouseY) Then Exit; + LastScaledMouseX := X; + LastScaledMouseY := Y; + + Shift := ButtonStateMask(Ev.motion.state); + Btn := Shift; + M_DELTAX := X - MOUSEX; + M_DELTAY := Y - MOUSEY; + MOUSEX := X; + MOUSEY := Y; + + // Origin shifted by the pointer's hotspot, which is where the image is + // actually drawn. + SP_SetDirtyRect(Min(MOUSEX, MOUSESTOREX) - MOUSEHSX, Min(MOUSEY, MOUSESTOREY) - MOUSEHSY, + Max(MOUSEX, MOUSESTOREX) - MOUSEHSX + MOUSEW, Max(MOUSEY, MOUSESTOREY) - MOUSEHSY + MOUSEH); + SP_NeedDisplayUpdate := True; + + // Decorated window drag/resize + For BankIdx := 0 To Length(SP_BankList) -1 Do Begin + If SP_BankList[BankIdx]^.DataType <> SP_WINDOW_BANK Then Continue; + sPtr := @SP_BankList[BankIdx].Info[0]; + If sPtr^.Dragging Then Begin + Err.Code := SP_ERR_OK; + SP_MoveWindow(sPtr^.ID, MOUSEX - sPtr^.DragOffX, MOUSEY - sPtr^.DragOffY, Err); + SP_NeedDisplayUpdate := True; + Handled := True; + Break; + End; + If sPtr^.Resizing Then Begin + DX := MOUSEX - sPtr^.ResizeMouseX; + DY := MOUSEY - sPtr^.ResizeMouseY; + NewX := sPtr^.ResizeOrigX; + NewY := sPtr^.ResizeOrigY; + NewW := sPtr^.ResizeOrigW; + NewH := sPtr^.ResizeOrigH; + If sPtr^.ResizeEdge And 1 <> 0 Then Begin // left edge + NewX := sPtr^.ResizeOrigX + DX; + NewW := sPtr^.ResizeOrigW - DX; + End; + If sPtr^.ResizeEdge And 2 <> 0 Then // right edge + NewW := sPtr^.ResizeOrigW + DX; + If sPtr^.ResizeEdge And 4 <> 0 Then Begin // top edge + NewY := sPtr^.ResizeOrigY + DY; + NewH := sPtr^.ResizeOrigH - DY; + End; + If sPtr^.ResizeEdge And 8 <> 0 Then // bottom edge + NewH := sPtr^.ResizeOrigH + DY; + // clamp to minimum size + If NewW < 40 Then Begin + NewW := 40; + If sPtr^.ResizeEdge And 1 <> 0 Then + NewX := sPtr^.ResizeOrigX + sPtr^.ResizeOrigW - 40; + End; + If NewH < sPtr^.CaptionHeight + 10 Then Begin + NewH := sPtr^.CaptionHeight + 10; + If sPtr^.ResizeEdge And 4 <> 0 Then + NewY := sPtr^.ResizeOrigY + sPtr^.ResizeOrigH - (sPtr^.CaptionHeight + 10); + End; + Err.Code := SP_ERR_OK; + If (NewX <> sPtr^.Left) Or (NewY <> sPtr^.Top) Then + SP_MoveWindow(sPtr^.ID, NewX, NewY, Err); + If (NewW <> sPtr^.Width) Or (NewH <> sPtr^.Height) Then + SP_ResizeWindow(sPtr^.ID, NewW, NewH, -1, SPFULLSCREEN, False, Err); + If sPtr^.ID = SCREENBANK Then + SP_WindowResizeFlag := sPtr^.ID; + SP_NeedDisplayUpdate := True; + Handled := True; + Break; + End; + End; + + If (CURMENU <> -1) And ((Shift and 2) <> 0) And MENUSHOWING Then Begin + + LMenu := LASTMENU; + LItem := LASTMENUITEM; + SP_SetMenuSelection(X, Y, CURMENU); + SP_InvalidateWholeDisplay; + SP_NeedDisplayUpdate := True; + + If (LMenu <> LASTMENU) or (LItem <> LASTMENUITEM) Then + MENU_HIGHLIGHTFLAG := True; + + End Else + + If (Assigned(CaptureControl) or MOUSEVISIBLE) And Not SIZINGMAIN Then Begin + + // Now check for controls under the mouse + + Handled := False; + If DisplaySection.TryEnter Then Begin + + tX := X; tY := Y; + {$IFNDEF RUNTIMEONLY} + If TipWindowID <> -1 Then CheckForTip(tx, ty); + {$ENDIF} + Win := WindowAtPoint(tX, tY, ID); + + If Assigned(Win) Then Begin + Win := ControlAtPoint(Win, tX, tY); + If Not Assigned(Win) Or (MouseControl <> pSP_BaseComponent(Win)^) Then + If Assigned(MouseControl) And SP_CanInteract(MouseControl) Then + MouseControl.MouseLeave; + End; + If Assigned(CaptureControl) And CaptureControl.Visible Then Begin + p := CaptureControl.ScreenToClient(Point(x, y)); + If SP_CanInteract(CaptureControl) Then Begin + CaptureControl.PreMouseMove(p.x, p.y, Btn); + Handled := True; + End; + End Else Begin + If Assigned(Win) And pSP_BaseComponent(Win)^.Enabled Then Begin + If MouseControl <> pSP_BaseComponent(Win)^ Then Begin + MouseControl := pSP_BaseComponent(Win)^; + p := MouseControl.ScreenToClient(Point(tX, tY)); + If SP_CanInteract(MouseControl) Then + MouseControl.MouseEnter(p.X, p.Y); + End; + If SP_CanInteract(pSP_BaseComponent(Win)^) Then + pSP_BaseComponent(Win)^.PreMouseMove(tX, tY, Btn); + Handled := True; + End Else + If Assigned(MouseControl) And SP_CanInteract(MouseControl) Then + MouseControl.MouseLeave; + End; + + // Released inside the guard that took it. A failed TryEnter means + // another thread holds the lock, and releasing one this thread does + // not own is a pthread error, which the runtime turns into an + // exception no caller here catches. + DisplaySection.Leave; + + End; + + End; + + // Fall through to allow user code to get mousemove events + + If Not Handled Then Begin + M_MOVEFLAG := True; + MOUSEBTN := Btn; + End; + +End; + +// SDL_CaptureMouse keeps events arriving while a button is held even after +// the pointer leaves the window, which is what SetCapture does for the +// Lazarus host. SpecBAS's own CaptureControl, further down, is a different +// thing with a similar name. +Procedure HandleMouseDown(Const Ev: TSDL_Event); +Var + mi: SP_MenuSelection; + Win: Pointer; + Shift, Btn, ID, X, Y: Integer; + WShift: TShiftState; + p: TPoint; + Handled: Boolean; + sPtr: pSP_Window_Info; + Edge: Integer; +Begin + + If ScaleMouseX > 0 Then Begin + + SDL_CaptureMouse(SDL_TRUE); + + X := Round(Ev.button.x / ScaleMouseX); + Y := Round(Ev.button.y / ScaleMouseY); + + MOUSEX := X; + MOUSEY := Y; + Shift := ButtonMask(Ev); + Btn := Shift; + + // Menus take precedence over everything + + If CURMENU <> -1 Then Begin + + If (Shift and 2) <> 0 Then + If Not (MENUSHOWING Or MENUBLOCK) Then Begin + + SP_DisplayMainMenu; + SP_SetMenuSelection(X, Y, CURMENU); + SP_InvalidateWholeDisplay; + MENU_SHOWFLAG := True; + Exit; + + End; + + If (Shift and 1) <> 0 Then + If MENUSHOWING Then Begin + + SP_SetMenuSelection(X, Y, CURMENU); + mi := SP_WhichItem(X, Y); + LASTMENU := mi.MenuID; + LASTMENUITEM := mi.ItemIdx; + SP_DisplayMainMenu; + SP_InvalidateWholeDisplay; + Refresh_Display; + MENUBLOCK := True; + + MENU_HIDEFLAG := True; + Exit; + + End; + + End; + + // Now check for controls under the mouse + // *** TO DO make windowmenu appear when right-clicking if not visible *** + + Handled := False; + {$IFNDEF RUNTIMEONLY} + CloseTipWindow; + {$ENDIF} + + If ForceCapture Then Begin + If CaptureControl.CanFocus Then + CaptureControl.SetFocus(True); + p := CaptureControl.ScreenToClient(Point(X, Y)); + If SP_CanInteract(CaptureControl) Then + SP_BaseComponent(CaptureControl).MouseDown(SP_BaseComponent(CaptureControl), p.X, p.Y, Btn); + Handled := True; + End Else Begin + Win := WindowAtPoint(X, Y, ID); // X, Y become window-relative after this + If Assigned(Win) Then Begin + sPtr := pSP_Window_Info(Win); + If sPtr^.Decorated And ((Shift and 1) <> 0) Then Begin + Edge := 0; + If sPtr^.Resizable Then Begin + If X < 2 Then Edge := Edge Or 1; + If X >= sPtr^.Width - 2 Then Edge := Edge Or 2; + If Y < 2 Then Edge := Edge Or 4; + If Y >= sPtr^.Height - 2 Then Edge := Edge Or 8; + If (X >= sPtr^.Width - 8) And + (Y >= sPtr^.Height - 8) Then Edge := Edge Or 10; + End; + If (Edge = 0) And sPtr^.Draggable And (Y < sPtr^.CaptionHeight) Then Begin + sPtr^.Dragging := True; + sPtr^.DragOffX := MOUSEX - sPtr^.Left; + sPtr^.DragOffY := MOUSEY - sPtr^.Top; + SwitchFocusedWindow(ID); + Handled := True; + End Else If Edge <> 0 Then Begin + sPtr^.Resizing := True; + sPtr^.ResizeEdge := Edge; + sPtr^.ResizeOrigX := sPtr^.Left; + sPtr^.ResizeOrigY := sPtr^.Top; + sPtr^.ResizeOrigW := sPtr^.Width; + sPtr^.ResizeOrigH := sPtr^.Height; + sPtr^.ResizeMouseX := MOUSEX; + sPtr^.ResizeMouseY := MOUSEY; + SwitchFocusedWindow(ID); + Handled := True; + End; + End; + If Not Handled Then Begin + WShift := ToShiftState(Shift); + If not TestForWindowMenu(Nil, WShift) Then Begin + If Not (SYSTEMSTATE in [SS_EDITOR, SS_DIRECT, SS_EVALUATE]) and (MODALWINDOW = -1) Then + SwitchFocusedWindow(ID); // The editor handles this. + Win := ControlAtPoint(Win, X, Y); + If Assigned(Win) Then Begin + if pSP_BaseComponent(Win)^.Enabled Then Begin + CaptureControl := pSP_BaseComponent(Win)^; + If CaptureControl.CanFocus Then + CaptureControl.SetFocus(True); + If SP_CanInteract(CaptureControl) Then + SP_BaseComponent(CaptureControl).MouseDown(SP_BaseComponent(CaptureControl), X, Y, Btn); + Handled := True; + End; + End Else Begin + If Assigned(CaptureControl) And SP_CanInteract(CaptureControl) Then + SP_BaseComponent(CaptureControl).MouseDown(SP_BaseComponent(CaptureControl), X, Y, Btn); + If Assigned(FocusedControl) And (MODALWINDOW = -1) And ((FocusedControl Is SP_PopUpMenu) or (FocusedControl is SP_WindowMenu)) Then + FocusedControl.SetFocus(False); + End; + End; + End; + End; + End; + + // Finally, pass the mouse event to the interpreter + + If Not Handled Then Begin + MOUSEBTN := Btn; + M_DOWNFLAG := True; + End; + + End; + +End; + +Procedure HandleMouseUp(Const Ev: TSDL_Event); +Var + mi: SP_MenuSelection; + Win: Pointer; + Shift, Btn, ID, X, Y, BankIdx: Integer; + WShift: TShiftState; + p: TPoint; + Handled: Boolean; + sPtr: pSP_Window_Info; +Begin + + SDL_CaptureMouse(SDL_FALSE); + + If ScaleMouseX = 0 Then Exit; + X := Round(Ev.button.x / ScaleMouseX); + Y := Round(Ev.button.y / ScaleMouseY); + + MOUSEX := X; + MOUSEY := Y; + + Shift := ButtonMask(Ev); + Btn := Shift; + + For BankIdx := 0 To Length(SP_BankList) -1 Do Begin + If SP_BankList[BankIdx]^.DataType <> SP_WINDOW_BANK Then Continue; + sPtr := @SP_BankList[BankIdx].Info[0]; + If sPtr^.Dragging Or sPtr^.Resizing Then Begin + sPtr^.Dragging := False; + sPtr^.Resizing := False; + SP_NeedDisplayUpdate := True; + End; + End; + + // Menus take precedence + + If (CURMENU <> -1) And (Not ((Shift and 2) <> 0)) And MENUSHOWING Then Begin + + SP_SetMenuSelection(X, Y, CURMENU); + mi := SP_WhichItem(X, Y); + LASTMENU := mi.MenuID; + LASTMENUITEM := mi.ItemIdx; + SP_DisplayMainMenu; + SP_InvalidateWholeDisplay; + SP_NeedDisplayUpdate := True; + + MENU_HIDEFLAG := True; + + End Else Begin + + // Now check for controls under the mouse + + WShift := ToShiftState(Shift); + Handled := TestForWindowMenu(Nil, WShift); + If Assigned(CaptureControl) Then Begin + p := CaptureControl.ScreenToClient(Point(x, y)); + If SP_CanInteract(CaptureControl) Then + CaptureControl.MouseUp(CaptureControl, p.x, p.y, Btn); + If Not ForceCapture Then + CaptureControl := Nil; + Handled := True; + End Else Begin + Win := WindowAtPoint(X, Y, ID); + If Assigned(Win) Then Begin + Win := ControlAtPoint(Win, X, Y); + If Assigned(Win) And pSP_BaseComponent(Win)^.Enabled And SP_CanInteract(pSP_BaseComponent(Win)^) Then Begin + pSP_BaseComponent(Win)^.MouseUp(pSP_BaseComponent(Win)^, X, Y, Btn); + Handled := True; + End; + End; + End; + + // Finally, pass the mouse event to the interpreter + + MOUSEBTN := MOUSEBTN And Not Btn; + If Not Handled Then Begin + M_UPFLAG := True; + End; + + End; + + MENUBLOCK := (Shift and 2) <> 0; + +End; + +Procedure DoMouseWheelDown(Shift: Integer); +Var + p: TPoint; + Win: Pointer; + cp: pSP_BaseComponent; + Ctrl: SP_BaseComponent; + X, Y, Btn, ID: Integer; + Handled: Boolean; +Begin + + X := MOUSEX; + Y := MOUSEY; + Btn := Shift; + + Handled := False; + EnterDisplaySection; + + If Assigned(CaptureControl) Then Begin + p := CaptureControl.ScreenToClient(Point(x, y)); + CaptureControl.MouseMove(CaptureControl, p.x, p.y, Btn); + End Else Begin + Win := WindowAtPoint(X, Y, ID); + If Assigned(Win) Then Begin + cp := ControlAtPoint(Win, X, Y); + If Assigned(cp) Then Begin + Ctrl := cp^; + While Assigned(Ctrl) And Not Handled Do Begin + Ctrl.MouseWheel(Ctrl, X, Y, Btn, 1, Handled); + If Not Handled Then + If Ctrl.fParentType = spWindow Then + Ctrl := Nil + Else + Ctrl := Ctrl.GetParentControl; + End; + End; + End; + End; + + DisplaySection.Leave; + + If Not Handled Then Begin + M_WHEELDNFLAG := True; + Inc(MOUSEWHEEL); + End; + +End; + +Procedure DoMouseWheelUp(Shift: Integer); +Var + p: TPoint; + Win: Pointer; + cp: pSP_BaseComponent; + Ctrl: SP_BaseComponent; + X, Y, Btn, ID: Integer; + Handled: Boolean; +Begin + + X := MOUSEX; + Y := MOUSEY; + Btn := Shift; + + Handled := False; + EnterDisplaySection; + + If Assigned(CaptureControl) Then Begin + p := CaptureControl.ScreenToClient(Point(x, y)); + CaptureControl.MouseMove(CaptureControl, p.x, p.y, Btn); + End Else Begin + Win := WindowAtPoint(X, Y, ID); + If Assigned(Win) Then Begin + cp := ControlAtPoint(Win, X, Y); + If Assigned(cp) Then Begin + Ctrl := cp^; + While Assigned(Ctrl) And not Handled Do Begin + Ctrl.MouseWheel(Ctrl, X, Y, Btn, -1, Handled); + If Not Handled Then + If Ctrl.fParentType = spWindow Then + Ctrl := Nil + Else + Ctrl := Ctrl.GetParentControl; + End; + End; + End; + End; + + DisplaySection.Leave; + + If Not Handled Then Begin + M_WHEELUPFLAG := True; + Dec(MouseWheel); + End; + +End; + +// SDL2 reports one signed scroll amount where the LCL splits the wheel into +// an up handler and a down handler, so the sign picks between the two. +// Positive is away from the user, which is the direction the LCL routes to +// OnMouseWheelUp; a flipped direction (natural scrolling) reverses it. +// SDL_MOUSEWHEEL carries no held-button state of its own, so that is asked +// for separately. +Procedure HandleMouseWheel(Const Ev: TSDL_Event); +Var + Delta: Integer; + Shift: Integer; +Begin + Delta := Ev.wheel.y; + If Ev.wheel.direction = SDL_MOUSEWHEEL_FLIPPED Then Delta := -Delta; + If Delta = 0 Then Exit; + + Shift := ButtonStateMask(SDL_GetMouseState(Nil, Nil)); + + If Delta > 0 Then + DoMouseWheelUp(Shift) + Else + DoMouseWheelDown(Shift); +End; + +{$IFNDEF RUNTIMEONLY} +Procedure HandleDropFile(Const Name: String); +Var + sl: TAnsiStringList; + paste, s: aString; + i: Integer; +Begin + sl := TAnsiStringList.Create; + Try + sl.LoadFromHost(Name); + Paste := ''; + If sl.Count > 0 Then Begin + if sl[0] = 'ZXASCII' Then Begin + for i := 0 To sl.Count -1 Do Begin + s := aString(sl[i]); + If (Copy(s, 1, 7) <> 'ZXASCII') and (Copy(s, 1, 4) <> 'AUTO') and (Copy(s, 1, 4) <> 'PROG') and (Copy(s, 1, 7) <> 'CHANGED') Then + paste := paste + s + #13#10; + End; + End; + FPBASICEditor.SetFocus(True); + FPBASICEditor.InsertText(paste); + FPBASICEditor.EnsureCursorVisible; + FPBASICEditor.Paint; + end; + Finally + sl.Free; + End; +End; +{$ENDIF} + +Procedure SDLHost_PumpEvents; +Var + Ev: TSDL_Event; +Begin + While SDL_PollEvent(@Ev) = 1 Do + Case Ev.type_ of + + SDL_QUITEV: + Quit; + + SDL_KEYDOWN: + // SpecBAS repeats a held key from its own frame clock, in + // SP_GetNextKey, so the platform's repeats are dropped here. + If Ev.key.repeat_ = 0 Then HandleKeyDown(Ev); + + SDL_KEYUP: + HandleKeyUp(Ev); + + SDL_TEXTINPUT: + HandleTextInput(Ev); + + SDL_MOUSEMOTION: + HandleMouseMotion(Ev); + + SDL_MOUSEBUTTONDOWN: + HandleMouseDown(Ev); + + SDL_MOUSEBUTTONUP: + HandleMouseUp(Ev); + + SDL_MOUSEWHEEL: + HandleMouseWheel(Ev); + + SDL_DROPFILE: + Begin + {$IFNDEF RUNTIMEONLY} + HandleDropFile(String(AnsiString(Ev.drop.file_))); + {$ENDIF} + SDL_free(Ev.drop.file_); + End; + + SDL_WINDOWEVENT: + Case Ev.window.event of + SDL_WINDOWEVENT_SIZE_CHANGED: + If Assigned(Main) and MainCanResize Then Main.FormResize(Main); + SDL_WINDOWEVENT_FOCUS_GAINED: + Begin + FormActivated := True; + SP_SysVars.FOCUSED := True; + End; + SDL_WINDOWEVENT_FOCUS_LOST: + Begin + FormActivated := False; + SP_SysVars.FOCUSED := False; + SP_ClearAllKeys; + End; + SDL_WINDOWEVENT_EXPOSED: + Begin + SP_InvalidateWholeDisplay; + SP_NeedDisplayUpdate := True; + End; + End; + + End; +End; + +// ----------------------------------------------------- start and finish + +Procedure HostCreate; +Var + Idx: Integer; + s, dir: String; +Begin + + INSTARTUP := True; + HELPFILE := '/specbas.guide'; + + DisplaySection.Enter; + + SP_GetMonitorMetrics; + OrgWidth := REALSCREENWIDTH; + OrgHeight := REALSCREENHEIGHT; + + MOUSEVISIBLE := FALSE; + + EXENAME := ParamStr(0); + PayLoad := TPayLoad.Create(EXENAME); + PAYLOADPRESENT := PayLoad.HasPayLoad; + If Not PAYLOADPRESENT Then + PayLoad.Free; + + If Not PAYLOADPRESENT Then Begin + PCOUNT := -1; + PARAMS := TStringList.Create; + For Idx := 0 To ParamCount Do Begin + s := ParamStr(Idx); + if Copy(s, 1, 1) <> '-' then Begin + if FileExists(s) then Begin + PARAMS.Add(aString(s)); + Inc(PCOUNT); + End; + End Else Begin + PARAMS.Add(aString(s)); + Inc(PCOUNT); + End; + End; + + dir := GetCurrentDir; + If (PCOUNT = 0) And FileExists(dir + PathDelim + 'autorun') Then Begin + PCOUNT := 1; + PARAMS.Add(aString(dir)+ PathDelim + 'autorun'); + End; + + End; + + BaseTime := SDLB_Milliseconds; + InitTime := Round(GetTicks); + + If Not PAYLOADPRESENT Then Begin + + // The project's version, from the same place the Windows build takes + // it: the VERSIONINFO in src/SpecBAS.rc. There is no version resource + // to read back at run time here, so build-sdl2/Makefile reads that file + // and writes SpecBAS_Version.inc. + BUILDSTR := {$INCLUDE SpecBAS_Version.inc}; + {$IFDEF DEBUG} + BUILDSTR := BUILDSTR + ' [Debug]'; + {$ENDIF} + + // Set the HOME folder - if we're loading a parameter file, extract the + // directory and set that as HOMEFOLDER + + If PCOUNT <= 0 Then Begin + + CaptionString := 'SpecBAS v'; + HOMEFOLDER := aString(GetUserDir) + aString('specbas'); + + End Else Begin + + CaptionString := ExtractFileName(String(PARAMS[1])); + HOMEFOLDER := aString(ExtractFileDir(String(PARAMS[1]))); + If HOMEFOLDER = '' Then + HOMEFOLDER := aString(GetCurrentDir); + + End; + + End Else Begin + + SetCurrentDir(ExtractFilePath(EXENAME)); + HOMEFOLDER := aString(GetCurrentDir); + + End; + + SDLB_SetTitle(CaptionString + String(BuildStr)); + + If Not DirectoryExists(String(HOMEFOLDER)) Then + CreateDir(String(HOMEFOLDER)); + If Not DirectoryExists(String(HOMEFOLDER) + PathDelim + 'temp') Then + CreateDir(String(HOMEFOLDER) + PathDelim + 'temp'); + TEMPDIR := HOMEFOLDER + aString(PathDelim + 'temp' + PathDelim); + SetCurrentDir(String(HOMEFOLDER)); + HOMEFOLDER := Lower(HOMEFOLDER); + If HOMEFOLDER[Length(HOMEFOLDER)] <> aChar(PathDelim) Then + HOMEFOLDER := HOMEFOLDER + aChar(PathDelim); + + AUTOSAVE := Not PAYLOADPRESENT; + + ScrWidth := 800; + ScrHeight := 480; + SCALEWIDTH := 800; + SCALEHEIGHT := 480; + MENUBLOCK := False; + + // Initialise callbacks + + CB_DecorateWindow := SP_Decorate_User_Window; + CB_GetKeyLockState := GetKeyState; + CB_Refresh_Display := Refresh_Display; + CB_Quit := SP_SDL2Host.Quit; + CB_SetScreenRes := SetScreen; + CB_Test_Resolution := TestScreenResolution; + CB_GetTicks := GetTicks; + CB_Yield := YieldProc; + CB_Load_Image := LoadImage; + CB_Save_Image := SaveImage; + CB_Free_Image := FreeImageResource; + CB_Messages := MsgProc; + CB_MouseMove := MouseMoveTo; + CB_SETWINDOWCAPTION := SetWindowCaption; + + // Start graphics server + + SP_SetFPS(GetScreenRefreshrate); + SP_InitialGFXSetup(ScrWidth, ScrHeight, False); + SP_GetMonitorMetrics; + Main.DoResizeMain((REALSCREENWIDTH - Main.Width) Div 2, + (REALSCREENHEIGHT - Main.Height) Div 2, + Main.Width, Main.Height); + + WINLEFT := Main.Left; + WINTOP := Main.Top; + + // Launch the interpreter + + SP_CLS(CPAPER); + EDITLINE := ''; + CURSORPOS := 0; + CURSORCHAR := 32; + SYSTEMSTATE := SS_IDLE; + + SoundEnabled := LoadLibrary(bassdll) <> NilHandle; + SP_Init_Sound; + + CORECOUNT := System.CPUCount; + + BASThread := TSpecBAS_Thread.Create(True); + + DisplaySection.Leave; + + BASThread.Start; + + MouseInForm := SDLB_GetMousePos(Idx, Idx); + +End; + +Procedure HostDestroy; +Var + Error: TSP_ErrorCode; +Begin + + PLAYSignalHalt(-1); + If Not QUITMSG Then Begin + Quitting := True; + QUITMSG := True; + BREAKSIGNAL := True; + SP_WaitForSecondaries; + End; + + While InterpreterThreadAlive Do Begin + // The interpreter thread may be parked on a window call this thread has + // to make before it can finish. See SDLHost_Run's loop. + CheckSynchronize; + CB_YIELD(1); + End; + + If Assigned(PARAMS) Then PARAMS.Free; + + Quitting := True; + + If SoundEnabled Then + BASS_Free; + + If PAYLOADPRESENT or (PCOUNT <> 0) Then Begin + SP_RmDirUnSafe('/temp', Error); + SP_RmDir('/s', Error); + SP_RmDir('/fonts', Error); + SP_RmDir('/keyboards', Error); + SP_RmDir('/include', Error); + End; + + DisplaySection.Enter; + SetScreenResolution(OrgWidth, OrgHeight, False); + DisplaySection.Leave; + + SP_FinalizeThreadVars; + +End; + +Procedure SDLHost_Run; +Begin + + If Not SDLB_Start('SpecBAS', 800, 480) Then Begin + WriteLn(StdErr, 'SpecBAS: SDL2 would not start: ', SDL_GetError); + Halt(1); + End; + + SDL_EventState(SDL_DROPFILE, SDL_ENABLE); + + Main := TSDLMain.Create; + Main.Handle := 0; + + Try + HostCreate; + + While Not (Quitting or QUITMSG) Do Begin + SDLHost_PumpEvents; + // Two things the interpreter thread cannot do for itself arrive + // through TThread.Synchronize, which parks the call on this thread's + // queue and waits for it: the host's picture loader and every window + // call in SP_SDL2Backend. Something here has to run that queue or the + // wait never ends. The LCL's own idle handler does it in the Lazarus + // build; here the main loop does it. + CheckSynchronize; + If MainCanResize Then + FrameLoop; + UpdateCaption; + End; + + HostDestroy; + Finally + FreeAndNil(Main); + SDLB_Stop; + End; + +End; + +end. diff --git a/src/SP_SDL2Keys.pas b/src/SP_SDL2Keys.pas new file mode 100644 index 0000000..e49e377 --- /dev/null +++ b/src/SP_SDL2Keys.pas @@ -0,0 +1,170 @@ +// Copyright (C) 2026 By D. Rimron-Soutter +// +// This file is part of the SpecBAS BASIC Interpreter, which is in turn +// part of the SpecOS project. +// +// SpecBAS is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// SpecBAS is distributed in the hope that it will be entertaining, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with SpecBAS. If not, see . + +unit SP_SDL2Keys; + +// The keyboard mapping, shared by every SDL2 platform. +// +// SpecBAS names keys by the K_ constants in SP_Input.pas, and everything +// downstream of SP_AddKey indexes by them: the editor, the widget set, +// KEYSTATE, INKEY$. So a key arriving from SDL2 has to be given one of those +// names before it goes anywhere else. +// +// The mapping runs from the SDL scancode rather than the keycode. A scancode +// names the physical key and does not move when the keyboard layout changes, +// which is what a K_ constant means too. The SDL keycode is the character +// the layout puts on that key, which is a separate question, answered by the +// SDL_TEXTINPUT event. + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$INCLUDE SpecBAS.inc} + +interface + +Uses SDL2, SP_Input; + + // The K_ constant for an SDL scancode, or 0 for a key SpecBAS has no name + // for. + Function SDL2_ScanCodeToKey(ScanCode: TSDL_ScanCode): Word; + + // True for a key that carries no character, and is therefore complete on + // the key-down event. Any other key waits for the SDL_TEXTINPUT event that + // supplies its character. + Function SDL2_IsNonPrintingKey(Key: Word): Boolean; + +implementation + +Function SDL2_ScanCodeToKey(ScanCode: TSDL_ScanCode): Word; +Begin + Case ScanCode of + + // SDL runs the letters A..Z from one scancode and the K_ constants run + // them from another, so each of these two ranges is one subtraction. + // The digit rows put 1..9 first and 0 last, where the K_ constants + // start at zero. + SDL_SCANCODE_A..SDL_SCANCODE_Z: + Result := K_A + (ScanCode - SDL_SCANCODE_A); + SDL_SCANCODE_1..SDL_SCANCODE_9: + Result := K_1 + (ScanCode - SDL_SCANCODE_1); + SDL_SCANCODE_0: Result := K_0; + + SDL_SCANCODE_RETURN: Result := K_RETURN; + SDL_SCANCODE_ESCAPE: Result := K_ESCAPE; + SDL_SCANCODE_BACKSPACE: Result := K_BACK; + SDL_SCANCODE_TAB: Result := K_TAB; + SDL_SCANCODE_SPACE: Result := K_SPACE; + + // The OEM keys, named for where they sit on a US layout. Which + // character each one produces is the layout's business, and arrives + // separately. + SDL_SCANCODE_MINUS: Result := K_OEM_MINUS; + SDL_SCANCODE_EQUALS: Result := K_OEM_PLUS; + SDL_SCANCODE_LEFTBRACKET: Result := K_OEM_4; + SDL_SCANCODE_RIGHTBRACKET: Result := K_OEM_6; + SDL_SCANCODE_BACKSLASH: Result := K_OEM_5; + SDL_SCANCODE_NONUSHASH: Result := K_OEM_5; + SDL_SCANCODE_SEMICOLON: Result := K_OEM_1; + SDL_SCANCODE_APOSTROPHE: Result := K_OEM_7; + SDL_SCANCODE_GRAVE: Result := K_OEM_3; + SDL_SCANCODE_COMMA: Result := K_OEM_COMMA; + SDL_SCANCODE_PERIOD: Result := K_OEM_PERIOD; + SDL_SCANCODE_SLASH: Result := K_OEM_2; + SDL_SCANCODE_NONUSBACKSLASH: Result := K_OEM_102; + + SDL_SCANCODE_CAPSLOCK: Result := K_CAPITAL; + + SDL_SCANCODE_F1..SDL_SCANCODE_F12: + Result := K_F1 + (ScanCode - SDL_SCANCODE_F1); + SDL_SCANCODE_F13..SDL_SCANCODE_F24: + Result := K_F13 + (ScanCode - SDL_SCANCODE_F13); + + SDL_SCANCODE_PRINTSCREEN: Result := K_SNAPSHOT; + SDL_SCANCODE_SCROLLLOCK: Result := K_SCROLL; + SDL_SCANCODE_PAUSE: Result := K_PAUSE; + SDL_SCANCODE_INSERT: Result := K_INSERT; + SDL_SCANCODE_HOME: Result := K_HOME; + SDL_SCANCODE_PAGEUP: Result := K_PRIOR; + SDL_SCANCODE_DELETE: Result := K_DELETE; + SDL_SCANCODE_END: Result := K_END; + SDL_SCANCODE_PAGEDOWN: Result := K_NEXT; + SDL_SCANCODE_RIGHT: Result := K_RIGHT; + SDL_SCANCODE_LEFT: Result := K_LEFT; + SDL_SCANCODE_DOWN: Result := K_DOWN; + SDL_SCANCODE_UP: Result := K_UP; + + SDL_SCANCODE_NUMLOCKCLEAR: Result := K_NUMLOCK; + SDL_SCANCODE_KP_DIVIDE: Result := K_DIVIDE; + SDL_SCANCODE_KP_MULTIPLY: Result := K_MULTIPLY; + SDL_SCANCODE_KP_MINUS: Result := K_SUBTRACT; + SDL_SCANCODE_KP_PLUS: Result := K_ADD; + SDL_SCANCODE_KP_ENTER: Result := K_RETURN; + SDL_SCANCODE_KP_1..SDL_SCANCODE_KP_9: + Result := K_NUMPAD1 + (ScanCode - SDL_SCANCODE_KP_1); + SDL_SCANCODE_KP_0: Result := K_NUMPAD0; + SDL_SCANCODE_KP_PERIOD: Result := K_DECIMAL; + SDL_SCANCODE_KP_EQUALS: Result := K_OEM_PLUS; + SDL_SCANCODE_KP_COMMA: Result := K_OEM_COMMA; + + SDL_SCANCODE_APPLICATION: Result := K_APPS; + SDL_SCANCODE_MENU: Result := K_APPS; + SDL_SCANCODE_SELECT: Result := K_SELECT; + SDL_SCANCODE_EXECUTE: Result := K_EXECUTE; + SDL_SCANCODE_HELP: Result := K_HELP; + SDL_SCANCODE_CANCEL: Result := K_CANCEL; + SDL_SCANCODE_CLEAR: Result := K_CLEAR; + + // SpecBAS names a modifier without a side, which is what KEYSTATE is + // indexed by, so both of each pair answer the same. + SDL_SCANCODE_LCTRL, + SDL_SCANCODE_RCTRL: Result := K_CONTROL; + SDL_SCANCODE_LSHIFT, + SDL_SCANCODE_RSHIFT: Result := K_SHIFT; + SDL_SCANCODE_LALT, + SDL_SCANCODE_RALT: Result := K_ALT; + {$IFDEF MAC_COMMAND_IS_CONTROL} + SDL_SCANCODE_LGUI, + SDL_SCANCODE_RGUI: Result := K_CONTROL; + {$ELSE} + SDL_SCANCODE_LGUI: Result := K_LWIN; + SDL_SCANCODE_RGUI: Result := K_RWIN; + {$ENDIF} + + Else + Result := 0; + End; +End; + +Function SDL2_IsNonPrintingKey(Key: Word): Boolean; +Begin + // The set MainForm.pas's FormKeyDown holds back on under Free Pascal, + // written in the K_ names rather than the LCLType ones. A key in this set + // reaches SP_AddKey on the key-down event; anything else waits for its + // character. + Result := Key In [K_ESCAPE, K_BACK, K_TAB, K_RETURN, + K_F1, K_F2, K_F3, K_F4, K_F5, K_F6, + K_F7, K_F8, K_F9, K_F10, K_F11, K_F12, + K_LEFT, K_RIGHT, K_UP, K_DOWN, + K_INSERT, K_DELETE, K_HOME, K_END, + K_PRIOR, K_NEXT, K_CAPITAL, K_NUMLOCK, + K_SCROLL, K_SHIFT, K_CONTROL, K_ALT]; +End; + +end. diff --git a/src/SP_Sockets.pas b/src/SP_Sockets.pas index 0a9b42d..568b474 100644 --- a/src/SP_Sockets.pas +++ b/src/SP_Sockets.pas @@ -56,7 +56,9 @@ interface {$IFDEF SP_WINSOCK} WinSock2 {$ELSE} - Sockets, BaseUnix, Unix + // FIONREAD is declared in termio, not in BaseUnix or Unix. netdb has the + // name resolver. + Sockets, BaseUnix, Unix, termio, netdb {$ENDIF} ; @@ -176,29 +178,34 @@ implementation // Nothing needed on POSIX End; +// Free Pascal names its socket entry points fpSocket, fpBind and so on. The +// code shared with WinSock names socket() alone, so that is the only one +// that needs a name here. +Function socket(Domain, SockType, Protocol: Integer): TSocket; +Begin + Result := fpSocket(Domain, SockType, Protocol); +End; + +// StrToNetAddr answers a dotted quad, and 0.0.0.0 for anything that is not +// one, which is when the name goes to the resolver. It is the network-order +// partner to what netdb returns; the host-order helper alongside it would +// reverse the octets and connect to the wrong machine. Function ResolveHost(Const Host: aString; Port: Integer; Out Addr: TInetSockAddr): Boolean; Var - Hints : AddrInfo; - Res : PAddrInfo; - sHost: AnsiString; - sPort : AnsiString; + Entry : THostEntry; + sHost : AnsiString; Begin Result := False; FillChar(Addr, SizeOf(Addr), 0); - FillChar(Hints, SizeOf(Hints), 0); - Hints.ai_family := AF_INET; - Hints.ai_socktype := SOCK_STREAM; + Addr.sin_family := AF_INET; + Addr.sin_port := htons(Port); sHost := AnsiString(Host); - sPort := AnsiString(IntToStr(Port)); - If fpGetAddrInfo(PAnsiChar(sHost), PAnsiChar(sPort), @Hints, @Res) <> 0 Then - Exit; - Try - If Res = Nil Then Exit; - Move(Res^.ai_addr^, Addr, SizeOf(TInetSockAddr)); + Addr.sin_addr := StrToNetAddr(sHost); + If Addr.sin_addr.s_addr = 0 Then Begin + If Not ResolveHostByName(String(sHost), Entry) Then Exit; + Addr.sin_addr := Entry.Addr; + End; Result := True; - Finally - fpFreeAddrInfo(Res); -End; End; Function LastSockError: Integer; diff --git a/src/SP_Tokenise.pas b/src/SP_Tokenise.pas index 17416be..c5edb4d 100644 --- a/src/SP_Tokenise.pas +++ b/src/SP_Tokenise.pas @@ -1467,7 +1467,7 @@ interface implementation -Uses SP_Main, SP_FileIO, SP_SysVars, {$IFDEF FPC}LclIntf{$ELSE}Windows{$ENDIF}; +Uses SP_Main, SP_FileIO, SP_SysVars{$IFDEF FPC}{$IFNDEF SDL2}, LclIntf{$ENDIF}{$ELSE}, Windows{$ENDIF}; Procedure AutoExpandCompounds(Var s: aString; Var CCol: Integer); Const diff --git a/src/SP_UITools.pas b/src/SP_UITools.pas index 9d84b28..51170fc 100644 --- a/src/SP_UITools.pas +++ b/src/SP_UITools.pas @@ -90,7 +90,7 @@ interface implementation -Uses SP_Main, SP_FPEditor, SP_Input, MainForm, SP_Interpret_PostFix, +Uses SP_Main, SP_FPEditor, SP_Input, {$IFNDEF SDL2}MainForm, {$ENDIF}SP_Interpret_PostFix, SP_MenuActions, SP_MemoUnit, SP_BASICEditorHostUnit, SP_Sound, SP_Execute, SP_Debugging, SP_Dialogs; diff --git a/src/SpecBAS.inc b/src/SpecBAS.inc index 227431e..fa00fcd 100644 --- a/src/SpecBAS.inc +++ b/src/SpecBAS.inc @@ -13,6 +13,17 @@ {$IF DEFINED(WINDOWS) AND DEFINED(FPC)} {$DEFINE OPENGL} {$ENDIF} +// Off Windows the window, the buffer present, the event queue and the frame +// clock come from SDL2 instead of from Lazarus. +{$IF DEFINED(FPC) AND NOT DEFINED(WINDOWS)} + {$DEFINE SDL2} +{$ENDIF} +// SpecBAS reads K_CONTROL for copy, cut, paste and select-all. macOS puts +// those on Command, so Command delivers K_CONTROL as well and both keys +// work. Undefine to have Command deliver K_LWIN and K_RWIN instead. +{$IFDEF DARWIN} + {$DEFINE MAC_COMMAND_IS_CONTROL} +{$ENDIF} //{$DEFINE RUNTIMEONLY} // passed on command line to build "rt" //{$DEFINE DEBUGPAYLOAD} // Debugging the compiler //{$DEFINE RefreshThread} diff --git a/src/SpecBAS_SDL2.dpr b/src/SpecBAS_SDL2.dpr new file mode 100644 index 0000000..82d5eba --- /dev/null +++ b/src/SpecBAS_SDL2.dpr @@ -0,0 +1,41 @@ +// Copyright (C) 2010 By Paul Dunn +// Copyright (C) 2026 By D. Rimron-Soutter +// +// This file is part of the SpecBAS BASIC Interpreter, which is in turn +// part of the SpecOS project. +// +// SpecBAS is free software: you can redistribute it and/or modify +// it under the terms of the GNU General Public License as published by +// the Free Software Foundation, either version 3 of the License, or +// (at your option) any later version. +// +// SpecBAS is distributed in the hope that it will be entertaining, +// but WITHOUT ANY WARRANTY; without even the implied warranty of +// MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +// GNU General Public License for more details. +// +// You should have received a copy of the GNU General Public License +// along with SpecBAS. If not, see . + +program SpecBAS_SDL2; + +// SpecBAS on the SDL2 backend. SpecBAS.dpr is the Lazarus entry point, +// which builds a form and hands the program to Application.Run; here the +// host owns its own loop and there is no GUI toolkit to initialise. + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$INCLUDE SpecBAS.inc} + +uses + {$IFDEF UNIX} + CThreads, + {$ENDIF} + SysUtils, + SP_SDL2Host in 'SP_SDL2Host.pas'; + +begin + SDLHost_Run; +end. diff --git a/src/bass.pas b/src/bass.pas index 585197f..1136ddd 100644 --- a/src/bass.pas +++ b/src/bass.pas @@ -842,6 +842,9 @@ BASS_FX_VOLUME_PARAM = record {$IFDEF MACOS} bassdll = 'libbass.dylib'; {$ENDIF} +{$IFDEF DARWIN} + bassdll = 'libbass.dylib'; +{$ENDIF} {$IFDEF ANDROID} bassdll = 'libbass.so'; {$ENDIF}