From 365b764e1c2477ed62d0189daa88a43ed3b71388 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:13:13 +0100 Subject: [PATCH 01/12] Name Darwin where only MACOS was named Two units stop a Free Pascal compile before it reaches anything else. bass.pas guards its macOS library name with {$IFDEF MACOS}. That is Delphi's symbol; Free Pascal defines DARWIN and never MACOS, so on a Free Pascal Apple target the const block ends up empty and bassdll is undeclared for every import below it: bass.pas(849,1) Fatal: Syntax error, "identifier" expected but "FUNCTION" found RunTimeCompiler.pas imports ActiveX unconditionally, for IsEqualGUID. ActiveX is a Windows unit: RunTimeCompiler.pas(32,13) Fatal: Can't find unit ActiveX used by RunTimeCompiler Free Pascal's SysUtils declares IsEqualGUID on every target, so off Windows the import is all that has to go. Windows keeps it, and keeps the ActiveX implementation with it. --- src/RunTimeCompiler.pas | 4 +++- src/bass.pas | 3 +++ 2 files changed, 6 insertions(+), 1 deletion(-) 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/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} From 9832be67af33dbf128656be5f7598bbf23c9a5a0 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:14:56 +0100 Subject: [PATCH 02/12] Add the SDL2 symbol and the backend it selects SpecBAS.inc auto-defines OPENGL for Free Pascal on Windows. SDL2 is the same shape for every other Free Pascal target: it says which host layer this build gets. Delphi and Windows are untouched, so the three-way split the source already carries stays as it is. SP_SDL2Backend is that host layer. It owns the window, the renderer and the streaming texture SpecBAS's frame buffer is uploaded into, and answers the clipboard, the display geometry and the clock. It knows nothing about SpecBAS beyond the address and pitch of the buffer it presents. Nothing selects it yet. --- src/SP_SDL2Backend.pas | 401 +++++++++++++++++++++++++++++++++++++++++ src/SpecBAS.inc | 5 + 2 files changed, 406 insertions(+) create mode 100644 src/SP_SDL2Backend.pas diff --git a/src/SP_SDL2Backend.pas b/src/SP_SDL2Backend.pas new file mode 100644 index 0000000..2ab0f0a --- /dev/null +++ b/src/SP_SDL2Backend.pas @@ -0,0 +1,401 @@ +// 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. + Procedure SDLB_GetDisplayBounds(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; + +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); +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/SpecBAS.inc b/src/SpecBAS.inc index 227431e..d1fc9c0 100644 --- a/src/SpecBAS.inc +++ b/src/SpecBAS.inc @@ -13,6 +13,11 @@ {$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} //{$DEFINE RUNTIMEONLY} // passed on command line to build "rt" //{$DEFINE DEBUGPAYLOAD} // Debugging the compiler //{$DEFINE RefreshThread} From 9448fe60781fc0bf13e87319ca1cdf22b095456e Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:18:15 +0100 Subject: [PATCH 03/12] Supply the two Lazarus calls the SDL2 build cannot link The SDL2 build links no Lazarus, so ClipBrd's Clipboard.AsText and LazUtils' CopyFile are not there to be called. SP_EditUnit, SP_MemoUnit, SP_FileIO and SP_Interpret_PostFix each reach for one of them by name. Both are answered here under the names and shapes those units already use, so nothing about the calls has to change: the clipboard from SDL2, and the copy over TFileStream, replacing an existing destination and carrying the source's modification time across when asked to. Nothing selects it yet. --- src/SP_SDL2Compat.pas | 115 ++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 115 insertions(+) create mode 100644 src/SP_SDL2Compat.pas 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. From 3b14cb1438371c69ef4021eab6f702c47daab19e Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:31:47 +0100 Subject: [PATCH 04/12] Do not reach for Lazarus where the SDL2 build has none The SDL2 build links no Lazarus, so a unit that names an LCL unit in its uses clause stops the compile there. Free Pascal on Windows keeps every one of them, and so does Delphi. SP_Interpret_PostFix.pas(28,16) Fatal: Can't find unit Forms used by SP_Interpret_PostFix Three of them are replaced, by SP_SDL2Compat where the call has to keep working and by nothing where the import was never used: ClipBrd, in SP_EditUnit, SP_MemoUnit and SP_Interpret_PostFix, for Clipboard.AsText. FileUtil, in SP_FileIO and SP_Interpret_PostFix, for CopyFile. The one qualified call site needs the qualifier to follow. Forms, LCLType, LclIntf, GraphUtil and Dialogs, in the remaining files here, are imported and never called. SP_DebugPanel and SP_Components carry ClipBrd on both sides of an existing {$IFNDEF FPC}, so the comma moves inside the conditional where the item can now be absent. --- src/SP_CheckBoxUnit.pas | 2 +- src/SP_Components.pas | 2 +- src/SP_DebugPanel.pas | 4 ++-- src/SP_EditUnit.pas | 2 +- src/SP_Editor.pas | 2 +- src/SP_FileIO.pas | 4 ++-- src/SP_FileListBoxUnit.pas | 2 +- src/SP_Graphics.pas | 2 +- src/SP_InfixToPostFix.pas | 2 +- src/SP_Interpret_PostFix.pas | 6 +++--- src/SP_MemoUnit.pas | 2 +- src/SP_Tokenise.pas | 2 +- 12 files changed, 16 insertions(+), 16 deletions(-) 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_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_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_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 From b54e18fe31a4d7286938055559cca77fad15cb80 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:31:56 +0100 Subject: [PATCH 05/12] Give every SDL2 platform one keyboard mapping SpecBAS names keys by the K_ constants in SP_Input.pas, which the editor, the widget set, KEYSTATE and INKEY$ all index by. SDL2 reports a scancode instead, so one of the two has to be turned into the other, and it is done in one place for every platform this backend covers. The mapping runs from the scancode rather than the keycode because a scancode names the physical key, which is what a K_ constant means as well. Which character that key produces is the layout's business and arrives separately, on the SDL_TEXTINPUT event. SpecBAS reads K_CONTROL for copy, cut, paste and select-all. macOS puts those on Command, so MAC_COMMAND_IS_CONTROL has Command deliver K_CONTROL as well and both keys work; it is a conditional inside the one mapping and Linux and Windows are unchanged by it. Nothing selects it yet. --- src/SP_SDL2Keys.pas | 170 ++++++++++++++++++++++++++++++++++++++++++++ src/SpecBAS.inc | 6 ++ 2 files changed, 176 insertions(+) create mode 100644 src/SP_SDL2Keys.pas 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/SpecBAS.inc b/src/SpecBAS.inc index d1fc9c0..fa00fcd 100644 --- a/src/SpecBAS.inc +++ b/src/SpecBAS.inc @@ -18,6 +18,12 @@ {$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} From c51c08459838d697f39a54a7cdf12218ab427b62 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:32:11 +0100 Subject: [PATCH 06/12] Run SpecBAS on the SDL2 backend SP_SDL2Host is what MainForm.pas is to the Lazarus build: the one platform file. It creates the window, starts the interpreter thread, fills in the CB_ callback table, turns SDL2 events into SpecBAS's own input, and owns the main loop that Application.OnIdle drives on Windows. It exports the names MainForm.pas exports, so a unit that wants the host picks between the two in its uses clause and changes nothing else. SpecBAS_SDL2.dpr is its entry point, as SpecBAS.dpr is Lazarus's. Pictures load and save through Free Pascal's own fcl-image, because there is no LCL here to supply TBitmap, TPortableNetworkGraphic, TJPEGImage or TGIFImage. The clock is SDL2's performance counter: Free Pascal 3.2.2 declares no clock_gettime on these targets, which is what MainForm.pas's UNIX branch calls, and SDL_GetTicks counts whole milliseconds, which is too coarse to pace a frame with. SP_Display.pas is the file that would not compile at all. Every error in it is Windows display-mode management outside any conditional: SP_Display.pas(1010) StretchBlt SP_Display.pas(1132) SystemParametersInfo, SPI_GETWORKAREA SP_Display.pas(1185..1341) EnumDisplaySettings, ChangeDisplaySettings, ChangeDisplaySettingsEx, GetMonitorInfo, EnumDisplayDevices, TDeviceMode, TMonitor Those become SDL_RenderCopy, SDL_GetDisplayUsableBounds, SDL_GetDisplayBounds, SDL_GetCurrentDisplayMode and SDL_SetWindowFullscreen. Its UNIX uses branch also omitted SysUtils, SyncObjs and Types, which the file uses unconditionally for TCriticalSection, TRect and PtInRect, and the frame buffer and the window size were declared for the OpenGL path alone. Fullscreen is desktop fullscreen. The renderer already stretches the logical screen to whatever it is given, so there is nothing to gain from switching the monitor's mode. SP_BankManager and SP_UITools name MainForm in a uses clause and follow it here. Building the whole environment needs -O1. Free Pascal 3.2.2 for aarch64 raises internal error 200510011 on SP_FPEditor.pas at -O2. --- src/SP_BankManager.pas | 2 +- src/SP_Display.pas | 163 +++- src/SP_SDL2Backend.pas | 19 +- src/SP_SDL2Host.pas | 1734 ++++++++++++++++++++++++++++++++++++++++ src/SP_UITools.pas | 2 +- src/SpecBAS_SDL2.dpr | 41 + 6 files changed, 1952 insertions(+), 9 deletions(-) create mode 100644 src/SP_SDL2Host.pas create mode 100644 src/SpecBAS_SDL2.dpr 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_Display.pas b/src/SP_Display.pas index 07c850d..ecdbc55 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)); @@ -1007,7 +1019,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 +1079,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 +1130,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 +1176,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 +1240,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 +1430,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 +1575,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 +1718,7 @@ function SetScreenResolution(Width, Height: Integer; FullScreen: Boolean): Boole end; {$ENDIF} // OPENGL end; +{$ENDIF} // SDL2 Initialization diff --git a/src/SP_SDL2Backend.pas b/src/SP_SDL2Backend.pas index 2ab0f0a..dfad2f1 100644 --- a/src/SP_SDL2Backend.pas +++ b/src/SP_SDL2Backend.pas @@ -90,8 +90,10 @@ interface Procedure SDLB_SetWindowPos(X, Y: Integer); Function SDLB_SetFullScreen(OnOff: Boolean): Boolean; - // Bounds of the display the window is on. + // 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 @@ -343,6 +345,21 @@ implementation 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; diff --git a/src/SP_SDL2Host.pas b/src/SP_SDL2Host.pas new file mode 100644 index 0000000..b569f17 --- /dev/null +++ b/src/SP_SDL2Host.pas @@ -0,0 +1,1734 @@ +// 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; + + SP_SetDirtyRect(Min(MOUSEX, MOUSESTOREX), Min(MOUSEY, MOUSESTOREY), Max(MOUSEX+MOUSEW, MOUSESTOREX+MOUSESTOREW), Max(MOUSEY+MOUSEH, MOUSESTOREY+MOUSESTOREH)); + 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; + + End; + + DisplaySection.Leave; + + 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 + + BUILDSTR := '0.0.0.0'; + {$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_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_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. From f8c09a0cc0ed0515cb2dae65a327aa1511b6df88 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:32:21 +0100 Subject: [PATCH 07/12] Give SP_Sockets the POSIX names Free Pascal has The POSIX half of the unit is written against calls Free Pascal 3.2.2 does not have: SP_Sockets.pas(181,12) Error: Identifier not found "AddrInfo" SP_Sockets.pas(193,6) Error: Identifier not found "fpGetAddrInfo" SP_Sockets.pas(271,11) Error: Identifier not found "socket" SP_Sockets.pas(718,45) Error: Identifier not found "FIONREAD" There is no fpGetAddrInfo, no AddrInfo type and no fpFreeAddrInfo, so name resolution goes through netdb's ResolveHostByName, with StrToNetAddr answering a dotted quad without a lookup. StrToNetAddr is the network-order helper, which is the order netdb answers in; the host-order one beside it would reverse the octets and connect to the wrong machine. The socket entry points are named fpSocket, fpBind and so on. Only socket() is named in the code shared with WinSock, so it gets a name of its own here, as InitWinSock already does. FIONREAD is declared in termio. Nothing here is reached by the Windows build, which keeps WinSock2. --- src/SP_Sockets.pas | 41 ++++++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 17 deletions(-) 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; From 1bd6549b6149a3f9973b1bb1fd2b1bf539e563cf Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 12:34:30 +0100 Subject: [PATCH 08/12] Build the SDL2 backend without Lazarus src/build.bat drives Delphi, and SpecBAS.lpi drives Lazarus. Neither builds this, so build-sdl2/ does: fetch-deps.sh puts the Pascal bindings and, on macOS, the SDL2 release framework into a gitignored vendor/, and the Makefile calls fpc directly. make app assembles a macOS application bundle with SDL2 inside it, which runs on a machine carrying no toolchain and no system SDL2. That is how SpecBAS already ships BASS on Windows, and it keeps a proprietary library alongside a GPLv3 application without linking it in. Every comment in these three files is there because the fact it records is not visible from the command it sits above. Free Pascal 3.2.2 needs no -k-ld_classic here: with Lazarus gone it emits no Objective-C, so there is no metadata for Xcode 26 to reject. --- .gitignore | 4 ++ build-sdl2/Makefile | 114 +++++++++++++++++++++++++++++++++++++ build-sdl2/bundle.sh | 71 +++++++++++++++++++++++ build-sdl2/fetch-deps.sh | 120 +++++++++++++++++++++++++++++++++++++++ 4 files changed, 309 insertions(+) create mode 100644 build-sdl2/Makefile create mode 100755 build-sdl2/bundle.sh create mode 100755 build-sdl2/fetch-deps.sh 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..b22add1 --- /dev/null +++ b/build-sdl2/Makefile @@ -0,0 +1,114 @@ +# 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. +FPCFLAGS := -MDelphi -Sh -O1 -vew -Fu$(SRC) -Fi$(SRC) -Fu$(UNITS) -Fi$(UNITS) + +# 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' > $@ + +exe: $(LINKDEPS) + @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" From 8d05f5c7986f3ac3b42331652f8e87e4a0dec9d0 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 13:57:50 +0100 Subject: [PATCH 09/12] Release the display lock only where it was taken HandleMouseMotion takes DisplaySection with TryEnter and released it after the block that acquires it rather than inside, so a failed acquire was still followed by a release. TryEnter only fails while another thread holds the lock, which is why it killed the program on roughly half of the attempts and looked like a crash on a mouse click. Releasing a mutex this thread does not own is an error pthreads reports, which Free Pascal turns into runtime error 236 and SysUtils raises as EThreadError. Nothing on the path catches it, so the process printed two "EThreadError: Thread error" traces and stopped. --- src/SP_SDL2Host.pas | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/src/SP_SDL2Host.pas b/src/SP_SDL2Host.pas index b569f17..f6b26c6 100644 --- a/src/SP_SDL2Host.pas +++ b/src/SP_SDL2Host.pas @@ -1036,9 +1036,13 @@ implementation MouseControl.MouseLeave; End; - 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; - DisplaySection.Leave; + End; End; From 8e332a63662bd4214d4f62963ce813de98579a38 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 13:57:57 +0100 Subject: [PATCH 10/12] Take the version from the file the Windows build takes it from BUILDSTR was the literal '0.0.0.0', so the title bar read "SpecBAS v 0.0.0.0" where the Windows one reads the real version. Windows gets it from the executable's own VERSIONINFO resource at run time; there is no such resource here, and no way to read one back. build-sdl2/Makefile now reads src/SpecBAS.rc, which is where that resource is written, and generates SpecBAS_Version.inc for the unit to include. The file stays the project's single statement of its own version, and both builds report the same number: FILEVERSION 0,0,0,1511 shows as 0.1511 on each. --- build-sdl2/Makefile | 25 +++++++++++++++++++++++-- src/SP_SDL2Host.pas | 6 +++++- 2 files changed, 28 insertions(+), 3 deletions(-) diff --git a/build-sdl2/Makefile b/build-sdl2/Makefile index b22add1..8e3cd0c 100644 --- a/build-sdl2/Makefile +++ b/build-sdl2/Makefile @@ -42,7 +42,10 @@ UNAME_S := $(shell uname -s) # 200510011 on SP_FPEditor.pas at -O2. # # -MDelphi matches the mode every SpecBAS unit selects for itself. -FPCFLAGS := -MDelphi -Sh -O1 -vew -Fu$(SRC) -Fi$(SRC) -Fu$(UNITS) -Fi$(UNITS) +# +# -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. @@ -94,7 +97,25 @@ $(LINKDIR)/libbass.so: @mkdir -p $(LINKDIR) @printf '/* Empty linker script. See the BASS note in build-sdl2/Makefile. */\n' > $@ -exe: $(LINKDEPS) +# 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) diff --git a/src/SP_SDL2Host.pas b/src/SP_SDL2Host.pas index f6b26c6..65dd4db 100644 --- a/src/SP_SDL2Host.pas +++ b/src/SP_SDL2Host.pas @@ -1553,7 +1553,11 @@ implementation If Not PAYLOADPRESENT Then Begin - BUILDSTR := '0.0.0.0'; + // 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} From 39fdf314611e3e41ae3ca7aab7acce894b1cb9a1 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 13:58:16 +0100 Subject: [PATCH 11/12] Answer one mouse position, in the space the events use SDLB_GetMousePos derived the pointer from the global mouse position minus the window position, while motion events arrive in SDL's window-relative space. SP_Display.HandleMouse takes MOUSEX and MOUSEY from the first every frame and the host marks the area to repaint from the second, so where the two disagreed the pointer was drawn outside the rectangle redrawn for it. The global position is still what decides whether the pointer is inside the window, because HandleMouse needs to notice it leaving and SDL_GetMouseState cannot report that. Once inside, the position answered is SDL's own. --- src/SP_SDL2Backend.pas | 9 +++++++++ 1 file changed, 9 insertions(+) diff --git a/src/SP_SDL2Backend.pas b/src/SP_SDL2Backend.pas index dfad2f1..7f2c335 100644 --- a/src/SP_SDL2Backend.pas +++ b/src/SP_SDL2Backend.pas @@ -390,6 +390,15 @@ implementation 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); From 363c032e33f093d7343292c84c9bd0b51f124d82 Mon Sep 17 00:00:00 2001 From: "D. Rimron-Soutter" Date: Tue, 11 Aug 2026 14:38:56 +0100 Subject: [PATCH 12/12] Repaint the pointer and window shadows correctly under SDL2 Two drawing faults showed up while dragging the mouse pointer over a window with a drop shadow. A shadow is blurred from the pixels around it and blended into the same buffer it reads, so a dirty rectangle covering part of one gives a different result from one covering all of it. The buffer keeps the previous frame, so the difference accumulates and the area darkens and smears. Any rectangle that touches a shadow is now widened to that whole shadow before the fragments are generated. The pointer's dirty rectangle started at MOUSEX, but the image is drawn at MOUSEX - MOUSEHSX. With a hotspot, set by MOUSE GRAPHIC ... POINT, the strip above and to the left of the pointer was drawn and never repainted. The rectangle now starts where the image does. Both are in code the Windows build compiles, so both changes are inside {$IFDEF SDL2} and the Windows path selects what it did before. --- src/SP_Display.pas | 16 ++++++++++++++++ src/SP_Graphics32.pas | 23 ++++++++++++++++++++++- src/SP_SDL2Host.pas | 5 ++++- 3 files changed, 42 insertions(+), 2 deletions(-) diff --git a/src/SP_Display.pas b/src/SP_Display.pas index ecdbc55..bb8ac25 100644 --- a/src/SP_Display.pas +++ b/src/SP_Display.pas @@ -774,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); @@ -787,6 +802,7 @@ procedure SmartSleep(const AMilliseconds: aFloat); MOUSESTOREX := MOUSEX; MOUSESTOREY := MOUSEY; End; + {$ENDIF} X1 := SCMINX; Y1 := SCMINY; X2 := SCMAXX +1; Y2 := SCMAXY +1; 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_SDL2Host.pas b/src/SP_SDL2Host.pas index 65dd4db..de70b8f 100644 --- a/src/SP_SDL2Host.pas +++ b/src/SP_SDL2Host.pas @@ -925,7 +925,10 @@ implementation MOUSEX := X; MOUSEY := Y; - SP_SetDirtyRect(Min(MOUSEX, MOUSESTOREX), Min(MOUSEY, MOUSESTOREY), Max(MOUSEX+MOUSEW, MOUSESTOREX+MOUSESTOREW), Max(MOUSEY+MOUSEH, MOUSESTOREY+MOUSESTOREH)); + // 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