diff --git a/src/common/KM_CommonClasses.pas b/src/common/KM_CommonClasses.pas index 202235f4e3..1514c24d9e 100644 --- a/src/common/KM_CommonClasses.pas +++ b/src/common/KM_CommonClasses.pas @@ -511,12 +511,15 @@ procedure TKMemoryStream.WriteBytes(const Value: TBytes); class procedure TKMemoryStream.AsyncSaveToFileAndFree(var aStream: TKMemoryStream; const aFileName: string; aWorkerThread: TKMWorkerThread); var localStream: TKMemoryStream; +{$IFDEF WDC} + task: TKMWorkerThreadTask; +{$ENDIF} begin localStream := aStream; aStream := nil; //So caller doesn't use it by mistake {$IFDEF WDC} - aWorkerThread.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin try localStream.SaveToFile(aFileName); @@ -524,6 +527,8 @@ class procedure TKMemoryStream.AsyncSaveToFileAndFree(var aStream: TKMemoryStrea localStream.Free; end; end, 'SaveToFile'); + + aWorkerThread.Enqueue(task); {$ELSE} try LocalStream.SaveToFile(aFileName); @@ -538,12 +543,13 @@ class procedure TKMemoryStream.AsyncSaveToFileCompressedAndFree(var aStream: TKM aWorkerThread: TKMWorkerThread); var localStream: TKMemoryStream; + task: TKMWorkerThreadTask; begin localStream := aStream; aStream := nil; //So caller doesn't use it by mistake {$IFDEF WDC} - aWorkerThread.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin try localStream.SaveToFileCompressed(aFileName, aMarker); @@ -551,6 +557,8 @@ class procedure TKMemoryStream.AsyncSaveToFileCompressedAndFree(var aStream: TKM localStream.Free; end; end, 'SaveToFileCompressed ' + aMarker); + + aWorkerThread.Enqueue(task); {$ELSE} try LocalStream.SaveToFileCompressed(aFileName, aMarker); @@ -565,6 +573,9 @@ class procedure TKMemoryStream.AsyncSaveStreamsToFileAndFree(var aMainStream, aS const aMarker1, aMarker2: string; aWorkerThread: TKMWorkerThread); var localSubStream1, localSubStream2, localMainStream: TKMemoryStream; +{$IFDEF WDC} + task: TKMWorkerThreadTask; +{$ENDIF} begin localMainStream := aMainStream; localSubStream1 := aSubStream1; @@ -574,7 +585,7 @@ class procedure TKMemoryStream.AsyncSaveStreamsToFileAndFree(var aMainStream, aS aSubStream2 := nil; //So caller doesn't use it by mistake {$IFDEF WDC} - aWorkerThread.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin try localMainStream.AppendStream(localSubStream1, aMarker1); @@ -586,6 +597,8 @@ class procedure TKMemoryStream.AsyncSaveStreamsToFileAndFree(var aMainStream, aS localMainStream.Free; end; end, 'SaveStreamsToFile ' + aMarker1 + ' ' + aMarker2); + + aWorkerThread.Enqueue(task); {$ELSE} try mainStream.AppendStream(localStream1, aMarker1); diff --git a/src/common/KM_WorkerThread.pas b/src/common/KM_WorkerThread.pas index 1c6080796d..4d8788e6f3 100644 --- a/src/common/KM_WorkerThread.pas +++ b/src/common/KM_WorkerThread.pas @@ -4,33 +4,49 @@ interface uses Classes, SysUtils, Generics.Collections; + // procedure TKMWorkLoggerCallback(aJobName: String); + type - TKMWorkerThreadTask = class + ITKMWorkerThreadTask = class abstract(TInterfacedObject) + procedure exec; virtual; abstract; + end; + + TKMWorkerThreadTaskBase = class abstract(ITKMWorkerThreadTask) + protected WorkName: string; + public + constructor Create(const aWorkName: String); + end; + + TKMWorkerThreadTask = class(TKMWorkerThreadTaskBase) + private Proc: TProc; Callback: TProc; + public + constructor Create(aProc: TProc; aCallback: TProc = nil; aWorkName: string = ''); overload; + constructor Create(aProc: TProc; aCallback: aWorkName: string = ''); overload; + + procedure exec; override; end; TKMWorkerThread = class(TThread) private fWorkerThreadName: string; fWorkCompleted: Boolean; - fTaskQueue: TQueue; + fTaskQueue: TQueue; procedure NameThread; overload; procedure NameThread(aThreadName: string); overload; function GetBaseThreadName: string; public - //Special mode for exception handling. Runs work synchronously inside QueueWork + //Special mode for exception handling. Runs work synchronously inside Enqueue fSynchronousExceptionMode: Boolean; constructor Create(const aThreadName: string = ''); destructor Destroy; override; procedure Execute; override; - procedure QueueWorkAndLog(aProc: TProc; aWorkName: string = ''); - procedure QueueWork(aProc: TProc; aWorkName: string = ''); overload; - procedure QueueWork(aProc: TProc; aCallback: TProc = nil; aWorkName: string = ''); overload; + procedure Enqueue(aTask: ITKMWorkerThreadTask); procedure WaitForAllWorkToComplete; end; @@ -55,6 +71,30 @@ implementation KM_Log; +constructor TKMWorkerThreadTaskBase.Create(const aWorkName: String); +begin + WorkName := aWorkName; +end; + +constructor TKMWorkerThreadTask.Create(aProc: TProc; aCallback: TProc = nil; aWorkName: string = ''); +begin + inherited Create(aWorkName); + Proc := aProc; + Callback := aCallback; +end; + +constructor TKMWorkerThreadTask.Create(aProc: TProc; aWorkName: string = ''); +begin + Create(aProc, nil, aWorkName); +end; + +procedure TKMWorkerThreadTask.exec; +begin + Proc(); + if Assigned(Callback) then + Callback(WorkName); +end; + { TKMWorkerThread } constructor TKMWorkerThread.Create(const aThreadName: string = ''); begin @@ -71,7 +111,7 @@ constructor TKMWorkerThread.Create(const aThreadName: string = ''); fWorkCompleted := False; fSynchronousExceptionMode := False; - fTaskQueue := TQueue.Create; + fTaskQueue := TQueue.Create; end; destructor TKMWorkerThread.Destroy; @@ -120,7 +160,7 @@ procedure TKMWorkerThread.NameThread(aThreadName: string); procedure TKMWorkerThread.Execute; var - job: TKMWorkerThreadTask; + job: ITKMWorkerThreadTask; loopRunning: Boolean; threadName: string; begin @@ -162,11 +202,7 @@ procedure TKMWorkerThread.Execute; if job <> nil then begin NameThread(threadName); - job.Proc(); - - if Assigned(job.Callback) then - job.Callback(job.WorkName); - + job.exec; FreeAndNil(job); end; @@ -174,49 +210,31 @@ procedure TKMWorkerThread.Execute; end; end; - -procedure TKMWorkerThread.QueueWorkAndLog(aProc: TProc; aWorkName: string = ''); -begin - QueueWork(aProc, procedure(aJobName: String) - begin - gLog.MultithreadLogging := True; - try - gLog.AddTime(Format('Job ''%s'' is completed', [aJobName])); - finally - gLog.MultithreadLogging := False; - end; - end, aWorkName); -end; - - -procedure TKMWorkerThread.QueueWork(aProc: TProc; aWorkName: string = ''); -begin - QueueWork(aProc, nil, aWorkName); -end; - - -procedure TKMWorkerThread.QueueWork(aProc: TProc; aCallback: TProc = nil; aWorkName: string = ''); -var - job: TKMWorkerThreadTask; +// procedure TKMWorkLoggerCallback(aJobName: String); +// begin +// gLog.MultithreadLogging := True; +// try +// gLog.AddTime(Format('Job ''%s'' is completed', [aJobName])); +// finally +// gLog.MultithreadLogging := False; +// end; +// end; + +procedure TKMWorkerThread.Enqueue(aTask: ITKMWorkerThreadTask); begin if fSynchronousExceptionMode then begin - aProc(); + aTask.exec; end else begin if Finished then - raise Exception.Create('Worker thread not running in TKMWorkerThread.QueueWork'); - - job := TKMWorkerThreadTask.Create; - job.Proc := aProc; - job.Callback := aCallback; - job.WorkName := aWorkName; + raise Exception.Create('Worker thread not running in TKMWorkerThread.Enqueue'); TMonitor.Enter(fTaskQueue); try fWorkCompleted := False; - fTaskQueue.Enqueue(job); + fTaskQueue.Enqueue(aTask); TMonitor.Pulse(fTaskQueue); finally diff --git a/src/game/KM_Game.pas b/src/game/KM_Game.pas index 5da7e3dd5d..819de67ad4 100644 --- a/src/game/KM_Game.pas +++ b/src/game/KM_Game.pas @@ -1416,6 +1416,7 @@ procedure TKMGame.AutoSave(aTimestamp: TDateTime); {$IFDEF WDC} var localIsMultiPlayerOrSpec: Boolean; + task: TKMWorkerThreadTask; {$ENDIF} begin Save(AUTOSAVE_SAVE_NAME, aTimestamp, fAutoSaveWorkerThreadHolder.Worker); //Save to temp file @@ -1424,10 +1425,11 @@ procedure TKMGame.AutoSave(aTimestamp: TDateTime); {$IFDEF WDC} //Avoid accessing Self from async thread, copy required states to local variables localIsMultiPlayerOrSpec := fParams.IsMultiPlayerOrSpec; - fAutoSaveWorkerThreadHolder.Worker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin DoAutoSaveRename(localIsMultiPlayerOrSpec); end, 'AutoSaveRename'); + fAutoSaveWorkerThreadHolder.Worker.Enqueue(task); {$ELSE} DoAutoSaveRename(fParams.IsMultiPlayerOrSpec); {$ENDIF} @@ -2228,6 +2230,7 @@ procedure TKMGame.SaveGameToStream(aTimestamp: TDateTime; aHeaderStream, aBodySt procedure TKMGame.PrepareSaveFolder(const aPathName: String; aSaveByPlayer: Boolean; aSaveWorkerThread: TKMWorkerThread); var path: string; + task: TKMWorkerThreadTask; begin path := aPathName; //Makes the folders in case they were deleted. @@ -2235,7 +2238,7 @@ procedure TKMGame.PrepareSaveFolder(const aPathName: String; aSaveByPlayer: Bool if (aPathName <> '') then begin // We can make directories in async too, since all save parts are made in async now - aSaveWorkerThread.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin path := ExtractFilePath(path); if DirectoryExists(path) then @@ -2255,6 +2258,7 @@ procedure TKMGame.PrepareSaveFolder(const aPathName: String; aSaveByPlayer: Bool else ForceDirectories(path); end, 'Prepare save dir'); + aSaveWorkerThread.Enqueue(task); end; end; @@ -2359,6 +2363,7 @@ procedure TKMGame.Save(const aSaveName: UnicodeString; aTimestamp: TDateTime; aS I, index: Integer; fullPath, rngPath, mpLocalDataPath, newSaveName, loadFrom: UnicodeString; saveByPlayer: Boolean; + task: TKMWorkerThreadTask; begin {$IFDEF PERFLOG} gPerfLogs.SectionEnter(psGameSaveWait); @@ -2382,12 +2387,15 @@ procedure TKMGame.Save(const aSaveName: UnicodeString; aTimestamp: TDateTime; aS try // Emulate slow save in the async save thread if SLOW_GAME_SAVE_ASYNC then - aSaveWorkerThread.QueueWork(procedure + begin + task := TKMWorkerThreadTask.Create(procedure begin Sleep(10000); end, 'Slow Game Save' ); + aSaveWorkerThread.Enqueue(task); + end; //Convert name to full path+name fullPath := SaveName(aSaveName, EXT_SAVE_MAIN, fParams.IsMultiplayer); diff --git a/src/game/KM_GameSavePoints.pas b/src/game/KM_GameSavePoints.pas index 5746863fb8..79a36d2035 100644 --- a/src/game/KM_GameSavePoints.pas +++ b/src/game/KM_GameSavePoints.pas @@ -244,6 +244,7 @@ procedure TKMSavePointCollection.NewSavePointAsyncAndFree(var aStream: TKMemoryS {$IFDEF WDC} var localStream: TKMemoryStream; + task: TKMWorkerThreadTask; {$ENDIF} begin {$IFDEF WDC} @@ -262,7 +263,7 @@ procedure TKMSavePointCollection.NewSavePointAsyncAndFree(var aStream: TKMemoryS // Increase save threads counter in main thread AtomicIncrement(fAsyncThreadsCnt); - aWorkerThread.QueueWork( + task := TKMWorkerThreadTask.Create( procedure var S: TKMemoryStream; @@ -285,6 +286,8 @@ procedure TKMSavePointCollection.NewSavePointAsyncAndFree(var aStream: TKMemoryS AtomicDecrement(fAsyncThreadsCnt); end, 'NewSavePointAsyncAndFree'); + aWorkerThread.Enqueue(task); + {$ELSE} NewSavePoint(aStream, aTick); {$ENDIF} @@ -363,6 +366,7 @@ procedure TKMSavePointCollection.SaveToFileAsync(const aFileName: UnicodeString; {$IFNDEF WDC} var localStream: TKMemoryStream; + task: TKMWorkerThreadTask; {$ENDIF} begin if Self = nil then Exit; @@ -371,7 +375,7 @@ procedure TKMSavePointCollection.SaveToFileAsync(const aFileName: UnicodeString; // Increase save threads counter in main thread AtomicIncrement(fAsyncThreadsCnt); - aWorkerThread.QueueWork( + task := TKMWorkerThreadTask.Create( procedure var localStream: TKMemoryStream; @@ -386,6 +390,8 @@ procedure TKMSavePointCollection.SaveToFileAsync(const aFileName: UnicodeString; localStream.Free; end; end, 'Save SavePoints'); + + aWorkerThread.Enqueue(task); {$ELSE} localStream := TKMemoryStreamBinary.Create; try diff --git a/src/res/KM_ResExporter.pas b/src/res/KM_ResExporter.pas index 787a716f2d..7d29bef82c 100644 --- a/src/res/KM_ResExporter.pas +++ b/src/res/KM_ResExporter.pas @@ -111,11 +111,13 @@ procedure TKMResExporter.PrepareAtlasMap(aSpritePack: TKMSpritePack); procedure TKMResExporter.ExportSpritesFromRXXToPNG(aRT: TRXType; aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var sprites: TKMResSprites; begin @@ -127,15 +129,19 @@ procedure TKMResExporter.ExportSpritesFromRXXToPNG(aRT: TRXType; aOnDone: TProc< sprites.Free; end; end, aOnDone, 'Export from ' + RX_INFO[aRT].FileName + '.rxx'); + + GetOrCreateExportWorker.Enqueue(task); end; procedure TKMResExporter.ExportSpritesFromRXAToPNG(aRT: TRXType; aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var I: Integer; folderPath: string; @@ -159,16 +165,19 @@ procedure TKMResExporter.ExportSpritesFromRXAToPNG(aRT: TRXType; aOnDone: TProc< sprites.Free; end; end, aOnDone, 'Export from ' + RX_INFO[aRT].FileName + '.rxa'); + + GetOrCreateExportWorker.Enqueue(task); end; procedure TKMResExporter.ExportUnitAnimHD(aUnitFrom, aUnitTo: TKMUnitType; aExportThoughts, aExportUnused: Boolean; aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; UT: TKMUnitType; @@ -318,17 +327,21 @@ procedure TKMResExporter.ExportUnitAnimHD(aUnitFrom, aUnitTo: TKMUnitType; aExpo resTexts.Free; end; end, aOnDone, 'Export HD units anim'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; //Export Units graphics categorized by Unit and Action procedure TKMResExporter.ExportUnitAnim(aUnitFrom, aUnitTo: TKMUnitType; aExportUnused: Boolean; aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; UT: TKMUnitType; @@ -457,16 +470,20 @@ procedure TKMResExporter.ExportUnitAnim(aUnitFrom, aUnitTo: TKMUnitType; aExport resTexts.Free; end; end, aOnDone, 'Export units anim'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; procedure TKMResExporter.ExportHouseAnimHD(aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; I, LVL, STEP, Q, spriteID: Integer; @@ -555,17 +572,21 @@ procedure TKMResExporter.ExportHouseAnimHD(aOnDone: TProc); sprites.Free; end; end, aOnDone, 'Export HD House animation'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; //Export Houses graphics categorized by House and Action procedure TKMResExporter.ExportHouseAnim(aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; houses: TKMResHouses; @@ -637,6 +658,9 @@ procedure TKMResExporter.ExportHouseAnim(aOnDone: TProc); sprites.Free; end; end, aOnDone, 'Export house anim'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; @@ -716,12 +740,13 @@ procedure TKMResExporter.ExportFullImageDataFromAtlas(aSpritePack: TKMSpritePack procedure TKMResExporter.ExportTreeAnimHD(aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; I, J, K, spriteID: Integer; @@ -763,17 +788,21 @@ procedure TKMResExporter.ExportTreeAnimHD(aOnDone: TProc); sprites.Free; end; end, aOnDone, 'Export HD Tree animation'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; //Export Trees graphics categorized by ID procedure TKMResExporter.ExportTreeAnim(aOnDone: TProc); +var + task: TKMWorkerThreadTask; begin // Make sure we loaded all of the resources (to avoid collisions with async res loader gRes.LoadGameResources(True); - // Asynchroniously export data - GetOrCreateExportWorker.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure var fullFolderPath, folderPath: string; I, K, spriteID: Integer; @@ -813,6 +842,9 @@ procedure TKMResExporter.ExportTreeAnim(aOnDone: TProc); sprites.Free; end; end, aOnDone, 'Export tree anim'); + + // Asynchroniously export data + GetOrCreateExportWorker.Enqueue(task); end; diff --git a/src/utils/io/KM_FileIO.pas b/src/utils/io/KM_FileIO.pas index 96e603a1ef..79765e66b0 100644 --- a/src/utils/io/KM_FileIO.pas +++ b/src/utils/io/KM_FileIO.pas @@ -180,12 +180,17 @@ procedure KMCopyFile(const aSrc, aDest: UnicodeString; aOverwrite: Boolean); {$IFDEF WDC OR FPC_FULLVERSION >= 30200} procedure KMCopyFileAsync(const aSrc, aDest: UnicodeString; aOverwrite: Boolean; aWorkerThread: TKMWorkerThread); +{$IFDEF WDC} +var + task: TKMWorkerThreadTask; +{$ENDIF} begin {$IFDEF WDC} - aWorkerThread.QueueWork(procedure + task := TKMWorkerThreadTask.Create(procedure begin KMCopyFile(aSrc, aDest, aOverwrite); end, 'KMCopyFile'); + aWorkerThread.Enqueue(task); {$ELSE} KMCopyFile(aSrc, aDest, aOverwrite); {$ENDIF}