diff options
author | jaybinks <jaybinks@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-03-10 02:13:08 +0000 |
---|---|---|
committer | jaybinks <jaybinks@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-03-10 02:13:08 +0000 |
commit | 7ede07ea15a9c91f980a25ed6afbdf45987e7fcd (patch) | |
tree | d3fe7a0576b2b9f0b22c1baaad451bc6d44affcb /Game/Code/Classes | |
parent | 07d79daa7ca0af3cd24820242a3428fb18f3403b (diff) | |
download | usdx-7ede07ea15a9c91f980a25ed6afbdf45987e7fcd.tar.gz usdx-7ede07ea15a9c91f980a25ed6afbdf45987e7fcd.tar.xz usdx-7ede07ea15a9c91f980a25ed6afbdf45987e7fcd.zip |
auto removed a bunch of unused local variables
( removed with a script parsing compiler output )
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@950 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to '')
-rw-r--r-- | Game/Code/Classes/UAudioPlayback_SDL.pas | 2 | ||||
-rw-r--r-- | Game/Code/Classes/UCore.pas | 2 | ||||
-rw-r--r-- | Game/Code/Classes/UGraphic.pas | 1604 | ||||
-rw-r--r-- | Game/Code/Classes/ULog.pas | 2 | ||||
-rw-r--r-- | Game/Code/Classes/URecord.pas | 1220 | ||||
-rw-r--r-- | Game/Code/Classes/USong.pas | 1440 | ||||
-rw-r--r-- | Game/Code/Classes/UVideo.pas | 1416 |
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. |