From 7ede07ea15a9c91f980a25ed6afbdf45987e7fcd Mon Sep 17 00:00:00 2001 From: jaybinks Date: Mon, 10 Mar 2008 02:13:08 +0000 Subject: auto removed a bunch of unused local variables ( removed with a script parsing compiler output ) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@950 b956fd51-792f-4845-bead-9b4dfca2ff2c --- Game/Code/Classes/UAudioPlayback_SDL.pas | 2 +- Game/Code/Classes/UCore.pas | 2 +- Game/Code/Classes/UGraphic.pas | 1604 ++--- Game/Code/Classes/ULog.pas | 2 +- Game/Code/Classes/URecord.pas | 1220 ++-- Game/Code/Classes/USong.pas | 1440 ++-- Game/Code/Classes/UVideo.pas | 1416 ++-- Game/Code/Screens/UScreenCredits.pas | 2818 ++++---- Game/Code/Screens/UScreenLevel.pas | 196 +- Game/Code/Screens/UScreenOptions.pas | 356 +- Game/Code/Screens/UScreenOptionsAdvanced.pas | 214 +- Game/Code/Screens/UScreenOptionsGame.pas | 228 +- Game/Code/Screens/UScreenOptionsGraphics.pas | 202 +- Game/Code/Screens/UScreenOptionsLyrics.pas | 192 +- Game/Code/Screens/UScreenOptionsSound.pas | 202 +- Game/Code/Screens/UScreenPartyPlayer.pas | 670 +- Game/Code/Screens/UScreenPartyScore.pas | 2 +- Game/Code/Screens/UScreenPartyWin.pas | 524 +- Game/Code/Screens/UScreenScore.pas | 4 +- Game/Code/Screens/UScreenSong.pas | 22 +- Game/Code/Screens/UScreenSongJumpto.pas | 414 +- Game/Code/lib/JEDI-SDL/OpenGL/Pas/opengl12.pas | 2 +- Game/Code/lib/JEDI-SDL/SDL/Pas/sdlutils.pas | 8722 ++++++++++++------------ 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 ) - @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 ) + @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 } -{ } -{ Portions created by Tom Jones are } -{ Copyright (C) 2000 - 2001 Tom Jones. } -{ } -{ } -{ Contributor(s) } -{ -------------- } -{ Dominique Louis } -{ Róbert Kisnémeth } -{ } -{ 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 } +{ } +{ Portions created by Tom Jones are } +{ Copyright (C) 2000 - 2001 Tom Jones. } +{ } +{ } +{ Contributor(s) } +{ -------------- } +{ Dominique Louis } +{ Róbert Kisnémeth } +{ } +{ 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. + -- cgit v1.2.3