diff options
23 files changed, 10228 insertions, 10226 deletions
diff --git a/Game/Code/Classes/UAudioPlayback_SDL.pas b/Game/Code/Classes/UAudioPlayback_SDL.pas index 4c9200b2..6fc22242 100644 --- a/Game/Code/Classes/UAudioPlayback_SDL.pas +++ b/Game/Code/Classes/UAudioPlayback_SDL.pas @@ -56,7 +56,7 @@ end; function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean;
var
desiredAudioSpec, obtainedAudioSpec: TSDL_AudioSpec;
- err: integer;
+// err: integer; // Auto Removed, Unused Variable
begin
result := false;
diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas index 7f05289b..a6a0ba15 100644 --- a/Game/Code/Classes/UCore.pas +++ b/Game/Code/Classes/UCore.pas @@ -422,7 +422,7 @@ end; // Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
//-------------
Function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
-var Params: Cardinal;
+// var Params: Cardinal; // Auto Removed, Unused Variable
begin
Result := -1;
diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas index 90f8b34a..f681626d 100644 --- a/Game/Code/Classes/UGraphic.pas +++ b/Game/Code/Classes/UGraphic.pas @@ -1,802 +1,802 @@ -unit UGraphic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- OpenGL12,
- UTexture,
- TextGL,
- ULog,
- SysUtils,
- ULyrics,
- UScreenLoading,
- UScreenWelcome,
- UScreenMain,
- UScreenName,
- UScreenLevel,
- UScreenOptions,
- UScreenOptionsGame,
- UScreenOptionsGraphics,
- UScreenOptionsSound,
- UScreenOptionsLyrics,
- UScreenOptionsThemes,
- UScreenOptionsRecord,
- UScreenOptionsAdvanced,
- UScreenSong,
- UScreenSing,
- UScreenScore,
- UScreenTop5,
- UScreenEditSub,
- UScreenEdit,
- UScreenEditConvert,
- UScreenEditHeader,
- UScreenOpen,
- UThemes,
- USkins,
- UScreenSongMenu,
- UScreenSongJumpto,
- {Party Screens}
- UScreenSingModi,
- UScreenPartyNewRound,
- UScreenPartyScore,
- UScreenPartyOptions,
- UScreenPartyWin,
- UScreenPartyPlayer,
- {Stats Screens}
- UScreenStatMain,
- UScreenStatDetail,
- {CreditsScreen}
- UScreenCredits,
- {Popup for errors, etc.}
- UScreenPopup;
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
- end;
-
-var
- Screen: PSDL_Surface;
- LoadingThread: PSDL_Thread;
- Mutex: PSDL_Mutex;
-
- RenderW: integer;
- RenderH: integer;
- ScreenW: integer;
- ScreenH: integer;
- Screens: integer;
- ScreenAct: integer;
- ScreenX: integer;
-
- ScreenLoading: TScreenLoading;
- ScreenWelcome: TScreenWelcome;
- ScreenMain: TScreenMain;
- ScreenName: TScreenName;
- ScreenLevel: TScreenLevel;
- ScreenSong: TScreenSong;
- ScreenSing: TScreenSing;
- ScreenScore: TScreenScore;
- ScreenTop5: TScreenTop5;
- ScreenOptions: TScreenOptions;
- ScreenOptionsGame: TScreenOptionsGame;
- ScreenOptionsGraphics: TScreenOptionsGraphics;
- ScreenOptionsSound: TScreenOptionsSound;
- ScreenOptionsLyrics: TScreenOptionsLyrics;
- ScreenOptionsThemes: TScreenOptionsThemes;
- ScreenOptionsRecord: TScreenOptionsRecord;
- ScreenOptionsAdvanced: TScreenOptionsAdvanced;
- ScreenEditSub: TScreenEditSub;
- ScreenEdit: TScreenEdit;
- ScreenEditConvert: TScreenEditConvert;
- ScreenEditHeader: TScreenEditHeader;
- ScreenOpen: TScreenOpen;
-
- ScreenSongMenu: TScreenSongMenu;
- ScreenSongJumpto: TScreenSongJumpto;
-
- //Party Screens
- ScreenSingModi: TScreenSingModi;
- ScreenPartyNewRound: TScreenPartyNewRound;
- ScreenPartyScore: TScreenPartyScore;
- ScreenPartyWin: TScreenPartyWin;
- ScreenPartyOptions: TScreenPartyOptions;
- ScreenPartyPlayer: TScreenPartyPlayer;
-
- //StatsScreens
- ScreenStatMain: TScreenStatMain;
- ScreenStatDetail: TScreenStatDetail;
-
- //CreditsScreen
- ScreenCredits: TScreenCredits;
-
- //popup mod
- ScreenPopupCheck: TScreenPopupCheck;
- ScreenPopupError: TScreenPopupError;
-
- //Notes
- Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
- Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
- Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
-
- Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
- Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
- Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
-
- Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
- Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
- Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
-
- Tex_Note_Star: TTexture;
- Tex_Note_Perfect_Star: TTexture;
-
-
- Tex_Ball: TTexture;
- Tex_Lyric_Help_Bar: TTexture;
- FullScreen: boolean;
-
- Tex_TimeProgress: TTexture;
-
- //Sing Bar Mod
- Tex_SingBar_Back: TTexture;
- Tex_SingBar_Bar: TTexture;
- Tex_SingBar_Front: TTexture;
- //end Singbar Mod
-
- //PhrasenBonus - Line Bonus Mod
- Tex_SingLineBonusBack: array[0..8] of TTexture;
- //End PhrasenBonus - Line Bonus Mod
-
- //ScoreBG Texs
- Tex_ScoreBG: array [0..5] of TTexture;
-
- //Score Screen Textures
- Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
-
- Tex_Score_Ratings : array [0..6] of TTexture;
-
-const
- Skin_BGColorR = 1;
- Skin_BGColorG = 1;
- Skin_BGColorB = 1;
-
- Skin_SpectrumR = 0;
- Skin_SpectrumG = 0;
- Skin_SpectrumB = 0;
-
- Skin_Spectograph1R = 0.6;
- Skin_Spectograph1G = 0.8;
- Skin_Spectograph1B = 1;
-
- Skin_Spectograph2R = 0;
- Skin_Spectograph2G = 0;
- Skin_Spectograph2B = 0.2;
-
- Skin_SzczytR = 0.8;
- Skin_SzczytG = 0;
- Skin_SzczytB = 0;
-
- Skin_SzczytLimitR = 0;
- Skin_SzczytLimitG = 0.8;
- Skin_SzczytLimitB = 0;
-
- Skin_FontR = 0;
- Skin_FontG = 0;
- Skin_FontB = 0;
-
- Skin_FontHighlightR = 0.3; // 0.3
- Skin_FontHighlightG = 0.3; // 0.3
- Skin_FontHighlightB = 1; // 1
-
- Skin_TimeR = 0.25; //0,0,0
- Skin_TimeG = 0.25;
- Skin_TimeB = 0.25;
-
- Skin_OscR = 0;
- Skin_OscG = 0;
- Skin_OscB = 0;
-
- Skin_LyricsT = 494; // 500 / 510 / 400
- Skin_SpectrumT = 470;
- Skin_SpectrumBot = 570;
- Skin_SpectrumH = 100;
-
- Skin_P1_LinesR = 0.5; // 0.6 0.6 1
- Skin_P1_LinesG = 0.5;
- Skin_P1_LinesB = 0.5;
-
- Skin_P2_LinesR = 0.5; // 1 0.6 0.6
- Skin_P2_LinesG = 0.5;
- Skin_P2_LinesB = 0.5;
-
- Skin_P1_NotesB = 250;
- Skin_P2_NotesB = 430; // 430 / 300
-
- Skin_P1_ScoreT = 50;
- Skin_P1_ScoreL = 20;
-
- Skin_P2_ScoreT = 50;
- Skin_P2_ScoreL = 640;
-
-procedure Initialize3D (Title: string);
-procedure Reinitialize3D;
-procedure SwapBuffers;
-
-procedure LoadTextures;
-procedure InitializeScreen;
-procedure LoadLoadingScreen;
-procedure LoadScreens;
-procedure UnLoadScreens;
-
-function LoadingThreadFunction: integer;
-
-
-implementation
-
-uses UMain,
- UIni,
- UDisplay,
- UCommandLine,
- {$IFNDEF FPC}
- Graphics,
- {$ENDIF}
- {$IFDEF win32}
- windows,
- {$ENDIF}
- Classes;
-
-procedure LoadFontTextures;
-begin
- Log.LogStatus('Building Fonts', 'LoadTextures');
- BuildFont;
-end;
-
-procedure LoadTextures;
-
-
-var
- P: integer;
- R, G, B: real;
- Col: integer;
-begin
- // zaladowanie tekstur
- Log.LogStatus('Loading Textures', 'LoadTextures');
-
- Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch?
- Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch?
- Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch?
-
- Log.LogStatus('Loading Textures - A', 'LoadTextures');
-
- // P1-6
- // TODO... do it once for each player... this is a bit crappy !!
- // can we make it any better !?
- for P := 1 to 6 do
- begin
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
-
- Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col);
- Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col);
- Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col);
-
- Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col);
- Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col);
- Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col);
-
- Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col);
- Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col);
- Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col);
- end;
-
- Log.LogStatus('Loading Textures - B', 'LoadTextures');
-
- Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0);
- Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF);
- Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF);
- Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF);
-
-
- //TimeBar mod
- Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar')));
- //eoa TimeBar mod
-
- //SingBar Mod
- Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0);
- Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0);
- Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0);
- //end Singbar Mod
-
- Log.LogStatus('Loading Textures - C', 'LoadTextures');
-
- //Line Bonus PopUp
- for P := 0 to 8 do
- begin
- Case P of
- 0: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 1..3: begin
- R := 1;
- G := (P * 0.25);
- B := 0;
- end;
- 4: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 5..7: begin
- R := 1-((P-4)*0.25);
- G := 1;
- B := 0;
- end;
- 8: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- End;
-
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col);
- end;
-
-//## backgrounds for the scores ##
- for P := 0 to 5 do begin
- LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col);
- end;
-
-
- Log.LogStatus('Loading Textures - D', 'LoadTextures');
-
-// ######################
-// Score screen textures
-// ######################
-
-//## the bars that visualize the score ##
- for P := 1 to 6 do begin
-//NoteBar ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col);
-//LineBonus ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col);
-//GoldenNotes ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col);
- end;
-
-//## rating pictures that show a picture according to your rate ##
- for P := 0 to 6 do begin
- Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0);
- end;
-
- Log.LogStatus('Loading Textures - Done', 'LoadTextures');
-end;
-
-procedure Initialize3D (Title: string);
-var
-// Icon: TIcon;
-// Res: TResourceStream;
- ISurface: PSDL_Surface;
- Pixel: PByteArray;
- I: Integer;
-begin
- Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D');
-// Log.BenchmarkStart(2);
-
- LoadOpenGL;
-
- Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
- if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then
- begin
- Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
- exit;
- end;
-
- { //Load Icon
- Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON);
- Icon := TIcon.Create;
- Icon.LoadFromStream(Res);
- Res.Free;
- Icon.
- //Create icon Surface
- SDL_CreateRGBSurfaceFrom (
- SDL_SWSURFACE,
- Icon.Width,
- Icon.Height,
- 32,
- 128 or 64,
- 32 or 16,
- 8 or 4,
- 2 or 1);
- //SDL_BlitSurface(
-
-
- SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //}
-
- SDL_WM_SetCaption(PChar(Title), nil);
-
- InitializeScreen;
-
-// Log.BenchmarkEnd(2);
-// Log.LogBenchmark('--> Setting Screen', 2);
-
- // ladowanie tekstur
-// Log.BenchmarkStart(2);
- Texture := TTextureUnit.Create;
- Texture.Limit := 1024*1024;
-
-// LoadTextures;
-// Log.BenchmarkEnd(2);
-// Log.LogBenchmark('--> Loading Textures', 2);
-
-{ Log.BenchmarkStart(2);
- Lyric:= TLyric.Create;
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Fonts', 2);
-}
-
-// Log.BenchmarkStart(2);
-
- Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
- Display := TDisplay.Create;
-
- Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D');
- SDL_EnableUnicode(1);
-// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
-
-// Log.LogStatus('Loading Screens', 'Initialize3D');
-// Log.BenchmarkStart(3);
-
- Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
- LoadFontTextures();
-
- // Show the Loading Screen -------------
- Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
- LoadLoadingScreen;
-
-
- Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
- LoadTextures; // jb
-
-
-
- // now that we have something to display while loading,
- // start thread that loads the rest of ultrastar
-// Mutex := SDL_CreateMutex;
-// SDL_UnLockMutex(Mutex);
-
- // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will
- // siehe dazu kommentar unten
- // Englisch Translation:
- // is currently not working because the loading thread trys to accses opengl unchanged
- // look comment below
-
- //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
-
- // this would be run in the loadingthread
- Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
- LoadScreens;
-
-
- // TODO!!!!!!1
- // hier käme jetzt eine schleife, die
- // * den ladescreen malt (ab und zu)
- // * den "fortschritt" des ladescreens steuert
- // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und
- // * die texturen in die opengl lädt, sowie
- // * dem ladethread signalisiert, dass der speicher für die textur
- // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex)
- // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert,
- // dass er alles geladen hat fertig ist
- //
- // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche
- // opengl funktionen aufzurufen, entsprechend mutexe verändert
- // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist,
- // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ...
- //
- // English Translation:
- // here should be a loop witch
- // * draws the loading screen (form time to time)
- // * controlls the "process of the loading screen
- // * checks if the loadingthread has loaded textures (check mutex) and
- // * load the textures into opengl
- // * tells the loadingthread, that the memory for the texture can be reused
- // to load the netx texture (over another mutex)
- // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
- //
- // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
- // for itself, it should change mutex
- // the mainthread have to know somehow what opengl function have to be called with which parameters like
- // texturetype, textureobjekt, textur-buffer-adress, ...
-
-
-
- // wait for loading thread to finish
- // funktioniert so auch noch nicht - currently dos not work this way
- // SDL_WaitThread(LoadingThread, I);
- // SDL_DestroyMutex(Mutex);
-
- Display.CurrentScreen^.FadeTo( @ScreenMain );
-
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Screens', 2);
-
- Log.LogStatus('Finish', 'Initialize3D');
-end;
-
-procedure SwapBuffers;
-begin
- SDL_GL_SwapBuffers;
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- glOrtho(0, RenderW, RenderH, 0, -1, 100);
- glMatrixMode(GL_MODELVIEW);
-end;
-
-procedure Reinitialize3D;
-begin
-// InitializeScreen;
-// LoadTextures;
-// LoadScreens;
-end;
-
-procedure InitializeScreen;
-var
- S: string;
- I: integer;
- W, H: integer;
- Depth: Integer;
-begin
- if (Params.Screens <> -1) then
- Screens := Params.Screens + 1
- else
- Screens := Ini.Screens + 1;
-
- SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
- SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
-
- // If there is a resolution in Parameters, use it, else use the Ini value
- I := Params.Resolution;
- if (I <> -1) then
- S := IResolution[I]
- else
- S := IResolution[Ini.Resolution];
-
- I := Pos('x', S);
- W := StrToInt(Copy(S, 1, I-1)) * Screens;
- H := StrToInt(Copy(S, I+1, 1000));
-
- {if ParamStr(1) = '-fsblack' then begin
- W := 800;
- H := 600;
- end;
- if ParamStr(1) = '-320x240' then begin
- W := 320;
- H := 240;
- end; }
-
- If (Params.Depth <> -1) then
- Depth := Params.Depth
- else
- Depth := Ini.Depth;
-
-
- Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon');
-
-// Okay it's possible to set the title bar / taskbar icon here
-// it's working this way, but just if the bmp is in your exe folder
- SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0);
-
- Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
-// SDL_SetRefreshrate(85);
-// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
-
- {$IFDEF DARWIN}
- // Todo : eddie: remove before realease
- Ini.FullScreen := 0;
- {$ENDIF}
-
- if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE)
- end
- else
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
- SDL_ShowCursor(0);
- end;
-
- if (screen = nil) then
- begin
- Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
- exit;
- end;
-
- // clear screen once window is being shown
- glClearColor(1, 1, 1, 1);
- glClear(GL_COLOR_BUFFER_BIT);
- SwapBuffers;
-
- // zmienne
- RenderW := 800;
- RenderH := 600;
- ScreenW := W;
- ScreenH := H;
-end;
-
-procedure LoadLoadingScreen;
-begin
- ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
-
- Display.CurrentScreen := @ScreenLoading;
-
- swapbuffers;
-
- ScreenLoading.Draw;
- Display.Draw;
-
- SwapBuffers;
-end;
-
-procedure LoadScreens;
-begin
-{ ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
- Display.CurrentScreen := @ScreenLoading;
- ScreenLoading.Draw;
- Display.Draw;
- SwapBuffers;
-}
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
-{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
- ScreenMain := TScreenMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
- ScreenName := TScreenName.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
- ScreenLevel := TScreenLevel.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
- ScreenSong := TScreenSong.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
- ScreenSing := TScreenSing.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
- ScreenScore := TScreenScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
- ScreenTop5 := TScreenTop5.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
- ScreenOptions := TScreenOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
- ScreenOptionsGame := TScreenOptionsGame.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
- ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
- ScreenOptionsSound := TScreenOptionsSound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
- ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
- ScreenOptionsThemes := TScreenOptionsThemes.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
- ScreenOptionsRecord := TScreenOptionsRecord.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
- ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
- ScreenEditSub := TScreenEditSub.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
- ScreenEdit := TScreenEdit.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
- ScreenEditConvert := TScreenEditConvert.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
-// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
-// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
- ScreenOpen := TScreenOpen.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
- ScreenSingModi := TScreenSingModi.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
- ScreenSongJumpto := TScreenSongJumpto.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
- ScreenPopupCheck := TScreenPopupCheck.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
- ScreenPopupError := TScreenPopupError.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
- ScreenPartyNewRound := TScreenPartyNewRound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
- ScreenPartyScore := TScreenPartyScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
- ScreenPartyWin := TScreenPartyWin.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
- ScreenPartyOptions := TScreenPartyOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
- ScreenPartyPlayer := TScreenPartyPlayer.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
- ScreenStatMain := TScreenStatMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
- ScreenStatDetail := TScreenStatDetail.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
- ScreenCredits := TScreenCredits.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
-
-end;
-
-function LoadingThreadFunction: integer;
-begin
- LoadScreens;
- Result:= 1;
-end;
-
-procedure UnLoadScreens;
-begin
- freeandnil( ScreenMain );
- freeandnil( ScreenName );
- freeandnil( ScreenLevel);
- freeandnil( ScreenSong );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSing );
- freeandnil( ScreenScore);
- freeandnil( ScreenTop5 );
- freeandnil( ScreenOptions );
- freeandnil( ScreenOptionsGame );
- freeandnil( ScreenOptionsGraphics );
- freeandnil( ScreenOptionsSound );
- freeandnil( ScreenOptionsLyrics );
-// freeandnil( ScreenOptionsThemes );
- freeandnil( ScreenOptionsRecord );
- freeandnil( ScreenOptionsAdvanced );
- freeandnil( ScreenEditSub );
- freeandnil( ScreenEdit );
- freeandnil( ScreenEditConvert );
- freeandnil( ScreenOpen );
- freeandnil( ScreenSingModi );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSongJumpto);
- freeandnil( ScreenPopupCheck );
- freeandnil( ScreenPopupError );
- freeandnil( ScreenPartyNewRound );
- freeandnil( ScreenPartyScore );
- freeandnil( ScreenPartyWin );
- freeandnil( ScreenPartyOptions );
- freeandnil( ScreenPartyPlayer );
- freeandnil( ScreenStatMain );
- freeandnil( ScreenStatDetail );
-end;
-
-end.
+unit UGraphic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + OpenGL12, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UScreenLoading, + UScreenWelcome, + UScreenMain, + UScreenName, + UScreenLevel, + UScreenOptions, + UScreenOptionsGame, + UScreenOptionsGraphics, + UScreenOptionsSound, + UScreenOptionsLyrics, + UScreenOptionsThemes, + UScreenOptionsRecord, + UScreenOptionsAdvanced, + UScreenSong, + UScreenSing, + UScreenScore, + UScreenTop5, + UScreenEditSub, + UScreenEdit, + UScreenEditConvert, + UScreenEditHeader, + UScreenOpen, + UThemes, + USkins, + UScreenSongMenu, + UScreenSongJumpto, + {Party Screens} + UScreenSingModi, + UScreenPartyNewRound, + UScreenPartyScore, + UScreenPartyOptions, + UScreenPartyWin, + UScreenPartyPlayer, + {Stats Screens} + UScreenStatMain, + UScreenStatDetail, + {CreditsScreen} + UScreenCredits, + {Popup for errors, etc.} + UScreenPopup; + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + end; + +var + Screen: PSDL_Surface; + LoadingThread: PSDL_Thread; + Mutex: PSDL_Mutex; + + RenderW: integer; + RenderH: integer; + ScreenW: integer; + ScreenH: integer; + Screens: integer; + ScreenAct: integer; + ScreenX: integer; + + ScreenLoading: TScreenLoading; + ScreenWelcome: TScreenWelcome; + ScreenMain: TScreenMain; + ScreenName: TScreenName; + ScreenLevel: TScreenLevel; + ScreenSong: TScreenSong; + ScreenSing: TScreenSing; + ScreenScore: TScreenScore; + ScreenTop5: TScreenTop5; + ScreenOptions: TScreenOptions; + ScreenOptionsGame: TScreenOptionsGame; + ScreenOptionsGraphics: TScreenOptionsGraphics; + ScreenOptionsSound: TScreenOptionsSound; + ScreenOptionsLyrics: TScreenOptionsLyrics; + ScreenOptionsThemes: TScreenOptionsThemes; + ScreenOptionsRecord: TScreenOptionsRecord; + ScreenOptionsAdvanced: TScreenOptionsAdvanced; + ScreenEditSub: TScreenEditSub; + ScreenEdit: TScreenEdit; + ScreenEditConvert: TScreenEditConvert; + ScreenEditHeader: TScreenEditHeader; + ScreenOpen: TScreenOpen; + + ScreenSongMenu: TScreenSongMenu; + ScreenSongJumpto: TScreenSongJumpto; + + //Party Screens + ScreenSingModi: TScreenSingModi; + ScreenPartyNewRound: TScreenPartyNewRound; + ScreenPartyScore: TScreenPartyScore; + ScreenPartyWin: TScreenPartyWin; + ScreenPartyOptions: TScreenPartyOptions; + ScreenPartyPlayer: TScreenPartyPlayer; + + //StatsScreens + ScreenStatMain: TScreenStatMain; + ScreenStatDetail: TScreenStatDetail; + + //CreditsScreen + ScreenCredits: TScreenCredits; + + //popup mod + ScreenPopupCheck: TScreenPopupCheck; + ScreenPopupError: TScreenPopupError; + + //Notes + Tex_Left: array[0..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[0..6] of TTexture; //rename to tex_note_right + + Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left + Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid + Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right + + Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left + Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid + Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right + + Tex_Note_Star: TTexture; + Tex_Note_Perfect_Star: TTexture; + + + Tex_Ball: TTexture; + Tex_Lyric_Help_Bar: TTexture; + FullScreen: boolean; + + Tex_TimeProgress: TTexture; + + //Sing Bar Mod + Tex_SingBar_Back: TTexture; + Tex_SingBar_Bar: TTexture; + Tex_SingBar_Front: TTexture; + //end Singbar Mod + + //PhrasenBonus - Line Bonus Mod + Tex_SingLineBonusBack: array[0..8] of TTexture; + //End PhrasenBonus - Line Bonus Mod + + //ScoreBG Texs + Tex_ScoreBG: array [0..5] of TTexture; + + //Score Screen Textures + Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; + + Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; + Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; + + Tex_Score_Ratings : array [0..6] of TTexture; + +const + Skin_BGColorR = 1; + Skin_BGColorG = 1; + Skin_BGColorB = 1; + + Skin_SpectrumR = 0; + Skin_SpectrumG = 0; + Skin_SpectrumB = 0; + + Skin_Spectograph1R = 0.6; + Skin_Spectograph1G = 0.8; + Skin_Spectograph1B = 1; + + Skin_Spectograph2R = 0; + Skin_Spectograph2G = 0; + Skin_Spectograph2B = 0.2; + + Skin_SzczytR = 0.8; + Skin_SzczytG = 0; + Skin_SzczytB = 0; + + Skin_SzczytLimitR = 0; + Skin_SzczytLimitG = 0.8; + Skin_SzczytLimitB = 0; + + Skin_FontR = 0; + Skin_FontG = 0; + Skin_FontB = 0; + + Skin_FontHighlightR = 0.3; // 0.3 + Skin_FontHighlightG = 0.3; // 0.3 + Skin_FontHighlightB = 1; // 1 + + Skin_TimeR = 0.25; //0,0,0 + Skin_TimeG = 0.25; + Skin_TimeB = 0.25; + + Skin_OscR = 0; + Skin_OscG = 0; + Skin_OscB = 0; + + Skin_LyricsT = 494; // 500 / 510 / 400 + Skin_SpectrumT = 470; + Skin_SpectrumBot = 570; + Skin_SpectrumH = 100; + + Skin_P1_LinesR = 0.5; // 0.6 0.6 1 + Skin_P1_LinesG = 0.5; + Skin_P1_LinesB = 0.5; + + Skin_P2_LinesR = 0.5; // 1 0.6 0.6 + Skin_P2_LinesG = 0.5; + Skin_P2_LinesB = 0.5; + + Skin_P1_NotesB = 250; + Skin_P2_NotesB = 430; // 430 / 300 + + Skin_P1_ScoreT = 50; + Skin_P1_ScoreL = 20; + + Skin_P2_ScoreT = 50; + Skin_P2_ScoreL = 640; + +procedure Initialize3D (Title: string); +procedure Reinitialize3D; +procedure SwapBuffers; + +procedure LoadTextures; +procedure InitializeScreen; +procedure LoadLoadingScreen; +procedure LoadScreens; +procedure UnLoadScreens; + +function LoadingThreadFunction: integer; + + +implementation + +uses UMain, + UIni, + UDisplay, + UCommandLine, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + {$IFDEF win32} + windows, + {$ENDIF} + Classes; + +procedure LoadFontTextures; +begin + Log.LogStatus('Building Fonts', 'LoadTextures'); + BuildFont; +end; + +procedure LoadTextures; + + +var + P: integer; + R, G, B: real; + Col: integer; +begin + // zaladowanie tekstur + Log.LogStatus('Loading Textures', 'LoadTextures'); + + Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch? + + Log.LogStatus('Loading Textures - A', 'LoadTextures'); + + // P1-6 + // TODO... do it once for each player... this is a bit crappy !! + // can we make it any better !? + for P := 1 to 6 do + begin + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + + Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col); + Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col); + Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col); + + Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col); + Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col); + Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col); + + Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col); + Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col); + Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col); + end; + + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + + Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0); + Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF); + Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar'))); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0); + Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0); + Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0); + //end Singbar Mod + + Log.LogStatus('Loading Textures - C', 'LoadTextures'); + + //Line Bonus PopUp + for P := 0 to 8 do + begin + Case P of + 0: begin + R := 1; + G := 0; + B := 0; + end; + 1..3: begin + R := 1; + G := (P * 0.25); + B := 0; + end; + 4: begin + R := 1; + G := 1; + B := 0; + end; + 5..7: begin + R := 1-((P-4)*0.25); + G := 1; + B := 0; + end; + 8: begin + R := 0; + G := 1; + B := 0; + end; + End; + + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col); + end; + +//## backgrounds for the scores ## + for P := 0 to 5 do begin + LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col); + end; + + + Log.LogStatus('Loading Textures - D', 'LoadTextures'); + +// ###################### +// Score screen textures +// ###################### + +//## the bars that visualize the score ## + for P := 1 to 6 do begin +//NoteBar ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col); +//LineBonus ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col); +//GoldenNotes ScoreBar + LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest'); + Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); + Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col); + end; + +//## rating pictures that show a picture according to your rate ## + for P := 0 to 6 do begin + Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0); + end; + + Log.LogStatus('Loading Textures - Done', 'LoadTextures'); +end; + +procedure Initialize3D (Title: string); +//var +// Icon: TIcon; +// Res: TResourceStream; +// ISurface: PSDL_Surface; // Auto Removed, Unused Variable +// Pixel: PByteArray; // Auto Removed, Unused Variable +// I: Integer; // Auto Removed, Unused Variable +begin + Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D'); +// Log.BenchmarkStart(2); + + LoadOpenGL; + + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); + if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then + begin + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); + exit; + end; + + { //Load Icon + Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON); + Icon := TIcon.Create; + Icon.LoadFromStream(Res); + Res.Free; + Icon. + //Create icon Surface + SDL_CreateRGBSurfaceFrom ( + SDL_SWSURFACE, + Icon.Width, + Icon.Height, + 32, + 128 or 64, + 32 or 16, + 8 or 4, + 2 or 1); + //SDL_BlitSurface( + + + SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //} + + SDL_WM_SetCaption(PChar(Title), nil); + + InitializeScreen; + +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Setting Screen', 2); + + // ladowanie tekstur +// Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + Texture.Limit := 1024*1024; + +// LoadTextures; +// Log.BenchmarkEnd(2); +// Log.LogBenchmark('--> Loading Textures', 2); + +{ Log.BenchmarkStart(2); + Lyric:= TLyric.Create; + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Fonts', 2); +} + +// Log.BenchmarkStart(2); + + Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); + Display := TDisplay.Create; + + Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D'); + SDL_EnableUnicode(1); +// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); + +// Log.LogStatus('Loading Screens', 'Initialize3D'); +// Log.BenchmarkStart(3); + + Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); + LoadFontTextures(); + + // Show the Loading Screen ------------- + Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); + LoadLoadingScreen; + + + Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); + LoadTextures; // jb + + + + // now that we have something to display while loading, + // start thread that loads the rest of ultrastar +// Mutex := SDL_CreateMutex; +// SDL_UnLockMutex(Mutex); + + // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will + // siehe dazu kommentar unten + // Englisch Translation: + // is currently not working because the loading thread trys to accses opengl unchanged + // look comment below + + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // this would be run in the loadingthread + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); + LoadScreens; + + + // TODO!!!!!!1 + // hier käme jetzt eine schleife, die + // * den ladescreen malt (ab und zu) + // * den "fortschritt" des ladescreens steuert + // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und + // * die texturen in die opengl lädt, sowie + // * dem ladethread signalisiert, dass der speicher für die textur + // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex) + // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert, + // dass er alles geladen hat fertig ist + // + // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche + // opengl funktionen aufzurufen, entsprechend mutexe verändert + // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist, + // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ... + // + // English Translation: + // here should be a loop witch + // * draws the loading screen (form time to time) + // * controlls the "process of the loading screen + // * checks if the loadingthread has loaded textures (check mutex) and + // * load the textures into opengl + // * tells the loadingthread, that the memory for the texture can be reused + // to load the netx texture (over another mutex) + // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex) + // + // therefor loadtexture have to be changed, that it, instat of caling some opengl functions + // for itself, it should change mutex + // the mainthread have to know somehow what opengl function have to be called with which parameters like + // texturetype, textureobjekt, textur-buffer-adress, ... + + + + // wait for loading thread to finish + // funktioniert so auch noch nicht - currently dos not work this way + // SDL_WaitThread(LoadingThread, I); + // SDL_DestroyMutex(Mutex); + + Display.CurrentScreen^.FadeTo( @ScreenMain ); + + Log.BenchmarkEnd(2); + Log.LogBenchmark('--> Loading Screens', 2); + + Log.LogStatus('Finish', 'Initialize3D'); +end; + +procedure SwapBuffers; +begin + SDL_GL_SwapBuffers; + glMatrixMode(GL_PROJECTION); + glLoadIdentity; + glOrtho(0, RenderW, RenderH, 0, -1, 100); + glMatrixMode(GL_MODELVIEW); +end; + +procedure Reinitialize3D; +begin +// InitializeScreen; +// LoadTextures; +// LoadScreens; +end; + +procedure InitializeScreen; +var + S: string; + I: integer; + W, H: integer; + Depth: Integer; +begin + if (Params.Screens <> -1) then + Screens := Params.Screens + 1 + else + Screens := Ini.Screens + 1; + + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // If there is a resolution in Parameters, use it, else use the Ini value + I := Params.Resolution; + if (I <> -1) then + S := IResolution[I] + else + S := IResolution[Ini.Resolution]; + + I := Pos('x', S); + W := StrToInt(Copy(S, 1, I-1)) * Screens; + H := StrToInt(Copy(S, I+1, 1000)); + + {if ParamStr(1) = '-fsblack' then begin + W := 800; + H := 600; + end; + if ParamStr(1) = '-320x240' then begin + W := 320; + H := 240; + end; } + + If (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + + Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon'); + +// Okay it's possible to set the title bar / taskbar icon here +// it's working this way, but just if the bmp is in your exe folder + SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0); + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); +// SDL_SetRefreshrate(85); +// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + + {$IFDEF DARWIN} + // Todo : eddie: remove before realease + Ini.FullScreen := 0; + {$ENDIF} + + if (Ini.FullScreen = 0) and (Not Params.FullScreen) then + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE) + end + else + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); + screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN ); + SDL_ShowCursor(0); + end; + + if (screen = nil) then + begin + Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); + exit; + end; + + // clear screen once window is being shown + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; + + // zmienne + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; +end; + +procedure LoadLoadingScreen; +begin + ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + + Display.CurrentScreen := @ScreenLoading; + + swapbuffers; + + ScreenLoading.Draw; + Display.Draw; + + SwapBuffers; +end; + +procedure LoadScreens; +begin +{ ScreenLoading := TScreenLoading.Create; + ScreenLoading.onShow; + Display.CurrentScreen := @ScreenLoading; + ScreenLoading.Draw; + Display.Draw; + SwapBuffers; +} + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); +{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} + ScreenMain := TScreenMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); + ScreenName := TScreenName.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); + ScreenLevel := TScreenLevel.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); + ScreenSong := TScreenSong.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); + ScreenSing := TScreenSing.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); + ScreenScore := TScreenScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); + ScreenTop5 := TScreenTop5.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); + ScreenOptions := TScreenOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); + ScreenOptionsGame := TScreenOptionsGame.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); + ScreenOptionsGraphics := TScreenOptionsGraphics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); + ScreenOptionsSound := TScreenOptionsSound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); + ScreenOptionsLyrics := TScreenOptionsLyrics.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); + ScreenOptionsThemes := TScreenOptionsThemes.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); + ScreenOptionsRecord := TScreenOptionsRecord.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); + ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); + ScreenEditSub := TScreenEditSub.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); + ScreenEdit := TScreenEdit.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); + ScreenEditConvert := TScreenEditConvert.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); +// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); +// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); + ScreenOpen := TScreenOpen.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); + ScreenSingModi := TScreenSingModi.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); + ScreenSongMenu := TScreenSongMenu.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); + ScreenSongJumpto := TScreenSongJumpto.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); + ScreenPopupCheck := TScreenPopupCheck.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); + ScreenPopupError := TScreenPopupError.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); + ScreenPartyNewRound := TScreenPartyNewRound.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); + ScreenPartyScore := TScreenPartyScore.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); + ScreenPartyWin := TScreenPartyWin.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); + ScreenPartyOptions := TScreenPartyOptions.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); + ScreenPartyPlayer := TScreenPartyPlayer.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); + ScreenStatMain := TScreenStatMain.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); + ScreenStatDetail := TScreenStatDetail.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); + ScreenCredits := TScreenCredits.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); + +end; + +function LoadingThreadFunction: integer; +begin + LoadScreens; + Result:= 1; +end; + +procedure UnLoadScreens; +begin + freeandnil( ScreenMain ); + freeandnil( ScreenName ); + freeandnil( ScreenLevel); + freeandnil( ScreenSong ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSing ); + freeandnil( ScreenScore); + freeandnil( ScreenTop5 ); + freeandnil( ScreenOptions ); + freeandnil( ScreenOptionsGame ); + freeandnil( ScreenOptionsGraphics ); + freeandnil( ScreenOptionsSound ); + freeandnil( ScreenOptionsLyrics ); +// freeandnil( ScreenOptionsThemes ); + freeandnil( ScreenOptionsRecord ); + freeandnil( ScreenOptionsAdvanced ); + freeandnil( ScreenEditSub ); + freeandnil( ScreenEdit ); + freeandnil( ScreenEditConvert ); + freeandnil( ScreenOpen ); + freeandnil( ScreenSingModi ); + freeandnil( ScreenSongMenu ); + freeandnil( ScreenSongJumpto); + freeandnil( ScreenPopupCheck ); + freeandnil( ScreenPopupError ); + freeandnil( ScreenPartyNewRound ); + freeandnil( ScreenPartyScore ); + freeandnil( ScreenPartyWin ); + freeandnil( ScreenPartyOptions ); + freeandnil( ScreenPartyPlayer ); + freeandnil( ScreenStatMain ); + freeandnil( ScreenStatDetail ); +end; + +end. diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas index 6380b10a..c30bf676 100644 --- a/Game/Code/Classes/ULog.pas +++ b/Game/Code/Classes/ULog.pas @@ -282,7 +282,7 @@ end; procedure TLog.LogVoice(SoundNr: integer);
var
- FileVoice: File;
+// FileVoice: File; // Auto Removed, Unused Variable
FS: TFileStream;
FileName: string;
Num: integer;
diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas index bb8e38e6..2f62f441 100644 --- a/Game/Code/Classes/URecord.pas +++ b/Game/Code/Classes/URecord.pas @@ -1,610 +1,610 @@ -unit URecord;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses Classes,
- Math,
- SysUtils,
- UCommon,
- UMusic,
- UIni;
-
-const
- BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
- NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
-
-type
- TCaptureBuffer = class
- private
- BufferNew: TMemoryStream; // buffer for newest samples
-
- function GetToneString: string; // converts a tone to its string represenatation;
- public
- BufferArray: array[0..4095] of smallint; // newest 4096 samples
- BufferLong: TMemoryStream; // full buffer
- AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
-
- AudioFormat: TAudioFormatInfo;
-
- // pitch detection
- ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
- Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
- ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
-
- // methods
- constructor Create;
- destructor Destroy; override;
-
- procedure Clear;
-
- procedure ProcessNewBuffer;
- // use to analyze sound from buffers to get new pitch
- procedure AnalyzeBuffer;
- // we call it to analyze sound by checking Autocorrelation
- procedure AnalyzeByAutocorrelation;
- // use this to check one frequency by Autocorrelation
- function AnalyzeAutocorrelationFreq(Freq: real): real;
- function MaxSampleVolume: Single;
-
- property ToneString: string READ GetToneString;
- end;
-
- TAudioInputDeviceSource = record
- Name: string;
- end;
-
- // soundcard input-devices information
- TAudioInputDevice = class
- public
- CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Description: string; // soundcard name/description
- Source: array of TAudioInputDeviceSource; // soundcard input(-source)s
- SourceSelected: integer; // unused. What is this good for?
- MicSource: integer; // unused. What is this good for?
-
- AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
- CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
-
- destructor Destroy; override;
-
- procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-
- function Start(): boolean; virtual; abstract;
- procedure Stop(); virtual; abstract;
- end;
-
- TAudioInputProcessor = class
- public
- Sound: array of TCaptureBuffer; // sound-buffers for every player
- Device: array of TAudioInputDevice;
-
- constructor Create;
-
- // handle microphone input
- procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal;
- InputDevice: TAudioInputDevice);
- end;
-
- TAudioInputBase = class( TInterfacedObject, IAudioInput )
- private
- Started: boolean;
- protected
- function UnifyDeviceName(const name: string; deviceIndex: integer): string;
- function UnifyDeviceSourceName(const name: string; const deviceName: string): string;
- public
- function GetName: String; virtual; abstract;
- function InitializeRecord: boolean; virtual; abstract;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
-
- SmallIntArray = array [0..maxInt shr 1-1] of smallInt;
- PSmallIntArray = ^SmallIntArray;
-
- function AudioInputProcessor(): TAudioInputProcessor;
-
-implementation
-
-uses
- ULog,
- UMain;
-
-var
- singleton_AudioInputProcessor : TAudioInputProcessor = nil;
-
-
-// FIXME: Race-Conditions between Callback-thread and main-thread
-// on BufferArray (maybe BufferNew also).
-// Use SDL-mutexes to solve this problem.
-
-
-{ Global }
-
-function AudioInputProcessor(): TAudioInputProcessor;
-begin
- if singleton_AudioInputProcessor = nil then
- singleton_AudioInputProcessor := TAudioInputProcessor.create();
-
- result := singleton_AudioInputProcessor;
-end;
-
-
-{ TAudioInputDevice }
-
-destructor TAudioInputDevice.Destroy;
-var
- i: integer;
-begin
- Stop();
- Source := nil;
- CaptureChannel := nil;
- FreeAndNil(AudioFormat);
- inherited Destroy;
-end;
-
-procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-begin
- // check bounds
- if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
- Exit;
-
- // reset audio-format of old capture-buffer
- if (CaptureChannel[ChannelIndex] <> nil) then
- CaptureChannel[ChannelIndex].AudioFormat := nil;
-
- // set audio-format of new capture-buffer
- if (Sound <> nil) then
- Sound.AudioFormat := AudioFormat;
-
- // replace old with new buffer
- CaptureChannel[ChannelIndex] := Sound;
-end;
-
-{ TSound }
-
-constructor TCaptureBuffer.Create;
-begin
- inherited;
- BufferNew := TMemoryStream.Create;
- BufferLong := TMemoryStream.Create;
- AnalysisBufferSize := Min(4*1024, Length(BufferArray));
-end;
-
-destructor TCaptureBuffer.Destroy;
-begin
- AudioFormat := nil;
- FreeAndNil(BufferNew);
- FreeAndNil(BufferLong);
- inherited;
-end;
-
-procedure TCaptureBuffer.Clear;
-begin
- if assigned(BufferNew) then
- BufferNew.Clear;
- if assigned(BufferLong) then
- BufferLong.Clear;
- FillChar(BufferArray[0], Length(BufferArray) * SizeOf(SmallInt), 0);
-end;
-
-procedure TCaptureBuffer.ProcessNewBuffer;
-var
- SkipCount: integer;
- NumSamples: integer;
- SampleIndex: integer;
-begin
- // process BufferArray
- SkipCount := 0;
- NumSamples := BufferNew.Size div 2;
-
- // check if we have more new samples than we can store
- if (NumSamples > Length(BufferArray)) then
- begin
- // discard the oldest of the new samples
- SkipCount := NumSamples - Length(BufferArray);
- NumSamples := Length(BufferArray);
- end;
-
- // move old samples to the beginning of the array (if necessary)
- for SampleIndex := NumSamples to High(BufferArray) do
- BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex];
-
- // skip samples if necessary
- BufferNew.Seek(2*SkipCount, soBeginning);
- // copy samples
- BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples);
-
- // save capture-data to BufferLong if neccessary
- if (Ini.SavePlayback = 1) then
- begin
- BufferNew.Seek(0, soBeginning);
- BufferLong.CopyFrom(BufferNew, BufferNew.Size);
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeBuffer;
-var
- Volume: real;
- MaxVolume: real;
- SampleIndex: integer;
- Threshold: real;
-begin
- ToneValid := false;
- ToneAbs := -1;
- Tone := -1;
-
- // find maximum volume of first 1024 samples
- MaxVolume := 0;
- for SampleIndex := 0 to 1023 do
- begin
- Volume := Abs(BufferArray[SampleIndex]) / -Low(Smallint);
- if Volume > MaxVolume then
- MaxVolume := Volume;
- end;
-
- case Ini.Threshold of
- 0: Threshold := 0.05;
- 1: Threshold := 0.1;
- 2: Threshold := 0.15;
- 3: Threshold := 0.2;
- else Threshold := 0.1;
- end;
-
- // check if signal has an acceptable volume (ignore background-noise)
- if MaxVolume >= Threshold then
- begin
- // analyse the current voice pitch
- AnalyzeByAutocorrelation;
- ToneValid := true;
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeByAutocorrelation;
-var
- ToneIndex: integer;
- CurFreq: real;
- CurWeight: real;
- MaxWeight: real;
- MaxTone: integer;
-const
- HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
-begin
- // prepare to analyze
- MaxWeight := -1;
-
- // analyze halftones
- // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
- // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
- // too few samples -> use a bigger buffer-size
- for ToneIndex := 0 to NumHalftones-1 do
- begin
- CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
- CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
-
- // TODO: prefer higher frequencies (use >= or use downto)
- if (CurWeight > MaxWeight) then
- begin
- // this frequency has a higher weight
- MaxWeight := CurWeight;
- MaxTone := ToneIndex;
- end;
- end;
-
- ToneAbs := MaxTone;
- Tone := MaxTone mod 12;
-end;
-
-// result medium difference
-function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
-var
- Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
- AccumDist: real; // accumulated distances
- SampleIndex: integer; // index of sample to analyze
- CorrelatingSampleIndex: integer; // index of sample one period ahead
- SamplesPerPeriod: integer; // samples in one period
-begin
- SampleIndex := 0;
- SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
- CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
-
- AccumDist := 0;
-
- // compare correlating samples
- while (CorrelatingSampleIndex < AnalysisBufferSize) do
- begin
- // calc distance (correlation: 1-dist) to corresponding sample in next period
- Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) /
- High(Word);
- AccumDist := AccumDist + Dist;
- Inc(SampleIndex);
- Inc(CorrelatingSampleIndex);
- end;
-
- // return "inverse" average distance (=correlation)
- Result := 1 - AccumDist / AnalysisBufferSize;
-end;
-
-function TCaptureBuffer.MaxSampleVolume: Single;
-var
- lSampleIndex: Integer;
- lMaxVol : Longint;
-begin;
- // FIXME: lock buffer to avoid race-conditions
- lMaxVol := 0;
- for lSampleIndex := 0 to High(BufferArray) do
- begin
- if Abs(BufferArray[lSampleIndex]) > lMaxVol then
- lMaxVol := Abs(BufferArray[lSampleIndex]);
- end;
-
- result := lMaxVol / -Low(Smallint);
-end;
-
-const
- ToneStrings: array[0..11] of string = (
- 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
- );
-
-function TCaptureBuffer.GetToneString: string;
-begin
- if (ToneValid) then
- Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
- else
- Result := '-';
-end;
-
-
-{ TAudioInputProcessor }
-
-constructor TAudioInputProcessor.Create;
-var
- i: integer;
-begin
- SetLength(Sound, 6 {max players});//Ini.Players+1);
- for i := 0 to High(Sound) do
- begin
- Sound[i] := TCaptureBuffer.Create;
- end;
-end;
-
-{*
- * Handle captured microphone input data.
- * Params:
- * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
- * Interleaved means that a right-channel sample follows a left-
- * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
- * Length - number of bytes in Buffer
- * Input - Soundcard-Input used for capture
- *}
-procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice);
-var
- Value: integer;
- ChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
- SampleBuffer: PSmallIntArray; // buffer handled as array of samples
- Boost: byte;
- ChannelCount: integer;
- ChannelIndex: integer;
- ChannelOffset: integer;
- CaptureChannel: TCaptureBuffer;
- AudioFormat: TAudioFormatInfo;
- FrameSize: integer;
- NumSamples: integer;
- NumFrames: integer; // number of frames (stereo: 2xsamples)
- i: integer;
-begin
- // set boost
- case Ini.MicBoost of
- 0: Boost := 1;
- 1: Boost := 2;
- 2: Boost := 4;
- 3: Boost := 8;
- else Boost := 1;
- end;
-
- AudioFormat := InputDevice.AudioFormat;
-
- // FIXME: At the moment we assume a SInt16 format
- // TODO: use SDL_AudioConvert to convert to SInt16 but do NOT change the
- // samplerate (SDL does not convert 44.1kHz to 48kHz so we might get wrong
- // results in the analysis phase otherwise)
- if (AudioFormat.Format <> asfS16) then
- begin
- // this only occurs if a developer choosed a wrong input sample-format
- Log.CriticalError('TAudioInputProcessor.HandleMicrophoneData: Wrong sample-format');
- Exit;
- end;
-
- // interpret buffer as buffer of bytes
- SampleBuffer := Buffer;
-
- NumSamples := Size div SizeOf(Smallint);
-
- // boost buffer
- // TODO: remove this senseless stuff - adjust the threshold instead
- for i := 0 to NumSamples-1 do
- begin
- Value := SampleBuffer^[i] * Boost;
-
- // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ??
- if Value > High(Smallint) then
- Value := High(Smallint);
-
- if Value < Low(Smallint) then
- Value := Low(Smallint);
-
- SampleBuffer^[i] := Value;
- end;
-
- // samples per channel
- FrameSize := AudioFormat.Channels * SizeOf(SmallInt);
- NumFrames := Size div FrameSize;
-
- // process channels
- for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
- begin
- CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
- if (CaptureChannel <> nil) then
- begin
- // set offset according to channel index
- ChannelBuffer := @PChar(Buffer)[ChannelIndex * SizeOf(SmallInt)];
-
- // TODO: remove BufferNew and write to BufferArray directly
-
- CaptureChannel.BufferNew.Clear;
- for i := 0 to NumFrames-1 do
- begin
- CaptureChannel.BufferNew.Write(ChannelBuffer[i*FrameSize], SizeOf(SmallInt));
- end;
- CaptureChannel.ProcessNewBuffer();
- end;
- end;
-end;
-
-
-{ TAudioInputBase }
-
-{*
- * Start capturing on all used input-device.
- *}
-procedure TAudioInputBase.CaptureStart;
-var
- S: integer;
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
- DeviceUsed: boolean;
- Player: integer;
-begin
- if (Started) then
- CaptureStop();
-
- // reset buffers
- for S := 0 to High(AudioInputProcessor.Sound) do
- AudioInputProcessor.Sound[S].Clear;
-
- // start capturing on each used device
- for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
- begin
- Device := AudioInputProcessor.Device[DeviceIndex];
- if not assigned(Device) then
- continue;
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
-
- DeviceUsed := false;
-
- // check if device is used
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
- if (Player < 0) or (Player >= PlayersPlay) then
- begin
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end
- else
- begin
- Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
- DeviceUsed := true;
- end;
- end;
-
- // start device if used
- if (DeviceUsed) then
- begin
- //Log.BenchmarkStart(2);
- Device.Start();
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('Device.Start', 2) ;
- end;
- end;
-
- Started := true;
-end;
-
-{*
- * Stop input-capturing on all soundcards.
- *}
-procedure TAudioInputBase.CaptureStop;
-var
- DeviceIndex: integer;
- Player: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
-begin
- for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
- begin
- Device := AudioInputProcessor.Device[DeviceIndex];
- if not assigned(Device) then
- continue;
- Device.Stop();
- end;
-
- Started := false;
-end;
-
-function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
-var
- count: integer; // count of devices with this name
-
- function IsDuplicate(const name: string): boolean;
- var
- i: integer;
- begin
- Result := False;
- // search devices with same description
- For i := 0 to deviceIndex-1 do
- begin
- if (AudioInputProcessor.Device[i].Description = name) then
- begin
- Result := True;
- Break;
- end;
- end;
- end;
-begin
- count := 1;
- result := name;
-
- // if there is another device with the same ID, search for an available name
- while (IsDuplicate(result)) do
- begin
- Inc(count);
- // set description
- result := name + ' ('+IntToStr(count)+')';
- end;
-end;
-
-{*
- * Unifies an input-device's source name.
- * Note: the description member of the device must already be set when
- * calling this function.
- *}
-function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string;
-var
- Descr: string;
-begin
- result := name;
-
- {$IFDEF DARWIN}
- // Under MacOSX the SingStar Mics have an empty
- // InputName. So, we have to add a hard coded
- // Workaround for this problem
- if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then
- begin
- result := 'Microphone';
- end;
- {$ENDIF}
-end;
-
-end.
-
-
-
+unit URecord; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, + Math, + SysUtils, + UCommon, + UMusic, + UIni; + +const + BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) + NumHalftones = 36; // C2-B4 (for Whitney and my high voice) + +type + TCaptureBuffer = class + private + BufferNew: TMemoryStream; // buffer for newest samples + + function GetToneString: string; // converts a tone to its string represenatation; + public + BufferArray: array[0..4095] of smallint; // newest 4096 samples + BufferLong: TMemoryStream; // full buffer + AnalysisBufferSize: integer; // number of samples of BufferArray to analyze + + AudioFormat: TAudioFormatInfo; + + // pitch detection + ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise) + Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11 + ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1 + + // methods + constructor Create; + destructor Destroy; override; + + procedure Clear; + + procedure ProcessNewBuffer; + // use to analyze sound from buffers to get new pitch + procedure AnalyzeBuffer; + // we call it to analyze sound by checking Autocorrelation + procedure AnalyzeByAutocorrelation; + // use this to check one frequency by Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; + function MaxSampleVolume: Single; + + property ToneString: string READ GetToneString; + end; + + TAudioInputDeviceSource = record + Name: string; + end; + + // soundcard input-devices information + TAudioInputDevice = class + public + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Description: string; // soundcard name/description + Source: array of TAudioInputDeviceSource; // soundcard input(-source)s + SourceSelected: integer; // unused. What is this good for? + MicSource: integer; // unused. What is this good for? + + AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo) + CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data + + destructor Destroy; override; + + procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); + + function Start(): boolean; virtual; abstract; + procedure Stop(); virtual; abstract; + end; + + TAudioInputProcessor = class + public + Sound: array of TCaptureBuffer; // sound-buffers for every player + Device: array of TAudioInputDevice; + + constructor Create; + + // handle microphone input + procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; + InputDevice: TAudioInputDevice); + end; + + TAudioInputBase = class( TInterfacedObject, IAudioInput ) + private + Started: boolean; + protected + function UnifyDeviceName(const name: string; deviceIndex: integer): string; + function UnifyDeviceSourceName(const name: string; const deviceName: string): string; + public + function GetName: String; virtual; abstract; + function InitializeRecord: boolean; virtual; abstract; + + procedure CaptureStart; + procedure CaptureStop; + end; + + + SmallIntArray = array [0..maxInt shr 1-1] of smallInt; + PSmallIntArray = ^SmallIntArray; + + function AudioInputProcessor(): TAudioInputProcessor; + +implementation + +uses + ULog, + UMain; + +var + singleton_AudioInputProcessor : TAudioInputProcessor = nil; + + +// FIXME: Race-Conditions between Callback-thread and main-thread +// on BufferArray (maybe BufferNew also). +// Use SDL-mutexes to solve this problem. + + +{ Global } + +function AudioInputProcessor(): TAudioInputProcessor; +begin + if singleton_AudioInputProcessor = nil then + singleton_AudioInputProcessor := TAudioInputProcessor.create(); + + result := singleton_AudioInputProcessor; +end; + + +{ TAudioInputDevice } + +destructor TAudioInputDevice.Destroy; +//var +// i: integer; // Auto Removed, Unused Variable +begin + Stop(); + Source := nil; + CaptureChannel := nil; + FreeAndNil(AudioFormat); + inherited Destroy; +end; + +procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); +begin + // check bounds + if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then + Exit; + + // reset audio-format of old capture-buffer + if (CaptureChannel[ChannelIndex] <> nil) then + CaptureChannel[ChannelIndex].AudioFormat := nil; + + // set audio-format of new capture-buffer + if (Sound <> nil) then + Sound.AudioFormat := AudioFormat; + + // replace old with new buffer + CaptureChannel[ChannelIndex] := Sound; +end; + +{ TSound } + +constructor TCaptureBuffer.Create; +begin + inherited; + BufferNew := TMemoryStream.Create; + BufferLong := TMemoryStream.Create; + AnalysisBufferSize := Min(4*1024, Length(BufferArray)); +end; + +destructor TCaptureBuffer.Destroy; +begin + AudioFormat := nil; + FreeAndNil(BufferNew); + FreeAndNil(BufferLong); + inherited; +end; + +procedure TCaptureBuffer.Clear; +begin + if assigned(BufferNew) then + BufferNew.Clear; + if assigned(BufferLong) then + BufferLong.Clear; + FillChar(BufferArray[0], Length(BufferArray) * SizeOf(SmallInt), 0); +end; + +procedure TCaptureBuffer.ProcessNewBuffer; +var + SkipCount: integer; + NumSamples: integer; + SampleIndex: integer; +begin + // process BufferArray + SkipCount := 0; + NumSamples := BufferNew.Size div 2; + + // check if we have more new samples than we can store + if (NumSamples > Length(BufferArray)) then + begin + // discard the oldest of the new samples + SkipCount := NumSamples - Length(BufferArray); + NumSamples := Length(BufferArray); + end; + + // move old samples to the beginning of the array (if necessary) + for SampleIndex := NumSamples to High(BufferArray) do + BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex]; + + // skip samples if necessary + BufferNew.Seek(2*SkipCount, soBeginning); + // copy samples + BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples); + + // save capture-data to BufferLong if neccessary + if (Ini.SavePlayback = 1) then + begin + BufferNew.Seek(0, soBeginning); + BufferLong.CopyFrom(BufferNew, BufferNew.Size); + end; +end; + +procedure TCaptureBuffer.AnalyzeBuffer; +var + Volume: real; + MaxVolume: real; + SampleIndex: integer; + Threshold: real; +begin + ToneValid := false; + ToneAbs := -1; + Tone := -1; + + // find maximum volume of first 1024 samples + MaxVolume := 0; + for SampleIndex := 0 to 1023 do + begin + Volume := Abs(BufferArray[SampleIndex]) / -Low(Smallint); + if Volume > MaxVolume then + MaxVolume := Volume; + end; + + case Ini.Threshold of + 0: Threshold := 0.05; + 1: Threshold := 0.1; + 2: Threshold := 0.15; + 3: Threshold := 0.2; + else Threshold := 0.1; + end; + + // check if signal has an acceptable volume (ignore background-noise) + if MaxVolume >= Threshold then + begin + // analyse the current voice pitch + AnalyzeByAutocorrelation; + ToneValid := true; + end; +end; + +procedure TCaptureBuffer.AnalyzeByAutocorrelation; +var + ToneIndex: integer; + CurFreq: real; + CurWeight: real; + MaxWeight: real; + MaxTone: integer; +const + HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave) +begin + // prepare to analyze + MaxWeight := -1; + + // analyze halftones + // Note: at the lowest tone (~65Hz) and a buffer-size of 4096 + // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be + // too few samples -> use a bigger buffer-size + for ToneIndex := 0 to NumHalftones-1 do + begin + CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex); + CurWeight := AnalyzeAutocorrelationFreq(CurFreq); + + // TODO: prefer higher frequencies (use >= or use downto) + if (CurWeight > MaxWeight) then + begin + // this frequency has a higher weight + MaxWeight := CurWeight; + MaxTone := ToneIndex; + end; + end; + + ToneAbs := MaxTone; + Tone := MaxTone mod 12; +end; + +// result medium difference +function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real; +var + Dist: real; // distance (0=equal .. 1=totally different) between correlated samples + AccumDist: real; // accumulated distances + SampleIndex: integer; // index of sample to analyze + CorrelatingSampleIndex: integer; // index of sample one period ahead + SamplesPerPeriod: integer; // samples in one period +begin + SampleIndex := 0; + SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq); + CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod; + + AccumDist := 0; + + // compare correlating samples + while (CorrelatingSampleIndex < AnalysisBufferSize) do + begin + // calc distance (correlation: 1-dist) to corresponding sample in next period + Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) / + High(Word); + AccumDist := AccumDist + Dist; + Inc(SampleIndex); + Inc(CorrelatingSampleIndex); + end; + + // return "inverse" average distance (=correlation) + Result := 1 - AccumDist / AnalysisBufferSize; +end; + +function TCaptureBuffer.MaxSampleVolume: Single; +var + lSampleIndex: Integer; + lMaxVol : Longint; +begin; + // FIXME: lock buffer to avoid race-conditions + lMaxVol := 0; + for lSampleIndex := 0 to High(BufferArray) do + begin + if Abs(BufferArray[lSampleIndex]) > lMaxVol then + lMaxVol := Abs(BufferArray[lSampleIndex]); + end; + + result := lMaxVol / -Low(Smallint); +end; + +const + ToneStrings: array[0..11] of string = ( + 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B' + ); + +function TCaptureBuffer.GetToneString: string; +begin + if (ToneValid) then + Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2) + else + Result := '-'; +end; + + +{ TAudioInputProcessor } + +constructor TAudioInputProcessor.Create; +var + i: integer; +begin + SetLength(Sound, 6 {max players});//Ini.Players+1); + for i := 0 to High(Sound) do + begin + Sound[i] := TCaptureBuffer.Create; + end; +end; + +{* + * Handle captured microphone input data. + * Params: + * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. + * Interleaved means that a right-channel sample follows a left- + * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). + * Length - number of bytes in Buffer + * Input - Soundcard-Input used for capture + *} +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice); +var + Value: integer; + ChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) + SampleBuffer: PSmallIntArray; // buffer handled as array of samples + Boost: byte; +// ChannelCount: integer; // Auto Removed, Unused Variable + ChannelIndex: integer; +// ChannelOffset: integer; // Auto Removed, Unused Variable + CaptureChannel: TCaptureBuffer; + AudioFormat: TAudioFormatInfo; + FrameSize: integer; + NumSamples: integer; + NumFrames: integer; // number of frames (stereo: 2xsamples) + i: integer; +begin + // set boost + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + else Boost := 1; + end; + + AudioFormat := InputDevice.AudioFormat; + + // FIXME: At the moment we assume a SInt16 format + // TODO: use SDL_AudioConvert to convert to SInt16 but do NOT change the + // samplerate (SDL does not convert 44.1kHz to 48kHz so we might get wrong + // results in the analysis phase otherwise) + if (AudioFormat.Format <> asfS16) then + begin + // this only occurs if a developer choosed a wrong input sample-format + Log.CriticalError('TAudioInputProcessor.HandleMicrophoneData: Wrong sample-format'); + Exit; + end; + + // interpret buffer as buffer of bytes + SampleBuffer := Buffer; + + NumSamples := Size div SizeOf(Smallint); + + // boost buffer + // TODO: remove this senseless stuff - adjust the threshold instead + for i := 0 to NumSamples-1 do + begin + Value := SampleBuffer^[i] * Boost; + + // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ?? + if Value > High(Smallint) then + Value := High(Smallint); + + if Value < Low(Smallint) then + Value := Low(Smallint); + + SampleBuffer^[i] := Value; + end; + + // samples per channel + FrameSize := AudioFormat.Channels * SizeOf(SmallInt); + NumFrames := Size div FrameSize; + + // process channels + for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do + begin + CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; + if (CaptureChannel <> nil) then + begin + // set offset according to channel index + ChannelBuffer := @PChar(Buffer)[ChannelIndex * SizeOf(SmallInt)]; + + // TODO: remove BufferNew and write to BufferArray directly + + CaptureChannel.BufferNew.Clear; + for i := 0 to NumFrames-1 do + begin + CaptureChannel.BufferNew.Write(ChannelBuffer[i*FrameSize], SizeOf(SmallInt)); + end; + CaptureChannel.ProcessNewBuffer(); + end; + end; +end; + + +{ TAudioInputBase } + +{* + * Start capturing on all used input-device. + *} +procedure TAudioInputBase.CaptureStart; +var + S: integer; + DeviceIndex: integer; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + DeviceUsed: boolean; + Player: integer; +begin + if (Started) then + CaptureStop(); + + // reset buffers + for S := 0 to High(AudioInputProcessor.Sound) do + AudioInputProcessor.Sound[S].Clear; + + // start capturing on each used device + for DeviceIndex := 0 to High(AudioInputProcessor.Device) do + begin + Device := AudioInputProcessor.Device[DeviceIndex]; + if not assigned(Device) then + continue; + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + + DeviceUsed := false; + + // check if device is used + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; + if (Player < 0) or (Player >= PlayersPlay) then + begin + Device.LinkCaptureBuffer(ChannelIndex, nil); + end + else + begin + Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]); + DeviceUsed := true; + end; + end; + + // start device if used + if (DeviceUsed) then + begin + //Log.BenchmarkStart(2); + Device.Start(); + //Log.BenchmarkEnd(2); + //Log.LogBenchmark('Device.Start', 2) ; + end; + end; + + Started := true; +end; + +{* + * Stop input-capturing on all soundcards. + *} +procedure TAudioInputBase.CaptureStop; +var + DeviceIndex: integer; +// Player: integer; // Auto Removed, Unused Variable + Device: TAudioInputDevice; +// DeviceCfg: PInputDeviceConfig; // Auto Removed, Unused Variable +begin + for DeviceIndex := 0 to High(AudioInputProcessor.Device) do + begin + Device := AudioInputProcessor.Device[DeviceIndex]; + if not assigned(Device) then + continue; + Device.Stop(); + end; + + Started := false; +end; + +function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; +var + count: integer; // count of devices with this name + + function IsDuplicate(const name: string): boolean; + var + i: integer; + begin + Result := False; + // search devices with same description + For i := 0 to deviceIndex-1 do + begin + if (AudioInputProcessor.Device[i].Description = name) then + begin + Result := True; + Break; + end; + end; + end; +begin + count := 1; + result := name; + + // if there is another device with the same ID, search for an available name + while (IsDuplicate(result)) do + begin + Inc(count); + // set description + result := name + ' ('+IntToStr(count)+')'; + end; +end; + +{* + * Unifies an input-device's source name. + * Note: the description member of the device must already be set when + * calling this function. + *} +function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string; +//var +// Descr: string; // Auto Removed, Unused Variable +begin + result := name; + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty + // InputName. So, we have to add a hard coded + // Workaround for this problem + if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then + begin + result := 'Microphone'; + end; + {$ENDIF} +end; + +end. + + + diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas index 940f2779..427cba2e 100644 --- a/Game/Code/Classes/USong.pas +++ b/Game/Code/Classes/USong.pas @@ -1,720 +1,720 @@ -unit USong;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- SysUtils,
- Classes,
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- UCatCovers;
-
-type
-
- TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: widestring;
- Score: integer;
- Length: string;
- end;
-
- TSong = class
- FileLineNo : integer; //Line which is readed at Last, for error reporting
-
- procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
- procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
-
- function ReadTXTHeader( const aFileName : WideString ): boolean;
- public
- Path: widestring;
- Folder: widestring; // for sorting by folder
- fFileName,
- FileName: widestring;
-
- // sorting methods
- Category: array of widestring; // I think I won't need this
- Genre: widestring;
- Edition: widestring;
- Language: widestring; // 0.5.0: new
-
- Title: widestring;
- Artist: widestring;
-
- Text: widestring;
- Creator: widestring;
-
- Cover: widestring;
- CoverTex: TTexture;
- Mp3: widestring;
- Background: widestring;
- Video: widestring;
- VideoGAP: real;
- VideoLoaded: boolean; // 0.5.0: true if the video has been loaded
- NotesGAP: integer;
- Start: real; // in seconds
- Finish: integer; // in miliseconds
- Relative: boolean;
- Resolution: integer;
- BPM: array of TBPM;
- GAP: real; // in miliseconds
-
- Score: array[0..2] of array of TScore;
-
- // these are used when sorting is enabled
- Visible: boolean; // false if hidden, true if visible
- Main: boolean; // false for songs, true for category buttons
- OrderNum: integer; // has a number of category for category buttons and songs
- OrderTyp: integer; // type of sorting for this button (0=name)
- CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
-
- SongFile: TextFile; // all procedures in this unit operates on this file
-
- Base : array[0..1] of integer;
- Rel : array[0..1] of integer;
- Mult : integer;
- MultBPM : integer;
-
- constructor create ( const aFileName : WideString );
- function LoadSong: boolean;
- function Analyse(): boolean;
- procedure clear();
- end;
-
-implementation
-
-uses
- TextGL,
- UIni,
- UMusic, //needed for Lines
- UMain; //needed for Player
-
-constructor TSong.create( const aFileName : WideString );
-begin
-
- Mult := 1;
-
- MultBPM := 4;
-
-
- fFileName := aFileName;
-
-
- if fileexists( aFileName ) then
-
- begin
-
- self.Path := ExtractFilePath( aFileName );
- self.Folder := ExtractFilePath( aFileName );
- self.FileName := ExtractFileName( aFileName );
-
-(*
-
- if ReadTXTHeader( aFileName ) then
-
- begin
-
- LoadSong();
-
- end
- else
- begin
- Log.LogError('Error Loading SongHeader, abort Song Loading');
- Exit;
- end;
-*)
- end;
-
-end;
-
-
-function TSong.LoadSong(): boolean;
-
-var
- TempC: char;
- Text: string;
- CP: integer; // Current Player (0 or 1)
- Count: integer;
- Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I: Integer;
-begin
- Result := false;
-
- if not FileExists(Path + PathDelim + FileName) then
- begin
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
- exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
- Lines[0].NoteType := 0;
- self.Relative := false;
- Rel[0] := 0;
- CP := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- try
- // Open song file for reading.....
- FileMode := fmOpenRead;
- AssignFile(SongFile, fFileName);
- Reset(SongFile);
-
- //Clear old Song Header
- if (self.Path = '') then
- self.Path := ExtractFilePath(FileName);
-
- if (self.FileName = '') then
- self.Filename := ExtractFileName(FileName);
-
- Result := False;
-
- Reset(SongFile);
- FileLineNo := 0;
- //Search for Note Begining
- repeat
- ReadLn(SongFile, Text);
- Inc(FileLineNo);
-
- if (EoF(SongFile)) then
- begin //Song File Corrupted - No Notes
- CloseFile(SongFile);
- Log.LogError('Could not load txt File, no Notes found: ' + FileName);
- Result := False;
- Exit;
- end;
- Read(SongFile, TempC);
- until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
-
- SetLength(Lines, 2);
- for Count := 0 to High(Lines) do begin
- SetLength(Lines[Count].Line, 1);
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].Line[0].IlNut := 0;
- Lines[Count].Line[0].HighNote := -1;
- end;
-
- // TempC := ':';
- // TempC := Text[1]; // read from backup variable, don't use default ':' value
-
- while (TempC <> 'E') AND (not EOF(SongFile)) do
- begin
-
- if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin
- // read notes
- Read(SongFile, Param1);
- Read(SongFile, Param2);
- Read(SongFile, Param3);
- Read(SongFile, ParamS);
-
- //Check for ZeroNote
- if Param2 = 0 then Log.LogError('Error: Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+' '+ParamS+'" -> Note ignored!') else
- begin
- // add notes
- if not Both then
- // P1
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else begin
- // P1 + P2
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
- ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
- end;
- end; //Zeronote check
- end; // if
-
- if TempC = '-' then
- begin
- // reads sentence
- Read(SongFile, Param1);
- if self.Relative then Read(SongFile, Param2); // read one more data for relative system
-
- // new sentence
- if not Both then
- // P1
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
- else begin
- // P1 + P2
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
- NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
- end;
- end; // if
-
- if TempC = 'B' then
- begin
- SetLength(self.BPM, Length(self.BPM) + 1);
- Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
- self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
-
- Read(SongFile, Text);
- self.BPM[High(self.BPM)].BPM := StrToFloat(Text);
- self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
- end;
-
-
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Lenght * Lines[CP].Line[Lines[CP].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
- end else begin
- for Count := 0 to High(Lines) do begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Lenght * Lines[Count].Line[Lines[Count].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
- end;
- end;
- Read(SongFile, TempC);
- Inc(FileLineNo);
- end; // while}
-
- CloseFile(SongFile);
- except
- try
- CloseFile(SongFile);
- except
-
- end;
-
- Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
- exit;
- end;
-
- Result := true;
-end;
-
-
-function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
-
- function song_StrtoFloat( aValue : String ) : Extended;
- var
- lValue : String;
- lOldDecimalSeparator : Char;
- begin
- lValue := aValue;
-
- if (Pos(',', lValue) <> 0) then
- lValue[Pos(',', lValue)] := '.';
-
- Result := StrToFloatDef(lValue, 0);
- end;
-
-var
- Line, Identifier, Value: String;
- Temp : word;
- Done : byte;
-begin
- Result := true;
- Done := 0;
-
- //Read first Line
- ReadLn (SongFile, Line);
-
- if (Length(Line)<=0) then
- begin
- Log.LogError('File Starts with Empty Line: ' + aFileName);
- Result := False;
- Exit;
- end;
-
- //Read Lines while Line starts with # or its empty
- While ( Length(Line) = 0 ) OR
- ( Line[1] = '#' ) DO
- begin
- //Increase Line Number
- Inc (FileLineNo);
- Temp := Pos(':', Line);
-
- //Line has a Seperator-> Headerline
- if (Temp <> 0) then
- begin
- //Read Identifier and Value
- Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks
- Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp));
-
- //Check the Identifier (If Value is given)
- if (Length(Value) <> 0) then
- begin
-
- //-----------
- //Required Attributes
- //-----------
-
- {$IFDEF UTF8_FILENAMES}
- if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
- Value := Utf8Encode(Value);
- {$ENDIF}
-
- //Title
- if (Identifier = 'TITLE') then
- begin
- self.Title := Value;
-
- //Add Title Flag to Done
- Done := Done or 1;
- end
-
- //Artist
- else if (Identifier = 'ARTIST') then
- begin
- self.Artist := Value;
-
- //Add Artist Flag to Done
- Done := Done or 2;
- end
-
- //MP3 File //Test if Exists
- else if (Identifier = 'MP3') AND
- (FileExists(self.Path + Value)) then
- begin
- self.Mp3 := Value;
-
- //Add Mp3 Flag to Done
- Done := Done or 4;
- end
-
- //Beats per Minute
- else if (Identifier = 'BPM') then
- begin
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
-
- if self.BPM[0].BPM <> 0 then
- begin
- //Add BPM Flag to Done
- Done := Done or 8;
- end;
- end
-
- //---------
- //Additional Header Information
- //---------
-
- // Video Gap
- else if (Identifier = 'GAP') then
- self.GAP := song_StrtoFloat( Value )
-
- //Cover Picture
- else if (Identifier = 'COVER') then
- self.Cover := Value
-
- //Background Picture
- else if (Identifier = 'BACKGROUND') then
- self.Background := Value
-
- // Video File
- else if (Identifier = 'VIDEO') then
- begin
- if (FileExists(self.Path + Value)) then
- self.Video := Value
- else
- Log.LogError('Can''t find Video File in Song: ' + aFileName);
- end
-
- // Video Gap
- else if (Identifier = 'VIDEOGAP') then
- self.VideoGAP := song_StrtoFloat( Value )
-
- //Genre Sorting
- else if (Identifier = 'GENRE') then
- self.Genre := Value
-
- //Edition Sorting
- else if (Identifier = 'EDITION') then
- self.Edition := Value
-
- //Creator Tag
- else if (Identifier = 'CREATOR') then
- self.Creator := Value
-
- //Language Sorting
- else if (Identifier = 'LANGUAGE') then
- self.Language := Value
-
- // Song Start
- else if (Identifier = 'START') then
- self.Start := song_StrtoFloat( Value )
-
- // Song Ending
- else if (Identifier = 'END') then
- TryStrtoInt(Value, self.Finish)
-
- // Resolution
- else if (Identifier = 'RESOLUTION') then
- TryStrtoInt(Value, self.Resolution)
-
- // Notes Gap
- else if (Identifier = 'NOTESGAP') then
- TryStrtoInt(Value, self.NotesGAP)
- // Relative Notes
- else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then
- self.Relative := True;
-
- end;
- end;
-
- if not EOf(SongFile) then
- ReadLn (SongFile, Line)
- else
- begin
- Result := False;
- Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
- break;
- end;
-
- end;
-
- if self.Cover = '' then
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := False;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM Tag Missing: ' + self.FileName)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
- else //unknown Error
- Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
- end;
-
-end;
-
-procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
-var
- Space: boolean;
-begin
- case Ini.Solmization of
- 1: // european
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' si ';
- end;
- end;
- 2: // japanese
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' so ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' shi ';
- end;
- end;
- 3: // american
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' ti ';
- end;
- end;
- end; // case
-
- with Lines[LineNumber].Line[Lines[LineNumber].High] do begin
- SetLength(Note, Length(Note) + 1);
- IlNut := IlNut + 1;
- HighNote := HighNote + 1;
- Melody.IlNut := Melody.IlNut + 1;
-
- Note[HighNote].Start := StartP;
- if IlNut = 1 then begin
- StartNote := Note[HighNote].Start;
- if Lines[LineNumber].Number = 1 then
- Start := -100;
-// Start := Note[HighNote].Start;
- end;
-
- Note[HighNote].Lenght := DurationP;
- Melody.NoteLenght := Melody.NoteLenght + Note[HighNote].Lenght;
-
- // back to the normal system with normal, golden and now freestyle notes
- case TypeP of
- 'F': Note[HighNote].NoteType := 0;
- ':': Note[HighNote].NoteType := 1;
- '*': Note[HighNote].NoteType := 2;
- end;
-
- Lines[LineNumber].NoteType := Lines[LineNumber].NoteType + Note[HighNote].Lenght * Note[HighNote].NoteType;
-
- Note[HighNote].Tone := NoteP;
- if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
- Note[HighNote].ToneGamus := Note[HighNote].ToneGamus mod 12;
-
- Note[HighNote].Text := Copy(LyricS, 2, 100);
- Lyric := Lyric + Note[HighNote].Text;
-
- if TypeP = 'F' then
- Note[HighNote].FreeStyle := true;
-
- End_ := Note[HighNote].Start + Note[HighNote].Lenght;
- end; // with
-end;
-
-procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
-var
-I: Integer;
-begin
-
- // stara czesc //Alter Satz //Update Old Part
- Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric));
-
- //Total Notes Patch
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
- for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Lenght * Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
-
-
- // nowa czesc //Neuer Satz //Update New Part
- SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
- Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
- Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
- Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
-
- if self.Relative then
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
- Rel[LineNumberP] := Rel[LineNumberP] + Param2;
- end
- else
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
-
- Base[LineNumberP] := 100; // high number
-end;
-
-procedure TSong.clear();
-begin
- //Main Information
- Title := '';
- Artist := '';
-
- //Sortings:
- Genre := 'Unknown';
- Edition := 'Unknown';
- Language := 'Unknown'; //Language Patch
-
- //Required Information
- Mp3 := '';
- {$IFDEF FPC}
- setlength( BPM, 0 );
- {$ELSE}
- BPM := nil;
- {$ENDIF}
-
- GAP := 0;
- Start := 0;
- Finish := 0;
-
- //Additional Information
- Background := '';
- Cover := '';
- Video := '';
- VideoGAP := 0;
- NotesGAP := 0;
- Resolution := 4;
- Creator := '';
-
-end;
-
-function TSong.Analyse(): boolean;
-begin
- Result := False;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Open File and set File Pointer to the beginning
- AssignFile(SongFile, self.Path + self.FileName);
-
- try
- Reset(SongFile);
-
- //Clear old Song Header
- self.clear;
-
- //Read Header
- Result := self.ReadTxTHeader( FileName )
-
- //And Close File
- finally
- CloseFile(SongFile);
- end;
-end;
-
-
-
-end.
+unit USong; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + {$IFDEF MSWINDOWS} + Windows, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + UCatCovers; + +type + + TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + TSong = class + FileLineNo : integer; //Line which is readed at Last, for error reporting + + procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); + + function ReadTXTHeader( const aFileName : WideString ): boolean; + public + Path: widestring; + Folder: widestring; // for sorting by folder + fFileName, + FileName: widestring; + + // sorting methods + Category: array of widestring; // I think I won't need this + Genre: widestring; + Edition: widestring; + Language: widestring; // 0.5.0: new + + Title: widestring; + Artist: widestring; + + Text: widestring; + Creator: widestring; + + Cover: widestring; + CoverTex: TTexture; + Mp3: widestring; + Background: widestring; + Video: widestring; + VideoGAP: real; + VideoLoaded: boolean; // 0.5.0: true if the video has been loaded + NotesGAP: integer; + Start: real; // in seconds + Finish: integer; // in miliseconds + Relative: boolean; + Resolution: integer; + BPM: array of TBPM; + GAP: real; // in miliseconds + + Score: array[0..2] of array of TScore; + + // these are used when sorting is enabled + Visible: boolean; // false if hidden, true if visible + Main: boolean; // false for songs, true for category buttons + OrderNum: integer; // has a number of category for category buttons and songs + OrderTyp: integer; // type of sorting for this button (0=name) + CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs + + SongFile: TextFile; // all procedures in this unit operates on this file + + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer; + MultBPM : integer; + + constructor create ( const aFileName : WideString ); + function LoadSong: boolean; + function Analyse(): boolean; + procedure clear(); + end; + +implementation + +uses + TextGL, + UIni, + UMusic, //needed for Lines + UMain; //needed for Player + +constructor TSong.create( const aFileName : WideString ); +begin + + Mult := 1; + + MultBPM := 4; + + + fFileName := aFileName; + + + if fileexists( aFileName ) then + + begin + + self.Path := ExtractFilePath( aFileName ); + self.Folder := ExtractFilePath( aFileName ); + self.FileName := ExtractFileName( aFileName ); + +(* + + if ReadTXTHeader( aFileName ) then + + begin + + LoadSong(); + + end + else + begin + Log.LogError('Error Loading SongHeader, abort Song Loading'); + Exit; + end; +*) + end; + +end; + + +function TSong.LoadSong(): boolean; + +var + TempC: char; + Text: string; + CP: integer; // Current Player (0 or 1) + Count: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I: Integer; +begin + Result := false; + + if not FileExists(Path + PathDelim + FileName) then + begin + Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); + exit; + end; + + MultBPM := 4; // multiply beat-count of note by 4 + Mult := 1; // accuracy of measurement of note + Base[0] := 100; // high number + Lines[0].NoteType := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + try + // Open song file for reading..... + FileMode := fmOpenRead; + AssignFile(SongFile, fFileName); + Reset(SongFile); + + //Clear old Song Header + if (self.Path = '') then + self.Path := ExtractFilePath(FileName); + + if (self.FileName = '') then + self.Filename := ExtractFileName(FileName); + + Result := False; + + Reset(SongFile); + FileLineNo := 0; + //Search for Note Begining + repeat + ReadLn(SongFile, Text); + Inc(FileLineNo); + + if (EoF(SongFile)) then + begin //Song File Corrupted - No Notes + CloseFile(SongFile); + Log.LogError('Could not load txt File, no Notes found: ' + FileName); + Result := False; + Exit; + end; + Read(SongFile, TempC); + until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); + + SetLength(Lines, 2); + for Count := 0 to High(Lines) do begin + SetLength(Lines[Count].Line, 1); + Lines[Count].High := 0; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].Line[0].IlNut := 0; + Lines[Count].Line[0].HighNote := -1; + end; + + // TempC := ':'; + // TempC := Text[1]; // read from backup variable, don't use default ':' value + + while (TempC <> 'E') AND (not EOF(SongFile)) do + begin + + if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin + // read notes + Read(SongFile, Param1); + Read(SongFile, Param2); + Read(SongFile, Param3); + Read(SongFile, ParamS); + + //Check for ZeroNote + if Param2 = 0 then Log.LogError('Error: Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+' '+ParamS+'" -> Note ignored!') else + begin + // add notes + if not Both then + // P1 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else begin + // P1 + P2 + ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + end; + end; //Zeronote check + end; // if + + if TempC = '-' then + begin + // reads sentence + Read(SongFile, Param1); + if self.Relative then Read(SongFile, Param2); // read one more data for relative system + + // new sentence + if not Both then + // P1 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2) + else begin + // P1 + P2 + NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); + NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); + end; + end; // if + + if TempC = 'B' then + begin + SetLength(self.BPM, Length(self.BPM) + 1); + Read(SongFile, self.BPM[High(self.BPM)].StartBeat); + self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; + + Read(SongFile, Text); + self.BPM[High(self.BPM)].BPM := StrToFloat(Text); + self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; + end; + + + if not Both then + begin + Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; + Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric)); + //Total Notes Patch + Lines[CP].Line[Lines[CP].High].TotalNotes := 0; + for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do + begin + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Lenght * Lines[CP].Line[Lines[CP].High].Note[I].NoteType; + end; + //Total Notes Patch End + end else begin + for Count := 0 to High(Lines) do begin + Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; + Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric)); + //Total Notes Patch + Lines[Count].Line[Lines[Count].High].TotalNotes := 0; + for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do + begin + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Lenght * Lines[Count].Line[Lines[Count].High].Note[I].NoteType; + end; + //Total Notes Patch End + end; + end; + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + + +function TSong.ReadTXTHeader(const aFileName : WideString): boolean; + + function song_StrtoFloat( aValue : String ) : Extended; + var + lValue : String; +// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable + begin + lValue := aValue; + + if (Pos(',', lValue) <> 0) then + lValue[Pos(',', lValue)] := '.'; + + Result := StrToFloatDef(lValue, 0); + end; + +var + Line, Identifier, Value: String; + Temp : word; + Done : byte; +begin + Result := true; + Done := 0; + + //Read first Line + ReadLn (SongFile, Line); + + if (Length(Line)<=0) then + begin + Log.LogError('File Starts with Empty Line: ' + aFileName); + Result := False; + Exit; + end; + + //Read Lines while Line starts with # or its empty + While ( Length(Line) = 0 ) OR + ( Line[1] = '#' ) DO + begin + //Increase Line Number + Inc (FileLineNo); + Temp := Pos(':', Line); + + //Line has a Seperator-> Headerline + if (Temp <> 0) then + begin + //Read Identifier and Value + Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp)); + + //Check the Identifier (If Value is given) + if (Length(Value) <> 0) then + begin + + //----------- + //Required Attributes + //----------- + + {$IFDEF UTF8_FILENAMES} + if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then + Value := Utf8Encode(Value); + {$ENDIF} + + //Title + if (Identifier = 'TITLE') then + begin + self.Title := Value; + + //Add Title Flag to Done + Done := Done or 1; + end + + //Artist + else if (Identifier = 'ARTIST') then + begin + self.Artist := Value; + + //Add Artist Flag to Done + Done := Done or 2; + end + + //MP3 File //Test if Exists + else if (Identifier = 'MP3') AND + (FileExists(self.Path + Value)) then + begin + self.Mp3 := Value; + + //Add Mp3 Flag to Done + Done := Done or 4; + end + + //Beats per Minute + else if (Identifier = 'BPM') then + begin + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end + + //--------- + //Additional Header Information + //--------- + + // Video Gap + else if (Identifier = 'GAP') then + self.GAP := song_StrtoFloat( Value ) + + //Cover Picture + else if (Identifier = 'COVER') then + self.Cover := Value + + //Background Picture + else if (Identifier = 'BACKGROUND') then + self.Background := Value + + // Video File + else if (Identifier = 'VIDEO') then + begin + if (FileExists(self.Path + Value)) then + self.Video := Value + else + Log.LogError('Can''t find Video File in Song: ' + aFileName); + end + + // Video Gap + else if (Identifier = 'VIDEOGAP') then + self.VideoGAP := song_StrtoFloat( Value ) + + //Genre Sorting + else if (Identifier = 'GENRE') then + self.Genre := Value + + //Edition Sorting + else if (Identifier = 'EDITION') then + self.Edition := Value + + //Creator Tag + else if (Identifier = 'CREATOR') then + self.Creator := Value + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + self.Language := Value + + // Song Start + else if (Identifier = 'START') then + self.Start := song_StrtoFloat( Value ) + + // Song Ending + else if (Identifier = 'END') then + TryStrtoInt(Value, self.Finish) + + // Resolution + else if (Identifier = 'RESOLUTION') then + TryStrtoInt(Value, self.Resolution) + + // Notes Gap + else if (Identifier = 'NOTESGAP') then + TryStrtoInt(Value, self.NotesGAP) + // Relative Notes + else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then + self.Relative := True; + + end; + end; + + if not EOf(SongFile) then + ReadLn (SongFile, Line) + else + begin + Result := False; + Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); + break; + end; + + end; + + if self.Cover = '' then + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Check if all Required Values are given + if (Done <> 15) then + begin + Result := False; + if (Done and 8) = 0 then //No BPM Flag + Log.LogError('BPM Tag Missing: ' + self.FileName) + else if (Done and 4) = 0 then //No MP3 Flag + Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + else if (Done and 2) = 0 then //No Artist Flag + Log.LogError('Artist Tag Missing: ' + self.FileName) + else if (Done and 1) = 0 then //No Title Flag + Log.LogError('Title Tag Missing: ' + self.FileName) + else //unknown Error + Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +end; + +procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); +//var +// Space: boolean; // Auto Removed, Unused Variable +begin + case Ini.Solmization of + 1: // european + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' si '; + end; + end; + 2: // japanese + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' so '; + 9..10: LyricS := ' la '; + 11: LyricS := ' shi '; + end; + end; + 3: // american + begin + case (NoteP mod 12) of + 0..1: LyricS := ' do '; + 2..3: LyricS := ' re '; + 4: LyricS := ' mi '; + 5..6: LyricS := ' fa '; + 7..8: LyricS := ' sol '; + 9..10: LyricS := ' la '; + 11: LyricS := ' ti '; + end; + end; + end; // case + + with Lines[LineNumber].Line[Lines[LineNumber].High] do begin + SetLength(Note, Length(Note) + 1); + IlNut := IlNut + 1; + HighNote := HighNote + 1; + Melody.IlNut := Melody.IlNut + 1; + + Note[HighNote].Start := StartP; + if IlNut = 1 then begin + StartNote := Note[HighNote].Start; + if Lines[LineNumber].Number = 1 then + Start := -100; +// Start := Note[HighNote].Start; + end; + + Note[HighNote].Lenght := DurationP; + Melody.NoteLenght := Melody.NoteLenght + Note[HighNote].Lenght; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Note[HighNote].NoteType := 0; + ':': Note[HighNote].NoteType := 1; + '*': Note[HighNote].NoteType := 2; + end; + + Lines[LineNumber].NoteType := Lines[LineNumber].NoteType + Note[HighNote].Lenght * Note[HighNote].NoteType; + + Note[HighNote].Tone := NoteP; + if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; + Note[HighNote].ToneGamus := Note[HighNote].ToneGamus mod 12; + + Note[HighNote].Text := Copy(LyricS, 2, 100); + Lyric := Lyric + Note[HighNote].Text; + + if TypeP = 'F' then + Note[HighNote].FreeStyle := true; + + End_ := Note[HighNote].Start + Note[HighNote].Lenght; + end; // with +end; + +procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); +var +I: Integer; +begin + + // stara czesc //Alter Satz //Update Old Part + Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; + Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric)); + + //Total Notes Patch + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; + for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do + begin + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Lenght * Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType; + end; + //Total Notes Patch End + + + // nowa czesc //Neuer Satz //Update New Part + SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); + Lines[LineNumberP].High := Lines[LineNumberP].High + 1; + Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1; + Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; + + if self.Relative then + begin + Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; + Rel[LineNumberP] := Rel[LineNumberP] + Param2; + end + else + Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; + + Base[LineNumberP] := 100; // high number +end; + +procedure TSong.clear(); +begin + //Main Information + Title := ''; + Artist := ''; + + //Sortings: + Genre := 'Unknown'; + Edition := 'Unknown'; + Language := 'Unknown'; //Language Patch + + //Required Information + Mp3 := ''; + {$IFDEF FPC} + setlength( BPM, 0 ); + {$ELSE} + BPM := nil; + {$ENDIF} + + GAP := 0; + Start := 0; + Finish := 0; + + //Additional Information + Background := ''; + Cover := ''; + Video := ''; + VideoGAP := 0; + NotesGAP := 0; + Resolution := 4; + Creator := ''; + +end; + +function TSong.Analyse(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Open File and set File Pointer to the beginning + AssignFile(SongFile, self.Path + self.FileName); + + try + Reset(SongFile); + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadTxTHeader( FileName ) + + //And Close File + finally + CloseFile(SongFile); + end; +end; + + + +end. diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas index 15399110..e3152bf0 100644 --- a/Game/Code/Classes/UVideo.pas +++ b/Game/Code/Classes/UVideo.pas @@ -1,708 +1,708 @@ -unit UVideo;
-{< #############################################################################
-# FFmpeg support for UltraStar deluxe #
-# #
-# Created by b1indy #
-# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
-# #
-# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
-# http://www.nabble.com/file/p11795857/mpegpas01.zip #
-# #
-############################################################################## }
-
-//{$define DebugDisplay} // uncomment if u want to see the debug stuff
-//{$define DebugFrames}
-//{$define Info}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-(*
-
- look into
- av_read_play
-
-*)
-
-implementation
-
-uses SDL,
- UGraphicClasses,
- textgl,
- avcodec,
- avformat,
- avutil,
- {$IFDEF UseSWScale}
- swscale,
- {$ENDIF}
- math,
- OpenGL12,
- SysUtils,
- {$ifdef DebugDisplay}
- {$ifdef win32}
- dialogs,
- {$endif}
- {$ENDIF}
- (* FIXME
- {$ifdef UseFFMpegAudio}
- UAudioDecoder_FFMpeg,
- {$endif}
- *)
- UIni,
- UMusic,
- UGraphic;
-
-
-var
- singleton_VideoFFMpeg : IVideoPlayback;
-
-type
- TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback )
- private
- fVideoOpened ,
- fVideoPaused : Boolean;
-
- fVideoTex : glUint;
- fVideoSkipTime : Single;
-
- VideoFormatContext: PAVFormatContext;
-
- VideoStreamIndex ,
- AudioStreamIndex : Integer;
- VideoCodecContext: PAVCodecContext;
- VideoCodec: PAVCodec;
- AVFrame: PAVFrame;
- AVFrameRGB: PAVFrame;
- myBuffer: pByte;
-
- {$IFDEF UseSWScale}
- SoftwareScaleContext: PSwsContext;
- {$ENDIF}
-
- TexX, TexY, dataX, dataY: Cardinal;
-
- ScaledVideoWidth, ScaledVideoHeight: Real;
- VideoAspect: Real;
- VideoTextureU, VideoTextureV: Real;
- VideoTimeBase, VideoTime, LastFrameTime, TimeDifference, flooptime: Extended;
-
-
- WantedAudioCodecContext,
- AudioCodecContext : PSDL_AudioSpec;
- aCodecCtx : PAVCodecContext;
-
- function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
-
- public
- constructor create();
- function GetName: String;
- procedure init();
-
- function Open(const aFileName : string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- procedure GetFrame(Time: Extended);
- procedure DrawGL(Screen: integer);
-
- end;
-
- const
- SDL_AUDIO_BUFFER_SIZE = 1024;
-
-{$ifdef DebugDisplay}
-//{$ifNdef win32}
-
-procedure showmessage( aMessage : String );
-begin
- writeln( aMessage );
-end;
-
-//{$endif}
-{$ENDIF}
-
-{ ------------------------------------------------------------------------------
-asdf
------------------------------------------------------------------------------- }
-
-function TVideoPlayback_ffmpeg.GetName: String;
-begin
- result := 'FFMpeg';
-end;
-
-{
- @author(Jay Binks <jaybinks@gmail.com>)
- @created(2007-10-09)
- @lastmod(2007-10-09)
-
- @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file )
- @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream)
- @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream)
- @returns(@true on success, @false otherwise)
-
- translated from "Setting Up the Audio" section at
- http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html
-}
-function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
-var
- i : integer;
- st : pAVStream;
-begin
- // Find the first video stream
- aFirstAudioStream := -1;
- aFirstVideoStream := -1;
-
- writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) );
- writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) );
-
- i := 0;
- while ( i < aFormatCtx.nb_streams ) do
-// while ( i < length(aFormatCtx.streams)-1 ) do
- begin
- writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) );
- st := aFormatCtx.streams[i];
-
- if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND
- (aFirstVideoStream < 0) THEN
- begin
- aFirstVideoStream := i;
- end;
-
- if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND
- ( aFirstAudioStream < 0) THEN
- begin
- aFirstAudioStream := i;
- end;
-
- inc( i );
- end; // while
-
- result := (aFirstAudioStream > -1) OR
- (aFirstVideoStream > -1) ; // Didn't find a video stream
-end;
-
-
-
-
-procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended);
-var
- FrameFinished: Integer;
- AVPacket: TAVPacket;
- errnum, x, y: Integer;
- FrameDataPtr: PByteArray;
- linesize: integer;
- myTime: Extended;
- DropFrame: Boolean;
- droppedFrames: Integer;
-const
- FRAMEDROPCOUNT=3;
-begin
- if not fVideoOpened then Exit;
-
- if fVideoPaused then Exit;
-
- myTime := ( Time - flooptime ) + fVideoSkipTime;
- TimeDifference := myTime - VideoTime;
- DropFrame := False;
-
-{$IFDEF DebugDisplay}
- showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+
- 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
-{$endif}
-
- if (VideoTime <> 0) and (TimeDifference+flooptime <= VideoTimeBase) then
- begin
-{$ifdef DebugFrames}
- // frame delay debug display
- GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
-{$endif}
-
-{$IFDEF DebugDisplay}
- showmessage('not getting new frame'+#13#10+
- 'Time: '+inttostr(floor(Time*1000))+#13#10+
- 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
-{$endif}
-
- Exit;// we don't need a new frame now
- end;
-
- VideoTime:=VideoTime+VideoTimeBase;
- TimeDifference:=myTime-VideoTime;
- if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames
- begin
-{$ifdef DebugFrames}
- //frame drop debug display
- GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
-{$endif}
-{$IFDEF DebugDisplay}
- showmessage('skipping frames'+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+
- 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000)));
-{$endif}
- VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase;
- DropFrame:=True;
- end;
-
- AVPacket.data := nil;
- av_init_packet( AVPacket ); // JB-ffmpeg
-
- FrameFinished:=0;
- // read packets until we have a finished frame (or there are no more packets)
- while ( FrameFinished = 0 ) do
- begin
- if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then
- begin
- // Record the Time we looped, this is used to keep the loops, in time. otherwise they speed
- flooptime := time;
-
- // Dont use SetPosition() it dosnt let us go back to frame 0... can we / should we fix this ??
- fVideoSkipTime := 0;
- VideoTime := 0;
-
- // Free the packet we just got from av_read_frame
- av_free_packet( @AVPacket );
-
- // Seek to frame 0 in the video stream
- av_seek_frame(VideoFormatContext,VideoStreamIndex,0,AVSEEK_FLAG_ANY);
- break;
- end;
-
-
- // if we got a packet from the video stream, then decode it
- if (AVPacket.stream_index=VideoStreamIndex) then
- begin
- errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
- (* FIXME
- {$ifdef UseFFMpegAudio}
- end
- else
- if (AVPacket.stream_index = AudioStreamIndex ) then
- begin
- writeln('Encue Audio packet');
- audioq.put(AVPacket);
- {$endif}
- *)
- end;
-
- try
-// if AVPacket.data <> nil then
- av_free_packet( @AVPacket ); // JB-ffmpeg
- except
- // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
- end;
-
- end;
-
- if DropFrame then
- for droppedFrames:=1 to FRAMEDROPCOUNT do begin
- FrameFinished:=0;
- // read packets until we have a finished frame (or there are no more packets)
- while (FrameFinished=0) do
- begin
- if (av_read_frame(VideoFormatContext, AVPacket)<0) then
- Break;
- // if we got a packet from the video stream, then decode it
- if (AVPacket.stream_index=VideoStreamIndex) then
- errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
-
- // release internal packet structure created by av_read_frame
- try
-// if AVPacket.data <> nil then
- av_free_packet( @AVPacket ); // JB-ffmpeg
- except
- // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
- end;
- end;
- end;
-
- // if we did not get an new frame, there's nothing more to do
- if Framefinished=0 then begin
- Exit;
- end;
-
- // otherwise we convert the pixeldata from YUV to RGB
- {$IFDEF UseSWScale}
- errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize),
- 0,VideoCodecContext^.Height,
- @(AVFrameRGB.data),@(AVFrameRGB.linesize));
- {$ELSE}
- errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24,
- PAVPicture(AVFrame), VideoCodecContext^.pix_fmt,
- VideoCodecContext^.width, VideoCodecContext^.height);
- {$ENDIF}
-
- if errnum >=0 then
- begin
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-{$ifdef DebugFrames}
- //frame decode debug display
- GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00);
-{$endif}
- end;
-end;
-
-procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer);
-begin
- // have a nice black background to draw on (even if there were errors opening the vid)
- if Screen=1 then
- begin
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
- // exit if there's nothing to draw
- if not fVideoOpened then Exit;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glbegin(gl_quads);
- glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
- glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
- glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
- glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
-{$ifdef Info}
- if VideoSkipTime+VideoTime+VideoTimeBase < 0 then
- begin
- glColor4f(0.7, 1, 0.3, 1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (300, 0);
- glPrint('Delay due to negative VideoGap');
- glColor4f(1, 1, 1, 1);
- end;
-{$endif}
-
-{$ifdef DebugFrames}
- glColor4f(0, 0, 0, 0.2);
- glbegin(gl_quads);
- glVertex2f(0, 0);
- glVertex2f(0, 70);
- glVertex2f(250, 70);
- glVertex2f(250, 0);
- glEnd;
-
- glColor4f(1,1,1,1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (5, 0);
- glPrint('delaying frame');
- SetFontPos (5, 20);
- glPrint('fetching frame');
- SetFontPos (5, 40);
- glPrint('dropping frame');
-{$endif}
-end;
-
-constructor TVideoPlayback_ffmpeg.create();
-begin
- av_register_all;
-
- fVideoOpened := False;
- fVideoPaused := False;
-end;
-
-procedure TVideoPlayback_ffmpeg.init();
-begin
- glGenTextures(1, PglUint(@fVideoTex));
-end;
-
-
-function TVideoPlayback_ffmpeg.Open(const aFileName : string): boolean; // true if succeed
-var
- errnum, i, x,y: Integer;
- lStreamsCount : Integer;
-
- wanted_spec ,
- spec : TSDL_AudioSpec;
- aCodec : pAVCodec;
-
- sws_dst_w, sws_dst_h: Integer;
-
-begin
- Result := false;
-
- fVideoOpened := False;
- fVideoPaused := False;
- VideoTimeBase := 0;
- VideoTime := 0;
- LastFrameTime := 0;
- TimeDifference := 0;
- VideoFormatContext := nil;
-
-// writeln( aFileName );
-
- errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil);
-// writeln( 'Errnum : ' +inttostr( errnum ));
- if(errnum <> 0) then
- begin
-{$ifdef DebugDisplay}
- case errnum of
- AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN');
- AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO');
- AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED');
- AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA');
- AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM');
- AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT');
- AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP');
- else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum));
- end;
-{$ENDIF}
- Exit;
- end
- else
- begin
- VideoStreamIndex := -1;
- AudioStreamIndex := -1;
-
- // Find which stream contains the video
- if( av_find_stream_info(VideoFormatContext) >= 0 ) then
- begin
- find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex );
-
- writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) );
- writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) );
- end;
- // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error
- // Just a temporary workaround for now
- aCodecCtx := nil;
- if( AudioStreamIndex >= 0) then
- aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec;
-
- (* FIXME
- {$ifdef UseFFMpegAudio}
- // This is the audio ffmpeg audio support Jay is working on.
- if aCodecCtx <> nil then
- begin
- wanted_spec.freq := aCodecCtx.sample_rate;
- wanted_spec.format := AUDIO_S16SYS;
- wanted_spec.channels := aCodecCtx.channels;
- wanted_spec.silence := 0;
- wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE;
- wanted_spec.callback := UAudio_FFMpeg.audio_callback;
- wanted_spec.userdata := aCodecCtx;
-
-
- if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then
- begin
- writeln('SDL_OpenAudio: '+SDL_GetError());
- exit;
- end;
-
- writeln( 'SDL opened audio device' );
-
- aCodec := avcodec_find_decoder(aCodecCtx.codec_id);
- if (aCodec = nil) then
- begin
- writeln('Unsupported codec!');
- exit;
- end;
-
- avcodec_open(aCodecCtx, aCodec);
-
- writeln( 'Opened the codec' );
-
- packet_queue_init( audioq );
- SDL_PauseAudio(0);
-
- writeln( 'SDL_PauseAudio' );
-
-
- end;
- {$endif}
- *)
-
- if(VideoStreamIndex >= 0) then
- begin
- VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec;
- VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id);
- end
- else
- begin
-{$ifdef DebugDisplay}
- showmessage('found no video stream');
-{$ENDIF}
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-
- if(VideoCodec<>Nil) then
- begin
- errnum:=avcodec_open(VideoCodecContext, VideoCodec);
- end else begin
-{$ifdef DebugDisplay}
- showmessage('no matching codec found');
-{$ENDIF}
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
- if(errnum >=0) then
- begin
- if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then
- begin
- ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-{$ifdef DebugDisplay}
- showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+
- ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+
- ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+
- ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den));
-{$endif}
- // allocate space for decoded frame and rgb frame
- AVFrame:=avcodec_alloc_frame;
- AVFrameRGB:=avcodec_alloc_frame;
- end;
-
- dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width))));
- dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height))));
- myBuffer:=Nil;
- if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then
- begin
- myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY));
- end;
- if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24,
- dataX, dataY)
- else begin
- {$ifdef DebugDisplay}
- showmessage('failed to allocate video buffer');
- {$endif}
- av_free(AVFrameRGB);
- av_free(AVFrame);
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-
- {$IFDEF UseSWScale}
- SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt),
- dataX, dataY, integer(PIX_FMT_RGB24),
- SWS_FAST_BILINEAR, nil, nil, nil);
- if SoftwareScaleContext <> Nil then
- writeln('got swscale context')
- else begin
- writeln('ERROR: didn´t get swscale context');
- av_free(AVFrameRGB);
- av_free(AVFrame);
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
- {$ENDIF}
-
- // this is the errnum from avpicture_fill
- if errnum >=0 then
- begin
- fVideoOpened:=True;
-
- TexX := VideoCodecContext^.width;
- TexY := VideoCodecContext^.height;
- dataX := Round(Power(2, Ceil(Log2(TexX))));
- dataY := Round(Power(2, Ceil(Log2(TexY))));
- // calculate some information for video display
- VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den;
- if (VideoAspect = 0) then
- VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height
- else
- VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height;
- ScaledVideoWidth:=800.0;
- ScaledVideoHeight:=800.0/VideoAspect;
- VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num;
-{$ifdef DebugDisplay}
- showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps');
-{$endif}
- // hack to get reasonable timebase (for divx and others)
- if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps
- begin
- VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den;
- while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10;
- VideoTimeBase:=1/VideoTimeBase;
- end;
- end;
- end;
-
- Result := true;
-end;
-
-procedure TVideoPlayback_ffmpeg.Close;
-begin
- if fVideoOpened then
- begin
- av_free(myBuffer);
- av_free(AVFrameRGB);
- av_free(AVFrame);
-
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
-
- fVideoOpened:=False;
- end;
-end;
-
-procedure TVideoPlayback_ffmpeg.Play;
-begin
-end;
-
-procedure TVideoPlayback_ffmpeg.Pause;
-begin
- fVideoPaused := not fVideoPaused;
-end;
-
-procedure TVideoPlayback_ffmpeg.Stop;
-begin
-end;
-
-procedure TVideoPlayback_ffmpeg.SetPosition(Time: real);
-begin
- fVideoSkipTime := Time;
-
- if fVideoSkipTime > 0 then
- begin
- av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY);
-
- VideoTime := fVideoSkipTime;
- end;
-end;
-
-// what is this supposed to do? return VideoTime?
-function TVideoPlayback_ffmpeg.GetPosition: real;
-begin
- result := 0;
-end;
-
-initialization
- singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create();
- AudioManager.add( singleton_VideoFFMpeg );
-
-finalization
- AudioManager.Remove( singleton_VideoFFMpeg );
-
-end.
+unit UVideo; +{< ############################################################################# +# FFmpeg support for UltraStar deluxe # +# # +# Created by b1indy # +# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # +# # +# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # +# http://www.nabble.com/file/p11795857/mpegpas01.zip # +# # +############################################################################## } + +//{$define DebugDisplay} // uncomment if u want to see the debug stuff +//{$define DebugFrames} +//{$define Info} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +(* + + look into + av_read_play + +*) + +implementation + +uses SDL, + UGraphicClasses, + textgl, + avcodec, + avformat, + avutil, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} + math, + OpenGL12, + SysUtils, + {$ifdef DebugDisplay} + {$ifdef win32} + dialogs, + {$endif} + {$ENDIF} + (* FIXME + {$ifdef UseFFMpegAudio} + UAudioDecoder_FFMpeg, + {$endif} + *) + UIni, + UMusic, + UGraphic; + + +var + singleton_VideoFFMpeg : IVideoPlayback; + +type + TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback ) + private + fVideoOpened , + fVideoPaused : Boolean; + + fVideoTex : glUint; + fVideoSkipTime : Single; + + VideoFormatContext: PAVFormatContext; + + VideoStreamIndex , + AudioStreamIndex : Integer; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + myBuffer: pByte; + + {$IFDEF UseSWScale} + SoftwareScaleContext: PSwsContext; + {$ENDIF} + + TexX, TexY, dataX, dataY: Cardinal; + + ScaledVideoWidth, ScaledVideoHeight: Real; + VideoAspect: Real; + VideoTextureU, VideoTextureV: Real; + VideoTimeBase, VideoTime, LastFrameTime, TimeDifference, flooptime: Extended; + + + WantedAudioCodecContext, + AudioCodecContext : PSDL_AudioSpec; + aCodecCtx : PAVCodecContext; + + function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + + public + constructor create(); + function GetName: String; + procedure init(); + + function Open(const aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + + end; + + const + SDL_AUDIO_BUFFER_SIZE = 1024; + +{$ifdef DebugDisplay} +//{$ifNdef win32} + +procedure showmessage( aMessage : String ); +begin + writeln( aMessage ); +end; + +//{$endif} +{$ENDIF} + +{ ------------------------------------------------------------------------------ +asdf +------------------------------------------------------------------------------ } + +function TVideoPlayback_ffmpeg.GetName: String; +begin + result := 'FFMpeg'; +end; + +{ + @author(Jay Binks <jaybinks@gmail.com>) + @created(2007-10-09) + @lastmod(2007-10-09) + + @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file ) + @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream) + @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream) + @returns(@true on success, @false otherwise) + + translated from "Setting Up the Audio" section at + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html +} +function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; +var + i : integer; + st : pAVStream; +begin + // Find the first video stream + aFirstAudioStream := -1; + aFirstVideoStream := -1; + + writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) ); + writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) ); + + i := 0; + while ( i < aFormatCtx.nb_streams ) do +// while ( i < length(aFormatCtx.streams)-1 ) do + begin + writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); + st := aFormatCtx.streams[i]; + + if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND + (aFirstVideoStream < 0) THEN + begin + aFirstVideoStream := i; + end; + + if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND + ( aFirstAudioStream < 0) THEN + begin + aFirstAudioStream := i; + end; + + inc( i ); + end; // while + + result := (aFirstAudioStream > -1) OR + (aFirstVideoStream > -1) ; // Didn't find a video stream +end; + + + + +procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended); +var + FrameFinished: Integer; + AVPacket: TAVPacket; +errnum, {*x, *}y: Integer; // Auto Removed, Unused Variable (x) +// FrameDataPtr: PByteArray; // Auto Removed, Unused Variable +// linesize: integer; // Auto Removed, Unused Variable + myTime: Extended; + DropFrame: Boolean; + droppedFrames: Integer; +const + FRAMEDROPCOUNT=3; +begin + if not fVideoOpened then Exit; + + if fVideoPaused then Exit; + + myTime := ( Time - flooptime ) + fVideoSkipTime; + TimeDifference := myTime - VideoTime; + DropFrame := False; + +{$IFDEF DebugDisplay} + showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +{$endif} + + if (VideoTime <> 0) and (TimeDifference+flooptime <= VideoTimeBase) then + begin +{$ifdef DebugFrames} + // frame delay debug display + GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); +{$endif} + +{$IFDEF DebugDisplay} + showmessage('not getting new frame'+#13#10+ + 'Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +{$endif} + + Exit;// we don't need a new frame now + end; + + VideoTime:=VideoTime+VideoTimeBase; + TimeDifference:=myTime-VideoTime; + if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames + begin +{$ifdef DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); +{$endif} +{$IFDEF DebugDisplay} + showmessage('skipping frames'+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ + 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); +{$endif} + VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; + DropFrame:=True; + end; + + AVPacket.data := nil; + av_init_packet( AVPacket ); // JB-ffmpeg + + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while ( FrameFinished = 0 ) do + begin + if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then + begin + // Record the Time we looped, this is used to keep the loops, in time. otherwise they speed + flooptime := time; + + // Dont use SetPosition() it dosnt let us go back to frame 0... can we / should we fix this ?? + fVideoSkipTime := 0; + VideoTime := 0; + + // Free the packet we just got from av_read_frame + av_free_packet( @AVPacket ); + + // Seek to frame 0 in the video stream + av_seek_frame(VideoFormatContext,VideoStreamIndex,0,AVSEEK_FLAG_ANY); + break; + end; + + + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + begin + errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + (* FIXME + {$ifdef UseFFMpegAudio} + end + else + if (AVPacket.stream_index = AudioStreamIndex ) then + begin + writeln('Encue Audio packet'); + audioq.put(AVPacket); + {$endif} + *) + end; + + try +// if AVPacket.data <> nil then + av_free_packet( @AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; + + end; + + if DropFrame then + for droppedFrames:=1 to FRAMEDROPCOUNT do begin + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) do + begin + if (av_read_frame(VideoFormatContext, AVPacket)<0) then + Break; + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + + // release internal packet structure created by av_read_frame + try +// if AVPacket.data <> nil then + av_free_packet( @AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; + end; + end; + + // if we did not get an new frame, there's nothing more to do + if Framefinished=0 then begin + Exit; + end; + + // otherwise we convert the pixeldata from YUV to RGB + {$IFDEF UseSWScale} + errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize), + 0,VideoCodecContext^.Height, + @(AVFrameRGB.data),@(AVFrameRGB.linesize)); + {$ELSE} + errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); + {$ENDIF} + + if errnum >=0 then + begin + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +{$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); +{$endif} + end; +end; + +procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer); +begin + // have a nice black background to draw on (even if there were errors opening the vid) + if Screen=1 then + begin + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; + // exit if there's nothing to draw + if not fVideoOpened then Exit; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glbegin(gl_quads); + glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{$ifdef Info} + if VideoSkipTime+VideoTime+VideoTimeBase < 0 then + begin + glColor4f(0.7, 1, 0.3, 1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (300, 0); + glPrint('Delay due to negative VideoGap'); + glColor4f(1, 1, 1, 1); + end; +{$endif} + +{$ifdef DebugFrames} + glColor4f(0, 0, 0, 0.2); + glbegin(gl_quads); + glVertex2f(0, 0); + glVertex2f(0, 70); + glVertex2f(250, 70); + glVertex2f(250, 0); + glEnd; + + glColor4f(1,1,1,1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (5, 0); + glPrint('delaying frame'); + SetFontPos (5, 20); + glPrint('fetching frame'); + SetFontPos (5, 40); + glPrint('dropping frame'); +{$endif} +end; + +constructor TVideoPlayback_ffmpeg.create(); +begin + av_register_all; + + fVideoOpened := False; + fVideoPaused := False; +end; + +procedure TVideoPlayback_ffmpeg.init(); +begin + glGenTextures(1, PglUint(@fVideoTex)); +end; + + +function TVideoPlayback_ffmpeg.Open(const aFileName : string): boolean; // true if succeed +var +errnum {*i, x, y*}: Integer; // Auto Removed, Unused Variable (i) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (y) +// lStreamsCount : Integer; // Auto Removed, Unused Variable + + wanted_spec , +// spec : TSDL_AudioSpec; // Auto Removed, Unused Variable +// aCodec : pAVCodec; // Auto Removed, Unused Variable + +{*sws_dst_w, *}sws_dst_h: Integer; // Auto Removed, Unused Variable (sws_dst_w) + +begin + Result := false; + + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + LastFrameTime := 0; + TimeDifference := 0; + VideoFormatContext := nil; + +// writeln( aFileName ); + + errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil); +// writeln( 'Errnum : ' +inttostr( errnum )); + if(errnum <> 0) then + begin +{$ifdef DebugDisplay} + case errnum of + AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN'); + AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO'); + AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED'); + AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA'); + AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM'); + AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT'); + AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP'); + else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum)); + end; +{$ENDIF} + Exit; + end + else + begin + VideoStreamIndex := -1; + AudioStreamIndex := -1; + + // Find which stream contains the video + if( av_find_stream_info(VideoFormatContext) >= 0 ) then + begin + find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); + + writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); + writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); + end; + // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error + // Just a temporary workaround for now + aCodecCtx := nil; + if( AudioStreamIndex >= 0) then + aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; + + (* FIXME + {$ifdef UseFFMpegAudio} + // This is the audio ffmpeg audio support Jay is working on. + if aCodecCtx <> nil then + begin + wanted_spec.freq := aCodecCtx.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := aCodecCtx.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := UAudio_FFMpeg.audio_callback; + wanted_spec.userdata := aCodecCtx; + + + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + writeln('SDL_OpenAudio: '+SDL_GetError()); + exit; + end; + + writeln( 'SDL opened audio device' ); + + aCodec := avcodec_find_decoder(aCodecCtx.codec_id); + if (aCodec = nil) then + begin + writeln('Unsupported codec!'); + exit; + end; + + avcodec_open(aCodecCtx, aCodec); + + writeln( 'Opened the codec' ); + + packet_queue_init( audioq ); + SDL_PauseAudio(0); + + writeln( 'SDL_PauseAudio' ); + + + end; + {$endif} + *) + + if(VideoStreamIndex >= 0) then + begin + VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; + VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); + end + else + begin +{$ifdef DebugDisplay} + showmessage('found no video stream'); +{$ENDIF} + av_close_input_file(VideoFormatContext); + Exit; + end; + + if(VideoCodec<>Nil) then + begin + errnum:=avcodec_open(VideoCodecContext, VideoCodec); + end else begin +{$ifdef DebugDisplay} + showmessage('no matching codec found'); +{$ENDIF} + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(errnum >=0) then + begin + if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then + begin + ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; +{$ifdef DebugDisplay} + showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ + ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den)); +{$endif} + // allocate space for decoded frame and rgb frame + AVFrame:=avcodec_alloc_frame; + AVFrameRGB:=avcodec_alloc_frame; + end; + + dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); + dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); + myBuffer:=Nil; + if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then + begin + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY)); + end; + if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, + dataX, dataY) + else begin + {$ifdef DebugDisplay} + showmessage('failed to allocate video buffer'); + {$endif} + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + + {$IFDEF UseSWScale} + SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), + dataX, dataY, integer(PIX_FMT_RGB24), + SWS_FAST_BILINEAR, nil, nil, nil); + if SoftwareScaleContext <> Nil then + writeln('got swscale context') + else begin + writeln('ERROR: didn´t get swscale context'); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + {$ENDIF} + + // this is the errnum from avpicture_fill + if errnum >=0 then + begin + fVideoOpened:=True; + + TexX := VideoCodecContext^.width; + TexY := VideoCodecContext^.height; + dataX := Round(Power(2, Ceil(Log2(TexX)))); + dataY := Round(Power(2, Ceil(Log2(TexY)))); + // calculate some information for video display + VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; + if (VideoAspect = 0) then + VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height + else + VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; + ScaledVideoWidth:=800.0; + ScaledVideoHeight:=800.0/VideoAspect; + VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num; +{$ifdef DebugDisplay} + showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps'); +{$endif} + // hack to get reasonable timebase (for divx and others) + if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps + begin + VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den; + while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10; + VideoTimeBase:=1/VideoTimeBase; + end; + end; + end; + + Result := true; +end; + +procedure TVideoPlayback_ffmpeg.Close; +begin + if fVideoOpened then + begin + av_free(myBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + + fVideoOpened:=False; + end; +end; + +procedure TVideoPlayback_ffmpeg.Play; +begin +end; + +procedure TVideoPlayback_ffmpeg.Pause; +begin + fVideoPaused := not fVideoPaused; +end; + +procedure TVideoPlayback_ffmpeg.Stop; +begin +end; + +procedure TVideoPlayback_ffmpeg.SetPosition(Time: real); +begin + fVideoSkipTime := Time; + + if fVideoSkipTime > 0 then + begin + av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY); + + VideoTime := fVideoSkipTime; + end; +end; + +// what is this supposed to do? return VideoTime? +function TVideoPlayback_ffmpeg.GetPosition: real; +begin + result := 0; +end; + +initialization + singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); + AudioManager.add( singleton_VideoFFMpeg ); + +finalization + AudioManager.Remove( singleton_VideoFFMpeg ); + +end. diff --git a/Game/Code/Screens/UScreenCredits.pas b/Game/Code/Screens/UScreenCredits.pas index 254f9357..e12a54e3 100644 --- a/Game/Code/Screens/UScreenCredits.pas +++ b/Game/Code/Screens/UScreenCredits.pas @@ -1,1409 +1,1409 @@ -unit UScreenCredits;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- UMenu,
- SDL,
- SDL_Image,
- UDisplay,
- UTexture,
- OpenGL12,
- UMusic,
- UFiles,
- SysUtils,
- UThemes,
- ULCD,
- ULight,
- UGraphicClasses;
-
-type
- TCreditsStages=(InitialDelay,Intro,MainPart,Outro);
-
- TScreenCredits = class(TMenu)
- public
-
- Credits_X: Real;
- Credits_Time: Cardinal;
- Credits_Alpha: Cardinal;
- CTime: Cardinal;
- CTime_hold: Cardinal;
- ESC_Alpha: Integer;
-
- credits_entry_tex: TTexture;
- credits_entry_dx_tex: TTexture;
- credits_bg_tex: TTexture;
- credits_bg_ovl: TTexture;
-// credits_bg_logo: TTexture;
- credits_bg_scrollbox_left: TTexture;
- credits_blindguard: TTexture;
- credits_blindy: TTexture;
- credits_canni: TTexture;
- credits_commandio: TTexture;
- credits_lazyjoker: TTexture;
- credits_mog: TTexture;
- credits_mota: TTexture;
- credits_skillmaster: TTexture;
- credits_whiteshark: TTexture;
- intro_layer01: TTexture;
- intro_layer02: TTexture;
- intro_layer03: TTexture;
- intro_layer04: TTexture;
- intro_layer05: TTexture;
- intro_layer06: TTexture;
- intro_layer07: TTexture;
- intro_layer08: TTexture;
- intro_layer09: TTexture;
- outro_bg: TTexture;
- outro_esc: TTexture;
- outro_exd: TTexture;
-
- deluxe_slidein: cardinal;
-
- CurrentScrollText: String;
- NextScrollUpdate: Real;
- EndofLastScrollingPart: Cardinal;
- CurrentScrollStart, CurrentScrollEnd: Integer;
-
- CRDTS_Stage: TCreditsStages;
-
- myTex: glUint;
- mysdlimage,myconvertedsdlimage: PSDL_Surface;
-
- Fadeout: boolean;
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- function Draw: boolean; override;
- procedure onShow; override;
- procedure onHide; override;
- procedure DrawCredits;
- procedure Draw_FunkyText;
- end;
-
-const
- Funky_Text: AnsiString =
- 'Grandma Deluxe has arrived! Thanks to Corvus5 for the massive work on UltraStar, Wome for the nice tune you´re hearing, '+
- 'all the people who put massive effort and work in new songs (don´t forget UltraStar w/o songs would be nothing), ppl from '+
- 'irc helping us - eBandit and Gabari, scene ppl who really helped instead of compiling and running away. Greetings to DennisTheMenace for betatesting, '+
- 'Demoscene.tv, pouet.net, KakiArts, Sourceforge,..';
-
-
- Timings: array[0..21] of Cardinal=(
- 20, // 0 Delay vor Start
-
- 149, // 1 Ende erster Intro Zoom
- 155, // 2 Start 2. Action im Intro
- 170, // 3 Ende Separation im Intro
- 271, // 4 Anfang Zoomout im Intro
- 0, // 5 unused
- 261, // 6 Start fade-to-white im Intro
-
- 271, // 7 Start Main Part
- 280, // 8 Start On-Beat-Sternchen Main Part
-
- 396, // 9 Start BlindGuard
- 666, // 10 Start blindy
- 936, // 11 Start Canni
- 1206, // 12 Start Commandio
- 1476, // 13 Start LazyJoker
- 1746, // 14 Start Mog
- 2016, // 15 Start Mota
- 2286, // 16 Start SkillMaster
- 2556, // 17 Start WhiteShark
- 2826, // 18 Ende Whiteshark
- 3096, // 19 Start FadeOut Mainscreen
- 3366, // 20 Ende Credits Tune
- 60); // 21 start flare im intro
-
-
- sdl32bpprgba: TSDL_Pixelformat=(palette: nil;
- BitsPerPixel: 32;
- BytesPerPixel: 4;
- Rloss: 0;
- Gloss: 0;
- Bloss: 0;
- Aloss: 0;
- Rshift: 0;
- Gshift: 8;
- Bshift: 16;
- Ashift: 24;
- Rmask: $000000ff;
- Gmask: $0000ff00;
- Bmask: $00ff0000;
- Amask: $ff000000;
- colorkey: 0;
- alpha: 255 );
-
-
-implementation
-
-uses {$IFDEF win32}
- windows,
- {$ELSE}
- lclintf,
- {$ENDIF}
- ULog,
- UGraphic,
- UMain,
- UIni,
- USongs,
- Textgl,
- ULanguage,
- UCommon,
- Math,
- dialogs;
-
-
-function TScreenCredits.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- FadeTo(@ScreenMain);
- AudioPlayback.PlaySound(SoundLib.Back);
- end;
-{ SDLK_SPACE:
- begin
- setlength(CTime_hold,length(CTime_hold)+1);
- CTime_hold[high(CTime_hold)]:=CTime;
- end;
-}
- end;//esac
- end; //fi
-end;
-
-constructor TScreenCredits.Create;
-begin
- inherited Create;
-
- credits_bg_tex := Texture.LoadTexture(true, 'CRDTS_BG', 'PNG', 'Plain', 0);
- credits_bg_ovl := Texture.LoadTexture(true, 'CRDTS_OVL', 'PNG', 'Transparent', 0);
-
- credits_blindguard := Texture.LoadTexture(true, 'CRDTS_blindguard', 'PNG', 'Font Black', 0);
- credits_blindy := Texture.LoadTexture(true, 'CRDTS_blindy', 'PNG', 'Font Black', 0);
- credits_canni := Texture.LoadTexture(true, 'CRDTS_canni', 'PNG', 'Font Black', 0);
- credits_commandio := Texture.LoadTexture(true, 'CRDTS_commandio', 'PNG', 'Font Black', 0);
- credits_lazyjoker := Texture.LoadTexture(true, 'CRDTS_lazyjoker', 'PNG', 'Font Black', 0);
- credits_mog := Texture.LoadTexture(true, 'CRDTS_mog', 'PNG', 'Font Black', 0);
- credits_mota := Texture.LoadTexture(true, 'CRDTS_mota', 'PNG', 'Font Black', 0);
- credits_skillmaster := Texture.LoadTexture(true, 'CRDTS_skillmaster', 'PNG', 'Font Black', 0);
- credits_whiteshark := Texture.LoadTexture(true, 'CRDTS_whiteshark', 'PNG', 'Font Black', 0);
-
- intro_layer01 := Texture.LoadTexture(true, 'INTRO_L01', 'PNG', 'Transparent', 0);
- intro_layer02 := Texture.LoadTexture(true, 'INTRO_L02', 'PNG', 'Transparent', 0);
- intro_layer03 := Texture.LoadTexture(true, 'INTRO_L03', 'PNG', 'Transparent', 0);
- intro_layer04 := Texture.LoadTexture(true, 'INTRO_L04', 'PNG', 'Transparent', 0);
- intro_layer05 := Texture.LoadTexture(true, 'INTRO_L05', 'PNG', 'Transparent', 0);
- intro_layer06 := Texture.LoadTexture(true, 'INTRO_L06', 'PNG', 'Transparent', 0);
- intro_layer07 := Texture.LoadTexture(true, 'INTRO_L07', 'PNG', 'Transparent', 0);
- intro_layer08 := Texture.LoadTexture(true, 'INTRO_L08', 'PNG', 'Transparent', 0);
- intro_layer09 := Texture.LoadTexture(true, 'INTRO_L09', 'PNG', 'Transparent', 0);
-
- outro_bg := Texture.LoadTexture(true, 'OUTRO_BG', 'PNG', 'Plain', 0);
- outro_esc := Texture.LoadTexture(true, 'OUTRO_ESC', 'PNG', 'Transparent', 0);
- outro_exd := Texture.LoadTexture(true, 'OUTRO_EXD', 'PNG', 'Transparent', 0);
-
- CRDTS_Stage:=InitialDelay;
-end;
-
-function TScreenCredits.Draw: boolean;
-begin
- DrawCredits;
- Draw:=true;
-end;
-
-function pixfmt_eq(fmt1,fmt2: TSDL_Pixelformat): boolean;
-begin
- if (fmt1.BitsPerPixel = fmt2.BitsPerPixel) and
- (fmt1.BytesPerPixel = fmt2.BytesPerPixel) and
- (fmt1.Rloss = fmt2.Rloss) and
- (fmt1.Gloss = fmt2.Gloss) and
- (fmt1.Bloss = fmt2.Bloss) and
- (fmt1.Rmask = fmt2.Rmask) and
- (fmt1.Gmask = fmt2.Gmask) and
- (fmt1.Bmask = fmt2.Bmask) and
- (fmt1.Rshift = fmt2.Rshift) and
- (fmt1.Gshift = fmt2.Gshift) and
- (fmt1.Bshift = fmt2.Bshift)
- then
- pixfmt_eq:=True
- else
- pixfmt_eq:=False;
-end;
-
-function inttohexstr(i: cardinal):pchar;
-var helper, i2, c:cardinal;
- tmpstr: string;
-begin
- helper:=0;
- i2:=i;
- tmpstr:='';
- for c:=1 to 8 do
- begin
- helper:=(helper shl 4) or (i2 and $f);
- i2:=i2 shr 4;
- end;
- for c:=1 to 8 do
- begin
- i2:=helper and $f;
- helper := helper shr 4;
- case i2 of
- 0: tmpstr:=tmpstr+'0';
- 1: tmpstr:=tmpstr+'1';
- 2: tmpstr:=tmpstr+'2';
- 3: tmpstr:=tmpstr+'3';
- 4: tmpstr:=tmpstr+'4';
- 5: tmpstr:=tmpstr+'5';
- 6: tmpstr:=tmpstr+'6';
- 7: tmpstr:=tmpstr+'7';
- 8: tmpstr:=tmpstr+'8';
- 9: tmpstr:=tmpstr+'9';
- 10: tmpstr:=tmpstr+'a';
- 11: tmpstr:=tmpstr+'b';
- 12: tmpstr:=tmpstr+'c';
- 13: tmpstr:=tmpstr+'d';
- 14: tmpstr:=tmpstr+'e';
- 15: tmpstr:=tmpstr+'f';
- end;
- end;
- inttohexstr:=pchar(tmpstr);
-end;
-
-procedure TScreenCredits.onShow;
-begin
- inherited;
-
- CRDTS_Stage:=InitialDelay;
- Credits_X := 580;
- deluxe_slidein := 0;
- Credits_Alpha := 0;
- //Music.SetLoop(true); Loop looped ned, so ne scheisse - loop loops not, shit
- AudioPlayback.Open(soundpath + 'wome-credits-tune.mp3'); //danke kleinster liebster weeeetüüüüü!! - thank you wetü
-// Music.Play;
- CTime:=0;
-// setlength(CTime_hold,0);
-
- mysdlimage:=IMG_Load('test.png');
- if assigned(mysdlimage) then
- begin
- {$IFNDEF FPC}
- showmessage('opened image via SDL_Image'+#13#10+
- 'Width: '+inttostr(mysdlimage^.w)+#13#10+
- 'Height: '+inttostr(mysdlimage^.h)+#13#10+
- 'BitsPP: '+inttostr(mysdlimage^.format.BitsPerPixel)+#13#10+
- 'BytesPP: '+inttostr(mysdlimage^.format.BytesPerPixel)+#13#10+
- 'Rloss: '+inttostr(mysdlimage^.format.Rloss)+#13#10+
- 'Gloss: '+inttostr(mysdlimage^.format.Gloss)+#13#10+
- 'Bloss: '+inttostr(mysdlimage^.format.Bloss)+#13#10+
- 'Aloss: '+inttostr(mysdlimage^.format.Aloss)+#13#10+
- 'Rshift: '+inttostr(mysdlimage^.format.Rshift)+#13#10+
- 'Gshift: '+inttostr(mysdlimage^.format.Gshift)+#13#10+
- 'Bshift: '+inttostr(mysdlimage^.format.Bshift)+#13#10+
- 'Ashift: '+inttostr(mysdlimage^.format.Ashift)+#13#10+
- 'Rmask: '+inttohexstr(mysdlimage^.format.Rmask)+#13#10+
- 'Gmask: '+inttohexstr(mysdlimage^.format.Gmask)+#13#10+
- 'Bmask: '+inttohexstr(mysdlimage^.format.Bmask)+#13#10+
- 'Amask: '+inttohexstr(mysdlimage^.format.Amask)+#13#10+
- 'ColKey: '+inttostr(mysdlimage^.format.Colorkey)+#13#10+
- 'Alpha: '+inttostr(mysdlimage^.format.Alpha));
-
- if pixfmt_eq(mysdlimage^.format^,sdl32bpprgba) then
- showmessage('equal pixelformats')
- else
- showmessage('different pixelformats');
- {$ENDIF}
-
- myconvertedsdlimage:=SDL_ConvertSurface(mysdlimage,@sdl32bpprgba,SDL_SWSURFACE);
- glGenTextures(1,@myTex);
- glBindTexture(GL_TEXTURE_2D, myTex);
- glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR );
- glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR );
- glTexImage2D( GL_TEXTURE_2D, 0, 4, myconvertedsdlimage^.w, myconvertedsdlimage^.h, 0,
- GL_RGBA, GL_UNSIGNED_BYTE, myconvertedsdlimage^.pixels );
- SDL_FreeSurface(mysdlimage);
- SDL_FreeSurface(myconvertedsdlimage);
- end
- else
- {$IFDEF FPC}
- writeln( 'could not open file - test.png');
- {$ELSE}
- showmessage('could not open file - test.png');
- {$ENDIF}
-
-end;
-
-procedure TScreenCredits.onHide;
-begin
- AudioPlayback.Stop;
-end;
-
-Procedure TScreenCredits.Draw_FunkyText;
-var
- S: Integer;
- X,Y,A: Real;
- visibleText: PChar;
-begin
- SetFontSize(10);
- //Init ScrollingText
- if (CTime = Timings[7]) then
- begin
- //Set Position of Text
- Credits_X := 600;
- CurrentScrollStart:=1;
- CurrentScrollEnd:=1;
- end;
-
- if (CTime > Timings[7]) and (CurrentScrollStart < length(Funky_Text)) then
- begin
- X:=0;
- visibleText:=pchar(Copy(Funky_Text, CurrentScrollStart, CurrentScrollEnd));
- for S := 0 to length(visibleText)-1 do begin
- Y:=abs(sin((Credits_X+X)*0.93{*(((Credits_X+X))/1200)}/100*pi));
- SetFontPos(Credits_X+X,538-Y*(Credits_X+X)*(Credits_X+X)*(Credits_X+X)/1000000);
- A:=0;
- if (Credits_X+X < 15) then A:=0;
- if (Credits_X+X >=15) then A:=Credits_X+X-15;
- if Credits_X+X > 32 then A:=17;
- glColor4f( 230/255-40/255+Y*(Credits_X+X)/900, 200/255-30/255+Y*(Credits_X+X)/1000, 155/255-20/255+Y*(Credits_X+X)/1100, A/17);
- glPrintLetter(visibleText[S]);
- X := X + Fonts[ActFont].Width[Ord(visibleText[S])] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
- end;
- if (Credits_X<0) and (CurrentScrollStart < length(Funky_Text)) then begin
- Credits_X:=Credits_X + Fonts[ActFont].Width[Ord(Funky_Text[CurrentScrollStart])] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
- inc(CurrentScrollStart);
- end;
- visibleText:=pchar(Copy(Funky_Text, CurrentScrollStart, CurrentScrollEnd));
- if (Credits_X+glTextWidth(visibleText) < 600) and (CurrentScrollEnd < length(Funky_Text)) then begin
- inc(CurrentScrollEnd);
- end;
- end;
-{ // timing hack
- X:=5;
- SetFontStyle (2);
- SetFontItalic(False);
- SetFontSize(9);
- glColor4f(1, 1, 1, 1);
- for S:=0 to high(CTime_hold) do begin
- visibleText:=pchar(inttostr(CTime_hold[S]));
- SetFontPos (500, X);
- glPrint (Addr(visibleText[0]));
- X:=X+20;
- end;}
-end;
-
-procedure Start3D;
-begin
- glMatrixMode(GL_PROJECTION);
- glPushMatrix;
- glLoadIdentity;
- glFrustum(-0.3*4/3,0.3*4/3,-0.3,0.3,1,1000);
- glMatrixMode(GL_MODELVIEW);
- glLoadIdentity;
-end;
-procedure End3D;
-begin
- glMatrixMode(GL_PROJECTION);
- glPopMatrix;
- glMatrixMode(GL_MODELVIEW);
-end;
-
-procedure TScreenCredits.DrawCredits;
-var
- T,I: Cardinal;
- X: Real;
- Ver: PChar;
- RuntimeStr: AnsiString;
- Data: TFFTData;
- j,k,l:cardinal;
- f,g,h: Real;
- STime:cardinal;
- Delay:cardinal;
-
- myPixel: longword;
- myColor: Cardinal;
- myScale: Real;
- myAngle: Real;
-
-
-const myLogoCoords: Array[0..27,0..1] of Cardinal = ((39,32),(84,32),(100,16),(125,24),
- (154,31),(156,58),(168,32),(203,36),
- (258,34),(251,50),(274,93),(294,84),
- (232,54),(278,62),(319,34),(336,92),
- (347,23),(374,32),(377,58),(361,83),
- (385,91),(405,91),(429,35),(423,51),
- (450,32),(485,34),(444,91),(486,93));
-
-begin
- //dis does teh muiwk y0r
- AudioPlayback.GetFFTData(Data);
-
- Log.LogStatus('',' JB-1');
-
- T := GetTickCount div 33;
- if T <> Credits_Time then
- begin
- Credits_Time := T;
- inc(CTime);
- inc(CTime_hold);
- Credits_X := Credits_X-2;
-
- Log.LogStatus('',' JB-2');
- if (CRDTS_Stage=InitialDelay) and (CTime=Timings[0]) then
- begin
-// CTime:=Timings[20];
-// CRDTS_Stage:=Outro;
-
- CRDTS_Stage:=Intro;
- CTime:=0;
- AudioPlayback.Play;
-
- end;
- if (CRDTS_Stage=Intro) and (CTime=Timings[7]) then
- begin
- CRDTS_Stage:=MainPart;
- end;
- if (CRDTS_Stage=MainPart) and (CTime=Timings[20]) then
- begin
- CRDTS_Stage:=Outro;
- end;
- end;
-
- Log.LogStatus('',' JB-3');
-
- //draw background
- if CRDTS_Stage=InitialDelay then
- begin
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end
- else
- if CRDTS_Stage=Intro then
- begin
- Start3D;
- glPushMatrix;
-
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
-
- if CTime < Timings[1] then begin
- myScale:= 0.5+0.5*(Timings[1]-CTime)/(Timings[1]); // slowly move layers together
- myAngle:=cos((CTime)*pi/((Timings[1])*2)); // and make logo face towards camera
- end else begin // this is the part when the logo stands still
- myScale:=0.5;
- myAngle:=0;
- end;
- if CTime > Timings[2] then begin
- myScale:= 0.5+0.5*(CTime-Timings[2])/(Timings[3]-Timings[2]); // get some space between layers
- myAngle:=0;
- end;
-// if CTime > Timings[3] then myScale:=1; // keep the space between layers
- glTranslatef(0,0,-5+0.5*myScale);
- if CTime > Timings[3] then myScale:=1; // keep the space between layers
- if CTime > Timings[3] then begin // make logo rotate left and grow
-// myScale:=(CTime-Timings[4])/(Timings[7]-Timings[4]);
- glRotatef(20*sqr(CTime-Timings[3])/sqr((Timings[7]-Timings[3])/2),0,0,1);
- glScalef(1+sqr(CTime-Timings[3])/(32*(Timings[7]-Timings[3])),1+sqr(CTime-Timings[3])/(32*(Timings[7]-Timings[3])),1);
- end;
- if CTime < Timings[2] then
- glRotatef(30*myAngle,0.5*myScale+myScale,1+myScale,0);
-// glScalef(0.5,0.5,0.5);
- glScalef(4/3,-1,1);
- glColor4f(1, 1, 1, 1);
-
- glBindTexture(GL_TEXTURE_2D, intro_layer01.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, -0.4 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, -0.4 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, -0.4 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, -0.4 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer02.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, -0.3 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, -0.3 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, -0.3 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, -0.3 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer03.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, -0.2 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, -0.2 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, -0.2 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, -0.2 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer04.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, -0.1 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, -0.1 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, -0.1 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, -0.1 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer05.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, 0 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, 0 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, 0 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, 0 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer06.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, 0.1 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, 0.1 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, 0.1 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, 0.1 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer07.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, 0.2 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, 0.2 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, 0.2 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, 0.2 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer08.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, 0.3 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, 0.3 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, 0.3 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, 0.3 * myScale);
- glEnd;
- glBindTexture(GL_TEXTURE_2D, intro_layer09.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex3f(-1, -1, 0.22 * myScale);
- glTexCoord2f(0,1);glVertex3f(-1, 1, 0.22 * myScale);
- glTexCoord2f(1,1); glVertex3f(1, 1, 0.22 * myScale);
- glTexCoord2f(1,0);glVertex3f(1, -1, 0.22 * myScale);
- glEnd;
- gldisable(gl_texture_2d);
- glDisable(GL_BLEND);
-
- glPopMatrix;
- End3D;
-
- // do some sparkling effects
- if (CTime < Timings[1]) and (CTime > Timings[21]) then
- begin
- for k:=1 to 3 do begin
- l:=410+floor((CTime-Timings[21])/(Timings[1]-Timings[21])*(536-410))+RandomRange(-5,5);
- j:=floor((Timings[1]-CTime)/22)+RandomRange(285,301);
- GoldenRec.Spawn(l, j, 1, 16, 0, -1, Flare, 0);
- end;
- end;
-
- // fade to white at end
- if Ctime > Timings[6] then
- begin
- glColor4f(1,1,1,sqr(Ctime-Timings[6])*(Ctime-Timings[6])/sqr(Timings[7]-Timings[6]));
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- glVertex2f(0,0);
- glVertex2f(0,600);
- glVertex2f(800,600);
- glVertex2f(800,0);
- glEnd;
- glDisable(GL_BLEND);
- end;
-
- end;
- if (CRDTS_Stage=MainPart) then
- // main credits screen background, scroller, logo and girl
- begin
-
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
-
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, credits_bg_tex.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(0, 0);
- glTexCoord2f(0,600/1024);glVertex2f(0, 600);
- glTexCoord2f(800/1024,600/1024); glVertex2f(800, 600);
- glTexCoord2f(800/1024,0);glVertex2f(800, 0);
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // draw scroller
- Draw_FunkyText;
-
-//#########################################################################
-// draw credits names
-
-
-Log.LogStatus('',' JB-4');
-
-// BlindGuard (von links oben reindrehen, nach rechts unten rausdrehen) - (rotate in from upper left, rotate out to lower right)
- STime:=Timings[9]-10;
- Delay:=Timings[10]-Timings[9];
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(0,329,0);
- if CTime <= STime+10 then begin glrotatef((CTime-STime)*9+270,0,0,1);end;
- gltranslatef(223,0,0);
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- gltranslatef(223,0,0);
- glrotatef((integer(CTime)-(integer(STime+Delay)-10))*-9,0,0,1);
- gltranslatef(-223,0,0);
- end;
- glBindTexture(GL_TEXTURE_2D, credits_blindguard.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Blindy (zoom von 0 auf volle grösse und drehung, zoom auf doppelte grösse und nach rechts oben schieben) - (zoom from 0 to full size and rotation, zoom zo doubble size and shift to upper right)
- STime:=Timings[10]-10;
- Delay:=Timings[11]-Timings[10]+5;
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+20) and (CTime<=STime+22) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+20 then begin
- j:=CTime-Stime;
- glscalef(j*j/400,j*j/400,j*j/400);
- glrotatef(j*18.0,0,0,1);
- end;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=CTime-(STime+Delay-10);
- f:=j*10.0;
- gltranslatef(f*3,-f,0);
- glscalef(1+j/10,1+j/10,1+j/10);
- glrotatef(j*9.0,0,0,1);
- end;
- glBindTexture(GL_TEXTURE_2D, credits_blindy.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Canni (von links reinschieben, nach rechts oben rausschieben) - (shift in from left, shift out to upper right)
- STime:=Timings[11]-10;
- Delay:=Timings[12]-Timings[11]+5;
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then begin
- gltranslatef(((CTime-STime)*21.0)-210,0,0);
- end;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=(CTime-(STime+Delay-10))*21;
- gltranslatef(j,-j/2,0);
- end;
- glBindTexture(GL_TEXTURE_2D, credits_canni.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Commandio (von unten reinklappen, nach rechts oben rausklappen) - (flip in from down, flip out to upper right)
- STime:=Timings[12]-10;
- Delay:=Timings[13]-Timings[12];
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then
- f:=258.0-25.8*(CTime-STime)
- else
- f:=0;
- g:=0;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=CTime-(STime+Delay-10);
- g:=32.6*j;
- end;
- glBindTexture(GL_TEXTURE_2D, credits_commandio.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163+g-f*1.5, -129+f*1.5-g/2);
- glTexCoord2f(0,1);glVertex2f(-163+g*1.5, 129-(g*1.5*258/326));
- glTexCoord2f(1,1); glVertex2f(163+g, 129+g/4);
- glTexCoord2f(1,0);glVertex2f(163+f*1.5+g/4, -129+f*1.5-g/4);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// lazy joker (just scrolls from left to right, no twinkling stars, no on-beat flashing)
- STime:=Timings[13]-35;
- Delay:=Timings[14]-Timings[13]+5;
- if CTime > STime then
- begin
- k:=0;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)>10) and ((CTime-STime)<20) then ESC_Alpha:=20;
- ESC_Alpha:=10;
- f:=CTime-STime;
- if CTime <=STime+40 then j:=CTime-STime else j:=40;
- if (CTime >=STime+Delay-40) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j*j/1600);
-
- glPushMatrix;
- gltranslatef(180+(f-70),329,0);
- glBindTexture(GL_TEXTURE_2D, credits_lazyjoker.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Mog (von links reinklappen, nach rechts unten rausklappen) - (flip in from right, flip out to lower right)
- STime:=Timings[14]-10;
- Delay:=Timings[15]-Timings[14]+5;
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then
- f:=326.0-32.6*(CTime-STime)
- else
- f:=0;
-
- g:=0;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=CTime-(STime+Delay-10);
- g:=32.6*j;
- end;
- glBindTexture(GL_TEXTURE_2D, credits_mog.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163+g*1.5, -129+g*1.5);
- glTexCoord2f(0,1);glVertex2f(-163+g*1.2, 129+g);
- glTexCoord2f(1,1); glVertex2f(163-f+g/2, 129+f*1.5+g/4);
- glTexCoord2f(1,0);glVertex2f(163-f+g*1.5, -129-f*1.5);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Mota (von rechts oben reindrehen, nach links unten rausschieben und verkleinern und dabei drehen) - (rotate in from upper right, shift out to lower left while shrinking and rotateing)
- STime:=Timings[15]-10;
- Delay:=Timings[16]-Timings[15]+5;
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then begin
- gltranslatef(223,0,0);
- glrotatef((10-(CTime-STime))*9,0,0,1);
- gltranslatef(-223,0,0);
- end;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=CTime-(STime+Delay-10);
- f:=j*10.0;
- gltranslatef(-f*2,-f,0);
- glscalef(1-j/10,1-j/10,1-j/10);
- glrotatef(-j*9.0,0,0,1);
- end;
- glBindTexture(GL_TEXTURE_2D, credits_mota.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// Skillmaster (von rechts unten reinschieben, nach rechts oben rausdrehen) - (shift in from lower right, rotate out to upper right)
- STime:=Timings[16]-10;
- Delay:=Timings[17]-Timings[16]+5;
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then begin
- j:=STime+10-CTime;
- f:=j*10.0;
- gltranslatef(+f*2,+f/2,0);
- end;
- if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin
- j:=CTime-(STime+Delay-10);
- gltranslatef(0,-223,0);
- glrotatef(integer(j)*-9,0,0,1);
- gltranslatef(0,223,0);
- glrotatef(j*9,0,0,1);
- end;
- glBindTexture(GL_TEXTURE_2D, credits_skillmaster.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163, -129);
- glTexCoord2f(0,1);glVertex2f(-163, 129);
- glTexCoord2f(1,1); glVertex2f(163, 129);
- glTexCoord2f(1,0);glVertex2f(163, -129);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-// WhiteShark (von links unten reinklappen, nach rechts oben rausklappen) - (flip in from lower left, flip out to upper right)
- STime:=Timings[17]-10;
- Delay:=Timings[18]-Timings[17];
- if CTime > STime then
- begin
- k:=0;
- ESC_Alpha:=20;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
-
- if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha);
- if ESC_Alpha >20 then ESC_Alpha:=20;
- if ((CTime-STime)<20) then ESC_Alpha:=20;
- if CTime <=STime+10 then j:=CTime-STime else j:=10;
- if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0;
- glColor4f(1, 1, 1, ESC_Alpha/20*j/10);
-
- if (CTime >= STime+10) and (CTime<=STime+12) then begin
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1);
- GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5);
- end;
-
- glPushMatrix;
- gltranslatef(223,329,0);
- if CTime <= STime+10 then
- f:=326.0-32.6*(CTime-STime)
- else
- f:=0;
-
- if (CTime >= STime+Delay-10) and (CTime <= STime+Delay) then
- begin
- j:=CTime-(STime+Delay-10);
- g:=32.6*j;
- end
- else
- begin
- g:=0;
- end;
-
- glBindTexture(GL_TEXTURE_2D, credits_whiteshark.TexNum);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(-163-f+g, -129+f/4-g/2);
- glTexCoord2f(0,1);glVertex2f(-163-f/4+g, 129+g/2+f/4);
- glTexCoord2f(1,1); glVertex2f(163-f*1.2+g/4, 129+f/2-g/4);
- glTexCoord2f(1,0);glVertex2f(163-f*1.5+g/4, -129+f*1.5+g/4);
- glEnd;
- gldisable(gl_texture_2d);
- gldisable(GL_BLEND);
- glPopMatrix;
- end;
-
-
- Log.LogStatus('',' JB-103');
-
-// ####################################################################
-// do some twinkle stuff (kinda on beat)
- if (CTime > Timings[8] ) and
- (CTime < Timings[19] ) then
- begin
- k := 0;
-
- try
- for j:=0 to 40 do
- begin
- if ( j < length( Data ) ) AND
- ( k < length( Data ) ) then
- begin
- if Data[j] >= Data[k] then
- k:=j;
- end;
- end;
- except
- end;
-
- if Data[k]>0.2 then
- begin
- l := RandomRange(6,16);
- j := RandomRange(0,27);
-
- GoldenRec.Spawn(myLogoCoords[j,0], myLogoCoords[j,1], 16-l, l, 0, -1, PerfectNote, 0);
- end;
- end;
-
-//#################################################
-// draw the rest of the main screen (girl and logo
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, credits_bg_ovl.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(800-393, 0);
- glTexCoord2f(0,600/1024);glVertex2f(800-393, 600);
- glTexCoord2f(393/512,600/1024); glVertex2f(800, 600);
- glTexCoord2f(393/512,0);glVertex2f(800, 0);
- glEnd;
-{ glBindTexture(GL_TEXTURE_2D, credits_bg_logo.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(0, 0);
- glTexCoord2f(0,112/128);glVertex2f(0, 112);
- glTexCoord2f(497/512,112/128); glVertex2f(497, 112);
- glTexCoord2f(497/512,0);glVertex2f(497, 0);
- glEnd;
-}
- gldisable(gl_texture_2d);
- glDisable(GL_BLEND);
-
- // fade out at end of main part
- if Ctime > Timings[19] then
- begin
- glColor4f(0,0,0,(Ctime-Timings[19])/(Timings[20]-Timings[19]));
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- glVertex2f(0,0);
- glVertex2f(0,600);
- glVertex2f(800,600);
- glVertex2f(800,0);
- glEnd;
- glDisable(GL_BLEND);
- end;
- end
- else
- if (CRDTS_Stage=Outro) then
- begin
- if CTime=Timings[20] then begin
- CTime_hold:=0;
- AudioPlayback.Stop;
- AudioPlayback.Open(soundpath + 'credits-outro-tune.mp3');
- AudioPlayback.Play;
- AudioPlayback.SetVolume(20);
- AudioPlayback.SetLoop(True);
- end;
- if CTime_hold > 231 then begin
- AudioPlayback.Play;
- Ctime_hold:=0;
- end;
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- // do something useful
- // outro background
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
-
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, outro_bg.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(0, 0);
- glTexCoord2f(0,600/1024);glVertex2f(0, 600);
- glTexCoord2f(800/1024,600/1024); glVertex2f(800, 600);
- glTexCoord2f(800/1024,0);glVertex2f(800, 0);
- glEnd;
-
- //outro overlays
- glColor4f(1, 1, 1, (1+sin(CTime/15))/3+1/3);
- glBindTexture(GL_TEXTURE_2D, outro_esc.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(0, 0);
- glTexCoord2f(0,223/256);glVertex2f(0, 223);
- glTexCoord2f(487/512,223/256); glVertex2f(487, 223);
- glTexCoord2f(487/512,0);glVertex2f(487, 0);
- glEnd;
-
- ESC_Alpha:=20;
- if (RandomRange(0,20) > 18) and (ESC_Alpha=20) then
- ESC_Alpha:=0
- else inc(ESC_Alpha);
- if ESC_Alpha > 20 then ESC_Alpha:=20;
- glColor4f(1, 1, 1, ESC_Alpha/20);
- glBindTexture(GL_TEXTURE_2D, outro_exd.TexNum);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(800-310, 600-247);
- glTexCoord2f(0,247/256);glVertex2f(800-310, 600);
- glTexCoord2f(310/512,247/256); glVertex2f(800, 600);
- glTexCoord2f(310/512,0);glVertex2f(800, 600-247);
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // outro scrollers?
- // ...
- end;
-
-{ // draw credits runtime counter
- SetFontStyle (2);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (5, 5);
- glColor4f(1, 1, 1, 1);
-// RuntimeStr:='CTime: '+inttostr(floor(CTime/30.320663991914489602156136106092))+'.'+inttostr(floor(CTime/3.0320663991914489602156136106092)-floor(CTime/30.320663991914489602156136106092)*10);
- RuntimeStr:='CTime: '+inttostr(CTime);
- glPrint (Addr(RuntimeStr[1]));
-}
-
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, myTex);
- glbegin(gl_quads);
- glTexCoord2f(0,0);glVertex2f(100, 100);
- glTexCoord2f(0,1);glVertex2f(100, 200);
- glTexCoord2f(1,1); glVertex2f(200, 200);
- glTexCoord2f(1,0);glVertex2f(200, 100);
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
-
- // make the stars shine
- GoldenRec.Draw;
-end;
-
-end.
+unit UScreenCredits; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + UMenu, + SDL, + SDL_Image, + UDisplay, + UTexture, + OpenGL12, + UMusic, + UFiles, + SysUtils, + UThemes, + ULCD, + ULight, + UGraphicClasses; + +type + TCreditsStages=(InitialDelay,Intro,MainPart,Outro); + + TScreenCredits = class(TMenu) + public + + Credits_X: Real; + Credits_Time: Cardinal; + Credits_Alpha: Cardinal; + CTime: Cardinal; + CTime_hold: Cardinal; + ESC_Alpha: Integer; + + credits_entry_tex: TTexture; + credits_entry_dx_tex: TTexture; + credits_bg_tex: TTexture; + credits_bg_ovl: TTexture; +// credits_bg_logo: TTexture; + credits_bg_scrollbox_left: TTexture; + credits_blindguard: TTexture; + credits_blindy: TTexture; + credits_canni: TTexture; + credits_commandio: TTexture; + credits_lazyjoker: TTexture; + credits_mog: TTexture; + credits_mota: TTexture; + credits_skillmaster: TTexture; + credits_whiteshark: TTexture; + intro_layer01: TTexture; + intro_layer02: TTexture; + intro_layer03: TTexture; + intro_layer04: TTexture; + intro_layer05: TTexture; + intro_layer06: TTexture; + intro_layer07: TTexture; + intro_layer08: TTexture; + intro_layer09: TTexture; + outro_bg: TTexture; + outro_esc: TTexture; + outro_exd: TTexture; + + deluxe_slidein: cardinal; + + CurrentScrollText: String; + NextScrollUpdate: Real; + EndofLastScrollingPart: Cardinal; + CurrentScrollStart, CurrentScrollEnd: Integer; + + CRDTS_Stage: TCreditsStages; + + myTex: glUint; + mysdlimage,myconvertedsdlimage: PSDL_Surface; + + Fadeout: boolean; + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + function Draw: boolean; override; + procedure onShow; override; + procedure onHide; override; + procedure DrawCredits; + procedure Draw_FunkyText; + end; + +const + Funky_Text: AnsiString = + 'Grandma Deluxe has arrived! Thanks to Corvus5 for the massive work on UltraStar, Wome for the nice tune you´re hearing, '+ + 'all the people who put massive effort and work in new songs (don´t forget UltraStar w/o songs would be nothing), ppl from '+ + 'irc helping us - eBandit and Gabari, scene ppl who really helped instead of compiling and running away. Greetings to DennisTheMenace for betatesting, '+ + 'Demoscene.tv, pouet.net, KakiArts, Sourceforge,..'; + + + Timings: array[0..21] of Cardinal=( + 20, // 0 Delay vor Start + + 149, // 1 Ende erster Intro Zoom + 155, // 2 Start 2. Action im Intro + 170, // 3 Ende Separation im Intro + 271, // 4 Anfang Zoomout im Intro + 0, // 5 unused + 261, // 6 Start fade-to-white im Intro + + 271, // 7 Start Main Part + 280, // 8 Start On-Beat-Sternchen Main Part + + 396, // 9 Start BlindGuard + 666, // 10 Start blindy + 936, // 11 Start Canni + 1206, // 12 Start Commandio + 1476, // 13 Start LazyJoker + 1746, // 14 Start Mog + 2016, // 15 Start Mota + 2286, // 16 Start SkillMaster + 2556, // 17 Start WhiteShark + 2826, // 18 Ende Whiteshark + 3096, // 19 Start FadeOut Mainscreen + 3366, // 20 Ende Credits Tune + 60); // 21 start flare im intro + + + sdl32bpprgba: TSDL_Pixelformat=(palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 24; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $ff000000; + colorkey: 0; + alpha: 255 ); + + +implementation + +uses {$IFDEF win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + ULog, + UGraphic, + UMain, + UIni, + USongs, + Textgl, + ULanguage, + UCommon, + Math, + dialogs; + + +function TScreenCredits.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + FadeTo(@ScreenMain); + AudioPlayback.PlaySound(SoundLib.Back); + end; +{ SDLK_SPACE: + begin + setlength(CTime_hold,length(CTime_hold)+1); + CTime_hold[high(CTime_hold)]:=CTime; + end; +} + end;//esac + end; //fi +end; + +constructor TScreenCredits.Create; +begin + inherited Create; + + credits_bg_tex := Texture.LoadTexture(true, 'CRDTS_BG', 'PNG', 'Plain', 0); + credits_bg_ovl := Texture.LoadTexture(true, 'CRDTS_OVL', 'PNG', 'Transparent', 0); + + credits_blindguard := Texture.LoadTexture(true, 'CRDTS_blindguard', 'PNG', 'Font Black', 0); + credits_blindy := Texture.LoadTexture(true, 'CRDTS_blindy', 'PNG', 'Font Black', 0); + credits_canni := Texture.LoadTexture(true, 'CRDTS_canni', 'PNG', 'Font Black', 0); + credits_commandio := Texture.LoadTexture(true, 'CRDTS_commandio', 'PNG', 'Font Black', 0); + credits_lazyjoker := Texture.LoadTexture(true, 'CRDTS_lazyjoker', 'PNG', 'Font Black', 0); + credits_mog := Texture.LoadTexture(true, 'CRDTS_mog', 'PNG', 'Font Black', 0); + credits_mota := Texture.LoadTexture(true, 'CRDTS_mota', 'PNG', 'Font Black', 0); + credits_skillmaster := Texture.LoadTexture(true, 'CRDTS_skillmaster', 'PNG', 'Font Black', 0); + credits_whiteshark := Texture.LoadTexture(true, 'CRDTS_whiteshark', 'PNG', 'Font Black', 0); + + intro_layer01 := Texture.LoadTexture(true, 'INTRO_L01', 'PNG', 'Transparent', 0); + intro_layer02 := Texture.LoadTexture(true, 'INTRO_L02', 'PNG', 'Transparent', 0); + intro_layer03 := Texture.LoadTexture(true, 'INTRO_L03', 'PNG', 'Transparent', 0); + intro_layer04 := Texture.LoadTexture(true, 'INTRO_L04', 'PNG', 'Transparent', 0); + intro_layer05 := Texture.LoadTexture(true, 'INTRO_L05', 'PNG', 'Transparent', 0); + intro_layer06 := Texture.LoadTexture(true, 'INTRO_L06', 'PNG', 'Transparent', 0); + intro_layer07 := Texture.LoadTexture(true, 'INTRO_L07', 'PNG', 'Transparent', 0); + intro_layer08 := Texture.LoadTexture(true, 'INTRO_L08', 'PNG', 'Transparent', 0); + intro_layer09 := Texture.LoadTexture(true, 'INTRO_L09', 'PNG', 'Transparent', 0); + + outro_bg := Texture.LoadTexture(true, 'OUTRO_BG', 'PNG', 'Plain', 0); + outro_esc := Texture.LoadTexture(true, 'OUTRO_ESC', 'PNG', 'Transparent', 0); + outro_exd := Texture.LoadTexture(true, 'OUTRO_EXD', 'PNG', 'Transparent', 0); + + CRDTS_Stage:=InitialDelay; +end; + +function TScreenCredits.Draw: boolean; +begin + DrawCredits; + Draw:=true; +end; + +function pixfmt_eq(fmt1,fmt2: TSDL_Pixelformat): boolean; +begin + if (fmt1.BitsPerPixel = fmt2.BitsPerPixel) and + (fmt1.BytesPerPixel = fmt2.BytesPerPixel) and + (fmt1.Rloss = fmt2.Rloss) and + (fmt1.Gloss = fmt2.Gloss) and + (fmt1.Bloss = fmt2.Bloss) and + (fmt1.Rmask = fmt2.Rmask) and + (fmt1.Gmask = fmt2.Gmask) and + (fmt1.Bmask = fmt2.Bmask) and + (fmt1.Rshift = fmt2.Rshift) and + (fmt1.Gshift = fmt2.Gshift) and + (fmt1.Bshift = fmt2.Bshift) + then + pixfmt_eq:=True + else + pixfmt_eq:=False; +end; + +function inttohexstr(i: cardinal):pchar; +var helper, i2, c:cardinal; + tmpstr: string; +begin + helper:=0; + i2:=i; + tmpstr:=''; + for c:=1 to 8 do + begin + helper:=(helper shl 4) or (i2 and $f); + i2:=i2 shr 4; + end; + for c:=1 to 8 do + begin + i2:=helper and $f; + helper := helper shr 4; + case i2 of + 0: tmpstr:=tmpstr+'0'; + 1: tmpstr:=tmpstr+'1'; + 2: tmpstr:=tmpstr+'2'; + 3: tmpstr:=tmpstr+'3'; + 4: tmpstr:=tmpstr+'4'; + 5: tmpstr:=tmpstr+'5'; + 6: tmpstr:=tmpstr+'6'; + 7: tmpstr:=tmpstr+'7'; + 8: tmpstr:=tmpstr+'8'; + 9: tmpstr:=tmpstr+'9'; + 10: tmpstr:=tmpstr+'a'; + 11: tmpstr:=tmpstr+'b'; + 12: tmpstr:=tmpstr+'c'; + 13: tmpstr:=tmpstr+'d'; + 14: tmpstr:=tmpstr+'e'; + 15: tmpstr:=tmpstr+'f'; + end; + end; + inttohexstr:=pchar(tmpstr); +end; + +procedure TScreenCredits.onShow; +begin + inherited; + + CRDTS_Stage:=InitialDelay; + Credits_X := 580; + deluxe_slidein := 0; + Credits_Alpha := 0; + //Music.SetLoop(true); Loop looped ned, so ne scheisse - loop loops not, shit + AudioPlayback.Open(soundpath + 'wome-credits-tune.mp3'); //danke kleinster liebster weeeetüüüüü!! - thank you wetü +// Music.Play; + CTime:=0; +// setlength(CTime_hold,0); + + mysdlimage:=IMG_Load('test.png'); + if assigned(mysdlimage) then + begin + {$IFNDEF FPC} + showmessage('opened image via SDL_Image'+#13#10+ + 'Width: '+inttostr(mysdlimage^.w)+#13#10+ + 'Height: '+inttostr(mysdlimage^.h)+#13#10+ + 'BitsPP: '+inttostr(mysdlimage^.format.BitsPerPixel)+#13#10+ + 'BytesPP: '+inttostr(mysdlimage^.format.BytesPerPixel)+#13#10+ + 'Rloss: '+inttostr(mysdlimage^.format.Rloss)+#13#10+ + 'Gloss: '+inttostr(mysdlimage^.format.Gloss)+#13#10+ + 'Bloss: '+inttostr(mysdlimage^.format.Bloss)+#13#10+ + 'Aloss: '+inttostr(mysdlimage^.format.Aloss)+#13#10+ + 'Rshift: '+inttostr(mysdlimage^.format.Rshift)+#13#10+ + 'Gshift: '+inttostr(mysdlimage^.format.Gshift)+#13#10+ + 'Bshift: '+inttostr(mysdlimage^.format.Bshift)+#13#10+ + 'Ashift: '+inttostr(mysdlimage^.format.Ashift)+#13#10+ + 'Rmask: '+inttohexstr(mysdlimage^.format.Rmask)+#13#10+ + 'Gmask: '+inttohexstr(mysdlimage^.format.Gmask)+#13#10+ + 'Bmask: '+inttohexstr(mysdlimage^.format.Bmask)+#13#10+ + 'Amask: '+inttohexstr(mysdlimage^.format.Amask)+#13#10+ + 'ColKey: '+inttostr(mysdlimage^.format.Colorkey)+#13#10+ + 'Alpha: '+inttostr(mysdlimage^.format.Alpha)); + + if pixfmt_eq(mysdlimage^.format^,sdl32bpprgba) then + showmessage('equal pixelformats') + else + showmessage('different pixelformats'); + {$ENDIF} + + myconvertedsdlimage:=SDL_ConvertSurface(mysdlimage,@sdl32bpprgba,SDL_SWSURFACE); + glGenTextures(1,@myTex); + glBindTexture(GL_TEXTURE_2D, myTex); + glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR ); + glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR ); + glTexImage2D( GL_TEXTURE_2D, 0, 4, myconvertedsdlimage^.w, myconvertedsdlimage^.h, 0, + GL_RGBA, GL_UNSIGNED_BYTE, myconvertedsdlimage^.pixels ); + SDL_FreeSurface(mysdlimage); + SDL_FreeSurface(myconvertedsdlimage); + end + else + {$IFDEF FPC} + writeln( 'could not open file - test.png'); + {$ELSE} + showmessage('could not open file - test.png'); + {$ENDIF} + +end; + +procedure TScreenCredits.onHide; +begin + AudioPlayback.Stop; +end; + +Procedure TScreenCredits.Draw_FunkyText; +var + S: Integer; + X,Y,A: Real; + visibleText: PChar; +begin + SetFontSize(10); + //Init ScrollingText + if (CTime = Timings[7]) then + begin + //Set Position of Text + Credits_X := 600; + CurrentScrollStart:=1; + CurrentScrollEnd:=1; + end; + + if (CTime > Timings[7]) and (CurrentScrollStart < length(Funky_Text)) then + begin + X:=0; + visibleText:=pchar(Copy(Funky_Text, CurrentScrollStart, CurrentScrollEnd)); + for S := 0 to length(visibleText)-1 do begin + Y:=abs(sin((Credits_X+X)*0.93{*(((Credits_X+X))/1200)}/100*pi)); + SetFontPos(Credits_X+X,538-Y*(Credits_X+X)*(Credits_X+X)*(Credits_X+X)/1000000); + A:=0; + if (Credits_X+X < 15) then A:=0; + if (Credits_X+X >=15) then A:=Credits_X+X-15; + if Credits_X+X > 32 then A:=17; + glColor4f( 230/255-40/255+Y*(Credits_X+X)/900, 200/255-30/255+Y*(Credits_X+X)/1000, 155/255-20/255+Y*(Credits_X+X)/1100, A/17); + glPrintLetter(visibleText[S]); + X := X + Fonts[ActFont].Width[Ord(visibleText[S])] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; + if (Credits_X<0) and (CurrentScrollStart < length(Funky_Text)) then begin + Credits_X:=Credits_X + Fonts[ActFont].Width[Ord(Funky_Text[CurrentScrollStart])] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + inc(CurrentScrollStart); + end; + visibleText:=pchar(Copy(Funky_Text, CurrentScrollStart, CurrentScrollEnd)); + if (Credits_X+glTextWidth(visibleText) < 600) and (CurrentScrollEnd < length(Funky_Text)) then begin + inc(CurrentScrollEnd); + end; + end; +{ // timing hack + X:=5; + SetFontStyle (2); + SetFontItalic(False); + SetFontSize(9); + glColor4f(1, 1, 1, 1); + for S:=0 to high(CTime_hold) do begin + visibleText:=pchar(inttostr(CTime_hold[S])); + SetFontPos (500, X); + glPrint (Addr(visibleText[0])); + X:=X+20; + end;} +end; + +procedure Start3D; +begin + glMatrixMode(GL_PROJECTION); + glPushMatrix; + glLoadIdentity; + glFrustum(-0.3*4/3,0.3*4/3,-0.3,0.3,1,1000); + glMatrixMode(GL_MODELVIEW); + glLoadIdentity; +end; +procedure End3D; +begin + glMatrixMode(GL_PROJECTION); + glPopMatrix; + glMatrixMode(GL_MODELVIEW); +end; + +procedure TScreenCredits.DrawCredits; +var +T{*, I*}: Cardinal; // Auto Removed, Unused Variable (I) // Auto Removed, Unused Variable (I) +// X: Real; // Auto Removed, Unused Variable +// Ver: PChar; // Auto Removed, Unused Variable +// RuntimeStr: AnsiString; // Auto Removed, Unused Variable + Data: TFFTData; + j,k,l:cardinal; +f,g{*, h*}: Real; // Auto Removed, Unused Variable (h) // Auto Removed, Unused Variable (h) + STime:cardinal; + Delay:cardinal; + +// myPixel: longword; // Auto Removed, Unused Variable +// myColor: Cardinal; // Auto Removed, Unused Variable + myScale: Real; + myAngle: Real; + + +const myLogoCoords: Array[0..27,0..1] of Cardinal = ((39,32),(84,32),(100,16),(125,24), + (154,31),(156,58),(168,32),(203,36), + (258,34),(251,50),(274,93),(294,84), + (232,54),(278,62),(319,34),(336,92), + (347,23),(374,32),(377,58),(361,83), + (385,91),(405,91),(429,35),(423,51), + (450,32),(485,34),(444,91),(486,93)); + +begin + //dis does teh muiwk y0r + AudioPlayback.GetFFTData(Data); + + Log.LogStatus('',' JB-1'); + + T := GetTickCount div 33; + if T <> Credits_Time then + begin + Credits_Time := T; + inc(CTime); + inc(CTime_hold); + Credits_X := Credits_X-2; + + Log.LogStatus('',' JB-2'); + if (CRDTS_Stage=InitialDelay) and (CTime=Timings[0]) then + begin +// CTime:=Timings[20]; +// CRDTS_Stage:=Outro; + + CRDTS_Stage:=Intro; + CTime:=0; + AudioPlayback.Play; + + end; + if (CRDTS_Stage=Intro) and (CTime=Timings[7]) then + begin + CRDTS_Stage:=MainPart; + end; + if (CRDTS_Stage=MainPart) and (CTime=Timings[20]) then + begin + CRDTS_Stage:=Outro; + end; + end; + + Log.LogStatus('',' JB-3'); + + //draw background + if CRDTS_Stage=InitialDelay then + begin + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end + else + if CRDTS_Stage=Intro then + begin + Start3D; + glPushMatrix; + + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + if CTime < Timings[1] then begin + myScale:= 0.5+0.5*(Timings[1]-CTime)/(Timings[1]); // slowly move layers together + myAngle:=cos((CTime)*pi/((Timings[1])*2)); // and make logo face towards camera + end else begin // this is the part when the logo stands still + myScale:=0.5; + myAngle:=0; + end; + if CTime > Timings[2] then begin + myScale:= 0.5+0.5*(CTime-Timings[2])/(Timings[3]-Timings[2]); // get some space between layers + myAngle:=0; + end; +// if CTime > Timings[3] then myScale:=1; // keep the space between layers + glTranslatef(0,0,-5+0.5*myScale); + if CTime > Timings[3] then myScale:=1; // keep the space between layers + if CTime > Timings[3] then begin // make logo rotate left and grow +// myScale:=(CTime-Timings[4])/(Timings[7]-Timings[4]); + glRotatef(20*sqr(CTime-Timings[3])/sqr((Timings[7]-Timings[3])/2),0,0,1); + glScalef(1+sqr(CTime-Timings[3])/(32*(Timings[7]-Timings[3])),1+sqr(CTime-Timings[3])/(32*(Timings[7]-Timings[3])),1); + end; + if CTime < Timings[2] then + glRotatef(30*myAngle,0.5*myScale+myScale,1+myScale,0); +// glScalef(0.5,0.5,0.5); + glScalef(4/3,-1,1); + glColor4f(1, 1, 1, 1); + + glBindTexture(GL_TEXTURE_2D, intro_layer01.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, -0.4 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, -0.4 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, -0.4 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, -0.4 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer02.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, -0.3 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, -0.3 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, -0.3 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, -0.3 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer03.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, -0.2 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, -0.2 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, -0.2 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, -0.2 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer04.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, -0.1 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, -0.1 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, -0.1 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, -0.1 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer05.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, 0 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, 0 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, 0 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, 0 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer06.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, 0.1 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, 0.1 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, 0.1 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, 0.1 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer07.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, 0.2 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, 0.2 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, 0.2 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, 0.2 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer08.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, 0.3 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, 0.3 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, 0.3 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, 0.3 * myScale); + glEnd; + glBindTexture(GL_TEXTURE_2D, intro_layer09.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex3f(-1, -1, 0.22 * myScale); + glTexCoord2f(0,1);glVertex3f(-1, 1, 0.22 * myScale); + glTexCoord2f(1,1); glVertex3f(1, 1, 0.22 * myScale); + glTexCoord2f(1,0);glVertex3f(1, -1, 0.22 * myScale); + glEnd; + gldisable(gl_texture_2d); + glDisable(GL_BLEND); + + glPopMatrix; + End3D; + + // do some sparkling effects + if (CTime < Timings[1]) and (CTime > Timings[21]) then + begin + for k:=1 to 3 do begin + l:=410+floor((CTime-Timings[21])/(Timings[1]-Timings[21])*(536-410))+RandomRange(-5,5); + j:=floor((Timings[1]-CTime)/22)+RandomRange(285,301); + GoldenRec.Spawn(l, j, 1, 16, 0, -1, Flare, 0); + end; + end; + + // fade to white at end + if Ctime > Timings[6] then + begin + glColor4f(1,1,1,sqr(Ctime-Timings[6])*(Ctime-Timings[6])/sqr(Timings[7]-Timings[6])); + glEnable(GL_BLEND); + glBegin(GL_QUADS); + glVertex2f(0,0); + glVertex2f(0,600); + glVertex2f(800,600); + glVertex2f(800,0); + glEnd; + glDisable(GL_BLEND); + end; + + end; + if (CRDTS_Stage=MainPart) then + // main credits screen background, scroller, logo and girl + begin + + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, credits_bg_tex.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(0, 0); + glTexCoord2f(0,600/1024);glVertex2f(0, 600); + glTexCoord2f(800/1024,600/1024); glVertex2f(800, 600); + glTexCoord2f(800/1024,0);glVertex2f(800, 0); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // draw scroller + Draw_FunkyText; + +//######################################################################### +// draw credits names + + +Log.LogStatus('',' JB-4'); + +// BlindGuard (von links oben reindrehen, nach rechts unten rausdrehen) - (rotate in from upper left, rotate out to lower right) + STime:=Timings[9]-10; + Delay:=Timings[10]-Timings[9]; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(0,329,0); + if CTime <= STime+10 then begin glrotatef((CTime-STime)*9+270,0,0,1);end; + gltranslatef(223,0,0); + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + gltranslatef(223,0,0); + glrotatef((integer(CTime)-(integer(STime+Delay)-10))*-9,0,0,1); + gltranslatef(-223,0,0); + end; + glBindTexture(GL_TEXTURE_2D, credits_blindguard.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Blindy (zoom von 0 auf volle grösse und drehung, zoom auf doppelte grösse und nach rechts oben schieben) - (zoom from 0 to full size and rotation, zoom zo doubble size and shift to upper right) + STime:=Timings[10]-10; + Delay:=Timings[11]-Timings[10]+5; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+20) and (CTime<=STime+22) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+20 then begin + j:=CTime-Stime; + glscalef(j*j/400,j*j/400,j*j/400); + glrotatef(j*18.0,0,0,1); + end; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=CTime-(STime+Delay-10); + f:=j*10.0; + gltranslatef(f*3,-f,0); + glscalef(1+j/10,1+j/10,1+j/10); + glrotatef(j*9.0,0,0,1); + end; + glBindTexture(GL_TEXTURE_2D, credits_blindy.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Canni (von links reinschieben, nach rechts oben rausschieben) - (shift in from left, shift out to upper right) + STime:=Timings[11]-10; + Delay:=Timings[12]-Timings[11]+5; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then begin + gltranslatef(((CTime-STime)*21.0)-210,0,0); + end; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=(CTime-(STime+Delay-10))*21; + gltranslatef(j,-j/2,0); + end; + glBindTexture(GL_TEXTURE_2D, credits_canni.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Commandio (von unten reinklappen, nach rechts oben rausklappen) - (flip in from down, flip out to upper right) + STime:=Timings[12]-10; + Delay:=Timings[13]-Timings[12]; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then + f:=258.0-25.8*(CTime-STime) + else + f:=0; + g:=0; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=CTime-(STime+Delay-10); + g:=32.6*j; + end; + glBindTexture(GL_TEXTURE_2D, credits_commandio.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163+g-f*1.5, -129+f*1.5-g/2); + glTexCoord2f(0,1);glVertex2f(-163+g*1.5, 129-(g*1.5*258/326)); + glTexCoord2f(1,1); glVertex2f(163+g, 129+g/4); + glTexCoord2f(1,0);glVertex2f(163+f*1.5+g/4, -129+f*1.5-g/4); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// lazy joker (just scrolls from left to right, no twinkling stars, no on-beat flashing) + STime:=Timings[13]-35; + Delay:=Timings[14]-Timings[13]+5; + if CTime > STime then + begin + k:=0; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)>10) and ((CTime-STime)<20) then ESC_Alpha:=20; + ESC_Alpha:=10; + f:=CTime-STime; + if CTime <=STime+40 then j:=CTime-STime else j:=40; + if (CTime >=STime+Delay-40) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j*j/1600); + + glPushMatrix; + gltranslatef(180+(f-70),329,0); + glBindTexture(GL_TEXTURE_2D, credits_lazyjoker.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Mog (von links reinklappen, nach rechts unten rausklappen) - (flip in from right, flip out to lower right) + STime:=Timings[14]-10; + Delay:=Timings[15]-Timings[14]+5; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then + f:=326.0-32.6*(CTime-STime) + else + f:=0; + + g:=0; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=CTime-(STime+Delay-10); + g:=32.6*j; + end; + glBindTexture(GL_TEXTURE_2D, credits_mog.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163+g*1.5, -129+g*1.5); + glTexCoord2f(0,1);glVertex2f(-163+g*1.2, 129+g); + glTexCoord2f(1,1); glVertex2f(163-f+g/2, 129+f*1.5+g/4); + glTexCoord2f(1,0);glVertex2f(163-f+g*1.5, -129-f*1.5); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Mota (von rechts oben reindrehen, nach links unten rausschieben und verkleinern und dabei drehen) - (rotate in from upper right, shift out to lower left while shrinking and rotateing) + STime:=Timings[15]-10; + Delay:=Timings[16]-Timings[15]+5; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then begin + gltranslatef(223,0,0); + glrotatef((10-(CTime-STime))*9,0,0,1); + gltranslatef(-223,0,0); + end; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=CTime-(STime+Delay-10); + f:=j*10.0; + gltranslatef(-f*2,-f,0); + glscalef(1-j/10,1-j/10,1-j/10); + glrotatef(-j*9.0,0,0,1); + end; + glBindTexture(GL_TEXTURE_2D, credits_mota.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// Skillmaster (von rechts unten reinschieben, nach rechts oben rausdrehen) - (shift in from lower right, rotate out to upper right) + STime:=Timings[16]-10; + Delay:=Timings[17]-Timings[16]+5; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then begin + j:=STime+10-CTime; + f:=j*10.0; + gltranslatef(+f*2,+f/2,0); + end; + if CTime >=STime+Delay-10 then if CTime <=STime+Delay then begin + j:=CTime-(STime+Delay-10); + gltranslatef(0,-223,0); + glrotatef(integer(j)*-9,0,0,1); + gltranslatef(0,223,0); + glrotatef(j*9,0,0,1); + end; + glBindTexture(GL_TEXTURE_2D, credits_skillmaster.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163, -129); + glTexCoord2f(0,1);glVertex2f(-163, 129); + glTexCoord2f(1,1); glVertex2f(163, 129); + glTexCoord2f(1,0);glVertex2f(163, -129); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + +// WhiteShark (von links unten reinklappen, nach rechts oben rausklappen) - (flip in from lower left, flip out to upper right) + STime:=Timings[17]-10; + Delay:=Timings[18]-Timings[17]; + if CTime > STime then + begin + k:=0; + ESC_Alpha:=20; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + + if Data[k]>0.25 then ESC_Alpha:=5 else inc(ESC_Alpha); + if ESC_Alpha >20 then ESC_Alpha:=20; + if ((CTime-STime)<20) then ESC_Alpha:=20; + if CTime <=STime+10 then j:=CTime-STime else j:=10; + if (CTime >=STime+Delay-10) then if (CTime <=STime+Delay) then j:=(STime+Delay)-CTime else j:=0; + glColor4f(1, 1, 1, ESC_Alpha/20*j/10); + + if (CTime >= STime+10) and (CTime<=STime+12) then begin + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 0); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 1); + GoldenRec.Spawn(RandomRange(65,390), RandomRange(200,460), 1, 16, 0, -1, PerfectLineTwinkle, 5); + end; + + glPushMatrix; + gltranslatef(223,329,0); + if CTime <= STime+10 then + f:=326.0-32.6*(CTime-STime) + else + f:=0; + + if (CTime >= STime+Delay-10) and (CTime <= STime+Delay) then + begin + j:=CTime-(STime+Delay-10); + g:=32.6*j; + end + else + begin + g:=0; + end; + + glBindTexture(GL_TEXTURE_2D, credits_whiteshark.TexNum); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(-163-f+g, -129+f/4-g/2); + glTexCoord2f(0,1);glVertex2f(-163-f/4+g, 129+g/2+f/4); + glTexCoord2f(1,1); glVertex2f(163-f*1.2+g/4, 129+f/2-g/4); + glTexCoord2f(1,0);glVertex2f(163-f*1.5+g/4, -129+f*1.5+g/4); + glEnd; + gldisable(gl_texture_2d); + gldisable(GL_BLEND); + glPopMatrix; + end; + + + Log.LogStatus('',' JB-103'); + +// #################################################################### +// do some twinkle stuff (kinda on beat) + if (CTime > Timings[8] ) and + (CTime < Timings[19] ) then + begin + k := 0; + + try + for j:=0 to 40 do + begin + if ( j < length( Data ) ) AND + ( k < length( Data ) ) then + begin + if Data[j] >= Data[k] then + k:=j; + end; + end; + except + end; + + if Data[k]>0.2 then + begin + l := RandomRange(6,16); + j := RandomRange(0,27); + + GoldenRec.Spawn(myLogoCoords[j,0], myLogoCoords[j,1], 16-l, l, 0, -1, PerfectNote, 0); + end; + end; + +//################################################# +// draw the rest of the main screen (girl and logo + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, credits_bg_ovl.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(800-393, 0); + glTexCoord2f(0,600/1024);glVertex2f(800-393, 600); + glTexCoord2f(393/512,600/1024); glVertex2f(800, 600); + glTexCoord2f(393/512,0);glVertex2f(800, 0); + glEnd; +{ glBindTexture(GL_TEXTURE_2D, credits_bg_logo.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(0, 0); + glTexCoord2f(0,112/128);glVertex2f(0, 112); + glTexCoord2f(497/512,112/128); glVertex2f(497, 112); + glTexCoord2f(497/512,0);glVertex2f(497, 0); + glEnd; +} + gldisable(gl_texture_2d); + glDisable(GL_BLEND); + + // fade out at end of main part + if Ctime > Timings[19] then + begin + glColor4f(0,0,0,(Ctime-Timings[19])/(Timings[20]-Timings[19])); + glEnable(GL_BLEND); + glBegin(GL_QUADS); + glVertex2f(0,0); + glVertex2f(0,600); + glVertex2f(800,600); + glVertex2f(800,0); + glEnd; + glDisable(GL_BLEND); + end; + end + else + if (CRDTS_Stage=Outro) then + begin + if CTime=Timings[20] then begin + CTime_hold:=0; + AudioPlayback.Stop; + AudioPlayback.Open(soundpath + 'credits-outro-tune.mp3'); + AudioPlayback.Play; + AudioPlayback.SetVolume(20); + AudioPlayback.SetLoop(True); + end; + if CTime_hold > 231 then begin + AudioPlayback.Play; + Ctime_hold:=0; + end; + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + // do something useful + // outro background + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, outro_bg.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(0, 0); + glTexCoord2f(0,600/1024);glVertex2f(0, 600); + glTexCoord2f(800/1024,600/1024); glVertex2f(800, 600); + glTexCoord2f(800/1024,0);glVertex2f(800, 0); + glEnd; + + //outro overlays + glColor4f(1, 1, 1, (1+sin(CTime/15))/3+1/3); + glBindTexture(GL_TEXTURE_2D, outro_esc.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(0, 0); + glTexCoord2f(0,223/256);glVertex2f(0, 223); + glTexCoord2f(487/512,223/256); glVertex2f(487, 223); + glTexCoord2f(487/512,0);glVertex2f(487, 0); + glEnd; + + ESC_Alpha:=20; + if (RandomRange(0,20) > 18) and (ESC_Alpha=20) then + ESC_Alpha:=0 + else inc(ESC_Alpha); + if ESC_Alpha > 20 then ESC_Alpha:=20; + glColor4f(1, 1, 1, ESC_Alpha/20); + glBindTexture(GL_TEXTURE_2D, outro_exd.TexNum); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(800-310, 600-247); + glTexCoord2f(0,247/256);glVertex2f(800-310, 600); + glTexCoord2f(310/512,247/256); glVertex2f(800, 600); + glTexCoord2f(310/512,0);glVertex2f(800, 600-247); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // outro scrollers? + // ... + end; + +{ // draw credits runtime counter + SetFontStyle (2); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (5, 5); + glColor4f(1, 1, 1, 1); +// RuntimeStr:='CTime: '+inttostr(floor(CTime/30.320663991914489602156136106092))+'.'+inttostr(floor(CTime/3.0320663991914489602156136106092)-floor(CTime/30.320663991914489602156136106092)*10); + RuntimeStr:='CTime: '+inttostr(CTime); + glPrint (Addr(RuntimeStr[1])); +} + + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, myTex); + glbegin(gl_quads); + glTexCoord2f(0,0);glVertex2f(100, 100); + glTexCoord2f(0,1);glVertex2f(100, 200); + glTexCoord2f(1,1); glVertex2f(200, 200); + glTexCoord2f(1,0);glVertex2f(200, 100); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + + // make the stars shine + GoldenRec.Draw; +end; + +end. diff --git a/Game/Code/Screens/UScreenLevel.pas b/Game/Code/Screens/UScreenLevel.pas index d1910d5f..dc14a278 100644 --- a/Game/Code/Screens/UScreenLevel.pas +++ b/Game/Code/Screens/UScreenLevel.pas @@ -1,98 +1,98 @@ -unit UScreenLevel;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes;
-
-type
- TScreenLevel = class(TMenu)
- public
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- procedure SetAnimationProgress(Progress: real); override;
- end;
-
-implementation
-
-uses UGraphic,
- UMain,
- UIni,
- USong,
- UTexture;
-
-function TScreenLevel.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenName);
- end;
-
- SDLK_RETURN:
- begin
- Ini.Difficulty := Interaction;
- Ini.SaveLevel;
- AudioPlayback.PlaySound(SoundLib.Start);
- //Set Standard Mode
- ScreenSong.Mode := smNormal;
- FadeTo(@ScreenSong);
- end;
-
- // Up and Down could be done at the same time,
- // but I don't want to declare variables inside
- // functions like this one, called so many times
- SDLK_DOWN: InteractNext;
- SDLK_UP: InteractPrev;
- SDLK_RIGHT: InteractNext;
- SDLK_LEFT: InteractPrev;
- end;
- end;
-end;
-
-constructor TScreenLevel.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.Level);
-
- AddButton(Theme.Level.ButtonEasy);
- AddButton(Theme.Level.ButtonMedium);
- AddButton(Theme.Level.ButtonHard);
-
- Interaction := 0;
-end;
-
-procedure TScreenLevel.onShow;
-begin
- inherited;
-
- Interaction := Ini.Difficulty;
-
-// LCD.WriteText(1, ' Choose mode: ');
-// UpdateLCD;
-end;
-
-procedure TScreenLevel.SetAnimationProgress(Progress: real);
-begin
- Button[0].Texture.ScaleW := Progress;
- Button[1].Texture.ScaleW := Progress;
- Button[2].Texture.ScaleW := Progress;
-end;
-
-end.
+unit UScreenLevel; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes; + +type + TScreenLevel = class(TMenu) + public + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + procedure SetAnimationProgress(Progress: real); override; + end; + +implementation + +uses UGraphic, + UMain, + UIni, + USong, + UTexture; + +function TScreenLevel.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenName); + end; + + SDLK_RETURN: + begin + Ini.Difficulty := Interaction; + Ini.SaveLevel; + AudioPlayback.PlaySound(SoundLib.Start); + //Set Standard Mode + ScreenSong.Mode := smNormal; + FadeTo(@ScreenSong); + end; + + // Up and Down could be done at the same time, + // but I don't want to declare variables inside + // functions like this one, called so many times + SDLK_DOWN: InteractNext; + SDLK_UP: InteractPrev; + SDLK_RIGHT: InteractNext; + SDLK_LEFT: InteractPrev; + end; + end; +end; + +constructor TScreenLevel.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.Level); + + AddButton(Theme.Level.ButtonEasy); + AddButton(Theme.Level.ButtonMedium); + AddButton(Theme.Level.ButtonHard); + + Interaction := 0; +end; + +procedure TScreenLevel.onShow; +begin + inherited; + + Interaction := Ini.Difficulty; + +// LCD.WriteText(1, ' Choose mode: '); +// UpdateLCD; +end; + +procedure TScreenLevel.SetAnimationProgress(Progress: real); +begin + Button[0].Texture.ScaleW := Progress; + Button[1].Texture.ScaleW := Progress; + Button[2].Texture.ScaleW := Progress; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptions.pas b/Game/Code/Screens/UScreenOptions.pas index 8c5e67df..0c4ee173 100644 --- a/Game/Code/Screens/UScreenOptions.pas +++ b/Game/Code/Screens/UScreenOptions.pas @@ -1,178 +1,178 @@ -unit UScreenOptions;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, SysUtils, UDisplay, UMusic, UFiles, UIni, UThemes;
-
-type
- TScreenOptions = class(TMenu)
- public
- TextDescription: integer;
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- procedure InteractNext; override;
- procedure InteractPrev; override;
- procedure SetAnimationProgress(Progress: real); override;
- end;
-
-implementation
-
-uses UGraphic;
-
-function TScreenOptions.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenMain);
- end;
- SDLK_RETURN:
- begin
- if SelInteraction = 0 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsGame);
- end;
-
- if SelInteraction = 1 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsGraphics);
- end;
-
- if SelInteraction = 2 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsSound);
- end;
-
- if SelInteraction = 3 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsLyrics);
- end;
-
- if SelInteraction = 4 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsThemes);
- end;
-
- if SelInteraction = 5 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsRecord);
- end;
-
- if SelInteraction = 6 then
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenOptionsAdvanced);
- end;
-
- if SelInteraction = 7 then
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenMain);
- end;
- end;
- SDLK_DOWN: InteractInc;
- SDLK_UP: InteractDec;
- SDLK_RIGHT: InteractNext;
- SDLK_LEFT: InteractPrev;
- end;
- end;
-end;
-
-constructor TScreenOptions.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- TextDescription := AddText(Theme.Options.TextDescription);
-
- LoadFromTheme(Theme.Options);
-
- AddButton(Theme.Options.ButtonGame);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[0]);
-
- AddButton(Theme.Options.ButtonGraphics);
- if (Length(Button[1].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[1]);
-
- AddButton(Theme.Options.ButtonSound);
- if (Length(Button[2].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[2]);
-
- AddButton(Theme.Options.ButtonLyrics);
- if (Length(Button[3].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[3]);
-
- AddButton(Theme.Options.ButtonThemes);
- if (Length(Button[4].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[4]);
-
- AddButton(Theme.Options.ButtonRecord);
- if (Length(Button[5].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[5]);
-
- AddButton(Theme.Options.ButtonAdvanced);
- if (Length(Button[6].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[6]);
-
- AddButton(Theme.Options.ButtonExit);
- if (Length(Button[7].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
- Interaction := 0;
-end;
-
-procedure TScreenOptions.onShow;
-begin
- inherited;
-end;
-
-procedure TScreenOptions.InteractNext;
-begin
- inherited InteractNext;
- Text[TextDescription].Text := Theme.Options.Description[Interaction];
-end;
-
-procedure TScreenOptions.InteractPrev;
-begin
- inherited InteractPrev;
- Text[TextDescription].Text := Theme.Options.Description[Interaction];
-end;
-
-
-procedure TScreenOptions.SetAnimationProgress(Progress: real);
-begin
- Button[0].Texture.ScaleW := Progress;
- Button[1].Texture.ScaleW := Progress;
- Button[2].Texture.ScaleW := Progress;
- Button[3].Texture.ScaleW := Progress;
- Button[4].Texture.ScaleW := Progress;
- Button[5].Texture.ScaleW := Progress;
- Button[6].Texture.ScaleW := Progress;
- Button[7].Texture.ScaleW := Progress;
-end;
-
-end.
+unit UScreenOptions; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, SysUtils, UDisplay, UMusic, UFiles, UIni, UThemes; + +type + TScreenOptions = class(TMenu) + public + TextDescription: integer; + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + procedure InteractNext; override; + procedure InteractPrev; override; + procedure SetAnimationProgress(Progress: real); override; + end; + +implementation + +uses UGraphic; + +function TScreenOptions.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenMain); + end; + SDLK_RETURN: + begin + if SelInteraction = 0 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsGame); + end; + + if SelInteraction = 1 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsGraphics); + end; + + if SelInteraction = 2 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsSound); + end; + + if SelInteraction = 3 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsLyrics); + end; + + if SelInteraction = 4 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsThemes); + end; + + if SelInteraction = 5 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsRecord); + end; + + if SelInteraction = 6 then + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenOptionsAdvanced); + end; + + if SelInteraction = 7 then + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenMain); + end; + end; + SDLK_DOWN: InteractInc; + SDLK_UP: InteractDec; + SDLK_RIGHT: InteractNext; + SDLK_LEFT: InteractPrev; + end; + end; +end; + +constructor TScreenOptions.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + TextDescription := AddText(Theme.Options.TextDescription); + + LoadFromTheme(Theme.Options); + + AddButton(Theme.Options.ButtonGame); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[0]); + + AddButton(Theme.Options.ButtonGraphics); + if (Length(Button[1].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[1]); + + AddButton(Theme.Options.ButtonSound); + if (Length(Button[2].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[2]); + + AddButton(Theme.Options.ButtonLyrics); + if (Length(Button[3].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[3]); + + AddButton(Theme.Options.ButtonThemes); + if (Length(Button[4].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[4]); + + AddButton(Theme.Options.ButtonRecord); + if (Length(Button[5].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[5]); + + AddButton(Theme.Options.ButtonAdvanced); + if (Length(Button[6].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[6]); + + AddButton(Theme.Options.ButtonExit); + if (Length(Button[7].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + + Interaction := 0; +end; + +procedure TScreenOptions.onShow; +begin + inherited; +end; + +procedure TScreenOptions.InteractNext; +begin + inherited InteractNext; + Text[TextDescription].Text := Theme.Options.Description[Interaction]; +end; + +procedure TScreenOptions.InteractPrev; +begin + inherited InteractPrev; + Text[TextDescription].Text := Theme.Options.Description[Interaction]; +end; + + +procedure TScreenOptions.SetAnimationProgress(Progress: real); +begin + Button[0].Texture.ScaleW := Progress; + Button[1].Texture.ScaleW := Progress; + Button[2].Texture.ScaleW := Progress; + Button[3].Texture.ScaleW := Progress; + Button[4].Texture.ScaleW := Progress; + Button[5].Texture.ScaleW := Progress; + Button[6].Texture.ScaleW := Progress; + Button[7].Texture.ScaleW := Progress; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptionsAdvanced.pas b/Game/Code/Screens/UScreenOptionsAdvanced.pas index 7ca0fc05..de02f107 100644 --- a/Game/Code/Screens/UScreenOptionsAdvanced.pas +++ b/Game/Code/Screens/UScreenOptionsAdvanced.pas @@ -1,107 +1,107 @@ -unit UScreenOptionsAdvanced;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes;
-
-type
- TScreenOptionsAdvanced = class(TMenu)
- public
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- end;
-
-implementation
-
-uses UGraphic;
-
-function TScreenOptionsAdvanced.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- SDLK_RETURN:
- begin
- //SelectLoadAnimation Hidden because it is useless atm
- //if SelInteraction = 7 then begin
- if SelInteraction = 6 then begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- end;
- SDLK_DOWN:
- InteractNext;
- SDLK_UP :
- InteractPrev;
- SDLK_RIGHT:
- begin
- //SelectLoadAnimation Hidden because it is useless atm
- //if (SelInteraction >= 0) and (SelInteraction <= 6) then begin
- if (SelInteraction >= 0) and (SelInteraction <= 5) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractInc;
- end;
- end;
- SDLK_LEFT:
- begin
- //SelectLoadAnimation Hidden because it is useless atm
- //if (SelInteraction >= 0) and (SelInteraction <= 6) then begin
- if (SelInteraction >= 0) and (SelInteraction <= 5) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractDec;
- end;
- end;
- end;
- end;
-end;
-
-constructor TScreenOptionsAdvanced.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.OptionsAdvanced);
-
- //SelectLoadAnimation Hidden because it is useless atm
- //AddSelect(Theme.OptionsAdvanced.SelectLoadAnimation, Ini.LoadAnimation, ILoadAnimation);
- AddSelect(Theme.OptionsAdvanced.SelectScreenFade, Ini.ScreenFade, IScreenFade);
- AddSelect(Theme.OptionsAdvanced.SelectEffectSing, Ini.EffectSing, IEffectSing);
- AddSelect(Theme.OptionsAdvanced.SelectLineBonus, Ini.LineBonus, ILineBonus);
- AddSelectSlide(Theme.OptionsAdvanced.SelectOnSongClick, Ini.OnSongClick, IOnSongClick);
- AddSelect(Theme.OptionsAdvanced.SelectAskbeforeDel, Ini.AskbeforeDel, IAskbeforeDel);
- AddSelect(Theme.OptionsAdvanced.SelectPartyPopup, Ini.PartyPopup, IPartyPopup);
-
- AddButton(Theme.OptionsAdvanced.ButtonExit);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
- Interaction := 0;
-end;
-
-procedure TScreenOptionsAdvanced.onShow;
-begin
- inherited;
-
- Interaction := 0;
-end;
-
-end.
+unit UScreenOptionsAdvanced; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes; + +type + TScreenOptionsAdvanced = class(TMenu) + public + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + end; + +implementation + +uses UGraphic; + +function TScreenOptionsAdvanced.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + SDLK_RETURN: + begin + //SelectLoadAnimation Hidden because it is useless atm + //if SelInteraction = 7 then begin + if SelInteraction = 6 then begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + end; + SDLK_DOWN: + InteractNext; + SDLK_UP : + InteractPrev; + SDLK_RIGHT: + begin + //SelectLoadAnimation Hidden because it is useless atm + //if (SelInteraction >= 0) and (SelInteraction <= 6) then begin + if (SelInteraction >= 0) and (SelInteraction <= 5) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractInc; + end; + end; + SDLK_LEFT: + begin + //SelectLoadAnimation Hidden because it is useless atm + //if (SelInteraction >= 0) and (SelInteraction <= 6) then begin + if (SelInteraction >= 0) and (SelInteraction <= 5) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractDec; + end; + end; + end; + end; +end; + +constructor TScreenOptionsAdvanced.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.OptionsAdvanced); + + //SelectLoadAnimation Hidden because it is useless atm + //AddSelect(Theme.OptionsAdvanced.SelectLoadAnimation, Ini.LoadAnimation, ILoadAnimation); + AddSelect(Theme.OptionsAdvanced.SelectScreenFade, Ini.ScreenFade, IScreenFade); + AddSelect(Theme.OptionsAdvanced.SelectEffectSing, Ini.EffectSing, IEffectSing); + AddSelect(Theme.OptionsAdvanced.SelectLineBonus, Ini.LineBonus, ILineBonus); + AddSelectSlide(Theme.OptionsAdvanced.SelectOnSongClick, Ini.OnSongClick, IOnSongClick); + AddSelect(Theme.OptionsAdvanced.SelectAskbeforeDel, Ini.AskbeforeDel, IAskbeforeDel); + AddSelect(Theme.OptionsAdvanced.SelectPartyPopup, Ini.PartyPopup, IPartyPopup); + + AddButton(Theme.OptionsAdvanced.ButtonExit); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + + Interaction := 0; +end; + +procedure TScreenOptionsAdvanced.onShow; +begin + inherited; + + Interaction := 0; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptionsGame.pas b/Game/Code/Screens/UScreenOptionsGame.pas index 394b28a2..d16db3f4 100644 --- a/Game/Code/Screens/UScreenOptionsGame.pas +++ b/Game/Code/Screens/UScreenOptionsGame.pas @@ -1,114 +1,114 @@ -unit UScreenOptionsGame;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes, USongs;
-
-type
- TScreenOptionsGame = class(TMenu)
- public
- old_Tabs, old_Sorting: integer;
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- procedure RefreshSongs;
- end;
-
-implementation
-
-uses UGraphic;
-
-function TScreenOptionsGame.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- AudioPlayback.PlaySound(SoundLib.Back);
- RefreshSongs;
- FadeTo(@ScreenOptions);
- end;
- SDLK_RETURN:
- begin
- if SelInteraction = 6 then begin
- AudioPlayback.PlaySound(SoundLib.Back);
- RefreshSongs;
- FadeTo(@ScreenOptions);
- end;
- end;
- SDLK_DOWN:
- InteractNext;
- SDLK_UP :
- InteractPrev;
- SDLK_RIGHT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 5) then
- begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractInc;
- end;
- end;
- SDLK_LEFT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 5) then
- begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractDec;
- end;
- end;
- end;
- end;
-end;
-
-constructor TScreenOptionsGame.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.OptionsGame);
-
- //Refresh Songs Patch
- old_Sorting := Ini.Sorting;
- old_Tabs := Ini.Tabs;
-
- AddSelect(Theme.OptionsGame.SelectPlayers, Ini.Players, IPlayers);
- AddSelect(Theme.OptionsGame.SelectDifficulty, Ini.Difficulty, IDifficulty);
- AddSelectSlide(Theme.OptionsGame.SelectLanguage, Ini.Language, ILanguage);
- AddSelect(Theme.OptionsGame.SelectTabs, Ini.Tabs, ITabs);
- AddSelectSlide(Theme.OptionsGame.SelectSorting, Ini.Sorting, ISorting);
- AddSelect(Theme.OptionsGame.SelectDebug, Ini.Debug, IDebug);
-
-
- AddButton(Theme.OptionsGame.ButtonExit);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
-end;
-
-//Refresh Songs Patch
-procedure TScreenOptionsGame.RefreshSongs;
-begin
-if (ini.Sorting <> old_Sorting) or (ini.Tabs <> old_Tabs) then
- ScreenSong.Refresh;
-end;
-
-procedure TScreenOptionsGame.onShow;
-begin
- inherited;
-
-// Interaction := 0;
-end;
-
-end.
+unit UScreenOptionsGame; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes, USongs; + +type + TScreenOptionsGame = class(TMenu) + public + old_Tabs, old_Sorting: integer; + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + procedure RefreshSongs; + end; + +implementation + +uses UGraphic; + +function TScreenOptionsGame.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + AudioPlayback.PlaySound(SoundLib.Back); + RefreshSongs; + FadeTo(@ScreenOptions); + end; + SDLK_RETURN: + begin + if SelInteraction = 6 then begin + AudioPlayback.PlaySound(SoundLib.Back); + RefreshSongs; + FadeTo(@ScreenOptions); + end; + end; + SDLK_DOWN: + InteractNext; + SDLK_UP : + InteractPrev; + SDLK_RIGHT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 5) then + begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractInc; + end; + end; + SDLK_LEFT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 5) then + begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractDec; + end; + end; + end; + end; +end; + +constructor TScreenOptionsGame.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.OptionsGame); + + //Refresh Songs Patch + old_Sorting := Ini.Sorting; + old_Tabs := Ini.Tabs; + + AddSelect(Theme.OptionsGame.SelectPlayers, Ini.Players, IPlayers); + AddSelect(Theme.OptionsGame.SelectDifficulty, Ini.Difficulty, IDifficulty); + AddSelectSlide(Theme.OptionsGame.SelectLanguage, Ini.Language, ILanguage); + AddSelect(Theme.OptionsGame.SelectTabs, Ini.Tabs, ITabs); + AddSelectSlide(Theme.OptionsGame.SelectSorting, Ini.Sorting, ISorting); + AddSelect(Theme.OptionsGame.SelectDebug, Ini.Debug, IDebug); + + + AddButton(Theme.OptionsGame.ButtonExit); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + +end; + +//Refresh Songs Patch +procedure TScreenOptionsGame.RefreshSongs; +begin +if (ini.Sorting <> old_Sorting) or (ini.Tabs <> old_Tabs) then + ScreenSong.Refresh; +end; + +procedure TScreenOptionsGame.onShow; +begin + inherited; + +// Interaction := 0; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptionsGraphics.pas b/Game/Code/Screens/UScreenOptionsGraphics.pas index 607501f1..ea14a419 100644 --- a/Game/Code/Screens/UScreenOptionsGraphics.pas +++ b/Game/Code/Screens/UScreenOptionsGraphics.pas @@ -1,101 +1,101 @@ -unit UScreenOptionsGraphics;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes;
-
-type
- TScreenOptionsGraphics = class(TMenu)
- public
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- end;
-
-implementation
-
-uses UGraphic, UMain;
-
-function TScreenOptionsGraphics.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- SDLK_RETURN:
- begin
-{ if SelInteraction <= 1 then begin
- Restart := true;
- end;}
- if SelInteraction = 5 then begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- end;
- SDLK_DOWN:
- InteractNext;
- SDLK_UP :
- InteractPrev;
- SDLK_RIGHT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 4) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractInc;
- end;
- end;
- SDLK_LEFT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 4) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractDec;
- end;
- end;
- end;
- end;
-end;
-
-constructor TScreenOptionsGraphics.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.OptionsGraphics);
-
- AddSelectSlide(Theme.OptionsGraphics.SelectSlideResolution, Ini.Resolution, IResolution);
- AddSelect(Theme.OptionsGraphics.SelectFullscreen, Ini.Fullscreen, IFullscreen);
- AddSelect(Theme.OptionsGraphics.SelectDepth, Ini.Depth, IDepth);
- AddSelect(Theme.OptionsGraphics.SelectOscilloscope, Ini.Oscilloscope, IOscilloscope);
- AddSelect(Theme.OptionsGraphics.SelectMovieSize, Ini.MovieSize, IMovieSize);
-
-
- AddButton(Theme.OptionsGraphics.ButtonExit);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
-end;
-
-procedure TScreenOptionsGraphics.onShow;
-begin
- inherited;
-
- Interaction := 0;
-end;
-
-end.
+unit UScreenOptionsGraphics; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes; + +type + TScreenOptionsGraphics = class(TMenu) + public + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + end; + +implementation + +uses UGraphic, UMain; + +function TScreenOptionsGraphics.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + SDLK_RETURN: + begin +{ if SelInteraction <= 1 then begin + Restart := true; + end;} + if SelInteraction = 5 then begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + end; + SDLK_DOWN: + InteractNext; + SDLK_UP : + InteractPrev; + SDLK_RIGHT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 4) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractInc; + end; + end; + SDLK_LEFT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 4) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractDec; + end; + end; + end; + end; +end; + +constructor TScreenOptionsGraphics.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.OptionsGraphics); + + AddSelectSlide(Theme.OptionsGraphics.SelectSlideResolution, Ini.Resolution, IResolution); + AddSelect(Theme.OptionsGraphics.SelectFullscreen, Ini.Fullscreen, IFullscreen); + AddSelect(Theme.OptionsGraphics.SelectDepth, Ini.Depth, IDepth); + AddSelect(Theme.OptionsGraphics.SelectOscilloscope, Ini.Oscilloscope, IOscilloscope); + AddSelect(Theme.OptionsGraphics.SelectMovieSize, Ini.MovieSize, IMovieSize); + + + AddButton(Theme.OptionsGraphics.ButtonExit); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + +end; + +procedure TScreenOptionsGraphics.onShow; +begin + inherited; + + Interaction := 0; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptionsLyrics.pas b/Game/Code/Screens/UScreenOptionsLyrics.pas index b3e6b5f2..713726f1 100644 --- a/Game/Code/Screens/UScreenOptionsLyrics.pas +++ b/Game/Code/Screens/UScreenOptionsLyrics.pas @@ -1,96 +1,96 @@ -unit UScreenOptionsLyrics;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes;
-
-type
- TScreenOptionsLyrics = class(TMenu)
- public
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- end;
-
-implementation
-
-uses UGraphic;
-
-function TScreenOptionsLyrics.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- SDLK_RETURN:
- begin
- if SelInteraction = 3 then begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- end;
- SDLK_DOWN:
- InteractNext;
- SDLK_UP :
- InteractPrev;
- SDLK_RIGHT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 2) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractInc;
- end;
- end;
- SDLK_LEFT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 2) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractDec;
- end;
- end;
- end;
- end;
-end;
-
-constructor TScreenOptionsLyrics.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.OptionsLyrics);
-
- AddSelect(Theme.OptionsLyrics.SelectLyricsFont, Ini.LyricsFont, ILyricsFont);
- AddSelect(Theme.OptionsLyrics.SelectLyricsEffect, Ini.LyricsEffect, ILyricsEffect);
- AddSelect(Theme.OptionsLyrics.SelectSolmization, Ini.Solmization, ISolmization);
-
-
- AddButton(Theme.OptionsLyrics.ButtonExit);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
-end;
-
-procedure TScreenOptionsLyrics.onShow;
-begin
- inherited;
-
- Interaction := 0;
-end;
-
-end.
+unit UScreenOptionsLyrics; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes; + +type + TScreenOptionsLyrics = class(TMenu) + public + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + end; + +implementation + +uses UGraphic; + +function TScreenOptionsLyrics.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + SDLK_RETURN: + begin + if SelInteraction = 3 then begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + end; + SDLK_DOWN: + InteractNext; + SDLK_UP : + InteractPrev; + SDLK_RIGHT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 2) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractInc; + end; + end; + SDLK_LEFT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 2) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractDec; + end; + end; + end; + end; +end; + +constructor TScreenOptionsLyrics.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.OptionsLyrics); + + AddSelect(Theme.OptionsLyrics.SelectLyricsFont, Ini.LyricsFont, ILyricsFont); + AddSelect(Theme.OptionsLyrics.SelectLyricsEffect, Ini.LyricsEffect, ILyricsEffect); + AddSelect(Theme.OptionsLyrics.SelectSolmization, Ini.Solmization, ISolmization); + + + AddButton(Theme.OptionsLyrics.ButtonExit); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + +end; + +procedure TScreenOptionsLyrics.onShow; +begin + inherited; + + Interaction := 0; +end; + +end. diff --git a/Game/Code/Screens/UScreenOptionsSound.pas b/Game/Code/Screens/UScreenOptionsSound.pas index 6fe50793..ae483f0c 100644 --- a/Game/Code/Screens/UScreenOptionsSound.pas +++ b/Game/Code/Screens/UScreenOptionsSound.pas @@ -1,101 +1,101 @@ -unit UScreenOptionsSound;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes;
-
-type
- TScreenOptionsSound = class(TMenu)
- public
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- end;
-
-implementation
-
-uses UGraphic;
-
-function TScreenOptionsSound.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- SDLK_RETURN:
- begin
- if SelInteraction = 6 then begin
- Ini.Save;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenOptions);
- end;
- end;
- SDLK_DOWN:
- InteractNext;
- SDLK_UP :
- InteractPrev;
- SDLK_RIGHT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 6) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractInc;
- end;
- end;
- SDLK_LEFT:
- begin
- if (SelInteraction >= 0) and (SelInteraction <= 6) then begin
- AudioPlayback.PlaySound(SoundLib.Option);
- InteractDec;
- end;
- end;
- end;
- end;
-end;
-
-constructor TScreenOptionsSound.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.OptionsSound);
-
- AddSelect(Theme.OptionsSound.SelectMicBoost, Ini.MicBoost, IMicBoost); // TODO - This need moving to ScreenOptionsRecord
- AddSelect(Theme.OptionsSound.SelectClickAssist, Ini.ClickAssist, IClickAssist);
- AddSelect(Theme.OptionsSound.SelectBeatClick, Ini.BeatClick, IBeatClick);
- AddSelect(Theme.OptionsSound.SelectThreshold, Ini.Threshold, IThreshold);
-
- //Song Preview
- AddSelectSlide(Theme.OptionsSound.SelectSlidePreviewVolume, Ini.PreviewVolume, IPreviewVolume);
- AddSelectSlide(Theme.OptionsSound.SelectSlidePreviewFading, Ini.PreviewFading, IPreviewFading);
-
- AddButton(Theme.OptionsSound.ButtonExit);
- if (Length(Button[0].Text)=0) then
- AddButtonText(14, 20, Theme.Options.Description[7]);
-
- Interaction := 0;
-end;
-
-procedure TScreenOptionsSound.onShow;
-begin
- inherited;
-
- Interaction := 0;
-end;
-
-end.
+unit UScreenOptionsSound; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, UIni, UThemes; + +type + TScreenOptionsSound = class(TMenu) + public + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + end; + +implementation + +uses UGraphic; + +function TScreenOptionsSound.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + SDLK_RETURN: + begin + if SelInteraction = 6 then begin + Ini.Save; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenOptions); + end; + end; + SDLK_DOWN: + InteractNext; + SDLK_UP : + InteractPrev; + SDLK_RIGHT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 6) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractInc; + end; + end; + SDLK_LEFT: + begin + if (SelInteraction >= 0) and (SelInteraction <= 6) then begin + AudioPlayback.PlaySound(SoundLib.Option); + InteractDec; + end; + end; + end; + end; +end; + +constructor TScreenOptionsSound.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.OptionsSound); + + AddSelect(Theme.OptionsSound.SelectMicBoost, Ini.MicBoost, IMicBoost); // TODO - This need moving to ScreenOptionsRecord + AddSelect(Theme.OptionsSound.SelectClickAssist, Ini.ClickAssist, IClickAssist); + AddSelect(Theme.OptionsSound.SelectBeatClick, Ini.BeatClick, IBeatClick); + AddSelect(Theme.OptionsSound.SelectThreshold, Ini.Threshold, IThreshold); + + //Song Preview + AddSelectSlide(Theme.OptionsSound.SelectSlidePreviewVolume, Ini.PreviewVolume, IPreviewVolume); + AddSelectSlide(Theme.OptionsSound.SelectSlidePreviewFading, Ini.PreviewFading, IPreviewFading); + + AddButton(Theme.OptionsSound.ButtonExit); + if (Length(Button[0].Text)=0) then + AddButtonText(14, 20, Theme.Options.Description[7]); + + Interaction := 0; +end; + +procedure TScreenOptionsSound.onShow; +begin + inherited; + + Interaction := 0; +end; + +end. diff --git a/Game/Code/Screens/UScreenPartyPlayer.pas b/Game/Code/Screens/UScreenPartyPlayer.pas index 8897de0a..e696ae73 100644 --- a/Game/Code/Screens/UScreenPartyPlayer.pas +++ b/Game/Code/Screens/UScreenPartyPlayer.pas @@ -1,335 +1,335 @@ -unit UScreenPartyPlayer;
-
-Interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes;
-
-type
- TScreenPartyPlayer = class(TMenu)
- public
- Team1Name: Cardinal;
- Player1Name: Cardinal;
- Player2Name: Cardinal;
- Player3Name: Cardinal;
- Player4Name: Cardinal;
-
- Team2Name: Cardinal;
- Player5Name: Cardinal;
- Player6Name: Cardinal;
- Player7Name: Cardinal;
- Player8Name: Cardinal;
-
- Team3Name: Cardinal;
- Player9Name: Cardinal;
- Player10Name: Cardinal;
- Player11Name: Cardinal;
- Player12Name: Cardinal;
-
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- procedure SetAnimationProgress(Progress: real); override;
- end;
-
-implementation
-
-uses UGraphic, UMain, UIni, UTexture, UParty;
-
-function TScreenPartyPlayer.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-var
- I, J: integer;
- SDL_ModState: Word;
- procedure IntNext;
- begin
- repeat
- InteractNext;
- until Button[Interaction].Visible;
- end;
- procedure IntPrev;
- begin
- repeat
- InteractPrev;
- until Button[Interaction].Visible;
- end;
-begin
- Result := true;
-
- if (PressedDown) then
- SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT
- + KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT)
- else
- SDL_ModState := 0;
-
- begin // Key Down
- case PressedKey of
- SDLK_0..SDLK_9, SDLK_A..SDLK_Z, SDLK_SPACE, SDLK_MINUS, SDLK_EXCLAIM, SDLK_COMMA, SDLK_SLASH, SDLK_ASTERISK, SDLK_QUESTION, SDLK_QUOTE, SDLK_QUOTEDBL:
- begin
- Button[Interaction].Text[0].Text := Button[Interaction].Text[0].Text + chr(ScanCode);
- end;
-
- // Templates for Names Mod
- SDLK_F1:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[0] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[0];
- end;
- SDLK_F2:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[1] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[1];
- end;
- SDLK_F3:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[2] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[2];
- end;
- SDLK_F4:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[3] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[3];
- end;
- SDLK_F5:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[4] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[4];
- end;
- SDLK_F6:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[5] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[5];
- end;
- SDLK_F7:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[6] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[6];
- end;
- SDLK_F8:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[7] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[7];
- end;
- SDLK_F9:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[8] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[8];
- end;
- SDLK_F10:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[9] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[9];
- end;
- SDLK_F11:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[10] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[10];
- end;
- SDLK_F12:
- if (SDL_ModState = KMOD_LALT) then
- begin
- Ini.NameTemplate[11] := Button[Interaction].Text[0].Text;
- end
- else
- begin
- Button[Interaction].Text[0].Text := Ini.NameTemplate[11];
- end;
-
- SDLK_BACKSPACE:
- begin
- Button[Interaction].Text[0].DeleteLastL;
- end;
-
- SDLK_ESCAPE:
- begin
- Ini.SaveNames;
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(@ScreenPartyOptions);
- end;
-
- SDLK_RETURN:
- begin
-
- {//Save PlayerNames
- for I := 0 to PartySession.Teams.NumTeams-1 do
- begin
- PartySession.Teams.Teaminfo[I].Name := PChar(Button[I*5].Text[0].Text);
- for J := 0 to PartySession.Teams.Teaminfo[I].NumPlayers-1 do
- begin
- PartySession.Teams.Teaminfo[I].Playerinfo[J].Name := PChar(Button[I*5 + J+1].Text[0].Text);
- PartySession.Teams.Teaminfo[I].Playerinfo[J].TimesPlayed := 0;
- end;
- end;
-
- AudioPlayback.PlayStart;
- FadeTo(@ScreenPartyNewRound);}
- end;
-
- // Up and Down could be done at the same time,
- // but I don't want to declare variables inside
- // functions like this one, called so many times
- SDLK_DOWN: IntNext;
- SDLK_UP: IntPrev;
- SDLK_RIGHT: IntNext;
- SDLK_LEFT: IntPrev;
- end;
- end;
-end;
-
-constructor TScreenPartyPlayer.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- LoadFromTheme(Theme.PartyPlayer);
-
- Team1Name := AddButton(Theme.PartyPlayer.Team1Name);
- AddButton(Theme.PartyPlayer.Player1Name);
- AddButton(Theme.PartyPlayer.Player2Name);
- AddButton(Theme.PartyPlayer.Player3Name);
- AddButton(Theme.PartyPlayer.Player4Name);
-
- Team2Name := AddButton(Theme.PartyPlayer.Team2Name);
- AddButton(Theme.PartyPlayer.Player5Name);
- AddButton(Theme.PartyPlayer.Player6Name);
- AddButton(Theme.PartyPlayer.Player7Name);
- AddButton(Theme.PartyPlayer.Player8Name);
-
- Team3Name := AddButton(Theme.PartyPlayer.Team3Name);
- AddButton(Theme.PartyPlayer.Player9Name);
- AddButton(Theme.PartyPlayer.Player10Name);
- AddButton(Theme.PartyPlayer.Player11Name);
- AddButton(Theme.PartyPlayer.Player12Name);
-
- Interaction := 0;
-end;
-
-procedure TScreenPartyPlayer.onShow;
-var
- I: integer;
-begin
- inherited;
-
- // Templates for Names Mod
- for I := 1 to 4 do
- Button[I].Text[0].Text := Ini.Name[I-1];
-
- for I := 6 to 9 do
- Button[I].Text[0].Text := Ini.Name[I-2];
-
- for I := 11 to 14 do
- Button[I].Text[0].Text := Ini.Name[I-3];
-
- Button[0].Text[0].Text := Ini.NameTeam[0];
- Button[5].Text[0].Text := Ini.NameTeam[1];
- Button[10].Text[0].Text := Ini.NameTeam[2];
- // Templates for Names Mod end
-
- {If (PartySession.Teams.NumTeams>=1) then
- begin
- Button[0].Visible := True;
- Button[1].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=1);
- Button[2].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=2);
- Button[3].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=3);
- Button[4].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=4);
- end
- else
- begin
- Button[0].Visible := False;
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := False;
- Button[4].Visible := False;
- end;
-
- If (PartySession.Teams.NumTeams>=2) then
- begin
- Button[5].Visible := True;
- Button[6].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=1);
- Button[7].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=2);
- Button[8].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=3);
- Button[9].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=4);
- end
- else
- begin
- Button[5].Visible := False;
- Button[6].Visible := False;
- Button[7].Visible := False;
- Button[8].Visible := False;
- Button[9].Visible := False;
- end;
-
- If (PartySession.Teams.NumTeams>=3) then
- begin
- Button[10].Visible := True;
- Button[11].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=1);
- Button[12].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=2);
- Button[13].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=3);
- Button[14].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=4);
- end
- else
- begin
- Button[10].Visible := False;
- Button[11].Visible := False;
- Button[12].Visible := False;
- Button[13].Visible := False;
- Button[14].Visible := False;
- end; }
-
-end;
-
-procedure TScreenPartyPlayer.SetAnimationProgress(Progress: real);
-var
- I: integer;
-begin
- for I := 0 to high(Button) do
- Button[I].Texture.ScaleW := Progress;
-end;
-
-end.
+unit UScreenPartyPlayer; + +Interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes; + +type + TScreenPartyPlayer = class(TMenu) + public + Team1Name: Cardinal; + Player1Name: Cardinal; + Player2Name: Cardinal; + Player3Name: Cardinal; + Player4Name: Cardinal; + + Team2Name: Cardinal; + Player5Name: Cardinal; + Player6Name: Cardinal; + Player7Name: Cardinal; + Player8Name: Cardinal; + + Team3Name: Cardinal; + Player9Name: Cardinal; + Player10Name: Cardinal; + Player11Name: Cardinal; + Player12Name: Cardinal; + + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + procedure SetAnimationProgress(Progress: real); override; + end; + +implementation + +uses UGraphic, UMain, UIni, UTexture, UParty; + +function TScreenPartyPlayer.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +var +{*I, *}J: integer; // Auto Removed, Unused Variable (I) + SDL_ModState: Word; + procedure IntNext; + begin + repeat + InteractNext; + until Button[Interaction].Visible; + end; + procedure IntPrev; + begin + repeat + InteractPrev; + until Button[Interaction].Visible; + end; +begin + Result := true; + + if (PressedDown) then + SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT + + KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT) + else + SDL_ModState := 0; + + begin // Key Down + case PressedKey of + SDLK_0..SDLK_9, SDLK_A..SDLK_Z, SDLK_SPACE, SDLK_MINUS, SDLK_EXCLAIM, SDLK_COMMA, SDLK_SLASH, SDLK_ASTERISK, SDLK_QUESTION, SDLK_QUOTE, SDLK_QUOTEDBL: + begin + Button[Interaction].Text[0].Text := Button[Interaction].Text[0].Text + chr(ScanCode); + end; + + // Templates for Names Mod + SDLK_F1: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[0] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[0]; + end; + SDLK_F2: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[1] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[1]; + end; + SDLK_F3: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[2] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[2]; + end; + SDLK_F4: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[3] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[3]; + end; + SDLK_F5: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[4] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[4]; + end; + SDLK_F6: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[5] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[5]; + end; + SDLK_F7: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[6] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[6]; + end; + SDLK_F8: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[7] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[7]; + end; + SDLK_F9: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[8] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[8]; + end; + SDLK_F10: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[9] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[9]; + end; + SDLK_F11: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[10] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[10]; + end; + SDLK_F12: + if (SDL_ModState = KMOD_LALT) then + begin + Ini.NameTemplate[11] := Button[Interaction].Text[0].Text; + end + else + begin + Button[Interaction].Text[0].Text := Ini.NameTemplate[11]; + end; + + SDLK_BACKSPACE: + begin + Button[Interaction].Text[0].DeleteLastL; + end; + + SDLK_ESCAPE: + begin + Ini.SaveNames; + AudioPlayback.PlaySound(SoundLib.Back); + FadeTo(@ScreenPartyOptions); + end; + + SDLK_RETURN: + begin + + {//Save PlayerNames + for I := 0 to PartySession.Teams.NumTeams-1 do + begin + PartySession.Teams.Teaminfo[I].Name := PChar(Button[I*5].Text[0].Text); + for J := 0 to PartySession.Teams.Teaminfo[I].NumPlayers-1 do + begin + PartySession.Teams.Teaminfo[I].Playerinfo[J].Name := PChar(Button[I*5 + J+1].Text[0].Text); + PartySession.Teams.Teaminfo[I].Playerinfo[J].TimesPlayed := 0; + end; + end; + + AudioPlayback.PlayStart; + FadeTo(@ScreenPartyNewRound);} + end; + + // Up and Down could be done at the same time, + // but I don't want to declare variables inside + // functions like this one, called so many times + SDLK_DOWN: IntNext; + SDLK_UP: IntPrev; + SDLK_RIGHT: IntNext; + SDLK_LEFT: IntPrev; + end; + end; +end; + +constructor TScreenPartyPlayer.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + LoadFromTheme(Theme.PartyPlayer); + + Team1Name := AddButton(Theme.PartyPlayer.Team1Name); + AddButton(Theme.PartyPlayer.Player1Name); + AddButton(Theme.PartyPlayer.Player2Name); + AddButton(Theme.PartyPlayer.Player3Name); + AddButton(Theme.PartyPlayer.Player4Name); + + Team2Name := AddButton(Theme.PartyPlayer.Team2Name); + AddButton(Theme.PartyPlayer.Player5Name); + AddButton(Theme.PartyPlayer.Player6Name); + AddButton(Theme.PartyPlayer.Player7Name); + AddButton(Theme.PartyPlayer.Player8Name); + + Team3Name := AddButton(Theme.PartyPlayer.Team3Name); + AddButton(Theme.PartyPlayer.Player9Name); + AddButton(Theme.PartyPlayer.Player10Name); + AddButton(Theme.PartyPlayer.Player11Name); + AddButton(Theme.PartyPlayer.Player12Name); + + Interaction := 0; +end; + +procedure TScreenPartyPlayer.onShow; +var + I: integer; +begin + inherited; + + // Templates for Names Mod + for I := 1 to 4 do + Button[I].Text[0].Text := Ini.Name[I-1]; + + for I := 6 to 9 do + Button[I].Text[0].Text := Ini.Name[I-2]; + + for I := 11 to 14 do + Button[I].Text[0].Text := Ini.Name[I-3]; + + Button[0].Text[0].Text := Ini.NameTeam[0]; + Button[5].Text[0].Text := Ini.NameTeam[1]; + Button[10].Text[0].Text := Ini.NameTeam[2]; + // Templates for Names Mod end + + {If (PartySession.Teams.NumTeams>=1) then + begin + Button[0].Visible := True; + Button[1].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=1); + Button[2].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=2); + Button[3].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=3); + Button[4].Visible := (PartySession.Teams.Teaminfo[0].NumPlayers >=4); + end + else + begin + Button[0].Visible := False; + Button[1].Visible := False; + Button[2].Visible := False; + Button[3].Visible := False; + Button[4].Visible := False; + end; + + If (PartySession.Teams.NumTeams>=2) then + begin + Button[5].Visible := True; + Button[6].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=1); + Button[7].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=2); + Button[8].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=3); + Button[9].Visible := (PartySession.Teams.Teaminfo[1].NumPlayers >=4); + end + else + begin + Button[5].Visible := False; + Button[6].Visible := False; + Button[7].Visible := False; + Button[8].Visible := False; + Button[9].Visible := False; + end; + + If (PartySession.Teams.NumTeams>=3) then + begin + Button[10].Visible := True; + Button[11].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=1); + Button[12].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=2); + Button[13].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=3); + Button[14].Visible := (PartySession.Teams.Teaminfo[2].NumPlayers >=4); + end + else + begin + Button[10].Visible := False; + Button[11].Visible := False; + Button[12].Visible := False; + Button[13].Visible := False; + Button[14].Visible := False; + end; } + +end; + +procedure TScreenPartyPlayer.SetAnimationProgress(Progress: real); +var + I: integer; +begin + for I := 0 to high(Button) do + Button[I].Texture.ScaleW := Progress; +end; + +end. diff --git a/Game/Code/Screens/UScreenPartyScore.pas b/Game/Code/Screens/UScreenPartyScore.pas index aeffda8d..8414dbc3 100644 --- a/Game/Code/Screens/UScreenPartyScore.pas +++ b/Game/Code/Screens/UScreenPartyScore.pas @@ -84,7 +84,7 @@ end; constructor TScreenPartyScore.Create;
var
- I: integer;
+// I: integer; // Auto Removed, Unused Variable
Tex: TTexture;
R, G, B: Real;
Color: Integer;
diff --git a/Game/Code/Screens/UScreenPartyWin.pas b/Game/Code/Screens/UScreenPartyWin.pas index 91e0edc6..002741df 100644 --- a/Game/Code/Screens/UScreenPartyWin.pas +++ b/Game/Code/Screens/UScreenPartyWin.pas @@ -1,261 +1,263 @@ -unit UScreenPartyWin;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, SysUtils, UThemes;
-
-type
- TScreenPartyWin = class(TMenu)
- public
- TextScoreTeam1: Cardinal;
- TextScoreTeam2: Cardinal;
- TextScoreTeam3: Cardinal;
- TextNameTeam1: Cardinal;
- TextNameTeam2: Cardinal;
- TextNameTeam3: Cardinal;
- StaticTeam1: Cardinal;
- StaticTeam1BG: Cardinal;
- StaticTeam1Deco: Cardinal;
- StaticTeam2: Cardinal;
- StaticTeam2BG: Cardinal;
- StaticTeam2Deco: Cardinal;
- StaticTeam3: Cardinal;
- StaticTeam3BG: Cardinal;
- StaticTeam3Deco: Cardinal;
- TextWinner: Cardinal;
-
- constructor Create; override;
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- procedure SetAnimationProgress(Progress: real); override;
- end;
-
-implementation
-
-uses UGraphic, UMain, UParty, UScreenSingModi, ULanguage;
-
-function TScreenPartyWin.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_Q:
- begin
- Result := false;
- end;
-
-
- SDLK_ESCAPE,
- SDLK_BACKSPACE :
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenMain);
- end;
-
- SDLK_RETURN:
- begin
- AudioPlayback.PlaySound(SoundLib.Start);
- FadeTo(@ScreenMain);
- end;
- end;
- end;
-end;
-
-constructor TScreenPartyWin.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- TextScoreTeam1 := AddText (Theme.PartyWin.TextScoreTeam1);
- TextScoreTeam2 := AddText (Theme.PartyWin.TextScoreTeam2);
- TextScoreTeam3 := AddText (Theme.PartyWin.TextScoreTeam3);
- TextNameTeam1 := AddText (Theme.PartyWin.TextNameTeam1);
- TextNameTeam2 := AddText (Theme.PartyWin.TextNameTeam2);
- TextNameTeam3 := AddText (Theme.PartyWin.TextNameTeam3);
-
- StaticTeam1 := AddStatic (Theme.PartyWin.StaticTeam1);
- StaticTeam1BG := AddStatic (Theme.PartyWin.StaticTeam1BG);
- StaticTeam1Deco := AddStatic (Theme.PartyWin.StaticTeam1Deco);
- StaticTeam2 := AddStatic (Theme.PartyWin.StaticTeam2);
- StaticTeam2BG := AddStatic (Theme.PartyWin.StaticTeam2BG);
- StaticTeam2Deco := AddStatic (Theme.PartyWin.StaticTeam2Deco);
- StaticTeam3 := AddStatic (Theme.PartyWin.StaticTeam3);
- StaticTeam3BG := AddStatic (Theme.PartyWin.StaticTeam3BG);
- StaticTeam3Deco := AddStatic (Theme.PartyWin.StaticTeam3Deco);
-
- TextWinner := AddText (Theme.PartyWin.TextWinner);
-
- LoadFromTheme(Theme.PartyWin);
-end;
-
-procedure TScreenPartyWin.onShow;
-var
- I: Integer;
- Placing: Integer;
- Function GetTeamColor(Team: Byte): Cardinal;
- var
- NameString: String;
- begin
- NameString := 'P' + InttoStr(Team+1) + 'Dark';
-
- Result := ColorExists(NameString);
- end;
-begin
- inherited;
-
- // to-do : Party
- //Get Team Placing
- //Placing := PartySession.GetTeamOrder;
-
- //Set Winnertext
- //Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.Teams.Teaminfo[Placing[0]].Name]);
- {if (PartySession.Teams.NumTeams >= 1) then
- begin
- Text[TextScoreTeam1].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[0]].Score);
- Text[TextNameTeam1].Text := String(PartySession.Teams.TeamInfo[Placing[0]].Name);
-
- Text[TextScoreTeam1].Visible := True;
- Text[TextNameTeam1].Visible := True;
- Static[StaticTeam1].Visible := True;
- Static[StaticTeam1BG].Visible := True;
- Static[StaticTeam1Deco].Visible := True;
-
- //Set Static Color to Team Color
- If (Theme.PartyWin.StaticTeam1BG.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[0]);
- if (I <> -1) then
- begin
- Static[StaticTeam1BG].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam1BG].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam1BG].Texture.ColB := Color[I].RGB.B;
- end;
- end;
-
- If (Theme.PartyWin.StaticTeam1.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[0]);
- if (I <> -1) then
- begin
- Static[StaticTeam1].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam1].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam1].Texture.ColB := Color[I].RGB.B;
- end;
- end;
- end
- else
- begin
- Text[TextScoreTeam1].Visible := False;
- Text[TextNameTeam1].Visible := False;
- Static[StaticTeam1].Visible := False;
- Static[StaticTeam1BG].Visible := False;
- Static[StaticTeam1Deco].Visible := False;
- end;
-
- if (PartySession.Teams.NumTeams >= 2) then
- begin
- Text[TextScoreTeam2].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[1]].Score);
- Text[TextNameTeam2].Text := String(PartySession.Teams.TeamInfo[Placing[1]].Name);
-
- Text[TextScoreTeam2].Visible := True;
- Text[TextNameTeam2].Visible := True;
- Static[StaticTeam2].Visible := True;
- Static[StaticTeam2BG].Visible := True;
- Static[StaticTeam2Deco].Visible := True;
-
- //Set Static Color to Team Color
- If (Theme.PartyWin.StaticTeam2BG.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[1]);
- if (I <> -1) then
- begin
- Static[StaticTeam2BG].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam2BG].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam2BG].Texture.ColB := Color[I].RGB.B;
- end;
- end;
-
- If (Theme.PartyWin.StaticTeam2.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[1]);
- if (I <> -1) then
- begin
- Static[StaticTeam2].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam2].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam2].Texture.ColB := Color[I].RGB.B;
- end;
- end;
- end
- else
- begin
- Text[TextScoreTeam2].Visible := False;
- Text[TextNameTeam2].Visible := False;
- Static[StaticTeam2].Visible := False;
- Static[StaticTeam2BG].Visible := False;
- Static[StaticTeam2Deco].Visible := False;
- end;
-
- if (PartySession.Teams.NumTeams >= 3) then
- begin
- Text[TextScoreTeam3].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[2]].Score);
- Text[TextNameTeam3].Text := String(PartySession.Teams.TeamInfo[Placing[2]].Name);
-
- Text[TextScoreTeam3].Visible := True;
- Text[TextNameTeam3].Visible := True;
- Static[StaticTeam3].Visible := True;
- Static[StaticTeam3BG].Visible := True;
- Static[StaticTeam3Deco].Visible := True;
-
- //Set Static Color to Team Color
- If (Theme.PartyWin.StaticTeam3BG.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[2]);
- if (I <> -1) then
- begin
- Static[StaticTeam3BG].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam3BG].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam3BG].Texture.ColB := Color[I].RGB.B;
- end;
- end;
-
- If (Theme.PartyWin.StaticTeam3.Color = 'TeamColor') then
- begin
- I := GetTeamColor(Placing[2]);
- if (I <> -1) then
- begin
- Static[StaticTeam3].Texture.ColR := Color[I].RGB.R;
- Static[StaticTeam3].Texture.ColG := Color[I].RGB.G;
- Static[StaticTeam3].Texture.ColB := Color[I].RGB.B;
- end;
- end;
- end
- else
- begin
- Text[TextScoreTeam3].Visible := False;
- Text[TextNameTeam3].Visible := False;
- Static[StaticTeam3].Visible := False;
- Static[StaticTeam3BG].Visible := False;
- Static[StaticTeam3Deco].Visible := False;
- end; }
-
-
-// LCD.WriteText(1, ' Choose mode: ');
-// UpdateLCD;
-end;
-
-procedure TScreenPartyWin.SetAnimationProgress(Progress: real);
-begin
- {if (ScreenSingModi.PlayerInfo.NumPlayers >= 1) then
- Static[StaticTeam1].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[0].Score / maxScore;
- if (ScreenSingModi.PlayerInfo.NumPlayers >= 2) then
- Static[StaticTeam2].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[1].Score / maxScore;
- if (ScreenSingModi.PlayerInfo.NumPlayers >= 3) then
- Static[StaticTeam3].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[2].Score / maxScore;}
-end;
-
-end.
+unit UScreenPartyWin; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, SysUtils, UThemes; + +type + TScreenPartyWin = class(TMenu) + public + TextScoreTeam1: Cardinal; + TextScoreTeam2: Cardinal; + TextScoreTeam3: Cardinal; + TextNameTeam1: Cardinal; + TextNameTeam2: Cardinal; + TextNameTeam3: Cardinal; + StaticTeam1: Cardinal; + StaticTeam1BG: Cardinal; + StaticTeam1Deco: Cardinal; + StaticTeam2: Cardinal; + StaticTeam2BG: Cardinal; + StaticTeam2Deco: Cardinal; + StaticTeam3: Cardinal; + StaticTeam3BG: Cardinal; + StaticTeam3Deco: Cardinal; + TextWinner: Cardinal; + + constructor Create; override; + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + procedure SetAnimationProgress(Progress: real); override; + end; + +implementation + +uses UGraphic, UMain, UParty, UScreenSingModi, ULanguage; + +function TScreenPartyWin.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_Q: + begin + Result := false; + end; + + + SDLK_ESCAPE, + SDLK_BACKSPACE : + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenMain); + end; + + SDLK_RETURN: + begin + AudioPlayback.PlaySound(SoundLib.Start); + FadeTo(@ScreenMain); + end; + end; + end; +end; + +constructor TScreenPartyWin.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + TextScoreTeam1 := AddText (Theme.PartyWin.TextScoreTeam1); + TextScoreTeam2 := AddText (Theme.PartyWin.TextScoreTeam2); + TextScoreTeam3 := AddText (Theme.PartyWin.TextScoreTeam3); + TextNameTeam1 := AddText (Theme.PartyWin.TextNameTeam1); + TextNameTeam2 := AddText (Theme.PartyWin.TextNameTeam2); + TextNameTeam3 := AddText (Theme.PartyWin.TextNameTeam3); + + StaticTeam1 := AddStatic (Theme.PartyWin.StaticTeam1); + StaticTeam1BG := AddStatic (Theme.PartyWin.StaticTeam1BG); + StaticTeam1Deco := AddStatic (Theme.PartyWin.StaticTeam1Deco); + StaticTeam2 := AddStatic (Theme.PartyWin.StaticTeam2); + StaticTeam2BG := AddStatic (Theme.PartyWin.StaticTeam2BG); + StaticTeam2Deco := AddStatic (Theme.PartyWin.StaticTeam2Deco); + StaticTeam3 := AddStatic (Theme.PartyWin.StaticTeam3); + StaticTeam3BG := AddStatic (Theme.PartyWin.StaticTeam3BG); + StaticTeam3Deco := AddStatic (Theme.PartyWin.StaticTeam3Deco); + + TextWinner := AddText (Theme.PartyWin.TextWinner); + + LoadFromTheme(Theme.PartyWin); +end; + +procedure TScreenPartyWin.onShow; +//var +// I: Integer; // Auto Removed, Unused Variable +// Placing: Integer; // Auto Removed, Unused Variable + + Function GetTeamColor(Team: Byte): Cardinal; + var + NameString: String; + begin + NameString := 'P' + InttoStr(Team+1) + 'Dark'; + + Result := ColorExists(NameString); + end; + +begin + inherited; + + // to-do : Party + //Get Team Placing + //Placing := PartySession.GetTeamOrder; + + //Set Winnertext + //Text[TextWinner].Text := Format(Language.Translate('PARTY_SCORE_WINS'), [PartySession.Teams.Teaminfo[Placing[0]].Name]); + {if (PartySession.Teams.NumTeams >= 1) then + begin + Text[TextScoreTeam1].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[0]].Score); + Text[TextNameTeam1].Text := String(PartySession.Teams.TeamInfo[Placing[0]].Name); + + Text[TextScoreTeam1].Visible := True; + Text[TextNameTeam1].Visible := True; + Static[StaticTeam1].Visible := True; + Static[StaticTeam1BG].Visible := True; + Static[StaticTeam1Deco].Visible := True; + + //Set Static Color to Team Color + If (Theme.PartyWin.StaticTeam1BG.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[0]); + if (I <> -1) then + begin + Static[StaticTeam1BG].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam1BG].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam1BG].Texture.ColB := Color[I].RGB.B; + end; + end; + + If (Theme.PartyWin.StaticTeam1.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[0]); + if (I <> -1) then + begin + Static[StaticTeam1].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam1].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam1].Texture.ColB := Color[I].RGB.B; + end; + end; + end + else + begin + Text[TextScoreTeam1].Visible := False; + Text[TextNameTeam1].Visible := False; + Static[StaticTeam1].Visible := False; + Static[StaticTeam1BG].Visible := False; + Static[StaticTeam1Deco].Visible := False; + end; + + if (PartySession.Teams.NumTeams >= 2) then + begin + Text[TextScoreTeam2].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[1]].Score); + Text[TextNameTeam2].Text := String(PartySession.Teams.TeamInfo[Placing[1]].Name); + + Text[TextScoreTeam2].Visible := True; + Text[TextNameTeam2].Visible := True; + Static[StaticTeam2].Visible := True; + Static[StaticTeam2BG].Visible := True; + Static[StaticTeam2Deco].Visible := True; + + //Set Static Color to Team Color + If (Theme.PartyWin.StaticTeam2BG.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[1]); + if (I <> -1) then + begin + Static[StaticTeam2BG].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam2BG].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam2BG].Texture.ColB := Color[I].RGB.B; + end; + end; + + If (Theme.PartyWin.StaticTeam2.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[1]); + if (I <> -1) then + begin + Static[StaticTeam2].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam2].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam2].Texture.ColB := Color[I].RGB.B; + end; + end; + end + else + begin + Text[TextScoreTeam2].Visible := False; + Text[TextNameTeam2].Visible := False; + Static[StaticTeam2].Visible := False; + Static[StaticTeam2BG].Visible := False; + Static[StaticTeam2Deco].Visible := False; + end; + + if (PartySession.Teams.NumTeams >= 3) then + begin + Text[TextScoreTeam3].Text := InttoStr(PartySession.Teams.TeamInfo[Placing[2]].Score); + Text[TextNameTeam3].Text := String(PartySession.Teams.TeamInfo[Placing[2]].Name); + + Text[TextScoreTeam3].Visible := True; + Text[TextNameTeam3].Visible := True; + Static[StaticTeam3].Visible := True; + Static[StaticTeam3BG].Visible := True; + Static[StaticTeam3Deco].Visible := True; + + //Set Static Color to Team Color + If (Theme.PartyWin.StaticTeam3BG.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[2]); + if (I <> -1) then + begin + Static[StaticTeam3BG].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam3BG].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam3BG].Texture.ColB := Color[I].RGB.B; + end; + end; + + If (Theme.PartyWin.StaticTeam3.Color = 'TeamColor') then + begin + I := GetTeamColor(Placing[2]); + if (I <> -1) then + begin + Static[StaticTeam3].Texture.ColR := Color[I].RGB.R; + Static[StaticTeam3].Texture.ColG := Color[I].RGB.G; + Static[StaticTeam3].Texture.ColB := Color[I].RGB.B; + end; + end; + end + else + begin + Text[TextScoreTeam3].Visible := False; + Text[TextNameTeam3].Visible := False; + Static[StaticTeam3].Visible := False; + Static[StaticTeam3BG].Visible := False; + Static[StaticTeam3Deco].Visible := False; + end; } + + +// LCD.WriteText(1, ' Choose mode: '); +// UpdateLCD; +end; + +procedure TScreenPartyWin.SetAnimationProgress(Progress: real); +begin + {if (ScreenSingModi.PlayerInfo.NumPlayers >= 1) then + Static[StaticTeam1].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[0].Score / maxScore; + if (ScreenSingModi.PlayerInfo.NumPlayers >= 2) then + Static[StaticTeam2].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[1].Score / maxScore; + if (ScreenSingModi.PlayerInfo.NumPlayers >= 3) then + Static[StaticTeam3].Texture.ScaleW := Progress * ScreenSingModi.PlayerInfo.Playerinfo[2].Score / maxScore;} +end; + +end. diff --git a/Game/Code/Screens/UScreenScore.pas b/Game/Code/Screens/UScreenScore.pas index f7e641d6..5bba9691 100644 --- a/Game/Code/Screens/UScreenScore.pas +++ b/Game/Code/Screens/UScreenScore.pas @@ -761,8 +761,8 @@ var Score : integer;
//textures
- TextureBar : integer;
- TextureRound : integer;
+// TextureBar : integer; // Auto Removed, Unused Variable
+// TextureRound : integer; // Auto Removed, Unused Variable
begin
MaxHeight := aPlayerScoreScreenDatas[PlayerNumber].Bar_Height;
Width := aPlayerScoreScreenDatas[PlayerNumber].Bar_Width;
diff --git a/Game/Code/Screens/UScreenSong.pas b/Game/Code/Screens/UScreenSong.pas index 09844f9b..f481bad6 100644 --- a/Game/Code/Screens/UScreenSong.pas +++ b/Game/Code/Screens/UScreenSong.pas @@ -229,7 +229,7 @@ function TScreenSong.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDow var
I: integer;
I2: integer;
- HS: integer;
+// HS: integer; // Auto Removed, Unused Variable
SDL_ModState: Word;
Letter: Char;
begin
@@ -987,8 +987,8 @@ end; procedure TScreenSong.SetScroll1;
var
B: integer; // button
- BMin: integer; // button min
- BMax: integer; // button max
+// BMin: integer; // button min // Auto Removed, Unused Variable
+// BMax: integer; // button max // Auto Removed, Unused Variable
Src: integer;
// Dst: integer;
Count: integer; // Dst is not used. Count is used.
@@ -1123,8 +1123,8 @@ end; procedure TScreenSong.SetScroll2;
var
B: integer;
- Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu
- Wsp2: real;
+// Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu // Auto Removed, Unused Variable
+// Wsp2: real; // Auto Removed, Unused Variable
begin
// liniowe
for B := 0 to High(Button) do
@@ -1150,8 +1150,8 @@ end; procedure TScreenSong.SetScroll3; // with slide
var
B: integer;
- Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu
- Wsp2: real;
+// Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu // Auto Removed, Unused Variable
+// Wsp2: real; // Auto Removed, Unused Variable
begin
SongTarget := Interaction;
@@ -1699,7 +1699,7 @@ end; procedure TScreenSong.SelectNext;
var
Skip: integer;
- I: integer;
+// I: integer; // Auto Removed, Unused Variable
VS: Integer;
begin
VS := CatSongs.VisibleSongs;
@@ -1731,7 +1731,7 @@ end; procedure TScreenSong.SelectPrev;
var
Skip: integer;
- I: integer;
+// I: integer; // Auto Removed, Unused Variable
VS: Integer;
begin
VS := CatSongs.VisibleSongs;
@@ -1790,7 +1790,7 @@ end; procedure TScreenSong.SkipTo(Target: Cardinal); // 0.5.0
var
- Skip: integer;
+// Skip: integer; // Auto Removed, Unused Variable
I: integer;
begin
UnLoadDetailedCover;
@@ -1813,7 +1813,7 @@ var CurTime: Cardinal;
PosX, PosY: Integer;
Pos: Real;
- lTmp : double;
+// lTmp : double; // Auto Removed, Unused Variable
begin
// Nothing to do if no music is played or an equalizer bar consists of no block
if (AudioPlayback.Finished or (Theme.Song.Equalizer.Length <= 0)) then
diff --git a/Game/Code/Screens/UScreenSongJumpto.pas b/Game/Code/Screens/UScreenSongJumpto.pas index 1699e36f..bb9475cc 100644 --- a/Game/Code/Screens/UScreenSongJumpto.pas +++ b/Game/Code/Screens/UScreenSongJumpto.pas @@ -1,207 +1,207 @@ -unit UScreenSongJumpto;
-
-interface
-
-{$I switches.inc}
-
-uses
- UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes;
-
-type
- TScreenSongJumpto = class(TMenu)
- private
- //For ChangeMusic
- LastPlayed: Integer;
- VisibleBool: Boolean;
- public
- VisSongs: Integer;
-
- constructor Create; override;
-
- //Visible //Whether the Menu should be Drawn
- //Whether the Menu should be Drawn
- procedure SetVisible(Value: Boolean);
- property Visible: Boolean read VisibleBool write SetVisible;
-
- function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override;
- procedure onShow; override;
- function Draw: boolean; override;
-
- procedure SetTextFound(const Count: Cardinal);
- end;
-
-var
- IType: Array [0..2] of String;
- SelectType: Integer;
-
-
-implementation
-
-uses UGraphic, UMain, UIni, UTexture, ULanguage, UParty, USongs, UScreenSong, ULog;
-
-function TScreenSongJumpto.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean;
-begin
- Result := true;
- If (PressedDown) Then
- begin // Key Down
- case PressedKey of
- SDLK_0..SDLK_9, SDLK_A..SDLK_Z, SDLK_SPACE, SDLK_MINUS, SDLK_EXCLAIM, SDLK_COMMA, SDLK_SLASH, SDLK_ASTERISK, SDLK_QUESTION, SDLK_QUOTE, SDLK_QUOTEDBL, SDLK_LEFTBRACKET, SDLK_SEMICOLON:
- begin
- if Interaction = 0 then
- begin
- Button[0].Text[0].Text := Button[0].Text[0].Text + chr(ScanCode);
- SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType));
- end;
- end;
-
- SDLK_BACKSPACE:
- begin
- if (Interaction = 0) AND (Length(Button[0].Text[0].Text) > 0) then
- begin
- Button[0].Text[0].DeleteLastL;
- SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType));
- end;
- end;
-
- SDLK_RETURN,
- SDLK_ESCAPE:
- begin
- Visible := False;
- AudioPlayback.PlaySound(SoundLib.Back);
- if (VisSongs = 0) AND (Length(Button[0].Text[0].Text) > 0) then
- begin
- ScreenSong.UnLoadDetailedCover;
- Button[0].Text[0].Text := '';
- CatSongs.SetFilter('', 0);
- SetTextFound(0);
- end;
- end;
-
- // Up and Down could be done at the same time,
- // but I don't want to declare variables inside
- // functions like this one, called so many times
- SDLK_DOWN:
- begin
- {SelectNext;
- Button[0].Text[0].Selected := (Interaction = 0);}
- end;
-
- SDLK_UP:
- begin
- {SelectPrev;
- Button[0].Text[0].Selected := (Interaction = 0); }
- end;
-
- SDLK_RIGHT:
- begin
- Interaction := 1;
- InteractInc;
- if (Length(Button[0].Text[0].Text) > 0) then
- SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType));
- Interaction := 0;
- end;
- SDLK_LEFT:
- begin
- Interaction := 1;
- InteractDec;
- if (Length(Button[0].Text[0].Text) > 0) then
- SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType));
- Interaction := 0;
- end;
- end;
- end;
-end;
-
-constructor TScreenSongJumpto.Create;
-var
- I: integer;
-begin
- inherited Create;
-
- AddText(Theme.SongJumpto.TextFound);
-
- LoadFromTheme(Theme.SongJumpto);
-
- AddButton(Theme.SongJumpto.ButtonSearchText);
- if (Length(Button[0].Text) = 0) then
- AddButtonText(14, 20, '');
-
- SelectType := 0;
- AddSelectSlide(Theme.SongJumpto.SelectSlideType, SelectType, Theme.SongJumpto.IType);
-
-
- Interaction := 0;
- LastPlayed := 0;
-end;
-
-procedure TScreenSongJumpto.SetVisible(Value: Boolean);
-begin
-//If change from unvisible to Visible then OnShow
- if (VisibleBool = False) AND (Value = True) then
- OnShow;
-
- VisibleBool := Value;
-end;
-
-procedure TScreenSongJumpto.onShow;
-begin
- inherited;
-
- //Reset Screen if no Old Search is Displayed
- if (CatSongs.CatNumShow <> -2) then
- begin
- SelectsS[0].SetSelectOpt(0);
-
- Button[0].Text[0].Text := '';
- Text[0].Text := Theme.SongJumpto.NoSongsFound;
- end;
-
- //Select Input
- Interaction := 0;
- Button[0].Text[0].Selected := True;
-
- LastPlayed := ScreenSong.Interaction;
-end;
-
-function TScreenSongJumpto.Draw: boolean;
-begin
- Result := inherited Draw;
-end;
-
-procedure TScreenSongJumpto.SetTextFound(const Count: Cardinal);
-begin
- if (Count = 0) then
- begin
- Text[0].Text := Theme.SongJumpto.NoSongsFound;
- if (Length(Button[0].Text[0].Text) = 0) then
- ScreenSong.HideCatTL
- else
- ScreenSong.ShowCatTLCustom(Format(Theme.SongJumpto.CatText, [Button[0].Text[0].Text]));
- end
- else
- begin
- Text[0].Text := Format(Theme.SongJumpto.SongsFound, [Count]);
-
- //Set CatTopLeftText
- ScreenSong.ShowCatTLCustom(Format(Theme.SongJumpto.CatText, [Button[0].Text[0].Text]));
- end;
-
-
- //Set visSongs
- VisSongs := Count;
-
- //Fix SongSelection
- ScreenSong.Interaction := high(CatSongs.Song);
- ScreenSong.SelectNext;
- ScreenSong.FixSelected;
-
- //Play Correct Music
- if (ScreenSong.Interaction <> LastPlayed) then
- begin
- LastPlayed := ScreenSong.Interaction;
-
- ScreenSong.ChangeMusic;
- end;
-end;
-
-end.
+unit UScreenSongJumpto; + +interface + +{$I switches.inc} + +uses + UMenu, SDL, UDisplay, UMusic, UFiles, SysUtils, UThemes; + +type + TScreenSongJumpto = class(TMenu) + private + //For ChangeMusic + LastPlayed: Integer; + VisibleBool: Boolean; + public + VisSongs: Integer; + + constructor Create; override; + + //Visible //Whether the Menu should be Drawn + //Whether the Menu should be Drawn + procedure SetVisible(Value: Boolean); + property Visible: Boolean read VisibleBool write SetVisible; + + function ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; override; + procedure onShow; override; + function Draw: boolean; override; + + procedure SetTextFound(const Count: Cardinal); + end; + +var + IType: Array [0..2] of String; + SelectType: Integer; + + +implementation + +uses UGraphic, UMain, UIni, UTexture, ULanguage, UParty, USongs, UScreenSong, ULog; + +function TScreenSongJumpto.ParseInput(PressedKey: Cardinal; ScanCode: byte; PressedDown: Boolean): Boolean; +begin + Result := true; + If (PressedDown) Then + begin // Key Down + case PressedKey of + SDLK_0..SDLK_9, SDLK_A..SDLK_Z, SDLK_SPACE, SDLK_MINUS, SDLK_EXCLAIM, SDLK_COMMA, SDLK_SLASH, SDLK_ASTERISK, SDLK_QUESTION, SDLK_QUOTE, SDLK_QUOTEDBL, SDLK_LEFTBRACKET, SDLK_SEMICOLON: + begin + if Interaction = 0 then + begin + Button[0].Text[0].Text := Button[0].Text[0].Text + chr(ScanCode); + SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType)); + end; + end; + + SDLK_BACKSPACE: + begin + if (Interaction = 0) AND (Length(Button[0].Text[0].Text) > 0) then + begin + Button[0].Text[0].DeleteLastL; + SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType)); + end; + end; + + SDLK_RETURN, + SDLK_ESCAPE: + begin + Visible := False; + AudioPlayback.PlaySound(SoundLib.Back); + if (VisSongs = 0) AND (Length(Button[0].Text[0].Text) > 0) then + begin + ScreenSong.UnLoadDetailedCover; + Button[0].Text[0].Text := ''; + CatSongs.SetFilter('', 0); + SetTextFound(0); + end; + end; + + // Up and Down could be done at the same time, + // but I don't want to declare variables inside + // functions like this one, called so many times + SDLK_DOWN: + begin + {SelectNext; + Button[0].Text[0].Selected := (Interaction = 0);} + end; + + SDLK_UP: + begin + {SelectPrev; + Button[0].Text[0].Selected := (Interaction = 0); } + end; + + SDLK_RIGHT: + begin + Interaction := 1; + InteractInc; + if (Length(Button[0].Text[0].Text) > 0) then + SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType)); + Interaction := 0; + end; + SDLK_LEFT: + begin + Interaction := 1; + InteractDec; + if (Length(Button[0].Text[0].Text) > 0) then + SetTextFound(CatSongs.SetFilter(Button[0].Text[0].Text, SelectType)); + Interaction := 0; + end; + end; + end; +end; + +constructor TScreenSongJumpto.Create; +//var +// I: integer; // Auto Removed, Unused Variable +begin + inherited Create; + + AddText(Theme.SongJumpto.TextFound); + + LoadFromTheme(Theme.SongJumpto); + + AddButton(Theme.SongJumpto.ButtonSearchText); + if (Length(Button[0].Text) = 0) then + AddButtonText(14, 20, ''); + + SelectType := 0; + AddSelectSlide(Theme.SongJumpto.SelectSlideType, SelectType, Theme.SongJumpto.IType); + + + Interaction := 0; + LastPlayed := 0; +end; + +procedure TScreenSongJumpto.SetVisible(Value: Boolean); +begin +//If change from unvisible to Visible then OnShow + if (VisibleBool = False) AND (Value = True) then + OnShow; + + VisibleBool := Value; +end; + +procedure TScreenSongJumpto.onShow; +begin + inherited; + + //Reset Screen if no Old Search is Displayed + if (CatSongs.CatNumShow <> -2) then + begin + SelectsS[0].SetSelectOpt(0); + + Button[0].Text[0].Text := ''; + Text[0].Text := Theme.SongJumpto.NoSongsFound; + end; + + //Select Input + Interaction := 0; + Button[0].Text[0].Selected := True; + + LastPlayed := ScreenSong.Interaction; +end; + +function TScreenSongJumpto.Draw: boolean; +begin + Result := inherited Draw; +end; + +procedure TScreenSongJumpto.SetTextFound(const Count: Cardinal); +begin + if (Count = 0) then + begin + Text[0].Text := Theme.SongJumpto.NoSongsFound; + if (Length(Button[0].Text[0].Text) = 0) then + ScreenSong.HideCatTL + else + ScreenSong.ShowCatTLCustom(Format(Theme.SongJumpto.CatText, [Button[0].Text[0].Text])); + end + else + begin + Text[0].Text := Format(Theme.SongJumpto.SongsFound, [Count]); + + //Set CatTopLeftText + ScreenSong.ShowCatTLCustom(Format(Theme.SongJumpto.CatText, [Button[0].Text[0].Text])); + end; + + + //Set visSongs + VisSongs := Count; + + //Fix SongSelection + ScreenSong.Interaction := high(CatSongs.Song); + ScreenSong.SelectNext; + ScreenSong.FixSelected; + + //Play Correct Music + if (ScreenSong.Interaction <> LastPlayed) then + begin + LastPlayed := ScreenSong.Interaction; + + ScreenSong.ChangeMusic; + end; +end; + +end. diff --git a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/opengl12.pas b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/opengl12.pas index 763edaee..a79e1c6f 100644 --- a/Game/Code/lib/JEDI-SDL/OpenGL/Pas/opengl12.pas +++ b/Game/Code/lib/JEDI-SDL/OpenGL/Pas/opengl12.pas @@ -7073,7 +7073,7 @@ threadvar var
{$endif}
LastPixelFormat: Integer;
- ActivationRefCount: Integer;
+// ActivationRefCount: Integer; // Auto Removed, Unused Variable
{$ifdef Win32}
const
diff --git a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas index b15fa9ba..3941814d 100644 --- a/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas +++ b/Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas @@ -1,4361 +1,4361 @@ -unit sdlutils;
-{
- $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $
-
-}
-{******************************************************************************}
-{ }
-{ Borland Delphi SDL - Simple DirectMedia Layer }
-{ SDL Utility functions }
-{ }
-{ }
-{ The initial developer of this Pascal code was : }
-{ Tom Jones <tigertomjones@gmx.de> }
-{ }
-{ Portions created by Tom Jones are }
-{ Copyright (C) 2000 - 2001 Tom Jones. }
-{ }
-{ }
-{ Contributor(s) }
-{ -------------- }
-{ Dominique Louis <Dominique@SavageSoftware.com.au> }
-{ Róbert Kisnémeth <mikrobi@freemail.hu> }
-{ }
-{ Obtained through: }
-{ Joint Endeavour of Delphi Innovators ( Project JEDI ) }
-{ }
-{ You may retrieve the latest version of this file at the Project }
-{ JEDI home page, located at http://delphi-jedi.org }
-{ }
-{ The contents of this file are used with permission, subject to }
-{ the Mozilla Public License Version 1.1 (the "License"); you may }
-{ not use this file except in compliance with the License. You may }
-{ obtain a copy of the License at }
-{ http://www.mozilla.org/MPL/MPL-1.1.html }
-{ }
-{ Software distributed under the License is distributed on an }
-{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or }
-{ implied. See the License for the specific language governing }
-{ rights and limitations under the License. }
-{ }
-{ Description }
-{ ----------- }
-{ Helper functions... }
-{ }
-{ }
-{ Requires }
-{ -------- }
-{ SDL.dll on Windows platforms }
-{ libSDL-1.1.so.0 on Linux platform }
-{ }
-{ Programming Notes }
-{ ----------------- }
-{ }
-{ }
-{ }
-{ }
-{ Revision History }
-{ ---------------- }
-{ 2000 - TJ : Initial creation }
-{ }
-{ July 13 2001 - DL : Added PutPixel and GetPixel routines. }
-{ }
-{ Sept 14 2001 - RK : Added flipping routines. }
-{ }
-{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD }
-{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel }
-{ Added PSDLRect() }
-{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here}
-{ Also removed by poor attempt or a dialog box }
-{ }
-{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, }
-{ SubSurface, MonoSurface & TexturedSurface }
-{ }
-{ Sept 26 2001 - DL : Made change so that it refers to native Pascal }
-{ types rather that Windows types. This makes it more}
-{ portable to Linix. }
-{ }
-{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal }
-{ }
-{ Oct 27 2001 - JF : Added ScrollY function }
-{ }
-{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface }
-{ }
-{ Mar 28 2002 - JF : Added SDL_RotateSurface }
-{ }
-{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub }
-{ }
-{ May 27 2002 - YS : GradientFillRect function }
-{ }
-{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit }
-{ & SDL_50Scanline2xBlit }
-{ }
-{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect }
-{ }
-{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect }
-{ }
-{ November 9 2002 - JF : Added Jason's boolean Surface functions }
-{ }
-{ December 10 2002 - DE : Added Dean's SDL_ClipLine function }
-{ }
-{ April 26 2003 - SS : Incorporated JF's changes to SDL_ClipLine }
-{ Fixed SDL_ClipLine bug for non-zero cliprect x, y }
-{ Added overloaded SDL_DrawLine for dashed lines }
-{ }
-{******************************************************************************}
-{
- $Log: sdlutils.pas,v $
- Revision 1.5 2006/11/19 18:56:44 savage
- Removed Hints and Warnings.
-
- Revision 1.4 2004/06/02 19:38:53 savage
- Changes to SDL_GradientFillRect as suggested by
- Ángel Eduardo García Hernández. Many thanks.
-
- Revision 1.3 2004/05/29 23:11:54 savage
- Changes to SDL_ScaleSurfaceRect as suggested by
- Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks.
-
- Revision 1.2 2004/02/14 00:23:39 savage
- As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change.
-
- Revision 1.1 2004/02/05 00:08:20 savage
- Module 1.0 release
-
-
-}
-
-interface
-
-{$I jedi-sdl.inc}
-
-uses
-{$IFDEF UNIX}
- Types,
- Xlib,
-{$ENDIF}
- SysUtils,
- sdl;
-
-type
- TGradientStyle = ( gsHorizontal, gsVertical );
-
-// Pixel procedures
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean;
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
-
-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
- Uint32 );
-
-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-
-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-
-// Line procedures
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal ); overload;
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal; DashLength, DashSpace : byte ); overload;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-
-// Surface procedures
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-
-// Flip procedures
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect; overload;
-
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-
-// Fill Rect routine
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-
-// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface!
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-
-//
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
- PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
- boolean;
-
-// Jason's boolean Surface functions
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-
-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
-
-implementation
-
-uses
- Math;
-
-function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 :
- PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal;
- Mod1, Mod2 : cardinal;
- Addr1, Addr2 : cardinal;
- BPP : cardinal;
- Pitch1, Pitch2 : cardinal;
- TransparentColor1, TransparentColor2 : cardinal;
- tx, ty : cardinal;
- StartTick : cardinal;
- Color1, Color2 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
- if SrcRect2 = nil then
- begin
- with Src_Rect2 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface2.w;
- h := SrcSurface2.h;
- end;
- end
- else
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <=
- Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := cardinal( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
- with SrcSurface2^ do
- begin
- TransparentColor2 := format.colorkey;
- Pitch2 := Pitch;
- Addr2 := cardinal( Pixels );
- inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) );
- end;
- Mod1 := Pitch1 - ( ScanWidth * BPP );
- Mod2 := Pitch2 - ( ScanWidth * BPP );
- inc( Addr1, BPP * Scan1Start );
- inc( Addr2, BPP * Scan2Start );
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
- inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) );
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
- inc( Addr2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
- inc( Addr2, 2 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
- Color2 := PLongWord( Addr2 )^ and $00FFFFFF;
- if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
- inc( Addr2, 3 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <>
- TransparentColor2 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
- inc( Addr2, 4 );
- end;
- inc( Addr1, Mod1 );
- inc( Addr2, Mod2 );
- end;
- end;
-end;
-
-procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-var
- SrcColor : cardinal;
- Addr : cardinal;
- R, G, B : cardinal;
-begin
- if Color = 0 then
- exit;
- with DstSurface^ do
- begin
- Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel;
- SrcColor := PUInt32( Addr )^;
- case format.BitsPerPixel of
- 8 :
- begin
- R := SrcColor and $E0 + Color and $E0;
- G := SrcColor and $1C + Color and $1C;
- B := SrcColor and $03 + Color and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( Addr )^ := R or G or B;
- end;
- 15 :
- begin
- R := SrcColor and $7C00 + Color and $7C00;
- G := SrcColor and $03E0 + Color and $03E0;
- B := SrcColor and $001F + Color and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- end;
- 16 :
- begin
- R := SrcColor and $F800 + Color and $F800;
- G := SrcColor and $07C0 + Color and $07C0;
- B := SrcColor and $001F + Color and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07C0 then
- G := $07C0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- end;
- 24 :
- begin
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- end;
- 32 :
- begin
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := R or G or B;
- end;
- end;
- end;
-end;
-
-procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color :
- cardinal );
-var
- SrcColor : cardinal;
- Addr : cardinal;
- R, G, B : cardinal;
-begin
- if Color = 0 then
- exit;
- with DstSurface^ do
- begin
- Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel;
- SrcColor := PUInt32( Addr )^;
- case format.BitsPerPixel of
- 8 :
- begin
- R := SrcColor and $E0 - Color and $E0;
- G := SrcColor and $1C - Color and $1C;
- B := SrcColor and $03 - Color and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( Addr )^ := R or G or B;
- end;
- 15 :
- begin
- R := SrcColor and $7C00 - Color and $7C00;
- G := SrcColor and $03E0 - Color and $03E0;
- B := SrcColor and $001F - Color and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- end;
- 16 :
- begin
- R := SrcColor and $F800 - Color and $F800;
- G := SrcColor and $07C0 - Color and $07C0;
- B := SrcColor and $001F - Color and $001F;
- if R > $F800 then
- R := 0;
- if G > $07C0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- end;
- 24 :
- begin
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- end;
- 32 :
- begin
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := R or G or B;
- end;
- end;
- end;
-end;
-// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces.
-// In 8 bit color depth mode the procedure works with the default packed
-// palette (RRRGGGBB). It handles all clipping.
-
-procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $E0 + Pixel2 and $E0;
- G := Pixel1 and $1C + Pixel2 and $1C;
- B := Pixel1 and $03 + Pixel2 and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $7C00 + Pixel2 and $7C00;
- G := Pixel1 and $03E0 + Pixel2 and $03E0;
- B := Pixel1 and $001F + Pixel2 and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $F800 + Pixel2 and $F800;
- G := Pixel1 and $07E0 + Pixel2 and $07E0;
- B := Pixel1 and $001F + Pixel2 and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07E0 then
- G := $07E0;
- if B > $001F then
- B := $001F;
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
- G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
- B := Pixel1 and $0000FF + Pixel2 and $0000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel1 and $FF0000 + Pixel2 and $FF0000;
- G := Pixel1 and $00FF00 + Pixel2 and $00FF00;
- B := Pixel1 and $0000FF + Pixel2 and $0000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := DestSurface.Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $E0 - Pixel1 and $E0;
- G := Pixel2 and $1C - Pixel1 and $1C;
- B := Pixel2 and $03 - Pixel1 and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $7C00 - Pixel1 and $7C00;
- G := Pixel2 and $03E0 - Pixel1 and $03E0;
- B := Pixel2 and $001F - Pixel1 and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $F800 - Pixel1 and $F800;
- G := Pixel2 and $07E0 - Pixel1 and $07E0;
- B := Pixel2 and $001F - Pixel1 and $001F;
- if R > $F800 then
- R := 0;
- if G > $07E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( DestAddr )^ := R or G or B;
- end;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
- G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
- B := Pixel2 and $0000FF - Pixel1 and $0000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
- R := Pixel2 and $FF0000 - Pixel1 and $FF0000;
- G := Pixel2 and $00FF00 - Pixel1 and $00FF00;
- B := Pixel2 and $0000FF - Pixel1 and $0000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel2;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- TransparentColor, SrcColor : cardinal;
- BPP : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- BPP := DestSurface.Format.BytesPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case BPP of
- 1 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt8( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt8( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 2 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt16( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt16( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 3 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 4 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := SrcColor;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-// TextureRect.w and TextureRect.h are not used.
-// The TextureSurface's size MUST larger than the drawing rectangle!!!
-
-procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface;
- TextureRect : PSDL_Rect );
-var
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr, TextAddr : cardinal;
- _ebx, _esi, _edi, _esp : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod, TextMod : cardinal;
- SrcColor, TransparentColor, TextureColor : cardinal;
- BPP : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- BPP := DestSurface.Format.BitsPerPixel;
- end;
- with Texture^ do
- begin
- TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch +
- UInt32( TextureRect.x ) * Format.BytesPerPixel;
- TextMod := Pitch - Src.w * Format.BytesPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- SDL_LockSurface( Texture );
- WorkY := Src.h;
- case BPP of
- 1 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt8( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt8( DestAddr )^ := PUint8( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 2 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt16( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt16( DestAddr )^ := PUInt16( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 3 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^ and $FFFFFF;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF );
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 4 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- SrcColor := PUInt32( SrcAddr )^;
- if SrcColor <> TransparentColor then
- PUInt32( DestAddr )^ := PUInt32( TextAddr )^;
- inc( SrcAddr );
- inc( DestAddr );
- inc( TextAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- inc( TextAddr, TextMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
- SDL_UnlockSurface( Texture );
-end;
-
-procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect );
-var
- xc, yc : cardinal;
- rx, wx, ry, wy, ry16 : cardinal;
- color : cardinal;
- modx, mody : cardinal;
-begin
- // Warning! No checks for surface pointers!!!
- if srcrect = nil then
- srcrect := @SrcSurface.clip_rect;
- if dstrect = nil then
- dstrect := @DstSurface.clip_rect;
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- modx := trunc( ( srcrect.w / dstrect.w ) * 65536 );
- mody := trunc( ( srcrect.h / dstrect.h ) * 65536 );
- //rx := srcrect.x * 65536;
- ry := srcrect.y * 65536;
- wy := dstrect.y;
- for yc := 0 to dstrect.h - 1 do
- begin
- rx := srcrect.x * 65536;
- wx := dstrect.x;
- ry16 := ry shr 16;
- for xc := 0 to dstrect.w - 1 do
- begin
- color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 );
- SDL_PutPixel( DstSurface, wx, wy, color );
- rx := rx + modx;
- inc( wx );
- end;
- ry := ry + mody;
- inc( wy );
- end;
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-// Re-map a rectangular area into an area defined by four vertices
-// Converted from C to Pascal by KiCHY
-
-procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint );
-const
- SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20)
- THRESH = 1 shl SHIFTS; // Threshold for pixel size value
- procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal );
- var
- tm, lm, rm, bm, m : TPoint;
- mx, my : cardinal;
- cr : cardinal;
- begin
- // Does the destination area specify a single pixel?
- if ( ( abs( ul.x - ur.x ) < THRESH ) and
- ( abs( ul.x - lr.x ) < THRESH ) and
- ( abs( ul.x - ll.x ) < THRESH ) and
- ( abs( ul.y - ur.y ) < THRESH ) and
- ( abs( ul.y - lr.y ) < THRESH ) and
- ( abs( ul.y - ll.y ) < THRESH ) ) then
- begin // Yes
- cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) );
- SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr );
- end
- else
- begin // No
- // Quarter the source and the destination, and then recurse
- tm.x := ( ul.x + ur.x ) shr 1;
- tm.y := ( ul.y + ur.y ) shr 1;
- bm.x := ( ll.x + lr.x ) shr 1;
- bm.y := ( ll.y + lr.y ) shr 1;
- lm.x := ( ul.x + ll.x ) shr 1;
- lm.y := ( ul.y + ll.y ) shr 1;
- rm.x := ( ur.x + lr.x ) shr 1;
- rm.y := ( ur.y + lr.y ) shr 1;
- m.x := ( tm.x + bm.x ) shr 1;
- m.y := ( tm.y + bm.y ) shr 1;
- mx := ( x1 + x2 ) shr 1;
- my := ( y1 + y2 ) shr 1;
- CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my );
- CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my );
- CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 );
- CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 );
- end;
- end;
-var
- _UL, _UR, _LR, _LL : TPoint;
- Rect_x, Rect_y, Rect_w, Rect_h : integer;
-begin
- if SDL_MustLock( SrcSurface ) then
- SDL_LockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_LockSurface( DstSurface );
- if SrcRect = nil then
- begin
- Rect_x := 0;
- Rect_y := 0;
- Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS;
- end
- else
- begin
- Rect_x := SrcRect.x;
- Rect_y := SrcRect.y;
- Rect_w := ( SrcRect.w - 1 ) shl SHIFTS;
- Rect_h := ( SrcRect.h - 1 ) shl SHIFTS;
- end;
- // Shift all values to help reduce round-off error.
- _ul.x := ul.x shl SHIFTS;
- _ul.y := ul.y shl SHIFTS;
- _ur.x := ur.x shl SHIFTS;
- _ur.y := ur.y shl SHIFTS;
- _lr.x := lr.x shl SHIFTS;
- _lr.y := lr.y shl SHIFTS;
- _ll.x := ll.x shl SHIFTS;
- _ll.y := ll.y shl SHIFTS;
- CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h );
- if SDL_MustLock( SrcSurface ) then
- SDL_UnlockSurface( SrcSurface );
- if SDL_MustLock( DstSurface ) then
- SDL_UnlockSurface( DstSurface );
-end;
-
-// Draw a line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// Draw a dashed line between x1,y1 and x2,y2 to the given surface
-// NOTE: The surface must be locked before calling this!
-
-procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal; DashLength, DashSpace : byte ); overload;
-var
- dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean;
-begin
- counter := 0;
- drawdash := true; //begin line drawing with dash
-
- //Avoid invalid user-passed dash parameters
- if ( DashLength < 1 )
- then
- DashLength := 1;
- if ( DashSpace < 1 )
- then
- DashSpace := 0;
-
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc( counter );
- if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc( counter );
- if counter > DashSpace - 1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
-
- //Alternate drawing dashes, or leaving spaces
- if drawdash then
- begin
- SDL_PutPixel( DstSurface, px, py, Color );
- inc( counter );
- if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then
- begin
- drawdash := false;
- counter := 0;
- end;
- end
- else //space
- begin
- inc( counter );
- if counter > DashSpace - 1 then
- begin
- drawdash := true;
- counter := 0;
- end;
- end;
-
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_AddPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color :
- cardinal );
-var
- dx, dy, sdx, sdy, x, y, px, py : integer;
-begin
- dx := x2 - x1;
- dy := y2 - y1;
- if dx < 0 then
- sdx := -1
- else
- sdx := 1;
- if dy < 0 then
- sdy := -1
- else
- sdy := 1;
- dx := sdx * dx + 1;
- dy := sdy * dy + 1;
- x := 0;
- y := 0;
- px := x1;
- py := y1;
- if dx >= dy then
- begin
- for x := 0 to dx - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- y := y + dy;
- if y >= dx then
- begin
- y := y - dx;
- py := py + sdy;
- end;
- px := px + sdx;
- end;
- end
- else
- begin
- for y := 0 to dy - 1 do
- begin
- SDL_SubPixel( DstSurface, px, py, Color );
- x := x + dx;
- if x >= dy then
- begin
- x := x - dy;
- px := px + sdx;
- end;
- py := py + sdy;
- end;
- end;
-end;
-
-// flips a rectangle vertically on given surface
-
-procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-var
- TmpRect : TSDL_Rect;
- Locked : boolean;
- y, FlipLength, RowLength : integer;
- Row1, Row2 : Pointer;
- OneRow : TByteArray; // Optimize it if you wish
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin // if Rect=nil then we flip the whole surface
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.h shr 1 - 1;
- RowLength := Rect^.w * DstSurface^.format.BytesPerPixel;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) *
- DstSurface^.Pitch );
- Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 )
- * DstSurface^.Pitch );
- for y := 0 to FlipLength do
- begin
- Move( Row1^, OneRow, RowLength );
- Move( Row2^, Row1^, RowLength );
- Move( OneRow, Row2^, RowLength );
- inc( cardinal( Row1 ), DstSurface^.Pitch );
- dec( cardinal( Row2 ), DstSurface^.Pitch );
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// flips a rectangle horizontally on given surface
-
-procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect );
-type
- T24bit = packed array[ 0..2 ] of byte;
- T24bitArray = packed array[ 0..8191 ] of T24bit;
- P24bitArray = ^T24bitArray;
- TLongWordArray = array[ 0..8191 ] of LongWord;
- PLongWordArray = ^TLongWordArray;
-var
- TmpRect : TSDL_Rect;
- Row8bit : PByteArray;
- Row16bit : PWordArray;
- Row24bit : P24bitArray;
- Row32bit : PLongWordArray;
- y, x, RightSide, FlipLength : integer;
- Pixel : cardinal;
- Pixel24 : T24bit;
- Locked : boolean;
-begin
- if DstSurface <> nil then
- begin
- if Rect = nil then
- begin
- TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h );
- Rect := @TmpRect;
- end;
- FlipLength := Rect^.w shr 1 - 1;
- if SDL_MustLock( DstSurface ) then
- begin
- Locked := true;
- SDL_LockSurface( DstSurface );
- end
- else
- Locked := false;
- case DstSurface^.format.BytesPerPixel of
- 1 :
- begin
- Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row8Bit^[ x ];
- Row8Bit^[ x ] := Row8Bit^[ RightSide ];
- Row8Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row8Bit ), DstSurface^.pitch );
- end;
- end;
- 2 :
- begin
- Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row16Bit^[ x ];
- Row16Bit^[ x ] := Row16Bit^[ RightSide ];
- Row16Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row16Bit ), DstSurface^.pitch );
- end;
- end;
- 3 :
- begin
- Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel24 := Row24Bit^[ x ];
- Row24Bit^[ x ] := Row24Bit^[ RightSide ];
- Row24Bit^[ RightSide ] := Pixel24;
- dec( RightSide );
- end;
- inc( cardinal( Row24Bit ), DstSurface^.pitch );
- end;
- end;
- 4 :
- begin
- Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) *
- DstSurface^.pitch );
- for y := 1 to Rect^.h do
- begin
- RightSide := Rect^.w - 1;
- for x := 0 to FlipLength do
- begin
- Pixel := Row32Bit^[ x ];
- Row32Bit^[ x ] := Row32Bit^[ RightSide ];
- Row32Bit^[ RightSide ] := Pixel;
- dec( RightSide );
- end;
- inc( cardinal( Row32Bit ), DstSurface^.pitch );
- end;
- end;
- end;
- if Locked then
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer.
-// But you MUST free it after you don't need it anymore!!!
-
-function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect;
-var
- Rect : PSDL_Rect;
-begin
- New( Rect );
- with Rect^ do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
- Result := Rect;
-end;
-
-function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect;
-begin
- with result do
- begin
- x := aLeft;
- y := aTop;
- w := aWidth;
- h := aHeight;
- end;
-end;
-
-function SDLRect( aRect : TRect ) : TSDL_Rect;
-begin
- with aRect do
- result := SDLRect( Left, Top, Right - Left, Bottom - Top );
-end;
-
-procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw,
- depth : integer );
-var
- dx, dy, e, d, dx2 : integer;
- src_pitch, dst_pitch : uint16;
- src_pixels, dst_pixels : PUint8;
-begin
- if ( yw >= dst_surface^.h ) then
- exit;
- dx := ( x2 - x1 );
- dy := ( y2 - y1 );
- dy := dy shl 1;
- e := dy - dx;
- dx2 := dx shl 1;
- src_pitch := Surface^.pitch;
- dst_pitch := dst_surface^.pitch;
- src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth );
- dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 *
- depth );
- for d := 0 to dx - 1 do
- begin
- move( src_pixels^, dst_pixels^, depth );
- while ( e >= 0 ) do
- begin
- inc( src_pixels, depth );
- e := e - dx2;
- end;
- inc( dst_pixels, depth );
- e := e + dy;
- end;
-end;
-
-function sign( x : integer ) : integer;
-begin
- if x > 0 then
- result := 1
- else
- result := -1;
-end;
-
-// Stretches a part of a surface
-
-function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH,
- Width, Height : integer ) : PSDL_Surface;
-var
- dst_surface : PSDL_Surface;
- dx, dy, e, d, dx2, srcx2, srcy2 : integer;
- destx1, desty1 : integer;
-begin
- srcx2 := srcx1 + SrcW;
- srcy2 := srcy1 + SrcH;
- result := nil;
- destx1 := 0;
- desty1 := 0;
- dx := abs( integer( Height - desty1 ) );
- dy := abs( integer( SrcY2 - SrcY1 ) );
- e := ( dy shl 1 ) - dx;
- dx2 := dx shl 1;
- dy := dy shl 1;
- dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height -
- desty1,
- SrcSurface^.Format^.BitsPerPixel,
- SrcSurface^.Format^.RMask,
- SrcSurface^.Format^.GMask,
- SrcSurface^.Format^.BMask,
- SrcSurface^.Format^.AMask );
- if ( dst_surface^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey );
- if ( SDL_MustLock( dst_surface ) ) then
- if ( SDL_LockSurface( dst_surface ) < 0 ) then
- exit;
- for d := 0 to dx - 1 do
- begin
- SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1,
- SrcSurface^.format^.BytesPerPixel );
- while e >= 0 do
- begin
- inc( SrcY1 );
- e := e - dx2;
- end;
- inc( desty1 );
- e := e + dy;
- end;
- if SDL_MUSTLOCK( dst_surface ) then
- SDL_UnlockSurface( dst_surface );
- result := dst_surface;
-end;
-
-procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer );
-var
- src_pixels, dst_pixels : PUint8;
- i : integer;
-begin
- src_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + x2 *
- depth );
- dst_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2
- + xofs ) * depth );
- for i := x2 downto x1 do
- begin
- move( src_pixels^, dst_pixels^, depth );
- dec( src_pixels );
- dec( dst_pixels );
- end;
-end;
-{ Return the pixel value at (x, y)
-NOTE: The surface must be locked before calling this! }
-
-function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32;
-var
- bpp : UInt32;
- p : PInteger;
-begin
- bpp := SrcSurface.format.BytesPerPixel;
- // Here p is the address to the pixel we want to retrieve
- p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) *
- bpp );
- case bpp of
- 1 : result := PUint8( p )^;
- 2 : result := PUint16( p )^;
- 3 :
- if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
- result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ]
- else
- result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or
- PUInt8Array( p )[ 2 ] shl 16;
- 4 : result := PUint32( p )^;
- else
- result := 0; // shouldn't happen, but avoids warnings
- end;
-end;
-{ Set the pixel at (x, y) to the given value
- NOTE: The surface must be locked before calling this! }
-
-procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel :
- Uint32 );
-var
- bpp : UInt32;
- p : PInteger;
-begin
- bpp := DstSurface.format.BytesPerPixel;
- p := Pointer( Uint32( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x )
- * bpp );
- case bpp of
- 1 : PUint8( p )^ := pixel;
- 2 : PUint16( p )^ := pixel;
- 3 :
- if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then
- begin
- PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF;
- PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
- PUInt8Array( p )[ 2 ] := pixel and $FF;
- end
- else
- begin
- PUInt8Array( p )[ 0 ] := pixel and $FF;
- PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF;
- PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF;
- end;
- 4 :
- PUint32( p )^ := pixel;
- end;
-end;
-
-procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer );
-var
- r1, r2 : TSDL_Rect;
- //buffer: PSDL_Surface;
- YPos : Integer;
-begin
- if ( DstSurface <> nil ) and ( DifY <> 0 ) then
- begin
- //if DifY > 0 then // going up
- //begin
- ypos := 0;
- r1.x := 0;
- r2.x := 0;
- r1.w := DstSurface.w;
- r2.w := DstSurface.w;
- r1.h := DifY;
- r2.h := DifY;
- while ypos < DstSurface.h do
- begin
- r1.y := ypos;
- r2.y := ypos + DifY;
- SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 );
- ypos := ypos + DifY;
- end;
- //end
- //else
- //begin // Going Down
- //end;
- end;
-end;
-
-{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer);
-var
- r1, r2: TSDL_Rect;
- buffer: PSDL_Surface;
-begin
- if (Surface <> nil) and (Dify <> 0) then
- begin
- buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2,
- Surface^.h * 2,
- Surface^.Format^.BitsPerPixel, 0, 0, 0, 0);
- if buffer <> nil then
- begin
- if (buffer^.format^.BytesPerPixel = 1) then
- SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256);
- r1 := SDLRect(0, DifY, buffer^.w, buffer^.h);
- r2 := SDLRect(0, 0, buffer^.w, buffer^.h);
- SDL_BlitSurface(Surface, @r1, buffer, @r2);
- SDL_BlitSurface(buffer, @r2, Surface, @r2);
- SDL_FreeSurface(buffer);
- end;
- end;
-end;}
-
-procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer );
-var
- r1, r2 : TSDL_Rect;
- buffer : PSDL_Surface;
-begin
- if ( DstSurface <> nil ) and ( DifX <> 0 ) then
- begin
- buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2,
- DstSurface^.h * 2,
- DstSurface^.Format^.BitsPerPixel,
- DstSurface^.Format^.RMask,
- DstSurface^.Format^.GMask,
- DstSurface^.Format^.BMask,
- DstSurface^.Format^.AMask );
- if buffer <> nil then
- begin
- if ( buffer^.format^.BytesPerPixel = 1 ) then
- SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 );
- r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h );
- r2 := SDLRect( 0, 0, buffer^.w, buffer^.h );
- SDL_BlitSurface( DstSurface, @r1, buffer, @r2 );
- SDL_BlitSurface( buffer, @r2, DstSurface, @r2 );
- SDL_FreeSurface( buffer );
- end;
- end;
-end;
-
-procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single );
-var
- aSin, aCos : Single;
- MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer;
- Colour, TempTransparentColour : UInt32;
- MAXX, MAXY : Integer;
-begin
- // Rotate the surface to the target surface.
- TempTransparentColour := SrcSurface.format.colorkey;
- {if srcRect.w > srcRect.h then
- begin
- Width := srcRect.w;
- Height := srcRect.w;
- end
- else
- begin
- Width := srcRect.h;
- Height := srcRect.h;
- end; }
-
- maxx := DstSurface.w;
- maxy := DstSurface.h;
- aCos := cos( Angle );
- aSin := sin( Angle );
-
- Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) );
- Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) );
-
- OX := Width div 2;
- OY := Height div 2; ;
- MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2;
- MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2;
- ROX := ( -( srcRect.w div 2 ) ) + Offsetx;
- ROY := ( -( srcRect.h div 2 ) ) + OffsetY;
- Tx := ox + round( ROX * aSin - ROY * aCos );
- Ty := oy + round( ROY * aSin + ROX * aCos );
- SX := 0;
- for DX := DestX - TX to DestX - TX + ( width ) do
- begin
- Inc( SX );
- SY := 0;
- for DY := DestY - TY to DestY - TY + ( Height ) do
- begin
- RX := SX - OX;
- RY := SY - OY;
- NX := round( mx + RX * aSin + RY * aCos ); //
- NY := round( my + RY * aSin - RX * aCos ); //
- // Used for testing only
- //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0);
- if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then
- begin
- if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then
- begin
- if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then
- begin
- Colour := SDL_GetPixel( SrcSurface, NX, NY );
- if Colour <> TempTransparentColour then
- begin
- SDL_PutPixel( DstSurface, DX, DY, Colour );
- end;
- end;
- end;
- end;
- inc( SY );
- end;
- end;
-end;
-
-procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect :
- PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer );
-begin
- SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) );
-end;
-
-function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect;
-var
- RealRect : TSDL_Rect;
- OutOfRange : Boolean;
-begin
- OutOfRange := false;
- if dstrect = nil then
- begin
- RealRect.x := 0;
- RealRect.y := 0;
- RealRect.w := DstSurface.w;
- RealRect.h := DstSurface.h;
- end
- else
- begin
- if dstrect.x < DstSurface.w then
- begin
- RealRect.x := dstrect.x;
- end
- else if dstrect.x < 0 then
- begin
- realrect.x := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if dstrect.y < DstSurface.h then
- begin
- RealRect.y := dstrect.y;
- end
- else if dstrect.y < 0 then
- begin
- realrect.y := 0;
- end
- else
- begin
- OutOfRange := True;
- end;
- if OutOfRange = False then
- begin
- if realrect.x + dstrect.w <= DstSurface.w then
- begin
- RealRect.w := dstrect.w;
- end
- else
- begin
- RealRect.w := dstrect.w - realrect.x;
- end;
- if realrect.y + dstrect.h <= DstSurface.h then
- begin
- RealRect.h := dstrect.h;
- end
- else
- begin
- RealRect.h := dstrect.h - realrect.y;
- end;
- end;
- end;
- if OutOfRange = False then
- begin
- result := realrect;
- end
- else
- begin
- realrect.w := 0;
- realrect.h := 0;
- realrect.x := 0;
- realrect.y := 0;
- result := realrect;
- end;
-end;
-
-procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 + Color and $E0;
- G := SrcColor and $1C + Color and $1C;
- B := SrcColor and $03 + Color and $03;
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 + Color and $7C00;
- G := SrcColor and $03E0 + Color and $03E0;
- B := SrcColor and $001F + Color and $001F;
- if R > $7C00 then
- R := $7C00;
- if G > $03E0 then
- G := $03E0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 + Color and $F800;
- G := SrcColor and $07C0 + Color and $07C0;
- B := SrcColor and $001F + Color and $001F;
- if R > $F800 then
- R := $F800;
- if G > $07C0 then
- G := $07C0;
- if B > $001F then
- B := $001F;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 + Color and $00FF0000;
- G := SrcColor and $0000FF00 + Color and $0000FF00;
- B := SrcColor and $000000FF + Color and $000000FF;
- if R > $FF0000 then
- R := $FF0000;
- if G > $00FF00 then
- G := $00FF00;
- if B > $0000FF then
- B := $0000FF;
- PUInt32( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 );
-var
- RealRect : TSDL_Rect;
- Addr : pointer;
- ModX, BPP : cardinal;
- x, y, R, G, B, SrcColor : cardinal;
-begin
- RealRect := ValidateSurfaceRect( DstSurface, DstRect );
- if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then
- begin
- SDL_LockSurface( DstSurface );
- BPP := DstSurface.format.BytesPerPixel;
- with DstSurface^ do
- begin
- Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP );
- ModX := Pitch - UInt32( RealRect.w ) * BPP;
- end;
- case DstSurface.format.BitsPerPixel of
- 8 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $E0 - Color and $E0;
- G := SrcColor and $1C - Color and $1C;
- B := SrcColor and $03 - Color and $03;
- if R > $E0 then
- R := 0;
- if G > $1C then
- G := 0;
- if B > $03 then
- B := 0;
- PUInt8( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 15 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $7C00 - Color and $7C00;
- G := SrcColor and $03E0 - Color and $03E0;
- B := SrcColor and $001F - Color and $001F;
- if R > $7C00 then
- R := 0;
- if G > $03E0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 16 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $F800 - Color and $F800;
- G := SrcColor and $07C0 - Color and $07C0;
- B := SrcColor and $001F - Color and $001F;
- if R > $F800 then
- R := 0;
- if G > $07C0 then
- G := 0;
- if B > $001F then
- B := 0;
- PUInt16( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 24 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- 32 :
- begin
- for y := 0 to RealRect.h - 1 do
- begin
- for x := 0 to RealRect.w - 1 do
- begin
- SrcColor := PUInt32( Addr )^;
- R := SrcColor and $00FF0000 - Color and $00FF0000;
- G := SrcColor and $0000FF00 - Color and $0000FF00;
- B := SrcColor and $000000FF - Color and $000000FF;
- if R > $FF0000 then
- R := 0;
- if G > $00FF00 then
- G := 0;
- if B > $0000FF then
- B := 0;
- PUInt32( Addr )^ := R or G or B;
- inc( UInt32( Addr ), BPP );
- end;
- inc( UInt32( Addr ), ModX );
- end;
- end;
- end;
- SDL_UnlockSurface( DstSurface );
- end;
-end;
-
-procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle );
-var
- FBC : array[ 0..255 ] of Cardinal;
- // temp vars
- i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer;
-
- TempStepV, TempStepH : Single;
- TempLeft, TempTop, TempHeight, TempWidth : integer;
- TempRect : TSDL_Rect;
-
-begin
- // calc FBC
- YR := StartColor.r;
- YG := StartColor.g;
- YB := StartColor.b;
- SR := YR;
- SG := YG;
- SB := YB;
- DR := EndColor.r - SR;
- DG := EndColor.g - SG;
- DB := EndColor.b - SB;
-
- for i := 0 to 255 do
- begin
- FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB );
- YR := SR + round( DR / 255 * i );
- YG := SG + round( DG / 255 * i );
- YB := SB + round( DB / 255 * i );
- end;
-
- // if aStyle = 1 then begin
- TempStepH := Rect.w / 255;
- TempStepV := Rect.h / 255;
- TempHeight := Trunc( TempStepV + 1 );
- TempWidth := Trunc( TempStepH + 1 );
- TempTop := 0;
- TempLeft := 0;
- TempRect.x := Rect.x;
- TempRect.y := Rect.y;
- TempRect.h := Rect.h;
- TempRect.w := Rect.w;
-
- case Style of
- gsHorizontal :
- begin
- TempRect.h := TempHeight;
- for i := 0 to 255 do
- begin
- TempRect.y := Rect.y + TempTop;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempTop := Trunc( TempStepV * i );
- end;
- end;
- gsVertical :
- begin
- TempRect.w := TempWidth;
- for i := 0 to 255 do
- begin
- TempRect.x := Rect.x + TempLeft;
- SDL_FillRect( DstSurface, @TempRect, FBC[ i ] );
- TempLeft := Trunc( TempStepH * i );
- end;
- end;
- end;
-end;
-
-procedure SDL_2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BytesPerPixel of
- 1 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 2 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 3 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 4 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BytesPerPixel of
- 1 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 2 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 3 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 4 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface );
-var
- ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32;
- SrcPitch, DestPitch, x, y, Color : UInt32;
-begin
- if ( Src = nil ) or ( Dest = nil ) then
- exit;
- if ( Src.w shl 1 ) < Dest.w then
- exit;
- if ( Src.h shl 1 ) < Dest.h then
- exit;
-
- if SDL_MustLock( Src ) then
- SDL_LockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_LockSurface( Dest );
-
- ReadRow := UInt32( Src.Pixels );
- WriteRow := UInt32( Dest.Pixels );
-
- SrcPitch := Src.pitch;
- DestPitch := Dest.pitch;
-
- case Src.format.BitsPerPixel of
- 8 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt8( ReadAddr )^;
- PUInt8( WriteAddr )^ := Color;
- PUInt8( WriteAddr + 1 )^ := Color;
- Color := ( Color shr 1 ) and $6D; {%01101101}
- PUInt8( WriteAddr + DestPitch )^ := Color;
- PUInt8( WriteAddr + DestPitch + 1 )^ := Color;
- inc( ReadAddr );
- inc( WriteAddr, 2 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 15 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr )^ := Color;
- PUInt16( WriteAddr + 2 )^ := Color;
- Color := ( Color shr 1 ) and $3DEF; {%0011110111101111}
- PUInt16( WriteAddr + DestPitch )^ := Color;
- PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 16 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt16( ReadAddr )^;
- PUInt16( WriteAddr )^ := Color;
- PUInt16( WriteAddr + 2 )^ := Color;
- Color := ( Color shr 1 ) and $7BEF; {%0111101111101111}
- PUInt16( WriteAddr + DestPitch )^ := Color;
- PUInt16( WriteAddr + DestPitch + 2 )^ := Color;
- inc( ReadAddr, 2 );
- inc( WriteAddr, 4 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 24 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF );
- PUInt32( WriteAddr )^ := Color;
- PUInt32( WriteAddr + 3 )^ := Color;
- Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111}
- PUInt32( WriteAddr + DestPitch )^ := Color;
- PUInt32( WriteAddr + DestPitch + 3 )^ := Color;
- inc( ReadAddr, 3 );
- inc( WriteAddr, 6 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- 32 : for y := 1 to Src.h do
- begin
- ReadAddr := ReadRow;
- WriteAddr := WriteRow;
- for x := 1 to Src.w do
- begin
- Color := PUInt32( ReadAddr )^;
- PUInt32( WriteAddr )^ := Color;
- PUInt32( WriteAddr + 4 )^ := Color;
- Color := ( Color shr 1 ) and $7F7F7F7F;
- PUInt32( WriteAddr + DestPitch )^ := Color;
- PUInt32( WriteAddr + DestPitch + 4 )^ := Color;
- inc( ReadAddr, 4 );
- inc( WriteAddr, 8 );
- end;
- inc( UInt32( ReadRow ), SrcPitch );
- inc( UInt32( WriteRow ), DestPitch * 2 );
- end;
- end;
-
- if SDL_MustLock( Src ) then
- SDL_UnlockSurface( Src );
- if SDL_MustLock( Dest ) then
- SDL_UnlockSurface( Dest );
-end;
-
-function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 :
- PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) :
- boolean;
-var
- Src_Rect1, Src_Rect2 : TSDL_Rect;
- right1, bottom1 : integer;
- right2, bottom2 : integer;
- Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal;
- Mod1 : cardinal;
- Addr1 : cardinal;
- BPP : cardinal;
- Pitch1 : cardinal;
- TransparentColor1 : cardinal;
- tx, ty : cardinal;
- StartTick : cardinal;
- Color1 : cardinal;
-begin
- Result := false;
- if SrcRect1 = nil then
- begin
- with Src_Rect1 do
- begin
- x := 0;
- y := 0;
- w := SrcSurface1.w;
- h := SrcSurface1.h;
- end;
- end
- else
- Src_Rect1 := SrcRect1^;
-
- Src_Rect2 := SrcRect2^;
- with Src_Rect1 do
- begin
- Right1 := Left1 + w;
- Bottom1 := Top1 + h;
- end;
- with Src_Rect2 do
- begin
- Right2 := Left2 + w;
- Bottom2 := Top2 + h;
- end;
- if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then
- exit;
- if Left1 <= Left2 then
- begin
- // 1. left, 2. right
- Scan1Start := Src_Rect1.x + Left2 - Left1;
- //Scan2Start := Src_Rect2.x;
- ScanWidth := Right1 - Left2;
- with Src_Rect2 do
- if ScanWidth > w then
- ScanWidth := w;
- end
- else
- begin
- // 1. right, 2. left
- Scan1Start := Src_Rect1.x;
- //Scan2Start := Src_Rect2.x + Left1 - Left2;
- ScanWidth := Right2 - Left1;
- with Src_Rect1 do
- if ScanWidth > w then
- ScanWidth := w;
- end;
- with SrcSurface1^ do
- begin
- Pitch1 := Pitch;
- Addr1 := cardinal( Pixels );
- inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) );
- with format^ do
- begin
- BPP := BytesPerPixel;
- TransparentColor1 := colorkey;
- end;
- end;
-
- Mod1 := Pitch1 - ( ScanWidth * BPP );
-
- inc( Addr1, BPP * Scan1Start );
-
- if Top1 <= Top2 then
- begin
- // 1. up, 2. down
- ScanHeight := Bottom1 - Top2;
- if ScanHeight > Src_Rect2.h then
- ScanHeight := Src_Rect2.h;
- inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) );
- end
- else
- begin
- // 1. down, 2. up
- ScanHeight := Bottom2 - Top1;
- if ScanHeight > Src_Rect1.h then
- ScanHeight := Src_Rect1.h;
-
- end;
- case BPP of
- 1 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PByte( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 2 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 2 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 3 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- Color1 := PLongWord( Addr1 )^ and $00FFFFFF;
-
- if ( Color1 <> TransparentColor1 )
- then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 3 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- 4 :
- for ty := 1 to ScanHeight do
- begin
- for tx := 1 to ScanWidth do
- begin
- if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then
- begin
- Result := true;
- exit;
- end;
- inc( Addr1, 4 );
-
- end;
- inc( Addr1, Mod1 );
-
- end;
- end;
-end;
-
-procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- PUInt8( DestAddr )^ := Pixel2 or Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 or Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 or Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
-
- PUInt32( DestAddr )^ := Pixel2 or Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- PUInt8( DestAddr )^ := Pixel2 and Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 and Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
-
- PUInt16( DestAddr )^ := Pixel2 and Pixel1;
-
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
-
- PUInt32( DestAddr )^ := Pixel2 and Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-
-procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 > Pixel1 and $E0 then
- R := Pixel2 and $E0
- else
- R := Pixel1 and $E0;
- if Pixel2 and $1C > Pixel1 and $1C then
- G := Pixel2 and $1C
- else
- G := Pixel1 and $1C;
- if Pixel2 and $03 > Pixel1 and $03 then
- B := Pixel2 and $03
- else
- B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 > Pixel1 and $7C00 then
- R := Pixel2 and $7C00
- else
- R := Pixel1 and $7C00;
- if Pixel2 and $03E0 > Pixel1 and $03E0 then
- G := Pixel2 and $03E0
- else
- G := Pixel1 and $03E0;
- if Pixel2 and $001F > Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 > Pixel1 and $F800 then
- R := Pixel2 and $F800
- else
- R := Pixel1 and $F800;
- if Pixel2 and $07E0 > Pixel1 and $07E0 then
- G := Pixel2 and $07E0
- else
- G := Pixel1 and $07E0;
- if Pixel2 and $001F > Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 > Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 > Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF > Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-
-procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect;
- DestSurface : PSDL_Surface; DestRect : PSDL_Rect );
-var
- R, G, B, Pixel1, Pixel2, TransparentColor : cardinal;
- Src, Dest : TSDL_Rect;
- Diff : integer;
- SrcAddr, DestAddr : cardinal;
- WorkX, WorkY : word;
- SrcMod, DestMod : cardinal;
- Bits : cardinal;
-begin
- if ( SrcSurface = nil ) or ( DestSurface = nil ) then
- exit; // Remove this to make it faster
- if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then
- exit; // Remove this to make it faster
- if SrcRect = nil then
- begin
- with Src do
- begin
- x := 0;
- y := 0;
- w := SrcSurface.w;
- h := SrcSurface.h;
- end;
- end
- else
- Src := SrcRect^;
- if DestRect = nil then
- begin
- Dest.x := 0;
- Dest.y := 0;
- end
- else
- Dest := DestRect^;
- Dest.w := Src.w;
- Dest.h := Src.h;
- with DestSurface.Clip_Rect do
- begin
- // Source's right side is greater than the dest.cliprect
- if Dest.x + Src.w > x + w then
- begin
- smallint( Src.w ) := x + w - Dest.x;
- smallint( Dest.w ) := x + w - Dest.x;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's bottom side is greater than the dest.clip
- if Dest.y + Src.h > y + h then
- begin
- smallint( Src.h ) := y + h - Dest.y;
- smallint( Dest.h ) := y + h - Dest.y;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- // Source's left side is less than the dest.clip
- if Dest.x < x then
- begin
- Diff := x - Dest.x;
- Src.x := Src.x + Diff;
- smallint( Src.w ) := smallint( Src.w ) - Diff;
- Dest.x := x;
- smallint( Dest.w ) := smallint( Dest.w ) - Diff;
- if smallint( Dest.w ) < 1 then
- exit;
- end;
- // Source's Top side is less than the dest.clip
- if Dest.y < y then
- begin
- Diff := y - Dest.y;
- Src.y := Src.y + Diff;
- smallint( Src.h ) := smallint( Src.h ) - Diff;
- Dest.y := y;
- smallint( Dest.h ) := smallint( Dest.h ) - Diff;
- if smallint( Dest.h ) < 1 then
- exit;
- end;
- end;
- with SrcSurface^ do
- begin
- SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) *
- Format.BytesPerPixel;
- SrcMod := Pitch - Src.w * Format.BytesPerPixel;
- TransparentColor := Format.colorkey;
- end;
- with DestSurface^ do
- begin
- DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) *
- Format.BytesPerPixel;
- DestMod := Pitch - Dest.w * Format.BytesPerPixel;
- Bits := Format.BitsPerPixel;
- end;
- SDL_LockSurface( SrcSurface );
- SDL_LockSurface( DestSurface );
- WorkY := Src.h;
- case bits of
- 8 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt8( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt8( DestAddr )^;
- if Pixel2 > 0 then
- begin
- if Pixel2 and $E0 < Pixel1 and $E0 then
- R := Pixel2 and $E0
- else
- R := Pixel1 and $E0;
- if Pixel2 and $1C < Pixel1 and $1C then
- G := Pixel2 and $1C
- else
- G := Pixel1 and $1C;
- if Pixel2 and $03 < Pixel1 and $03 then
- B := Pixel2 and $03
- else
- B := Pixel1 and $03;
-
- if R > $E0 then
- R := $E0;
- if G > $1C then
- G := $1C;
- if B > $03 then
- B := $03;
- PUInt8( DestAddr )^ := R or G or B;
- end
- else
- PUInt8( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr );
- inc( DestAddr );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 15 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $7C00 < Pixel1 and $7C00 then
- R := Pixel2 and $7C00
- else
- R := Pixel1 and $7C00;
- if Pixel2 and $03E0 < Pixel1 and $03E0 then
- G := Pixel2 and $03E0
- else
- G := Pixel1 and $03E0;
- if Pixel2 and $001F < Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 16 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt16( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt16( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $F800 < Pixel1 and $F800 then
- R := Pixel2 and $F800
- else
- R := Pixel1 and $F800;
- if Pixel2 and $07E0 < Pixel1 and $07E0 then
- G := Pixel2 and $07E0
- else
- G := Pixel1 and $07E0;
- if Pixel2 and $001F < Pixel1 and $001F then
- B := Pixel2 and $001F
- else
- B := Pixel1 and $001F;
-
- PUInt16( DestAddr )^ := R or G or B;
- end
- else
- PUInt16( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 2 );
- inc( DestAddr, 2 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 24 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B );
- end
- else
- PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1;
- end;
- inc( SrcAddr, 3 );
- inc( DestAddr, 3 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- 32 :
- begin
- repeat
- WorkX := Src.w;
- repeat
- Pixel1 := PUInt32( SrcAddr )^;
- if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then
- begin
- Pixel2 := PUInt32( DestAddr )^;
- if Pixel2 > 0 then
- begin
-
- if Pixel2 and $FF0000 < Pixel1 and $FF0000 then
- R := Pixel2 and $FF0000
- else
- R := Pixel1 and $FF0000;
- if Pixel2 and $00FF00 < Pixel1 and $00FF00 then
- G := Pixel2 and $00FF00
- else
- G := Pixel1 and $00FF00;
- if Pixel2 and $0000FF < Pixel1 and $0000FF then
- B := Pixel2 and $0000FF
- else
- B := Pixel1 and $0000FF;
-
- PUInt32( DestAddr )^ := R or G or B;
- end
- else
- PUInt32( DestAddr )^ := Pixel1;
- end;
- inc( SrcAddr, 4 );
- inc( DestAddr, 4 );
- dec( WorkX );
- until WorkX = 0;
- inc( SrcAddr, SrcMod );
- inc( DestAddr, DestMod );
- dec( WorkY );
- until WorkY = 0;
- end;
- end;
- SDL_UnlockSurface( SrcSurface );
- SDL_UnlockSurface( DestSurface );
-end;
-
-// Will clip the x1,x2,y1,x2 params to the ClipRect provided
-
-function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean;
-var
- tflag, flag1, flag2 : word;
- txy, xedge, yedge : Integer;
- slope : single;
-
- function ClipCode( x, y : Integer ) : word;
- begin
- Result := 0;
- if x < ClipRect.x then
- Result := 1;
- if x >= ClipRect.w + ClipRect.x then
- Result := Result or 2;
- if y < ClipRect.y then
- Result := Result or 4;
- if y >= ClipRect.h + ClipRect.y then
- Result := Result or 8;
- end;
-
-begin
- flag1 := ClipCode( x1, y1 );
- flag2 := ClipCode( x2, y2 );
- result := true;
-
- while true do
- begin
- if ( flag1 or flag2 ) = 0 then
- Exit; // all in
-
- if ( flag1 and flag2 ) <> 0 then
- begin
- result := false;
- Exit; // all out
- end;
-
- if flag2 = 0 then
- begin
- txy := x1; x1 := x2; x2 := txy;
- txy := y1; y1 := y2; y2 := txy;
- tflag := flag1; flag1 := flag2; flag2 := tflag;
- end;
-
- if ( flag2 and 3 ) <> 0 then
- begin
- if ( flag2 and 1 ) <> 0 then
- xedge := ClipRect.x
- else
- xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop
-
- slope := ( y2 - y1 ) / ( x2 - x1 );
- y2 := y1 + Round( slope * ( xedge - x1 ) );
- x2 := xedge;
- end
- else
- begin
- if ( flag2 and 4 ) <> 0 then
- yedge := ClipRect.y
- else
- yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop
-
- slope := ( x2 - x1 ) / ( y2 - y1 );
- x2 := x1 + Round( slope * ( yedge - y1 ) );
- y2 := yedge;
- end;
-
- flag2 := ClipCode( x2, y2 );
- end;
-end;
-
-end.
-
+unit sdlutils; +{ + $Id: sdlutils.pas,v 1.5 2006/11/19 18:56:44 savage Exp $ + +} +{******************************************************************************} +{ } +{ Borland Delphi SDL - Simple DirectMedia Layer } +{ SDL Utility functions } +{ } +{ } +{ The initial developer of this Pascal code was : } +{ Tom Jones <tigertomjones@gmx.de> } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis <Dominique@SavageSoftware.com.au> } +{ Róbert Kisnémeth <mikrobi@freemail.hu> } +{ } +{ Obtained through: } +{ Joint Endeavour of Delphi Innovators ( Project JEDI ) } +{ } +{ You may retrieve the latest version of this file at the Project } +{ JEDI home page, located at http://delphi-jedi.org } +{ } +{ The contents of this file are used with permission, subject to } +{ the Mozilla Public License Version 1.1 (the "License"); you may } +{ not use this file except in compliance with the License. You may } +{ obtain a copy of the License at } +{ http://www.mozilla.org/MPL/MPL-1.1.html } +{ } +{ Software distributed under the License is distributed on an } +{ "AS IS" basis, WITHOUT WARRANTY OF ANY KIND, either express or } +{ implied. See the License for the specific language governing } +{ rights and limitations under the License. } +{ } +{ Description } +{ ----------- } +{ Helper functions... } +{ } +{ } +{ Requires } +{ -------- } +{ SDL.dll on Windows platforms } +{ libSDL-1.1.so.0 on Linux platform } +{ } +{ Programming Notes } +{ ----------------- } +{ } +{ } +{ } +{ } +{ Revision History } +{ ---------------- } +{ 2000 - TJ : Initial creation } +{ } +{ July 13 2001 - DL : Added PutPixel and GetPixel routines. } +{ } +{ Sept 14 2001 - RK : Added flipping routines. } +{ } +{ Sept 19 2001 - RK : Added PutPixel & line drawing & blitting with ADD } +{ effect. Fixed a bug in SDL_PutPixel & SDL_GetPixel } +{ Added PSDLRect() } +{ Sept 22 2001 - DL : Removed need for Windows.pas by defining types here} +{ Also removed by poor attempt or a dialog box } +{ } +{ Sept 25 2001 - RK : Added PixelTest, NewPutPixel, SubPixel, SubLine, } +{ SubSurface, MonoSurface & TexturedSurface } +{ } +{ Sept 26 2001 - DL : Made change so that it refers to native Pascal } +{ types rather that Windows types. This makes it more} +{ portable to Linix. } +{ } +{ Sept 27 2001 - RK : SDLUtils now can be compiled with FreePascal } +{ } +{ Oct 27 2001 - JF : Added ScrollY function } +{ } +{ Jan 21 2002 - RK : Added SDL_ZoomSurface and SDL_WarpSurface } +{ } +{ Mar 28 2002 - JF : Added SDL_RotateSurface } +{ } +{ May 13 2002 - RK : Improved SDL_FillRectAdd & SDL_FillRectSub } +{ } +{ May 27 2002 - YS : GradientFillRect function } +{ } +{ May 30 2002 - RK : Added SDL_2xBlit, SDL_Scanline2xBlit } +{ & SDL_50Scanline2xBlit } +{ } +{ June 12 2002 - RK : Added SDL_PixelTestSurfaceVsRect } +{ } +{ June 12 2002 - JF : Updated SDL_PixelTestSurfaceVsRect } +{ } +{ November 9 2002 - JF : Added Jason's boolean Surface functions } +{ } +{ December 10 2002 - DE : Added Dean's SDL_ClipLine function } +{ } +{ April 26 2003 - SS : Incorporated JF's changes to SDL_ClipLine } +{ Fixed SDL_ClipLine bug for non-zero cliprect x, y } +{ Added overloaded SDL_DrawLine for dashed lines } +{ } +{******************************************************************************} +{ + $Log: sdlutils.pas,v $ + Revision 1.5 2006/11/19 18:56:44 savage + Removed Hints and Warnings. + + Revision 1.4 2004/06/02 19:38:53 savage + Changes to SDL_GradientFillRect as suggested by + Ángel Eduardo García Hernández. Many thanks. + + Revision 1.3 2004/05/29 23:11:54 savage + Changes to SDL_ScaleSurfaceRect as suggested by + Ángel Eduardo García Hernández to fix a colour issue with the function. Many thanks. + + Revision 1.2 2004/02/14 00:23:39 savage + As UNIX is defined in jedi-sdl.inc this will be used to check linux compatability as well. Units have been changed to reflect this change. + + Revision 1.1 2004/02/05 00:08:20 savage + Module 1.0 release + + +} + +interface + +{$I jedi-sdl.inc} + +uses +{$IFDEF UNIX} + Types, + Xlib, +{$ENDIF} + SysUtils, + sdl; + +type + TGradientStyle = ( gsHorizontal, gsVertical ); + +// Pixel procedures +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : Boolean; + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32; + +procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel : + Uint32 ); + +procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); + +procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); + +// Line procedures +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); overload; + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal; DashLength, DashSpace : byte ); overload; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); + +// Surface procedures +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); + +// Flip procedures +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); + +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; overload; + +function SDLRect( aRect : TRect ) : TSDL_Rect; overload; + +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; + +// Fill Rect routine +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); + +// NOTE for All SDL_2xblit... function : the dest surface must be 2x of the source surface! +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); + +// +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : + PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : + boolean; + +// Jason's boolean Surface functions +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); + +function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean; + +implementation + +uses + Math; + +function SDL_PixelTest( SrcSurface1 : PSDL_Surface; SrcRect1 : PSDL_Rect; SrcSurface2 : + PSDL_Surface; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, Scan2Start, ScanWidth, ScanHeight : cardinal; + Mod1, Mod2 : cardinal; + Addr1, Addr2 : cardinal; + BPP : cardinal; + Pitch1, Pitch2 : cardinal; + TransparentColor1, TransparentColor2 : cardinal; + tx, ty : cardinal; +// StartTick : cardinal; // Auto Removed, Unused Variable + Color1, Color2 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + if SrcRect2 = nil then + begin + with Src_Rect2 do + begin + x := 0; + y := 0; + w := SrcSurface2.w; + h := SrcSurface2.h; + end; + end + else + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= + Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := cardinal( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + with SrcSurface2^ do + begin + TransparentColor2 := format.colorkey; + Pitch2 := Pitch; + Addr2 := cardinal( Pixels ); + inc( Addr2, Pitch2 * UInt32( Src_Rect2.y ) ); + end; + Mod1 := Pitch1 - ( ScanWidth * BPP ); + Mod2 := Pitch2 - ( ScanWidth * BPP ); + inc( Addr1, BPP * Scan1Start ); + inc( Addr2, BPP * Scan2Start ); + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + inc( Addr2, Pitch2 * UInt32( Top1 - Top2 ) ); + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) and ( PByte( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + inc( Addr2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) and ( PWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + inc( Addr2, 2 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + Color2 := PLongWord( Addr2 )^ and $00FFFFFF; + if ( Color1 <> TransparentColor1 ) and ( Color2 <> TransparentColor2 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + inc( Addr2, 3 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) and ( PLongWord( Addr2 )^ <> + TransparentColor2 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + inc( Addr2, 4 ); + end; + inc( Addr1, Mod1 ); + inc( Addr2, Mod2 ); + end; + end; +end; + +procedure SDL_AddPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); +var + SrcColor : cardinal; + Addr : cardinal; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel; + SrcColor := PUInt32( Addr )^; + case format.BitsPerPixel of + 8 : + begin + R := SrcColor and $E0 + Color and $E0; + G := SrcColor and $1C + Color and $1C; + B := SrcColor and $03 + Color and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( Addr )^ := R or G or B; + end; + 15 : + begin + R := SrcColor and $7C00 + Color and $7C00; + G := SrcColor and $03E0 + Color and $03E0; + B := SrcColor and $001F + Color and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + end; + 16 : + begin + R := SrcColor and $F800 + Color and $F800; + G := SrcColor and $07C0 + Color and $07C0; + B := SrcColor and $001F + Color and $001F; + if R > $F800 then + R := $F800; + if G > $07C0 then + G := $07C0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + end; + 24 : + begin + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + end; + 32 : + begin + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := R or G or B; + end; + end; + end; +end; + +procedure SDL_SubPixel( DstSurface : PSDL_Surface; x : cardinal; y : cardinal; Color : + cardinal ); +var + SrcColor : cardinal; + Addr : cardinal; + R, G, B : cardinal; +begin + if Color = 0 then + exit; + with DstSurface^ do + begin + Addr := cardinal( Pixels ) + y * Pitch + x * format.BytesPerPixel; + SrcColor := PUInt32( Addr )^; + case format.BitsPerPixel of + 8 : + begin + R := SrcColor and $E0 - Color and $E0; + G := SrcColor and $1C - Color and $1C; + B := SrcColor and $03 - Color and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( Addr )^ := R or G or B; + end; + 15 : + begin + R := SrcColor and $7C00 - Color and $7C00; + G := SrcColor and $03E0 - Color and $03E0; + B := SrcColor and $001F - Color and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + end; + 16 : + begin + R := SrcColor and $F800 - Color and $F800; + G := SrcColor and $07C0 - Color and $07C0; + B := SrcColor and $001F - Color and $001F; + if R > $F800 then + R := 0; + if G > $07C0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + end; + 24 : + begin + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + end; + 32 : + begin + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := R or G or B; + end; + end; + end; +end; +// This procedure works on 8, 15, 16, 24 and 32 bits color depth surfaces. +// In 8 bit color depth mode the procedure works with the default packed +// palette (RRRGGGBB). It handles all clipping. + +procedure SDL_AddSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $E0 + Pixel2 and $E0; + G := Pixel1 and $1C + Pixel2 and $1C; + B := Pixel1 and $03 + Pixel2 and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $7C00 + Pixel2 and $7C00; + G := Pixel1 and $03E0 + Pixel2 and $03E0; + B := Pixel1 and $001F + Pixel2 and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $F800 + Pixel2 and $F800; + G := Pixel1 and $07E0 + Pixel2 and $07E0; + B := Pixel1 and $001F + Pixel2 and $001F; + if R > $F800 then + R := $F800; + if G > $07E0 then + G := $07E0; + if B > $001F then + B := $001F; + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + R := Pixel1 and $FF0000 + Pixel2 and $FF0000; + G := Pixel1 and $00FF00 + Pixel2 and $00FF00; + B := Pixel1 and $0000FF + Pixel2 and $0000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel1 and $FF0000 + Pixel2 and $FF0000; + G := Pixel1 and $00FF00 + Pixel2 and $00FF00; + B := Pixel1 and $0000FF + Pixel2 and $0000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_SubSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := DestSurface.Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $E0 - Pixel1 and $E0; + G := Pixel2 and $1C - Pixel1 and $1C; + B := Pixel2 and $03 - Pixel1 and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $7C00 - Pixel1 and $7C00; + G := Pixel2 and $03E0 - Pixel1 and $03E0; + B := Pixel2 and $001F - Pixel1 and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $F800 - Pixel1 and $F800; + G := Pixel2 and $07E0 - Pixel1 and $07E0; + B := Pixel2 and $001F - Pixel1 and $001F; + if R > $F800 then + R := 0; + if G > $07E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( DestAddr )^ := R or G or B; + end; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + R := Pixel2 and $FF0000 - Pixel1 and $FF0000; + G := Pixel2 and $00FF00 - Pixel1 and $00FF00; + B := Pixel2 and $0000FF - Pixel1 and $0000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + R := Pixel2 and $FF0000 - Pixel1 and $FF0000; + G := Pixel2 and $00FF00 - Pixel1 and $00FF00; + B := Pixel2 and $0000FF - Pixel1 and $0000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel2; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_MonoSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Color : cardinal ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*} : cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + TransparentColor, SrcColor : cardinal; + BPP : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + BPP := DestSurface.Format.BytesPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case BPP of + 1 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt8( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt8( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 2 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt16( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt16( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 3 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^ and $FFFFFF; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 4 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := SrcColor; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; +// TextureRect.w and TextureRect.h are not used. +// The TextureSurface's size MUST larger than the drawing rectangle!!! + +procedure SDL_TexturedSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect; Texture : PSDL_Surface; + TextureRect : PSDL_Rect ); +var + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr, TextAddr : cardinal; +//{*_ebx, *}{*_esi, *}{*_edi, _esp*}: cardinal; // Auto Removed, Unused Variable (_ebx) // Auto Removed, Unused Variable (_esi) // Auto Removed, Unused Variable (_edi) + WorkX, WorkY : word; + SrcMod, DestMod, TextMod : cardinal; +SrcColor, TransparentColor{*, TextureColor*} : cardinal; // Auto Removed, Unused Variable (TextureColor) + BPP : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + BPP := DestSurface.Format.BitsPerPixel; + end; + with Texture^ do + begin + TextAddr := cardinal( Pixels ) + UInt32( TextureRect.y ) * Pitch + + UInt32( TextureRect.x ) * Format.BytesPerPixel; + TextMod := Pitch - Src.w * Format.BytesPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + SDL_LockSurface( Texture ); + WorkY := Src.h; + case BPP of + 1 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt8( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt8( DestAddr )^ := PUint8( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 2 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt16( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt16( DestAddr )^ := PUInt16( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 3 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^ and $FFFFFF; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := ( PUInt32( DestAddr )^ and $FFFFFF ) or ( PUInt32( TextAddr )^ and $FFFFFF ); + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + 4 : + begin + repeat + WorkX := Src.w; + repeat + SrcColor := PUInt32( SrcAddr )^; + if SrcColor <> TransparentColor then + PUInt32( DestAddr )^ := PUInt32( TextAddr )^; + inc( SrcAddr ); + inc( DestAddr ); + inc( TextAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + inc( TextAddr, TextMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); + SDL_UnlockSurface( Texture ); +end; + +procedure SDL_ZoomSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; DstRect : PSDL_Rect ); +var + xc, yc : cardinal; + rx, wx, ry, wy, ry16 : cardinal; + color : cardinal; + modx, mody : cardinal; +begin + // Warning! No checks for surface pointers!!! + if srcrect = nil then + srcrect := @SrcSurface.clip_rect; + if dstrect = nil then + dstrect := @DstSurface.clip_rect; + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + modx := trunc( ( srcrect.w / dstrect.w ) * 65536 ); + mody := trunc( ( srcrect.h / dstrect.h ) * 65536 ); + //rx := srcrect.x * 65536; + ry := srcrect.y * 65536; + wy := dstrect.y; + for yc := 0 to dstrect.h - 1 do + begin + rx := srcrect.x * 65536; + wx := dstrect.x; + ry16 := ry shr 16; + for xc := 0 to dstrect.w - 1 do + begin + color := SDL_GetPixel( SrcSurface, rx shr 16, ry16 ); + SDL_PutPixel( DstSurface, wx, wy, color ); + rx := rx + modx; + inc( wx ); + end; + ry := ry + mody; + inc( wy ); + end; + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; +// Re-map a rectangular area into an area defined by four vertices +// Converted from C to Pascal by KiCHY + +procedure SDL_WarpSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; DstSurface : PSDL_Surface; UL, UR, LR, LL : PPoint ); +const + SHIFTS = 15; // Extend ints to limit round-off error (try 2 - 20) + THRESH = 1 shl SHIFTS; // Threshold for pixel size value + procedure CopySourceToDest( UL, UR, LR, LL : TPoint; x1, y1, x2, y2 : cardinal ); + var + tm, lm, rm, bm, m : TPoint; + mx, my : cardinal; + cr : cardinal; + begin + // Does the destination area specify a single pixel? + if ( ( abs( ul.x - ur.x ) < THRESH ) and + ( abs( ul.x - lr.x ) < THRESH ) and + ( abs( ul.x - ll.x ) < THRESH ) and + ( abs( ul.y - ur.y ) < THRESH ) and + ( abs( ul.y - lr.y ) < THRESH ) and + ( abs( ul.y - ll.y ) < THRESH ) ) then + begin // Yes + cr := SDL_GetPixel( SrcSurface, ( x1 shr SHIFTS ), ( y1 shr SHIFTS ) ); + SDL_PutPixel( DstSurface, ( ul.x shr SHIFTS ), ( ul.y shr SHIFTS ), cr ); + end + else + begin // No + // Quarter the source and the destination, and then recurse + tm.x := ( ul.x + ur.x ) shr 1; + tm.y := ( ul.y + ur.y ) shr 1; + bm.x := ( ll.x + lr.x ) shr 1; + bm.y := ( ll.y + lr.y ) shr 1; + lm.x := ( ul.x + ll.x ) shr 1; + lm.y := ( ul.y + ll.y ) shr 1; + rm.x := ( ur.x + lr.x ) shr 1; + rm.y := ( ur.y + lr.y ) shr 1; + m.x := ( tm.x + bm.x ) shr 1; + m.y := ( tm.y + bm.y ) shr 1; + mx := ( x1 + x2 ) shr 1; + my := ( y1 + y2 ) shr 1; + CopySourceToDest( ul, tm, m, lm, x1, y1, mx, my ); + CopySourceToDest( tm, ur, rm, m, mx, y1, x2, my ); + CopySourceToDest( m, rm, lr, bm, mx, my, x2, y2 ); + CopySourceToDest( lm, m, bm, ll, x1, my, mx, y2 ); + end; + end; +var + _UL, _UR, _LR, _LL : TPoint; + Rect_x, Rect_y, Rect_w, Rect_h : integer; +begin + if SDL_MustLock( SrcSurface ) then + SDL_LockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_LockSurface( DstSurface ); + if SrcRect = nil then + begin + Rect_x := 0; + Rect_y := 0; + Rect_w := ( SrcSurface.w - 1 ) shl SHIFTS; + Rect_h := ( SrcSurface.h - 1 ) shl SHIFTS; + end + else + begin + Rect_x := SrcRect.x; + Rect_y := SrcRect.y; + Rect_w := ( SrcRect.w - 1 ) shl SHIFTS; + Rect_h := ( SrcRect.h - 1 ) shl SHIFTS; + end; + // Shift all values to help reduce round-off error. + _ul.x := ul.x shl SHIFTS; + _ul.y := ul.y shl SHIFTS; + _ur.x := ur.x shl SHIFTS; + _ur.y := ur.y shl SHIFTS; + _lr.x := lr.x shl SHIFTS; + _lr.y := lr.y shl SHIFTS; + _ll.x := ll.x shl SHIFTS; + _ll.y := ll.y shl SHIFTS; + CopySourceToDest( _ul, _ur, _lr, _ll, Rect_x, Rect_y, Rect_w, Rect_h ); + if SDL_MustLock( SrcSurface ) then + SDL_UnlockSurface( SrcSurface ); + if SDL_MustLock( DstSurface ) then + SDL_UnlockSurface( DstSurface ); +end; + +// Draw a line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_PutPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// Draw a dashed line between x1,y1 and x2,y2 to the given surface +// NOTE: The surface must be locked before calling this! + +procedure SDL_DrawLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal; DashLength, DashSpace : byte ); overload; +var + dx, dy, sdx, sdy, x, y, px, py, counter : integer; drawdash : boolean; +begin + counter := 0; + drawdash := true; //begin line drawing with dash + + //Avoid invalid user-passed dash parameters + if ( DashLength < 1 ) + then + DashLength := 1; + if ( DashSpace < 1 ) + then + DashSpace := 0; + + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc( counter ); + if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc( counter ); + if counter > DashSpace - 1 then + begin + drawdash := true; + counter := 0; + end; + end; + + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + + //Alternate drawing dashes, or leaving spaces + if drawdash then + begin + SDL_PutPixel( DstSurface, px, py, Color ); + inc( counter ); + if ( counter > DashLength - 1 ) and ( DashSpace > 0 ) then + begin + drawdash := false; + counter := 0; + end; + end + else //space + begin + inc( counter ); + if counter > DashSpace - 1 then + begin + drawdash := true; + counter := 0; + end; + end; + + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_AddLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_AddPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +procedure SDL_SubLine( DstSurface : PSDL_Surface; x1, y1, x2, y2 : integer; Color : + cardinal ); +var + dx, dy, sdx, sdy, x, y, px, py : integer; +begin + dx := x2 - x1; + dy := y2 - y1; + if dx < 0 then + sdx := -1 + else + sdx := 1; + if dy < 0 then + sdy := -1 + else + sdy := 1; + dx := sdx * dx + 1; + dy := sdy * dy + 1; + x := 0; + y := 0; + px := x1; + py := y1; + if dx >= dy then + begin + for x := 0 to dx - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + y := y + dy; + if y >= dx then + begin + y := y - dx; + py := py + sdy; + end; + px := px + sdx; + end; + end + else + begin + for y := 0 to dy - 1 do + begin + SDL_SubPixel( DstSurface, px, py, Color ); + x := x + dx; + if x >= dy then + begin + x := x - dy; + px := px + sdx; + end; + py := py + sdy; + end; + end; +end; + +// flips a rectangle vertically on given surface + +procedure SDL_FlipRectV( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +var + TmpRect : TSDL_Rect; + Locked : boolean; + y, FlipLength, RowLength : integer; + Row1, Row2 : Pointer; + OneRow : TByteArray; // Optimize it if you wish +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin // if Rect=nil then we flip the whole surface + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.h shr 1 - 1; + RowLength := Rect^.w * DstSurface^.format.BytesPerPixel; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + Row1 := pointer( cardinal( DstSurface^.Pixels ) + UInt32( Rect^.y ) * + DstSurface^.Pitch ); + Row2 := pointer( cardinal( DstSurface^.Pixels ) + ( UInt32( Rect^.y ) + Rect^.h - 1 ) + * DstSurface^.Pitch ); + for y := 0 to FlipLength do + begin + Move( Row1^, OneRow, RowLength ); + Move( Row2^, Row1^, RowLength ); + Move( OneRow, Row2^, RowLength ); + inc( cardinal( Row1 ), DstSurface^.Pitch ); + dec( cardinal( Row2 ), DstSurface^.Pitch ); + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// flips a rectangle horizontally on given surface + +procedure SDL_FlipRectH( DstSurface : PSDL_Surface; Rect : PSDL_Rect ); +type + T24bit = packed array[ 0..2 ] of byte; + T24bitArray = packed array[ 0..8191 ] of T24bit; + P24bitArray = ^T24bitArray; + TLongWordArray = array[ 0..8191 ] of LongWord; + PLongWordArray = ^TLongWordArray; +var + TmpRect : TSDL_Rect; + Row8bit : PByteArray; + Row16bit : PWordArray; + Row24bit : P24bitArray; + Row32bit : PLongWordArray; + y, x, RightSide, FlipLength : integer; + Pixel : cardinal; + Pixel24 : T24bit; + Locked : boolean; +begin + if DstSurface <> nil then + begin + if Rect = nil then + begin + TmpRect := SDLRect( 0, 0, DstSurface.w, DstSurface.h ); + Rect := @TmpRect; + end; + FlipLength := Rect^.w shr 1 - 1; + if SDL_MustLock( DstSurface ) then + begin + Locked := true; + SDL_LockSurface( DstSurface ); + end + else + Locked := false; + case DstSurface^.format.BytesPerPixel of + 1 : + begin + Row8Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row8Bit^[ x ]; + Row8Bit^[ x ] := Row8Bit^[ RightSide ]; + Row8Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row8Bit ), DstSurface^.pitch ); + end; + end; + 2 : + begin + Row16Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row16Bit^[ x ]; + Row16Bit^[ x ] := Row16Bit^[ RightSide ]; + Row16Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row16Bit ), DstSurface^.pitch ); + end; + end; + 3 : + begin + Row24Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel24 := Row24Bit^[ x ]; + Row24Bit^[ x ] := Row24Bit^[ RightSide ]; + Row24Bit^[ RightSide ] := Pixel24; + dec( RightSide ); + end; + inc( cardinal( Row24Bit ), DstSurface^.pitch ); + end; + end; + 4 : + begin + Row32Bit := pointer( cardinal( DstSurface^.pixels ) + UInt32( Rect^.y ) * + DstSurface^.pitch ); + for y := 1 to Rect^.h do + begin + RightSide := Rect^.w - 1; + for x := 0 to FlipLength do + begin + Pixel := Row32Bit^[ x ]; + Row32Bit^[ x ] := Row32Bit^[ RightSide ]; + Row32Bit^[ RightSide ] := Pixel; + dec( RightSide ); + end; + inc( cardinal( Row32Bit ), DstSurface^.pitch ); + end; + end; + end; + if Locked then + SDL_UnlockSurface( DstSurface ); + end; +end; + +// Use with caution! The procedure allocates memory for TSDL_Rect and return with its pointer. +// But you MUST free it after you don't need it anymore!!! + +function PSDLRect( aLeft, aTop, aWidth, aHeight : integer ) : PSDL_Rect; +var + Rect : PSDL_Rect; +begin + New( Rect ); + with Rect^ do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; + Result := Rect; +end; + +function SDLRect( aLeft, aTop, aWidth, aHeight : integer ) : TSDL_Rect; +begin + with result do + begin + x := aLeft; + y := aTop; + w := aWidth; + h := aHeight; + end; +end; + +function SDLRect( aRect : TRect ) : TSDL_Rect; +begin + with aRect do + result := SDLRect( Left, Top, Right - Left, Bottom - Top ); +end; + +procedure SDL_Stretch8( Surface, Dst_Surface : PSDL_Surface; x1, x2, y1, y2, yr, yw, + depth : integer ); +var + dx, dy, e, d, dx2 : integer; + src_pitch, dst_pitch : uint16; + src_pixels, dst_pixels : PUint8; +begin + if ( yw >= dst_surface^.h ) then + exit; + dx := ( x2 - x1 ); + dy := ( y2 - y1 ); + dy := dy shl 1; + e := dy - dx; + dx2 := dx shl 1; + src_pitch := Surface^.pitch; + dst_pitch := dst_surface^.pitch; + src_pixels := PUint8( integer( Surface^.pixels ) + yr * src_pitch + y1 * depth ); + dst_pixels := PUint8( integer( dst_surface^.pixels ) + yw * dst_pitch + x1 * + depth ); + for d := 0 to dx - 1 do + begin + move( src_pixels^, dst_pixels^, depth ); + while ( e >= 0 ) do + begin + inc( src_pixels, depth ); + e := e - dx2; + end; + inc( dst_pixels, depth ); + e := e + dy; + end; +end; + +function sign( x : integer ) : integer; +begin + if x > 0 then + result := 1 + else + result := -1; +end; + +// Stretches a part of a surface + +function SDL_ScaleSurfaceRect( SrcSurface : PSDL_Surface; SrcX1, SrcY1, SrcW, SrcH, + Width, Height : integer ) : PSDL_Surface; +var + dst_surface : PSDL_Surface; + dx, dy, e, d, dx2, srcx2, srcy2 : integer; + destx1, desty1 : integer; +begin + srcx2 := srcx1 + SrcW; + srcy2 := srcy1 + SrcH; + result := nil; + destx1 := 0; + desty1 := 0; + dx := abs( integer( Height - desty1 ) ); + dy := abs( integer( SrcY2 - SrcY1 ) ); + e := ( dy shl 1 ) - dx; + dx2 := dx shl 1; + dy := dy shl 1; + dst_surface := SDL_CreateRGBSurface( SDL_HWPALETTE, width - destx1, Height - + desty1, + SrcSurface^.Format^.BitsPerPixel, + SrcSurface^.Format^.RMask, + SrcSurface^.Format^.GMask, + SrcSurface^.Format^.BMask, + SrcSurface^.Format^.AMask ); + if ( dst_surface^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( dst_surface, @SrcSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + SDL_SetColorKey( dst_surface, sdl_srccolorkey, SrcSurface^.format^.colorkey ); + if ( SDL_MustLock( dst_surface ) ) then + if ( SDL_LockSurface( dst_surface ) < 0 ) then + exit; + for d := 0 to dx - 1 do + begin + SDL_Stretch8( SrcSurface, dst_surface, destx1, Width, SrcX1, SrcX2, SrcY1, desty1, + SrcSurface^.format^.BytesPerPixel ); + while e >= 0 do + begin + inc( SrcY1 ); + e := e - dx2; + end; + inc( desty1 ); + e := e + dy; + end; + if SDL_MUSTLOCK( dst_surface ) then + SDL_UnlockSurface( dst_surface ); + result := dst_surface; +end; + +procedure SDL_MoveLine( Surface : PSDL_Surface; x1, x2, y1, xofs, depth : integer ); +var + src_pixels, dst_pixels : PUint8; + i : integer; +begin + src_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + x2 * + depth ); + dst_pixels := PUint8( integer( Surface^.pixels ) + Surface^.w * y1 * depth + ( x2 + + xofs ) * depth ); + for i := x2 downto x1 do + begin + move( src_pixels^, dst_pixels^, depth ); + dec( src_pixels ); + dec( dst_pixels ); + end; +end; +{ Return the pixel value at (x, y) +NOTE: The surface must be locked before calling this! } + +function SDL_GetPixel( SrcSurface : PSDL_Surface; x : integer; y : integer ) : Uint32; +var + bpp : UInt32; + p : PInteger; +begin + bpp := SrcSurface.format.BytesPerPixel; + // Here p is the address to the pixel we want to retrieve + p := Pointer( Uint32( SrcSurface.pixels ) + UInt32( y ) * SrcSurface.pitch + UInt32( x ) * + bpp ); + case bpp of + 1 : result := PUint8( p )^; + 2 : result := PUint16( p )^; + 3 : + if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then + result := PUInt8Array( p )[ 0 ] shl 16 or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] + else + result := PUInt8Array( p )[ 0 ] or PUInt8Array( p )[ 1 ] shl 8 or + PUInt8Array( p )[ 2 ] shl 16; + 4 : result := PUint32( p )^; + else + result := 0; // shouldn't happen, but avoids warnings + end; +end; +{ Set the pixel at (x, y) to the given value + NOTE: The surface must be locked before calling this! } + +procedure SDL_PutPixel( DstSurface : PSDL_Surface; x : integer; y : integer; pixel : + Uint32 ); +var + bpp : UInt32; + p : PInteger; +begin + bpp := DstSurface.format.BytesPerPixel; + p := Pointer( Uint32( DstSurface.pixels ) + UInt32( y ) * DstSurface.pitch + UInt32( x ) + * bpp ); + case bpp of + 1 : PUint8( p )^ := pixel; + 2 : PUint16( p )^ := pixel; + 3 : + if ( SDL_BYTEORDER = SDL_BIG_ENDIAN ) then + begin + PUInt8Array( p )[ 0 ] := ( pixel shr 16 ) and $FF; + PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF; + PUInt8Array( p )[ 2 ] := pixel and $FF; + end + else + begin + PUInt8Array( p )[ 0 ] := pixel and $FF; + PUInt8Array( p )[ 1 ] := ( pixel shr 8 ) and $FF; + PUInt8Array( p )[ 2 ] := ( pixel shr 16 ) and $FF; + end; + 4 : + PUint32( p )^ := pixel; + end; +end; + +procedure SDL_ScrollY( DstSurface : PSDL_Surface; DifY : integer ); +var + r1, r2 : TSDL_Rect; + //buffer: PSDL_Surface; + YPos : Integer; +begin + if ( DstSurface <> nil ) and ( DifY <> 0 ) then + begin + //if DifY > 0 then // going up + //begin + ypos := 0; + r1.x := 0; + r2.x := 0; + r1.w := DstSurface.w; + r2.w := DstSurface.w; + r1.h := DifY; + r2.h := DifY; + while ypos < DstSurface.h do + begin + r1.y := ypos; + r2.y := ypos + DifY; + SDL_BlitSurface( DstSurface, @r2, DstSurface, @r1 ); + ypos := ypos + DifY; + end; + //end + //else + //begin // Going Down + //end; + end; +end; + +{procedure SDL_ScrollY(Surface: PSDL_Surface; DifY: integer); +var + r1, r2: TSDL_Rect; + buffer: PSDL_Surface; +begin + if (Surface <> nil) and (Dify <> 0) then + begin + buffer := SDL_CreateRGBSurface(SDL_HWSURFACE, (Surface^.w - DifY) * 2, + Surface^.h * 2, + Surface^.Format^.BitsPerPixel, 0, 0, 0, 0); + if buffer <> nil then + begin + if (buffer^.format^.BytesPerPixel = 1) then + SDL_SetColors(buffer, @Surface^.format^.palette^.colors^[0], 0, 256); + r1 := SDLRect(0, DifY, buffer^.w, buffer^.h); + r2 := SDLRect(0, 0, buffer^.w, buffer^.h); + SDL_BlitSurface(Surface, @r1, buffer, @r2); + SDL_BlitSurface(buffer, @r2, Surface, @r2); + SDL_FreeSurface(buffer); + end; + end; +end;} + +procedure SDL_ScrollX( DstSurface : PSDL_Surface; DifX : integer ); +var + r1, r2 : TSDL_Rect; + buffer : PSDL_Surface; +begin + if ( DstSurface <> nil ) and ( DifX <> 0 ) then + begin + buffer := SDL_CreateRGBSurface( SDL_HWSURFACE, ( DstSurface^.w - DifX ) * 2, + DstSurface^.h * 2, + DstSurface^.Format^.BitsPerPixel, + DstSurface^.Format^.RMask, + DstSurface^.Format^.GMask, + DstSurface^.Format^.BMask, + DstSurface^.Format^.AMask ); + if buffer <> nil then + begin + if ( buffer^.format^.BytesPerPixel = 1 ) then + SDL_SetColors( buffer, @DstSurface^.format^.palette^.colors^[ 0 ], 0, 256 ); + r1 := SDLRect( DifX, 0, buffer^.w, buffer^.h ); + r2 := SDLRect( 0, 0, buffer^.w, buffer^.h ); + SDL_BlitSurface( DstSurface, @r1, buffer, @r2 ); + SDL_BlitSurface( buffer, @r2, DstSurface, @r2 ); + SDL_FreeSurface( buffer ); + end; + end; +end; + +procedure SDL_RotateRad( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Single ); +var + aSin, aCos : Single; + MX, MY, DX, DY, NX, NY, SX, SY, OX, OY, Width, Height, TX, TY, RX, RY, ROX, ROY : Integer; + Colour, TempTransparentColour : UInt32; + MAXX, MAXY : Integer; +begin + // Rotate the surface to the target surface. + TempTransparentColour := SrcSurface.format.colorkey; + {if srcRect.w > srcRect.h then + begin + Width := srcRect.w; + Height := srcRect.w; + end + else + begin + Width := srcRect.h; + Height := srcRect.h; + end; } + + maxx := DstSurface.w; + maxy := DstSurface.h; + aCos := cos( Angle ); + aSin := sin( Angle ); + + Width := round( abs( srcrect.h * acos ) + abs( srcrect.w * asin ) ); + Height := round( abs( srcrect.h * asin ) + abs( srcrect.w * acos ) ); + + OX := Width div 2; + OY := Height div 2; ; + MX := ( srcRect.x + ( srcRect.x + srcRect.w ) ) div 2; + MY := ( srcRect.y + ( srcRect.y + srcRect.h ) ) div 2; + ROX := ( -( srcRect.w div 2 ) ) + Offsetx; + ROY := ( -( srcRect.h div 2 ) ) + OffsetY; + Tx := ox + round( ROX * aSin - ROY * aCos ); + Ty := oy + round( ROY * aSin + ROX * aCos ); + SX := 0; + for DX := DestX - TX to DestX - TX + ( width ) do + begin + Inc( SX ); + SY := 0; + for DY := DestY - TY to DestY - TY + ( Height ) do + begin + RX := SX - OX; + RY := SY - OY; + NX := round( mx + RX * aSin + RY * aCos ); // + NY := round( my + RY * aSin - RX * aCos ); // + // Used for testing only + //SDL_PutPixel(DestSurface.SDLSurfacePointer,DX,DY,0); + if ( ( DX > 0 ) and ( DX < MAXX ) ) and ( ( DY > 0 ) and ( DY < MAXY ) ) then + begin + if ( NX >= srcRect.x ) and ( NX <= srcRect.x + srcRect.w ) then + begin + if ( NY >= srcRect.y ) and ( NY <= srcRect.y + srcRect.h ) then + begin + Colour := SDL_GetPixel( SrcSurface, NX, NY ); + if Colour <> TempTransparentColour then + begin + SDL_PutPixel( DstSurface, DX, DY, Colour ); + end; + end; + end; + end; + inc( SY ); + end; + end; +end; + +procedure SDL_RotateDeg( DstSurface, SrcSurface : PSDL_Surface; SrcRect : + PSDL_Rect; DestX, DestY, OffsetX, OffsetY : Integer; Angle : Integer ); +begin + SDL_RotateRad( DstSurface, SrcSurface, SrcRect, DestX, DestY, OffsetX, OffsetY, DegToRad( Angle ) ); +end; + +function ValidateSurfaceRect( DstSurface : PSDL_Surface; dstrect : PSDL_Rect ) : TSDL_Rect; +var + RealRect : TSDL_Rect; + OutOfRange : Boolean; +begin + OutOfRange := false; + if dstrect = nil then + begin + RealRect.x := 0; + RealRect.y := 0; + RealRect.w := DstSurface.w; + RealRect.h := DstSurface.h; + end + else + begin + if dstrect.x < DstSurface.w then + begin + RealRect.x := dstrect.x; + end + else if dstrect.x < 0 then + begin + realrect.x := 0; + end + else + begin + OutOfRange := True; + end; + if dstrect.y < DstSurface.h then + begin + RealRect.y := dstrect.y; + end + else if dstrect.y < 0 then + begin + realrect.y := 0; + end + else + begin + OutOfRange := True; + end; + if OutOfRange = False then + begin + if realrect.x + dstrect.w <= DstSurface.w then + begin + RealRect.w := dstrect.w; + end + else + begin + RealRect.w := dstrect.w - realrect.x; + end; + if realrect.y + dstrect.h <= DstSurface.h then + begin + RealRect.h := dstrect.h; + end + else + begin + RealRect.h := dstrect.h - realrect.y; + end; + end; + end; + if OutOfRange = False then + begin + result := realrect; + end + else + begin + realrect.w := 0; + realrect.h := 0; + realrect.x := 0; + realrect.y := 0; + result := realrect; + end; +end; + +procedure SDL_FillRectAdd( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 + Color and $E0; + G := SrcColor and $1C + Color and $1C; + B := SrcColor and $03 + Color and $03; + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 + Color and $7C00; + G := SrcColor and $03E0 + Color and $03E0; + B := SrcColor and $001F + Color and $001F; + if R > $7C00 then + R := $7C00; + if G > $03E0 then + G := $03E0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 + Color and $F800; + G := SrcColor and $07C0 + Color and $07C0; + B := SrcColor and $001F + Color and $001F; + if R > $F800 then + R := $F800; + if G > $07C0 then + G := $07C0; + if B > $001F then + B := $001F; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 + Color and $00FF0000; + G := SrcColor and $0000FF00 + Color and $0000FF00; + B := SrcColor and $000000FF + Color and $000000FF; + if R > $FF0000 then + R := $FF0000; + if G > $00FF00 then + G := $00FF00; + if B > $0000FF then + B := $0000FF; + PUInt32( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_FillRectSub( DstSurface : PSDL_Surface; dstrect : PSDL_Rect; color : UInt32 ); +var + RealRect : TSDL_Rect; + Addr : pointer; + ModX, BPP : cardinal; + x, y, R, G, B, SrcColor : cardinal; +begin + RealRect := ValidateSurfaceRect( DstSurface, DstRect ); + if ( RealRect.w > 0 ) and ( RealRect.h > 0 ) then + begin + SDL_LockSurface( DstSurface ); + BPP := DstSurface.format.BytesPerPixel; + with DstSurface^ do + begin + Addr := pointer( UInt32( pixels ) + UInt32( RealRect.y ) * pitch + UInt32( RealRect.x ) * BPP ); + ModX := Pitch - UInt32( RealRect.w ) * BPP; + end; + case DstSurface.format.BitsPerPixel of + 8 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $E0 - Color and $E0; + G := SrcColor and $1C - Color and $1C; + B := SrcColor and $03 - Color and $03; + if R > $E0 then + R := 0; + if G > $1C then + G := 0; + if B > $03 then + B := 0; + PUInt8( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 15 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $7C00 - Color and $7C00; + G := SrcColor and $03E0 - Color and $03E0; + B := SrcColor and $001F - Color and $001F; + if R > $7C00 then + R := 0; + if G > $03E0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 16 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $F800 - Color and $F800; + G := SrcColor and $07C0 - Color and $07C0; + B := SrcColor and $001F - Color and $001F; + if R > $F800 then + R := 0; + if G > $07C0 then + G := 0; + if B > $001F then + B := 0; + PUInt16( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 24 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := SrcColor and $FF000000 or R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + 32 : + begin + for y := 0 to RealRect.h - 1 do + begin + for x := 0 to RealRect.w - 1 do + begin + SrcColor := PUInt32( Addr )^; + R := SrcColor and $00FF0000 - Color and $00FF0000; + G := SrcColor and $0000FF00 - Color and $0000FF00; + B := SrcColor and $000000FF - Color and $000000FF; + if R > $FF0000 then + R := 0; + if G > $00FF00 then + G := 0; + if B > $0000FF then + B := 0; + PUInt32( Addr )^ := R or G or B; + inc( UInt32( Addr ), BPP ); + end; + inc( UInt32( Addr ), ModX ); + end; + end; + end; + SDL_UnlockSurface( DstSurface ); + end; +end; + +procedure SDL_GradientFillRect( DstSurface : PSDL_Surface; const Rect : PSDL_Rect; const StartColor, EndColor : TSDL_Color; const Style : TGradientStyle ); +var + FBC : array[ 0..255 ] of Cardinal; + // temp vars + i, YR, YG, YB, SR, SG, SB, DR, DG, DB : Integer; + + TempStepV, TempStepH : Single; + TempLeft, TempTop, TempHeight, TempWidth : integer; + TempRect : TSDL_Rect; + +begin + // calc FBC + YR := StartColor.r; + YG := StartColor.g; + YB := StartColor.b; + SR := YR; + SG := YG; + SB := YB; + DR := EndColor.r - SR; + DG := EndColor.g - SG; + DB := EndColor.b - SB; + + for i := 0 to 255 do + begin + FBC[ i ] := SDL_MapRGB( DstSurface.format, YR, YG, YB ); + YR := SR + round( DR / 255 * i ); + YG := SG + round( DG / 255 * i ); + YB := SB + round( DB / 255 * i ); + end; + + // if aStyle = 1 then begin + TempStepH := Rect.w / 255; + TempStepV := Rect.h / 255; + TempHeight := Trunc( TempStepV + 1 ); + TempWidth := Trunc( TempStepH + 1 ); + TempTop := 0; + TempLeft := 0; + TempRect.x := Rect.x; + TempRect.y := Rect.y; + TempRect.h := Rect.h; + TempRect.w := Rect.w; + + case Style of + gsHorizontal : + begin + TempRect.h := TempHeight; + for i := 0 to 255 do + begin + TempRect.y := Rect.y + TempTop; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempTop := Trunc( TempStepV * i ); + end; + end; + gsVertical : + begin + TempRect.w := TempWidth; + for i := 0 to 255 do + begin + TempRect.x := Rect.x + TempLeft; + SDL_FillRect( DstSurface, @TempRect, FBC[ i ] ); + TempLeft := Trunc( TempStepH * i ); + end; + end; + end; +end; + +procedure SDL_2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BytesPerPixel of + 1 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + DestPitch )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + DestPitch + 1 )^ := PUInt8( ReadAddr )^; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 2 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + DestPitch )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + DestPitch + 2 )^ := PUInt16( ReadAddr )^; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 3 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + DestPitch )^ := ( PUInt32( WriteAddr + DestPitch )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + DestPitch + 3 )^ := ( PUInt32( WriteAddr + DestPitch + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 4 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + DestPitch )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + DestPitch + 4 )^ := PUInt32( ReadAddr )^; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BytesPerPixel of + 1 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt8( WriteAddr )^ := PUInt8( ReadAddr )^; + PUInt8( WriteAddr + 1 )^ := PUInt8( ReadAddr )^; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 2 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt16( WriteAddr )^ := PUInt16( ReadAddr )^; + PUInt16( WriteAddr + 2 )^ := PUInt16( ReadAddr )^; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 3 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr + 3 )^ := ( PUInt32( WriteAddr + 3 )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 4 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + PUInt32( WriteAddr )^ := PUInt32( ReadAddr )^; + PUInt32( WriteAddr + 4 )^ := PUInt32( ReadAddr )^; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +procedure SDL_50Scanline2xBlit( Src, Dest : PSDL_Surface ); +var + ReadAddr, WriteAddr, ReadRow, WriteRow : UInt32; + SrcPitch, DestPitch, x, y, Color : UInt32; +begin + if ( Src = nil ) or ( Dest = nil ) then + exit; + if ( Src.w shl 1 ) < Dest.w then + exit; + if ( Src.h shl 1 ) < Dest.h then + exit; + + if SDL_MustLock( Src ) then + SDL_LockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_LockSurface( Dest ); + + ReadRow := UInt32( Src.Pixels ); + WriteRow := UInt32( Dest.Pixels ); + + SrcPitch := Src.pitch; + DestPitch := Dest.pitch; + + case Src.format.BitsPerPixel of + 8 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt8( ReadAddr )^; + PUInt8( WriteAddr )^ := Color; + PUInt8( WriteAddr + 1 )^ := Color; + Color := ( Color shr 1 ) and $6D; {%01101101} + PUInt8( WriteAddr + DestPitch )^ := Color; + PUInt8( WriteAddr + DestPitch + 1 )^ := Color; + inc( ReadAddr ); + inc( WriteAddr, 2 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 15 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt16( ReadAddr )^; + PUInt16( WriteAddr )^ := Color; + PUInt16( WriteAddr + 2 )^ := Color; + Color := ( Color shr 1 ) and $3DEF; {%0011110111101111} + PUInt16( WriteAddr + DestPitch )^ := Color; + PUInt16( WriteAddr + DestPitch + 2 )^ := Color; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 16 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt16( ReadAddr )^; + PUInt16( WriteAddr )^ := Color; + PUInt16( WriteAddr + 2 )^ := Color; + Color := ( Color shr 1 ) and $7BEF; {%0111101111101111} + PUInt16( WriteAddr + DestPitch )^ := Color; + PUInt16( WriteAddr + DestPitch + 2 )^ := Color; + inc( ReadAddr, 2 ); + inc( WriteAddr, 4 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 24 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := ( PUInt32( WriteAddr )^ and $FF000000 ) or ( PUInt32( ReadAddr )^ and $00FFFFFF ); + PUInt32( WriteAddr )^ := Color; + PUInt32( WriteAddr + 3 )^ := Color; + Color := ( Color shr 1 ) and $007F7F7F; {%011111110111111101111111} + PUInt32( WriteAddr + DestPitch )^ := Color; + PUInt32( WriteAddr + DestPitch + 3 )^ := Color; + inc( ReadAddr, 3 ); + inc( WriteAddr, 6 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + 32 : for y := 1 to Src.h do + begin + ReadAddr := ReadRow; + WriteAddr := WriteRow; + for x := 1 to Src.w do + begin + Color := PUInt32( ReadAddr )^; + PUInt32( WriteAddr )^ := Color; + PUInt32( WriteAddr + 4 )^ := Color; + Color := ( Color shr 1 ) and $7F7F7F7F; + PUInt32( WriteAddr + DestPitch )^ := Color; + PUInt32( WriteAddr + DestPitch + 4 )^ := Color; + inc( ReadAddr, 4 ); + inc( WriteAddr, 8 ); + end; + inc( UInt32( ReadRow ), SrcPitch ); + inc( UInt32( WriteRow ), DestPitch * 2 ); + end; + end; + + if SDL_MustLock( Src ) then + SDL_UnlockSurface( Src ); + if SDL_MustLock( Dest ) then + SDL_UnlockSurface( Dest ); +end; + +function SDL_PixelTestSurfaceVsRect( SrcSurface1 : PSDL_Surface; SrcRect1 : + PSDL_Rect; SrcRect2 : PSDL_Rect; Left1, Top1, Left2, Top2 : integer ) : + boolean; +var + Src_Rect1, Src_Rect2 : TSDL_Rect; + right1, bottom1 : integer; + right2, bottom2 : integer; + Scan1Start, {Scan2Start,} ScanWidth, ScanHeight : cardinal; + Mod1 : cardinal; + Addr1 : cardinal; + BPP : cardinal; + Pitch1 : cardinal; + TransparentColor1 : cardinal; + tx, ty : cardinal; +// StartTick : cardinal; // Auto Removed, Unused Variable + Color1 : cardinal; +begin + Result := false; + if SrcRect1 = nil then + begin + with Src_Rect1 do + begin + x := 0; + y := 0; + w := SrcSurface1.w; + h := SrcSurface1.h; + end; + end + else + Src_Rect1 := SrcRect1^; + + Src_Rect2 := SrcRect2^; + with Src_Rect1 do + begin + Right1 := Left1 + w; + Bottom1 := Top1 + h; + end; + with Src_Rect2 do + begin + Right2 := Left2 + w; + Bottom2 := Top2 + h; + end; + if ( Left1 >= Right2 ) or ( Right1 <= Left2 ) or ( Top1 >= Bottom2 ) or ( Bottom1 <= Top2 ) then + exit; + if Left1 <= Left2 then + begin + // 1. left, 2. right + Scan1Start := Src_Rect1.x + Left2 - Left1; + //Scan2Start := Src_Rect2.x; + ScanWidth := Right1 - Left2; + with Src_Rect2 do + if ScanWidth > w then + ScanWidth := w; + end + else + begin + // 1. right, 2. left + Scan1Start := Src_Rect1.x; + //Scan2Start := Src_Rect2.x + Left1 - Left2; + ScanWidth := Right2 - Left1; + with Src_Rect1 do + if ScanWidth > w then + ScanWidth := w; + end; + with SrcSurface1^ do + begin + Pitch1 := Pitch; + Addr1 := cardinal( Pixels ); + inc( Addr1, Pitch1 * UInt32( Src_Rect1.y ) ); + with format^ do + begin + BPP := BytesPerPixel; + TransparentColor1 := colorkey; + end; + end; + + Mod1 := Pitch1 - ( ScanWidth * BPP ); + + inc( Addr1, BPP * Scan1Start ); + + if Top1 <= Top2 then + begin + // 1. up, 2. down + ScanHeight := Bottom1 - Top2; + if ScanHeight > Src_Rect2.h then + ScanHeight := Src_Rect2.h; + inc( Addr1, Pitch1 * UInt32( Top2 - Top1 ) ); + end + else + begin + // 1. down, 2. up + ScanHeight := Bottom2 - Top1; + if ScanHeight > Src_Rect1.h then + ScanHeight := Src_Rect1.h; + + end; + case BPP of + 1 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PByte( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1 ); + + end; + inc( Addr1, Mod1 ); + + end; + 2 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 2 ); + + end; + inc( Addr1, Mod1 ); + + end; + 3 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + Color1 := PLongWord( Addr1 )^ and $00FFFFFF; + + if ( Color1 <> TransparentColor1 ) + then + begin + Result := true; + exit; + end; + inc( Addr1, 3 ); + + end; + inc( Addr1, Mod1 ); + + end; + 4 : + for ty := 1 to ScanHeight do + begin + for tx := 1 to ScanWidth do + begin + if ( PLongWord( Addr1 )^ <> TransparentColor1 ) then + begin + Result := true; + exit; + end; + inc( Addr1, 4 ); + + end; + inc( Addr1, Mod1 ); + + end; + end; +end; + +procedure SDL_ORSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var +{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B) + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + PUInt8( DestAddr )^ := Pixel2 or Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 or Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 or Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + + PUInt32( DestAddr )^ := Pixel2 or Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +procedure SDL_ANDSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var +{*R, *}{*G, *}{*B, *}Pixel1, Pixel2, TransparentColor : cardinal; // Auto Removed, Unused Variable (R) // Auto Removed, Unused Variable (G) // Auto Removed, Unused Variable (B) + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + PUInt8( DestAddr )^ := Pixel2 and Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 and Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + + PUInt16( DestAddr )^ := Pixel2 and Pixel1; + + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel2 and Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + + PUInt32( DestAddr )^ := Pixel2 and Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + + +procedure SDL_GTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 > Pixel1 and $E0 then + R := Pixel2 and $E0 + else + R := Pixel1 and $E0; + if Pixel2 and $1C > Pixel1 and $1C then + G := Pixel2 and $1C + else + G := Pixel1 and $1C; + if Pixel2 and $03 > Pixel1 and $03 then + B := Pixel2 and $03 + else + B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 > Pixel1 and $7C00 then + R := Pixel2 and $7C00 + else + R := Pixel1 and $7C00; + if Pixel2 and $03E0 > Pixel1 and $03E0 then + G := Pixel2 and $03E0 + else + G := Pixel1 and $03E0; + if Pixel2 and $001F > Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 > Pixel1 and $F800 then + R := Pixel2 and $F800 + else + R := Pixel1 and $F800; + if Pixel2 and $07E0 > Pixel1 and $07E0 then + G := Pixel2 and $07E0 + else + G := Pixel1 and $07E0; + if Pixel2 and $001F > Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 > Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 > Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF > Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + + +procedure SDL_LTSurface( SrcSurface : PSDL_Surface; SrcRect : PSDL_Rect; + DestSurface : PSDL_Surface; DestRect : PSDL_Rect ); +var + R, G, B, Pixel1, Pixel2, TransparentColor : cardinal; + Src, Dest : TSDL_Rect; + Diff : integer; + SrcAddr, DestAddr : cardinal; + WorkX, WorkY : word; + SrcMod, DestMod : cardinal; + Bits : cardinal; +begin + if ( SrcSurface = nil ) or ( DestSurface = nil ) then + exit; // Remove this to make it faster + if ( SrcSurface.Format.BitsPerPixel <> DestSurface.Format.BitsPerPixel ) then + exit; // Remove this to make it faster + if SrcRect = nil then + begin + with Src do + begin + x := 0; + y := 0; + w := SrcSurface.w; + h := SrcSurface.h; + end; + end + else + Src := SrcRect^; + if DestRect = nil then + begin + Dest.x := 0; + Dest.y := 0; + end + else + Dest := DestRect^; + Dest.w := Src.w; + Dest.h := Src.h; + with DestSurface.Clip_Rect do + begin + // Source's right side is greater than the dest.cliprect + if Dest.x + Src.w > x + w then + begin + smallint( Src.w ) := x + w - Dest.x; + smallint( Dest.w ) := x + w - Dest.x; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's bottom side is greater than the dest.clip + if Dest.y + Src.h > y + h then + begin + smallint( Src.h ) := y + h - Dest.y; + smallint( Dest.h ) := y + h - Dest.y; + if smallint( Dest.h ) < 1 then + exit; + end; + // Source's left side is less than the dest.clip + if Dest.x < x then + begin + Diff := x - Dest.x; + Src.x := Src.x + Diff; + smallint( Src.w ) := smallint( Src.w ) - Diff; + Dest.x := x; + smallint( Dest.w ) := smallint( Dest.w ) - Diff; + if smallint( Dest.w ) < 1 then + exit; + end; + // Source's Top side is less than the dest.clip + if Dest.y < y then + begin + Diff := y - Dest.y; + Src.y := Src.y + Diff; + smallint( Src.h ) := smallint( Src.h ) - Diff; + Dest.y := y; + smallint( Dest.h ) := smallint( Dest.h ) - Diff; + if smallint( Dest.h ) < 1 then + exit; + end; + end; + with SrcSurface^ do + begin + SrcAddr := cardinal( Pixels ) + UInt32( Src.y ) * Pitch + UInt32( Src.x ) * + Format.BytesPerPixel; + SrcMod := Pitch - Src.w * Format.BytesPerPixel; + TransparentColor := Format.colorkey; + end; + with DestSurface^ do + begin + DestAddr := cardinal( Pixels ) + UInt32( Dest.y ) * Pitch + UInt32( Dest.x ) * + Format.BytesPerPixel; + DestMod := Pitch - Dest.w * Format.BytesPerPixel; + Bits := Format.BitsPerPixel; + end; + SDL_LockSurface( SrcSurface ); + SDL_LockSurface( DestSurface ); + WorkY := Src.h; + case bits of + 8 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt8( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt8( DestAddr )^; + if Pixel2 > 0 then + begin + if Pixel2 and $E0 < Pixel1 and $E0 then + R := Pixel2 and $E0 + else + R := Pixel1 and $E0; + if Pixel2 and $1C < Pixel1 and $1C then + G := Pixel2 and $1C + else + G := Pixel1 and $1C; + if Pixel2 and $03 < Pixel1 and $03 then + B := Pixel2 and $03 + else + B := Pixel1 and $03; + + if R > $E0 then + R := $E0; + if G > $1C then + G := $1C; + if B > $03 then + B := $03; + PUInt8( DestAddr )^ := R or G or B; + end + else + PUInt8( DestAddr )^ := Pixel1; + end; + inc( SrcAddr ); + inc( DestAddr ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 15 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $7C00 < Pixel1 and $7C00 then + R := Pixel2 and $7C00 + else + R := Pixel1 and $7C00; + if Pixel2 and $03E0 < Pixel1 and $03E0 then + G := Pixel2 and $03E0 + else + G := Pixel1 and $03E0; + if Pixel2 and $001F < Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 16 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt16( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt16( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $F800 < Pixel1 and $F800 then + R := Pixel2 and $F800 + else + R := Pixel1 and $F800; + if Pixel2 and $07E0 < Pixel1 and $07E0 then + G := Pixel2 and $07E0 + else + G := Pixel1 and $07E0; + if Pixel2 and $001F < Pixel1 and $001F then + B := Pixel2 and $001F + else + B := Pixel1 and $001F; + + PUInt16( DestAddr )^ := R or G or B; + end + else + PUInt16( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 2 ); + inc( DestAddr, 2 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 24 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^ and $00FFFFFF; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^ and $00FFFFFF; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or ( R or G or B ); + end + else + PUInt32( DestAddr )^ := PUInt32( DestAddr )^ and $FF000000 or Pixel1; + end; + inc( SrcAddr, 3 ); + inc( DestAddr, 3 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + 32 : + begin + repeat + WorkX := Src.w; + repeat + Pixel1 := PUInt32( SrcAddr )^; + if ( Pixel1 <> TransparentColor ) and ( Pixel1 <> 0 ) then + begin + Pixel2 := PUInt32( DestAddr )^; + if Pixel2 > 0 then + begin + + if Pixel2 and $FF0000 < Pixel1 and $FF0000 then + R := Pixel2 and $FF0000 + else + R := Pixel1 and $FF0000; + if Pixel2 and $00FF00 < Pixel1 and $00FF00 then + G := Pixel2 and $00FF00 + else + G := Pixel1 and $00FF00; + if Pixel2 and $0000FF < Pixel1 and $0000FF then + B := Pixel2 and $0000FF + else + B := Pixel1 and $0000FF; + + PUInt32( DestAddr )^ := R or G or B; + end + else + PUInt32( DestAddr )^ := Pixel1; + end; + inc( SrcAddr, 4 ); + inc( DestAddr, 4 ); + dec( WorkX ); + until WorkX = 0; + inc( SrcAddr, SrcMod ); + inc( DestAddr, DestMod ); + dec( WorkY ); + until WorkY = 0; + end; + end; + SDL_UnlockSurface( SrcSurface ); + SDL_UnlockSurface( DestSurface ); +end; + +// Will clip the x1,x2,y1,x2 params to the ClipRect provided + +function SDL_ClipLine( var x1, y1, x2, y2 : Integer; ClipRect : PSDL_Rect ) : boolean; +var + tflag, flag1, flag2 : word; + txy, xedge, yedge : Integer; + slope : single; + + function ClipCode( x, y : Integer ) : word; + begin + Result := 0; + if x < ClipRect.x then + Result := 1; + if x >= ClipRect.w + ClipRect.x then + Result := Result or 2; + if y < ClipRect.y then + Result := Result or 4; + if y >= ClipRect.h + ClipRect.y then + Result := Result or 8; + end; + +begin + flag1 := ClipCode( x1, y1 ); + flag2 := ClipCode( x2, y2 ); + result := true; + + while true do + begin + if ( flag1 or flag2 ) = 0 then + Exit; // all in + + if ( flag1 and flag2 ) <> 0 then + begin + result := false; + Exit; // all out + end; + + if flag2 = 0 then + begin + txy := x1; x1 := x2; x2 := txy; + txy := y1; y1 := y2; y2 := txy; + tflag := flag1; flag1 := flag2; flag2 := tflag; + end; + + if ( flag2 and 3 ) <> 0 then + begin + if ( flag2 and 1 ) <> 0 then + xedge := ClipRect.x + else + xedge := ClipRect.w + ClipRect.x - 1; // back 1 pixel otherwise we end up in a loop + + slope := ( y2 - y1 ) / ( x2 - x1 ); + y2 := y1 + Round( slope * ( xedge - x1 ) ); + x2 := xedge; + end + else + begin + if ( flag2 and 4 ) <> 0 then + yedge := ClipRect.y + else + yedge := ClipRect.h + ClipRect.y - 1; // up 1 pixel otherwise we end up in a loop + + slope := ( x2 - x1 ) / ( y2 - y1 ); + x2 := x1 + Round( slope * ( yedge - y1 ) ); + y2 := yedge; + end; + + flag2 := ClipCode( x2, y2 ); + end; +end; + +end. + |