aboutsummaryrefslogtreecommitdiffstats
path: root/Game/Code/Classes
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--Game/Code/Classes/UAudioPlayback_SDL.pas2
-rw-r--r--Game/Code/Classes/UCore.pas2
-rw-r--r--Game/Code/Classes/UGraphic.pas1604
-rw-r--r--Game/Code/Classes/ULog.pas2
-rw-r--r--Game/Code/Classes/URecord.pas1220
-rw-r--r--Game/Code/Classes/USong.pas1440
-rw-r--r--Game/Code/Classes/UVideo.pas1416
7 files changed, 2843 insertions, 2843 deletions
diff --git a/Game/Code/Classes/UAudioPlayback_SDL.pas b/Game/Code/Classes/UAudioPlayback_SDL.pas
index 4c9200b2..6fc22242 100644
--- a/Game/Code/Classes/UAudioPlayback_SDL.pas
+++ b/Game/Code/Classes/UAudioPlayback_SDL.pas
@@ -56,7 +56,7 @@ end;
function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean;
var
desiredAudioSpec, obtainedAudioSpec: TSDL_AudioSpec;
- err: integer;
+// err: integer; // Auto Removed, Unused Variable
begin
result := false;
diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas
index 7f05289b..a6a0ba15 100644
--- a/Game/Code/Classes/UCore.pas
+++ b/Game/Code/Classes/UCore.pas
@@ -422,7 +422,7 @@ end;
// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
//-------------
Function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
-var Params: Cardinal;
+// var Params: Cardinal; // Auto Removed, Unused Variable
begin
Result := -1;
diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas
index 90f8b34a..f681626d 100644
--- a/Game/Code/Classes/UGraphic.pas
+++ b/Game/Code/Classes/UGraphic.pas
@@ -1,802 +1,802 @@
-unit UGraphic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- OpenGL12,
- UTexture,
- TextGL,
- ULog,
- SysUtils,
- ULyrics,
- UScreenLoading,
- UScreenWelcome,
- UScreenMain,
- UScreenName,
- UScreenLevel,
- UScreenOptions,
- UScreenOptionsGame,
- UScreenOptionsGraphics,
- UScreenOptionsSound,
- UScreenOptionsLyrics,
- UScreenOptionsThemes,
- UScreenOptionsRecord,
- UScreenOptionsAdvanced,
- UScreenSong,
- UScreenSing,
- UScreenScore,
- UScreenTop5,
- UScreenEditSub,
- UScreenEdit,
- UScreenEditConvert,
- UScreenEditHeader,
- UScreenOpen,
- UThemes,
- USkins,
- UScreenSongMenu,
- UScreenSongJumpto,
- {Party Screens}
- UScreenSingModi,
- UScreenPartyNewRound,
- UScreenPartyScore,
- UScreenPartyOptions,
- UScreenPartyWin,
- UScreenPartyPlayer,
- {Stats Screens}
- UScreenStatMain,
- UScreenStatDetail,
- {CreditsScreen}
- UScreenCredits,
- {Popup for errors, etc.}
- UScreenPopup;
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
- end;
-
-var
- Screen: PSDL_Surface;
- LoadingThread: PSDL_Thread;
- Mutex: PSDL_Mutex;
-
- RenderW: integer;
- RenderH: integer;
- ScreenW: integer;
- ScreenH: integer;
- Screens: integer;
- ScreenAct: integer;
- ScreenX: integer;
-
- ScreenLoading: TScreenLoading;
- ScreenWelcome: TScreenWelcome;
- ScreenMain: TScreenMain;
- ScreenName: TScreenName;
- ScreenLevel: TScreenLevel;
- ScreenSong: TScreenSong;
- ScreenSing: TScreenSing;
- ScreenScore: TScreenScore;
- ScreenTop5: TScreenTop5;
- ScreenOptions: TScreenOptions;
- ScreenOptionsGame: TScreenOptionsGame;
- ScreenOptionsGraphics: TScreenOptionsGraphics;
- ScreenOptionsSound: TScreenOptionsSound;
- ScreenOptionsLyrics: TScreenOptionsLyrics;
- ScreenOptionsThemes: TScreenOptionsThemes;
- ScreenOptionsRecord: TScreenOptionsRecord;
- ScreenOptionsAdvanced: TScreenOptionsAdvanced;
- ScreenEditSub: TScreenEditSub;
- ScreenEdit: TScreenEdit;
- ScreenEditConvert: TScreenEditConvert;
- ScreenEditHeader: TScreenEditHeader;
- ScreenOpen: TScreenOpen;
-
- ScreenSongMenu: TScreenSongMenu;
- ScreenSongJumpto: TScreenSongJumpto;
-
- //Party Screens
- ScreenSingModi: TScreenSingModi;
- ScreenPartyNewRound: TScreenPartyNewRound;
- ScreenPartyScore: TScreenPartyScore;
- ScreenPartyWin: TScreenPartyWin;
- ScreenPartyOptions: TScreenPartyOptions;
- ScreenPartyPlayer: TScreenPartyPlayer;
-
- //StatsScreens
- ScreenStatMain: TScreenStatMain;
- ScreenStatDetail: TScreenStatDetail;
-
- //CreditsScreen
- ScreenCredits: TScreenCredits;
-
- //popup mod
- ScreenPopupCheck: TScreenPopupCheck;
- ScreenPopupError: TScreenPopupError;
-
- //Notes
- Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
- Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
- Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
-
- Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
- Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
- Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
-
- Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
- Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
- Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
-
- Tex_Note_Star: TTexture;
- Tex_Note_Perfect_Star: TTexture;
-
-
- Tex_Ball: TTexture;
- Tex_Lyric_Help_Bar: TTexture;
- FullScreen: boolean;
-
- Tex_TimeProgress: TTexture;
-
- //Sing Bar Mod
- Tex_SingBar_Back: TTexture;
- Tex_SingBar_Bar: TTexture;
- Tex_SingBar_Front: TTexture;
- //end Singbar Mod
-
- //PhrasenBonus - Line Bonus Mod
- Tex_SingLineBonusBack: array[0..8] of TTexture;
- //End PhrasenBonus - Line Bonus Mod
-
- //ScoreBG Texs
- Tex_ScoreBG: array [0..5] of TTexture;
-
- //Score Screen Textures
- Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
-
- Tex_Score_Ratings : array [0..6] of TTexture;
-
-const
- Skin_BGColorR = 1;
- Skin_BGColorG = 1;
- Skin_BGColorB = 1;
-
- Skin_SpectrumR = 0;
- Skin_SpectrumG = 0;
- Skin_SpectrumB = 0;
-
- Skin_Spectograph1R = 0.6;
- Skin_Spectograph1G = 0.8;
- Skin_Spectograph1B = 1;
-
- Skin_Spectograph2R = 0;
- Skin_Spectograph2G = 0;
- Skin_Spectograph2B = 0.2;
-
- Skin_SzczytR = 0.8;
- Skin_SzczytG = 0;
- Skin_SzczytB = 0;
-
- Skin_SzczytLimitR = 0;
- Skin_SzczytLimitG = 0.8;
- Skin_SzczytLimitB = 0;
-
- Skin_FontR = 0;
- Skin_FontG = 0;
- Skin_FontB = 0;
-
- Skin_FontHighlightR = 0.3; // 0.3
- Skin_FontHighlightG = 0.3; // 0.3
- Skin_FontHighlightB = 1; // 1
-
- Skin_TimeR = 0.25; //0,0,0
- Skin_TimeG = 0.25;
- Skin_TimeB = 0.25;
-
- Skin_OscR = 0;
- Skin_OscG = 0;
- Skin_OscB = 0;
-
- Skin_LyricsT = 494; // 500 / 510 / 400
- Skin_SpectrumT = 470;
- Skin_SpectrumBot = 570;
- Skin_SpectrumH = 100;
-
- Skin_P1_LinesR = 0.5; // 0.6 0.6 1
- Skin_P1_LinesG = 0.5;
- Skin_P1_LinesB = 0.5;
-
- Skin_P2_LinesR = 0.5; // 1 0.6 0.6
- Skin_P2_LinesG = 0.5;
- Skin_P2_LinesB = 0.5;
-
- Skin_P1_NotesB = 250;
- Skin_P2_NotesB = 430; // 430 / 300
-
- Skin_P1_ScoreT = 50;
- Skin_P1_ScoreL = 20;
-
- Skin_P2_ScoreT = 50;
- Skin_P2_ScoreL = 640;
-
-procedure Initialize3D (Title: string);
-procedure Reinitialize3D;
-procedure SwapBuffers;
-
-procedure LoadTextures;
-procedure InitializeScreen;
-procedure LoadLoadingScreen;
-procedure LoadScreens;
-procedure UnLoadScreens;
-
-function LoadingThreadFunction: integer;
-
-
-implementation
-
-uses UMain,
- UIni,
- UDisplay,
- UCommandLine,
- {$IFNDEF FPC}
- Graphics,
- {$ENDIF}
- {$IFDEF win32}
- windows,
- {$ENDIF}
- Classes;
-
-procedure LoadFontTextures;
-begin
- Log.LogStatus('Building Fonts', 'LoadTextures');
- BuildFont;
-end;
-
-procedure LoadTextures;
-
-
-var
- P: integer;
- R, G, B: real;
- Col: integer;
-begin
- // zaladowanie tekstur
- Log.LogStatus('Loading Textures', 'LoadTextures');
-
- Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch?
- Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch?
- Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch?
-
- Log.LogStatus('Loading Textures - A', 'LoadTextures');
-
- // P1-6
- // TODO... do it once for each player... this is a bit crappy !!
- // can we make it any better !?
- for P := 1 to 6 do
- begin
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
-
- Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col);
- Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col);
- Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col);
-
- Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col);
- Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col);
- Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col);
-
- Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col);
- Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col);
- Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col);
- end;
-
- Log.LogStatus('Loading Textures - B', 'LoadTextures');
-
- Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0);
- Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF);
- Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF);
- Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF);
-
-
- //TimeBar mod
- Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar')));
- //eoa TimeBar mod
-
- //SingBar Mod
- Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0);
- Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0);
- Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0);
- //end Singbar Mod
-
- Log.LogStatus('Loading Textures - C', 'LoadTextures');
-
- //Line Bonus PopUp
- for P := 0 to 8 do
- begin
- Case P of
- 0: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 1..3: begin
- R := 1;
- G := (P * 0.25);
- B := 0;
- end;
- 4: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 5..7: begin
- R := 1-((P-4)*0.25);
- G := 1;
- B := 0;
- end;
- 8: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- End;
-
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col);
- end;
-
-//## backgrounds for the scores ##
- for P := 0 to 5 do begin
- LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col);
- end;
-
-
- Log.LogStatus('Loading Textures - D', 'LoadTextures');
-
-// ######################
-// Score screen textures
-// ######################
-
-//## the bars that visualize the score ##
- for P := 1 to 6 do begin
-//NoteBar ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col);
-//LineBonus ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col);
-//GoldenNotes ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col);
- Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col);
- end;
-
-//## rating pictures that show a picture according to your rate ##
- for P := 0 to 6 do begin
- Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0);
- end;
-
- Log.LogStatus('Loading Textures - Done', 'LoadTextures');
-end;
-
-procedure Initialize3D (Title: string);
-var
-// Icon: TIcon;
-// Res: TResourceStream;
- ISurface: PSDL_Surface;
- Pixel: PByteArray;
- I: Integer;
-begin
- Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D');
-// Log.BenchmarkStart(2);
-
- LoadOpenGL;
-
- Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
- if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then
- begin
- Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
- exit;
- end;
-
- { //Load Icon
- Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON);
- Icon := TIcon.Create;
- Icon.LoadFromStream(Res);
- Res.Free;
- Icon.
- //Create icon Surface
- SDL_CreateRGBSurfaceFrom (
- SDL_SWSURFACE,
- Icon.Width,
- Icon.Height,
- 32,
- 128 or 64,
- 32 or 16,
- 8 or 4,
- 2 or 1);
- //SDL_BlitSurface(
-
-
- SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //}
-
- SDL_WM_SetCaption(PChar(Title), nil);
-
- InitializeScreen;
-
-// Log.BenchmarkEnd(2);
-// Log.LogBenchmark('--> Setting Screen', 2);
-
- // ladowanie tekstur
-// Log.BenchmarkStart(2);
- Texture := TTextureUnit.Create;
- Texture.Limit := 1024*1024;
-
-// LoadTextures;
-// Log.BenchmarkEnd(2);
-// Log.LogBenchmark('--> Loading Textures', 2);
-
-{ Log.BenchmarkStart(2);
- Lyric:= TLyric.Create;
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Fonts', 2);
-}
-
-// Log.BenchmarkStart(2);
-
- Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
- Display := TDisplay.Create;
-
- Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D');
- SDL_EnableUnicode(1);
-// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
-
-// Log.LogStatus('Loading Screens', 'Initialize3D');
-// Log.BenchmarkStart(3);
-
- Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
- LoadFontTextures();
-
- // Show the Loading Screen -------------
- Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
- LoadLoadingScreen;
-
-
- Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
- LoadTextures; // jb
-
-
-
- // now that we have something to display while loading,
- // start thread that loads the rest of ultrastar
-// Mutex := SDL_CreateMutex;
-// SDL_UnLockMutex(Mutex);
-
- // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will
- // siehe dazu kommentar unten
- // Englisch Translation:
- // is currently not working because the loading thread trys to accses opengl unchanged
- // look comment below
-
- //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
-
- // this would be run in the loadingthread
- Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
- LoadScreens;
-
-
- // TODO!!!!!!1
- // hier käme jetzt eine schleife, die
- // * den ladescreen malt (ab und zu)
- // * den "fortschritt" des ladescreens steuert
- // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und
- // * die texturen in die opengl lädt, sowie
- // * dem ladethread signalisiert, dass der speicher für die textur
- // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex)
- // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert,
- // dass er alles geladen hat fertig ist
- //
- // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche
- // opengl funktionen aufzurufen, entsprechend mutexe verändert
- // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist,
- // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ...
- //
- // English Translation:
- // here should be a loop witch
- // * draws the loading screen (form time to time)
- // * controlls the "process of the loading screen
- // * checks if the loadingthread has loaded textures (check mutex) and
- // * load the textures into opengl
- // * tells the loadingthread, that the memory for the texture can be reused
- // to load the netx texture (over another mutex)
- // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
- //
- // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
- // for itself, it should change mutex
- // the mainthread have to know somehow what opengl function have to be called with which parameters like
- // texturetype, textureobjekt, textur-buffer-adress, ...
-
-
-
- // wait for loading thread to finish
- // funktioniert so auch noch nicht - currently dos not work this way
- // SDL_WaitThread(LoadingThread, I);
- // SDL_DestroyMutex(Mutex);
-
- Display.CurrentScreen^.FadeTo( @ScreenMain );
-
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Screens', 2);
-
- Log.LogStatus('Finish', 'Initialize3D');
-end;
-
-procedure SwapBuffers;
-begin
- SDL_GL_SwapBuffers;
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- glOrtho(0, RenderW, RenderH, 0, -1, 100);
- glMatrixMode(GL_MODELVIEW);
-end;
-
-procedure Reinitialize3D;
-begin
-// InitializeScreen;
-// LoadTextures;
-// LoadScreens;
-end;
-
-procedure InitializeScreen;
-var
- S: string;
- I: integer;
- W, H: integer;
- Depth: Integer;
-begin
- if (Params.Screens <> -1) then
- Screens := Params.Screens + 1
- else
- Screens := Ini.Screens + 1;
-
- SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
- SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
-
- // If there is a resolution in Parameters, use it, else use the Ini value
- I := Params.Resolution;
- if (I <> -1) then
- S := IResolution[I]
- else
- S := IResolution[Ini.Resolution];
-
- I := Pos('x', S);
- W := StrToInt(Copy(S, 1, I-1)) * Screens;
- H := StrToInt(Copy(S, I+1, 1000));
-
- {if ParamStr(1) = '-fsblack' then begin
- W := 800;
- H := 600;
- end;
- if ParamStr(1) = '-320x240' then begin
- W := 320;
- H := 240;
- end; }
-
- If (Params.Depth <> -1) then
- Depth := Params.Depth
- else
- Depth := Ini.Depth;
-
-
- Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon');
-
-// Okay it's possible to set the title bar / taskbar icon here
-// it's working this way, but just if the bmp is in your exe folder
- SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0);
-
- Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
-// SDL_SetRefreshrate(85);
-// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
-
- {$IFDEF DARWIN}
- // Todo : eddie: remove before realease
- Ini.FullScreen := 0;
- {$ENDIF}
-
- if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE)
- end
- else
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
- SDL_ShowCursor(0);
- end;
-
- if (screen = nil) then
- begin
- Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
- exit;
- end;
-
- // clear screen once window is being shown
- glClearColor(1, 1, 1, 1);
- glClear(GL_COLOR_BUFFER_BIT);
- SwapBuffers;
-
- // zmienne
- RenderW := 800;
- RenderH := 600;
- ScreenW := W;
- ScreenH := H;
-end;
-
-procedure LoadLoadingScreen;
-begin
- ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
-
- Display.CurrentScreen := @ScreenLoading;
-
- swapbuffers;
-
- ScreenLoading.Draw;
- Display.Draw;
-
- SwapBuffers;
-end;
-
-procedure LoadScreens;
-begin
-{ ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
- Display.CurrentScreen := @ScreenLoading;
- ScreenLoading.Draw;
- Display.Draw;
- SwapBuffers;
-}
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
-{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
- ScreenMain := TScreenMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
- ScreenName := TScreenName.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
- ScreenLevel := TScreenLevel.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
- ScreenSong := TScreenSong.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
- ScreenSing := TScreenSing.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
- ScreenScore := TScreenScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
- ScreenTop5 := TScreenTop5.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
- ScreenOptions := TScreenOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
- ScreenOptionsGame := TScreenOptionsGame.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
- ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
- ScreenOptionsSound := TScreenOptionsSound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
- ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
- ScreenOptionsThemes := TScreenOptionsThemes.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
- ScreenOptionsRecord := TScreenOptionsRecord.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
- ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
- ScreenEditSub := TScreenEditSub.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
- ScreenEdit := TScreenEdit.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
- ScreenEditConvert := TScreenEditConvert.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
-// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
-// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
- ScreenOpen := TScreenOpen.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
- ScreenSingModi := TScreenSingModi.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
- ScreenSongJumpto := TScreenSongJumpto.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
- ScreenPopupCheck := TScreenPopupCheck.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
- ScreenPopupError := TScreenPopupError.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
- ScreenPartyNewRound := TScreenPartyNewRound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
- ScreenPartyScore := TScreenPartyScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
- ScreenPartyWin := TScreenPartyWin.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
- ScreenPartyOptions := TScreenPartyOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
- ScreenPartyPlayer := TScreenPartyPlayer.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
- ScreenStatMain := TScreenStatMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
- ScreenStatDetail := TScreenStatDetail.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
- ScreenCredits := TScreenCredits.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
-
-end;
-
-function LoadingThreadFunction: integer;
-begin
- LoadScreens;
- Result:= 1;
-end;
-
-procedure UnLoadScreens;
-begin
- freeandnil( ScreenMain );
- freeandnil( ScreenName );
- freeandnil( ScreenLevel);
- freeandnil( ScreenSong );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSing );
- freeandnil( ScreenScore);
- freeandnil( ScreenTop5 );
- freeandnil( ScreenOptions );
- freeandnil( ScreenOptionsGame );
- freeandnil( ScreenOptionsGraphics );
- freeandnil( ScreenOptionsSound );
- freeandnil( ScreenOptionsLyrics );
-// freeandnil( ScreenOptionsThemes );
- freeandnil( ScreenOptionsRecord );
- freeandnil( ScreenOptionsAdvanced );
- freeandnil( ScreenEditSub );
- freeandnil( ScreenEdit );
- freeandnil( ScreenEditConvert );
- freeandnil( ScreenOpen );
- freeandnil( ScreenSingModi );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSongJumpto);
- freeandnil( ScreenPopupCheck );
- freeandnil( ScreenPopupError );
- freeandnil( ScreenPartyNewRound );
- freeandnil( ScreenPartyScore );
- freeandnil( ScreenPartyWin );
- freeandnil( ScreenPartyOptions );
- freeandnil( ScreenPartyPlayer );
- freeandnil( ScreenStatMain );
- freeandnil( ScreenStatDetail );
-end;
-
-end.
+unit UGraphic;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ OpenGL12,
+ UTexture,
+ TextGL,
+ ULog,
+ SysUtils,
+ ULyrics,
+ UScreenLoading,
+ UScreenWelcome,
+ UScreenMain,
+ UScreenName,
+ UScreenLevel,
+ UScreenOptions,
+ UScreenOptionsGame,
+ UScreenOptionsGraphics,
+ UScreenOptionsSound,
+ UScreenOptionsLyrics,
+ UScreenOptionsThemes,
+ UScreenOptionsRecord,
+ UScreenOptionsAdvanced,
+ UScreenSong,
+ UScreenSing,
+ UScreenScore,
+ UScreenTop5,
+ UScreenEditSub,
+ UScreenEdit,
+ UScreenEditConvert,
+ UScreenEditHeader,
+ UScreenOpen,
+ UThemes,
+ USkins,
+ UScreenSongMenu,
+ UScreenSongJumpto,
+ {Party Screens}
+ UScreenSingModi,
+ UScreenPartyNewRound,
+ UScreenPartyScore,
+ UScreenPartyOptions,
+ UScreenPartyWin,
+ UScreenPartyPlayer,
+ {Stats Screens}
+ UScreenStatMain,
+ UScreenStatDetail,
+ {CreditsScreen}
+ UScreenCredits,
+ {Popup for errors, etc.}
+ UScreenPopup;
+
+type
+ TRecR = record
+ Top: real;
+ Left: real;
+ Right: real;
+ Bottom: real;
+ end;
+
+var
+ Screen: PSDL_Surface;
+ LoadingThread: PSDL_Thread;
+ Mutex: PSDL_Mutex;
+
+ RenderW: integer;
+ RenderH: integer;
+ ScreenW: integer;
+ ScreenH: integer;
+ Screens: integer;
+ ScreenAct: integer;
+ ScreenX: integer;
+
+ ScreenLoading: TScreenLoading;
+ ScreenWelcome: TScreenWelcome;
+ ScreenMain: TScreenMain;
+ ScreenName: TScreenName;
+ ScreenLevel: TScreenLevel;
+ ScreenSong: TScreenSong;
+ ScreenSing: TScreenSing;
+ ScreenScore: TScreenScore;
+ ScreenTop5: TScreenTop5;
+ ScreenOptions: TScreenOptions;
+ ScreenOptionsGame: TScreenOptionsGame;
+ ScreenOptionsGraphics: TScreenOptionsGraphics;
+ ScreenOptionsSound: TScreenOptionsSound;
+ ScreenOptionsLyrics: TScreenOptionsLyrics;
+ ScreenOptionsThemes: TScreenOptionsThemes;
+ ScreenOptionsRecord: TScreenOptionsRecord;
+ ScreenOptionsAdvanced: TScreenOptionsAdvanced;
+ ScreenEditSub: TScreenEditSub;
+ ScreenEdit: TScreenEdit;
+ ScreenEditConvert: TScreenEditConvert;
+ ScreenEditHeader: TScreenEditHeader;
+ ScreenOpen: TScreenOpen;
+
+ ScreenSongMenu: TScreenSongMenu;
+ ScreenSongJumpto: TScreenSongJumpto;
+
+ //Party Screens
+ ScreenSingModi: TScreenSingModi;
+ ScreenPartyNewRound: TScreenPartyNewRound;
+ ScreenPartyScore: TScreenPartyScore;
+ ScreenPartyWin: TScreenPartyWin;
+ ScreenPartyOptions: TScreenPartyOptions;
+ ScreenPartyPlayer: TScreenPartyPlayer;
+
+ //StatsScreens
+ ScreenStatMain: TScreenStatMain;
+ ScreenStatDetail: TScreenStatDetail;
+
+ //CreditsScreen
+ ScreenCredits: TScreenCredits;
+
+ //popup mod
+ ScreenPopupCheck: TScreenPopupCheck;
+ ScreenPopupError: TScreenPopupError;
+
+ //Notes
+ Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
+ Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
+ Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
+
+ Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
+ Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
+ Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
+
+ Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
+ Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
+ Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
+
+ Tex_Note_Star: TTexture;
+ Tex_Note_Perfect_Star: TTexture;
+
+
+ Tex_Ball: TTexture;
+ Tex_Lyric_Help_Bar: TTexture;
+ FullScreen: boolean;
+
+ Tex_TimeProgress: TTexture;
+
+ //Sing Bar Mod
+ Tex_SingBar_Back: TTexture;
+ Tex_SingBar_Bar: TTexture;
+ Tex_SingBar_Front: TTexture;
+ //end Singbar Mod
+
+ //PhrasenBonus - Line Bonus Mod
+ Tex_SingLineBonusBack: array[0..8] of TTexture;
+ //End PhrasenBonus - Line Bonus Mod
+
+ //ScoreBG Texs
+ Tex_ScoreBG: array [0..5] of TTexture;
+
+ //Score Screen Textures
+ Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
+
+ Tex_Score_Ratings : array [0..6] of TTexture;
+
+const
+ Skin_BGColorR = 1;
+ Skin_BGColorG = 1;
+ Skin_BGColorB = 1;
+
+ Skin_SpectrumR = 0;
+ Skin_SpectrumG = 0;
+ Skin_SpectrumB = 0;
+
+ Skin_Spectograph1R = 0.6;
+ Skin_Spectograph1G = 0.8;
+ Skin_Spectograph1B = 1;
+
+ Skin_Spectograph2R = 0;
+ Skin_Spectograph2G = 0;
+ Skin_Spectograph2B = 0.2;
+
+ Skin_SzczytR = 0.8;
+ Skin_SzczytG = 0;
+ Skin_SzczytB = 0;
+
+ Skin_SzczytLimitR = 0;
+ Skin_SzczytLimitG = 0.8;
+ Skin_SzczytLimitB = 0;
+
+ Skin_FontR = 0;
+ Skin_FontG = 0;
+ Skin_FontB = 0;
+
+ Skin_FontHighlightR = 0.3; // 0.3
+ Skin_FontHighlightG = 0.3; // 0.3
+ Skin_FontHighlightB = 1; // 1
+
+ Skin_TimeR = 0.25; //0,0,0
+ Skin_TimeG = 0.25;
+ Skin_TimeB = 0.25;
+
+ Skin_OscR = 0;
+ Skin_OscG = 0;
+ Skin_OscB = 0;
+
+ Skin_LyricsT = 494; // 500 / 510 / 400
+ Skin_SpectrumT = 470;
+ Skin_SpectrumBot = 570;
+ Skin_SpectrumH = 100;
+
+ Skin_P1_LinesR = 0.5; // 0.6 0.6 1
+ Skin_P1_LinesG = 0.5;
+ Skin_P1_LinesB = 0.5;
+
+ Skin_P2_LinesR = 0.5; // 1 0.6 0.6
+ Skin_P2_LinesG = 0.5;
+ Skin_P2_LinesB = 0.5;
+
+ Skin_P1_NotesB = 250;
+ Skin_P2_NotesB = 430; // 430 / 300
+
+ Skin_P1_ScoreT = 50;
+ Skin_P1_ScoreL = 20;
+
+ Skin_P2_ScoreT = 50;
+ Skin_P2_ScoreL = 640;
+
+procedure Initialize3D (Title: string);
+procedure Reinitialize3D;
+procedure SwapBuffers;
+
+procedure LoadTextures;
+procedure InitializeScreen;
+procedure LoadLoadingScreen;
+procedure LoadScreens;
+procedure UnLoadScreens;
+
+function LoadingThreadFunction: integer;
+
+
+implementation
+
+uses UMain,
+ UIni,
+ UDisplay,
+ UCommandLine,
+ {$IFNDEF FPC}
+ Graphics,
+ {$ENDIF}
+ {$IFDEF win32}
+ windows,
+ {$ENDIF}
+ Classes;
+
+procedure LoadFontTextures;
+begin
+ Log.LogStatus('Building Fonts', 'LoadTextures');
+ BuildFont;
+end;
+
+procedure LoadTextures;
+
+
+var
+ P: integer;
+ R, G, B: real;
+ Col: integer;
+begin
+ // zaladowanie tekstur
+ Log.LogStatus('Loading Textures', 'LoadTextures');
+
+ Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch?
+ Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch?
+ Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch?
+
+ Log.LogStatus('Loading Textures - A', 'LoadTextures');
+
+ // P1-6
+ // TODO... do it once for each player... this is a bit crappy !!
+ // can we make it any better !?
+ for P := 1 to 6 do
+ begin
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+
+ Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col);
+ Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col);
+ Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col);
+
+ Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col);
+ Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col);
+ Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col);
+
+ Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col);
+ Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col);
+ Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col);
+ end;
+
+ Log.LogStatus('Loading Textures - B', 'LoadTextures');
+
+ Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0);
+ Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF);
+ Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF);
+ Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF);
+
+
+ //TimeBar mod
+ Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar')));
+ //eoa TimeBar mod
+
+ //SingBar Mod
+ Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0);
+ Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0);
+ Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0);
+ //end Singbar Mod
+
+ Log.LogStatus('Loading Textures - C', 'LoadTextures');
+
+ //Line Bonus PopUp
+ for P := 0 to 8 do
+ begin
+ Case P of
+ 0: begin
+ R := 1;
+ G := 0;
+ B := 0;
+ end;
+ 1..3: begin
+ R := 1;
+ G := (P * 0.25);
+ B := 0;
+ end;
+ 4: begin
+ R := 1;
+ G := 1;
+ B := 0;
+ end;
+ 5..7: begin
+ R := 1-((P-4)*0.25);
+ G := 1;
+ B := 0;
+ end;
+ 8: begin
+ R := 0;
+ G := 1;
+ B := 0;
+ end;
+ End;
+
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col);
+ end;
+
+//## backgrounds for the scores ##
+ for P := 0 to 5 do begin
+ LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col);
+ end;
+
+
+ Log.LogStatus('Loading Textures - D', 'LoadTextures');
+
+// ######################
+// Score screen textures
+// ######################
+
+//## the bars that visualize the score ##
+ for P := 1 to 6 do begin
+//NoteBar ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col);
+//LineBonus ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col);
+//GoldenNotes ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col);
+ end;
+
+//## rating pictures that show a picture according to your rate ##
+ for P := 0 to 6 do begin
+ Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0);
+ end;
+
+ Log.LogStatus('Loading Textures - Done', 'LoadTextures');
+end;
+
+procedure Initialize3D (Title: string);
+//var
+// Icon: TIcon;
+// Res: TResourceStream;
+// ISurface: PSDL_Surface; // Auto Removed, Unused Variable
+// Pixel: PByteArray; // Auto Removed, Unused Variable
+// I: Integer; // Auto Removed, Unused Variable
+begin
+ Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D');
+// Log.BenchmarkStart(2);
+
+ LoadOpenGL;
+
+ Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
+ if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then
+ begin
+ Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
+ exit;
+ end;
+
+ { //Load Icon
+ Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON);
+ Icon := TIcon.Create;
+ Icon.LoadFromStream(Res);
+ Res.Free;
+ Icon.
+ //Create icon Surface
+ SDL_CreateRGBSurfaceFrom (
+ SDL_SWSURFACE,
+ Icon.Width,
+ Icon.Height,
+ 32,
+ 128 or 64,
+ 32 or 16,
+ 8 or 4,
+ 2 or 1);
+ //SDL_BlitSurface(
+
+
+ SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //}
+
+ SDL_WM_SetCaption(PChar(Title), nil);
+
+ InitializeScreen;
+
+// Log.BenchmarkEnd(2);
+// Log.LogBenchmark('--> Setting Screen', 2);
+
+ // ladowanie tekstur
+// Log.BenchmarkStart(2);
+ Texture := TTextureUnit.Create;
+ Texture.Limit := 1024*1024;
+
+// LoadTextures;
+// Log.BenchmarkEnd(2);
+// Log.LogBenchmark('--> Loading Textures', 2);
+
+{ Log.BenchmarkStart(2);
+ Lyric:= TLyric.Create;
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Fonts', 2);
+}
+
+// Log.BenchmarkStart(2);
+
+ Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
+ Display := TDisplay.Create;
+
+ Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D');
+ SDL_EnableUnicode(1);
+// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
+
+// Log.LogStatus('Loading Screens', 'Initialize3D');
+// Log.BenchmarkStart(3);
+
+ Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
+ LoadFontTextures();
+
+ // Show the Loading Screen -------------
+ Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
+ LoadLoadingScreen;
+
+
+ Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
+ LoadTextures; // jb
+
+
+
+ // now that we have something to display while loading,
+ // start thread that loads the rest of ultrastar
+// Mutex := SDL_CreateMutex;
+// SDL_UnLockMutex(Mutex);
+
+ // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will
+ // siehe dazu kommentar unten
+ // Englisch Translation:
+ // is currently not working because the loading thread trys to accses opengl unchanged
+ // look comment below
+
+ //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
+
+ // this would be run in the loadingthread
+ Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
+ LoadScreens;
+
+
+ // TODO!!!!!!1
+ // hier käme jetzt eine schleife, die
+ // * den ladescreen malt (ab und zu)
+ // * den "fortschritt" des ladescreens steuert
+ // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und
+ // * die texturen in die opengl lädt, sowie
+ // * dem ladethread signalisiert, dass der speicher für die textur
+ // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex)
+ // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert,
+ // dass er alles geladen hat fertig ist
+ //
+ // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche
+ // opengl funktionen aufzurufen, entsprechend mutexe verändert
+ // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist,
+ // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ...
+ //
+ // English Translation:
+ // here should be a loop witch
+ // * draws the loading screen (form time to time)
+ // * controlls the "process of the loading screen
+ // * checks if the loadingthread has loaded textures (check mutex) and
+ // * load the textures into opengl
+ // * tells the loadingthread, that the memory for the texture can be reused
+ // to load the netx texture (over another mutex)
+ // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
+ //
+ // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
+ // for itself, it should change mutex
+ // the mainthread have to know somehow what opengl function have to be called with which parameters like
+ // texturetype, textureobjekt, textur-buffer-adress, ...
+
+
+
+ // wait for loading thread to finish
+ // funktioniert so auch noch nicht - currently dos not work this way
+ // SDL_WaitThread(LoadingThread, I);
+ // SDL_DestroyMutex(Mutex);
+
+ Display.CurrentScreen^.FadeTo( @ScreenMain );
+
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Screens', 2);
+
+ Log.LogStatus('Finish', 'Initialize3D');
+end;
+
+procedure SwapBuffers;
+begin
+ SDL_GL_SwapBuffers;
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, RenderW, RenderH, 0, -1, 100);
+ glMatrixMode(GL_MODELVIEW);
+end;
+
+procedure Reinitialize3D;
+begin
+// InitializeScreen;
+// LoadTextures;
+// LoadScreens;
+end;
+
+procedure InitializeScreen;
+var
+ S: string;
+ I: integer;
+ W, H: integer;
+ Depth: Integer;
+begin
+ if (Params.Screens <> -1) then
+ Screens := Params.Screens + 1
+ else
+ Screens := Ini.Screens + 1;
+
+ SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
+ SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
+
+ // If there is a resolution in Parameters, use it, else use the Ini value
+ I := Params.Resolution;
+ if (I <> -1) then
+ S := IResolution[I]
+ else
+ S := IResolution[Ini.Resolution];
+
+ I := Pos('x', S);
+ W := StrToInt(Copy(S, 1, I-1)) * Screens;
+ H := StrToInt(Copy(S, I+1, 1000));
+
+ {if ParamStr(1) = '-fsblack' then begin
+ W := 800;
+ H := 600;
+ end;
+ if ParamStr(1) = '-320x240' then begin
+ W := 320;
+ H := 240;
+ end; }
+
+ If (Params.Depth <> -1) then
+ Depth := Params.Depth
+ else
+ Depth := Ini.Depth;
+
+
+ Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon');
+
+// Okay it's possible to set the title bar / taskbar icon here
+// it's working this way, but just if the bmp is in your exe folder
+ SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0);
+
+ Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
+// SDL_SetRefreshrate(85);
+// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
+
+ {$IFDEF DARWIN}
+ // Todo : eddie: remove before realease
+ Ini.FullScreen := 0;
+ {$ENDIF}
+
+ if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE)
+ end
+ else
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
+ SDL_ShowCursor(0);
+ end;
+
+ if (screen = nil) then
+ begin
+ Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
+ exit;
+ end;
+
+ // clear screen once window is being shown
+ glClearColor(1, 1, 1, 1);
+ glClear(GL_COLOR_BUFFER_BIT);
+ SwapBuffers;
+
+ // zmienne
+ RenderW := 800;
+ RenderH := 600;
+ ScreenW := W;
+ ScreenH := H;
+end;
+
+procedure LoadLoadingScreen;
+begin
+ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+
+ Display.CurrentScreen := @ScreenLoading;
+
+ swapbuffers;
+
+ ScreenLoading.Draw;
+ Display.Draw;
+
+ SwapBuffers;
+end;
+
+procedure LoadScreens;
+begin
+{ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+ Display.CurrentScreen := @ScreenLoading;
+ ScreenLoading.Draw;
+ Display.Draw;
+ SwapBuffers;
+}
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
+{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
+ ScreenMain := TScreenMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
+ ScreenName := TScreenName.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
+ ScreenLevel := TScreenLevel.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
+ ScreenSong := TScreenSong.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
+ ScreenSing := TScreenSing.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
+ ScreenScore := TScreenScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
+ ScreenTop5 := TScreenTop5.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
+ ScreenOptions := TScreenOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGame := TScreenOptionsGame.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsSound := TScreenOptionsSound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
+ ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsThemes := TScreenOptionsThemes.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
+ ScreenOptionsRecord := TScreenOptionsRecord.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
+ ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
+ ScreenEditSub := TScreenEditSub.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
+ ScreenEdit := TScreenEdit.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
+ ScreenEditConvert := TScreenEditConvert.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
+// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
+// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
+ ScreenOpen := TScreenOpen.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
+ ScreenSingModi := TScreenSingModi.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
+ ScreenSongJumpto := TScreenSongJumpto.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
+ ScreenPopupCheck := TScreenPopupCheck.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
+ ScreenPopupError := TScreenPopupError.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
+ ScreenPartyNewRound := TScreenPartyNewRound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
+ ScreenPartyScore := TScreenPartyScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
+ ScreenPartyWin := TScreenPartyWin.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
+ ScreenPartyOptions := TScreenPartyOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
+ ScreenPartyPlayer := TScreenPartyPlayer.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
+ ScreenStatMain := TScreenStatMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
+ ScreenStatDetail := TScreenStatDetail.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
+ ScreenCredits := TScreenCredits.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
+
+end;
+
+function LoadingThreadFunction: integer;
+begin
+ LoadScreens;
+ Result:= 1;
+end;
+
+procedure UnLoadScreens;
+begin
+ freeandnil( ScreenMain );
+ freeandnil( ScreenName );
+ freeandnil( ScreenLevel);
+ freeandnil( ScreenSong );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSing );
+ freeandnil( ScreenScore);
+ freeandnil( ScreenTop5 );
+ freeandnil( ScreenOptions );
+ freeandnil( ScreenOptionsGame );
+ freeandnil( ScreenOptionsGraphics );
+ freeandnil( ScreenOptionsSound );
+ freeandnil( ScreenOptionsLyrics );
+// freeandnil( ScreenOptionsThemes );
+ freeandnil( ScreenOptionsRecord );
+ freeandnil( ScreenOptionsAdvanced );
+ freeandnil( ScreenEditSub );
+ freeandnil( ScreenEdit );
+ freeandnil( ScreenEditConvert );
+ freeandnil( ScreenOpen );
+ freeandnil( ScreenSingModi );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSongJumpto);
+ freeandnil( ScreenPopupCheck );
+ freeandnil( ScreenPopupError );
+ freeandnil( ScreenPartyNewRound );
+ freeandnil( ScreenPartyScore );
+ freeandnil( ScreenPartyWin );
+ freeandnil( ScreenPartyOptions );
+ freeandnil( ScreenPartyPlayer );
+ freeandnil( ScreenStatMain );
+ freeandnil( ScreenStatDetail );
+end;
+
+end.
diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas
index 6380b10a..c30bf676 100644
--- a/Game/Code/Classes/ULog.pas
+++ b/Game/Code/Classes/ULog.pas
@@ -282,7 +282,7 @@ end;
procedure TLog.LogVoice(SoundNr: integer);
var
- FileVoice: File;
+// FileVoice: File; // Auto Removed, Unused Variable
FS: TFileStream;
FileName: string;
Num: integer;
diff --git a/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas
index bb8e38e6..2f62f441 100644
--- a/Game/Code/Classes/URecord.pas
+++ b/Game/Code/Classes/URecord.pas
@@ -1,610 +1,610 @@
-unit URecord;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses Classes,
- Math,
- SysUtils,
- UCommon,
- UMusic,
- UIni;
-
-const
- BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
- NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
-
-type
- TCaptureBuffer = class
- private
- BufferNew: TMemoryStream; // buffer for newest samples
-
- function GetToneString: string; // converts a tone to its string represenatation;
- public
- BufferArray: array[0..4095] of smallint; // newest 4096 samples
- BufferLong: TMemoryStream; // full buffer
- AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
-
- AudioFormat: TAudioFormatInfo;
-
- // pitch detection
- ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
- Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
- ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
-
- // methods
- constructor Create;
- destructor Destroy; override;
-
- procedure Clear;
-
- procedure ProcessNewBuffer;
- // use to analyze sound from buffers to get new pitch
- procedure AnalyzeBuffer;
- // we call it to analyze sound by checking Autocorrelation
- procedure AnalyzeByAutocorrelation;
- // use this to check one frequency by Autocorrelation
- function AnalyzeAutocorrelationFreq(Freq: real): real;
- function MaxSampleVolume: Single;
-
- property ToneString: string READ GetToneString;
- end;
-
- TAudioInputDeviceSource = record
- Name: string;
- end;
-
- // soundcard input-devices information
- TAudioInputDevice = class
- public
- CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Description: string; // soundcard name/description
- Source: array of TAudioInputDeviceSource; // soundcard input(-source)s
- SourceSelected: integer; // unused. What is this good for?
- MicSource: integer; // unused. What is this good for?
-
- AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
- CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
-
- destructor Destroy; override;
-
- procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-
- function Start(): boolean; virtual; abstract;
- procedure Stop(); virtual; abstract;
- end;
-
- TAudioInputProcessor = class
- public
- Sound: array of TCaptureBuffer; // sound-buffers for every player
- Device: array of TAudioInputDevice;
-
- constructor Create;
-
- // handle microphone input
- procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal;
- InputDevice: TAudioInputDevice);
- end;
-
- TAudioInputBase = class( TInterfacedObject, IAudioInput )
- private
- Started: boolean;
- protected
- function UnifyDeviceName(const name: string; deviceIndex: integer): string;
- function UnifyDeviceSourceName(const name: string; const deviceName: string): string;
- public
- function GetName: String; virtual; abstract;
- function InitializeRecord: boolean; virtual; abstract;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
-
- SmallIntArray = array [0..maxInt shr 1-1] of smallInt;
- PSmallIntArray = ^SmallIntArray;
-
- function AudioInputProcessor(): TAudioInputProcessor;
-
-implementation
-
-uses
- ULog,
- UMain;
-
-var
- singleton_AudioInputProcessor : TAudioInputProcessor = nil;
-
-
-// FIXME: Race-Conditions between Callback-thread and main-thread
-// on BufferArray (maybe BufferNew also).
-// Use SDL-mutexes to solve this problem.
-
-
-{ Global }
-
-function AudioInputProcessor(): TAudioInputProcessor;
-begin
- if singleton_AudioInputProcessor = nil then
- singleton_AudioInputProcessor := TAudioInputProcessor.create();
-
- result := singleton_AudioInputProcessor;
-end;
-
-
-{ TAudioInputDevice }
-
-destructor TAudioInputDevice.Destroy;
-var
- i: integer;
-begin
- Stop();
- Source := nil;
- CaptureChannel := nil;
- FreeAndNil(AudioFormat);
- inherited Destroy;
-end;
-
-procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-begin
- // check bounds
- if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
- Exit;
-
- // reset audio-format of old capture-buffer
- if (CaptureChannel[ChannelIndex] <> nil) then
- CaptureChannel[ChannelIndex].AudioFormat := nil;
-
- // set audio-format of new capture-buffer
- if (Sound <> nil) then
- Sound.AudioFormat := AudioFormat;
-
- // replace old with new buffer
- CaptureChannel[ChannelIndex] := Sound;
-end;
-
-{ TSound }
-
-constructor TCaptureBuffer.Create;
-begin
- inherited;
- BufferNew := TMemoryStream.Create;
- BufferLong := TMemoryStream.Create;
- AnalysisBufferSize := Min(4*1024, Length(BufferArray));
-end;
-
-destructor TCaptureBuffer.Destroy;
-begin
- AudioFormat := nil;
- FreeAndNil(BufferNew);
- FreeAndNil(BufferLong);
- inherited;
-end;
-
-procedure TCaptureBuffer.Clear;
-begin
- if assigned(BufferNew) then
- BufferNew.Clear;
- if assigned(BufferLong) then
- BufferLong.Clear;
- FillChar(BufferArray[0], Length(BufferArray) * SizeOf(SmallInt), 0);
-end;
-
-procedure TCaptureBuffer.ProcessNewBuffer;
-var
- SkipCount: integer;
- NumSamples: integer;
- SampleIndex: integer;
-begin
- // process BufferArray
- SkipCount := 0;
- NumSamples := BufferNew.Size div 2;
-
- // check if we have more new samples than we can store
- if (NumSamples > Length(BufferArray)) then
- begin
- // discard the oldest of the new samples
- SkipCount := NumSamples - Length(BufferArray);
- NumSamples := Length(BufferArray);
- end;
-
- // move old samples to the beginning of the array (if necessary)
- for SampleIndex := NumSamples to High(BufferArray) do
- BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex];
-
- // skip samples if necessary
- BufferNew.Seek(2*SkipCount, soBeginning);
- // copy samples
- BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples);
-
- // save capture-data to BufferLong if neccessary
- if (Ini.SavePlayback = 1) then
- begin
- BufferNew.Seek(0, soBeginning);
- BufferLong.CopyFrom(BufferNew, BufferNew.Size);
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeBuffer;
-var
- Volume: real;
- MaxVolume: real;
- SampleIndex: integer;
- Threshold: real;
-begin
- ToneValid := false;
- ToneAbs := -1;
- Tone := -1;
-
- // find maximum volume of first 1024 samples
- MaxVolume := 0;
- for SampleIndex := 0 to 1023 do
- begin
- Volume := Abs(BufferArray[SampleIndex]) / -Low(Smallint);
- if Volume > MaxVolume then
- MaxVolume := Volume;
- end;
-
- case Ini.Threshold of
- 0: Threshold := 0.05;
- 1: Threshold := 0.1;
- 2: Threshold := 0.15;
- 3: Threshold := 0.2;
- else Threshold := 0.1;
- end;
-
- // check if signal has an acceptable volume (ignore background-noise)
- if MaxVolume >= Threshold then
- begin
- // analyse the current voice pitch
- AnalyzeByAutocorrelation;
- ToneValid := true;
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeByAutocorrelation;
-var
- ToneIndex: integer;
- CurFreq: real;
- CurWeight: real;
- MaxWeight: real;
- MaxTone: integer;
-const
- HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
-begin
- // prepare to analyze
- MaxWeight := -1;
-
- // analyze halftones
- // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
- // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
- // too few samples -> use a bigger buffer-size
- for ToneIndex := 0 to NumHalftones-1 do
- begin
- CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
- CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
-
- // TODO: prefer higher frequencies (use >= or use downto)
- if (CurWeight > MaxWeight) then
- begin
- // this frequency has a higher weight
- MaxWeight := CurWeight;
- MaxTone := ToneIndex;
- end;
- end;
-
- ToneAbs := MaxTone;
- Tone := MaxTone mod 12;
-end;
-
-// result medium difference
-function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
-var
- Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
- AccumDist: real; // accumulated distances
- SampleIndex: integer; // index of sample to analyze
- CorrelatingSampleIndex: integer; // index of sample one period ahead
- SamplesPerPeriod: integer; // samples in one period
-begin
- SampleIndex := 0;
- SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
- CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
-
- AccumDist := 0;
-
- // compare correlating samples
- while (CorrelatingSampleIndex < AnalysisBufferSize) do
- begin
- // calc distance (correlation: 1-dist) to corresponding sample in next period
- Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) /
- High(Word);
- AccumDist := AccumDist + Dist;
- Inc(SampleIndex);
- Inc(CorrelatingSampleIndex);
- end;
-
- // return "inverse" average distance (=correlation)
- Result := 1 - AccumDist / AnalysisBufferSize;
-end;
-
-function TCaptureBuffer.MaxSampleVolume: Single;
-var
- lSampleIndex: Integer;
- lMaxVol : Longint;
-begin;
- // FIXME: lock buffer to avoid race-conditions
- lMaxVol := 0;
- for lSampleIndex := 0 to High(BufferArray) do
- begin
- if Abs(BufferArray[lSampleIndex]) > lMaxVol then
- lMaxVol := Abs(BufferArray[lSampleIndex]);
- end;
-
- result := lMaxVol / -Low(Smallint);
-end;
-
-const
- ToneStrings: array[0..11] of string = (
- 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
- );
-
-function TCaptureBuffer.GetToneString: string;
-begin
- if (ToneValid) then
- Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
- else
- Result := '-';
-end;
-
-
-{ TAudioInputProcessor }
-
-constructor TAudioInputProcessor.Create;
-var
- i: integer;
-begin
- SetLength(Sound, 6 {max players});//Ini.Players+1);
- for i := 0 to High(Sound) do
- begin
- Sound[i] := TCaptureBuffer.Create;
- end;
-end;
-
-{*
- * Handle captured microphone input data.
- * Params:
- * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
- * Interleaved means that a right-channel sample follows a left-
- * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
- * Length - number of bytes in Buffer
- * Input - Soundcard-Input used for capture
- *}
-procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice);
-var
- Value: integer;
- ChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
- SampleBuffer: PSmallIntArray; // buffer handled as array of samples
- Boost: byte;
- ChannelCount: integer;
- ChannelIndex: integer;
- ChannelOffset: integer;
- CaptureChannel: TCaptureBuffer;
- AudioFormat: TAudioFormatInfo;
- FrameSize: integer;
- NumSamples: integer;
- NumFrames: integer; // number of frames (stereo: 2xsamples)
- i: integer;
-begin
- // set boost
- case Ini.MicBoost of
- 0: Boost := 1;
- 1: Boost := 2;
- 2: Boost := 4;
- 3: Boost := 8;
- else Boost := 1;
- end;
-
- AudioFormat := InputDevice.AudioFormat;
-
- // FIXME: At the moment we assume a SInt16 format
- // TODO: use SDL_AudioConvert to convert to SInt16 but do NOT change the
- // samplerate (SDL does not convert 44.1kHz to 48kHz so we might get wrong
- // results in the analysis phase otherwise)
- if (AudioFormat.Format <> asfS16) then
- begin
- // this only occurs if a developer choosed a wrong input sample-format
- Log.CriticalError('TAudioInputProcessor.HandleMicrophoneData: Wrong sample-format');
- Exit;
- end;
-
- // interpret buffer as buffer of bytes
- SampleBuffer := Buffer;
-
- NumSamples := Size div SizeOf(Smallint);
-
- // boost buffer
- // TODO: remove this senseless stuff - adjust the threshold instead
- for i := 0 to NumSamples-1 do
- begin
- Value := SampleBuffer^[i] * Boost;
-
- // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ??
- if Value > High(Smallint) then
- Value := High(Smallint);
-
- if Value < Low(Smallint) then
- Value := Low(Smallint);
-
- SampleBuffer^[i] := Value;
- end;
-
- // samples per channel
- FrameSize := AudioFormat.Channels * SizeOf(SmallInt);
- NumFrames := Size div FrameSize;
-
- // process channels
- for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
- begin
- CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
- if (CaptureChannel <> nil) then
- begin
- // set offset according to channel index
- ChannelBuffer := @PChar(Buffer)[ChannelIndex * SizeOf(SmallInt)];
-
- // TODO: remove BufferNew and write to BufferArray directly
-
- CaptureChannel.BufferNew.Clear;
- for i := 0 to NumFrames-1 do
- begin
- CaptureChannel.BufferNew.Write(ChannelBuffer[i*FrameSize], SizeOf(SmallInt));
- end;
- CaptureChannel.ProcessNewBuffer();
- end;
- end;
-end;
-
-
-{ TAudioInputBase }
-
-{*
- * Start capturing on all used input-device.
- *}
-procedure TAudioInputBase.CaptureStart;
-var
- S: integer;
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
- DeviceUsed: boolean;
- Player: integer;
-begin
- if (Started) then
- CaptureStop();
-
- // reset buffers
- for S := 0 to High(AudioInputProcessor.Sound) do
- AudioInputProcessor.Sound[S].Clear;
-
- // start capturing on each used device
- for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
- begin
- Device := AudioInputProcessor.Device[DeviceIndex];
- if not assigned(Device) then
- continue;
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
-
- DeviceUsed := false;
-
- // check if device is used
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
- if (Player < 0) or (Player >= PlayersPlay) then
- begin
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end
- else
- begin
- Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
- DeviceUsed := true;
- end;
- end;
-
- // start device if used
- if (DeviceUsed) then
- begin
- //Log.BenchmarkStart(2);
- Device.Start();
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('Device.Start', 2) ;
- end;
- end;
-
- Started := true;
-end;
-
-{*
- * Stop input-capturing on all soundcards.
- *}
-procedure TAudioInputBase.CaptureStop;
-var
- DeviceIndex: integer;
- Player: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
-begin
- for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
- begin
- Device := AudioInputProcessor.Device[DeviceIndex];
- if not assigned(Device) then
- continue;
- Device.Stop();
- end;
-
- Started := false;
-end;
-
-function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
-var
- count: integer; // count of devices with this name
-
- function IsDuplicate(const name: string): boolean;
- var
- i: integer;
- begin
- Result := False;
- // search devices with same description
- For i := 0 to deviceIndex-1 do
- begin
- if (AudioInputProcessor.Device[i].Description = name) then
- begin
- Result := True;
- Break;
- end;
- end;
- end;
-begin
- count := 1;
- result := name;
-
- // if there is another device with the same ID, search for an available name
- while (IsDuplicate(result)) do
- begin
- Inc(count);
- // set description
- result := name + ' ('+IntToStr(count)+')';
- end;
-end;
-
-{*
- * Unifies an input-device's source name.
- * Note: the description member of the device must already be set when
- * calling this function.
- *}
-function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string;
-var
- Descr: string;
-begin
- result := name;
-
- {$IFDEF DARWIN}
- // Under MacOSX the SingStar Mics have an empty
- // InputName. So, we have to add a hard coded
- // Workaround for this problem
- if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then
- begin
- result := 'Microphone';
- end;
- {$ENDIF}
-end;
-
-end.
-
-
-
+unit URecord;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses Classes,
+ Math,
+ SysUtils,
+ UCommon,
+ UMusic,
+ UIni;
+
+const
+ BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
+ NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
+
+type
+ TCaptureBuffer = class
+ private
+ BufferNew: TMemoryStream; // buffer for newest samples
+
+ function GetToneString: string; // converts a tone to its string represenatation;
+ public
+ BufferArray: array[0..4095] of smallint; // newest 4096 samples
+ BufferLong: TMemoryStream; // full buffer
+ AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
+
+ AudioFormat: TAudioFormatInfo;
+
+ // pitch detection
+ ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
+ Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
+ ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
+
+ // methods
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure Clear;
+
+ procedure ProcessNewBuffer;
+ // use to analyze sound from buffers to get new pitch
+ procedure AnalyzeBuffer;
+ // we call it to analyze sound by checking Autocorrelation
+ procedure AnalyzeByAutocorrelation;
+ // use this to check one frequency by Autocorrelation
+ function AnalyzeAutocorrelationFreq(Freq: real): real;
+ function MaxSampleVolume: Single;
+
+ property ToneString: string READ GetToneString;
+ end;
+
+ TAudioInputDeviceSource = record
+ Name: string;
+ end;
+
+ // soundcard input-devices information
+ TAudioInputDevice = class
+ public
+ CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
+ Description: string; // soundcard name/description
+ Source: array of TAudioInputDeviceSource; // soundcard input(-source)s
+ SourceSelected: integer; // unused. What is this good for?
+ MicSource: integer; // unused. What is this good for?
+
+ AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
+ CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
+
+ destructor Destroy; override;
+
+ procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
+
+ function Start(): boolean; virtual; abstract;
+ procedure Stop(); virtual; abstract;
+ end;
+
+ TAudioInputProcessor = class
+ public
+ Sound: array of TCaptureBuffer; // sound-buffers for every player
+ Device: array of TAudioInputDevice;
+
+ constructor Create;
+
+ // handle microphone input
+ procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal;
+ InputDevice: TAudioInputDevice);
+ end;
+
+ TAudioInputBase = class( TInterfacedObject, IAudioInput )
+ private
+ Started: boolean;
+ protected
+ function UnifyDeviceName(const name: string; deviceIndex: integer): string;
+ function UnifyDeviceSourceName(const name: string; const deviceName: string): string;
+ public
+ function GetName: String; virtual; abstract;
+ function InitializeRecord: boolean; virtual; abstract;
+
+ procedure CaptureStart;
+ procedure CaptureStop;
+ end;
+
+
+ SmallIntArray = array [0..maxInt shr 1-1] of smallInt;
+ PSmallIntArray = ^SmallIntArray;
+
+ function AudioInputProcessor(): TAudioInputProcessor;
+
+implementation
+
+uses
+ ULog,
+ UMain;
+
+var
+ singleton_AudioInputProcessor : TAudioInputProcessor = nil;
+
+
+// FIXME: Race-Conditions between Callback-thread and main-thread
+// on BufferArray (maybe BufferNew also).
+// Use SDL-mutexes to solve this problem.
+
+
+{ Global }
+
+function AudioInputProcessor(): TAudioInputProcessor;
+begin
+ if singleton_AudioInputProcessor = nil then
+ singleton_AudioInputProcessor := TAudioInputProcessor.create();
+
+ result := singleton_AudioInputProcessor;
+end;
+
+
+{ TAudioInputDevice }
+
+destructor TAudioInputDevice.Destroy;
+//var
+// i: integer; // Auto Removed, Unused Variable
+begin
+ Stop();
+ Source := nil;
+ CaptureChannel := nil;
+ FreeAndNil(AudioFormat);
+ inherited Destroy;
+end;
+
+procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
+begin
+ // check bounds
+ if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
+ Exit;
+
+ // reset audio-format of old capture-buffer
+ if (CaptureChannel[ChannelIndex] <> nil) then
+ CaptureChannel[ChannelIndex].AudioFormat := nil;
+
+ // set audio-format of new capture-buffer
+ if (Sound <> nil) then
+ Sound.AudioFormat := AudioFormat;
+
+ // replace old with new buffer
+ CaptureChannel[ChannelIndex] := Sound;
+end;
+
+{ TSound }
+
+constructor TCaptureBuffer.Create;
+begin
+ inherited;
+ BufferNew := TMemoryStream.Create;
+ BufferLong := TMemoryStream.Create;
+ AnalysisBufferSize := Min(4*1024, Length(BufferArray));
+end;
+
+destructor TCaptureBuffer.Destroy;
+begin
+ AudioFormat := nil;
+ FreeAndNil(BufferNew);
+ FreeAndNil(BufferLong);
+ inherited;
+end;
+
+procedure TCaptureBuffer.Clear;
+begin
+ if assigned(BufferNew) then
+ BufferNew.Clear;
+ if assigned(BufferLong) then
+ BufferLong.Clear;
+ FillChar(BufferArray[0], Length(BufferArray) * SizeOf(SmallInt), 0);
+end;
+
+procedure TCaptureBuffer.ProcessNewBuffer;
+var
+ SkipCount: integer;
+ NumSamples: integer;
+ SampleIndex: integer;
+begin
+ // process BufferArray
+ SkipCount := 0;
+ NumSamples := BufferNew.Size div 2;
+
+ // check if we have more new samples than we can store
+ if (NumSamples > Length(BufferArray)) then
+ begin
+ // discard the oldest of the new samples
+ SkipCount := NumSamples - Length(BufferArray);
+ NumSamples := Length(BufferArray);
+ end;
+
+ // move old samples to the beginning of the array (if necessary)
+ for SampleIndex := NumSamples to High(BufferArray) do
+ BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex];
+
+ // skip samples if necessary
+ BufferNew.Seek(2*SkipCount, soBeginning);
+ // copy samples
+ BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples);
+
+ // save capture-data to BufferLong if neccessary
+ if (Ini.SavePlayback = 1) then
+ begin
+ BufferNew.Seek(0, soBeginning);
+ BufferLong.CopyFrom(BufferNew, BufferNew.Size);
+ end;
+end;
+
+procedure TCaptureBuffer.AnalyzeBuffer;
+var
+ Volume: real;
+ MaxVolume: real;
+ SampleIndex: integer;
+ Threshold: real;
+begin
+ ToneValid := false;
+ ToneAbs := -1;
+ Tone := -1;
+
+ // find maximum volume of first 1024 samples
+ MaxVolume := 0;
+ for SampleIndex := 0 to 1023 do
+ begin
+ Volume := Abs(BufferArray[SampleIndex]) / -Low(Smallint);
+ if Volume > MaxVolume then
+ MaxVolume := Volume;
+ end;
+
+ case Ini.Threshold of
+ 0: Threshold := 0.05;
+ 1: Threshold := 0.1;
+ 2: Threshold := 0.15;
+ 3: Threshold := 0.2;
+ else Threshold := 0.1;
+ end;
+
+ // check if signal has an acceptable volume (ignore background-noise)
+ if MaxVolume >= Threshold then
+ begin
+ // analyse the current voice pitch
+ AnalyzeByAutocorrelation;
+ ToneValid := true;
+ end;
+end;
+
+procedure TCaptureBuffer.AnalyzeByAutocorrelation;
+var
+ ToneIndex: integer;
+ CurFreq: real;
+ CurWeight: real;
+ MaxWeight: real;
+ MaxTone: integer;
+const
+ HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
+begin
+ // prepare to analyze
+ MaxWeight := -1;
+
+ // analyze halftones
+ // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
+ // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
+ // too few samples -> use a bigger buffer-size
+ for ToneIndex := 0 to NumHalftones-1 do
+ begin
+ CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
+ CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
+
+ // TODO: prefer higher frequencies (use >= or use downto)
+ if (CurWeight > MaxWeight) then
+ begin
+ // this frequency has a higher weight
+ MaxWeight := CurWeight;
+ MaxTone := ToneIndex;
+ end;
+ end;
+
+ ToneAbs := MaxTone;
+ Tone := MaxTone mod 12;
+end;
+
+// result medium difference
+function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
+var
+ Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
+ AccumDist: real; // accumulated distances
+ SampleIndex: integer; // index of sample to analyze
+ CorrelatingSampleIndex: integer; // index of sample one period ahead
+ SamplesPerPeriod: integer; // samples in one period
+begin
+ SampleIndex := 0;
+ SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
+ CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
+
+ AccumDist := 0;
+
+ // compare correlating samples
+ while (CorrelatingSampleIndex < AnalysisBufferSize) do
+ begin
+ // calc distance (correlation: 1-dist) to corresponding sample in next period
+ Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) /
+ High(Word);
+ AccumDist := AccumDist + Dist;
+ Inc(SampleIndex);
+ Inc(CorrelatingSampleIndex);
+ end;
+
+ // return "inverse" average distance (=correlation)
+ Result := 1 - AccumDist / AnalysisBufferSize;
+end;
+
+function TCaptureBuffer.MaxSampleVolume: Single;
+var
+ lSampleIndex: Integer;
+ lMaxVol : Longint;
+begin;
+ // FIXME: lock buffer to avoid race-conditions
+ lMaxVol := 0;
+ for lSampleIndex := 0 to High(BufferArray) do
+ begin
+ if Abs(BufferArray[lSampleIndex]) > lMaxVol then
+ lMaxVol := Abs(BufferArray[lSampleIndex]);
+ end;
+
+ result := lMaxVol / -Low(Smallint);
+end;
+
+const
+ ToneStrings: array[0..11] of string = (
+ 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
+ );
+
+function TCaptureBuffer.GetToneString: string;
+begin
+ if (ToneValid) then
+ Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
+ else
+ Result := '-';
+end;
+
+
+{ TAudioInputProcessor }
+
+constructor TAudioInputProcessor.Create;
+var
+ i: integer;
+begin
+ SetLength(Sound, 6 {max players});//Ini.Players+1);
+ for i := 0 to High(Sound) do
+ begin
+ Sound[i] := TCaptureBuffer.Create;
+ end;
+end;
+
+{*
+ * Handle captured microphone input data.
+ * Params:
+ * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
+ * Interleaved means that a right-channel sample follows a left-
+ * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
+ * Length - number of bytes in Buffer
+ * Input - Soundcard-Input used for capture
+ *}
+procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice);
+var
+ Value: integer;
+ ChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
+ SampleBuffer: PSmallIntArray; // buffer handled as array of samples
+ Boost: byte;
+// ChannelCount: integer; // Auto Removed, Unused Variable
+ ChannelIndex: integer;
+// ChannelOffset: integer; // Auto Removed, Unused Variable
+ CaptureChannel: TCaptureBuffer;
+ AudioFormat: TAudioFormatInfo;
+ FrameSize: integer;
+ NumSamples: integer;
+ NumFrames: integer; // number of frames (stereo: 2xsamples)
+ i: integer;
+begin
+ // set boost
+ case Ini.MicBoost of
+ 0: Boost := 1;
+ 1: Boost := 2;
+ 2: Boost := 4;
+ 3: Boost := 8;
+ else Boost := 1;
+ end;
+
+ AudioFormat := InputDevice.AudioFormat;
+
+ // FIXME: At the moment we assume a SInt16 format
+ // TODO: use SDL_AudioConvert to convert to SInt16 but do NOT change the
+ // samplerate (SDL does not convert 44.1kHz to 48kHz so we might get wrong
+ // results in the analysis phase otherwise)
+ if (AudioFormat.Format <> asfS16) then
+ begin
+ // this only occurs if a developer choosed a wrong input sample-format
+ Log.CriticalError('TAudioInputProcessor.HandleMicrophoneData: Wrong sample-format');
+ Exit;
+ end;
+
+ // interpret buffer as buffer of bytes
+ SampleBuffer := Buffer;
+
+ NumSamples := Size div SizeOf(Smallint);
+
+ // boost buffer
+ // TODO: remove this senseless stuff - adjust the threshold instead
+ for i := 0 to NumSamples-1 do
+ begin
+ Value := SampleBuffer^[i] * Boost;
+
+ // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ??
+ if Value > High(Smallint) then
+ Value := High(Smallint);
+
+ if Value < Low(Smallint) then
+ Value := Low(Smallint);
+
+ SampleBuffer^[i] := Value;
+ end;
+
+ // samples per channel
+ FrameSize := AudioFormat.Channels * SizeOf(SmallInt);
+ NumFrames := Size div FrameSize;
+
+ // process channels
+ for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
+ begin
+ CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
+ if (CaptureChannel <> nil) then
+ begin
+ // set offset according to channel index
+ ChannelBuffer := @PChar(Buffer)[ChannelIndex * SizeOf(SmallInt)];
+
+ // TODO: remove BufferNew and write to BufferArray directly
+
+ CaptureChannel.BufferNew.Clear;
+ for i := 0 to NumFrames-1 do
+ begin
+ CaptureChannel.BufferNew.Write(ChannelBuffer[i*FrameSize], SizeOf(SmallInt));
+ end;
+ CaptureChannel.ProcessNewBuffer();
+ end;
+ end;
+end;
+
+
+{ TAudioInputBase }
+
+{*
+ * Start capturing on all used input-device.
+ *}
+procedure TAudioInputBase.CaptureStart;
+var
+ S: integer;
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+ DeviceUsed: boolean;
+ Player: integer;
+begin
+ if (Started) then
+ CaptureStop();
+
+ // reset buffers
+ for S := 0 to High(AudioInputProcessor.Sound) do
+ AudioInputProcessor.Sound[S].Clear;
+
+ // start capturing on each used device
+ for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
+ begin
+ Device := AudioInputProcessor.Device[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+ DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
+
+ DeviceUsed := false;
+
+ // check if device is used
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ begin
+ Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
+ if (Player < 0) or (Player >= PlayersPlay) then
+ begin
+ Device.LinkCaptureBuffer(ChannelIndex, nil);
+ end
+ else
+ begin
+ Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
+ DeviceUsed := true;
+ end;
+ end;
+
+ // start device if used
+ if (DeviceUsed) then
+ begin
+ //Log.BenchmarkStart(2);
+ Device.Start();
+ //Log.BenchmarkEnd(2);
+ //Log.LogBenchmark('Device.Start', 2) ;
+ end;
+ end;
+
+ Started := true;
+end;
+
+{*
+ * Stop input-capturing on all soundcards.
+ *}
+procedure TAudioInputBase.CaptureStop;
+var
+ DeviceIndex: integer;
+// Player: integer; // Auto Removed, Unused Variable
+ Device: TAudioInputDevice;
+// DeviceCfg: PInputDeviceConfig; // Auto Removed, Unused Variable
+begin
+ for DeviceIndex := 0 to High(AudioInputProcessor.Device) do
+ begin
+ Device := AudioInputProcessor.Device[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+ Device.Stop();
+ end;
+
+ Started := false;
+end;
+
+function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
+var
+ count: integer; // count of devices with this name
+
+ function IsDuplicate(const name: string): boolean;
+ var
+ i: integer;
+ begin
+ Result := False;
+ // search devices with same description
+ For i := 0 to deviceIndex-1 do
+ begin
+ if (AudioInputProcessor.Device[i].Description = name) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+ end;
+begin
+ count := 1;
+ result := name;
+
+ // if there is another device with the same ID, search for an available name
+ while (IsDuplicate(result)) do
+ begin
+ Inc(count);
+ // set description
+ result := name + ' ('+IntToStr(count)+')';
+ end;
+end;
+
+{*
+ * Unifies an input-device's source name.
+ * Note: the description member of the device must already be set when
+ * calling this function.
+ *}
+function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string;
+//var
+// Descr: string; // Auto Removed, Unused Variable
+begin
+ result := name;
+
+ {$IFDEF DARWIN}
+ // Under MacOSX the SingStar Mics have an empty
+ // InputName. So, we have to add a hard coded
+ // Workaround for this problem
+ if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then
+ begin
+ result := 'Microphone';
+ end;
+ {$ENDIF}
+end;
+
+end.
+
+
+
diff --git a/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas
index 940f2779..427cba2e 100644
--- a/Game/Code/Classes/USong.pas
+++ b/Game/Code/Classes/USong.pas
@@ -1,720 +1,720 @@
-unit USong;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- SysUtils,
- Classes,
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- UCatCovers;
-
-type
-
- TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: widestring;
- Score: integer;
- Length: string;
- end;
-
- TSong = class
- FileLineNo : integer; //Line which is readed at Last, for error reporting
-
- procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
- procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
-
- function ReadTXTHeader( const aFileName : WideString ): boolean;
- public
- Path: widestring;
- Folder: widestring; // for sorting by folder
- fFileName,
- FileName: widestring;
-
- // sorting methods
- Category: array of widestring; // I think I won't need this
- Genre: widestring;
- Edition: widestring;
- Language: widestring; // 0.5.0: new
-
- Title: widestring;
- Artist: widestring;
-
- Text: widestring;
- Creator: widestring;
-
- Cover: widestring;
- CoverTex: TTexture;
- Mp3: widestring;
- Background: widestring;
- Video: widestring;
- VideoGAP: real;
- VideoLoaded: boolean; // 0.5.0: true if the video has been loaded
- NotesGAP: integer;
- Start: real; // in seconds
- Finish: integer; // in miliseconds
- Relative: boolean;
- Resolution: integer;
- BPM: array of TBPM;
- GAP: real; // in miliseconds
-
- Score: array[0..2] of array of TScore;
-
- // these are used when sorting is enabled
- Visible: boolean; // false if hidden, true if visible
- Main: boolean; // false for songs, true for category buttons
- OrderNum: integer; // has a number of category for category buttons and songs
- OrderTyp: integer; // type of sorting for this button (0=name)
- CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
-
- SongFile: TextFile; // all procedures in this unit operates on this file
-
- Base : array[0..1] of integer;
- Rel : array[0..1] of integer;
- Mult : integer;
- MultBPM : integer;
-
- constructor create ( const aFileName : WideString );
- function LoadSong: boolean;
- function Analyse(): boolean;
- procedure clear();
- end;
-
-implementation
-
-uses
- TextGL,
- UIni,
- UMusic, //needed for Lines
- UMain; //needed for Player
-
-constructor TSong.create( const aFileName : WideString );
-begin
-
- Mult := 1;
-
- MultBPM := 4;
-
-
- fFileName := aFileName;
-
-
- if fileexists( aFileName ) then
-
- begin
-
- self.Path := ExtractFilePath( aFileName );
- self.Folder := ExtractFilePath( aFileName );
- self.FileName := ExtractFileName( aFileName );
-
-(*
-
- if ReadTXTHeader( aFileName ) then
-
- begin
-
- LoadSong();
-
- end
- else
- begin
- Log.LogError('Error Loading SongHeader, abort Song Loading');
- Exit;
- end;
-*)
- end;
-
-end;
-
-
-function TSong.LoadSong(): boolean;
-
-var
- TempC: char;
- Text: string;
- CP: integer; // Current Player (0 or 1)
- Count: integer;
- Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I: Integer;
-begin
- Result := false;
-
- if not FileExists(Path + PathDelim + FileName) then
- begin
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
- exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
- Lines[0].NoteType := 0;
- self.Relative := false;
- Rel[0] := 0;
- CP := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- try
- // Open song file for reading.....
- FileMode := fmOpenRead;
- AssignFile(SongFile, fFileName);
- Reset(SongFile);
-
- //Clear old Song Header
- if (self.Path = '') then
- self.Path := ExtractFilePath(FileName);
-
- if (self.FileName = '') then
- self.Filename := ExtractFileName(FileName);
-
- Result := False;
-
- Reset(SongFile);
- FileLineNo := 0;
- //Search for Note Begining
- repeat
- ReadLn(SongFile, Text);
- Inc(FileLineNo);
-
- if (EoF(SongFile)) then
- begin //Song File Corrupted - No Notes
- CloseFile(SongFile);
- Log.LogError('Could not load txt File, no Notes found: ' + FileName);
- Result := False;
- Exit;
- end;
- Read(SongFile, TempC);
- until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
-
- SetLength(Lines, 2);
- for Count := 0 to High(Lines) do begin
- SetLength(Lines[Count].Line, 1);
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].Line[0].IlNut := 0;
- Lines[Count].Line[0].HighNote := -1;
- end;
-
- // TempC := ':';
- // TempC := Text[1]; // read from backup variable, don't use default ':' value
-
- while (TempC <> 'E') AND (not EOF(SongFile)) do
- begin
-
- if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin
- // read notes
- Read(SongFile, Param1);
- Read(SongFile, Param2);
- Read(SongFile, Param3);
- Read(SongFile, ParamS);
-
- //Check for ZeroNote
- if Param2 = 0 then Log.LogError('Error: Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+' '+ParamS+'" -> Note ignored!') else
- begin
- // add notes
- if not Both then
- // P1
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else begin
- // P1 + P2
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
- ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
- end;
- end; //Zeronote check
- end; // if
-
- if TempC = '-' then
- begin
- // reads sentence
- Read(SongFile, Param1);
- if self.Relative then Read(SongFile, Param2); // read one more data for relative system
-
- // new sentence
- if not Both then
- // P1
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
- else begin
- // P1 + P2
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
- NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
- end;
- end; // if
-
- if TempC = 'B' then
- begin
- SetLength(self.BPM, Length(self.BPM) + 1);
- Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
- self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
-
- Read(SongFile, Text);
- self.BPM[High(self.BPM)].BPM := StrToFloat(Text);
- self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
- end;
-
-
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Lenght * Lines[CP].Line[Lines[CP].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
- end else begin
- for Count := 0 to High(Lines) do begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Lenght * Lines[Count].Line[Lines[Count].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
- end;
- end;
- Read(SongFile, TempC);
- Inc(FileLineNo);
- end; // while}
-
- CloseFile(SongFile);
- except
- try
- CloseFile(SongFile);
- except
-
- end;
-
- Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
- exit;
- end;
-
- Result := true;
-end;
-
-
-function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
-
- function song_StrtoFloat( aValue : String ) : Extended;
- var
- lValue : String;
- lOldDecimalSeparator : Char;
- begin
- lValue := aValue;
-
- if (Pos(',', lValue) <> 0) then
- lValue[Pos(',', lValue)] := '.';
-
- Result := StrToFloatDef(lValue, 0);
- end;
-
-var
- Line, Identifier, Value: String;
- Temp : word;
- Done : byte;
-begin
- Result := true;
- Done := 0;
-
- //Read first Line
- ReadLn (SongFile, Line);
-
- if (Length(Line)<=0) then
- begin
- Log.LogError('File Starts with Empty Line: ' + aFileName);
- Result := False;
- Exit;
- end;
-
- //Read Lines while Line starts with # or its empty
- While ( Length(Line) = 0 ) OR
- ( Line[1] = '#' ) DO
- begin
- //Increase Line Number
- Inc (FileLineNo);
- Temp := Pos(':', Line);
-
- //Line has a Seperator-> Headerline
- if (Temp <> 0) then
- begin
- //Read Identifier and Value
- Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks
- Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp));
-
- //Check the Identifier (If Value is given)
- if (Length(Value) <> 0) then
- begin
-
- //-----------
- //Required Attributes
- //-----------
-
- {$IFDEF UTF8_FILENAMES}
- if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
- Value := Utf8Encode(Value);
- {$ENDIF}
-
- //Title
- if (Identifier = 'TITLE') then
- begin
- self.Title := Value;
-
- //Add Title Flag to Done
- Done := Done or 1;
- end
-
- //Artist
- else if (Identifier = 'ARTIST') then
- begin
- self.Artist := Value;
-
- //Add Artist Flag to Done
- Done := Done or 2;
- end
-
- //MP3 File //Test if Exists
- else if (Identifier = 'MP3') AND
- (FileExists(self.Path + Value)) then
- begin
- self.Mp3 := Value;
-
- //Add Mp3 Flag to Done
- Done := Done or 4;
- end
-
- //Beats per Minute
- else if (Identifier = 'BPM') then
- begin
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
-
- if self.BPM[0].BPM <> 0 then
- begin
- //Add BPM Flag to Done
- Done := Done or 8;
- end;
- end
-
- //---------
- //Additional Header Information
- //---------
-
- // Video Gap
- else if (Identifier = 'GAP') then
- self.GAP := song_StrtoFloat( Value )
-
- //Cover Picture
- else if (Identifier = 'COVER') then
- self.Cover := Value
-
- //Background Picture
- else if (Identifier = 'BACKGROUND') then
- self.Background := Value
-
- // Video File
- else if (Identifier = 'VIDEO') then
- begin
- if (FileExists(self.Path + Value)) then
- self.Video := Value
- else
- Log.LogError('Can''t find Video File in Song: ' + aFileName);
- end
-
- // Video Gap
- else if (Identifier = 'VIDEOGAP') then
- self.VideoGAP := song_StrtoFloat( Value )
-
- //Genre Sorting
- else if (Identifier = 'GENRE') then
- self.Genre := Value
-
- //Edition Sorting
- else if (Identifier = 'EDITION') then
- self.Edition := Value
-
- //Creator Tag
- else if (Identifier = 'CREATOR') then
- self.Creator := Value
-
- //Language Sorting
- else if (Identifier = 'LANGUAGE') then
- self.Language := Value
-
- // Song Start
- else if (Identifier = 'START') then
- self.Start := song_StrtoFloat( Value )
-
- // Song Ending
- else if (Identifier = 'END') then
- TryStrtoInt(Value, self.Finish)
-
- // Resolution
- else if (Identifier = 'RESOLUTION') then
- TryStrtoInt(Value, self.Resolution)
-
- // Notes Gap
- else if (Identifier = 'NOTESGAP') then
- TryStrtoInt(Value, self.NotesGAP)
- // Relative Notes
- else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then
- self.Relative := True;
-
- end;
- end;
-
- if not EOf(SongFile) then
- ReadLn (SongFile, Line)
- else
- begin
- Result := False;
- Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
- break;
- end;
-
- end;
-
- if self.Cover = '' then
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := False;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM Tag Missing: ' + self.FileName)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
- else //unknown Error
- Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
- end;
-
-end;
-
-procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
-var
- Space: boolean;
-begin
- case Ini.Solmization of
- 1: // european
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' si ';
- end;
- end;
- 2: // japanese
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' so ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' shi ';
- end;
- end;
- 3: // american
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' ti ';
- end;
- end;
- end; // case
-
- with Lines[LineNumber].Line[Lines[LineNumber].High] do begin
- SetLength(Note, Length(Note) + 1);
- IlNut := IlNut + 1;
- HighNote := HighNote + 1;
- Melody.IlNut := Melody.IlNut + 1;
-
- Note[HighNote].Start := StartP;
- if IlNut = 1 then begin
- StartNote := Note[HighNote].Start;
- if Lines[LineNumber].Number = 1 then
- Start := -100;
-// Start := Note[HighNote].Start;
- end;
-
- Note[HighNote].Lenght := DurationP;
- Melody.NoteLenght := Melody.NoteLenght + Note[HighNote].Lenght;
-
- // back to the normal system with normal, golden and now freestyle notes
- case TypeP of
- 'F': Note[HighNote].NoteType := 0;
- ':': Note[HighNote].NoteType := 1;
- '*': Note[HighNote].NoteType := 2;
- end;
-
- Lines[LineNumber].NoteType := Lines[LineNumber].NoteType + Note[HighNote].Lenght * Note[HighNote].NoteType;
-
- Note[HighNote].Tone := NoteP;
- if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
- Note[HighNote].ToneGamus := Note[HighNote].ToneGamus mod 12;
-
- Note[HighNote].Text := Copy(LyricS, 2, 100);
- Lyric := Lyric + Note[HighNote].Text;
-
- if TypeP = 'F' then
- Note[HighNote].FreeStyle := true;
-
- End_ := Note[HighNote].Start + Note[HighNote].Lenght;
- end; // with
-end;
-
-procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
-var
-I: Integer;
-begin
-
- // stara czesc //Alter Satz //Update Old Part
- Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric));
-
- //Total Notes Patch
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
- for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Lenght * Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType;
- end;
- //Total Notes Patch End
-
-
- // nowa czesc //Neuer Satz //Update New Part
- SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
- Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
- Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
- Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
-
- if self.Relative then
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
- Rel[LineNumberP] := Rel[LineNumberP] + Param2;
- end
- else
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
-
- Base[LineNumberP] := 100; // high number
-end;
-
-procedure TSong.clear();
-begin
- //Main Information
- Title := '';
- Artist := '';
-
- //Sortings:
- Genre := 'Unknown';
- Edition := 'Unknown';
- Language := 'Unknown'; //Language Patch
-
- //Required Information
- Mp3 := '';
- {$IFDEF FPC}
- setlength( BPM, 0 );
- {$ELSE}
- BPM := nil;
- {$ENDIF}
-
- GAP := 0;
- Start := 0;
- Finish := 0;
-
- //Additional Information
- Background := '';
- Cover := '';
- Video := '';
- VideoGAP := 0;
- NotesGAP := 0;
- Resolution := 4;
- Creator := '';
-
-end;
-
-function TSong.Analyse(): boolean;
-begin
- Result := False;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Open File and set File Pointer to the beginning
- AssignFile(SongFile, self.Path + self.FileName);
-
- try
- Reset(SongFile);
-
- //Clear old Song Header
- self.clear;
-
- //Read Header
- Result := self.ReadTxTHeader( FileName )
-
- //And Close File
- finally
- CloseFile(SongFile);
- end;
-end;
-
-
-
-end.
+unit USong;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ELSE}
+ {$IFNDEF DARWIN}
+ syscall,
+ {$ENDIF}
+ baseunix,
+ UnixType,
+ {$ENDIF}
+ SysUtils,
+ Classes,
+ UPlatform,
+ ULog,
+ UTexture,
+ UCommon,
+ {$IFDEF DARWIN}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF USE_PSEUDO_THREAD}
+ PseudoThread,
+ {$ENDIF}
+ UCatCovers;
+
+type
+
+ TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
+
+ TBPM = record
+ BPM: real;
+ StartBeat: real;
+ end;
+
+ TScore = record
+ Name: widestring;
+ Score: integer;
+ Length: string;
+ end;
+
+ TSong = class
+ FileLineNo : integer; //Line which is readed at Last, for error reporting
+
+ procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+ procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
+
+ function ReadTXTHeader( const aFileName : WideString ): boolean;
+ public
+ Path: widestring;
+ Folder: widestring; // for sorting by folder
+ fFileName,
+ FileName: widestring;
+
+ // sorting methods
+ Category: array of widestring; // I think I won't need this
+ Genre: widestring;
+ Edition: widestring;
+ Language: widestring; // 0.5.0: new
+
+ Title: widestring;
+ Artist: widestring;
+
+ Text: widestring;
+ Creator: widestring;
+
+ Cover: widestring;
+ CoverTex: TTexture;
+ Mp3: widestring;
+ Background: widestring;
+ Video: widestring;
+ VideoGAP: real;
+ VideoLoaded: boolean; // 0.5.0: true if the video has been loaded
+ NotesGAP: integer;
+ Start: real; // in seconds
+ Finish: integer; // in miliseconds
+ Relative: boolean;
+ Resolution: integer;
+ BPM: array of TBPM;
+ GAP: real; // in miliseconds
+
+ Score: array[0..2] of array of TScore;
+
+ // these are used when sorting is enabled
+ Visible: boolean; // false if hidden, true if visible
+ Main: boolean; // false for songs, true for category buttons
+ OrderNum: integer; // has a number of category for category buttons and songs
+ OrderTyp: integer; // type of sorting for this button (0=name)
+ CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
+
+ SongFile: TextFile; // all procedures in this unit operates on this file
+
+ Base : array[0..1] of integer;
+ Rel : array[0..1] of integer;
+ Mult : integer;
+ MultBPM : integer;
+
+ constructor create ( const aFileName : WideString );
+ function LoadSong: boolean;
+ function Analyse(): boolean;
+ procedure clear();
+ end;
+
+implementation
+
+uses
+ TextGL,
+ UIni,
+ UMusic, //needed for Lines
+ UMain; //needed for Player
+
+constructor TSong.create( const aFileName : WideString );
+begin
+
+ Mult := 1;
+
+ MultBPM := 4;
+
+
+ fFileName := aFileName;
+
+
+ if fileexists( aFileName ) then
+
+ begin
+
+ self.Path := ExtractFilePath( aFileName );
+ self.Folder := ExtractFilePath( aFileName );
+ self.FileName := ExtractFileName( aFileName );
+
+(*
+
+ if ReadTXTHeader( aFileName ) then
+
+ begin
+
+ LoadSong();
+
+ end
+ else
+ begin
+ Log.LogError('Error Loading SongHeader, abort Song Loading');
+ Exit;
+ end;
+*)
+ end;
+
+end;
+
+
+function TSong.LoadSong(): boolean;
+
+var
+ TempC: char;
+ Text: string;
+ CP: integer; // Current Player (0 or 1)
+ Count: integer;
+ Both: boolean;
+ Param1: integer;
+ Param2: integer;
+ Param3: integer;
+ ParamS: string;
+ I: Integer;
+begin
+ Result := false;
+
+ if not FileExists(Path + PathDelim + FileName) then
+ begin
+ Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
+ exit;
+ end;
+
+ MultBPM := 4; // multiply beat-count of note by 4
+ Mult := 1; // accuracy of measurement of note
+ Base[0] := 100; // high number
+ Lines[0].NoteType := 0;
+ self.Relative := false;
+ Rel[0] := 0;
+ CP := 0;
+ Both := false;
+
+ if Length(Player) = 2 then
+ Both := true;
+
+ try
+ // Open song file for reading.....
+ FileMode := fmOpenRead;
+ AssignFile(SongFile, fFileName);
+ Reset(SongFile);
+
+ //Clear old Song Header
+ if (self.Path = '') then
+ self.Path := ExtractFilePath(FileName);
+
+ if (self.FileName = '') then
+ self.Filename := ExtractFileName(FileName);
+
+ Result := False;
+
+ Reset(SongFile);
+ FileLineNo := 0;
+ //Search for Note Begining
+ repeat
+ ReadLn(SongFile, Text);
+ Inc(FileLineNo);
+
+ if (EoF(SongFile)) then
+ begin //Song File Corrupted - No Notes
+ CloseFile(SongFile);
+ Log.LogError('Could not load txt File, no Notes found: ' + FileName);
+ Result := False;
+ Exit;
+ end;
+ Read(SongFile, TempC);
+ until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
+
+ SetLength(Lines, 2);
+ for Count := 0 to High(Lines) do begin
+ SetLength(Lines[Count].Line, 1);
+ Lines[Count].High := 0;
+ Lines[Count].Number := 1;
+ Lines[Count].Current := 0;
+ Lines[Count].Resolution := self.Resolution;
+ Lines[Count].NotesGAP := self.NotesGAP;
+ Lines[Count].Line[0].IlNut := 0;
+ Lines[Count].Line[0].HighNote := -1;
+ end;
+
+ // TempC := ':';
+ // TempC := Text[1]; // read from backup variable, don't use default ':' value
+
+ while (TempC <> 'E') AND (not EOF(SongFile)) do
+ begin
+
+ if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin
+ // read notes
+ Read(SongFile, Param1);
+ Read(SongFile, Param2);
+ Read(SongFile, Param3);
+ Read(SongFile, ParamS);
+
+ //Check for ZeroNote
+ if Param2 = 0 then Log.LogError('Error: Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+' '+ParamS+'" -> Note ignored!') else
+ begin
+ // add notes
+ if not Both then
+ // P1
+ ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
+ else begin
+ // P1 + P2
+ ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
+ ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
+ end;
+ end; //Zeronote check
+ end; // if
+
+ if TempC = '-' then
+ begin
+ // reads sentence
+ Read(SongFile, Param1);
+ if self.Relative then Read(SongFile, Param2); // read one more data for relative system
+
+ // new sentence
+ if not Both then
+ // P1
+ NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
+ else begin
+ // P1 + P2
+ NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
+ NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
+ end;
+ end; // if
+
+ if TempC = 'B' then
+ begin
+ SetLength(self.BPM, Length(self.BPM) + 1);
+ Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
+ self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
+
+ Read(SongFile, Text);
+ self.BPM[High(self.BPM)].BPM := StrToFloat(Text);
+ self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
+ end;
+
+
+ if not Both then
+ begin
+ Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
+ Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
+ //Total Notes Patch
+ Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
+ for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
+ begin
+ Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Lenght * Lines[CP].Line[Lines[CP].High].Note[I].NoteType;
+ end;
+ //Total Notes Patch End
+ end else begin
+ for Count := 0 to High(Lines) do begin
+ Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
+ Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
+ //Total Notes Patch
+ Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
+ for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
+ begin
+ Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Lenght * Lines[Count].Line[Lines[Count].High].Note[I].NoteType;
+ end;
+ //Total Notes Patch End
+ end;
+ end;
+ Read(SongFile, TempC);
+ Inc(FileLineNo);
+ end; // while}
+
+ CloseFile(SongFile);
+ except
+ try
+ CloseFile(SongFile);
+ except
+
+ end;
+
+ Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
+ exit;
+ end;
+
+ Result := true;
+end;
+
+
+function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
+
+ function song_StrtoFloat( aValue : String ) : Extended;
+ var
+ lValue : String;
+// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable
+ begin
+ lValue := aValue;
+
+ if (Pos(',', lValue) <> 0) then
+ lValue[Pos(',', lValue)] := '.';
+
+ Result := StrToFloatDef(lValue, 0);
+ end;
+
+var
+ Line, Identifier, Value: String;
+ Temp : word;
+ Done : byte;
+begin
+ Result := true;
+ Done := 0;
+
+ //Read first Line
+ ReadLn (SongFile, Line);
+
+ if (Length(Line)<=0) then
+ begin
+ Log.LogError('File Starts with Empty Line: ' + aFileName);
+ Result := False;
+ Exit;
+ end;
+
+ //Read Lines while Line starts with # or its empty
+ While ( Length(Line) = 0 ) OR
+ ( Line[1] = '#' ) DO
+ begin
+ //Increase Line Number
+ Inc (FileLineNo);
+ Temp := Pos(':', Line);
+
+ //Line has a Seperator-> Headerline
+ if (Temp <> 0) then
+ begin
+ //Read Identifier and Value
+ Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks
+ Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp));
+
+ //Check the Identifier (If Value is given)
+ if (Length(Value) <> 0) then
+ begin
+
+ //-----------
+ //Required Attributes
+ //-----------
+
+ {$IFDEF UTF8_FILENAMES}
+ if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
+ Value := Utf8Encode(Value);
+ {$ENDIF}
+
+ //Title
+ if (Identifier = 'TITLE') then
+ begin
+ self.Title := Value;
+
+ //Add Title Flag to Done
+ Done := Done or 1;
+ end
+
+ //Artist
+ else if (Identifier = 'ARTIST') then
+ begin
+ self.Artist := Value;
+
+ //Add Artist Flag to Done
+ Done := Done or 2;
+ end
+
+ //MP3 File //Test if Exists
+ else if (Identifier = 'MP3') AND
+ (FileExists(self.Path + Value)) then
+ begin
+ self.Mp3 := Value;
+
+ //Add Mp3 Flag to Done
+ Done := Done or 4;
+ end
+
+ //Beats per Minute
+ else if (Identifier = 'BPM') then
+ begin
+ SetLength(self.BPM, 1);
+ self.BPM[0].StartBeat := 0;
+
+ self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
+
+ if self.BPM[0].BPM <> 0 then
+ begin
+ //Add BPM Flag to Done
+ Done := Done or 8;
+ end;
+ end
+
+ //---------
+ //Additional Header Information
+ //---------
+
+ // Video Gap
+ else if (Identifier = 'GAP') then
+ self.GAP := song_StrtoFloat( Value )
+
+ //Cover Picture
+ else if (Identifier = 'COVER') then
+ self.Cover := Value
+
+ //Background Picture
+ else if (Identifier = 'BACKGROUND') then
+ self.Background := Value
+
+ // Video File
+ else if (Identifier = 'VIDEO') then
+ begin
+ if (FileExists(self.Path + Value)) then
+ self.Video := Value
+ else
+ Log.LogError('Can''t find Video File in Song: ' + aFileName);
+ end
+
+ // Video Gap
+ else if (Identifier = 'VIDEOGAP') then
+ self.VideoGAP := song_StrtoFloat( Value )
+
+ //Genre Sorting
+ else if (Identifier = 'GENRE') then
+ self.Genre := Value
+
+ //Edition Sorting
+ else if (Identifier = 'EDITION') then
+ self.Edition := Value
+
+ //Creator Tag
+ else if (Identifier = 'CREATOR') then
+ self.Creator := Value
+
+ //Language Sorting
+ else if (Identifier = 'LANGUAGE') then
+ self.Language := Value
+
+ // Song Start
+ else if (Identifier = 'START') then
+ self.Start := song_StrtoFloat( Value )
+
+ // Song Ending
+ else if (Identifier = 'END') then
+ TryStrtoInt(Value, self.Finish)
+
+ // Resolution
+ else if (Identifier = 'RESOLUTION') then
+ TryStrtoInt(Value, self.Resolution)
+
+ // Notes Gap
+ else if (Identifier = 'NOTESGAP') then
+ TryStrtoInt(Value, self.NotesGAP)
+ // Relative Notes
+ else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then
+ self.Relative := True;
+
+ end;
+ end;
+
+ if not EOf(SongFile) then
+ ReadLn (SongFile, Line)
+ else
+ begin
+ Result := False;
+ Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
+ break;
+ end;
+
+ end;
+
+ if self.Cover = '' then
+ self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
+
+ //Check if all Required Values are given
+ if (Done <> 15) then
+ begin
+ Result := False;
+ if (Done and 8) = 0 then //No BPM Flag
+ Log.LogError('BPM Tag Missing: ' + self.FileName)
+ else if (Done and 4) = 0 then //No MP3 Flag
+ Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
+ else if (Done and 2) = 0 then //No Artist Flag
+ Log.LogError('Artist Tag Missing: ' + self.FileName)
+ else if (Done and 1) = 0 then //No Title Flag
+ Log.LogError('Title Tag Missing: ' + self.FileName)
+ else //unknown Error
+ Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
+ end;
+
+end;
+
+procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+//var
+// Space: boolean; // Auto Removed, Unused Variable
+begin
+ case Ini.Solmization of
+ 1: // european
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' si ';
+ end;
+ end;
+ 2: // japanese
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' so ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' shi ';
+ end;
+ end;
+ 3: // american
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' ti ';
+ end;
+ end;
+ end; // case
+
+ with Lines[LineNumber].Line[Lines[LineNumber].High] do begin
+ SetLength(Note, Length(Note) + 1);
+ IlNut := IlNut + 1;
+ HighNote := HighNote + 1;
+ Melody.IlNut := Melody.IlNut + 1;
+
+ Note[HighNote].Start := StartP;
+ if IlNut = 1 then begin
+ StartNote := Note[HighNote].Start;
+ if Lines[LineNumber].Number = 1 then
+ Start := -100;
+// Start := Note[HighNote].Start;
+ end;
+
+ Note[HighNote].Lenght := DurationP;
+ Melody.NoteLenght := Melody.NoteLenght + Note[HighNote].Lenght;
+
+ // back to the normal system with normal, golden and now freestyle notes
+ case TypeP of
+ 'F': Note[HighNote].NoteType := 0;
+ ':': Note[HighNote].NoteType := 1;
+ '*': Note[HighNote].NoteType := 2;
+ end;
+
+ Lines[LineNumber].NoteType := Lines[LineNumber].NoteType + Note[HighNote].Lenght * Note[HighNote].NoteType;
+
+ Note[HighNote].Tone := NoteP;
+ if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
+ Note[HighNote].ToneGamus := Note[HighNote].ToneGamus mod 12;
+
+ Note[HighNote].Text := Copy(LyricS, 2, 100);
+ Lyric := Lyric + Note[HighNote].Text;
+
+ if TypeP = 'F' then
+ Note[HighNote].FreeStyle := true;
+
+ End_ := Note[HighNote].Start + Note[HighNote].Lenght;
+ end; // with
+end;
+
+procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
+var
+I: Integer;
+begin
+
+ // stara czesc //Alter Satz //Update Old Part
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric));
+
+ //Total Notes Patch
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
+ for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
+ begin
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Lenght * Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType;
+ end;
+ //Total Notes Patch End
+
+
+ // nowa czesc //Neuer Satz //Update New Part
+ SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
+ Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
+ Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
+
+ if self.Relative then
+ begin
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
+ Rel[LineNumberP] := Rel[LineNumberP] + Param2;
+ end
+ else
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
+
+ Base[LineNumberP] := 100; // high number
+end;
+
+procedure TSong.clear();
+begin
+ //Main Information
+ Title := '';
+ Artist := '';
+
+ //Sortings:
+ Genre := 'Unknown';
+ Edition := 'Unknown';
+ Language := 'Unknown'; //Language Patch
+
+ //Required Information
+ Mp3 := '';
+ {$IFDEF FPC}
+ setlength( BPM, 0 );
+ {$ELSE}
+ BPM := nil;
+ {$ENDIF}
+
+ GAP := 0;
+ Start := 0;
+ Finish := 0;
+
+ //Additional Information
+ Background := '';
+ Cover := '';
+ Video := '';
+ VideoGAP := 0;
+ NotesGAP := 0;
+ Resolution := 4;
+ Creator := '';
+
+end;
+
+function TSong.Analyse(): boolean;
+begin
+ Result := False;
+
+ //Reset LineNo
+ FileLineNo := 0;
+
+ //Open File and set File Pointer to the beginning
+ AssignFile(SongFile, self.Path + self.FileName);
+
+ try
+ Reset(SongFile);
+
+ //Clear old Song Header
+ self.clear;
+
+ //Read Header
+ Result := self.ReadTxTHeader( FileName )
+
+ //And Close File
+ finally
+ CloseFile(SongFile);
+ end;
+end;
+
+
+
+end.
diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas
index 15399110..e3152bf0 100644
--- a/Game/Code/Classes/UVideo.pas
+++ b/Game/Code/Classes/UVideo.pas
@@ -1,708 +1,708 @@
-unit UVideo;
-{< #############################################################################
-# FFmpeg support for UltraStar deluxe #
-# #
-# Created by b1indy #
-# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
-# #
-# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
-# http://www.nabble.com/file/p11795857/mpegpas01.zip #
-# #
-############################################################################## }
-
-//{$define DebugDisplay} // uncomment if u want to see the debug stuff
-//{$define DebugFrames}
-//{$define Info}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-(*
-
- look into
- av_read_play
-
-*)
-
-implementation
-
-uses SDL,
- UGraphicClasses,
- textgl,
- avcodec,
- avformat,
- avutil,
- {$IFDEF UseSWScale}
- swscale,
- {$ENDIF}
- math,
- OpenGL12,
- SysUtils,
- {$ifdef DebugDisplay}
- {$ifdef win32}
- dialogs,
- {$endif}
- {$ENDIF}
- (* FIXME
- {$ifdef UseFFMpegAudio}
- UAudioDecoder_FFMpeg,
- {$endif}
- *)
- UIni,
- UMusic,
- UGraphic;
-
-
-var
- singleton_VideoFFMpeg : IVideoPlayback;
-
-type
- TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback )
- private
- fVideoOpened ,
- fVideoPaused : Boolean;
-
- fVideoTex : glUint;
- fVideoSkipTime : Single;
-
- VideoFormatContext: PAVFormatContext;
-
- VideoStreamIndex ,
- AudioStreamIndex : Integer;
- VideoCodecContext: PAVCodecContext;
- VideoCodec: PAVCodec;
- AVFrame: PAVFrame;
- AVFrameRGB: PAVFrame;
- myBuffer: pByte;
-
- {$IFDEF UseSWScale}
- SoftwareScaleContext: PSwsContext;
- {$ENDIF}
-
- TexX, TexY, dataX, dataY: Cardinal;
-
- ScaledVideoWidth, ScaledVideoHeight: Real;
- VideoAspect: Real;
- VideoTextureU, VideoTextureV: Real;
- VideoTimeBase, VideoTime, LastFrameTime, TimeDifference, flooptime: Extended;
-
-
- WantedAudioCodecContext,
- AudioCodecContext : PSDL_AudioSpec;
- aCodecCtx : PAVCodecContext;
-
- function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
-
- public
- constructor create();
- function GetName: String;
- procedure init();
-
- function Open(const aFileName : string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- procedure GetFrame(Time: Extended);
- procedure DrawGL(Screen: integer);
-
- end;
-
- const
- SDL_AUDIO_BUFFER_SIZE = 1024;
-
-{$ifdef DebugDisplay}
-//{$ifNdef win32}
-
-procedure showmessage( aMessage : String );
-begin
- writeln( aMessage );
-end;
-
-//{$endif}
-{$ENDIF}
-
-{ ------------------------------------------------------------------------------
-asdf
------------------------------------------------------------------------------- }
-
-function TVideoPlayback_ffmpeg.GetName: String;
-begin
- result := 'FFMpeg';
-end;
-
-{
- @author(Jay Binks <jaybinks@gmail.com>)
- @created(2007-10-09)
- @lastmod(2007-10-09)
-
- @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file )
- @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream)
- @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream)
- @returns(@true on success, @false otherwise)
-
- translated from "Setting Up the Audio" section at
- http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html
-}
-function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
-var
- i : integer;
- st : pAVStream;
-begin
- // Find the first video stream
- aFirstAudioStream := -1;
- aFirstVideoStream := -1;
-
- writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) );
- writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) );
-
- i := 0;
- while ( i < aFormatCtx.nb_streams ) do
-// while ( i < length(aFormatCtx.streams)-1 ) do
- begin
- writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) );
- st := aFormatCtx.streams[i];
-
- if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND
- (aFirstVideoStream < 0) THEN
- begin
- aFirstVideoStream := i;
- end;
-
- if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND
- ( aFirstAudioStream < 0) THEN
- begin
- aFirstAudioStream := i;
- end;
-
- inc( i );
- end; // while
-
- result := (aFirstAudioStream > -1) OR
- (aFirstVideoStream > -1) ; // Didn't find a video stream
-end;
-
-
-
-
-procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended);
-var
- FrameFinished: Integer;
- AVPacket: TAVPacket;
- errnum, x, y: Integer;
- FrameDataPtr: PByteArray;
- linesize: integer;
- myTime: Extended;
- DropFrame: Boolean;
- droppedFrames: Integer;
-const
- FRAMEDROPCOUNT=3;
-begin
- if not fVideoOpened then Exit;
-
- if fVideoPaused then Exit;
-
- myTime := ( Time - flooptime ) + fVideoSkipTime;
- TimeDifference := myTime - VideoTime;
- DropFrame := False;
-
-{$IFDEF DebugDisplay}
- showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+
- 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
-{$endif}
-
- if (VideoTime <> 0) and (TimeDifference+flooptime <= VideoTimeBase) then
- begin
-{$ifdef DebugFrames}
- // frame delay debug display
- GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
-{$endif}
-
-{$IFDEF DebugDisplay}
- showmessage('not getting new frame'+#13#10+
- 'Time: '+inttostr(floor(Time*1000))+#13#10+
- 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
-{$endif}
-
- Exit;// we don't need a new frame now
- end;
-
- VideoTime:=VideoTime+VideoTimeBase;
- TimeDifference:=myTime-VideoTime;
- if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames
- begin
-{$ifdef DebugFrames}
- //frame drop debug display
- GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
-{$endif}
-{$IFDEF DebugDisplay}
- showmessage('skipping frames'+#13#10+
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+
- 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000)));
-{$endif}
- VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase;
- DropFrame:=True;
- end;
-
- AVPacket.data := nil;
- av_init_packet( AVPacket ); // JB-ffmpeg
-
- FrameFinished:=0;
- // read packets until we have a finished frame (or there are no more packets)
- while ( FrameFinished = 0 ) do
- begin
- if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then
- begin
- // Record the Time we looped, this is used to keep the loops, in time. otherwise they speed
- flooptime := time;
-
- // Dont use SetPosition() it dosnt let us go back to frame 0... can we / should we fix this ??
- fVideoSkipTime := 0;
- VideoTime := 0;
-
- // Free the packet we just got from av_read_frame
- av_free_packet( @AVPacket );
-
- // Seek to frame 0 in the video stream
- av_seek_frame(VideoFormatContext,VideoStreamIndex,0,AVSEEK_FLAG_ANY);
- break;
- end;
-
-
- // if we got a packet from the video stream, then decode it
- if (AVPacket.stream_index=VideoStreamIndex) then
- begin
- errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
- (* FIXME
- {$ifdef UseFFMpegAudio}
- end
- else
- if (AVPacket.stream_index = AudioStreamIndex ) then
- begin
- writeln('Encue Audio packet');
- audioq.put(AVPacket);
- {$endif}
- *)
- end;
-
- try
-// if AVPacket.data <> nil then
- av_free_packet( @AVPacket ); // JB-ffmpeg
- except
- // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
- end;
-
- end;
-
- if DropFrame then
- for droppedFrames:=1 to FRAMEDROPCOUNT do begin
- FrameFinished:=0;
- // read packets until we have a finished frame (or there are no more packets)
- while (FrameFinished=0) do
- begin
- if (av_read_frame(VideoFormatContext, AVPacket)<0) then
- Break;
- // if we got a packet from the video stream, then decode it
- if (AVPacket.stream_index=VideoStreamIndex) then
- errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
-
- // release internal packet structure created by av_read_frame
- try
-// if AVPacket.data <> nil then
- av_free_packet( @AVPacket ); // JB-ffmpeg
- except
- // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
- end;
- end;
- end;
-
- // if we did not get an new frame, there's nothing more to do
- if Framefinished=0 then begin
- Exit;
- end;
-
- // otherwise we convert the pixeldata from YUV to RGB
- {$IFDEF UseSWScale}
- errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize),
- 0,VideoCodecContext^.Height,
- @(AVFrameRGB.data),@(AVFrameRGB.linesize));
- {$ELSE}
- errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24,
- PAVPicture(AVFrame), VideoCodecContext^.pix_fmt,
- VideoCodecContext^.width, VideoCodecContext^.height);
- {$ENDIF}
-
- if errnum >=0 then
- begin
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-{$ifdef DebugFrames}
- //frame decode debug display
- GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00);
-{$endif}
- end;
-end;
-
-procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer);
-begin
- // have a nice black background to draw on (even if there were errors opening the vid)
- if Screen=1 then
- begin
- glClearColor(0,0,0,0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
- // exit if there's nothing to draw
- if not fVideoOpened then Exit;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glbegin(gl_quads);
- glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
- glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
- glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
- glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
-{$ifdef Info}
- if VideoSkipTime+VideoTime+VideoTimeBase < 0 then
- begin
- glColor4f(0.7, 1, 0.3, 1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (300, 0);
- glPrint('Delay due to negative VideoGap');
- glColor4f(1, 1, 1, 1);
- end;
-{$endif}
-
-{$ifdef DebugFrames}
- glColor4f(0, 0, 0, 0.2);
- glbegin(gl_quads);
- glVertex2f(0, 0);
- glVertex2f(0, 70);
- glVertex2f(250, 70);
- glVertex2f(250, 0);
- glEnd;
-
- glColor4f(1,1,1,1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (5, 0);
- glPrint('delaying frame');
- SetFontPos (5, 20);
- glPrint('fetching frame');
- SetFontPos (5, 40);
- glPrint('dropping frame');
-{$endif}
-end;
-
-constructor TVideoPlayback_ffmpeg.create();
-begin
- av_register_all;
-
- fVideoOpened := False;
- fVideoPaused := False;
-end;
-
-procedure TVideoPlayback_ffmpeg.init();
-begin
- glGenTextures(1, PglUint(@fVideoTex));
-end;
-
-
-function TVideoPlayback_ffmpeg.Open(const aFileName : string): boolean; // true if succeed
-var
- errnum, i, x,y: Integer;
- lStreamsCount : Integer;
-
- wanted_spec ,
- spec : TSDL_AudioSpec;
- aCodec : pAVCodec;
-
- sws_dst_w, sws_dst_h: Integer;
-
-begin
- Result := false;
-
- fVideoOpened := False;
- fVideoPaused := False;
- VideoTimeBase := 0;
- VideoTime := 0;
- LastFrameTime := 0;
- TimeDifference := 0;
- VideoFormatContext := nil;
-
-// writeln( aFileName );
-
- errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil);
-// writeln( 'Errnum : ' +inttostr( errnum ));
- if(errnum <> 0) then
- begin
-{$ifdef DebugDisplay}
- case errnum of
- AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN');
- AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO');
- AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED');
- AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA');
- AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM');
- AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT');
- AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP');
- else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum));
- end;
-{$ENDIF}
- Exit;
- end
- else
- begin
- VideoStreamIndex := -1;
- AudioStreamIndex := -1;
-
- // Find which stream contains the video
- if( av_find_stream_info(VideoFormatContext) >= 0 ) then
- begin
- find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex );
-
- writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) );
- writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) );
- end;
- // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error
- // Just a temporary workaround for now
- aCodecCtx := nil;
- if( AudioStreamIndex >= 0) then
- aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec;
-
- (* FIXME
- {$ifdef UseFFMpegAudio}
- // This is the audio ffmpeg audio support Jay is working on.
- if aCodecCtx <> nil then
- begin
- wanted_spec.freq := aCodecCtx.sample_rate;
- wanted_spec.format := AUDIO_S16SYS;
- wanted_spec.channels := aCodecCtx.channels;
- wanted_spec.silence := 0;
- wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE;
- wanted_spec.callback := UAudio_FFMpeg.audio_callback;
- wanted_spec.userdata := aCodecCtx;
-
-
- if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then
- begin
- writeln('SDL_OpenAudio: '+SDL_GetError());
- exit;
- end;
-
- writeln( 'SDL opened audio device' );
-
- aCodec := avcodec_find_decoder(aCodecCtx.codec_id);
- if (aCodec = nil) then
- begin
- writeln('Unsupported codec!');
- exit;
- end;
-
- avcodec_open(aCodecCtx, aCodec);
-
- writeln( 'Opened the codec' );
-
- packet_queue_init( audioq );
- SDL_PauseAudio(0);
-
- writeln( 'SDL_PauseAudio' );
-
-
- end;
- {$endif}
- *)
-
- if(VideoStreamIndex >= 0) then
- begin
- VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec;
- VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id);
- end
- else
- begin
-{$ifdef DebugDisplay}
- showmessage('found no video stream');
-{$ENDIF}
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-
- if(VideoCodec<>Nil) then
- begin
- errnum:=avcodec_open(VideoCodecContext, VideoCodec);
- end else begin
-{$ifdef DebugDisplay}
- showmessage('no matching codec found');
-{$ENDIF}
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
- if(errnum >=0) then
- begin
- if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then
- begin
- ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-{$ifdef DebugDisplay}
- showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+
- ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+
- ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+
- ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den));
-{$endif}
- // allocate space for decoded frame and rgb frame
- AVFrame:=avcodec_alloc_frame;
- AVFrameRGB:=avcodec_alloc_frame;
- end;
-
- dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width))));
- dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height))));
- myBuffer:=Nil;
- if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then
- begin
- myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY));
- end;
- if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24,
- dataX, dataY)
- else begin
- {$ifdef DebugDisplay}
- showmessage('failed to allocate video buffer');
- {$endif}
- av_free(AVFrameRGB);
- av_free(AVFrame);
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
-
- {$IFDEF UseSWScale}
- SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt),
- dataX, dataY, integer(PIX_FMT_RGB24),
- SWS_FAST_BILINEAR, nil, nil, nil);
- if SoftwareScaleContext <> Nil then
- writeln('got swscale context')
- else begin
- writeln('ERROR: didn´t get swscale context');
- av_free(AVFrameRGB);
- av_free(AVFrame);
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
- Exit;
- end;
- {$ENDIF}
-
- // this is the errnum from avpicture_fill
- if errnum >=0 then
- begin
- fVideoOpened:=True;
-
- TexX := VideoCodecContext^.width;
- TexY := VideoCodecContext^.height;
- dataX := Round(Power(2, Ceil(Log2(TexX))));
- dataY := Round(Power(2, Ceil(Log2(TexY))));
- // calculate some information for video display
- VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den;
- if (VideoAspect = 0) then
- VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height
- else
- VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height;
- ScaledVideoWidth:=800.0;
- ScaledVideoHeight:=800.0/VideoAspect;
- VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num;
-{$ifdef DebugDisplay}
- showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps');
-{$endif}
- // hack to get reasonable timebase (for divx and others)
- if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps
- begin
- VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den;
- while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10;
- VideoTimeBase:=1/VideoTimeBase;
- end;
- end;
- end;
-
- Result := true;
-end;
-
-procedure TVideoPlayback_ffmpeg.Close;
-begin
- if fVideoOpened then
- begin
- av_free(myBuffer);
- av_free(AVFrameRGB);
- av_free(AVFrame);
-
- avcodec_close(VideoCodecContext);
- av_close_input_file(VideoFormatContext);
-
- fVideoOpened:=False;
- end;
-end;
-
-procedure TVideoPlayback_ffmpeg.Play;
-begin
-end;
-
-procedure TVideoPlayback_ffmpeg.Pause;
-begin
- fVideoPaused := not fVideoPaused;
-end;
-
-procedure TVideoPlayback_ffmpeg.Stop;
-begin
-end;
-
-procedure TVideoPlayback_ffmpeg.SetPosition(Time: real);
-begin
- fVideoSkipTime := Time;
-
- if fVideoSkipTime > 0 then
- begin
- av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY);
-
- VideoTime := fVideoSkipTime;
- end;
-end;
-
-// what is this supposed to do? return VideoTime?
-function TVideoPlayback_ffmpeg.GetPosition: real;
-begin
- result := 0;
-end;
-
-initialization
- singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create();
- AudioManager.add( singleton_VideoFFMpeg );
-
-finalization
- AudioManager.Remove( singleton_VideoFFMpeg );
-
-end.
+unit UVideo;
+{< #############################################################################
+# FFmpeg support for UltraStar deluxe #
+# #
+# Created by b1indy #
+# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
+# #
+# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
+# http://www.nabble.com/file/p11795857/mpegpas01.zip #
+# #
+############################################################################## }
+
+//{$define DebugDisplay} // uncomment if u want to see the debug stuff
+//{$define DebugFrames}
+//{$define Info}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+(*
+
+ look into
+ av_read_play
+
+*)
+
+implementation
+
+uses SDL,
+ UGraphicClasses,
+ textgl,
+ avcodec,
+ avformat,
+ avutil,
+ {$IFDEF UseSWScale}
+ swscale,
+ {$ENDIF}
+ math,
+ OpenGL12,
+ SysUtils,
+ {$ifdef DebugDisplay}
+ {$ifdef win32}
+ dialogs,
+ {$endif}
+ {$ENDIF}
+ (* FIXME
+ {$ifdef UseFFMpegAudio}
+ UAudioDecoder_FFMpeg,
+ {$endif}
+ *)
+ UIni,
+ UMusic,
+ UGraphic;
+
+
+var
+ singleton_VideoFFMpeg : IVideoPlayback;
+
+type
+ TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback )
+ private
+ fVideoOpened ,
+ fVideoPaused : Boolean;
+
+ fVideoTex : glUint;
+ fVideoSkipTime : Single;
+
+ VideoFormatContext: PAVFormatContext;
+
+ VideoStreamIndex ,
+ AudioStreamIndex : Integer;
+ VideoCodecContext: PAVCodecContext;
+ VideoCodec: PAVCodec;
+ AVFrame: PAVFrame;
+ AVFrameRGB: PAVFrame;
+ myBuffer: pByte;
+
+ {$IFDEF UseSWScale}
+ SoftwareScaleContext: PSwsContext;
+ {$ENDIF}
+
+ TexX, TexY, dataX, dataY: Cardinal;
+
+ ScaledVideoWidth, ScaledVideoHeight: Real;
+ VideoAspect: Real;
+ VideoTextureU, VideoTextureV: Real;
+ VideoTimeBase, VideoTime, LastFrameTime, TimeDifference, flooptime: Extended;
+
+
+ WantedAudioCodecContext,
+ AudioCodecContext : PSDL_AudioSpec;
+ aCodecCtx : PAVCodecContext;
+
+ function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
+
+ public
+ constructor create();
+ function GetName: String;
+ procedure init();
+
+ function Open(const aFileName : string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure GetFrame(Time: Extended);
+ procedure DrawGL(Screen: integer);
+
+ end;
+
+ const
+ SDL_AUDIO_BUFFER_SIZE = 1024;
+
+{$ifdef DebugDisplay}
+//{$ifNdef win32}
+
+procedure showmessage( aMessage : String );
+begin
+ writeln( aMessage );
+end;
+
+//{$endif}
+{$ENDIF}
+
+{ ------------------------------------------------------------------------------
+asdf
+------------------------------------------------------------------------------ }
+
+function TVideoPlayback_ffmpeg.GetName: String;
+begin
+ result := 'FFMpeg';
+end;
+
+{
+ @author(Jay Binks <jaybinks@gmail.com>)
+ @created(2007-10-09)
+ @lastmod(2007-10-09)
+
+ @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file )
+ @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream)
+ @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream)
+ @returns(@true on success, @false otherwise)
+
+ translated from "Setting Up the Audio" section at
+ http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html
+}
+function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean;
+var
+ i : integer;
+ st : pAVStream;
+begin
+ // Find the first video stream
+ aFirstAudioStream := -1;
+ aFirstVideoStream := -1;
+
+ writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) );
+ writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) );
+
+ i := 0;
+ while ( i < aFormatCtx.nb_streams ) do
+// while ( i < length(aFormatCtx.streams)-1 ) do
+ begin
+ writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) );
+ st := aFormatCtx.streams[i];
+
+ if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND
+ (aFirstVideoStream < 0) THEN
+ begin
+ aFirstVideoStream := i;
+ end;
+
+ if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND
+ ( aFirstAudioStream < 0) THEN
+ begin
+ aFirstAudioStream := i;
+ end;
+
+ inc( i );
+ end; // while
+
+ result := (aFirstAudioStream > -1) OR
+ (aFirstVideoStream > -1) ; // Didn't find a video stream
+end;
+
+
+
+
+procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended);
+var
+ FrameFinished: Integer;
+ AVPacket: TAVPacket;
+errnum, {*x, *}y: Integer; // Auto Removed, Unused Variable (x)
+// FrameDataPtr: PByteArray; // Auto Removed, Unused Variable
+// linesize: integer; // Auto Removed, Unused Variable
+ myTime: Extended;
+ DropFrame: Boolean;
+ droppedFrames: Integer;
+const
+ FRAMEDROPCOUNT=3;
+begin
+ if not fVideoOpened then Exit;
+
+ if fVideoPaused then Exit;
+
+ myTime := ( Time - flooptime ) + fVideoSkipTime;
+ TimeDifference := myTime - VideoTime;
+ DropFrame := False;
+
+{$IFDEF DebugDisplay}
+ showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+
+ 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+{$endif}
+
+ if (VideoTime <> 0) and (TimeDifference+flooptime <= VideoTimeBase) then
+ begin
+{$ifdef DebugFrames}
+ // frame delay debug display
+ GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
+{$endif}
+
+{$IFDEF DebugDisplay}
+ showmessage('not getting new frame'+#13#10+
+ 'Time: '+inttostr(floor(Time*1000))+#13#10+
+ 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+{$endif}
+
+ Exit;// we don't need a new frame now
+ end;
+
+ VideoTime:=VideoTime+VideoTimeBase;
+ TimeDifference:=myTime-VideoTime;
+ if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames
+ begin
+{$ifdef DebugFrames}
+ //frame drop debug display
+ GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
+{$endif}
+{$IFDEF DebugDisplay}
+ showmessage('skipping frames'+#13#10+
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+
+ 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000)));
+{$endif}
+ VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase;
+ DropFrame:=True;
+ end;
+
+ AVPacket.data := nil;
+ av_init_packet( AVPacket ); // JB-ffmpeg
+
+ FrameFinished:=0;
+ // read packets until we have a finished frame (or there are no more packets)
+ while ( FrameFinished = 0 ) do
+ begin
+ if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then
+ begin
+ // Record the Time we looped, this is used to keep the loops, in time. otherwise they speed
+ flooptime := time;
+
+ // Dont use SetPosition() it dosnt let us go back to frame 0... can we / should we fix this ??
+ fVideoSkipTime := 0;
+ VideoTime := 0;
+
+ // Free the packet we just got from av_read_frame
+ av_free_packet( @AVPacket );
+
+ // Seek to frame 0 in the video stream
+ av_seek_frame(VideoFormatContext,VideoStreamIndex,0,AVSEEK_FLAG_ANY);
+ break;
+ end;
+
+
+ // if we got a packet from the video stream, then decode it
+ if (AVPacket.stream_index=VideoStreamIndex) then
+ begin
+ errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
+ (* FIXME
+ {$ifdef UseFFMpegAudio}
+ end
+ else
+ if (AVPacket.stream_index = AudioStreamIndex ) then
+ begin
+ writeln('Encue Audio packet');
+ audioq.put(AVPacket);
+ {$endif}
+ *)
+ end;
+
+ try
+// if AVPacket.data <> nil then
+ av_free_packet( @AVPacket ); // JB-ffmpeg
+ except
+ // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
+ end;
+
+ end;
+
+ if DropFrame then
+ for droppedFrames:=1 to FRAMEDROPCOUNT do begin
+ FrameFinished:=0;
+ // read packets until we have a finished frame (or there are no more packets)
+ while (FrameFinished=0) do
+ begin
+ if (av_read_frame(VideoFormatContext, AVPacket)<0) then
+ Break;
+ // if we got a packet from the video stream, then decode it
+ if (AVPacket.stream_index=VideoStreamIndex) then
+ errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg
+
+ // release internal packet structure created by av_read_frame
+ try
+// if AVPacket.data <> nil then
+ av_free_packet( @AVPacket ); // JB-ffmpeg
+ except
+ // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! )
+ end;
+ end;
+ end;
+
+ // if we did not get an new frame, there's nothing more to do
+ if Framefinished=0 then begin
+ Exit;
+ end;
+
+ // otherwise we convert the pixeldata from YUV to RGB
+ {$IFDEF UseSWScale}
+ errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize),
+ 0,VideoCodecContext^.Height,
+ @(AVFrameRGB.data),@(AVFrameRGB.linesize));
+ {$ELSE}
+ errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24,
+ PAVPicture(AVFrame), VideoCodecContext^.pix_fmt,
+ VideoCodecContext^.width, VideoCodecContext^.height);
+ {$ENDIF}
+
+ if errnum >=0 then
+ begin
+ glBindTexture(GL_TEXTURE_2D, fVideoTex);
+ glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+{$ifdef DebugFrames}
+ //frame decode debug display
+ GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00);
+{$endif}
+ end;
+end;
+
+procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer);
+begin
+ // have a nice black background to draw on (even if there were errors opening the vid)
+ if Screen=1 then
+ begin
+ glClearColor(0,0,0,0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
+ // exit if there's nothing to draw
+ if not fVideoOpened then Exit;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glColor4f(1, 1, 1, 1);
+ glBindTexture(GL_TEXTURE_2D, fVideoTex);
+ glbegin(gl_quads);
+ glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
+ glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
+ glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2);
+ glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2);
+ glEnd;
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+{$ifdef Info}
+ if VideoSkipTime+VideoTime+VideoTimeBase < 0 then
+ begin
+ glColor4f(0.7, 1, 0.3, 1);
+ SetFontStyle (1);
+ SetFontItalic(False);
+ SetFontSize(9);
+ SetFontPos (300, 0);
+ glPrint('Delay due to negative VideoGap');
+ glColor4f(1, 1, 1, 1);
+ end;
+{$endif}
+
+{$ifdef DebugFrames}
+ glColor4f(0, 0, 0, 0.2);
+ glbegin(gl_quads);
+ glVertex2f(0, 0);
+ glVertex2f(0, 70);
+ glVertex2f(250, 70);
+ glVertex2f(250, 0);
+ glEnd;
+
+ glColor4f(1,1,1,1);
+ SetFontStyle (1);
+ SetFontItalic(False);
+ SetFontSize(9);
+ SetFontPos (5, 0);
+ glPrint('delaying frame');
+ SetFontPos (5, 20);
+ glPrint('fetching frame');
+ SetFontPos (5, 40);
+ glPrint('dropping frame');
+{$endif}
+end;
+
+constructor TVideoPlayback_ffmpeg.create();
+begin
+ av_register_all;
+
+ fVideoOpened := False;
+ fVideoPaused := False;
+end;
+
+procedure TVideoPlayback_ffmpeg.init();
+begin
+ glGenTextures(1, PglUint(@fVideoTex));
+end;
+
+
+function TVideoPlayback_ffmpeg.Open(const aFileName : string): boolean; // true if succeed
+var
+errnum {*i, x, y*}: Integer; // Auto Removed, Unused Variable (i) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (x) // Auto Removed, Unused Variable (y)
+// lStreamsCount : Integer; // Auto Removed, Unused Variable
+
+ wanted_spec ,
+// spec : TSDL_AudioSpec; // Auto Removed, Unused Variable
+// aCodec : pAVCodec; // Auto Removed, Unused Variable
+
+{*sws_dst_w, *}sws_dst_h: Integer; // Auto Removed, Unused Variable (sws_dst_w)
+
+begin
+ Result := false;
+
+ fVideoOpened := False;
+ fVideoPaused := False;
+ VideoTimeBase := 0;
+ VideoTime := 0;
+ LastFrameTime := 0;
+ TimeDifference := 0;
+ VideoFormatContext := nil;
+
+// writeln( aFileName );
+
+ errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil);
+// writeln( 'Errnum : ' +inttostr( errnum ));
+ if(errnum <> 0) then
+ begin
+{$ifdef DebugDisplay}
+ case errnum of
+ AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN');
+ AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO');
+ AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED');
+ AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA');
+ AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM');
+ AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT');
+ AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP');
+ else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum));
+ end;
+{$ENDIF}
+ Exit;
+ end
+ else
+ begin
+ VideoStreamIndex := -1;
+ AudioStreamIndex := -1;
+
+ // Find which stream contains the video
+ if( av_find_stream_info(VideoFormatContext) >= 0 ) then
+ begin
+ find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex );
+
+ writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) );
+ writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) );
+ end;
+ // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error
+ // Just a temporary workaround for now
+ aCodecCtx := nil;
+ if( AudioStreamIndex >= 0) then
+ aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec;
+
+ (* FIXME
+ {$ifdef UseFFMpegAudio}
+ // This is the audio ffmpeg audio support Jay is working on.
+ if aCodecCtx <> nil then
+ begin
+ wanted_spec.freq := aCodecCtx.sample_rate;
+ wanted_spec.format := AUDIO_S16SYS;
+ wanted_spec.channels := aCodecCtx.channels;
+ wanted_spec.silence := 0;
+ wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE;
+ wanted_spec.callback := UAudio_FFMpeg.audio_callback;
+ wanted_spec.userdata := aCodecCtx;
+
+
+ if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then
+ begin
+ writeln('SDL_OpenAudio: '+SDL_GetError());
+ exit;
+ end;
+
+ writeln( 'SDL opened audio device' );
+
+ aCodec := avcodec_find_decoder(aCodecCtx.codec_id);
+ if (aCodec = nil) then
+ begin
+ writeln('Unsupported codec!');
+ exit;
+ end;
+
+ avcodec_open(aCodecCtx, aCodec);
+
+ writeln( 'Opened the codec' );
+
+ packet_queue_init( audioq );
+ SDL_PauseAudio(0);
+
+ writeln( 'SDL_PauseAudio' );
+
+
+ end;
+ {$endif}
+ *)
+
+ if(VideoStreamIndex >= 0) then
+ begin
+ VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec;
+ VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id);
+ end
+ else
+ begin
+{$ifdef DebugDisplay}
+ showmessage('found no video stream');
+{$ENDIF}
+ av_close_input_file(VideoFormatContext);
+ Exit;
+ end;
+
+ if(VideoCodec<>Nil) then
+ begin
+ errnum:=avcodec_open(VideoCodecContext, VideoCodec);
+ end else begin
+{$ifdef DebugDisplay}
+ showmessage('no matching codec found');
+{$ENDIF}
+ avcodec_close(VideoCodecContext);
+ av_close_input_file(VideoFormatContext);
+ Exit;
+ end;
+ if(errnum >=0) then
+ begin
+ if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then
+ begin
+ ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message
+ avcodec_close(VideoCodecContext);
+ av_close_input_file(VideoFormatContext);
+ Exit;
+ end;
+{$ifdef DebugDisplay}
+ showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+
+ ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+
+ ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+
+ ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den));
+{$endif}
+ // allocate space for decoded frame and rgb frame
+ AVFrame:=avcodec_alloc_frame;
+ AVFrameRGB:=avcodec_alloc_frame;
+ end;
+
+ dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width))));
+ dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height))));
+ myBuffer:=Nil;
+ if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then
+ begin
+ myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY));
+ end;
+ if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24,
+ dataX, dataY)
+ else begin
+ {$ifdef DebugDisplay}
+ showmessage('failed to allocate video buffer');
+ {$endif}
+ av_free(AVFrameRGB);
+ av_free(AVFrame);
+ avcodec_close(VideoCodecContext);
+ av_close_input_file(VideoFormatContext);
+ Exit;
+ end;
+
+ {$IFDEF UseSWScale}
+ SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt),
+ dataX, dataY, integer(PIX_FMT_RGB24),
+ SWS_FAST_BILINEAR, nil, nil, nil);
+ if SoftwareScaleContext <> Nil then
+ writeln('got swscale context')
+ else begin
+ writeln('ERROR: didn´t get swscale context');
+ av_free(AVFrameRGB);
+ av_free(AVFrame);
+ avcodec_close(VideoCodecContext);
+ av_close_input_file(VideoFormatContext);
+ Exit;
+ end;
+ {$ENDIF}
+
+ // this is the errnum from avpicture_fill
+ if errnum >=0 then
+ begin
+ fVideoOpened:=True;
+
+ TexX := VideoCodecContext^.width;
+ TexY := VideoCodecContext^.height;
+ dataX := Round(Power(2, Ceil(Log2(TexX))));
+ dataY := Round(Power(2, Ceil(Log2(TexY))));
+ // calculate some information for video display
+ VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den;
+ if (VideoAspect = 0) then
+ VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height
+ else
+ VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height;
+ ScaledVideoWidth:=800.0;
+ ScaledVideoHeight:=800.0/VideoAspect;
+ VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num;
+{$ifdef DebugDisplay}
+ showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps');
+{$endif}
+ // hack to get reasonable timebase (for divx and others)
+ if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps
+ begin
+ VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den;
+ while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10;
+ VideoTimeBase:=1/VideoTimeBase;
+ end;
+ end;
+ end;
+
+ Result := true;
+end;
+
+procedure TVideoPlayback_ffmpeg.Close;
+begin
+ if fVideoOpened then
+ begin
+ av_free(myBuffer);
+ av_free(AVFrameRGB);
+ av_free(AVFrame);
+
+ avcodec_close(VideoCodecContext);
+ av_close_input_file(VideoFormatContext);
+
+ fVideoOpened:=False;
+ end;
+end;
+
+procedure TVideoPlayback_ffmpeg.Play;
+begin
+end;
+
+procedure TVideoPlayback_ffmpeg.Pause;
+begin
+ fVideoPaused := not fVideoPaused;
+end;
+
+procedure TVideoPlayback_ffmpeg.Stop;
+begin
+end;
+
+procedure TVideoPlayback_ffmpeg.SetPosition(Time: real);
+begin
+ fVideoSkipTime := Time;
+
+ if fVideoSkipTime > 0 then
+ begin
+ av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY);
+
+ VideoTime := fVideoSkipTime;
+ end;
+end;
+
+// what is this supposed to do? return VideoTime?
+function TVideoPlayback_ffmpeg.GetPosition: real;
+begin
+ result := 0;
+end;
+
+initialization
+ singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create();
+ AudioManager.add( singleton_VideoFFMpeg );
+
+finalization
+ AudioManager.Remove( singleton_VideoFFMpeg );
+
+end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-22 15:52:49 +0000