From 7a01b05b3861a667eb32ce2e0fc88ff3bacb99ae Mon Sep 17 00:00:00 2001 From: mogguh Date: Tue, 2 Sep 2008 17:25:26 +0000 Subject: Moved: The folder classes has been renamed to base Updated: ultrastardx.dpr has been changed accordingly git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1339 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 462 +++++++ src/base/UAudioConverter.pas | 458 +++++++ src/base/UAudioCore_Bass.pas | 123 ++ src/base/UAudioCore_Portaudio.pas | 257 ++++ src/base/UAudioDecoder_Bass.pas | 242 ++++ src/base/UAudioDecoder_FFmpeg.pas | 1114 ++++++++++++++++ src/base/UAudioInput_Bass.pas | 481 +++++++ src/base/UAudioInput_Portaudio.pas | 474 +++++++ src/base/UAudioPlaybackBase.pas | 292 +++++ src/base/UAudioPlayback_Bass.pas | 731 +++++++++++ src/base/UAudioPlayback_Portaudio.pas | 361 ++++++ src/base/UAudioPlayback_SDL.pas | 160 +++ src/base/UAudioPlayback_SoftMixer.pas | 1132 +++++++++++++++++ src/base/UCatCovers.pas | 173 +++ src/base/UCommandLine.pas | 334 +++++ src/base/UCommon.pas | 774 ++++++++++++ src/base/UConfig.pas | 199 +++ src/base/UCore.pas | 525 ++++++++ src/base/UCoreModule.pas | 128 ++ src/base/UCovers.pas | 430 +++++++ src/base/UDLLManager.pas | 253 ++++ src/base/UDataBase.pas | 533 ++++++++ src/base/UDraw.pas | 1390 ++++++++++++++++++++ src/base/UEditorLyrics.pas | 229 ++++ src/base/UFiles.pas | 150 +++ src/base/UGraphic.pas | 760 +++++++++++ src/base/UGraphicClasses.pas | 673 ++++++++++ src/base/UHooks.pas | 434 +++++++ src/base/UImage.pas | 993 +++++++++++++++ src/base/UIni.pas | 928 ++++++++++++++ src/base/UJoystick.pas | 282 +++++ src/base/ULCD.pas | 304 +++++ src/base/ULanguage.pas | 240 ++++ src/base/ULight.pas | 145 +++ src/base/ULog.pas | 417 ++++++ src/base/ULyrics.pas | 884 +++++++++++++ src/base/UMain.pas | 1107 ++++++++++++++++ src/base/UMediaCore_FFmpeg.pas | 405 ++++++ src/base/UMediaCore_SDL.pas | 38 + src/base/UMedia_dummy.pas | 243 ++++ src/base/UModules.pas | 26 + src/base/UMusic.pas | 1233 ++++++++++++++++++ src/base/UParty.pas | 630 ++++++++++ src/base/UPlatform.pas | 174 +++ src/base/UPlatformLinux.pas | 173 +++ src/base/UPlatformMacOSX.pas | 294 +++++ src/base/UPlatformWindows.pas | 236 ++++ src/base/UPlaylist.pas | 490 ++++++++ src/base/UPluginInterface.pas | 156 +++ src/base/URecord.pas | 766 +++++++++++ src/base/URingBuffer.pas | 128 ++ src/base/UServices.pas | 358 ++++++ src/base/USingNotes.pas | 13 + src/base/USingScores.pas | 973 ++++++++++++++ src/base/USkins.pas | 185 +++ src/base/USong.pas | 1027 +++++++++++++++ src/base/USongs.pas | 806 ++++++++++++ src/base/UTextClasses.pas | 60 + src/base/UTexture.pas | 525 ++++++++ src/base/UThemes.pas | 2234 +++++++++++++++++++++++++++++++++ src/base/UTime.pas | 185 +++ src/base/UVideo.pas | 828 ++++++++++++ src/base/UVisualizer.pas | 442 +++++++ src/base/UXMLSong.pas | 573 +++++++++ src/base/uPluginLoader.pas | 775 ++++++++++++ 65 files changed, 32548 insertions(+) create mode 100644 src/base/TextGL.pas create mode 100644 src/base/UAudioConverter.pas create mode 100644 src/base/UAudioCore_Bass.pas create mode 100644 src/base/UAudioCore_Portaudio.pas create mode 100644 src/base/UAudioDecoder_Bass.pas create mode 100644 src/base/UAudioDecoder_FFmpeg.pas create mode 100644 src/base/UAudioInput_Bass.pas create mode 100644 src/base/UAudioInput_Portaudio.pas create mode 100644 src/base/UAudioPlaybackBase.pas create mode 100644 src/base/UAudioPlayback_Bass.pas create mode 100644 src/base/UAudioPlayback_Portaudio.pas create mode 100644 src/base/UAudioPlayback_SDL.pas create mode 100644 src/base/UAudioPlayback_SoftMixer.pas create mode 100644 src/base/UCatCovers.pas create mode 100644 src/base/UCommandLine.pas create mode 100644 src/base/UCommon.pas create mode 100644 src/base/UConfig.pas create mode 100644 src/base/UCore.pas create mode 100644 src/base/UCoreModule.pas create mode 100644 src/base/UCovers.pas create mode 100644 src/base/UDLLManager.pas create mode 100644 src/base/UDataBase.pas create mode 100644 src/base/UDraw.pas create mode 100644 src/base/UEditorLyrics.pas create mode 100644 src/base/UFiles.pas create mode 100644 src/base/UGraphic.pas create mode 100644 src/base/UGraphicClasses.pas create mode 100644 src/base/UHooks.pas create mode 100644 src/base/UImage.pas create mode 100644 src/base/UIni.pas create mode 100644 src/base/UJoystick.pas create mode 100644 src/base/ULCD.pas create mode 100644 src/base/ULanguage.pas create mode 100644 src/base/ULight.pas create mode 100644 src/base/ULog.pas create mode 100644 src/base/ULyrics.pas create mode 100644 src/base/UMain.pas create mode 100644 src/base/UMediaCore_FFmpeg.pas create mode 100644 src/base/UMediaCore_SDL.pas create mode 100644 src/base/UMedia_dummy.pas create mode 100644 src/base/UModules.pas create mode 100644 src/base/UMusic.pas create mode 100644 src/base/UParty.pas create mode 100644 src/base/UPlatform.pas create mode 100644 src/base/UPlatformLinux.pas create mode 100644 src/base/UPlatformMacOSX.pas create mode 100644 src/base/UPlatformWindows.pas create mode 100644 src/base/UPlaylist.pas create mode 100644 src/base/UPluginInterface.pas create mode 100644 src/base/URecord.pas create mode 100644 src/base/URingBuffer.pas create mode 100644 src/base/UServices.pas create mode 100644 src/base/USingNotes.pas create mode 100644 src/base/USingScores.pas create mode 100644 src/base/USkins.pas create mode 100644 src/base/USong.pas create mode 100644 src/base/USongs.pas create mode 100644 src/base/UTextClasses.pas create mode 100644 src/base/UTexture.pas create mode 100644 src/base/UThemes.pas create mode 100644 src/base/UTime.pas create mode 100644 src/base/UVideo.pas create mode 100644 src/base/UVisualizer.pas create mode 100644 src/base/UXMLSong.pas create mode 100644 src/base/uPluginLoader.pas (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas new file mode 100644 index 00000000..f7b3ac95 --- /dev/null +++ b/src/base/TextGL.pas @@ -0,0 +1,462 @@ +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + SDL, + UTexture, + Classes, +// SDL_ttf, + ULog; + +procedure BuildFont; // build our bitmap font +procedure KillFont; // delete the font +function glTextWidth(text: PChar): real; // returns text width +procedure glPrintLetter(letter: char); +procedure glPrint(text: pchar); // custom GL "Print" routine +procedure SetFontPos(X, Y: real); // sets X and Y +procedure SetFontZ(Z: real); // sets Z +procedure SetFontSize(Size: real); +procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) +procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) +procedure SetFontAspectW(Aspect: real); +procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection +procedure SetFontBlend(Enable: boolean); // enables/disables blending + +//function NextPowerOfTwo(Value: integer): integer; +// Checks if the ttf exists, if yes then a SDL_ttf is returned +//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; +// Does the renderstuff, color is in $ffeecc style +//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; + +type + TTextGL = record + X: real; + Y: real; + Z: real; + Text: string; + Size: real; + ColR: real; + ColG: real; + ColB: real; + end; + + PFont = ^TFont; + TFont = record + Tex: TTexture; + Width: array[0..255] of byte; + AspectW: real; + Centered: boolean; + Outline: real; + Italic: boolean; + Reflection: boolean; + ReflectionSpacing: real; + Blend: boolean; + end; + + +var + Fonts: array of TFont; + ActFont: integer; + + +implementation + +uses + UMain, + UCommon, + SysUtils, + UGraphic; + +var + // Colours for the reflection + TempColor: array[0..3] of GLfloat; + +procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string); +var + stream: TStream; +begin + stream := GetResourceStream(aResourceName, aType); + if (not assigned(stream)) then + begin + Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + Exit; + end; + try + stream.Read(Fonts[ aID ].Width, 256); + except + Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + end; + stream.Free; +end; + +// Builds bitmap fonts +procedure BuildFont; +var + Count: integer; +begin + ActFont := 0; + + SetLength(Fonts, 5); + Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[0].Tex.H := 30; + Fonts[0].AspectW := 0.9; + Fonts[0].Outline := 0; + + Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[1].Tex.H := 30; + Fonts[1].AspectW := 1; + Fonts[1].Outline := 0; + + Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[2].Tex.H := 30; + Fonts[2].AspectW := 0.95; + Fonts[2].Outline := 5; + + Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[3].Tex.H := 30; + Fonts[3].AspectW := 0.95; + Fonts[3].Outline := 4; + +{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen + Fonts[4].Tex.H := 30; + Fonts[4].AspectW := 0.95; + Fonts[4].Done := -1; + Fonts[4].Outline := 5;} + + // load font info + LoadBitmapFontInfo( 0, 'FNT', 'Font'); + LoadBitmapFontInfo( 1, 'FNT', 'FontB'); + LoadBitmapFontInfo( 2, 'FNT', 'FontO'); + LoadBitmapFontInfo( 3, 'FNT', 'FontO2'); + + for Count := 0 to 255 do + Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; + + for Count := 0 to 255 do + Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; + + for Count := 0 to 255 do + Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; + +{ for Count := 0 to 255 do + Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} + + // enable blending by default + for Count := 0 to High(Fonts) do + Fonts[Count].Blend := true; +end; + +// Deletes the font +procedure KillFont; +begin + // delete all characters + //glDeleteLists(..., 256); +end; + +function glTextWidth(text: pchar): real; +var + Letter: char; + i: integer; +begin + Result := 0; + for i := 0 to Length(text) -1 do + begin + Letter := Text[i]; + Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + end; +end; + +procedure glPrintLetter(Letter: char); +var + TexX, TexY: real; + TexR, TexB: real; + TexHeight: real; + FWidth: real; + PL, PT: real; + PR, PB: real; + XItal: real; // X shift for italic type letter + ReflectionSpacing: real; // Distance of the reflection + Font: PFont; + Tex: PTexture; +begin + Font := @Fonts[ActFont]; + Tex := @Font.Tex; + + FWidth := Font.Width[Ord(Letter)]; + + Tex.W := FWidth * (Tex.H/30) * Font.AspectW; + + // set texture positions + TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024; + TexY := (ord(Letter) div 16) * 1/16 + 2/1024; + TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024; + TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; + + TexHeight := TexB - TexY; + + // set vector positions + PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2; + PT := Tex.Y; + PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW; + PB := PT + Tex.H; + + if (not Font.Italic) then + XItal := 0 + else + XItal := 12; + + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); + glEnd; + + // Reflection + // Yes it would make sense to put this in an extra procedure, + // but this works, doesn't take much lines, and is almost lightweight + if Font.Reflection then + begin + ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2; + + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexX, TexY + TexHeight/2); + glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3); + glTexCoord2f(TexX, TexB ); + glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z); + + glTexCoord2f(TexR, TexB ); + glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z); + + glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); + glTexCoord2f(TexR, TexY + TexHeight/2); + glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z); + glEnd; + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + if (Font.Blend) then + glDisable(GL_BLEND); + + Tex.X := Tex.X + Tex.W; + + //write the colour back + glColor4fv(@TempColor); +end; + +// Custom GL "Print" Routine +procedure glPrint(Text: PChar); +var + Pos: integer; +begin + // if there is no text do nothing + if ((Text = nil) or (Text = '')) then + Exit; + + //Save the actual color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @TempColor); + + for Pos := 0 to Length(Text) - 1 do + begin + glPrintLetter(Text[Pos]); + end; +end; + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].Tex.X := X; + Fonts[ActFont].Tex.Y := Y; +end; + +procedure SetFontZ(Z: real); +begin + Fonts[ActFont].Tex.Z := Z; +end; + +procedure SetFontSize(Size: real); +begin + Fonts[ActFont].Tex.H := 30 * (Size/10); +end; + +procedure SetFontStyle(Style: integer); +begin + ActFont := Style; +end; + +procedure SetFontItalic(Enable: boolean); +begin + Fonts[ActFont].Italic := Enable; +end; + +procedure SetFontAspectW(Aspect: real); +begin + Fonts[ActFont].AspectW := Aspect; +end; + +procedure SetFontReflection(Enable: boolean; Spacing: real); +begin + Fonts[ActFont].Reflection := Enable; + Fonts[ActFont].ReflectionSpacing := Spacing; +end; + +procedure SetFontBlend(Enable: boolean); +begin + Fonts[ActFont].Blend := Enable; +end; + + + + +(* + I uncommented this, because it was some kind of after hour hack together with blindy +it's actually just a prove of concept, as it's having some flaws +- instead nice and clean ttf code should be placed here :) + +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} + +function NextPowerOfTwo(Value: integer): integer; +begin + Result:= 1; +{$IF Defined(CPUX86_64)} + asm + mov rcx, -1 + bsr rcx, Value + inc rcx + shl Result, cl + end; +{$ELSEIF Defined(CPU386) or Defined(CPUI386)} + asm + mov ecx, -1 + bsr ecx, Value + inc ecx + shl Result, cl + end; +{$ELSE} + while (Result <= Value) do + Result := 2 * Result; +{$IFEND} +end; + +function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; +begin + if (FileExists(FileName)) then + begin + Result := TTF_OpenFont( FileName, PointSize ); + end + else + begin + Log.LogStatus('ERROR Could not find font in ' + FileName , ''); + ShowMessage( 'ERROR Could not find font in ' + FileName ); + Result := nil; + end; +end; + +function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; +var + clr : TSDL_color; +begin + clr.r := ((Color and $ff0000) shr 16 ) div 255; + clr.g := ((Color and $ff00 ) shr 8 ) div 255; + clr.b := ( Color and $ff ) div 255 ; + + result := TTF_RenderText_Blended( font, text, cLr); +end; + +procedure printrandomtext(); +var + stext,intermediary : PSDL_surface; + clrFg, clrBG : TSDL_color; + texture : Gluint; + font : PTTF_Font; + w,h : integer; +begin + + font := LoadFont('fonts\comicbd.ttf', 42); + + clrFg.r := 255; + clrFg.g := 255; + clrFg.b := 255; + clrFg.unused := 255; + + clrBg.r := 255; + clrbg.g := 0; + clrbg.b := 255; + clrbg.unused := 0; + + sText := RenderText(font, 'katzeeeeeee', $fe198e); + //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); + + // Convert the rendered text to a known format + w := nextpoweroftwo(sText.w); + h := nextpoweroftwo(sText.h); + + intermediary := SDL_CreateRGBSurface(0, w, h, 32, + $000000ff, $0000ff00, $00ff0000, $ff000000); + + SDL_SetAlpha(intermediary, 0, 255); + SDL_SetAlpha(sText, 0, 255); + SDL_BlitSurface(sText, nil, intermediary, nil); + + glGenTextures(1, @texture); + + glBindTexture(GL_TEXTURE_2D, texture); + + glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + glBindTexture(GL_TEXTURE_2D, texture); + glColor4f(1, 0, 1, 1); + + glbegin(gl_quads); + glTexCoord2f(0, 0); glVertex2f(200 , 300 ); + glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h); + glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); + glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 ); + glEnd; + glfinish(); + glDisable(GL_BLEND); + gldisable(gl_texture_2d); + + SDL_FreeSurface(sText); + SDL_FreeSurface(intermediary); + glDeleteTextures(1, @texture); + TTF_CloseFont(font); + +end; +*) + + +end. diff --git a/src/base/UAudioConverter.pas b/src/base/UAudioConverter.pas new file mode 100644 index 00000000..5647f27b --- /dev/null +++ b/src/base/UAudioConverter.pas @@ -0,0 +1,458 @@ +unit UAudioConverter; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + ULog, + ctypes, + {$IFDEF UseSRCResample} + samplerate, + {$ENDIF} + {$IFDEF UseFFmpegResample} + avcodec, + {$ENDIF} + UMediaCore_SDL, + sdl, + SysUtils, + Math; + +type + {* + * Notes: + * - 44.1kHz to 48kHz conversion or vice versa is not supported + * by SDL 1.2 (will be introduced in 1.3). + * No conversion takes place in this cases. + * This is because SDL just converts differences in powers of 2. + * So the result might not be that accurate. + * This IS audible (voice to high/low) and it needs good synchronization + * with the video or the lyrics timer. + * - float<->int16 conversion is not supported (will be part of 1.3) and + * SDL (<1.3) is not capable of handling floats at all. + * -> Using FFmpeg or libsamplerate for resampling is preferred. + * Use SDL for channel and format conversion only. + *} + TAudioConverter_SDL = class(TAudioConverter) + private + cvt: TSDL_AudioCVT; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + + {$IFDEF UseFFmpegResample} + // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so + // the quality should be good. + TAudioConverter_FFmpeg = class(TAudioConverter) + private + // TODO: use SDL for multi-channel->stereo and format conversion + ResampleContext: PReSampleContext; + Ratio: double; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + {$ENDIF} + + {$IFDEF UseSRCResample} + TAudioConverter_SRC = class(TAudioConverter) + private + ConverterState: PSRC_STATE; + ConversionData: SRC_DATA; + FormatConverter: TAudioConverter; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; + destructor Destroy(); override; + + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; + function GetOutputBufferSize(InputSize: integer): integer; override; + function GetRatio(): double; override; + end; + + // Note: SRC (=libsamplerate) provides several converters with different quality + // speed trade-offs. The SINC-types are slow but offer best quality. + // The SRC_SINC_* converters are too slow for realtime conversion, + // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting + // in audible clicks and pops. + // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD + // because it interpolates the samples. Normal "non-audiophile" users should not + // be able to hear a difference between the SINC_* ones and LINEAR. Especially + // if people sing along with the song. + // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR. + const + SRC_CONVERTER_TYPE = SRC_LINEAR; + {$ENDIF} + +implementation + +function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean; +var + srcFormat: UInt16; + dstFormat: UInt16; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or + not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then + begin + Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion'); + Exit; + end; + + if (SDL_BuildAudioCVT(@cvt, + srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate), + dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then + begin + Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion'); + Exit; + end; + + Result := true; +end; + +destructor TAudioConverter_SDL.Destroy(); +begin + // nothing to be done here + inherited; +end; + +(* + * Returns the size of the output buffer. This might be bigger than the actual + * size of resampled audio data. + *) +function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer; +begin + // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2. + // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2 + Result := InputSize * cvt.len_mult; +end; + +function TAudioConverter_SDL.GetRatio(): double; +begin + Result := cvt.len_ratio; +end; + +function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +begin + Result := -1; + + if (InputSize <= 0) then + begin + // avoid div-by-zero problems + if (InputSize = 0) then + Result := 0; + Exit; + end; + + // OutputBuffer is always bigger than or equal to InputBuffer + Move(InputBuffer[0], OutputBuffer[0], InputSize); + cvt.buf := PUint8(OutputBuffer); + cvt.len := InputSize; + if (SDL_ConvertAudio(@cvt) = -1) then + Exit; + + Result := cvt.len_cvt; +end; + + +{$IFDEF UseFFmpegResample} + +function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + // Note: ffmpeg does not support resampling for more than 2 input channels + + if (srcFormatInfo.Format <> asfS16) then + begin + Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + // TODO: use SDL here + if (srcFormatInfo.Format <> dstFormatInfo.Format) then + begin + Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + ResampleContext := audio_resample_init( + dstFormatInfo.Channels, srcFormatInfo.Channels, + Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate)); + if (ResampleContext = nil) then + begin + Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init'); + Exit; + end; + + // calculate ratio + Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) * + (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate); + + Result := true; +end; + +destructor TAudioConverter_FFmpeg.Destroy(); +begin + if (ResampleContext <> nil) then + audio_resample_close(ResampleContext); + inherited; +end; + +function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +var + InputSampleCount: integer; + OutputSampleCount: integer; +begin + Result := -1; + + if (InputSize <= 0) then + begin + // avoid div-by-zero in audio_resample() + if (InputSize = 0) then + Result := 0; + Exit; + end; + + InputSampleCount := InputSize div SrcFormatInfo.FrameSize; + OutputSampleCount := audio_resample( + ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer), + InputSampleCount); + if (OutputSampleCount = -1) then + begin + Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert'); + Exit; + end; + Result := OutputSampleCount * DstFormatInfo.FrameSize; +end; + +function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer; +begin + Result := Ceil(InputSize * GetRatio()); +end; + +function TAudioConverter_FFmpeg.GetRatio(): double; +begin + Result := Ratio; +end; + +{$ENDIF} + + +{$IFDEF UseSRCResample} + +function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +var + error: integer; + TempSrcFormatInfo: TAudioFormatInfo; + TempDstFormatInfo: TAudioFormatInfo; +begin + inherited Init(SrcFormatInfo, DstFormatInfo); + + Result := false; + + FormatConverter := nil; + + // SRC does not handle channel or format conversion + if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or + not (SrcFormatInfo.Format in [asfS16, asfFloat])) then + begin + // SDL can not convert to float, so we have to convert to SInt16 first + TempSrcFormatInfo := TAudioFormatInfo.Create( + SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format); + TempDstFormatInfo := TAudioFormatInfo.Create( + DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16); + + // init format/channel conversion + FormatConverter := TAudioConverter_SDL.Create(); + if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then + begin + Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init'); + FormatConverter.Free; + // exit after the format-info is freed + end; + + // this info was copied so we do not need it anymore + TempSrcFormatInfo.Free; + TempDstFormatInfo.Free; + + // leave if the format is not supported + if (not assigned(FormatConverter)) then + Exit; + + // adjust our copy of the input audio-format for SRC conversion + Self.SrcFormatInfo.Channels := DstFormatInfo.Channels; + Self.SrcFormatInfo.Format := asfS16; + end; + + if ((DstFormatInfo.Format <> asfS16) and + (DstFormatInfo.Format <> asfFloat)) then + begin + Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init'); + Exit; + end; + + ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate; + if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then + begin + Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init'); + Exit; + end; + + ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error); + if (ConverterState = nil) then + begin + Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init'); + Exit; + end; + + Result := true; +end; + +destructor TAudioConverter_SRC.Destroy(); +begin + if (ConverterState <> nil) then + src_delete(ConverterState); + FormatConverter.Free; + inherited; +end; + +function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; +var + FloatInputBuffer: PSingle; + FloatOutputBuffer: PSingle; + TempBuffer: PChar; + TempSize: integer; + NumSamples: integer; + OutputSize: integer; + error: integer; +begin + Result := -1; + + TempBuffer := nil; + + // format conversion with external converter (to correct number of channels and format) + if (assigned(FormatConverter)) then + begin + TempSize := FormatConverter.GetOutputBufferSize(InputSize); + GetMem(TempBuffer, TempSize); + InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize); + InputBuffer := TempBuffer; + end; + + if (InputSize <= 0) then + begin + // avoid div-by-zero problems + if (InputSize = 0) then + Result := 0; + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + Exit; + end; + + if (SrcFormatInfo.Format = asfFloat) then + begin + FloatInputBuffer := PSingle(InputBuffer); + end else begin + NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format]; + GetMem(FloatInputBuffer, NumSamples * SizeOf(Single)); + src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples); + end; + + // calculate approx. output size + OutputSize := Ceil(InputSize * ConversionData.src_ratio); + + if (DstFormatInfo.Format = asfFloat) then + begin + FloatOutputBuffer := PSingle(OutputBuffer); + end else begin + NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format]; + GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single)); + end; + + with ConversionData do + begin + data_in := PCFloat(FloatInputBuffer); + input_frames := InputSize div SrcFormatInfo.FrameSize; + data_out := PCFloat(FloatOutputBuffer); + output_frames := OutputSize div DstFormatInfo.FrameSize; + // TODO: set this to 1 at end of file-playback + end_of_input := 0; + end; + + error := src_process(ConverterState, @ConversionData); + if (error <> 0) then + begin + Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert'); + if (SrcFormatInfo.Format <> asfFloat) then + FreeMem(FloatInputBuffer); + if (DstFormatInfo.Format <> asfFloat) then + FreeMem(FloatOutputBuffer); + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + Exit; + end; + + if (SrcFormatInfo.Format <> asfFloat) then + FreeMem(FloatInputBuffer); + + if (DstFormatInfo.Format <> asfFloat) then + begin + NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels; + src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples); + FreeMem(FloatOutputBuffer); + end; + + // free format conversion buffer if used + if (TempBuffer <> nil) then + FreeMem(TempBuffer); + + if (assigned(FormatConverter)) then + InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize + else + InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize; + + // set result to output size according to SRC + Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize; +end; + +function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer; +begin + Result := Ceil(InputSize * GetRatio()); +end; + +function TAudioConverter_SRC.GetRatio(): double; +begin + // if we need additional channel/format conversion, use this ratio + if (assigned(FormatConverter)) then + Result := FormatConverter.GetRatio() + else + Result := 1.0; + + // now the SRC ratio (Note: the format might change from SInt16 to float) + Result := Result * + ConversionData.src_ratio * + (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize); +end; + +{$ENDIF} + +end. \ No newline at end of file diff --git a/src/base/UAudioCore_Bass.pas b/src/base/UAudioCore_Bass.pas new file mode 100644 index 00000000..beb2db16 --- /dev/null +++ b/src/base/UAudioCore_Bass.pas @@ -0,0 +1,123 @@ +unit UAudioCore_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + SysUtils, + UMusic, + bass; // (Note: DWORD is defined here) + +type + TAudioCore_Bass = class + public + constructor Create(); + class function GetInstance(): TAudioCore_Bass; + function ErrorGetString(): string; overload; + function ErrorGetString(errCode: integer): string; overload; + function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; + function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; + end; + +implementation + +uses + UMain, + ULog; + +var + Instance: TAudioCore_Bass; + +constructor TAudioCore_Bass.Create(); +begin + inherited; +end; + +class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass; +begin + if (not Assigned(Instance)) then + Instance := TAudioCore_Bass.Create(); + Result := Instance; +end; + +function TAudioCore_Bass.ErrorGetString(): string; +begin + Result := ErrorGetString(BASS_ErrorGetCode()); +end; + +function TAudioCore_Bass.ErrorGetString(errCode: integer): string; +begin + case errCode of + BASS_OK: result := 'No error'; + BASS_ERROR_MEM: result := 'Insufficient memory'; + BASS_ERROR_FILEOPEN: result := 'File could not be opened'; + BASS_ERROR_DRIVER: result := 'Device driver not available'; + BASS_ERROR_BUFLOST: result := 'Buffer lost'; + BASS_ERROR_HANDLE: result := 'Invalid Handle'; + BASS_ERROR_FORMAT: result := 'Sample-Format not supported'; + BASS_ERROR_POSITION: result := 'Illegal position'; + BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called'; + BASS_ERROR_START: result := 'Paused/stopped'; + BASS_ERROR_ALREADY: result := 'Already created/used'; + BASS_ERROR_NOCHAN: result := 'No free channels'; + BASS_ERROR_ILLTYPE: result := 'Type is invalid'; + BASS_ERROR_ILLPARAM: result := 'Illegal parameter'; + BASS_ERROR_NO3D: result := 'No 3D support'; + BASS_ERROR_NOEAX: result := 'No EAX support'; + BASS_ERROR_DEVICE: result := 'Invalid device number'; + BASS_ERROR_NOPLAY: result := 'Channel not playing'; + BASS_ERROR_FREQ: result := 'Freq out of range'; + BASS_ERROR_NOTFILE: result := 'Not a file stream'; + BASS_ERROR_NOHW: result := 'No hardware support'; + BASS_ERROR_EMPTY: result := 'Is empty'; + BASS_ERROR_NONET: result := 'Network unavailable'; + BASS_ERROR_CREATE: result := 'Creation error'; + BASS_ERROR_NOFX: result := 'DX8 effects unavailable'; + BASS_ERROR_NOTAVAIL: result := 'Not available'; + BASS_ERROR_DECODE: result := 'Is a decoding channel'; + BASS_ERROR_DX: result := 'Insufficient version of DirectX'; + BASS_ERROR_TIMEOUT: result := 'Timeout'; + BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported'; + BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support'; + BASS_ERROR_VERSION: result := 'Version error'; + BASS_ERROR_CODEC: result := 'Codec not available/supported'; + BASS_ERROR_ENDED: result := 'The channel/file has ended'; + BASS_ERROR_UNKNOWN: result := 'Unknown error'; + else result := 'Unknown error'; + end; +end; + +function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; +begin + case Format of + asfS16: Flags := 0; + asfFloat: Flags := BASS_SAMPLE_FLOAT; + asfU8: Flags := BASS_SAMPLE_8BITS; + else begin + Result := false; + Exit; + end; + end; + + Result := true; +end; + +function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; +begin + if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then + Format := asfFloat + else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then + Format := asfU8 + else + Format := asfS16; + + Result := true; +end; + +end. diff --git a/src/base/UAudioCore_Portaudio.pas b/src/base/UAudioCore_Portaudio.pas new file mode 100644 index 00000000..bcc8a001 --- /dev/null +++ b/src/base/UAudioCore_Portaudio.pas @@ -0,0 +1,257 @@ +unit UAudioCore_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I ../switches.inc} + + +uses + Classes, + SysUtils, + portaudio; + +type + TAudioCore_Portaudio = class + public + constructor Create(); + class function GetInstance(): TAudioCore_Portaudio; + function GetPreferredApiIndex(): TPaHostApiIndex; + function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; + end; + +implementation + +uses + ULog; + +{* + * The default API used by Portaudio is the least common denominator + * and might lack efficiency. In addition it might not even work. + * We use an array named ApiPreferenceOrder with which we define the order of + * preferred APIs to use. The first API-type in the list is tried first. + * If it is not available the next one is tried and so on ... + * If none of the preferred APIs was found the default API (detected by + * portaudio) is used. + * + * Pascal does not permit zero-length static arrays, so you must use paDefaultApi + * as an array's only member if you do not have any preferences. + * You can also append paDefaultApi to a non-zero length preferences array but + * this is optional because the default API is always used as a fallback. + *} +const + paDefaultApi = -1; +const + ApiPreferenceOrder: +{$IF Defined(MSWINDOWS)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME, but DirectSound is faster + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note: Portmixer has no mixer support for JACK at the moment + array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); +{$ELSEIF Defined(DARWIN)} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + + +{ TAudioInput_Portaudio } + +var + Instance: TAudioCore_Portaudio; + +constructor TAudioCore_Portaudio.Create(); +begin + inherited; +end; + +class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio; +begin + if not assigned(Instance) then + Instance := TAudioCore_Portaudio.Create(); + Result := Instance; +end; + +function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; +begin + result := -1; + + // select preferred sound-API + for i:= 0 to High(ApiPreferenceOrder) do + begin + if(ApiPreferenceOrder[i] <> paDefaultApi) then + begin + // check if API is available + apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(apiIndex >= 0) then + begin + // we found an API but we must check if it works + // (on linux portaudio might detect OSS but does not provide + // any devices if ALSA is enabled) + apiInfo := Pa_GetHostApiInfo(apiIndex); + if (apiInfo^.deviceCount > 0) then + begin + Result := apiIndex; + break; + end; + end; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then + begin + result := Pa_GetDefaultHostApi(); + end; +end; + +{* + * Portaudio test callback used by TestDevice(). + *} +function TestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + // this callback is called only once + result := paAbort; +end; + +(* + * Tests if the callback works. Some devices can be opened without + * an error but the callback is never called. Calling Pa_StopStream() on such + * a stream freezes USDX then. Probably because the callback-thread is deadlocked + * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream() + * block forever too and though can't be used for testing. + * + * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream) + * can be used to force the stream to stop. But for some reason this stops debugging + * in gdb with a "no process found" message. + * + * Because freezing devices are non-working devices we test the devices here to + * be able to exclude them from the device-selection list. + * + * Portaudio does not provide any test to check this error case (probably because + * it should not even occur). So we have to open the device, start the stream and + * check if the callback is called (the stream is stopped if the callback is called + * for the first time, so we can poll until the stream is stopped). + * + * Another error that occurs is that some devices (even the default device) might + * work at the beginning but stop after a few calls (maybe 50) of the callback. + * For me this problem occurs with the default output-device. The "dmix" or "front" + * device must be selected instead. Another problem is that (due to a bug in + * portaudio or ALSA) the "front" device is not detected every time portaudio + * is started. Sometimes it needs two or more restarts. + * + * There is no reasonable way to test for these errors. For the first error-case + * we could test if the callback is called 50 times but this can take a second + * for each device and it can fail in the 51st or even 100th callback call then. + * + * The second error-case cannot be tested at all. How should we now that one + * device is missing if portaudio is not even able to detect it. + * We could start and terminate Portaudio for several times and see if the device + * count changes but this is ugly. + * + * Conclusion: We are not able to autodetect a working device with + * portaudio (at least not with the newest v19_20071207) at the moment. + * So we have to provide the possibility to manually select an output device + * in the UltraStar options if we want to use portaudio instead of SDL. + *) +function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; +var + stream: PPaStream; + err: TPaError; + cbWorks: boolean; + cbPolls: integer; + i: integer; +const + altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates +begin + Result := false; + + if (sampleRate <= 0) then + sampleRate := 44100; + + // check if device supports our input-format + err := Pa_IsFormatSupported(inParams, outParams, sampleRate); + if(err <> paNoError) then + begin + // we cannot fix the error -> exit + if (err <> paInvalidSampleRate) then + Exit; + + // try alternative sample-rates to the detected one + sampleRate := 0; + for i := 0 to High(altSampleRates) do + begin + // do not check the detected sample-rate twice + if (altSampleRates[i] = sampleRate) then + continue; + // check alternative + err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]); + if (err = paNoError) then + begin + // sample-rate works + sampleRate := altSampleRates[i]; + break; + end; + end; + // no working sample-rate found + if (sampleRate = 0) then + Exit; + end; + + // FIXME: for some reason gdb stops after a call of Pa_AbortStream() + // which is implicitely called by Pa_CloseStream(). + // gdb's stops with the message: "ptrace: no process found". + // Probably because the callback-thread is killed what confuses gdb. + {$IF Defined(Debug) and Defined(Linux)} + cbWorks := true; + {$ELSE} + // open device for testing + err := Pa_OpenStream(stream, inParams, outParams, sampleRate, + paFramesPerBufferUnspecified, + paNoFlag, @TestCallback, nil); + if(err <> paNoError) then + begin + exit; + end; + + // start the callback + err := Pa_StartStream(stream); + if(err <> paNoError) then + begin + Pa_CloseStream(stream); + exit; + end; + + cbWorks := false; + // check if the callback was called (poll for max. 200ms) + for cbPolls := 1 to 20 do + begin + // if the test-callback was called it should be aborted now + if (Pa_IsStreamActive(stream) = 0) then + begin + cbWorks := true; + break; + end; + // not yet aborted, wait and try (poll) again + Pa_Sleep(10); + end; + + // finally abort the stream + Pa_CloseStream(stream); + {$IFEND} + + Result := cbWorks; +end; + +end. diff --git a/src/base/UAudioDecoder_Bass.pas b/src/base/UAudioDecoder_Bass.pas new file mode 100644 index 00000000..dba1fde4 --- /dev/null +++ b/src/base/UAudioDecoder_Bass.pas @@ -0,0 +1,242 @@ +unit UAudioDecoder_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + Classes, + SysUtils, + UMain, + UMusic, + UAudioCore_Bass, + ULog, + bass; + +type + TBassDecodeStream = class(TAudioDecodeStream) + private + Handle: HSTREAM; + FormatInfo : TAudioFormatInfo; + Error: boolean; + public + constructor Create(Handle: HSTREAM); + destructor Destroy(); override; + + procedure Close(); override; + + function GetLength(): real; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + + function ReadData(Buffer: PChar; BufSize: integer): integer; override; + end; + +type + TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder ) + public + function GetName: string; + + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +var + BassCore: TAudioCore_Bass; + + +{ TBassDecodeStream } + +constructor TBassDecodeStream.Create(Handle: HSTREAM); +var + ChannelInfo: BASS_CHANNELINFO; + Format: TAudioSampleFormat; +begin + inherited Create(); + Self.Handle := Handle; + + // setup format info + if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then + begin + raise Exception.Create('Failed to open decode-stream'); + end; + BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format); + FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format); + + Error := false; +end; + +destructor TBassDecodeStream.Destroy(); +begin + Close(); + inherited; +end; + +procedure TBassDecodeStream.Close(); +begin + if (Handle <> 0) then + begin + BASS_StreamFree(Handle); + Handle := 0; + end; + PerformOnClose(); + FreeAndNil(FormatInfo); + Error := false; +end; + +function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TBassDecodeStream.GetLength(): real; +var + bytes: QWORD; +begin + bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +function TBassDecodeStream.GetPosition: real; +var + bytes: QWORD; +begin + bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +procedure TBassDecodeStream.SetPosition(Time: real); +var + bytes: QWORD; +begin + bytes := BASS_ChannelSeconds2Bytes(Handle, Time); + BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE); +end; + +function TBassDecodeStream.GetLoop(): boolean; +var + flags: DWORD; +begin + // retrieve channel flags + flags := BASS_ChannelFlags(Handle, 0, 0); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop'); + Result := false; + Exit; + end; + Result := (flags and BASS_SAMPLE_LOOP) <> 0; +end; + +procedure TBassDecodeStream.SetLoop(Enabled: boolean); +var + flags: DWORD; +begin + // set/unset loop-flag + if (Enabled) then + flags := BASS_SAMPLE_LOOP + else + flags := 0; + + // set new flag-bits + if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then + begin + Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop'); + Exit; + end; +end; + +function TBassDecodeStream.IsEOF(): boolean; +begin + Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED); +end; + +function TBassDecodeStream.IsError(): boolean; +begin + Result := Error; +end; + +function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer; +begin + Result := BASS_ChannelGetData(Handle, Buffer, BufSize); + // check error state (do not handle EOF as error) + if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then + Error := true + else + Error := false; +end; + + +{ TAudioDecoder_Bass } + +function TAudioDecoder_Bass.GetName: String; +begin + result := 'BASS_Decoder'; +end; + +function TAudioDecoder_Bass.InitializeDecoder(): boolean; +begin + BassCore := TAudioCore_Bass.GetInstance(); + Result := true; +end; + +function TAudioDecoder_Bass.FinalizeDecoder(): boolean; +begin + Result := true; +end; + +function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream; +var + Stream: HSTREAM; + ChannelInfo: BASS_CHANNELINFO; + FileExt: string; +begin + Result := nil; + + // check if BASS was initialized + // in case the decoder is not used with BASS playback, init the NO_SOUND device + if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then + BASS_Init(0, 44100, 0, 0, nil); + + // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files? + // disadvantage: seeking will slow down. + Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE); + if (Stream = 0) then + begin + //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open'); + Exit; + end; + + // check if BASS opened some erroneously recognized file-formats + if BASS_ChannelGetInfo(Stream, channelInfo) then + begin + fileExt := ExtractFileExt(Filename); + // BASS opens FLV-files (maybe others too) although it cannot handle them. + // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help. + if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then + begin + BASS_StreamFree(Stream); + Exit; + end; + end; + + Result := TBassDecodeStream.Create(Stream); +end; + + +initialization + MediaManager.Add(TAudioDecoder_Bass.Create); + +end. diff --git a/src/base/UAudioDecoder_FFmpeg.pas b/src/base/UAudioDecoder_FFmpeg.pas new file mode 100644 index 00000000..d9b4c93c --- /dev/null +++ b/src/base/UAudioDecoder_FFmpeg.pas @@ -0,0 +1,1114 @@ +unit UAudioDecoder_FFmpeg; + +(******************************************************************************* + * + * This unit is primarily based upon - + * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html + * + * and tutorial03.c + * + * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html + * + *******************************************************************************) + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// show FFmpeg specific debug output +{.$DEFINE DebugFFmpegDecode} + +// FFmpeg is very verbose and shows a bunch of errors. +// Those errors (they can be considered as warnings by us) can be ignored +// as they do not give any useful information. +// There is no solution to fix this except for turning them off. +{.$DEFINE EnableFFmpegErrorOutput} + +implementation + +uses + Classes, + SysUtils, + Math, + UMusic, + UIni, + UMain, + avcodec, + avformat, + avutil, + avio, + mathematics, // used for av_rescale_q + rational, + UMediaCore_FFmpeg, + SDL, + ULog, + UCommon, + UConfig; + +const + MAX_AUDIOQ_SIZE = (5 * 16 * 1024); + +const + // TODO: The factor 3/2 might not be necessary as we do not need extra + // space for synchronizing as in the tutorial. + AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2; + +type + TFFmpegDecodeStream = class(TAudioDecodeStream) + private + StateLock: PSDL_Mutex; + + EOFState: boolean; // end-of-stream flag (locked by StateLock) + ErrorState: boolean; // error flag (locked by StateLock) + + QuitRequest: boolean; // (locked by StateLock) + ParserIdleCond: PSDL_Cond; + + // parser pause/resume data + ParserLocked: boolean; + ParserPauseRequestCount: integer; + ParserUnlockedCond: PSDL_Cond; + ParserResumeCond: PSDL_Cond; + + SeekRequest: boolean; // (locked by StateLock) + SeekFlags: integer; // (locked by StateLock) + SeekPos: double; // stream position to seek for (in secs) (locked by StateLock) + SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock) + SeekFinishedCond: PSDL_Cond; + + Loop: boolean; // (locked by StateLock) + + ParseThread: PSDL_Thread; + PacketQueue: TPacketQueue; + + FormatInfo: TAudioFormatInfo; + + // FFmpeg specific data + FormatCtx: PAVFormatContext; + CodecCtx: PAVCodecContext; + Codec: PAVCodec; + + AudioStreamIndex: integer; + AudioStream: PAVStream; + AudioStreamPos: double; // stream position in seconds (locked by DecoderLock) + + // decoder pause/resume data + DecoderLocked: boolean; + DecoderPauseRequestCount: integer; + DecoderUnlockedCond: PSDL_Cond; + DecoderResumeCond: PSDL_Cond; + + // state-vars for DecodeFrame (locked by DecoderLock) + AudioPaket: TAVPacket; + AudioPaketData: PChar; + AudioPaketSize: integer; + AudioPaketSilence: integer; // number of bytes of silence to return + + // state-vars for AudioCallback (locked by DecoderLock) + AudioBufferPos: integer; + AudioBufferSize: integer; + AudioBuffer: PChar; + + Filename: string; + + procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); + procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} + procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} + function IsSeeking(): boolean; + function IsQuit(): boolean; + + procedure Reset(); + + procedure Parse(); + function ParseLoop(): boolean; + procedure PauseParser(); + procedure ResumeParser(); + + function DecodeFrame(Buffer: PChar; BufferSize: integer): integer; + procedure FlushCodecBuffers(); + procedure PauseDecoder(); + procedure ResumeDecoder(); + public + constructor Create(); + destructor Destroy(); override; + + function Open(const Filename: string): boolean; + procedure Close(); override; + + function GetLength(): real; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + end; + +type + TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder ) + public + function GetName: string; + + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +var + FFmpegCore: TMediaCore_FFmpeg; + +function ParseThreadMain(Data: Pointer): integer; cdecl; forward; + + +{ TFFmpegDecodeStream } + +constructor TFFmpegDecodeStream.Create(); +begin + inherited Create(); + + StateLock := SDL_CreateMutex(); + ParserUnlockedCond := SDL_CreateCond(); + ParserResumeCond := SDL_CreateCond(); + ParserIdleCond := SDL_CreateCond(); + SeekFinishedCond := SDL_CreateCond(); + DecoderUnlockedCond := SDL_CreateCond(); + DecoderResumeCond := SDL_CreateCond(); + + // according to the documentation of avcodec_decode_audio(2), sample-data + // should be aligned on a 16 byte boundary. Otherwise internal calls + // (e.g. to SSE or Altivec operations) might fail or lack performance on some + // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher + // alignment for buffers of this size (alignment depends on the size of the + // requested buffer), we will set the alignment explicitly as the minimum + // alignment used by Delphi and FPC is on an 8 byte boundary. + // + // Note: AudioBuffer was previously defined as a field of type TAudioBuffer + // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated. + // Fields of records are aligned different to memory allocated with GetMem(), + // aligning depending on the type but will be at least 2 bytes. + // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive + // was not applicable as Delphi in contrast to FPC provides at most 8 byte + // alignment ({$ALIGN 16} is not supported) by this directive. + AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16); + + Reset(); +end; + +procedure TFFmpegDecodeStream.Reset(); +begin + ParseThread := nil; + + EOFState := false; + ErrorState := false; + Loop := false; + QuitRequest := false; + + AudioPaketData := nil; + AudioPaketSize := 0; + AudioPaketSilence := 0; + + AudioBufferPos := 0; + AudioBufferSize := 0; + + ParserLocked := false; + ParserPauseRequestCount := 0; + DecoderLocked := false; + DecoderPauseRequestCount := 0; + + FillChar(AudioPaket, SizeOf(TAVPacket), 0); +end; + +{* + * Frees the decode-stream data. + *} +destructor TFFmpegDecodeStream.Destroy(); +begin + Close(); + + SDL_DestroyMutex(StateLock); + SDL_DestroyCond(ParserUnlockedCond); + SDL_DestroyCond(ParserResumeCond); + SDL_DestroyCond(ParserIdleCond); + SDL_DestroyCond(SeekFinishedCond); + SDL_DestroyCond(DecoderUnlockedCond); + SDL_DestroyCond(DecoderResumeCond); + + FreeAlignedMem(AudioBuffer); + + inherited; +end; + +function TFFmpegDecodeStream.Open(const Filename: string): boolean; +var + SampleFormat: TAudioSampleFormat; + AVResult: integer; +begin + Result := false; + + Close(); + Reset(); + + if (not FileExists(Filename)) then + begin + Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg'); + Exit; + end; + + Self.Filename := Filename; + + // open audio file + if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then + begin + Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg'); + Exit; + end; + + // generate PTS values if they do not exist + FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS; + + // retrieve stream information + if (av_find_stream_info(FormatCtx) < 0) then + begin + Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end + FormatCtx^.pb.eof_reached := 0; + + {$IFDEF DebugFFmpegDecode} + dump_format(FormatCtx, 0, pchar(Filename), 0); + {$ENDIF} + + AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx); + if (AudioStreamIndex < 0) then + begin + Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg'); + + AudioStream := FormatCtx.streams[AudioStreamIndex]; + CodecCtx := AudioStream^.codec; + + // TODO: should we use this or not? Should we allow 5.1 channel audio? + (* + {$IF LIBAVCODEC_VERSION >= 51042000} + if (CodecCtx^.channels > 0) then + CodecCtx^.request_channels := Min(2, CodecCtx^.channels) + else + CodecCtx^.request_channels := 2; + {$IFEND} + *) + + Codec := avcodec_find_decoder(CodecCtx^.codec_id); + if (Codec = nil) then + begin + Log.LogError('Unsupported codec!', 'UAudio_FFmpeg'); + CodecCtx := nil; + Close(); + Exit; + end; + + // set debug options + CodecCtx^.debug_mv := 0; + CodecCtx^.debug := 0; + + // detect bug-workarounds automatically + CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT; + // error resilience strategy (careful/compliant/agressive/very_aggressive) + //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; + // allow non spec compliant speedup tricks. + //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST; + + // Note: avcodec_open() and avcodec_close() are not thread-safe and will + // fail if called concurrently by different threads. + FFmpegCore.LockAVCodec(); + try + AVResult := avcodec_open(CodecCtx, Codec); + finally + FFmpegCore.UnlockAVCodec(); + end; + if (AVResult < 0) then + begin + Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg'); + Close(); + Exit; + end; + + // now initialize the audio-format + + if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then + begin + // try standard format + SampleFormat := asfS16; + end; + + FormatInfo := TAudioFormatInfo.Create( + CodecCtx^.channels, + CodecCtx^.sample_rate, + SampleFormat + ); + + + PacketQueue := TPacketQueue.Create(); + + // finally start the decode thread + ParseThread := SDL_CreateThread(@ParseThreadMain, Self); + + Result := true; +end; + +procedure TFFmpegDecodeStream.Close(); +var + ThreadResult: integer; +begin + // wake threads waiting for packet-queue data + // Note: normally, there are no waiting threads. If there were waiting + // ones, they would block the audio-callback thread. + if (assigned(PacketQueue)) then + PacketQueue.Abort(); + + // send quit request (to parse-thread etc) + SDL_mutexP(StateLock); + QuitRequest := true; + SDL_CondBroadcast(ParserIdleCond); + SDL_mutexV(StateLock); + + // abort parse-thread + if (ParseThread <> nil) then + begin + // and wait until it terminates + SDL_WaitThread(ParseThread, ThreadResult); + ParseThread := nil; + end; + + // Close the codec + if (CodecCtx <> nil) then + begin + // avcodec_close() is not thread-safe + FFmpegCore.LockAVCodec(); + try + avcodec_close(CodecCtx); + finally + FFmpegCore.UnlockAVCodec(); + end; + CodecCtx := nil; + end; + + // Close the video file + if (FormatCtx <> nil) then + begin + av_close_input_file(FormatCtx); + FormatCtx := nil; + end; + + PerformOnClose(); + + FreeAndNil(PacketQueue); + FreeAndNil(FormatInfo); +end; + +function TFFmpegDecodeStream.GetLength(): real; +begin + // do not forget to consider the start_time value here + Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE; +end; + +function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TFFmpegDecodeStream.IsEOF(): boolean; +begin + SDL_mutexP(StateLock); + Result := EOFState; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetEOF(State: boolean); +begin + SDL_mutexP(StateLock); + EOFState := State; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsError(): boolean; +begin + SDL_mutexP(StateLock); + Result := ErrorState; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetError(State: boolean); +begin + SDL_mutexP(StateLock); + ErrorState := State; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsSeeking(): boolean; +begin + SDL_mutexP(StateLock); + Result := SeekRequest; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.IsQuit(): boolean; +begin + SDL_mutexP(StateLock); + Result := QuitRequest; + SDL_mutexV(StateLock); +end; + +function TFFmpegDecodeStream.GetPosition(): real; +var + BufferSizeSec: double; +begin + PauseDecoder(); + + // ReadData() does not return all of the buffer retrieved by DecodeFrame(). + // Determine the size of the unused part of the decode-buffer. + BufferSizeSec := (AudioBufferSize - AudioBufferPos) / + FormatInfo.BytesPerSec; + + // subtract the size of unused buffer-data from the audio clock. + Result := AudioStreamPos - BufferSizeSec; + + ResumeDecoder(); +end; + +procedure TFFmpegDecodeStream.SetPosition(Time: real); +begin + SetPositionIntern(Time, true, true); +end; + +function TFFmpegDecodeStream.GetLoop(): boolean; +begin + SDL_mutexP(StateLock); + Result := Loop; + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean); +begin + SDL_mutexP(StateLock); + Loop := Enabled; + SDL_mutexV(StateLock); +end; + + +(******************************************** + * Parser section + ********************************************) + +procedure TFFmpegDecodeStream.PauseParser(); +begin + if (SDL_ThreadID() = ParseThread.threadid) then + Exit; + + SDL_mutexP(StateLock); + Inc(ParserPauseRequestCount); + while (ParserLocked) do + SDL_CondWait(ParserUnlockedCond, StateLock); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.ResumeParser(); +begin + if (SDL_ThreadID() = ParseThread.threadid) then + Exit; + + SDL_mutexP(StateLock); + Dec(ParserPauseRequestCount); + SDL_CondSignal(ParserResumeCond); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); +begin + // - Pause the parser first to prevent it from putting obsolete packages + // into the queue after the queue was flushed and before seeking is done. + // Otherwise we will hear fragments of old data, if the stream was seeked + // in stopped mode and resumed afterwards (applies to non-blocking mode only). + // - Pause the decoder to avoid race-condition that might occur otherwise. + // - Last lock the state lock because we are manipulating some shared state-vars. + PauseParser(); + PauseDecoder(); + SDL_mutexP(StateLock); + + // configure seek parameters + SeekPos := Time; + SeekFlush := Flush; + SeekFlags := AVSEEK_FLAG_ANY; + SeekRequest := true; + + // Note: the BACKWARD-flag seeks to the first position <= the position + // searched for. Otherwise e.g. position 0 might not be seeked correct. + // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame + // following. In streams with few key-frames (like many flv-files) the next + // key-frame after 0 might be 5secs ahead. + if (Time < AudioStreamPos) then + SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; + + EOFState := false; + ErrorState := false; + + // send a reuse signal in case the parser was stopped (e.g. because of an EOF) + SDL_CondSignal(ParserIdleCond); + + SDL_mutexV(StateLock); + ResumeDecoder(); + ResumeParser(); + + // in blocking mode, wait until seeking is done + if (Blocking) then + begin + SDL_mutexP(StateLock); + while (SeekRequest) do + SDL_CondWait(SeekFinishedCond, StateLock); + SDL_mutexV(StateLock); + end; +end; + +function ParseThreadMain(Data: Pointer): integer; cdecl; +var + Stream: TFFmpegDecodeStream; +begin + Stream := TFFmpegDecodeStream(Data); + if (Stream <> nil) then + Stream.Parse(); + Result := 0; +end; + +procedure TFFmpegDecodeStream.Parse(); +begin + // reuse thread as long as the stream is not terminated + while (ParseLoop()) do + begin + // wait for reuse or destruction of stream + SDL_mutexP(StateLock); + while (not (SeekRequest or QuitRequest)) do + SDL_CondWait(ParserIdleCond, StateLock); + SDL_mutexV(StateLock); + end; +end; + +(** + * Parser main loop. + * Will not return until parsing of the stream is finished. + * Reasons for the parser to return are: + * - the end-of-file is reached + * - an error occured + * - the stream was quited (received a quit-request) + * Returns true if the stream can be resumed or false if the stream has to + * be terminated. + *) +function TFFmpegDecodeStream.ParseLoop(): boolean; +var + Packet: TAVPacket; + StatusPacket: PAVPacket; + SeekTarget: int64; + ByteIOCtx: PByteIOContext; + ErrorCode: integer; + StartSilence: double; // duration of silence at start of stream + StartSilencePtr: PDouble; // pointer for the EMPTY status packet + + // Note: pthreads wakes threads waiting on a mutex in the order of their + // priority and not in FIFO order. SDL does not provide any option to + // control priorities. This might (and already did) starve threads waiting + // on the mutex (e.g. SetPosition) making usdx look like it was froozen. + // Instead of simply locking the critical section we set a ParserLocked flag + // instead and give priority to the threads requesting the parser to pause. + procedure LockParser(); + begin + SDL_mutexP(StateLock); + while (ParserPauseRequestCount > 0) do + SDL_CondWait(ParserResumeCond, StateLock); + ParserLocked := true; + SDL_mutexV(StateLock); + end; + + procedure UnlockParser(); + begin + SDL_mutexP(StateLock); + ParserLocked := false; + SDL_CondBroadcast(ParserUnlockedCond); + SDL_mutexV(StateLock); + end; + +begin + Result := true; + + while (true) do + begin + LockParser(); + try + + if (IsQuit()) then + begin + Result := false; + Exit; + end; + + // handle seek-request (Note: no need to lock SeekRequest here) + if (SeekRequest) then + begin + // first try: seek on the audio stream + SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base)); + StartSilence := 0; + if (SeekTarget < AudioStream^.start_time) then + StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base); + ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags); + + if (ErrorCode < 0) then + begin + // second try: seek on the default stream (necessary for flv-videos and some ogg-files) + SeekTarget := Round(SeekPos * AV_TIME_BASE); + StartSilence := 0; + if (SeekTarget < FormatCtx^.start_time) then + StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE; + ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags); + end; + + // pause decoder and lock state (keep the lock-order to avoid deadlocks). + // Note that the decoder does not block in the packet-queue in seeking state, + // so locking the decoder here does not cause a dead-lock. + PauseDecoder(); + SDL_mutexP(StateLock); + try + if (ErrorCode < 0) then + begin + // seeking failed + ErrorState := true; + Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg'); + end + else + begin + if (SeekFlush) then + begin + // flush queue (we will send a Flush-Packet when seeking is finished) + PacketQueue.Flush(); + + // flush the decode buffers + AudioBufferSize := 0; + AudioBufferPos := 0; + AudioPaketSize := 0; + AudioPaketSilence := 0; + FlushCodecBuffers(); + + // Set preliminary stream position. The position will be set to + // the correct value as soon as the first packet is decoded. + AudioStreamPos := SeekPos; + end + else + begin + // request avcodec buffer flush + PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil); + end; + + // fill the gap between position 0 and start_time with silence + // but not if we are in loop mode + if ((StartSilence > 0) and (not Loop)) then + begin + GetMem(StartSilencePtr, SizeOf(StartSilence)); + StartSilencePtr^ := StartSilence; + PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr); + end; + end; + + SeekRequest := false; + SDL_CondBroadcast(SeekFinishedCond); + finally + SDL_mutexV(StateLock); + ResumeDecoder(); + end; + end; + + if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then + begin + SDL_Delay(10); + Continue; + end; + + if (av_read_frame(FormatCtx, Packet) < 0) then + begin + // failed to read a frame, check reason + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} + ByteIOCtx := FormatCtx^.pb; + {$ELSE} + ByteIOCtx := @FormatCtx^.pb; + {$IFEND} + + // check for end-of-file (eof is not an error) + if (url_feof(ByteIOCtx) <> 0) then + begin + if (GetLoop()) then + begin + // rewind stream (but do not flush) + SetPositionIntern(0, false, false); + Continue; + end + else + begin + // signal end-of-file + PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil); + Exit; + end; + end; + + // check for errors + if (url_ferror(ByteIOCtx) <> 0) then + begin + // an error occured -> abort and wait for repositioning or termination + PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil); + Exit; + end; + + // no error -> wait for user input + SDL_Delay(100); + Continue; + end; + + if (Packet.stream_index = AudioStreamIndex) then + PacketQueue.Put(@Packet) + else + av_free_packet(@Packet); + + finally + UnlockParser(); + end; + end; +end; + + +(******************************************** + * Decoder section + ********************************************) + +procedure TFFmpegDecodeStream.PauseDecoder(); +begin + SDL_mutexP(StateLock); + Inc(DecoderPauseRequestCount); + while (DecoderLocked) do + SDL_CondWait(DecoderUnlockedCond, StateLock); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.ResumeDecoder(); +begin + SDL_mutexP(StateLock); + Dec(DecoderPauseRequestCount); + SDL_CondSignal(DecoderResumeCond); + SDL_mutexV(StateLock); +end; + +procedure TFFmpegDecodeStream.FlushCodecBuffers(); +begin + // if no flush operation is specified, avcodec_flush_buffers will not do anything. + if (@CodecCtx.codec.flush <> nil) then + begin + // flush buffers used by avcodec_decode_audio, etc. + avcodec_flush_buffers(CodecCtx); + end + else + begin + // we need a Workaround to avoid plopping noise with ogg-vorbis and + // mp3 (in older versions of FFmpeg). + // We will just reopen the codec. + FFmpegCore.LockAVCodec(); + try + avcodec_close(CodecCtx); + avcodec_open(CodecCtx, Codec); + finally + FFmpegCore.UnlockAVCodec(); + end; + end; +end; + +function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer; +var + PaketDecodedSize: integer; // size of packet data used for decoding + DataSize: integer; // size of output data decoded by FFmpeg + BlockQueue: boolean; + SilenceDuration: double; + {$IFDEF DebugFFmpegDecode} + TmpPos: double; + {$ENDIF} +begin + Result := -1; + + if (EOF) then + Exit; + + while(true) do + begin + // for titles with start_time > 0 we have to generate silence + // until we reach the pts of the first data packet. + if (AudioPaketSilence > 0) then + begin + DataSize := Min(AudioPaketSilence, BufferSize); + FillChar(Buffer[0], DataSize, 0); + Dec(AudioPaketSilence, DataSize); + AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; + Result := DataSize; + Exit; + end; + + // read packet data + while (AudioPaketSize > 0) do + begin + DataSize := BufferSize; + + {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 + PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer), + DataSize, AudioPaketData, AudioPaketSize); + {$ELSE} + PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer), + DataSize, AudioPaketData, AudioPaketSize); + {$IFEND} + + if(PaketDecodedSize < 0) then + begin + // if error, skip frame + {$IFDEF DebugFFmpegDecode} + DebugWriteln('Skip audio frame'); + {$ENDIF} + AudioPaketSize := 0; + Break; + end; + + Inc(AudioPaketData, PaketDecodedSize); + Dec(AudioPaketSize, PaketDecodedSize); + + // check if avcodec_decode_audio returned data, otherwise fetch more frames + if (DataSize <= 0) then + Continue; + + // update stream position by the amount of fetched data + AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; + + // we have data, return it and come back for more later + Result := DataSize; + Exit; + end; + + // free old packet data + if (AudioPaket.data <> nil) then + av_free_packet(@AudioPaket); + + // do not block queue on seeking (to avoid deadlocks on the DecoderLock) + if (IsSeeking()) then + BlockQueue := false + else + BlockQueue := true; + + // request a new packet and block if none available. + // If this fails, the queue was aborted. + if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then + Exit; + + // handle Status-packet + if (PChar(AudioPaket.data) = STATUS_PACKET) then + begin + AudioPaket.data := nil; + AudioPaketData := nil; + AudioPaketSize := 0; + + case (AudioPaket.flags) of + PKT_STATUS_FLAG_FLUSH: + begin + // just used if SetPositionIntern was called without the flush flag. + FlushCodecBuffers; + end; + PKT_STATUS_FLAG_EOF: // end-of-file + begin + // ignore EOF while seeking + if (not IsSeeking()) then + SetEOF(true); + // buffer contains no data -> result = -1 + Exit; + end; + PKT_STATUS_FLAG_ERROR: + begin + SetError(true); + Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame'); + Exit; + end; + PKT_STATUS_FLAG_EMPTY: + begin + SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^; + AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize; + PacketQueue.FreeStatusInfo(AudioPaket); + end + else + begin + Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame'); + end; + end; + + Continue; + end; + + AudioPaketData := PChar(AudioPaket.data); + AudioPaketSize := AudioPaket.size; + + // if available, update the stream position to the presentation time of this package + if(AudioPaket.pts <> AV_NOPTS_VALUE) then + begin + {$IFDEF DebugFFmpegDecode} + TmpPos := AudioStreamPos; + {$ENDIF} + AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts; + {$IFDEF DebugFFmpegDecode} + DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' + + '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' + + 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3)); + {$ENDIF} + end; + end; +end; + +function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + CopyByteCount: integer; // number of bytes to copy + RemainByteCount: integer; // number of bytes left (remain) to read + BufferPos: integer; + + // prioritize pause requests + procedure LockDecoder(); + begin + SDL_mutexP(StateLock); + while (DecoderPauseRequestCount > 0) do + SDL_CondWait(DecoderResumeCond, StateLock); + DecoderLocked := true; + SDL_mutexV(StateLock); + end; + + procedure UnlockDecoder(); + begin + SDL_mutexP(StateLock); + DecoderLocked := false; + SDL_CondBroadcast(DecoderUnlockedCond); + SDL_mutexV(StateLock); + end; + +begin + Result := -1; + + // set number of bytes to copy to the output buffer + BufferPos := 0; + + LockDecoder(); + try + // leave if end-of-file is reached + if (EOF) then + Exit; + + // copy data to output buffer + while (BufferPos < BufferSize) do + begin + // check if we need more data + if (AudioBufferPos >= AudioBufferSize) then + begin + AudioBufferPos := 0; + + // we have already sent all our data; get more + AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE); + + // check for errors or EOF + if(AudioBufferSize < 0) then + begin + Result := BufferPos; + Exit; + end; + end; + + // calc number of new bytes in the decode-buffer + CopyByteCount := AudioBufferSize - AudioBufferPos; + // resize copy-count if more bytes available than needed (remaining bytes are used the next time) + RemainByteCount := BufferSize - BufferPos; + if (CopyByteCount > RemainByteCount) then + CopyByteCount := RemainByteCount; + + Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount); + + Inc(BufferPos, CopyByteCount); + Inc(AudioBufferPos, CopyByteCount); + end; + finally + UnlockDecoder(); + end; + + Result := BufferSize; +end; + + +{ TAudioDecoder_FFmpeg } + +function TAudioDecoder_FFmpeg.GetName: String; +begin + Result := 'FFmpeg_Decoder'; +end; + +function TAudioDecoder_FFmpeg.InitializeDecoder: boolean; +begin + //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg'); + FFmpegCore := TMediaCore_FFmpeg.GetInstance(); + av_register_all(); + + // Do not show uninformative error messages by default. + // FFmpeg prints all error-infos on the console by default what + // is very confusing as the playback of the files is correct. + // We consider these errors to be internal to FFMpeg. They can be fixed + // by the FFmpeg guys only and do not provide any useful information in + // respect to USDX. + {$IFNDEF EnableFFmpegErrorOutput} + {$IF LIBAVUTIL_VERSION_MAJOR >= 50} + av_log_set_level(AV_LOG_FATAL); + {$ELSE} + // FATAL and ERROR share one log-level, so we have to use QUIET + av_log_set_level(AV_LOG_QUIET); + {$IFEND} + {$ENDIF} + + Result := true; +end; + +function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean; +begin + Result := true; +end; + +function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream; +var + Stream: TFFmpegDecodeStream; +begin + Result := nil; + + Stream := TFFmpegDecodeStream.Create(); + if (not Stream.Open(Filename)) then + begin + Stream.Free; + Exit; + end; + + Result := Stream; +end; + + +initialization + MediaManager.Add(TAudioDecoder_FFmpeg.Create); + +end. diff --git a/src/base/UAudioInput_Bass.pas b/src/base/UAudioInput_Bass.pas new file mode 100644 index 00000000..65a4704d --- /dev/null +++ b/src/base/UAudioInput_Bass.pas @@ -0,0 +1,481 @@ +unit UAudioInput_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + URecord, + UMusic; + +implementation + +uses + UMain, + UIni, + ULog, + UAudioCore_Bass, + UCommon, // (Note: for MakeLong on non-windows platforms) + {$IFDEF MSWINDOWS} + Windows, // (Note: for MakeLong) + {$ENDIF} + bass; // (Note: DWORD is redefined here -> insert after Windows-unit) + +type + TAudioInput_Bass = class(TAudioInputBase) + private + function EnumDevices(): boolean; + public + function GetName: String; override; + function InitializeRecord: boolean; override; + function FinalizeRecord: boolean; override; + end; + + TBassInputDevice = class(TAudioInputDevice) + private + RecordStream: HSTREAM; + BassDeviceID: DWORD; // DeviceID used by BASS + SingleIn: boolean; + + function SetInputSource(SourceIndex: integer): boolean; + function GetInputSource(): integer; + public + function Open(): boolean; + function Close(): boolean; + function Start(): boolean; override; + function Stop(): boolean; override; + + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + end; + +var + BassCore: TAudioCore_Bass; + + +{ Global } + +{* + * Bass input capture callback. + * Params: + * stream - BASS input stream + * buffer - buffer of captured samples + * len - size of buffer in bytes + * user - players associated with left/right channels + *} +function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; + len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +begin + AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice); + Result := true; +end; + + +{ TBassInputDevice } + +function TBassInputDevice.GetInputSource(): integer; +var + SourceCnt: integer; + i: integer; + flags: DWORD; +begin + // get input-source config (subtract virtual device to get BASS indices) + SourceCnt := Length(Source)-1; + + // find source + Result := -1; + for i := 0 to SourceCnt-1 do + begin + // get input settings + flags := BASS_RecordGetInput(i, PSingle(nil)^); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); + Exit; + end; + + // check if current source is selected + if ((flags and BASS_INPUT_OFF) = 0) then + begin + // selected source found + Result := i; + Exit; + end; + end; +end; + +function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean; +var + SourceCnt: integer; + i: integer; + flags: DWORD; +begin + Result := false; + + // check for invalid source index + if (SourceIndex < 0) then + Exit; + + // get input-source config (subtract virtual device to get BASS indices) + SourceCnt := Length(Source)-1; + + // turn on selected source (turns off the others for single-in devices) + if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then + begin + Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); + Exit; + end; + + // turn off all other sources (not needed for single-in devices) + if (not SingleIn) then + begin + for i := 0 to SourceCnt-1 do + begin + if (i = SourceIndex) then + continue; + // get input settings + flags := BASS_RecordGetInput(i, PSingle(nil)^); + if (flags = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); + Exit; + end; + // deselect source if selected + if ((flags and BASS_INPUT_OFF) = 0) then + BASS_RecordSetInput(i, BASS_INPUT_OFF, -1); + end; + end; + + Result := true; +end; + +function TBassInputDevice.Open(): boolean; +var + FormatFlags: DWORD; + SourceIndex: integer; +const + latency = 20; // 20ms callback period (= latency) +begin + Result := false; + + if (not BASS_RecordInit(BassDeviceID)) then + begin + Log.LogError('BASS_RecordInit['+Name+']: ' + + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); + Exit; + end; + + if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then + begin + Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open'); + Exit; + end; + + // start capturing in paused state + RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels, + MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency), + @MicrophoneCallback, Self); + if (RecordStream = 0) then + begin + Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); + BASS_RecordFree; + Exit; + end; + + // save current source selection and select new source + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // nothing to do if default source is used + SourceRestore := -1; + end + else + begin + // store current source-index and select new source + SourceRestore := GetInputSource(); + SetInputSource(SourceIndex); + end; + + Result := true; +end; + +{* Start input-capturing on this device. *} +function TBassInputDevice.Start(): boolean; +begin + Result := false; + + // recording already started -> stop first + if (RecordStream <> 0) then + Stop(); + + // TODO: Do not open the device here (takes too much time). + if not Open() then + Exit; + + if (not BASS_ChannelPlay(RecordStream, true)) then + begin + Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); + Exit; + end; + + Result := true; +end; + +{* Stop input-capturing on this device. *} +function TBassInputDevice.Stop(): boolean; +begin + Result := false; + + if (RecordStream = 0) then + Exit; + if (not BASS_RecordSetDevice(BassDeviceID)) then + Exit; + + if (not BASS_ChannelStop(RecordStream)) then + begin + Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop'); + end; + + // TODO: Do not close the device here (takes too much time). + Result := Close(); +end; + +function TBassInputDevice.Close(): boolean; +begin + // restore source selection + if (SourceRestore >= 0) then + begin + SetInputSource(SourceRestore); + end; + + // free data + if (not BASS_RecordFree()) then + begin + Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close'); + Result := false; + end + else + begin + Result := true; + end; + + RecordStream := 0; +end; + +function TBassInputDevice.GetVolume(): single; +var + SourceIndex: integer; + lVolume: Single; +begin + Result := 0; + + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // if default source used find selected source + SourceIndex := GetInputSource(); + if (SourceIndex = -1) then + Exit; + end; + + if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then + begin + Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume'); + Exit; + end; + Result := lVolume; +end; + +procedure TBassInputDevice.SetVolume(Volume: single); +var + SourceIndex: integer; +begin + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // if default source used find selected source + SourceIndex := GetInputSource(); + if (SourceIndex = -1) then + Exit; + end; + + // clip volume to valid range + if (Volume > 1.0) then + Volume := 1.0 + else if (Volume < 0) then + Volume := 0; + + if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then + begin + Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume'); + end; +end; + + +{ TAudioInput_Bass } + +function TAudioInput_Bass.GetName: String; +begin + result := 'BASS_Input'; +end; + +function TAudioInput_Bass.EnumDevices(): boolean; +var + Descr: PChar; + SourceName: PChar; + Flags: integer; + BassDeviceID: integer; + BassDevice: TBassInputDevice; + DeviceIndex: integer; + DeviceInfo: BASS_DEVICEINFO; + SourceIndex: integer; + RecordInfo: BASS_RECORDINFO; + SelectedSourceIndex: integer; +begin + result := false; + + DeviceIndex := 0; + BassDeviceID := 0; + SetLength(AudioInputProcessor.DeviceList, 0); + + // checks for recording devices and puts them into an array + while true do + begin + if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then + break; + + // try to initialize the device + if not BASS_RecordInit(BassDeviceID) then + begin + Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']', + 'TAudioInput_Bass.InitializeRecord'); + end + else + begin + SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1); + + // TODO: free object on termination + BassDevice := TBassInputDevice.Create(); + AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice; + + Descr := DeviceInfo.name; + + BassDevice.BassDeviceID := BassDeviceID; + BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex); + + // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX) + FillChar(RecordInfo, SizeOf(RecordInfo), 0); + // retrieve recording device info + BASS_RecordGetInfo(RecordInfo); + + // check if BASS has capture-freq. info + if (RecordInfo.freq > 0) then + begin + // use current input sample rate (available only on Windows Vista and OSX). + // Recording at this rate will give the best quality and performance, as no resampling is required. + // FIXME: does BASS use LSB/MSB or system integer values for 16bit? + BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16) + end + else + begin + // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats) + // but it doesn't fail if we use stereo input on a mono device + // -> use stereo by default + BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16) + end; + + // get info if multiple input-sources can be selected at once + BassDevice.SingleIn := RecordInfo.singlein; + + // init list for capture buffers per channel + SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels); + + BassDevice.MicSource := -1; + BassDevice.SourceRestore := -1; + + // add a virtual default source (will not change mixer-settings) + SetLength(BassDevice.Source, 1); + BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME; + + // add real input sources + SourceIndex := 1; + + // process each input + while true do + begin + SourceName := BASS_RecordGetInputName(SourceIndex-1); + + {$IFDEF DARWIN} + // Under MacOSX the SingStar Mics have an empty InputName. + // So, we have to add a hard coded Workaround for this problem + // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem? + // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe + // BASS is not able to detect any mic-sources (the default source will work then). + // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case + // we could use this value to check if the device exists. + // Please check that, eddie. + // If it returns false, then the source is not detected and it does not make sense to add a second + // fake device here. + // What about BASS_RecordGetInput()? Does it return a value <> -1? + // - Does it even work at all with this fake source-index, now that input switching works? + // This info was not used before (sources were never switched), so it did not matter what source-index was used. + // But now BASS_RecordSetInput() will probably fail. + if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then + SourceName := 'Microphone' + {$ENDIF} + + if (SourceName = nil) then + break; + + SetLength(BassDevice.Source, Length(BassDevice.Source)+1); + BassDevice.Source[SourceIndex].Name := SourceName; + + // get input-source info + Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^); + if (Flags <> -1) then + begin + // is the current source a mic-source? + if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then + BassDevice.MicSource := SourceIndex; + end; + + Inc(SourceIndex); + end; + + // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called. + // Maybe because the sound-device was not released properly? + BASS_RecordFree; + + Inc(DeviceIndex); + end; + + Inc(BassDeviceID); + end; + + result := true; +end; + +function TAudioInput_Bass.InitializeRecord(): boolean; +begin + BassCore := TAudioCore_Bass.GetInstance(); + Result := EnumDevices(); +end; + +function TAudioInput_Bass.FinalizeRecord(): boolean; +begin + CaptureStop; + Result := inherited FinalizeRecord; +end; + + +initialization + MediaManager.Add(TAudioInput_Bass.Create); + +end. diff --git a/src/base/UAudioInput_Portaudio.pas b/src/base/UAudioInput_Portaudio.pas new file mode 100644 index 00000000..9a1c3e99 --- /dev/null +++ b/src/base/UAudioInput_Portaudio.pas @@ -0,0 +1,474 @@ +unit UAudioInput_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I ../switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + portaudio, + UAudioCore_Portaudio, + URecord, + UIni, + ULog, + UMain; + +type + TAudioInput_Portaudio = class(TAudioInputBase) + private + AudioCore: TAudioCore_Portaudio; + function EnumDevices(): boolean; + public + function GetName: String; override; + function InitializeRecord: boolean; override; + function FinalizeRecord: boolean; override; + end; + + TPortaudioInputDevice = class(TAudioInputDevice) + private + RecordStream: PPaStream; + {$IFDEF UsePortmixer} + Mixer: PPxMixer; + {$ENDIF} + PaDeviceIndex: TPaDeviceIndex; + public + function Open(): boolean; + function Close(): boolean; + function Start(): boolean; override; + function Stop(): boolean; override; + + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + + +{ TPortaudioInputDevice } + +function TPortaudioInputDevice.Open(): boolean; +var + Error: TPaError; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; + SourceIndex: integer; +begin + Result := false; + + // get input latency info + deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); + + // set input stream parameters + with inputParams do + begin + device := PaDeviceIndex; + channelCount := AudioFormat.Channels; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + //Log.LogStatus(deviceInfo^.name, 'Portaudio'); + //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(RecordStream, @inputParams, nil, + AudioFormat.SampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(Self)); + if(Error <> paNoError) then + begin + Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); + Exit; + end; + + {$IFDEF UsePortmixer} + // open default mixer + Mixer := Px_OpenMixer(RecordStream, 0); + if (Mixer = nil) then + begin + Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); + end + else + begin + // save current source selection and select new source + SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; + if (SourceIndex = -1) then + begin + // nothing to do if default source is used + SourceRestore := -1; + end + else + begin + // store current source-index and select new source + SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case + Px_SetCurrentInputSource(Mixer, SourceIndex); + end; + end; + {$ENDIF} + + Result := true; +end; + +function TPortaudioInputDevice.Start(): boolean; +var + Error: TPaError; +begin + Result := false; + + // recording already started -> stop first + if (RecordStream <> nil) then + Stop(); + + // TODO: Do not open the device here (takes too much time). + if (not Open()) then + Exit; + + // start capture + Error := Pa_StartStream(RecordStream); + if(Error <> paNoError) then + begin + Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start'); + Close(); + RecordStream := nil; + Exit; + end; + + Result := true; +end; + +function TPortaudioInputDevice.Stop(): boolean; +var + Error: TPaError; +begin + Result := false; + + if (RecordStream = nil) then + Exit; + + // Note: do NOT call Pa_StopStream here! + // It gets stuck on devices with non-working callback as Pa_StopStream + // waits until all buffers have been handled (which never occurs in that case). + Error := Pa_AbortStream(RecordStream); + if (Error <> paNoError) then + begin + Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop'); + end; + + Result := Close(); +end; + +function TPortaudioInputDevice.Close(): boolean; +var + Error: TPaError; +begin + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + begin + // restore source selection + if (SourceRestore >= 0) then + begin + Px_SetCurrentInputSource(Mixer, SourceRestore); + end; + + // close mixer + Px_CloseMixer(Mixer); + Mixer := nil; + end; + {$ENDIF} + + Error := Pa_CloseStream(RecordStream); + if (Error <> paNoError) then + begin + Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close'); + Result := false; + end + else + begin + Result := true; + end; + + RecordStream := nil; +end; + +function TPortaudioInputDevice.GetVolume(): single; +begin + Result := 0; + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + Result := Px_GetInputVolume(Mixer); + {$ENDIF} +end; + +procedure TPortaudioInputDevice.SetVolume(Volume: single); +begin + {$IFDEF UsePortmixer} + if (Mixer <> nil) then + begin + // clip to valid range + if (Volume > 1.0) then + Volume := 1.0 + else if (Volume < 0) then + Volume := 0; + Px_SetInputVolume(Mixer, Volume); + end; + {$ENDIF} +end; + + +{ TAudioInput_Portaudio } + +function TAudioInput_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudioInput_Portaudio.EnumDevices(): boolean; +var + i: integer; + paApiIndex: TPaHostApiIndex; + paApiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + channelCnt: integer; + SC: integer; // soundcard + err: TPaError; + errMsg: string; + paDevice: TPortaudioInputDevice; + inputParams: TPaStreamParameters; + stream: PPaStream; + streamInfo: PPaStreamInfo; + sampleRate: double; + latency: TPaTime; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + sourceCnt: integer; + sourceIndex: integer; + sourceName: string; + {$ENDIF} + cbPolls: integer; + cbWorks: boolean; +begin + Result := false; + + // choose the best available Audio-API + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices'); + Exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount); + for i:= 0 to High(AudioInputProcessor.DeviceList) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + channelCnt := deviceInfo^.maxInputChannels; + + // current device is no input device -> skip + if (channelCnt <= 0) then + continue; + + // portaudio returns a channel-count of 128 for some devices + // (e.g. the "default"-device), so we have to detect those + // fantasy channel counts. + if (channelCnt > 8) then + channelCnt := 2; + + paDevice := TPortaudioInputDevice.Create(); + AudioInputProcessor.DeviceList[SC] := paDevice; + + // retrieve device-name + deviceName := deviceInfo^.name; + paDevice.Name := deviceName; + paDevice.PaDeviceIndex := deviceIndex; + + sampleRate := deviceInfo^.defaultSampleRate; + + // on vista and xp the defaultLowInputLatency may be set to 0 but it works. + // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) + latency := deviceInfo^.defaultLowInputLatency; + + // setup desired input parameters + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + with inputParams do + begin + device := deviceIndex; + channelCount := channelCnt; + sampleFormat := paInt16; + suggestedLatency := latency; + hostApiSpecificStreamInfo := nil; + end; + + // check souncard and adjust sample-rate + if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then + begin + // ignore device if it does not work + Log.LogError('Device "'+paDevice.Name+'" does not work', + 'TAudioInput_Portaudio.EnumDevices'); + paDevice.Free(); + continue; + end; + + // open device for further info + err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); + if(err <> paNoError) then + begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', + 'TAudioInput_Portaudio.EnumDevices'); + paDevice.Free(); + continue; + end; + + // adjust sample-rate (might be changed by portaudio) + streamInfo := Pa_GetStreamInfo(stream); + if (streamInfo <> nil) then + begin + if (sampleRate <> streamInfo^.sampleRate) then + begin + Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + + ' to ' + FloatToStr(streamInfo^.sampleRate), + 'TAudioInput_Portaudio.InitializeRecord'); + sampleRate := streamInfo^.sampleRate; + end; + end; + + // create audio-format info and resize capture-buffer array + paDevice.AudioFormat := TAudioFormatInfo.Create( + channelCnt, + sampleRate, + asfS16 + ); + SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); + + Log.LogStatus('InputDevice "'+paDevice.Name+'"@' + + IntToStr(paDevice.AudioFormat.Channels)+'x'+ + FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ + FloatTostr(inputParams.suggestedLatency)+'sec)' , + 'Portaudio.EnumDevices'); + + // portaudio does not provide a source-type check + paDevice.MicSource := -1; + paDevice.SourceRestore := -1; + + // add a virtual default source (will not change mixer-settings) + SetLength(paDevice.Source, 1); + paDevice.Source[0].Name := DEFAULT_SOURCE_NAME; + + {$IFDEF UsePortmixer} + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + sourceCnt := Px_GetNumInputSources(mixer); + SetLength(paDevice.Source, sourceCnt+1); + + // get input names + for sourceIndex := 1 to sourceCnt do + begin + sourceName := Px_GetInputSourceName(mixer, sourceIndex-1); + paDevice.Source[sourceIndex].Name := sourceName; + end; + + Px_CloseMixer(mixer); + {$ENDIF} + + // close test-stream + Pa_CloseStream(stream); + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(AudioInputProcessor.DeviceList, SC); + + Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio'); + + Result := true; +end; + +function TAudioInput_Portaudio.InitializeRecord(): boolean; +var + err: TPaError; +begin + AudioCore := TAudioCore_Portaudio.GetInstance(); + + // initialize portaudio + err := Pa_Initialize(); + if(err <> paNoError) then + begin + Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); + Result := false; + Exit; + end; + + Result := EnumDevices(); +end; + +function TAudioInput_Portaudio.FinalizeRecord: boolean; +begin + CaptureStop; + Pa_Terminate(); + Result := inherited FinalizeRecord(); +end; + +{* + * Portaudio input capture callback. + *} +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice); + result := paContinue; +end; + +{* + * Portaudio test capture callback. + *} +function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; +begin + // this callback is called only once + result := paAbort; +end; + + +initialization + MediaManager.add(TAudioInput_Portaudio.Create); + +end. diff --git a/src/base/UAudioPlaybackBase.pas b/src/base/UAudioPlaybackBase.pas new file mode 100644 index 00000000..2337d43f --- /dev/null +++ b/src/base/UAudioPlaybackBase.pas @@ -0,0 +1,292 @@ +unit UAudioPlaybackBase; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic; + +type + TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback) + protected + OutputDeviceList: TAudioOutputDeviceList; + MusicStream: TAudioPlaybackStream; + function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract; + procedure ClearOutputDeviceList(); + function GetLatency(): double; virtual; abstract; + + // open sound or music stream (used by Open() and OpenSound()) + function OpenStream(const Filename: string): TAudioPlaybackStream; + function OpenDecodeStream(const Filename: string): TAudioDecodeStream; + public + function GetName: string; virtual; abstract; + + function Open(const Filename: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + procedure FadeIn(Time: real; TargetVolume: single); + + procedure SetSyncSource(SyncSource: TSyncSource); + + procedure SetPosition(Time: real); + function GetPosition: real; + + function InitializePlayback: boolean; virtual; abstract; + function FinalizePlayback: boolean; virtual; + + //function SetOutputDevice(Device: TAudioOutputDevice): boolean; + function GetOutputDeviceList(): TAudioOutputDeviceList; + + procedure SetAppVolume(Volume: single); virtual; abstract; + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + + procedure Rewind; + function Finished: boolean; + function Length: real; + + // Sounds + function OpenSound(const Filename: string): TAudioPlaybackStream; + procedure PlaySound(Stream: TAudioPlaybackStream); + procedure StopSound(Stream: TAudioPlaybackStream); + + // Equalizer + procedure GetFFTData(var Data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var Data: TPCMData): Cardinal; + + function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract; + end; + + +implementation + +uses + ULog, + SysUtils; + +{ TAudioPlaybackBase } + +function TAudioPlaybackBase.FinalizePlayback: boolean; +begin + FreeAndNil(MusicStream); + ClearOutputDeviceList(); + Result := true; +end; + +function TAudioPlaybackBase.Open(const Filename: string): boolean; +begin + // free old MusicStream + MusicStream.Free; + + MusicStream := OpenStream(Filename); + if not assigned(MusicStream) then + begin + Result := false; + Exit; + end; + + //MusicStream.AddSoundEffect(TVoiceRemoval.Create()); + + Result := true; +end; + +procedure TAudioPlaybackBase.Close; +begin + FreeAndNil(MusicStream); +end; + +function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream; +var + i: integer; +begin + for i := 0 to AudioDecoders.Count-1 do + begin + Result := IAudioDecoder(AudioDecoders[i]).Open(Filename); + if (assigned(Result)) then + begin + Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() + + ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream'); + Exit; + end; + end; + Result := nil; +end; + +procedure OnClosePlaybackStream(Stream: TAudioProcessingStream); +var + PlaybackStream: TAudioPlaybackStream; + SourceStream: TAudioSourceStream; +begin + PlaybackStream := TAudioPlaybackStream(Stream); + SourceStream := PlaybackStream.GetSourceStream(); + SourceStream.Free; +end; + +function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream; +var + PlaybackStream: TAudioPlaybackStream; + DecodeStream: TAudioDecodeStream; +begin + Result := nil; + + //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); + + DecodeStream := OpenDecodeStream(Filename); + if (not assigned(DecodeStream)) then + begin + Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); + Exit; + end; + + // create a matching playback-stream for the decoder + PlaybackStream := CreatePlaybackStream(); + if (not PlaybackStream.Open(DecodeStream)) then + begin + FreeAndNil(PlaybackStream); + FreeAndNil(DecodeStream); + Exit; + end; + + PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream); + + Result := PlaybackStream; +end; + +procedure TAudioPlaybackBase.Play; +begin + if assigned(MusicStream) then + MusicStream.Play(); +end; + +procedure TAudioPlaybackBase.Pause; +begin + if assigned(MusicStream) then + MusicStream.Pause(); +end; + +procedure TAudioPlaybackBase.Stop; +begin + if assigned(MusicStream) then + MusicStream.Stop(); +end; + +function TAudioPlaybackBase.Length: real; +begin + if assigned(MusicStream) then + Result := MusicStream.Length + else + Result := 0; +end; + +function TAudioPlaybackBase.GetPosition: real; +begin + if assigned(MusicStream) then + Result := MusicStream.Position + else + Result := 0; +end; + +procedure TAudioPlaybackBase.SetPosition(Time: real); +begin + if assigned(MusicStream) then + MusicStream.Position := Time; +end; + +procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource); +begin + if assigned(MusicStream) then + MusicStream.SetSyncSource(SyncSource); +end; + +procedure TAudioPlaybackBase.Rewind; +begin + SetPosition(0); +end; + +function TAudioPlaybackBase.Finished: boolean; +begin + if assigned(MusicStream) then + Result := (MusicStream.Status = ssStopped) + else + Result := true; +end; + +procedure TAudioPlaybackBase.SetVolume(Volume: single); +begin + if assigned(MusicStream) then + MusicStream.Volume := Volume; +end; + +procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single); +begin + if assigned(MusicStream) then + MusicStream.FadeIn(Time, TargetVolume); +end; + +procedure TAudioPlaybackBase.SetLoop(Enabled: boolean); +begin + if assigned(MusicStream) then + MusicStream.Loop := Enabled; +end; + +// Equalizer +procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData); +begin + if assigned(MusicStream) then + MusicStream.GetFFTData(data); +end; + +{* + * Copies interleaved PCM SInt16 stereo samples into data. + * Returns the number of frames + *} +function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal; +begin + if assigned(MusicStream) then + Result := MusicStream.GetPCMData(data) + else + Result := 0; +end; + +function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream; +begin + Result := OpenStream(Filename); +end; + +procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Play(); +end; + +procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Stop(); +end; + +procedure TAudioPlaybackBase.ClearOutputDeviceList(); +var + DeviceIndex: integer; +begin + for DeviceIndex := 0 to High(OutputDeviceList) do + OutputDeviceList[DeviceIndex].Free(); + SetLength(OutputDeviceList, 0); +end; + +function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList; +begin + Result := OutputDeviceList; +end; + +end. diff --git a/src/base/UAudioPlayback_Bass.pas b/src/base/UAudioPlayback_Bass.pas new file mode 100644 index 00000000..41a91173 --- /dev/null +++ b/src/base/UAudioPlayback_Bass.pas @@ -0,0 +1,731 @@ +unit UAudioPlayback_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + Classes, + SysUtils, + Math, + UIni, + UMain, + UMusic, + UAudioPlaybackBase, + UAudioCore_Bass, + ULog, + sdl, + bass; + +type + PHDSP = ^HDSP; + +type + TBassPlaybackStream = class(TAudioPlaybackStream) + private + Handle: HSTREAM; + NeedsRewind: boolean; + PausedSeek: boolean; // true if a seek was performed in pause state + + procedure Reset(); + function IsEOF(): boolean; + protected + function GetLatency(): double; override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + public + constructor Create(); + destructor Destroy(); override; + + function Open(SourceStream: TAudioSourceStream): boolean; override; + procedure Close(); override; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure FadeIn(Time: real; TargetVolume: single); override; + + procedure AddSoundEffect(Effect: TSoundEffect); override; + procedure RemoveSoundEffect(Effect: TSoundEffect); override; + + procedure GetFFTData(var Data: TFFTData); override; + function GetPCMData(var Data: TPCMData): Cardinal; override; + + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + property EOF: boolean READ IsEOF; + end; + +const + MAX_VOICE_DELAY = 0.020; // 20ms + +type + TBassVoiceStream = class(TAudioVoiceStream) + private + Handle: HSTREAM; + public + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; + procedure Close(); override; + + procedure WriteData(Buffer: PChar; BufferSize: integer); override; + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + end; + +type + TAudioPlayback_Bass = class(TAudioPlaybackBase) + private + function EnumDevices(): boolean; + protected + function GetLatency(): double; override; + function CreatePlaybackStream(): TAudioPlaybackStream; override; + public + function GetName: String; override; + function InitializePlayback(): boolean; override; + function FinalizePlayback: boolean; override; + procedure SetAppVolume(Volume: single); override; + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; + end; + + TBassOutputDevice = class(TAudioOutputDevice) + private + BassDeviceID: DWORD; // DeviceID used by BASS + end; + +var + BassCore: TAudioCore_Bass; + + +{ TBassPlaybackStream } + +function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; +{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +var + PlaybackStream: TBassPlaybackStream; + BytesRead: integer; +begin + PlaybackStream := TBassPlaybackStream(user); + if (not assigned (PlaybackStream)) then + begin + Result := BASS_STREAMPROC_END; + Exit; + end; + + BytesRead := PlaybackStream.ReadData(buffer, length); + // check for errors + if (BytesRead < 0) then + Result := BASS_STREAMPROC_END + // check for EOF + else if (PlaybackStream.EOF) then + Result := BytesRead or BASS_STREAMPROC_END + // no error/EOF + else + Result := BytesRead; +end; + +function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + AdjustedSize: integer; + RequestedSourceSize, SourceSize: integer; + SkipCount: integer; + SourceFormatInfo: TAudioFormatInfo; + FrameSize: integer; + PadFrame: PChar; + //Info: BASS_INFO; + //Latency: double; +begin + Result := -1; + + if (not assigned(SourceStream)) then + Exit; + + // sanity check + if (BufferSize = 0) then + begin + Result := 0; + Exit; + end; + + SourceFormatInfo := SourceStream.GetAudioFormatInfo(); + FrameSize := SourceFormatInfo.FrameSize; + + // check how much data to fetch to be in synch + AdjustedSize := Synchronize(BufferSize, SourceFormatInfo); + + // skip data if we are too far behind + SkipCount := AdjustedSize - BufferSize; + while (SkipCount > 0) do + begin + RequestedSourceSize := Min(SkipCount, BufferSize); + SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); + // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData() + if (SourceSize <= 0) then + break; + Dec(SkipCount, SourceSize); + end; + + // get source data (e.g. from a decoder) + RequestedSourceSize := Min(AdjustedSize, BufferSize); + SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); + if (SourceSize < 0) then + Exit; + + // set preliminary result + Result := SourceSize; + + // if we are to far ahead, fill output-buffer with last frame of source data + // Note that AdjustedSize is used instead of SourceSize as the SourceSize might + // be less than expected because of errors etc. + if (AdjustedSize < BufferSize) then + begin + // use either the last frame for padding or fill with zero + if (SourceSize >= FrameSize) then + PadFrame := @Buffer[SourceSize-FrameSize] + else + PadFrame := nil; + + FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize, + PadFrame, FrameSize); + Result := BufferSize; + end; +end; + +constructor TBassPlaybackStream.Create(); +begin + inherited; + Reset(); +end; + +destructor TBassPlaybackStream.Destroy(); +begin + Close(); + inherited; +end; + +function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; +var + FormatInfo: TAudioFormatInfo; + FormatFlags: DWORD; +begin + Result := false; + + // close previous stream and reset state + Reset(); + + // sanity check if stream is valid + if not assigned(SourceStream) then + Exit; + + Self.SourceStream := SourceStream; + FormatInfo := SourceStream.GetAudioFormatInfo(); + if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then + begin + Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open'); + Exit; + end; + + // create matching playback stream + Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags, + @PlaybackStreamHandler, Self); + if (Handle = 0) then + begin + Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()), + 'TBassPlaybackStream.Open'); + Exit; + end; + + Result := true; +end; + +procedure TBassPlaybackStream.Close(); +begin + // stop and free stream + if (Handle <> 0) then + begin + Bass_StreamFree(Handle); + Handle := 0; + end; + + // Note: PerformOnClose must be called before SourceStream is invalidated + PerformOnClose(); + // unset source-stream + SourceStream := nil; +end; + +procedure TBassPlaybackStream.Reset(); +begin + Close(); + NeedsRewind := false; + PausedSeek := false; +end; + +procedure TBassPlaybackStream.Play(); +var + NeedsFlush: boolean; +begin + if (not assigned(SourceStream)) then + Exit; + + NeedsFlush := true; + + if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then + begin + // only paused (and not seeked while paused) streams are not flushed + if (not PausedSeek) then + NeedsFlush := false; + // paused streams do not need a rewind + NeedsRewind := false; + end; + + // rewind if necessary. Cases that require no rewind are: + // - stream was created and never played + // - stream was paused and is resumed now + // - stream was stopped and set to a new position already + if (NeedsRewind) then + SourceStream.Position := 0; + + NeedsRewind := true; + PausedSeek := false; + + // start playing and flush buffers on rewind + BASS_ChannelPlay(Handle, NeedsFlush); +end; + +procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single); +begin + // start stream + Play(); + // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime + BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000)); +end; + +procedure TBassPlaybackStream.Pause(); +begin + BASS_ChannelPause(Handle); +end; + +procedure TBassPlaybackStream.Stop(); +begin + BASS_ChannelStop(Handle); +end; + +function TBassPlaybackStream.IsEOF(): boolean; +begin + if (assigned(SourceStream)) then + Result := SourceStream.EOF + else + Result := true; +end; + +function TBassPlaybackStream.GetLatency(): double; +begin + // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)? + //if (BASS_GetInfo(Info)) then + // Latency := Info.latency / 1000 + //else + // Latency := 0; + Result := 0; +end; + +function TBassPlaybackStream.GetVolume(): single; +var + lVolume: single; +begin + if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then + begin + Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(), + 'TBassPlaybackStream.GetVolume'); + Result := 0; + Exit; + end; + Result := Round(lVolume); +end; + +procedure TBassPlaybackStream.SetVolume(Volume: single); +begin + // clamp volume + if Volume < 0 then + Volume := 0; + if Volume > 1.0 then + Volume := 1.0; + // set volume + BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume); +end; + +function TBassPlaybackStream.GetPosition: real; +var + BufferPosByte: QWORD; + BufferPosSec: double; +begin + if assigned(SourceStream) then + begin + BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE); + BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte); + // decrease the decoding position by the amount buffered (and hence not played) + // in the BASS playback stream. + Result := SourceStream.Position - BufferPosSec; + end + else + begin + Result := -1; + end; +end; + +procedure TBassPlaybackStream.SetPosition(Time: real); +var + ChannelState: DWORD; +begin + if assigned(SourceStream) then + begin + ChannelState := BASS_ChannelIsActive(Handle); + if (ChannelState = BASS_ACTIVE_STOPPED) then + begin + // if the stream is stopped, do not rewind when the stream is played next time + NeedsRewind := false + end + else if (ChannelState = BASS_ACTIVE_PAUSED) then + begin + // buffers must be flushed if in paused state but there is no + // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play(). + PausedSeek := true; + end; + + // set new position + SourceStream.Position := Time; + end; +end; + +function TBassPlaybackStream.GetLength(): real; +begin + if assigned(SourceStream) then + Result := SourceStream.Length + else + Result := -1; +end; + +function TBassPlaybackStream.GetStatus(): TStreamStatus; +var + State: DWORD; +begin + State := BASS_ChannelIsActive(Handle); + case State of + BASS_ACTIVE_PLAYING, + BASS_ACTIVE_STALLED: + Result := ssPlaying; + BASS_ACTIVE_PAUSED: + Result := ssPaused; + BASS_ACTIVE_STOPPED: + Result := ssStopped; + else + begin + Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus'); + Result := ssStopped; + end; + end; +end; + +function TBassPlaybackStream.GetLoop(): boolean; +begin + if assigned(SourceStream) then + Result := SourceStream.Loop + else + Result := false; +end; + +procedure TBassPlaybackStream.SetLoop(Enabled: boolean); +begin + if assigned(SourceStream) then + SourceStream.Loop := Enabled; +end; + +procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); +{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} +var + Effect: TSoundEffect; +begin + Effect := TSoundEffect(user); + if assigned(Effect) then + Effect.Callback(buffer, length); +end; + +procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect); +var + DspHandle: HDSP; +begin + if assigned(Effect.engineData) then + begin + Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect'); + Exit; + end; + + DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0); + if (DspHandle = 0) then + begin + Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect'); + Exit; + end; + + GetMem(Effect.EngineData, SizeOf(HDSP)); + PHDSP(Effect.EngineData)^ := DspHandle; +end; + +procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); +begin + if not assigned(Effect.EngineData) then + begin + Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect'); + Exit; + end; + + if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then + begin + Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect'); + Exit; + end; + + FreeMem(Effect.EngineData); + Effect.EngineData := nil; +end; + +procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData); +begin + // get FFT channel data (Mono, FFT512 -> 256 values) + BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512); +end; + +{* + * Copies interleaved PCM SInt16 stereo samples into data. + * Returns the number of frames + *} +function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; +var + Info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + Result := 0; + + FillChar(Data, SizeOf(TPCMData), 0); + + // no support for non-stereo files at the moment + BASS_ChannelGetInfo(Handle, Info); + if (Info.chans <> 2) then + Exit; + + nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData)); + if(nBytes <= 0) then + Result := 0 + else + Result := nBytes div SizeOf(TPCMStereoSample); +end; + +function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + if assigned(SourceStream) then + Result := SourceStream.GetAudioFormatInfo() + else + Result := nil; +end; + + +{ TBassVoiceStream } + +function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +var + Flags: DWORD; +begin + Result := false; + + Close(); + + if (not inherited Open(ChannelMap, FormatInfo)) then + Exit; + + // get channel flags + BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags); + + (* + // distribute the mics equally to both speakers + if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then + Flags := Flags or BASS_SPEAKER_FRONTLEFT; + if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then + Flags := Flags or BASS_SPEAKER_FRONTRIGHT; + *) + + // create the channel + Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil); + + // start the channel + BASS_ChannelPlay(Handle, true); + + Result := true; +end; + +procedure TBassVoiceStream.Close(); +begin + if (Handle <> 0) then + begin + BASS_ChannelStop(Handle); + BASS_StreamFree(Handle); + end; + inherited Close(); +end; + +procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +var QueueSize: DWORD; +begin + if ((Handle <> 0) and (BufferSize > 0)) then + begin + // query the queue size (normally 0) + QueueSize := BASS_StreamPutData(Handle, nil, 0); + // flush the buffer if the delay would be too high + if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then + BASS_ChannelPlay(Handle, true); + // send new data to playback buffer + BASS_StreamPutData(Handle, Buffer, BufferSize); + end; +end; + +// Note: we do not need the read-function for the BASS implementation +function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +begin + Result := -1; +end; + +function TBassVoiceStream.IsEOF(): boolean; +begin + Result := false; +end; + +function TBassVoiceStream.IsError(): boolean; +begin + Result := false; +end; + + +{ TAudioPlayback_Bass } + +function TAudioPlayback_Bass.GetName: String; +begin + Result := 'BASS_Playback'; +end; + +function TAudioPlayback_Bass.EnumDevices(): boolean; +var + BassDeviceID: DWORD; + DeviceIndex: integer; + Device: TBassOutputDevice; + DeviceInfo: BASS_DEVICEINFO; +begin + Result := true; + + ClearOutputDeviceList(); + + // skip "no sound"-device (ID = 0) + BassDeviceID := 1; + + while (true) do + begin + // check for device + if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then + Break; + + // set device info + Device := TBassOutputDevice.Create(); + Device.Name := DeviceInfo.name; + Device.BassDeviceID := BassDeviceID; + + // add device to list + SetLength(OutputDeviceList, BassDeviceID); + OutputDeviceList[BassDeviceID-1] := Device; + + Inc(BassDeviceID); + end; +end; + +function TAudioPlayback_Bass.InitializePlayback(): boolean; +begin + result := false; + + BassCore := TAudioCore_Bass.GetInstance(); + + EnumDevices(); + + //Log.BenchmarkStart(4); + //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + // TODO: use BASS_DEVICE_LATENCY to determine the latency + if not BASS_Init(-1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback'); + Exit; + end; + + //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); + + // config playing buffer + //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); + //BASS_SetConfig(BASS_CONFIG_BUFFER, 100); + + result := true; +end; + +function TAudioPlayback_Bass.FinalizePlayback(): boolean; +begin + Close; + BASS_Free; + inherited FinalizePlayback(); + Result := true; +end; + +function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream; +begin + Result := TBassPlaybackStream.Create(); +end; + +procedure TAudioPlayback_Bass.SetAppVolume(Volume: single); +begin + // set volume for this application (ranges from 0..10000 since BASS 2.4) + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000)); +end; + +function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +var + VoiceStream: TAudioVoiceStream; +begin + Result := nil; + + VoiceStream := TBassVoiceStream.Create(); + if (not VoiceStream.Open(ChannelMap, FormatInfo)) then + begin + VoiceStream.Free; + Exit; + end; + + Result := VoiceStream; +end; + +function TAudioPlayback_Bass.GetLatency(): double; +begin + Result := 0; +end; + + +initialization + MediaManager.Add(TAudioPlayback_Bass.Create); + +end. diff --git a/src/base/UAudioPlayback_Portaudio.pas b/src/base/UAudioPlayback_Portaudio.pas new file mode 100644 index 00000000..c3717ba6 --- /dev/null +++ b/src/base/UAudioPlayback_Portaudio.pas @@ -0,0 +1,361 @@ +unit UAudioPlayback_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + portaudio, + UAudioCore_Portaudio, + UAudioPlayback_SoftMixer, + ULog, + UIni, + UMain; + +type + TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer) + private + paStream: PPaStream; + AudioCore: TAudioCore_Portaudio; + Latency: double; + function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + function GetLatency(): double; override; + public + function GetName: String; override; + end; + + TPortaudioOutputDevice = class(TAudioOutputDevice) + private + PaDeviceIndex: TPaDeviceIndex; + end; + + +{ TAudioPlayback_Portaudio } + +function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + Engine: TAudioPlayback_Portaudio; +begin + Engine := TAudioPlayback_Portaudio(userData); + // update latency + Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime; + // call superclass callback + Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize); + Result := paContinue; +end; + +function TAudioPlayback_Portaudio.GetName: String; +begin + Result := 'Portaudio_Playback'; +end; + +function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean; +var + DeviceInfo : PPaDeviceInfo; + SampleRate : double; + OutParams : TPaStreamParameters; + StreamInfo : PPaStreamInfo; + err : TPaError; +begin + Result := false; + + DeviceInfo := Pa_GetDeviceInfo(deviceIndex); + + Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); + + SampleRate := DeviceInfo^.defaultSampleRate; + + with OutParams do + begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := DeviceInfo^.defaultLowOutputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // check souncard and adjust sample-rate + if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then + begin + Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice'); + Exit; + end; + + // open output stream + err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate, + paFramesPerBufferUnspecified, + paNoFlag, @PortaudioAudioCallback, Self); + if(err <> paNoError) then + begin + Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice'); + paStream := nil; + Exit; + end; + + // get estimated latency (will be updated with real latency in the callback) + StreamInfo := Pa_GetStreamInfo(paStream); + if (StreamInfo <> nil) then + Latency := StreamInfo^.outputLatency + else + Latency := 0; + + FormatInfo := TAudioFormatInfo.Create( + OutParams.channelCount, + SampleRate, + asfS16 // FIXME: is paInt16 system-dependant or -independant? + ); + + Result := true; +end; + +function TAudioPlayback_Portaudio.EnumDevices(): boolean; +var + i: integer; + paApiIndex: TPaHostApiIndex; + paApiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + channelCnt: integer; + SC: integer; // soundcard + err: TPaError; + errMsg: string; + paDevice: TPortaudioOutputDevice; + outputParams: TPaStreamParameters; + stream: PPaStream; + streamInfo: PPaStreamInfo; + sampleRate: double; + latency: TPaTime; + cbPolls: integer; + cbWorks: boolean; +begin + Result := false; + +(* + // choose the best available Audio-API + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices'); + Exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + + SC := 0; + + // init array-size to max. output-devices count + SetLength(OutputDeviceList, paApiInfo^.deviceCount); + for i:= 0 to High(OutputDeviceList) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + channelCnt := deviceInfo^.maxOutputChannels; + + // current device is no output device -> skip + if (channelCnt <= 0) then + continue; + + // portaudio returns a channel-count of 128 for some devices + // (e.g. the "default"-device), so we have to detect those + // fantasy channel counts. + if (channelCnt > 8) then + channelCnt := 2; + + paDevice := TPortaudioOutputDevice.Create(); + OutputDeviceList[SC] := paDevice; + + // retrieve device-name + deviceName := deviceInfo^.name; + paDevice.Name := deviceName; + paDevice.PaDeviceIndex := deviceIndex; + + if (deviceInfo^.defaultSampleRate > 0) then + sampleRate := deviceInfo^.defaultSampleRate + else + sampleRate := 44100; + + // on vista and xp the defaultLowInputLatency may be set to 0 but it works. + // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) + latency := deviceInfo^.defaultLowInputLatency; + + // setup desired output parameters + // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might + // not be set correctly in OSS) + with outputParams do + begin + device := deviceIndex; + channelCount := channelCnt; + sampleFormat := paInt16; + suggestedLatency := latency; + hostApiSpecificStreamInfo := nil; + end; + + // check if mic-callback works (might not be called on some devices) + if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then + begin + // ignore device if callback did not work + Log.LogError('Device "'+paDevice.Name+'" does not respond', + 'TAudioPlayback_Portaudio.InitializeRecord'); + paDevice.Free(); + continue; + end; + + // open device for further info + err := Pa_OpenStream(stream, nil, @outputParams, sampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); + if(err <> paNoError) then + begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', + 'TAudioPlayback_Portaudio.InitializeRecord'); + paDevice.Free(); + continue; + end; + + // adjust sample-rate (might be changed by portaudio) + streamInfo := Pa_GetStreamInfo(stream); + if (streamInfo <> nil) then + begin + if (sampleRate <> streamInfo^.sampleRate) then + begin + Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + + ' to ' + FloatToStr(streamInfo^.sampleRate), + 'TAudioInput_Portaudio.InitializeRecord'); + sampleRate := streamInfo^.sampleRate; + end; + end; + + // create audio-format info and resize capture-buffer array + paDevice.AudioFormat := TAudioFormatInfo.Create( + channelCnt, + sampleRate, + asfS16 + ); + SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); + + Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' + + IntToStr(paDevice.AudioFormat.Channels)+'x'+ + FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ + FloatTostr(outputParams.suggestedLatency)+'sec)' , + 'TAudioInput_Portaudio.InitializeRecord'); + + // close test-stream + Pa_CloseStream(stream); + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(OutputDeviceList, SC); + + Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio'); +*) + + Result := true; +end; + +function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean; +var + paApiIndex : TPaHostApiIndex; + paApiInfo : PPaHostApiInfo; + paOutDevice : TPaDeviceIndex; + err: TPaError; +begin + Result := false; + + AudioCore := TAudioCore_Portaudio.GetInstance(); + + // initialize portaudio + err := Pa_Initialize(); + if(err <> paNoError) then + begin + Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); + Exit; + end; + + paApiIndex := AudioCore.GetPreferredApiIndex(); + if(paApiIndex = -1) then + begin + Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine'); + Exit; + end; + + EnumDevices(); + + paApiInfo := Pa_GetHostApiInfo(paApiIndex); + Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); + + paOutDevice := paApiInfo^.defaultOutputDevice; + if (not OpenDevice(paOutDevice)) then + begin + Exit; + end; + + Result := true; +end; + +function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean; +var + err: TPaError; +begin + Result := false; + + if (paStream = nil) then + Exit; + + err := Pa_StartStream(paStream); + if(err <> paNoError) then + begin + Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); + Exit; + end; + + Result := true; +end; + +procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine(); +begin + if (paStream <> nil) then + Pa_StopStream(paStream); +end; + +function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean; +begin + Pa_Terminate(); + Result := true; +end; + +function TAudioPlayback_Portaudio.GetLatency(): double; +begin + Result := Latency; +end; + + +initialization + MediaManager.Add(TAudioPlayback_Portaudio.Create); + +end. diff --git a/src/base/UAudioPlayback_SDL.pas b/src/base/UAudioPlayback_SDL.pas new file mode 100644 index 00000000..deef91e8 --- /dev/null +++ b/src/base/UAudioPlayback_SDL.pas @@ -0,0 +1,160 @@ +unit UAudioPlayback_SDL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + sdl, + UAudioPlayback_SoftMixer, + ULog, + UIni, + UMain; + +type + TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer) + private + Latency: double; + function EnumDevices(): boolean; + protected + function InitializeAudioPlaybackEngine(): boolean; override; + function StartAudioPlaybackEngine(): boolean; override; + procedure StopAudioPlaybackEngine(); override; + function FinalizeAudioPlaybackEngine(): boolean; override; + function GetLatency(): double; override; + public + function GetName: String; override; + procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; + end; + + +{ TAudioPlayback_SDL } + +procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; +var + Engine: TAudioPlayback_SDL; +begin + Engine := TAudioPlayback_SDL(userdata); + Engine.AudioCallback(stream, len); +end; + +function TAudioPlayback_SDL.GetName: String; +begin + Result := 'SDL_Playback'; +end; + +function TAudioPlayback_SDL.EnumDevices(): boolean; +begin + // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3) + ClearOutputDeviceList(); + SetLength(OutputDeviceList, 1); + OutputDeviceList[0] := TAudioOutputDevice.Create(); + OutputDeviceList[0].Name := '[SDL Default-Device]'; + Result := true; +end; + +function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean; +var + DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec; + SampleBufferSize: integer; +begin + Result := false; + + EnumDevices(); + + if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then + begin + Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + Exit; + end; + + SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex]; + if (SampleBufferSize <= 0) then + begin + // Automatic setting default + // FIXME: too much glitches with 1024 samples + SampleBufferSize := 2048; //1024; + end; + + FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0); + with DesiredAudioSpec do + begin + freq := 44100; + format := AUDIO_S16SYS; + channels := 2; + samples := SampleBufferSize; + callback := @SDLAudioCallback; + userdata := Self; + end; + + // Note: always use the "obtained" parameter, otherwise SDL might try to convert + // the samples itself if the desired format is not available. This might lead + // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz. + // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with + // its crappy (non working) converter resulting in a wrong (too high) pitch. + if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then + begin + Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + Exit; + end; + + FormatInfo := TAudioFormatInfo.Create( + ObtainedAudioSpec.channels, + ObtainedAudioSpec.freq, + asfS16 + ); + + // Note: SDL does not provide info of the internal buffer state. + // So we use the average buffer-size. + Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate; + + Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); + + Result := true; +end; + +function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean; +begin + SDL_PauseAudio(0); + Result := true; +end; + +procedure TAudioPlayback_SDL.StopAudioPlaybackEngine(); +begin + SDL_PauseAudio(1); +end; + +function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean; +begin + SDL_CloseAudio(); + SDL_QuitSubSystem(SDL_INIT_AUDIO); + Result := true; +end; + +function TAudioPlayback_SDL.GetLatency(): double; +begin + Result := Latency; +end; + +procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); +begin + SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME)); +end; + + +initialization + MediaManager.add(TAudioPlayback_SDL.Create); + +end. diff --git a/src/base/UAudioPlayback_SoftMixer.pas b/src/base/UAudioPlayback_SoftMixer.pas new file mode 100644 index 00000000..6ddae980 --- /dev/null +++ b/src/base/UAudioPlayback_SoftMixer.pas @@ -0,0 +1,1132 @@ +unit UAudioPlayback_SoftMixer; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + sdl, + URingBuffer, + UMusic, + UAudioPlaybackBase; + +type + TAudioPlayback_SoftMixer = class; + + TGenericPlaybackStream = class(TAudioPlaybackStream) + private + Engine: TAudioPlayback_SoftMixer; + + SampleBuffer: PChar; + SampleBufferSize: integer; + SampleBufferCount: integer; // number of available bytes in SampleBuffer + SampleBufferPos: cardinal; + + SourceBuffer: PChar; + SourceBufferSize: integer; + SourceBufferCount: integer; // number of available bytes in SourceBuffer + + Converter: TAudioConverter; + Status: TStreamStatus; + InternalLock: PSDL_Mutex; + SoundEffects: TList; + fVolume: single; + + FadeInStartTime, FadeInTime: cardinal; + FadeInStartVolume, FadeInTargetVolume: single; + + NeedsRewind: boolean; + + procedure Reset(); + + procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer); + function InitFormatConversion(): boolean; + procedure FlushBuffers(); + + procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + protected + function GetLatency(): double; override; + function GetStatus(): TStreamStatus; override; + function GetVolume(): single; override; + procedure SetVolume(Volume: single); override; + function GetLength(): real; override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + destructor Destroy(); override; + + function Open(SourceStream: TAudioSourceStream): boolean; override; + procedure Close(); override; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure FadeIn(Time: real; TargetVolume: single); override; + + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + function GetPCMData(var Data: TPCMData): Cardinal; override; + procedure GetFFTData(var Data: TFFTData); override; + + procedure AddSoundEffect(Effect: TSoundEffect); override; + procedure RemoveSoundEffect(Effect: TSoundEffect); override; + end; + + TAudioMixerStream = class + private + Engine: TAudioPlayback_SoftMixer; + + ActiveStreams: TList; + MixerBuffer: PChar; + InternalLock: PSDL_Mutex; + + AppVolume: single; + + procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF} + procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF} + + function GetVolume(): single; + procedure SetVolume(Volume: single); + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + destructor Destroy(); override; + procedure AddStream(Stream: TAudioPlaybackStream); + procedure RemoveStream(Stream: TAudioPlaybackStream); + function ReadData(Buffer: PChar; BufferSize: integer): integer; + + property Volume: single read GetVolume write SetVolume; + end; + + TAudioPlayback_SoftMixer = class(TAudioPlaybackBase) + private + MixerStream: TAudioMixerStream; + protected + FormatInfo: TAudioFormatInfo; + + function InitializeAudioPlaybackEngine(): boolean; virtual; abstract; + function StartAudioPlaybackEngine(): boolean; virtual; abstract; + procedure StopAudioPlaybackEngine(); virtual; abstract; + function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract; + procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} + + function CreatePlaybackStream(): TAudioPlaybackStream; override; + public + function GetName: String; override; abstract; + function InitializePlayback(): boolean; override; + function FinalizePlayback: boolean; override; + + procedure SetAppVolume(Volume: single); override; + + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; + + function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF} + function GetAudioFormatInfo(): TAudioFormatInfo; + + procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual; + end; + +type + TGenericVoiceStream = class(TAudioVoiceStream) + private + VoiceBuffer: TRingBuffer; + BufferLock: PSDL_Mutex; + PlaybackStream: TGenericPlaybackStream; + Engine: TAudioPlayback_SoftMixer; + public + constructor Create(Engine: TAudioPlayback_SoftMixer); + + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; + procedure Close(); override; + procedure WriteData(Buffer: PChar; BufferSize: integer); override; + function ReadData(Buffer: PChar; BufferSize: integer): integer; override; + function IsEOF(): boolean; override; + function IsError(): boolean; override; + end; + +const + SOURCE_BUFFER_FRAMES = 4096; + +const + MAX_VOICE_DELAY = 0.500; // 20ms + +implementation + +uses + Math, + ULog, + UIni, + UFFT, + UAudioConverter, + UMain; + +{ TAudioMixerStream } + +constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + + Self.Engine := Engine; + + ActiveStreams := TList.Create; + InternalLock := SDL_CreateMutex(); + AppVolume := 1.0; +end; + +destructor TAudioMixerStream.Destroy(); +begin + if assigned(MixerBuffer) then + Freemem(MixerBuffer); + ActiveStreams.Free; + SDL_DestroyMutex(InternalLock); + inherited; +end; + +procedure TAudioMixerStream.Lock(); +begin + SDL_mutexP(InternalLock); +end; + +procedure TAudioMixerStream.Unlock(); +begin + SDL_mutexV(InternalLock); +end; + +function TAudioMixerStream.GetVolume(): single; +begin + Lock(); + Result := AppVolume; + Unlock(); +end; + +procedure TAudioMixerStream.SetVolume(Volume: single); +begin + Lock(); + AppVolume := Volume; + Unlock(); +end; + +procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream); +begin + if not assigned(Stream) then + Exit; + + Lock(); + // check if stream is already in list to avoid duplicates + if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then + ActiveStreams.Add(Pointer(Stream)); + Unlock(); +end; + +(* + * Sets the entry of stream in the ActiveStreams-List to nil + * but does not remove it from the list (Count is not changed!). + * Otherwise iterations over the elements might fail due to a + * changed Count-property. + * Call ActiveStreams.Pack() to remove the nil-pointers + * or check for nil-pointers when accessing ActiveStreams. + *) +procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream); +var + Index: integer; +begin + Lock(); + Index := activeStreams.IndexOf(Pointer(Stream)); + if (Index <> -1) then + begin + // remove entry but do not decrease count-property + ActiveStreams[Index] := nil; + end; + Unlock(); +end; + +function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + i: integer; + Size: integer; + Stream: TGenericPlaybackStream; + NeedsPacking: boolean; +begin + Result := BufferSize; + + // zero target-buffer (silence) + FillChar(Buffer^, BufferSize, 0); + + // resize mixer-buffer if necessary + ReallocMem(MixerBuffer, BufferSize); + if not assigned(MixerBuffer) then + Exit; + + Lock(); + + NeedsPacking := false; + + // mix streams to one stream + for i := 0 to ActiveStreams.Count-1 do + begin + if (ActiveStreams[i] = nil) then + begin + NeedsPacking := true; + continue; + end; + + Stream := TGenericPlaybackStream(ActiveStreams[i]); + // fetch data from current stream + Size := Stream.ReadData(MixerBuffer, BufferSize); + if (Size > 0) then + begin + // mix stream-data with mixer-buffer + // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking + Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume); + end; + end; + + // remove nil-pointers from list + if (NeedsPacking) then + begin + ActiveStreams.Pack(); + end; + + Unlock(); +end; + + +{ TGenericPlaybackStream } + +constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + Self.Engine := Engine; + InternalLock := SDL_CreateMutex(); + SoundEffects := TList.Create; + Status := ssStopped; + Reset(); +end; + +destructor TGenericPlaybackStream.Destroy(); +begin + Close(); + SDL_DestroyMutex(InternalLock); + FreeAndNil(SoundEffects); + inherited; +end; + +procedure TGenericPlaybackStream.Reset(); +begin + SourceStream := nil; + + FreeAndNil(Converter); + + FreeMem(SampleBuffer); + SampleBuffer := nil; + SampleBufferPos := 0; + SampleBufferSize := 0; + SampleBufferCount := 0; + + FreeMem(SourceBuffer); + SourceBuffer := nil; + SourceBufferSize := 0; + SourceBufferCount := 0; + + NeedsRewind := false; + + fVolume := 0; + SoundEffects.Clear; + FadeInTime := 0; +end; + +function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; +begin + Result := false; + + Close(); + + if (not assigned(SourceStream)) then + Exit; + Self.SourceStream := SourceStream; + + if (not InitFormatConversion()) then + begin + // reset decode-stream so it will not be freed on destruction + Self.SourceStream := nil; + Exit; + end; + + SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize; + GetMem(SourceBuffer, SourceBufferSize); + fVolume := 1.0; + + Result := true; +end; + +procedure TGenericPlaybackStream.Close(); +begin + // stop audio-callback on this stream + Stop(); + + // Note: PerformOnClose must be called before SourceStream is invalidated + PerformOnClose(); + // and free data + Reset(); +end; + +procedure TGenericPlaybackStream.LockSampleBuffer(); +begin + SDL_mutexP(InternalLock); +end; + +procedure TGenericPlaybackStream.UnlockSampleBuffer(); +begin + SDL_mutexV(InternalLock); +end; + +function TGenericPlaybackStream.InitFormatConversion(): boolean; +var + SrcFormatInfo: TAudioFormatInfo; + DstFormatInfo: TAudioFormatInfo; +begin + Result := false; + + SrcFormatInfo := SourceStream.GetAudioFormatInfo(); + DstFormatInfo := GetAudioFormatInfo(); + + // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead + {$IF Defined(UseFFmpegResample)} + Converter := TAudioConverter_FFmpeg.Create(); + {$ELSEIF Defined(UseSRCResample)} + Converter := TAudioConverter_SRC.Create(); + {$ELSE} + Converter := TAudioConverter_SDL.Create(); + {$IFEND} + + Result := Converter.Init(SrcFormatInfo, DstFormatInfo); +end; + +procedure TGenericPlaybackStream.Play(); +var + Mixer: TAudioMixerStream; +begin + // only paused streams are not flushed + if (Status = ssPaused) then + NeedsRewind := false; + + // rewind if necessary. Cases that require no rewind are: + // - stream was created and never played + // - stream was paused and is resumed now + // - stream was stopped and set to a new position already + if (NeedsRewind) then + SetPosition(0); + + // update status + Status := ssPlaying; + + NeedsRewind := true; + + // add this stream to the mixer + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.AddStream(Self); +end; + +procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single); +begin + FadeInTime := Trunc(Time * 1000); + FadeInStartTime := SDL_GetTicks(); + FadeInStartVolume := fVolume; + FadeInTargetVolume := TargetVolume; + Play(); +end; + +procedure TGenericPlaybackStream.Pause(); +var + Mixer: TAudioMixerStream; +begin + if (Status <> ssPlaying) then + Exit; + + Status := ssPaused; + + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.RemoveStream(Self); +end; + +procedure TGenericPlaybackStream.Stop(); +var + Mixer: TAudioMixerStream; +begin + if (Status = ssStopped) then + Exit; + + Status := ssStopped; + + Mixer := Engine.GetMixer(); + if (Mixer <> nil) then + Mixer.RemoveStream(Self); +end; + +function TGenericPlaybackStream.GetLoop(): boolean; +begin + if assigned(SourceStream) then + Result := SourceStream.Loop + else + Result := false; +end; + +procedure TGenericPlaybackStream.SetLoop(Enabled: boolean); +begin + if assigned(SourceStream) then + SourceStream.Loop := Enabled; +end; + +function TGenericPlaybackStream.GetLength(): real; +begin + if assigned(SourceStream) then + Result := SourceStream.Length + else + Result := -1; +end; + +function TGenericPlaybackStream.GetLatency(): double; +begin + Result := Engine.GetLatency(); +end; + +function TGenericPlaybackStream.GetStatus(): TStreamStatus; +begin + Result := Status; +end; + +function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := Engine.GetAudioFormatInfo(); +end; + +procedure TGenericPlaybackStream.FlushBuffers(); +begin + SampleBufferCount := 0; + SampleBufferPos := 0; + SourceBufferCount := 0; +end; + +procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer); +var + i: integer; +begin + for i := 0 to SoundEffects.Count-1 do + begin + if (SoundEffects[i] <> nil) then + begin + TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize); + end; + end; +end; + +function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +var + ConversionInputCount: integer; + ConversionOutputSize: integer; // max. number of converted data (= buffer size) + ConversionOutputCount: integer; // actual number of converted data + SourceSize: integer; + RequestedSourceSize: integer; + NeededSampleBufferSize: integer; + BytesNeeded, BytesAvail: integer; + SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo; + SourceFrameSize, OutputFrameSize: integer; + SkipOutputCount: integer; // number of output-data bytes to skip + SkipSourceCount: integer; // number of source-data bytes to skip + FillCount: integer; // number of bytes to fill with padding data + CopyCount: integer; + PadFrame: PChar; + i: integer; +begin + Result := -1; + + // sanity check for the source-stream + if (not assigned(SourceStream)) then + Exit; + + SkipOutputCount := 0; + SkipSourceCount := 0; + FillCount := 0; + + SourceFormatInfo := SourceStream.GetAudioFormatInfo(); + SourceFrameSize := SourceFormatInfo.FrameSize; + OutputFormatInfo := GetAudioFormatInfo(); + OutputFrameSize := OutputFormatInfo.FrameSize; + + // synchronize (adjust buffer size) + BytesNeeded := Synchronize(BufferSize, OutputFormatInfo); + if (BytesNeeded > BufferSize) then + begin + SkipOutputCount := BytesNeeded - BufferSize; + BytesNeeded := BufferSize; + end + else if (BytesNeeded < BufferSize) then + begin + FillCount := BufferSize - BytesNeeded; + end; + + // lock access to sample-buffer + LockSampleBuffer(); + try + + // skip sample-buffer data + SampleBufferPos := SampleBufferPos + SkipOutputCount; + // size of available bytes in SampleBuffer after skipping + SampleBufferCount := SampleBufferCount - SampleBufferPos; + // update byte skip-count + SkipOutputCount := -SampleBufferCount; + + // now that we skipped all buffered data from the last pass, we have to skip + // data directly after fetching it from the source-stream. + if (SkipOutputCount > 0) then + begin + SampleBufferCount := 0; + // convert skip-count to source-format units and resize to a multiple of + // the source frame-size. + SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) / + SourceFrameSize) * SourceFrameSize; + SkipOutputCount := 0; + end; + + // copy data to front of buffer + if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then + Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount); + SampleBufferPos := 0; + + // resize buffer to a reasonable size + if (BufferSize > SampleBufferCount) then + begin + // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing + SampleBufferSize := BufferSize; + ReallocMem(SampleBuffer, SampleBufferSize); + if (not assigned(SampleBuffer)) then + Exit; + end; + + // fill sample-buffer (fetch and convert one block of source data per loop) + while (SampleBufferCount < BytesNeeded) do + begin + // move remaining source data from the previous pass to front of buffer + if (SourceBufferCount > 0) then + begin + Move(SourceBuffer[SourceBufferSize-SourceBufferCount], + SourceBuffer[0], + SourceBufferCount); + end; + + SourceSize := SourceStream.ReadData( + @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount); + // break on error (-1) or if no data is available (0), e.g. while seeking + if (SourceSize <= 0) then + begin + // if we do not have data -> exit + if (SourceBufferCount = 0) then + begin + FlushBuffers(); + Exit; + end; + // if we have some data, stop retrieving data from the source stream + // and use the data we have so far + Break; + end; + + SourceBufferCount := SourceBufferCount + SourceSize; + + // end-of-file reached -> stop playback + if (SourceStream.EOF) then + begin + if (Loop) then + SourceStream.Position := 0 + else + Stop(); + end; + + if (SkipSourceCount > 0) then + begin + // skip data and update source buffer count + SourceBufferCount := SourceBufferCount - SkipSourceCount; + SkipSourceCount := -SourceBufferCount; + // continue with next pass if we skipped all data + if (SourceBufferCount <= 0) then + begin + SourceBufferCount := 0; + Continue; + end; + end; + + // calc buffer size (might be bigger than actual resampled byte count) + ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount); + NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize; + + // resize buffer if necessary + if (SampleBufferSize < NeededSampleBufferSize) then + begin + SampleBufferSize := NeededSampleBufferSize; + ReallocMem(SampleBuffer, SampleBufferSize); + if (not assigned(SampleBuffer)) then + begin + FlushBuffers(); + Exit; + end; + end; + + // resample source data (Note: ConversionInputCount might be adjusted by Convert()) + ConversionInputCount := SourceBufferCount; + ConversionOutputCount := Converter.Convert( + SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount); + if (ConversionOutputCount = -1) then + begin + FlushBuffers(); + Exit; + end; + + // adjust sample- and source-buffer count by the number of converted bytes + SampleBufferCount := SampleBufferCount + ConversionOutputCount; + SourceBufferCount := SourceBufferCount - ConversionInputCount; + end; + + // apply effects + ApplySoundEffects(SampleBuffer, SampleBufferCount); + + // copy data to result buffer + CopyCount := Min(BytesNeeded, SampleBufferCount); + Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount); + Dec(BytesNeeded, CopyCount); + SampleBufferPos := CopyCount; + + // release buffer lock + finally + UnlockSampleBuffer(); + end; + + // pad the buffer with the last frame if we are to fast + if (FillCount > 0) then + begin + if (CopyCount >= OutputFrameSize) then + PadFrame := @Buffer[CopyCount-OutputFrameSize] + else + PadFrame := nil; + FillBufferWithFrame(@Buffer[CopyCount], FillCount, + PadFrame, OutputFrameSize); + end; + + // BytesNeeded now contains the number of remaining bytes we were not able to fetch + Result := BufferSize - BytesNeeded; +end; + +function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; +var + ByteCount: integer; +begin + Result := 0; + + // just SInt16 stereo support for now + if ((Engine.GetAudioFormatInfo().Format <> asfS16) or + (Engine.GetAudioFormatInfo().Channels <> 2)) then + begin + Exit; + end; + + // zero memory + FillChar(Data, SizeOf(Data), 0); + + // TODO: At the moment just the first samples of the SampleBuffer + // are returned, even if there is newer data in the upper samples. + + LockSampleBuffer(); + ByteCount := Min(SizeOf(Data), SampleBufferCount); + if (ByteCount > 0) then + begin + Move(SampleBuffer[0], Data, ByteCount); + end; + UnlockSampleBuffer(); + + Result := ByteCount div SizeOf(TPCMStereoSample); +end; + +procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData); +var + i: integer; + Frames: integer; + DataIn: PSingleArray; + AudioFormat: TAudioFormatInfo; +begin + // only works with SInt16 and Float values at the moment + AudioFormat := GetAudioFormatInfo(); + + DataIn := AllocMem(FFTSize * SizeOf(Single)); + if (DataIn = nil) then + Exit; + + LockSampleBuffer(); + // TODO: We just use the first Frames frames, the others are ignored. + Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize); + // use only first channel and convert data to float-values + case AudioFormat.Format of + asfS16: + begin + for i := 0 to Frames-1 do + DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt); + end; + asfFloat: + begin + for i := 0 to Frames-1 do + DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^; + end; + end; + UnlockSampleBuffer(); + + WindowFunc(fwfHanning, FFTSize, DataIn); + PowerSpectrum(FFTSize, DataIn, @Data); + FreeMem(DataIn); + + // resize data to a 0..1 range + for i := 0 to High(TFFTData) do + begin + Data[i] := Sqrt(Data[i]) / 100; + end; +end; + +procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect); +begin + if (not assigned(Effect)) then + Exit; + + LockSampleBuffer(); + // check if effect is already in list to avoid duplicates + if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then + SoundEffects.Add(Pointer(Effect)); + UnlockSampleBuffer(); +end; + +procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); +begin + LockSampleBuffer(); + SoundEffects.Remove(Effect); + UnlockSampleBuffer(); +end; + +function TGenericPlaybackStream.GetPosition: real; +var + BufferedTime: double; +begin + if assigned(SourceStream) then + begin + LockSampleBuffer(); + + // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer) + // but not yet outputed + BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec + + SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec; + // and subtract it from the source position + Result := SourceStream.Position - BufferedTime; + + UnlockSampleBuffer(); + end + else + begin + Result := -1; + end; +end; + +procedure TGenericPlaybackStream.SetPosition(Time: real); +begin + if assigned(SourceStream) then + begin + LockSampleBuffer(); + + SourceStream.Position := Time; + if (Status = ssStopped) then + NeedsRewind := false; + // do not use outdated data + FlushBuffers(); + + AvgSyncDiff := -1; + + UnlockSampleBuffer(); + end; +end; + +function TGenericPlaybackStream.GetVolume(): single; +var + FadeAmount: Single; +begin + LockSampleBuffer(); + // adjust volume if fading is enabled + if (FadeInTime > 0) then + begin + FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime; + // check if fade-target is reached + if (FadeAmount >= 1) then + begin + // target reached -> stop fading + FadeInTime := 0; + fVolume := FadeInTargetVolume; + end + else + begin + // fading in progress + fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume; + end; + end; + // return current volume + Result := fVolume; + UnlockSampleBuffer(); +end; + +procedure TGenericPlaybackStream.SetVolume(Volume: single); +begin + LockSampleBuffer(); + // stop fading + FadeInTime := 0; + // clamp volume + if (Volume > 1.0) then + fVolume := 1.0 + else if (Volume < 0) then + fVolume := 0 + else + fVolume := Volume; + UnlockSampleBuffer(); +end; + + +{ TGenericVoiceStream } + +constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer); +begin + inherited Create(); + Self.Engine := Engine; +end; + +function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +var + BufferSize: integer; +begin + Result := false; + + Close(); + + if (not inherited Open(ChannelMap, FormatInfo)) then + Exit; + + // Note: + // - use Self.FormatInfo instead of FormatInfo as the latter one might have a + // channel size of 2. + // - the buffer-size must be a multiple of the FrameSize + BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) * + Self.FormatInfo.FrameSize; + VoiceBuffer := TRingBuffer.Create(BufferSize); + + BufferLock := SDL_CreateMutex(); + + + // create a matching playback stream for the voice-stream + PlaybackStream := TGenericPlaybackStream.Create(Engine); + // link voice- and playback-stream + if (not PlaybackStream.Open(Self)) then + begin + PlaybackStream.Free; + Exit; + end; + + // start voice passthrough + PlaybackStream.Play(); + + Result := true; +end; + +procedure TGenericVoiceStream.Close(); +begin + // stop and free the playback stream + FreeAndNil(PlaybackStream); + + // free data + FreeAndNil(VoiceBuffer); + if (BufferLock <> nil) then + SDL_DestroyMutex(BufferLock); + + inherited Close(); +end; + +procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); +begin + // lock access to buffer + SDL_mutexP(BufferLock); + try + if (VoiceBuffer = nil) then + Exit; + VoiceBuffer.Write(Buffer, BufferSize); + finally + SDL_mutexV(BufferLock); + end; +end; + +function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; +begin + Result := -1; + + // lock access to buffer + SDL_mutexP(BufferLock); + try + if (VoiceBuffer = nil) then + Exit; + Result := VoiceBuffer.Read(Buffer, BufferSize); + finally + SDL_mutexV(BufferLock); + end; +end; + +function TGenericVoiceStream.IsEOF(): boolean; +begin + SDL_mutexP(BufferLock); + Result := (VoiceBuffer = nil); + SDL_mutexV(BufferLock); +end; + +function TGenericVoiceStream.IsError(): boolean; +begin + Result := false; +end; + + +{ TAudioPlayback_SoftMixer } + +function TAudioPlayback_SoftMixer.InitializePlayback: boolean; +begin + Result := false; + + //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer'); + + if(not InitializeAudioPlaybackEngine()) then + Exit; + + MixerStream := TAudioMixerStream.Create(Self); + + if(not StartAudioPlaybackEngine()) then + Exit; + + Result := true; +end; + +function TAudioPlayback_SoftMixer.FinalizePlayback: boolean; +begin + Close; + StopAudioPlaybackEngine(); + + FreeAndNil(MixerStream); + FreeAndNil(FormatInfo); + + FinalizeAudioPlaybackEngine(); + inherited FinalizePlayback; + Result := true; +end; + +procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer); +begin + MixerStream.ReadData(Buffer, Size); +end; + +function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream; +begin + Result := MixerStream; +end; + +function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream; +begin + Result := TGenericPlaybackStream.Create(Self); +end; + +function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +var + VoiceStream: TGenericVoiceStream; +begin + Result := nil; + + // create a voice stream + VoiceStream := TGenericVoiceStream.Create(Self); + if (not VoiceStream.Open(ChannelMap, FormatInfo)) then + begin + VoiceStream.Free; + Exit; + end; + + Result := VoiceStream; +end; + +procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single); +begin + // sets volume only for this application + MixerStream.Volume := Volume; +end; + +procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); +var + SampleIndex: Cardinal; + SampleInt: Integer; + SampleFlt: Single; +begin + SampleIndex := 0; + case FormatInfo.Format of + asfS16: + begin + while (SampleIndex < Size) do + begin + // apply volume and sum with previous mixer value + SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ + + Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume); + // clip result + if (SampleInt > High(SmallInt)) then + SampleInt := High(SmallInt) + else if (SampleInt < Low(SmallInt)) then + SampleInt := Low(SmallInt); + // assign result + PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt; + // increase index by one sample + Inc(SampleIndex, SizeOf(SmallInt)); + end; + end; + asfFloat: + begin + while (SampleIndex < Size) do + begin + // apply volume and sum with previous mixer value + SampleFlt := PSingle(@DstBuffer[SampleIndex])^ + + PSingle(@SrcBuffer[SampleIndex])^ * Volume; + // clip result + if (SampleFlt > 1.0) then + SampleFlt := 1.0 + else if (SampleFlt < -1.0) then + SampleFlt := -1.0; + // assign result + PSingle(@DstBuffer[SampleIndex])^ := SampleFlt; + // increase index by one sample + Inc(SampleIndex, SizeOf(Single)); + end; + end; + else + begin + Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio'); + end; + end; +end; + +end. diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas new file mode 100644 index 00000000..d8f6cdb0 --- /dev/null +++ b/src/base/UCatCovers.pas @@ -0,0 +1,173 @@ +unit UCatCovers; +///////////////////////////////////////////////////////////////////////// +// UCatCovers by Whiteshark // +// Class for listing and managing the Category Covers // +///////////////////////////////////////////////////////////////////////// + +interface + +{$I switches.inc} + +uses UIni; + +type + TCatCovers = class + protected + cNames: array [0..high(ISorting)] of array of string; + cFiles: array [0..high(ISorting)] of array of string; + public + constructor Create; + procedure Load; //Load Cover aus Cover.ini and Cover Folder + procedure LoadPath(const CoversPath: string); + procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover + function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists + function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover + end; + +var + CatCovers: TCatCovers; + +implementation + +uses + IniFiles, + SysUtils, + Classes, + // UFiles, + UMain, + ULog; + +constructor TCatCovers.Create; +begin + inherited; + Load; +end; + +procedure TCatCovers.Load; +var + I: integer; +begin + for I := 0 to CoverPaths.Count-1 do + LoadPath(CoverPaths[I]); +end; + +(** + * Load Cover from Cover.ini and Cover Folder + *) +procedure TCatCovers.LoadPath(const CoversPath: string); +var + Ini: TMemIniFile; + SR: TSearchRec; + List: TStringlist; + I, J: Integer; + Name, Filename, Temp: string; +begin + Ini := nil; + List := nil; + + try + Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); + List := TStringlist.Create; + + //Add every Cover in Covers Ini for Every Sorting option + for I := 0 to High(ISorting) do + begin + Ini.ReadSection(ISorting[I], List); + + for J := 0 to List.Count - 1 do + Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); + end; + finally + Ini.Free; + List.Free; + end; + + try + //Add Covers from Folder + if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then + repeat + //Add Cover if it doesn't exist for every Section + Name := SR.Name; + Filename := CoversPath + Name; + Delete (Name, length(Name) - 3, 4); + + for I := 0 to high(ISorting) do + begin + Temp := Name; + if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then + Delete (Temp, Pos ('Title', Temp), 5) + else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then + Delete (Temp, Pos ('Artist', Temp), 6); + + if not CoverExists(I, Temp) then + Add (I, Temp, Filename); + end; + until FindNext (SR) <> 0; + finally + FindClose (SR); + end; +end; + + //Add a Cover +procedure TCatCovers.Add(Sorting: integer; Name, Filename: string); +begin + if FileExists (Filename) then //If Exists -> Add + begin + SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1); + SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1); + + CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name); + CFiles[Sorting][high(cNames[Sorting])] := FileName; + end; +end; + + //Returns True when a cover with the given Name exists +function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean; +var + I: Integer; +begin + Result := False; + Name := Uppercase(Name); //Case Insensitiv + + for I := 0 to high(cNames[Sorting]) do + begin + if (cNames[Sorting][I] = Name) then //Found Name + begin + Result := true; + break; //Break For Loop + end; + end; +end; + + //Returns the Filename of a Cover +function TCatCovers.GetCover(Sorting: integer; Name: string): string; +var + I: Integer; +begin + Result := ''; + Name := Uppercase(Name); + + for I := 0 to high(cNames[Sorting]) do + begin + if cNames[Sorting][I] = Name then + begin + Result := cFiles[Sorting][I]; + Break; + end; + end; + + //No Cover + if (Result = '') then + begin + for I := 0 to CoverPaths.Count-1 do + begin + if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then + begin + Result := CoverPaths[I] + 'NoCover.jpg'; + Break; + end; + end; + end; +end; + +end. diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas new file mode 100644 index 00000000..8bdc4f5a --- /dev/null +++ b/src/base/UCommandLine.pas @@ -0,0 +1,334 @@ +unit UCommandLine; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + //----------- + // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables + //----------- + TCMDParams = class + private + sLanguage: String; + sResolution: String; + public + //Some Boolean Variables Set when Reading Infos + Debug: Boolean; + Benchmark: Boolean; + NoLog: Boolean; + FullScreen: Boolean; + Joypad: Boolean; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + Depth: Integer; + Screens: Integer; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath: String; + ConfigFile: String; + ScoreFile: String; + + procedure showhelp(); + + //Pseudo Integer Values + Function GetLanguage: Integer; + Property Language: Integer read GetLanguage; + + Function GetResolution: Integer; + Property Resolution: Integer read GetResolution; + + //Some Procedures for Reading Infos + Constructor Create; + + Procedure ResetVariables; + Procedure ReadParamInfo; + end; + +var + Params: TCMDParams; + +const + cHelp = 'help'; + cDebug = 'debug'; + cMediaInterfaces = 'showinterfaces'; + + +implementation + +uses SysUtils, + uPlatform; +// uINI -- Nasty requirement... ( removed with permission of blindy ) + + +//------------- +// Constructor - Create class, Reset Variables and Read Infos +//------------- +Constructor TCMDParams.Create; +begin + inherited; + + if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then + showhelp(); + + ResetVariables; + ReadParamInfo; +end; + +procedure TCMDParams.showhelp(); + + function s( aString : String ) : string; + begin + result := aString + StringofChar( ' ', 15 - length( aString ) ); + end; + +begin + + writeln( '' ); + writeln( '**************************************************************' ); + writeln( ' UltraStar Deluxe - Command line switches ' ); + writeln( '**************************************************************' ); + writeln( '' ); + writeln( ' '+s( 'Switch' ) +' : Purpose' ); + writeln( ' ----------------------------------------------------------' ); + writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' ); + writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' ); + writeln( '' ); + + platform.halt; +end; + +//------------- +// ResetVariables - Reset Class Variables +//------------- +Procedure TCMDParams.ResetVariables; +begin + Debug := False; + Benchmark := False; + NoLog := False; + FullScreen := False; + Joypad := False; + + //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} + sResolution := ''; + sLanguage := ''; + Depth := -1; + Screens := -1; + + //Some Strings Set when Reading Infos {Length=0 Not Set} + SongPath := ''; + ConfigFile := ''; + ScoreFile := ''; +end; + +//------------- +// ReadParamInfo - Read Infos from Parameters +//------------- +Procedure TCMDParams.ReadParamInfo; +var + I: Integer; + PCount: Integer; + Command: String; +begin + PCount := ParamCount; + //Log.LogError('ParamCount: ' + Inttostr(PCount)); + + + //Check all Parameters + For I := 1 to PCount do + begin + Command := Paramstr(I); + //Log.LogError('Start parsing Command: ' + Command); + //Is String Parameter ? + if (Length(Command) > 1) AND (Command[1] = '-') then + begin + //Remove - from Command + Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); + //Log.LogError('Command prepared: ' + Command); + + //Check Command + + // Boolean Triggers: + if (Command = 'debug') then + Debug := True + else if (Command = 'benchmark') then + Benchmark := True + else if (Command = 'nolog') then + NoLog := True + else if (Command = 'fullscreen') then + Fullscreen := True + else if (Command = 'window') then + Fullscreen := False + else if (Command = 'joypad') then + Joypad := True + + //Integer Variables + else if (Command = 'depth') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '16') then + Depth := 0 + Else If (Command = '32') then + Depth := 1; + end; + end + + else if (Command = 'screens') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + Command := ParamStr(I + 1); + + //Check for valid Value + If (Command = '1') then + Screens := 0 + Else If (Command = '2') then + Screens := 1; + end; + end + + //Pseudo Integer Values + else if (Command = 'language') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sLanguage := Lowercase(ParamStr(I + 1)); + end; + end + + else if (Command = 'resolution') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + sResolution := Lowercase(ParamStr(I + 1)); + end; + end + + //String Values + else if (Command = 'songpath') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + SongPath := ParamStr(I + 1); + end; + end + + else if (Command = 'configfile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ConfigFile := ParamStr(I + 1); + + //is this a relative PAth -> then add Gamepath + if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then + ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; + end; + end + + else if (Command = 'scorefile') then + begin + //Check if there is another Parameter to get the Value from + if (PCount > I) then + begin + //Write Value to String + ScoreFile := ParamStr(I + 1); + end; + end; + + end; + + end; + +{ Log.LogError('Values: '); + + if Debug then + Log.LogError('Debug'); + + if Benchmark then + Log.LogError('Benchmark'); + + if NoLog then + Log.LogError('NoLog'); + + if Fullscreen then + Log.LogError('FullScreen'); + + if JoyStick then + Log.LogError('Joystick'); + + + Log.LogError('Screens: ' + Inttostr(Screens)); + Log.LogError('Depth: ' + Inttostr(Depth)); + + Log.LogError('Resolution: ' + Inttostr(Resolution)); + Log.LogError('Resolution: ' + Inttostr(Language)); + + Log.LogError('sResolution: ' + sResolution); + Log.LogError('sLanguage: ' + sLanguage); + + Log.LogError('ConfigFile: ' + ConfigFile); + Log.LogError('SongPath: ' + SongPath); + Log.LogError('ScoreFile: ' + ScoreFile); } + +end; + +//------------- +// GetLanguage - Get Language ID from saved String Information +//------------- +Function TCMDParams.GetLanguage: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Language + For I := 0 to high(ILanguage) do + if (LowerCase(ILanguage[I]) = sLanguage) then + begin + Result := I; + Break; + end; +*} +end; + +//------------- +// GetResolution - Get Resolution ID from saved String Information +//------------- +Function TCMDParams.GetResolution: Integer; +var + I: integer; +begin + Result := -1; +{* JB - 12sep07 to remove uINI dependency + + //Search for Resolution + For I := 0 to high(IResolution) do + if (LowerCase(IResolution[I]) = sResolution) then + begin + Result := I; + Break; + end; +*} +end; + +end. diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas new file mode 100644 index 00000000..41e3c1f1 --- /dev/null +++ b/src/base/UCommon.pas @@ -0,0 +1,774 @@ +unit UCommon; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF} + sdl, + UConfig, + ULog; + +type + TMessageType = ( mtInfo, mtError ); + +procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); + +procedure ConsoleWriteLn(const msg: string); + +function GetResourceStream(const aName, aType : string): TStream; +function RWopsFromStream(Stream: TStream): PSDL_RWops; + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +{$ENDIF} + +function StringReplaceW(text : WideString; search, rep: WideChar):WideString; +function AdaptFilePaths( const aPath : widestring ): widestring; + +procedure DisableFloatingPointExceptions(); +procedure SetDefaultNumericLocale(); +procedure RestoreNumericLocale(); + +{$IFNDEF MSWINDOWS} + procedure ZeroMemory( Destination: Pointer; Length: DWORD ); + function MakeLong(a, b: Word): Longint; + (* + #define LOBYTE(a) (BYTE)(a) + #define HIBYTE(a) (BYTE)((a)>>8) + #define LOWORD(a) (WORD)(a) + #define HIWORD(a) (WORD)((a)>>16) + #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8)) + *) +{$ENDIF} + +function FileExistsInsensitive(var FileName: string): boolean; + +(* + * Character classes + *) + +function IsAlphaChar(ch: WideChar): boolean; +function IsNumericChar(ch: WideChar): boolean; +function IsAlphaNumericChar(ch: WideChar): boolean; +function IsPunctuationChar(ch: WideChar): boolean; +function IsControlChar(ch: WideChar): boolean; + +// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) +procedure MergeSort(List: TList; CompareFunc: TListSortCompare); + +function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; +procedure FreeAlignedMem(P: Pointer); + + +implementation + +uses + Math, + {$IFDEF Delphi} + Dialogs, + {$ENDIF} + UMain; + + +// data used by the ...Locale() functions +{$IFDEF LINUX} + +var + PrevNumLocale: string; + +const + LC_NUMERIC = 1; + +function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale'; + +{$ENDIF} + +// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') +// to set the language/country specific locale (e.g. charset) for this application. +// Unfortunately, LC_NUMERIC is set by this call too. +// It defines the decimal-separator and other country-specific numeric settings. +// This parameter is used by the C string-to-float parsing functions atof() and strtod(). +// After changing LC_NUMERIC some external C-based libs (like projectM) are not +// able to parse strings correctly +// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). +// So we reset the numeric settings to the default ('C'). +// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not +// changed by this because it doesn't use the locale-settings. +// TODO: +// - Check if this is needed in MacOSX (at least the locale is set in cwstring) +// - Find out which libs are concerned by this problem. +// If only projectM is concerned by this problem set and restore the numeric locale +// for each call to projectM instead of changing it globally. +procedure SetDefaultNumericLocale(); +begin + {$ifdef LINUX} + PrevNumLocale := setlocale(LC_NUMERIC, nil); + setlocale(LC_NUMERIC, 'C'); + {$endif} +end; + +procedure RestoreNumericLocale(); +begin + {$ifdef LINUX} + setlocale(LC_NUMERIC, PChar(PrevNumLocale)); + {$endif} +end; + +(* + * If an invalid floating point operation was performed the Floating-point unit (FPU) + * generates a Floating-point exception (FPE). Dependending on the settings in + * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself + * (we will call this as "FPE disabled" later on) or is passed to the application + * (FPE enabled). + * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is + * considered an error and an exception is thrown. Otherwise the FPU will handle + * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without + * throwing an error to the application. + * The same applies to a division by INF that either raises an exception + * (FPE enabled) or returns 0.0 (FPE disabled). + * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED + * on program startup (at least with Intel CPUs), but for some strange reasons + * they are ENABLED in pascal (both delphi and FPC) by default. + * Many libs operating with floating-point values rely heavily on the C-specific + * behaviour. So using them in delphi is a ticking time-bomb because sooner or + * later they will crash because of an FPE (this problem occurs massively + * in OpenGL-based libs like projectM). In contrast to this no error will occur + * if the lib is linked to a C-program. + * + * Further info on FPUs: + * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. + * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 + * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. + * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) + * to control FPEs. Either has (among others) 6bits to enable/disable several + * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). + * Those exception-types must all be masked (=1) to get the default C behaviour. + * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). + * Instead of using assembler code, we can use Set8087CW() provided by delphi and + * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. + * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program + * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. + * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. + * FPC and Delphi both provide a SetExceptionMask() for control of the FPE + * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE + * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() + * is what we need and it even is plattform and CPU independent. + * + * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) + * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL + * headers they do not work properly with FPC. I already patched them, so they + * work at least until they are updated the next time. In addition Set8086CW() + * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. + * FPEs with SSE are a big problem with some libs because many linux distributions + * optimize code for SSE or Pentium3 (for example: int(INF) which convert the + * double value "infinity" to an integer might be automatically optimized by + * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case + * to make USDX portable. + * + * Summary: + * Call this function on initialization to make sure FPEs are turned off. + * It will solve a lot of errors with FPEs in external libs. + *) +procedure DisableFloatingPointExceptions(); +begin + (* + // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). + // Note: Leave these lines for documentation purposes just in case + // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). + {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} + Set8087CW($133F); + {$IFEND} + {$IF Defined(FPC)} + if (has_sse_support) then + SetSSECSR($1F80); + {$IFEND} + *) + + // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and + // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). + SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, + exOverflow, exUnderflow, exPrecision]); +end; + +function StringReplaceW(text : WideString; search, rep: WideChar) : WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 1 to length(result) do + begin + if result[iPos] = search then + result[iPos] := rep; + end; +end; + +function AdaptFilePaths( const aPath : widestring ): widestring; +begin + result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); +end; + + +{$IFNDEF MSWINDOWS} +procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +begin + FillChar( Destination^, Length, 0 ); +end; + +function MakeLong(A, B: Word): Longint; +begin + Result := (LongInt(B) shl 16) + A; +end; + +(* +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; + + // From http://en.wikipedia.org/wiki/RDTSC + function RDTSC: Int64; register; + asm + rdtsc + end; + +begin + // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit) + lpPerformanceCount := RDTSC(); + result := true; +end; + +function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; +begin + // clock_getres(CLOCK_REALTIME, ...) + lpFrequency := 0; + result := true; +end; +*) +{$ENDIF} + +// Checks if a regular files or directory with the given name exists. +// The comparison is case insensitive. +function FileExistsInsensitive(var FileName: string): boolean; +var + FilePath, LocalFileName: string; + SearchInfo: TSearchRec; +begin +{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems + // speed up standard case + if FileExists(FileName) then + begin + Result := true; + exit; + end; + + Result := false; + + FilePath := ExtractFilePath(FileName); + if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then + begin + LocalFileName := ExtractFileName(FileName); + repeat + if (AnsiSameText(LocalFileName, SearchInfo.Name)) then + begin + FileName := FilePath + SearchInfo.Name; + Result := true; + break; + end; + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); +{$ELSE} + Result := FileExists(FileName); +{$ENDIF} +end; + + +{$IFDEF Unix} + // include resource-file info (stored in the constant array "resources") + {$I ../resource.inc} +{$ENDIF} + +function GetResourceStream(const aName, aType: string): TStream; +{$IFDEF Unix} +var + ResIndex: integer; + Filename: string; +{$ENDIF} +begin + Result := nil; + + {$IFDEF Unix} + for ResIndex := 0 to High(resources) do + begin + if (resources[ResIndex][0] = aName ) and + (resources[ResIndex][1] = aType ) then + begin + try + Filename := ResourcesPath + resources[ResIndex][2]; + Result := TFileStream.Create(Filename, fmOpenRead); + except + Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream'); + end; + exit; + end; + end; + {$ELSE} + try + Result := TResourceStream.Create(HInstance, aName , PChar(aType)); + except + Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream'); + end; + {$ENDIF} +end; + +// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ + function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; + var + stream : TStream; + origin : Word; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); + case whence of + 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. + 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. + 2 : origin := soFromEnd; + else + origin := soFromBeginning; // just in case + end; + Result := stream.Seek( offset, origin ); + end; + + function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; + var + stream : TStream; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); + try + Result := stream.read( Ptr^, Size * maxnum ) div size; + except + Result := -1; + end; + end; + + function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; + var + stream : TStream; + begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; + end; +// ----------------------------------------------- + +(* + * Creates an SDL_RWops handle from a TStream. + * The stream and RWops must be freed by the user after usage. + * Use SDL_FreeRW(...) to free the RWops data-struct. + *) +function RWopsFromStream(Stream: TStream): PSDL_RWops; +begin + Result := SDL_AllocRW(); + if (Result = nil) then + Exit; + + // set RW-callbacks + with Result^ do + begin + unknown := TUnknown(Stream); + seek := SDLStreamSeek; + read := SDLStreamRead; + write := nil; + close := SDLStreamClose; + type_ := 2; + end; +end; + + + +{$IFDEF FPC} +function RandomRange(aMin: Integer; aMax: Integer) : Integer; +begin + RandomRange := Random(aMax-aMin) + aMin ; +end; +{$ENDIF} + + +{$IFDEF FPC} +var + MessageList: TStringList; + ConsoleHandler: TThreadID; + // Note: TRTLCriticalSection is defined in the units System and Libc, use System one + ConsoleCriticalSection: System.TRTLCriticalSection; + ConsoleEvent: PRTLEvent; + ConsoleQuit: boolean; +{$ENDIF} + +(* + * Write to console if one is available. + * It checks if a console is available before output so it will not + * crash on windows if none is available. + * Do not use this function directly because it is not thread-safe, + * use ConsoleWriteLn() instead. + *) +procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF} +begin + {$IFDEF MSWINDOWS} + // sanity check to avoid crashes with writeln() + if (IsConsole) then + begin + {$ENDIF} + Writeln(aString); + {$IFDEF MSWINDOWS} + end; + {$ENDIF} +end; + +{$IFDEF FPC} +{* + * The console-handlers main-function. + * TODO: create a quit-event on closing. + *} +function ConsoleHandlerFunc(param: pointer): PtrInt; +var + i: integer; + quit: boolean; +begin + quit := false; + while (not quit) do + begin + // wait for new output or quit-request + RTLeventWaitFor(ConsoleEvent); + + System.EnterCriticalSection(ConsoleCriticalSection); + // output pending messages + for i := 0 to MessageList.Count-1 do + begin + _ConsoleWriteLn(MessageList[i]); + end; + MessageList.Clear(); + + // use local quit-variable to avoid accessing + // ConsoleQuit outside of the critical section + if (ConsoleQuit) then + quit := true; + + RTLeventResetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + end; + result := 0; +end; +{$ENDIF} + +procedure InitConsoleOutput(); +begin + {$IFDEF FPC} + // init thread-safe output + MessageList := TStringList.Create(); + System.InitCriticalSection(ConsoleCriticalSection); + ConsoleEvent := RTLEventCreate(); + ConsoleQuit := false; + // must be a thread managed by FPC. Otherwise (e.g. SDL-thread) + // it will crash when using Writeln. + ConsoleHandler := BeginThread(@ConsoleHandlerFunc); + {$ENDIF} +end; + +procedure FinalizeConsoleOutput(); +begin + {$IFDEF FPC} + // terminate console-handler + System.EnterCriticalSection(ConsoleCriticalSection); + ConsoleQuit := true; + RTLeventSetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + WaitForThreadTerminate(ConsoleHandler, 0); + // free data + System.DoneCriticalsection(ConsoleCriticalSection); + RTLeventDestroy(ConsoleEvent); + MessageList.Free(); + {$ENDIF} +end; + +{* + * With FPC console output is not thread-safe. + * Using WriteLn() from external threads (like in SDL callbacks) + * will damage the heap and crash the program. + * Most probably FPC uses thread-local-data (TLS) to lock a mutex on + * the console-buffer. This does not work with external lib's threads + * because these do not have the TLS data and so it crashes while + * accessing unallocated memory. + * The solution is to create an FPC-managed thread which has the TLS data + * and use it to handle the console-output (hence it is called Console-Handler) + * It should be safe to do so, but maybe FPC requires the main-thread to access + * the console-buffer only. In this case output should be delegated to it. + * + * TODO: - check if it is safe if an FPC-managed thread different than the + * main-thread accesses the console-buffer in FPC. + * - check if Delphi's WriteLn is thread-safe. + * - check if we need to synchronize file-output too + *} +procedure ConsoleWriteLn(const msg: string); +begin +{$IFDEF CONSOLE} + {$IFDEF FPC} + // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then? + //GetCurrentThreadThreadId(); + System.EnterCriticalSection(ConsoleCriticalSection); + MessageList.Add(msg); + RTLeventSetEvent(ConsoleEvent); + System.LeaveCriticalSection(ConsoleCriticalSection); + {$ELSE} + _ConsoleWriteLn(msg); + {$ENDIF} +{$ENDIF} +end; + +procedure ShowMessage(const msg: String; msgType: TMessageType); +{$IFDEF MSWINDOWS} +var Flags: Cardinal; +{$ENDIF} +begin +{$IF Defined(MSWINDOWS)} + case msgType of + mtInfo: Flags := MB_ICONINFORMATION or MB_OK; + mtError: Flags := MB_ICONERROR or MB_OK; + else Flags := MB_OK; + end; + MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags); +{$ELSE} + ConsoleWriteln(msg); +{$IFEND} +end; + +function IsAlphaChar(ch: WideChar): boolean; +begin + // TODO: add chars > 255 when unicode-fonts work? + case ch of + 'A'..'Z', // A-Z + 'a'..'z', // a-z + #170,#181,#186, + #192..#214, + #216..#246, + #248..#255: + Result := true; + else + Result := false; + end; +end; + +function IsNumericChar(ch: WideChar): boolean; +begin + case ch of + '0'..'9': + Result := true; + else + Result := false; + end; +end; + +function IsAlphaNumericChar(ch: WideChar): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsPunctuationChar(ch: WideChar): boolean; +begin + // TODO: add chars outside of Latin1 basic (0..127)? + case ch of + ' '..'/',':'..'@','['..'`','{'..'~': + Result := true; + else + Result := false; + end; +end; + +function IsControlChar(ch: WideChar): boolean; +begin + case ch of + #0..#31, + #127..#159: + Result := true; + else + Result := false; + end; +end; + +(* + * Recursive part of the MergeSort algorithm. + * OutList will be either InList or TempList and will be swapped in each + * depth-level of recursion. By doing this it we can directly merge into the + * output-list. If we only had In- and OutList parameters we had to merge into + * InList after the recursive calls and copy the data to the OutList afterwards. + *) +procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer; + CompareFunc: TListSortCompare); +var + LeftSize, RightSize: integer; // number of elements in left/right block + LeftEnd, RightEnd: integer; // Index after last element in left/right block + MidPos: integer; // index of first element in right block + Pos: integer; // position in output list +begin + LeftSize := BlockSize div 2; + RightSize := BlockSize - LeftSize; + MidPos := StartPos + LeftSize; + + // sort left and right halves of this block by recursive calls of this function + if (LeftSize >= 2) then + _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc) + else + TempList[StartPos] := InList[StartPos]; + if (RightSize >= 2) then + _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc) + else + TempList[MidPos] := InList[MidPos]; + + // merge sorted left and right sub-lists into output-list + LeftEnd := MidPos; + RightEnd := StartPos + BlockSize; + Pos := StartPos; + while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do + begin + if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then + begin + OutList[Pos] := TempList[StartPos]; + Inc(StartPos); + end + else + begin + OutList[Pos] := TempList[MidPos]; + Inc(MidPos); + end; + Inc(Pos); + end; + + // copy remaining elements to output-list + while (StartPos < LeftEnd) do + begin + OutList[Pos] := TempList[StartPos]; + Inc(StartPos); + Inc(Pos); + end; + while (MidPos < RightEnd) do + begin + OutList[Pos] := TempList[MidPos]; + Inc(MidPos); + Inc(Pos); + end; +end; + +(* + * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation. + * A stable sorting algorithm preserves preordered items. E.g. if sorting by + * songs by title first and artist afterwards, the songs of each artist will + * be ordered by title. In contrast to this an unstable algorithm (like QuickSort) + * may destroy an existing order, so the songs of an artist will not be ordered + * by title anymore after sorting by artist in the previous example. + * If you do not need a stable algorithm, use TList.Sort() instead. + *) +procedure MergeSort(List: TList; CompareFunc: TListSortCompare); +var + TempList: TList; +begin + TempList := TList.Create(); + TempList.Count := List.Count; + if (List.Count >= 2) then + _MergeSort(List, TempList, List, 0, List.Count, CompareFunc); + TempList.Free; +end; + + +type + // stores the unaligned pointer of data allocated by GetAlignedMem() + PMemAlignHeader = ^TMemAlignHeader; + TMemAlignHeader = Pointer; + +(** + * Use this function to assure that allocated memory is aligned on a specific + * byte boundary. + * Alignment must be a power of 2. + * + * Important: Memory allocated with GetAlignedMem() MUST be freed with + * FreeAlignedMem(), FreeMem() will cause a segmentation fault. + * + * Hint: If you do not need dynamic memory, consider to allocate memory + * statically and use the {$ALIGN x} compiler directive. Note that delphi + * supports an alignment "x" of up to 8 bytes only whereas FPC supports + * alignments on 16 and 32 byte boundaries too. + *) +{$WARNINGS OFF} +function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; +var + OrigPtr: Pointer; +const + MIN_ALIGNMENT = 16; +begin + // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with + // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment + // of either 8 or 16 bytes depending on the size of the requested block + // (see System.GetMinimumBlockAlignment). As we do not want to change the + // boundary for the worse, we align at least on MIN_ALIGN. + if (Alignment < MIN_ALIGNMENT) then + Alignment := MIN_ALIGNMENT; + + // allocate unaligned memory + GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment); + if (OrigPtr = nil) then + begin + Result := nil; + Exit; + end; + + // reserve space for the header + Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); + // align memory + Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); + + // set header with info on old pointer for FreeMem + PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr; +end; +{$WARNINGS ON} + +{$WARNINGS OFF} +procedure FreeAlignedMem(P: Pointer); +begin + if (P <> nil) then + FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^); +end; +{$WARNINGS ON} + + +initialization + InitConsoleOutput(); + +finalization + FinalizeConsoleOutput(); + +end. diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas new file mode 100644 index 00000000..b77c2a5a --- /dev/null +++ b/src/base/UConfig.pas @@ -0,0 +1,199 @@ +unit UConfig; + +// ------------------------------------------------------------------- +// Note on version comparison (for developers only): +// ------------------------------------------------------------------- +// Delphi (in contrast to FPC) DOESN'T support MACROS. So we +// can't define a macro like VERSION_MAJOR(version) to extract +// parts of the version-number or to create version numbers for +// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro. +// So we have to define constants for every part of the version here. +// +// In addition FPC (in contrast to delphi) DOES NOT support floating- +// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23}) +// It also DOESN'T support arithmetic operations so we aren't able to +// compare versions this way (brackets aren't supported too): +// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))} +// +// Hence we have to use fixed numbers in the directives. At least +// Pascal allows leading 0s so 0005 equals 5 (octals are +// preceded by & and not by 0 in FPC). +// We also fix the count of digits for each part of the version number +// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version) +// +// A check for a library with at least a version of 2.5.11 would look +// like this: +// {$IF LIB_VERSION >= 002005011} +// +// If you just need to check the major version do this: +// {$IF LIB_VERSION_MAJOR >= 23} +// +// IMPORTANT: +// Because this unit must be included in a uses-section it is +// not possible to use the version-numbers in this uses-clause. +// Example: +// interface +// uses +// versions, // include this file +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined +// const +// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK +// uses +// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK +// +// Even if this file was an include-file no constants could be declared +// before the interface's uses clause. +// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers +// but this is incompatible to Delphi. In addition macros do not allow expand +// arithmetic expressions. Although you can define +// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} +// the following check would fail: +// {$IF FPC_VERSION_INT >= 002002000} +// would fail because FPC_VERSION_INT is interpreted as a string. +// +// PLEASE consider this if you use version numbers in $IF compiler- +// directives. Otherwise you might break portability. +// ------------------------------------------------------------------- + +interface + +{$IFDEF FPC} + {$MODE Delphi} + {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH +{$ENDIF} + +{$I switches.inc} + +uses + Sysutils; + +const + // IMPORTANT: + // If IncludeConstants is defined, the const-sections + // of the config-file will be included too. + // This switch is necessary because it is not possible to + // include the const-sections in the switches.inc. + // switches.inc is always included before the first uses- + // section but at that place no const-section is allowed. + // So we have to include the config-file in switches.inc + // with IncludeConstants undefined and in UConfig.pas with + // IncludeConstants defined (see the note above). + {$DEFINE IncludeConstants} + + // include config-file (defines + constants) + {$IF Defined(MSWindows)} + {$I ../config-win.inc} + {$ELSEIF Defined(Linux)} + {$I ../config-linux.inc} + {$ELSEIF Defined(Darwin)} + {$I ../config-darwin.inc} + {$ELSE} + {$MESSAGE Fatal 'Unknown OS'} + {$IFEND} + +{* Libraries *} + + VERSION_MAJOR = 1000000; + VERSION_MINOR = 1000; + VERSION_RELEASE = 1; + + (* + * Current version of UltraStar Deluxe + *) + USDX_VERSION_MAJOR = 1; + USDX_VERSION_MINOR = 1; + USDX_VERSION_RELEASE = 0; + USDX_VERSION_STATE = 'Alpha'; + USDX_STRING = 'UltraStar Deluxe'; + + (* + * FPC version numbers are already defined as built-in macros: + * FPC_VERSION (MAJOR) + * FPC_RELEASE (MINOR) + * FPC_PATCH (RELEASE) + * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as + * composed version number. + *) + {$IFNDEF FPC} + // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding + // $IF or $IFDEF so the follwing will give you an error in delphi: + // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF} + // The reason for this error is that FPC_VERSION is not a valid constant. + // To avoid this error, we define dummys here. + FPC_VERSION = 0; + FPC_RELEASE = 0; + FPC_PATCH = 0; + {$ENDIF} + + FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) + + (FPC_RELEASE * VERSION_MINOR) + + (FPC_PATCH * VERSION_RELEASE); + + + {$IFDEF HaveFFmpeg} + + LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) + + (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) + + (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE); + + LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) + + (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + + (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); + + {$IFDEF HaveSWScale} + LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + + (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + + (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$ENDIF} + + {$IFDEF HaveProjectM} + PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + + (PROJECTM_VERSION_MINOR * VERSION_MINOR) + + (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HavePortaudio} + PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + + (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + + (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$IFDEF HaveLibsamplerate} + LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) + + (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) + + (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + +function USDXVersionStr(): string; +function USDXShortVersionStr(): string; + +implementation + +uses + StrUtils, Math; + +function USDXShortVersionStr(): string; +begin + Result := + USDX_STRING + + IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE); +end; + +function USDXVersionStr(): string; +begin + Result := + USDX_STRING + ' V ' + + IntToStr(USDX_VERSION_MAJOR) + '.' + + IntToStr(USDX_VERSION_MINOR) + '.' + + IntToStr(USDX_VERSION_RELEASE) + + IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) + + ' Build'; +end; + +end. diff --git a/src/base/UCore.pas b/src/base/UCore.pas new file mode 100644 index 00000000..fe23a68e --- /dev/null +++ b/src/base/UCore.pas @@ -0,0 +1,525 @@ +unit UCore; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + uPluginDefs, + uCoreModule, + UHooks, + UServices, + UModules; + +{********************* + TCore + Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process + Also it does some Error Handling, and maybe sometime multithreaded Loading ;) +*********************} + +type + TModuleListItem = record + Module: TCoreModule; //Instance of the Modules Class + Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc + NeedsDeInit: Boolean; //True if Module was succesful inited + end; + + TCore = class + private + //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos + hLoadingFinished: THandle; + hMainLoop: THandle; + hTranslate: THandle; + hLoadTextures: THandle; + hExitQuery: THandle; + hExit: THandle; + hDebug: THandle; + hError: THandle; + sReportError: THandle; + sReportDebug: THandle; + sShowMessage: THandle; + sRetranslate: THandle; + sReloadTextures: THandle; + sGetModuleInfo: THandle; + sGetApplicationHandle: THandle; + + Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + + //Cur + Last Executed Setting and Getting ;) + iCurExecuted: Integer; + iLastExecuted: Integer; + + procedure SetCurExecuted(Value: Integer); + + //Function Get all Modules and Creates them + function GetModules: Boolean; + + //Loads Core and all Modules + function Load: Boolean; + + //Inits Core and all Modules + function Init: Boolean; + + //DeInits Core and all Modules + function DeInit: Boolean; + + //Load the Core + function LoadCore: Boolean; + + //Init the Core + function InitCore: Boolean; + + //DeInit the Core + function DeInitCore: Boolean; + + //Called one Time per Frame + function MainLoop: Boolean; + + public + Hooks: THookManager; //Teh Hook Manager ;) + Services: TServiceManager;//The Service Manager + + Name: String; //Name of this Application + Version: LongWord; //Version of this ". For Info Look PluginDefs Functions + + LastErrorReporter:String; //Who Reported the Last Error String + LastErrorString: String; //Last Error String reported + + property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed + property LastExecuted: Integer read iLastExecuted; + + //--------------- + //Main Methods to control the Core: + //--------------- + constructor Create(const cName: String; const cVersion: LongWord); + + //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown + procedure Run; + + //Method for other Classes to get Pointer to a specific Module + function GetModulebyName(const Name: String): PCoreModule; + + //-------------- + // Hook and Service Procs: + //-------------- + function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) + function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) + function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook + function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook + function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam + function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle + end; + +var + Core: TCore; + +implementation + +uses + {$IFDEF win32} + Windows, + {$ENDIF} + SysUtils; + +//------------- +// Create - Creates Class + Hook and Service Manager +//------------- +constructor TCore.Create(const cName: String; const cVersion: LongWord); +begin + inherited Create; + + Name := cName; + Version := cVersion; + iLastExecuted := 0; + iCurExecuted := 0; + + LastErrorReporter := ''; + LastErrorString := ''; + + Hooks := THookManager.Create(50); + Services := TServiceManager.Create; +end; + +//------------- +//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown +//------------- +procedure TCore.Run; +var + Success: Boolean; + + procedure HandleError(const ErrorMsg: string); + begin + if (LastErrorString <> '') then + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) + else + Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); + + //DeInit + DeInit; + end; + +begin + //Get Modules + try + Success := GetModules(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error Getting Modules'); + Exit; + end; + + //Loading + try + Success := Load(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error loading Modules'); + Exit; + end; + + //Init + try + Success := Init(); + except + Success := False; + end; + + if (not Success) then + begin + HandleError('Error initing Modules'); + Exit; + end; + + //Call Translate Hook + if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then + begin + HandleError('Error translating'); + Exit; + end; + + //Calls LoadTextures Hook + if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then + begin + HandleError('Error loading textures'); + Exit; + end; + + //Calls Loading Finished Hook + if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then + begin + HandleError('Error calling LoadingFinished Hook'); + Exit; + end; + + //Start MainLoop + while Success do + begin + Success := MainLoop(); + // to-do : Call Display Draw here + end; +end; + +//------------- +//Called one Time per Frame +//------------- +function TCore.MainLoop: Boolean; +begin + Result := False; +end; + +//------------- +//Function Get all Modules and Creates them +//------------- +function TCore.GetModules: Boolean; +var + i: Integer; +begin + Result := False; + for i := 0 to high(Modules) do + begin + try + Modules[i].NeedsDeInit := False; + Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; + Modules[i].Module.Info(@Modules[i].Info); + except + ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + Exit; + end; + end; + Result := True; +end; + +//------------- +//Loads Core and all Modules +//------------- +function TCore.Load: Boolean; +var + i: Integer; +begin + Result := LoadCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Load; + except + Result := False; + end; + + if (not Result) then + begin + ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + end; +end; + +//------------- +//Inits Core and all Modules +//------------- +function TCore.Init: Boolean; +var + i: Integer; +begin + Result := InitCore; + + for i := 0 to High(CORE_MODULES_TO_LOAD) do + begin + try + Result := Modules[i].Module.Init; + except + Result := False; + end; + + if (not Result) then + begin + ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + break; + end; + + Modules[i].NeedsDeInit := Result; + end; +end; + +//------------- +//DeInits Core and all Modules +//------------- +function TCore.DeInit: boolean; +var + i: integer; +begin + + for i := High(CORE_MODULES_TO_LOAD) downto 0 do + begin + try + if (Modules[i].NeedsDeInit) then + Modules[i].Module.DeInit; + except + end; + end; + + DeInitCore; + + Result := true; +end; + +//------------- +//Load the Core +//------------- +function TCore.LoadCore: Boolean; +begin + hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); + hMainLoop := Hooks.AddEvent('Core/MainLoop'); + hTranslate := Hooks.AddEvent('Core/Translate'); + hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); + hExitQuery := Hooks.AddEvent('Core/ExitQuery'); + hExit := Hooks.AddEvent('Core/Exit'); + hDebug := Hooks.AddEvent('Core/NewDebugInfo'); + hError := Hooks.AddEvent('Core/NewError'); + + sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); + sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); + sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); + sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); + sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); + sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); + sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); + + //A little Test + Hooks.AddSubscriber('Core/NewError', HookTest); + + result := true; +end; + +//------------- +//Init the Core +//------------- +function TCore.InitCore: Boolean; +begin + //Don not init something atm. + result := true; +end; + +//------------- +//DeInit the Core +//------------- +function TCore.DeInitCore: Boolean; +begin + // TODO: write TService-/HookManager.Free and call it here + Result := true; +end; + +//------------- +//Method for other classes to get pointer to a specific module +//------------- +function TCore.GetModuleByName(const Name: String): PCoreModule; +var i: Integer; +begin + Result := nil; + for i := 0 to High(Modules) do + begin + if (Modules[i].Info.Name = Name) then + begin + Result := @Modules[i].Module; + Break; + end; + end; +end; + +//------------- +// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) +//------------- +function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; +{$IFDEF MSWINDOWS} +var Params: Cardinal; +{$ENDIF} +begin + Result := -1; + + {$IFDEF MSWINDOWS} + if (lParam <> nil) then + begin + Params := MB_OK; + case wParam of + CORE_SM_ERROR: Params := Params or MB_ICONERROR; + CORE_SM_WARNING: Params := Params or MB_ICONWARNING; + CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; + end; + + //Show: + Result := Messagebox(0, lParam, PChar(Name), Params); + end; + {$ENDIF} + + // TODO: write ShowMessage for other OSes +end; + +//------------- +// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; +begin + //Update LastErrorReporter and LastErrorString + LastErrorReporter := String(PChar(lParam)); + LastErrorString := String(PChar(Pointer(wParam))); + + Hooks.CallEventChain(hError, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) +//------------- +function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hDebug, wParam, lParam); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls Translate hook +//------------- +function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hTranslate, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// Calls LoadTextures hook +//------------- +function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; +begin + Hooks.CallEventChain(hLoadTextures, 1, nil); + + // FIXME: return a correct result + Result := 0; +end; + +//------------- +// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam +//------------- +function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; +var + I: integer; +begin + if (Pointer(lParam) = nil) then + begin + Result := Length(Modules); + end + else + begin + try + for I := 0 to High(Modules) do + begin + AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; + AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; + AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; + end; + Result := Length(Modules); + except + Result := -1; + end; + end; +end; + +//------------- +// Returns Application Handle +//------------- +function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; +begin + Result := hInstance; +end; + +//------------- +// Called when setting CurExecuted +//------------- +procedure TCore.SetCurExecuted(Value: Integer); +begin + //Set Last Executed + iLastExecuted := iCurExecuted; + + //Set Cur Executed + iCurExecuted := Value; +end; + +end. diff --git a/src/base/UCoreModule.pas b/src/base/UCoreModule.pas new file mode 100644 index 00000000..031fb04e --- /dev/null +++ b/src/base/UCoreModule.pas @@ -0,0 +1,128 @@ +unit UCoreModule; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{********************* + TCoreModule + Dummy Class that has Methods that will be called from Core + In the Best case every Piece of this Software is a Module +*********************} +uses UPluginDefs; + +type + PCoreModule = ^TCoreModule; + TCoreModule = class + public + Constructor Create; virtual; + + //Function that gives some Infos about the Module to the Core + Procedure Info(const pInfo: PModuleInfo); virtual; + + //Is Called on Loading. + //In this Method only Events and Services should be created + //to offer them to other Modules or Plugins during the Init process + //If False is Returned this will cause a Forced Exit + Function Load: Boolean; virtual; + + //Is Called on Init Process + //In this Method you can Hook some Events and Create + Init + //your Classes, Variables etc. + //If False is Returned this will cause a Forced Exit + Function Init: Boolean; virtual; + + //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing + //If False is Returned this will cause a Forced Exit + Function MainLoop: Boolean; virtual; + + //Is Called if this Module has been Inited and there is a Exit. + //Deinit is in backwards Initing Order + //If False is Returned this will cause a Forced Exit + Procedure DeInit; virtual; + + //Is Called if this Module will be unloaded and has been created + //Should be used to Free Memory + Destructor Destroy; override; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) + inherited; +end; + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TCoreModule.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'Not Set'; + pInfo^.Version := 0; + pInfo^.Description := 'Not Set'; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Load: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.Init: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing +//If False is Returned this will cause a Forced Exit +//------------- +Function TCoreModule.MainLoop: Boolean; +begin + //Dummy ftw!! + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TCoreModule.DeInit; +begin + //Dummy ftw!! +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TCoreModule.Destroy; +begin + //Dummy ftw!! + inherited; +end; + +end. diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas new file mode 100644 index 00000000..7bb57b4a --- /dev/null +++ b/src/base/UCovers.pas @@ -0,0 +1,430 @@ +unit UCovers; + +{ + TODO: + - adjust database to new song-loading (e.g. use SongIDs) + - support for deletion of outdated covers + - support for update of changed covers + - use paths relative to the song for removable disks support + (a drive might have a different drive-name the next time it is connected, + so "H:/songs/..." will not match "I:/songs/...") +} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + sdl, + SQLite3, + SQLiteTable3, + SysUtils, + Classes, + UImage, + UTexture; + +type + ECoverDBException = class(Exception) + end; + + TCover = class + private + ID: int64; + Filename: WideString; + public + constructor Create(ID: int64; Filename: WideString); + function GetPreviewTexture(): TTexture; + function GetTexture(): TTexture; + end; + + TThumbnailInfo = record + CoverWidth: integer; // Original width of cover + CoverHeight: integer; // Original height of cover + PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail + end; + + TCoverDatabase = class + private + DB: TSQLiteDatabase; + procedure InitCoverDatabase(); + function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; + function LoadCover(CoverID: int64): TTexture; + procedure DeleteCover(CoverID: int64); + function FindCoverIntern(const Filename: WideString): int64; + procedure Open(); + function GetVersion(): integer; + procedure SetVersion(Version: integer); + public + constructor Create(); + destructor Destroy; override; + function AddCover(const Filename: WideString): TCover; + function FindCover(const Filename: WideString): TCover; + function CoverExists(const Filename: WideString): boolean; + function GetMaxCoverSize(): integer; + procedure SetMaxCoverSize(Size: integer); + end; + + TBlobWrapper = class(TCustomMemoryStream) + function Write(const Buffer; Count: Integer): Integer; override; + end; + +var + Covers: TCoverDatabase; + +implementation + +uses + UMain, + ULog, + UPlatform, + UIni, + Math, + DateUtils; + +const + COVERDB_FILENAME = 'cover.db'; + COVERDB_VERSION = 01; // 0.1 + COVER_TBL = 'Cover'; + COVER_THUMBNAIL_TBL = 'CoverThumbnail'; + COVER_IDX = 'Cover_Filename_IDX'; + +// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC +function DateTimeToUnixTime(time: TDateTime): int64; +begin + Result := Round((time - UnixDateDelta) * SecsPerDay); +end; + +// Note: DateUtils.UnixToDateTime() will throw an exception in FPC +function UnixTimeToDateTime(timestamp: int64): TDateTime; +begin + Result := timestamp / SecsPerDay + UnixDateDelta; +end; + + +{ TBlobWrapper } + +function TBlobWrapper.Write(const Buffer; Count: Integer): Integer; +begin + SetPointer(Pointer(Buffer), Count); + Result := Count; +end; + + +{ TCover } + +constructor TCover.Create(ID: int64; Filename: WideString); +begin + Self.ID := ID; + Self.Filename := Filename; +end; + +function TCover.GetPreviewTexture(): TTexture; +begin + Result := Covers.LoadCover(ID); +end; + +function TCover.GetTexture(): TTexture; +begin + Result := Texture.LoadTexture(Filename); +end; + + +{ TCoverDatabase } + +constructor TCoverDatabase.Create(); +begin + inherited; + + Open(); + InitCoverDatabase(); +end; + +destructor TCoverDatabase.Destroy; +begin + DB.Free; + inherited; +end; + +function TCoverDatabase.GetVersion(): integer; +begin + Result := DB.GetTableValue('PRAGMA user_version'); +end; + +procedure TCoverDatabase.SetVersion(Version: integer); +begin + DB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); +end; + +function TCoverDatabase.GetMaxCoverSize(): integer; +begin + Result := ITextureSizeVals[Ini.TextureSize]; +end; + +procedure TCoverDatabase.SetMaxCoverSize(Size: integer); +var + I: integer; +begin + // search for first valid cover-size > Size + for I := 0 to Length(ITextureSizeVals)-1 do + begin + if (Size <= ITextureSizeVals[I]) then + begin + Ini.TextureSize := I; + Exit; + end; + end; + + // fall-back to highest size + Ini.TextureSize := High(ITextureSizeVals); +end; + +procedure TCoverDatabase.Open(); +var + Version: integer; + Filename: string; +begin + Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME); + + DB := TSQLiteDatabase.Create(Filename); + Version := GetVersion(); + + // check version, if version is too old/new, delete database file + if ((Version <> 0) and (Version <> COVERDB_VERSION)) then + begin + Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open'); + // close and delete outdated file + DB.Free; + if (not DeleteFile(Filename)) then + raise ECoverDBException.Create('Could not delete ' + Filename); + // reopen + DB := TSQLiteDatabase.Create(Filename); + Version := 0; + end; + + // set version number after creation + if (Version = 0) then + SetVersion(COVERDB_VERSION); + + // speed-up disk-writing. The default FULL-synchronous mode is too slow. + // With this option disk-writing is approx. 4 times faster but the database + // might be corrupted if the OS crashes, although this is very unlikely. + DB.ExecSQL('PRAGMA synchronous = OFF;'); + + // the next line rather gives a slow-down instead of a speed-up, so we do not use it + //DB.ExecSQL('PRAGMA temp_store = MEMORY;'); +end; + +procedure TCoverDatabase.InitCoverDatabase(); +begin + DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' + + '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' + + '[Filename] TEXT UNIQUE NOT NULL, ' + + '[Date] INTEGER NOT NULL, ' + + '[Width] INTEGER NOT NULL, ' + + '[Height] INTEGER NOT NULL ' + + ')'); + + DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' + + '[Filename] ASC' + + ')'); + + DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' + + '[ID] INTEGER NOT NULL PRIMARY KEY, ' + + '[Format] INTEGER NOT NULL, ' + + '[Width] INTEGER NOT NULL, ' + + '[Height] INTEGER NOT NULL, ' + + '[Data] BLOB NULL' + + ')'); +end; + +function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64; +begin + Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' + + 'WHERE [Filename] = ?', + [UTF8Encode(Filename)]); +end; + +function TCoverDatabase.FindCover(const Filename: WideString): TCover; +var + CoverID: int64; +begin + Result := nil; + try + CoverID := FindCoverIntern(Filename); + if (CoverID > 0) then + Result := TCover.Create(CoverID, Filename); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.FindCover'); + end; +end; + +function TCoverDatabase.CoverExists(const Filename: WideString): boolean; +begin + Result := false; + try + Result := (FindCoverIntern(Filename) > 0); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.CoverExists'); + end; +end; + +function TCoverDatabase.AddCover(const Filename: WideString): TCover; +var + CoverID: int64; + Thumbnail: PSDL_Surface; + CoverData: TBlobWrapper; + FileDate: TDateTime; + Info: TThumbnailInfo; +begin + Result := nil; + + //if (not FileExists(Filename)) then + // Exit; + + // TODO: replace '\' with '/' in filename + FileDate := Now(); //FileDateToDateTime(FileAge(Filename)); + + Thumbnail := CreateThumbnail(Filename, Info); + if (Thumbnail = nil) then + Exit; + + CoverData := TBlobWrapper.Create; + CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch); + + try + // Note: use a transaction to speed-up file-writing. + // Without data written by the first INSERT might be moved at the second INSERT. + DB.BeginTransaction(); + + // add general cover info + DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' + + '([Filename], [Date], [Width], [Height]) VALUES' + + '(?, ?, ?, ?)', + [UTF8Encode(Filename), DateTimeToUnixTime(FileDate), + Info.CoverWidth, Info.CoverHeight]); + + // get auto-generated cover ID + CoverID := DB.GetLastInsertRowID(); + + // add thumbnail info + DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' + + '([ID], [Format], [Width], [Height], [Data]) VALUES' + + '(?, ?, ?, ?, ?)', + [CoverID, Ord(Info.PixelFormat), + Thumbnail^.w, Thumbnail^.h, CoverData]); + + Result := TCover.Create(CoverID, Filename); + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.AddCover'); + end; + + DB.Commit(); + CoverData.Free; + SDL_FreeSurface(Thumbnail); +end; + +function TCoverDatabase.LoadCover(CoverID: int64): TTexture; +var + Width, Height: integer; + PixelFmt: TImagePixelFmt; + Data: PChar; + DataSize: integer; + Filename: WideString; + Table: TSQLiteUniTable; +begin + Table := nil; + + try + Table := DB.GetUniTable(Format( + 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' + + 'FROM ['+COVER_TBL+'] C ' + + 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' + + 'USING(ID) ' + + 'WHERE [ID] = %d', [CoverID])); + + Filename := UTF8Decode(Table.FieldAsString(0)); + PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1)); + Width := Table.FieldAsInteger(2); + Height := Table.FieldAsInteger(3); + + Data := Table.FieldAsBlobPtr(4, DataSize); + if (Data <> nil) and + (PixelFmt = ipfRGB) then + begin + Result := Texture.CreateTexture(Data, Filename, Width, Height, 24) + end + else + begin + FillChar(Result, SizeOf(TTexture), 0); + end; + except on E: Exception do + Log.LogError(E.Message, 'TCoverDatabase.LoadCover'); + end; + + Table.Free; +end; + +procedure TCoverDatabase.DeleteCover(CoverID: int64); +begin + DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID])); + DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID])); +end; + +(** + * Returns a pointer to an array of bytes containing the texture data in the + * requested size + *) +function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; +var + TargetAspect, SourceAspect: double; + //TargetWidth, TargetHeight: integer; + Thumbnail: PSDL_Surface; + MaxSize: integer; +begin + Result := nil; + + MaxSize := GetMaxCoverSize(); + + Thumbnail := LoadImage(Filename); + if (not assigned(Thumbnail)) then + begin + Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover'); + Exit; + end; + + // Convert pixel format as needed + AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN); + + Info.CoverWidth := Thumbnail^.w; + Info.CoverHeight := Thumbnail^.h; + Info.PixelFormat := ipfRGB; + + (* TODO: keep aspect ratio + TargetAspect := Width / Height; + SourceAspect := TexSurface.w / TexSurface.h; + + // Scale texture to covers dimensions (keep aspect) + if (SourceAspect >= TargetAspect) then + begin + TargetWidth := Width; + TargetHeight := Trunc(Width / SourceAspect); + end + else + begin + TargetHeight := Height; + TargetWidth := Trunc(Height * SourceAspect); + end; + *) + + // TODO: do not scale if image is smaller + ScaleImage(Thumbnail, MaxSize, MaxSize); + + Result := Thumbnail; +end; + +end. + diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas new file mode 100644 index 00000000..3d32a72a --- /dev/null +++ b/src/base/UDLLManager.pas @@ -0,0 +1,253 @@ +unit UDLLManager; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses ModiSDK, + UFiles; + +type + TDLLMan = class + private + hLib: THandle; + P_Init: fModi_Init; + P_Draw: fModi_Draw; + P_Finish: fModi_Finish; + P_RData: pModi_RData; + public + Plugins: array of TPluginInfo; + PluginPaths: array of String; + Selected: ^TPluginInfo; + + constructor Create; + + procedure GetPluginList; + procedure ClearPluginInfo(No: Cardinal); + function LoadPluginInfo(Filename: String; No: Cardinal): boolean; + + function LoadPlugin(No: Cardinal): boolean; + procedure UnLoadPlugin; + + function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; + function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; + function PluginFinish (var Playerinfo: TPlayerinfo): byte; + procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); + end; + +var + DLLMan: TDLLMan; + +const + DLLPath = 'Plugins'; + + {$IFDEF MSWINDOWS} + DLLExt = '.dll'; + {$ENDIF} + {$IFDEF LINUX} + DLLExt = '.so'; + {$ENDIF} + {$IFDEF DARWIN} + DLLExt = '.dylib'; + {$ENDIF} + +implementation + +uses {$IFDEF MSWINDOWS} + windows, + {$ELSE} + dynlibs, + {$ENDIF} + ULog, + SysUtils; + + +constructor TDLLMan.Create; +begin + inherited; + SetLength(Plugins, 0); + SetLength(PluginPaths, Length(Plugins)); + GetPluginList; +end; + +procedure TDLLMan.GetPluginList; +var + SR: TSearchRec; +begin + + if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then + begin + repeat + SetLength(Plugins, Length(Plugins)+1); + SetLength(PluginPaths, Length(Plugins)); + + if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful + begin + PluginPaths[High(PluginPaths)] := SR.Name; + end + else //Error Loading + begin + SetLength(Plugins, Length(Plugins)-1); + SetLength(PluginPaths, Length(Plugins)); + end; + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +procedure TDLLMan.ClearPluginInfo(No: Cardinal); +begin + //Set to Party Modi Plugin + Plugins[No].Typ := 8; + + Plugins[No].Name := 'unknown'; + Plugins[No].NumPlayers := 0; + + Plugins[No].Creator := 'Nobody'; + Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; + + Plugins[No].LoadSong := True; + Plugins[No].ShowScore := True; + Plugins[No].ShowBars := False; + Plugins[No].ShowNotes := True; + Plugins[No].LoadVideo := True; + Plugins[No].LoadBack := True; + + Plugins[No].TeamModeOnly := False; + Plugins[No].GetSoundData := False; + Plugins[No].Dummy := False; + + + Plugins[No].BGShowFull := False; + Plugins[No].BGShowFull_O := True; + + Plugins[No].ShowRateBar:= False; + Plugins[No].ShowRateBar_O := True; + + Plugins[No].EnLineBonus := False; + Plugins[No].EnLineBonus_O := True; +end; + +function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; +var + hLibg: THandle; + Info: pModi_PluginInfo; + I: Integer; +begin + Result := False; + //Clear Plugin Info + ClearPluginInfo(No); + + {//Workaround Plugins Loaded 2 Times + For I := low(PluginPaths) to high(PluginPaths) do + if (PluginPaths[I] = Filename) then + exit; } + + //Load Libary + hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename)); + //If Loaded + if (hLibg <> 0) then + begin + //Load Info Procedure + @Info := GetProcAddress (hLibg, PChar('PluginInfo')); + + //If Loaded + if (@Info <> nil) then + begin + //Load PluginInfo + Info (Plugins[No]); + Result := True; + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); + + FreeLibrary (hLibg); + end + else + Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); +end; + +function TDLLMan.LoadPlugin(No: Cardinal): boolean; +begin + Result := False; + //Load Libary + hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No])); + //If Loaded + if (hLib <> 0) then + begin + //Load Info Procedure + @P_Init := GetProcAddress (hLib, PChar('Init')); + @P_Draw := GetProcAddress (hLib, PChar('Draw')); + @P_Finish := GetProcAddress (hLib, PChar('Finish')); + + //If Loaded + if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then + begin + Selected := @Plugins[No]; + Result := True; + end + else + begin + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); + + end; + end + else + Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); +end; + +procedure TDLLMan.UnLoadPlugin; +begin +if (hLib <> 0) then + FreeLibrary (hLib); + +//Selected := nil; +@P_Init := nil; +@P_Draw := nil; +@P_Finish := nil; +@P_RData := nil; +end; + +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; +var + Methods: TMethodRec; +begin + Methods.LoadTex := LoadTex; + Methods.Print := Print; + Methods.LoadSound := LoadSound; + Methods.PlaySound := PlaySound; + + if (@P_Init <> nil) then + Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) + else + Result := False +end; + +function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; +begin +if (@P_Draw <> nil) then + Result := P_Draw (PlayerInfo, CurSentence) +else + Result := False +end; + +function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; +begin +if (@P_Finish <> nil) then + Result := P_Finish (PlayerInfo) +else + Result := 0; +end; + +procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); +begin +if (@P_RData <> nil) then + P_RData (handle, buffer, len, user); +end; + +end. diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas new file mode 100644 index 00000000..cd315df3 --- /dev/null +++ b/src/base/UDataBase.pas @@ -0,0 +1,533 @@ +unit UDataBase; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses USongs, + USong, + Classes, + SQLiteTable3; + +//-------------------- +//DataBaseSystem - Class including all DB Methods +//-------------------- +type + TStatType = ( + stBestScores, // Best Scores + stBestSingers, // Best Singers + stMostSungSong, // Most sung Songs + stMostPopBand // Most popular Band + ); + + // abstract super-class for statistic results + TStatResult = class + public + Typ: TStatType; + end; + + TStatResultBestScores = class(TStatResult) + public + Singer: WideString; + Score: Word; + Difficulty: Byte; + SongArtist: WideString; + SongTitle: WideString; + end; + + TStatResultBestSingers = class(TStatResult) + public + Player: WideString; + AverageScore: Word; + end; + + TStatResultMostSungSong = class(TStatResult) + public + Artist: WideString; + Title: WideString; + TimesSung: Word; + end; + + TStatResultMostPopBand = class(TStatResult) + public + ArtistName: WideString; + TimesSungTot: Word; + end; + + + TDataBaseSystem = class + private + ScoreDB: TSQLiteDatabase; + fFilename: string; + + function GetVersion(): integer; + procedure SetVersion(Version: integer); + public + property Filename: string read fFilename; + + destructor Destroy; override; + + procedure Init(const Filename: string); + procedure ReadScore(Song: TSong); + procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); + procedure WriteScore(Song: TSong); + + function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; + procedure FreeStats(StatList: TList); + function GetTotalEntrys(Typ: TStatType): Cardinal; + function GetStatReset: TDateTime; + end; + +var + DataBase: TDataBaseSystem; + +implementation + +uses + ULog, + DateUtils, + StrUtils, + SysUtils; + +const + cDBVersion = 01; // 0.1 + cUS_Scores = 'us_scores'; + cUS_Songs = 'us_songs'; + cUS_Statistics_Info = 'us_statistics_info'; + +(** + * Opens Database and Create Tables if not Exist + *) +procedure TDataBaseSystem.Init(const Filename: string); +var + Version: integer; +begin + if Assigned(ScoreDB) then + Exit; + + Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init'); + + try + + // Open Database + ScoreDB := TSQLiteDatabase.Create(Filename); + fFilename := Filename; + + // Close and delete outdated file + Version := GetVersion(); + if ((Version <> 0) and (Version <> cDBVersion)) then + begin + Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init'); + // Close and delete outdated file + ScoreDB.Free; + if (not DeleteFile(Filename)) then + raise Exception.Create('Could not delete ' + Filename); + // Reopen + ScoreDB := TSQLiteDatabase.Create(Filename); + Version := 0; + end; + + // Set version number after creation + if (Version = 0) then + SetVersion(cDBVersion); + + + // SQLite does not handle VARCHAR(n) or INT(n) as expected. + // Texts do not have a restricted length, no matter which type is used, + // so use the native TEXT type. INT(n) is always INTEGER. + // In addition, SQLiteTable3 will fail if other types than the native SQLite + // types are used (especially FieldAsInteger). Also take care to write the + // types in upper-case letters although SQLite does not care about this - + // SQLiteTable3 is very sensitive in this regard. + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' + + '[SongID] INTEGER NOT NULL, ' + + '[Difficulty] INTEGER NOT NULL, ' + + '[Player] TEXT NOT NULL, ' + + '[Score] INTEGER NOT NULL' + + ');'); + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' + + '[ID] INTEGER PRIMARY KEY, ' + + '[Artist] TEXT NOT NULL, ' + + '[Title] TEXT NOT NULL, ' + + '[TimesPlayed] INTEGER NOT NULL' + + ');'); + + if not ScoreDB.TableExists(cUS_Statistics_Info) then + begin + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + + '[ResetTime] INTEGER' + + ');'); + // insert creation timestamp + ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + + '([ResetTime]) VALUES(%d);', + [DateTimeToUnix(Now())])); + end; + + except + on E: Exception do + begin + Log.LogError(E.Message, 'TDataBaseSystem.Init'); + FreeAndNil(ScoreDB); + end; + end; + +end; + +(** + * Frees Database + *) +destructor TDataBaseSystem.Destroy; +begin + Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy'); + ScoreDB.Free; + inherited; +end; + +(** + * Read Scores into SongArray + *) +procedure TDataBaseSystem.ReadScore(Song: TSong); +var + TableData: TSQLiteUniTable; + Difficulty: Integer; +begin + if not Assigned(ScoreDB) then + Exit; + + TableData := nil; + + try + // Search Song in DB + TableData := ScoreDB.GetUniTable( + 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = (' + + 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'WHERE [Artist] = ? AND [Title] = ? ' + + 'LIMIT 1) ' + + 'ORDER BY [Score] DESC LIMIT 15', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + + // Empty Old Scores + SetLength(Song.Score[0], 0); + SetLength(Song.Score[1], 0); + SetLength(Song.Score[2], 0); + + // Go through all Entrys + while (not TableData.EOF) do + begin + // Add one Entry to Array + Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']); + if ((Difficulty >= 0) and (Difficulty <= 2)) and + (Length(Song.Score[Difficulty]) < 5) then + begin + SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); + + Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := + UTF8Decode(TableData.FieldByName['Player']); + Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := + TableData.FieldAsInteger(TableData.FieldIndex['Score']); + end; + + TableData.Next; + end; // while + + except + for Difficulty := 0 to 2 do + begin + SetLength(Song.Score[Difficulty], 1); + Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB'; + end; + end; + + TableData.Free; +end; + +(** + * Adds one new score to DB + *) +procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); +var + ID: Integer; + TableData: TSQLiteTable; +begin + if not Assigned(ScoreDB) then + Exit; + + // Prevent 0 Scores from being added + if (Score <= 0) then + Exit; + + TableData := nil; + + try + + ID := ScoreDB.GetTableValue( + 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'WHERE [Artist] = ? AND [Title] = ?', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + if (ID = 0) then + begin + // Create song if it does not exist + ScoreDB.ExecSQL( + 'INSERT INTO ['+cUS_Songs+'] ' + + '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' + + '(NULL, ?, ?, 0);', + [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + // Get song-ID + ID := ScoreDB.GetLastInsertRowID(); + end; + // Create new entry + ScoreDB.ExecSQL( + 'INSERT INTO ['+cUS_Scores+'] ' + + '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' + + '(?, ?, ?, ?);', + [ID, Level, UTF8Encode(Name), Score]); + + // Delete last position when there are more than 5 entrys. + // Fixes crash when there are > 5 ScoreEntrys + // Note: GetUniTable is not applicable here, as the results are used while + // table entries are deleted. + TableData := ScoreDB.GetTable( + 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + + '[Difficulty] = ' + InttoStr(Level) +' ' + + 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5'); + + while (not TableData.EOF) do + begin + // Note: Score is an int-value, so in contrast to Player, we do not bind + // this value. Otherwise we had to convert the string to an int to avoid + // an automatic cast of this field to the TEXT type (although it might even + // work that way). + ScoreDB.ExecSQL( + 'DELETE FROM ['+cUS_Scores+'] ' + + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + + '[Difficulty] = ' + InttoStr(Level) +' AND ' + + '[Player] = ? AND ' + + '[Score] = ' + TableData.FieldByName['Score'], + [TableData.FieldByName['Player']]); + + TableData.Next; + end; + + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.AddScore'); + end; + + TableData.Free; +end; + +(** + * Not needed with new System. + * Used for increment played count + *) +procedure TDataBaseSystem.WriteScore(Song: TSong); +begin + if not Assigned(ScoreDB) then + Exit; + + try + // Increase TimesPlayed + ScoreDB.ExecSQL( + 'UPDATE ['+cUS_Songs+'] ' + + 'SET [TimesPlayed] = [TimesPlayed] + 1 ' + + 'WHERE [Title] = ? AND [Artist] = ?;', + [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.WriteScore'); + end; +end; + +(** + * Writes some stats to array. + * Returns nil if the database is not ready or a list with zero or more statistic + * entries. + * Free the result-list with FreeStats() after usage to avoid memory leaks. + *) +function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; +var + Query: String; + TableData: TSQLiteUniTable; + Stat: TStatResult; +begin + Result := nil; + + if not Assigned(ScoreDB) then + Exit; + + {Todo: Add Prevention that only players with more than 5 scores are selected at type 2} + + // Create query + case Typ of + stBestScores: begin + Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' + + 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]'; + end; + stBestSingers: begin + Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' + + 'GROUP BY [Player] ORDER BY AVG([Score])'; + end; + stMostSungSong: begin + Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' + + 'ORDER BY [TimesPlayed]'; + end; + stMostPopBand: begin + Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' + + 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])'; + end; + end; + + // Add order direction + Query := Query + IfThen(Reversed, ' ASC', ' DESC'); + + // Add limit + Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; + + // Execute query + try + TableData := ScoreDB.GetUniTable(Query); + except + on E: Exception do + begin + Log.LogError(E.Message, 'TDataBaseSystem.GetStats'); + Exit; + end; + end; + + Result := TList.Create; + Stat := nil; + + // Copy result to stats array + while not TableData.EOF do + begin + case Typ of + stBestScores: begin + Stat := TStatResultBestScores.Create; + with TStatResultBestScores(Stat) do + begin + Singer := UTF8Decode(TableData.Fields[0]); + Difficulty := TableData.FieldAsInteger(1); + Score := TableData.FieldAsInteger(2); + SongArtist := UTF8Decode(TableData.Fields[3]); + SongTitle := UTF8Decode(TableData.Fields[4]); + end; + end; + stBestSingers: begin + Stat := TStatResultBestSingers.Create; + with TStatResultBestSingers(Stat) do + begin + Player := UTF8Decode(TableData.Fields[0]); + AverageScore := TableData.FieldAsInteger(1); + end; + end; + stMostSungSong: begin + Stat := TStatResultMostSungSong.Create; + with TStatResultMostSungSong(Stat) do + begin + Artist := UTF8Decode(TableData.Fields[0]); + Title := UTF8Decode(TableData.Fields[1]); + TimesSung := TableData.FieldAsInteger(2); + end; + end; + stMostPopBand: begin + Stat := TStatResultMostPopBand.Create; + with TStatResultMostPopBand(Stat) do + begin + ArtistName := UTF8Decode(TableData.Fields[0]); + TimesSungTot := TableData.FieldAsInteger(1); + end; + end + else + Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats'); + end; + + Stat.Typ := Typ; + Result.Add(Stat); + + TableData.Next; + end; + + TableData.Free; +end; + +procedure TDataBaseSystem.FreeStats(StatList: TList); +var + I: integer; +begin + if (StatList = nil) then + Exit; + for I := 0 to StatList.Count-1 do + TStatResult(StatList[I]).Free; + StatList.Free; +end; + +(** + * Gets total number of entrys for a stats query + *) +function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal; +var + Query: String; +begin + Result := 0; + + if not Assigned(ScoreDB) then + Exit; + + try + // Create query + case Typ of + stBestScores: + Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];'; + stBestSingers: + Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];'; + stMostSungSong: + Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];'; + stMostPopBand: + Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];'; + end; + + Result := ScoreDB.GetTableValue(Query); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys'); + end; + +end; + +(** + * Gets reset date of statistic data + *) +function TDataBaseSystem.GetStatReset: TDateTime; +var + Query: string; + ResetTime: int64; +begin + Result := 0; + + if not Assigned(ScoreDB) then + Exit; + + try + Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];'; + Result := UnixToDateTime(ScoreDB.GetTableValue(Query)); + except on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset'); + end; +end; + +function TDataBaseSystem.GetVersion(): integer; +begin + Result := ScoreDB.GetTableValue('PRAGMA user_version'); +end; + +procedure TDataBaseSystem.SetVersion(Version: integer); +begin + ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); +end; + +end. diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas new file mode 100644 index 00000000..ff0920f5 --- /dev/null +++ b/src/base/UDraw.pas @@ -0,0 +1,1390 @@ +unit UDraw; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UThemes, + ModiSDK, + UGraphicClasses; + +procedure SingDraw; +procedure SingModiDraw (PlayerInfo: TPlayerInfo); +procedure SingDrawBackground; +procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +procedure SingDrawLyricHelper(Left, LyricsMid: real); +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); +procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); +procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +//Draw Editor NoteLines +procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); + + +type + TRecR = record + Top: real; + Left: real; + Right: real; + Bottom: real; + + Width: real; + WMid: real; + Height: real; + HMid: real; + + Mid: real; + end; + +var + NotesW: real; + NotesH: real; + Starfr: integer; + StarfrG: integer; + + //SingBar + TickOld: cardinal; + TickOld2:cardinal; + +const + Przedz = 32; + +implementation + +uses + gl, + UGraphic, + SysUtils, + UMusic, + URecord, + ULog, + UScreenSing, + UScreenSingModi, + ULyrics, + UMain, + TextGL, + UTexture, + UDrawTexture, + UIni, + Math, + UDLLManager; + +procedure SingDrawBackground; +var + Rec: TRecR; + TexRec: TRecR; +begin + if (ScreenSing.Tex_Background.TexNum > 0) then begin + + glClearColor (1, 1, 1, 1); + glColor4f (1, 1, 1, 1); + + if (Ini.MovieSize <= 1) then //HalfSize BG + begin + (* half screen + gradient *) + Rec.Top := 110; // 80 + Rec.Bottom := Rec.Top + 20; + Rec.Left := 0; + Rec.Right := 800; + + TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + TexRec.Left := 0; + TexRec.Right := ScreenSing.Tex_Background.TexW; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); + glEnable(GL_BLEND); + glBegin(GL_QUADS); + (* gradient draw *) + (* top *) + glColor4f(1, 1, 1, 0); + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glColor4f(1, 1, 1, 1); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + (* mid *) + Rec.Top := Rec.Bottom; + Rec.Bottom := 490 - 20; // 490 - 20 + TexRec.Top := TexRec.Bottom; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + (* bottom *) + Rec.Top := Rec.Bottom; + Rec.Bottom := 490; // 490 + TexRec.Top := TexRec.Bottom; + TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; + glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); + glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); + glColor4f(1, 1, 1, 0); + glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); + + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end + else //Full Size BG + begin + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); + //glEnable(GL_BLEND); + glBegin(GL_QUADS); + + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600); + glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600); + glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0); + + glEnd; + glDisable(GL_TEXTURE_2D); + //glDisable(GL_BLEND); + end; + end; +end; + +procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); +var + SampleIndex: integer; + Sound: TCaptureBuffer; + MaxX, MaxY: real; +begin; + Sound := AudioInputProcessor.Sound[NrSound]; + + // Log.LogStatus('Oscilloscope', 'SingDraw'); + glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); + {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); } + + MaxX := W-1; + MaxY := (H-1) / 2; + + Sound.LockAnalysisBuffer(); + + glBegin(GL_LINE_STRIP); + for SampleIndex := 0 to High(Sound.AnalysisBuffer) do + begin + glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer), + Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint))); + end; + glEnd; + + Sound.UnlockAnalysisBuffer(); +end; + + + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Count: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Count := 0 to 9 do begin + glVertex2f(Left, Top + Count * Space); + glVertex2f(Right, Top + Count * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); +var + Count: integer; + TempR: real; +begin + TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin + if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top); + glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; + R,G,B: real; + + PlayerNumber: Integer; + + GoldenStarPos : real; + + lTmpA , + lTmpB : real; +begin +// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero +// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero +// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then +// BUT this is not implemented yet, all notes are drawn! :D + + PlayerNumber := NrLines + 1; // Player 1 is 0 + NrLines := 0; + +// exploit done + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + lTmpA := (Right-Left); + lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + + with Lines[NrLines].Line[Lines[NrLines].Current] do begin + for Count := 0 to HighNote do begin + with Note[Count] do begin + if NoteType <> ntFreestyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case NoteType of + ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could + end; // case + end //Else all Notes same Color + else + glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + // Czesci == teil, element == piece, element | koniec == end / ending + // lewa czesc - left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + //We keep the postion of the top left corner b4 it's overwritten + GoldenStarPos := Rec.Left; + //done + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length + + glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc - right part + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Golden Star Patch + if (NoteType = ntGolden) AND (Ini.EffectSing=1) then + begin + GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); + end; + + end; // if not FreeStyle + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + + +// draw sung notes +procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R, G, B, A: real; + NotesH2: real; +begin + //Log.LogStatus('Player notes', 'SingDraw'); + + //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') + //else LoadColor(R, G, B, 'P2Light'); + + //R := 71/255; + //G := 175/255; + //B := 247/255; + + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //if Player[NrGracza].LengthNote > 0 then + begin + TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start); + for N := 0 to Player[PlayerIndex].HighNote do + begin + with Player[PlayerIndex].Note[N] do + begin + // Left part of note + Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + + // Draw it in half size, if not hit + if Hit then + begin + NotesH2 := NotesH + end + else + begin + NotesH2 := int(NotesH * 0.65); + end; + + Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Middle part of the note + Rec.Left := Rec.Right; + Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Length-1 = LyricsState.CurrentBeatD) then + Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; + // the left note is more right than the right note itself, sounds weird - so we fix that xD + if Rec.Right <= Rec.Left then + Rec.Right := Rec.Left; + + // draw the middle part + glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glColor3f(1, 1, 1); + + // the right part of the note + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // Perfect note is stored + if Perfect and (Ini.EffectSing=1) then + begin + A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); + if not (Start+Length-1 = LyricsState.CurrentBeatD) then + begin + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; + end; // with + end; // for + + // actually we need a comparison here, to determine if the singing process + // is ahead Rec.Right even if there is no singing + + if (Ini.EffectSing = 1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; + + lTmpA , + lTmpB : real; +begin + if (Player[PlayerIndex].ScoreTotalInt >= 0) then + begin + glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 ); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + lTmpA := (Right-Left); + lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + + if ( lTmpA > 0 ) and + ( lTmpB > 0 ) then + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + if NoteType <> ntFreestyle then + begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc + Rec.Left := X2; + Rec.Right := X3; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc + Rec.Left := X3; + Rec.Right := X4; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + end; // if not FreeStyle + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +(** + * Draws the lyrics helper bar. + * Left: position the bar starts at + * LyricsMid: the middle of the lyrics relative to the position Left + *) +procedure SingDrawLyricHelper(Left, LyricsMid: real); +var + Bounds: TRecR; // bounds of the lyric help bar + BarProgress: real; // progress of the lyrics helper + BarMoveDelta: real; // current beat relative to the beat the bar starts to move at + BarAlpha: real; // transparency + CurLine: PLine; // current lyric line (beat specific) + LineWidth: real; // lyric line width + FirstNoteBeat: integer; // beat of the first note in the current line + FirstNoteDelta: integer; // time in beats between the start of the current line and its first note + MoveStartX: real; // x-pos. the bar starts to move from + MoveDist: real; // number of pixels the bar will move + LyricEngine: TLyricEngine; +const + BarWidth = 50; // width of the lyric helper bar + BarHeight = 30; // height of the lyric helper bar + BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move +begin + // get current lyrics line and the time in beats of its first note + CurLine := @Lines[0].Line[Lines[0].Current]; + + // FIXME: accessing ScreenSing is not that generic + LyricEngine := ScreenSing.Lyrics; + + // do not draw the lyrics helper if the current line does not contain any note + if (Length(CurLine.Note) > 0) then + begin + // start beat of the first note of this line + FirstNoteBeat := CurLine.Note[0].Start; + // time in beats between the start of the current line and its first note + FirstNoteDelta := FirstNoteBeat - CurLine.Start; + + // beats from current beat to the first note of the line + BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat; + + if (FirstNoteDelta > 8) and // if the wait-time is large enough + (BarMoveDelta > 0) then // and the first note of the line is not reached + begin + // let the bar blink to the beat + BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25; + + // if the number of beats to the first note is too big, + // the bar stays on the left side. + if (BarMoveDelta > BarMoveLimit) then + BarMoveDelta := BarMoveLimit; + + // limit number of beats the bar moves + if (FirstNoteDelta > BarMoveLimit) then + FirstNoteDelta := BarMoveLimit; + + // calc bar progress + BarProgress := 1 - BarMoveDelta / FirstNoteDelta; + + // retrieve the width of the upper lyrics line on the display + if (LyricEngine.GetUpperLine() <> nil) then + LineWidth := LyricEngine.GetUpperLine().Width + else + LineWidth := 0; + + // distance the bar will move (LyricRec.Left to beginning of text) + MoveDist := LyricsMid - LineWidth / 2 - BarWidth; + // if the line is too long the helper might move from right to left + // so we have to assure the start position is left of the text. + if (MoveDist >= 0) then + MoveStartX := Left + else + MoveStartX := Left + MoveDist; + + // determine lyric help bar position and size + Bounds.Left := MoveStartX + BarProgress * MoveDist; + Bounds.Right := Bounds.Left + BarWidth; + Bounds.Top := Skin_LyricsT + 3; + Bounds.Bottom := Bounds.Top + BarHeight + 3; + + // draw lyric help bar + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, BarAlpha); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top); + glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom); + glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom); + glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top); + glEnd; + glDisable(GL_BLEND); + end; + end; +end; + +procedure SingDraw; +var + NR: TRecR; // lyrics area bounds (NR = NoteRec?) + LyricEngine: TLyricEngine; +begin + // positions + if Ini.SingWindow = 0 then + NR.Left := 120 + else + NR.Left := 20; + + NR.Right := 780; + + NR.Width := NR.Right - NR.Left; + NR.WMid := NR.Width / 2; + NR.Mid := NR.Left + NR.WMid; + + // FIXME: accessing ScreenSing is not that generic + LyricEngine := ScreenSing.Lyrics; + + // background //BG Fullsize Mod + //SingDrawBackground; + + // draw time-bar + SingDrawTimeBar(); + + // draw note-lines + + if (PlayersPlay = 1) and (Ini.NoteLines = 1) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + + if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then + begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + end; + + if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + end; + + // draw Lyrics + LyricEngine.Draw(LyricsState.MidBeat); + SingDrawLyricHelper(NR.Left, NR.WMid); + + // oscilloscope + if Ini.Oscilloscope = 1 then begin + if PlayersPlay = 1 then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + + if PlayersPlay = 2 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + if ScreenAct = 2 then begin + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); + end; + end; + + if PlayersPlay = 3 then begin + SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + if ScreenAct = 2 then begin + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); + end; + end; + + end; + + // Set the note heights according to the difficulty level + case Ini.Difficulty of + 0: + begin + NotesH := 11; // 9 + NotesW := 6; // 5 + end; + 1: + begin + NotesH := 8; // 7 + NotesW := 4; // 4 + end; + 2: + begin + NotesH := 5; + NotesW := 3; + end; + end; + + // Draw the Notes + if PlayersPlay = 1 then begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + + if PlayersPlay = 3 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + end; + end; + + if PlayersPlay = 6 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + end; + end; + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +// q'n'd for using the game mode dll's +procedure SingModiDraw (PlayerInfo: TPlayerInfo); +var + Count: integer; + Pet2: integer; + TempR: real; + Rec: TRecR; + TexRec: TRecR; + NR: TRecR; + FS: real; + BarFrom: integer; + BarAlpha: real; + BarWspol: real; + TempCol: real; + Tekst: string; + PetCz: integer; +begin + // positions + if Ini.SingWindow = 0 then begin + NR.Left := 120; + end else begin + NR.Left := 20; + end; + + NR.Right := 780; + NR.Width := NR.Right - NR.Left; + NR.WMid := NR.Width / 2; + NR.Mid := NR.Left + NR.WMid; + + // time bar + SingDrawTimeBar(); + + if DLLMan.Selected.ShowNotes then + begin + if PlayersPlay = 1 then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + if (PlayersPlay = 2) or (PlayersPlay = 4) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + end; + + if (PlayersPlay = 3) or (PlayersPlay = 6) then begin + SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + end; + end; + + // Draw Lyrics + ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start; + if BarFrom > 40 then BarFrom := 40; + if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem + (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX; + Rec.Right := Rec.Left + 50; + Rec.Top := Skin_LyricsT + 3; + Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); + glBegin(GL_QUADS); + glColor4f(1, 1, 1, 0); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glColor4f(1, 1, 1, 0.5); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + glDisable(GL_BLEND); + end; + } + + // oscilloscope | the thing that moves when you yell into your mic (imho) + if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin + if PlayersPlay = 1 then + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + + if PlayersPlay = 2 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); + end; + end; + + if PlayersPlay = 3 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + + if PlayersPlay = 6 then begin + if ScreenAct = 1 then begin + if PlayerInfo.Playerinfo[0].Enabled then + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); + if PlayerInfo.Playerinfo[1].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); + if PlayerInfo.Playerinfo[2].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); + end; + if ScreenAct = 2 then begin + if PlayerInfo.Playerinfo[3].Enabled then + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); + if PlayerInfo.Playerinfo[4].Enabled then + SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); + if PlayerInfo.Playerinfo[5].Enabled then + SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); + end; + end; + + end; + +// resize the notes according to the difficulty level + case Ini.Difficulty of + 0: + begin + NotesH := 11; // 9 + NotesW := 6; // 5 + end; + 1: + begin + NotesH := 8; // 7 + NotesW := 4; // 4 + end; + 2: + begin + NotesH := 5; + NotesW := 3; + end; + end; + + if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then + begin + if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + + end; + + if PlayersPlay = 3 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + end; + end; + + if PlayersPlay = 6 then begin + NotesW := NotesW * 0.8; + NotesH := NotesH * 0.8; + + if ScreenAct = 1 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + end; + end; + end; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + + +{//SingBar Mod +procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); +var + R: Real; + G: Real; + B: Real; + A: cardinal; + I: Integer; + +begin; + + //SingBar Background + glColor4f(1, 1, 1, 0.8); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); + glTexCoord2f(1, 0); glVertex2f(X+W, Y); + glEnd; + + //SingBar coloured Bar + Case Percent of + 0..22: begin + R := 1; + G := 0; + B := 0; + end; + 23..42: begin + R := 1; + G := ((Percent-23)/100)*5; + B := 0; + end; + 43..57: begin + R := 1; + G := 1; + B := 0; + end; + 58..77: begin + R := 1-(Percent - 58)/100*5; + G := 1; + B := 0; + end; + 78..99: begin + R := 0; + G := 1; + B := 0; + end; + End; //Case + + glColor4f(R, G, B, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum); + //Size= Player[PlayerNum].ScorePercent of W + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); + glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y); + glEnd; + + //SingBar Front + glColor4f(1, 1, 1, 0.6); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y+H); + glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); + glTexCoord2f(1, 0); glVertex2f(X+W, Y); + glEnd; +end; +//end Singbar Mod + +//PhrasenBonus - Line Bonus Pop Up +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); +var +Length, X2: Real; //Length of Text +Size: Integer; //Size of Popup +begin +if Alpha <> 0 then +begin + +//Set Font Propertys +SetFontStyle(2); //Font: Outlined1 +if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6); +SetFontItalic(False); + +//Check Font Size +Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^ + +//Text +SetFontPos (X + 50 - (Length / 2), Y + 12); //Position + + +if Age < 5 then Size := Age * 10 else Size := 50; + + //Draw Background + //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color + glColor4f(1, 1, 1, Alpha); + + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + + //New Method, Not Variable + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); + glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); + glEnd; + + glColor4f(1, 1, 1, Alpha); //Set Color + //Draw Text + glPrint (PChar(Text)); +end; +end; +//PhrasenBonus - Line Bonus Mod} + +// Draw Note Bars for Editor +//There are 11 Resons for a new Procdedure: (nice binary :D ) +// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor +// 2. You can see the Freestyle Notes in the Editor SemiTransparent +// 3. Its easier and Faster then changing the old Procedure +procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); +var + Rec: TRecR; + Count: integer; + TempR: real; +begin + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + with Lines[NrLines].Line[Lines[NrLines].Current] do begin + for Count := 0 to HighNote do begin + with Note[Count] do begin + + // Golden Note Patch + case NoteType of + ntFreestyle: glColor4f(1, 1, 1, 0.35); + ntNormal: glColor4f(1, 1, 1, 0.85); + ntGolden: Glcolor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // srodkowa czesc - middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + + glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + // prawa czesc - right part + Rec.Left := Rec.Right; + Rec.Right := Rec.Right + NotesW; + + glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; + + end; // with + end; // for + end; // with + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +procedure SingDrawTimeBar(); +var + x,y: real; + width, height: real; + LyricsProgress: real; + CurLyricsTime: real; +begin + x := Theme.Sing.StaticTimeProgress.x; + y := Theme.Sing.StaticTimeProgress.y; + + width := Theme.Sing.StaticTimeProgress.w; + height := Theme.Sing.StaticTimeProgress.h; + + glColor4f(Theme.Sing.StaticTimeProgress.ColR, + Theme.Sing.StaticTimeProgress.ColG, + Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + + glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(x, y); + + CurLyricsTime := LyricsState.GetCurrentTime(); + if (CurLyricsTime > 0) and + (LyricsState.TotalTime > 0) then + begin + LyricsProgress := CurLyricsTime / LyricsState.TotalTime; + glTexCoord2f((width * LyricsProgress) / 8, 0); + glVertex2f(x + width * LyricsProgress, y); + + glTexCoord2f((width * LyricsProgress) / 8, 1); + glVertex2f(x + width * LyricsProgress, y + height); + end; + + glTexCoord2f(0, 1); + glVertex2f(x, y + height); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1, 1, 1, 1); +end; + +end. + diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas new file mode 100644 index 00000000..25e8423e --- /dev/null +++ b/src/base/UEditorLyrics.pas @@ -0,0 +1,229 @@ +unit UEditorLyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + gl, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TEditorLyrics = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + FontStyleI: integer; // font number + Word: array of TWord; + + procedure SetX(Value: real); + procedure SetY(Value: real); + function GetClientX: real; + procedure SetAlign(Value: integer); + function GetSize: real; + procedure SetSize(Value: real); + procedure SetSelected(Value: integer); + procedure SetFStyle(Value: integer); + procedure AddWord(Text: string); + procedure Refresh; + public + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + + constructor Create; + destructor Destroy; override; + + procedure AddLine(NrLine: integer); + + procedure Clear; + procedure Draw; + published + property X: real write SetX; + property Y: real write SetY; + property ClientX: real read GetClientX; + property Align: integer write SetAlign; + property Size: real read GetSize write SetSize; + property Selected: integer read SelectedI write SetSelected; + property FontStyle: integer write SetFStyle; + end; + +implementation + +uses + TextGL, UGraphic, UDrawTexture, Math, USkins; + +constructor TEditorLyrics.Create; +begin + inherited; +end; + +destructor TEditorLyrics.Destroy; +begin + SetLength(Word, 0); + inherited; +end; + +procedure TEditorLyrics.SetX(Value: real); +begin + XR := Value; +end; + +procedure TEditorLyrics.SetY(Value: real); +begin + YR := Value; +end; + +function TEditorLyrics.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TEditorLyrics.SetAlign(Value: integer); +begin + AlignI := Value; +end; + +function TEditorLyrics.GetSize: real; +begin + Result := SizeR; +end; + +procedure TEditorLyrics.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TEditorLyrics.SetSelected(Value: integer); +var + W: integer; +begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then + begin + Word[SelectedI].Selected := false; + Word[SelectedI].ColR := ColR; + Word[SelectedI].ColG := ColG; + Word[SelectedI].ColB := ColB; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then + begin + Word[Value].Selected := true; + Word[Value].ColR := ColSR; + Word[Value].ColG := ColSG; + Word[Value].ColB := ColSB; + end; + + Refresh; +end; + +procedure TEditorLyrics.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TEditorLyrics.AddWord(Text: string); +var + WordNum: integer; +begin + WordNum := Length(Word); + SetLength(Word, WordNum + 1); + if WordNum = 0 then begin + Word[WordNum].X := XR; + end else begin + Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; + end; + + Word[WordNum].Y := YR; + Word[WordNum].Size := SizeR; + Word[WordNum].FontStyle := FontStyleI; + SetFontStyle(FontStyleI); + SetFontSize(SizeR); + Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Text := Text; + Word[WordNum].ColR := ColR; + Word[WordNum].ColG := ColG; + Word[WordNum].ColB := ColB; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TEditorLyrics.AddLine(NrLine: integer); +var + N: integer; +begin + Clear; + for N := 0 to Lines[0].Line[NrLine].HighNote do begin + Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; + AddWord(Lines[0].Line[NrLine].Note[N].Text); + end; + Selected := -1; +end; + +procedure TEditorLyrics.Clear; +begin + SetLength(Word, 0); + SelectedI := -1; +end; + +procedure TEditorLyrics.Refresh; +var + W: integer; + TotWidth: real; +begin + if AlignI = 1 then begin + TotWidth := 0; + for W := 0 to High(Word) do + TotWidth := TotWidth + Word[W].Width; + + Word[0].X := XR - TotWidth / 2; + for W := 1 to High(Word) do + Word[W].X := Word[W - 1].X + Word[W - 1].Width; + end; +end; + +procedure TEditorLyrics.Draw; +var + W: integer; +begin + for W := 0 to High(Word) do + begin + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)); + end; +end; + +end. diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas new file mode 100644 index 00000000..ca43bb21 --- /dev/null +++ b/src/base/UFiles.pas @@ -0,0 +1,150 @@ +unit UFiles; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +{$I switches.inc} + +uses SysUtils, + ULog, + UMusic, + USongs, + USong; + +procedure ResetSingTemp; +function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; + +var + SongFile: TextFile; // all procedures in this unit operates on this file + FileLineNo: integer; //Line which is readed at Last, for error reporting + + // variables available for all procedures + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer = 1; + MultBPM : integer = 4; + +implementation + +uses TextGL, + UIni, + UPlatform, + UMain; + +//-------------------- +// Resets the temporary Sentence Arrays for each Player and some other Variables +//-------------------- +procedure ResetSingTemp; +var + Count: integer; +begin + SetLength(Lines, Length(Player)); + for Count := 0 to High(Player) do begin + SetLength(Lines[Count].Line, 1); + SetLength(Lines[Count].Line[0].Note, 0); + Lines[Count].Line[0].Lyric := ''; + Lines[Count].Line[0].LyricWidth := 0; + Player[Count].Score := 0; + Player[Count].LengthNote := 0; + Player[Count].HighNote := -1; + end; + + (* FIXME + //Reset Path and Filename Values to Prevent Errors in Editor + if assigned( CurrentSong ) then + begin + SetLength(CurrentSong.BPM, 0); + CurrentSong.Path := ''; + CurrentSong.FileName := ''; + end; + *) + +// CurrentSong := nil; +end; + + +//-------------------- +// Saves a Song +//-------------------- +function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; +var + C: integer; + N: integer; + S: string; + B: integer; + RelativeSubTime: integer; + NoteState: String; + +begin +// Relative := true; // override (idea - use shift+S to save with relative) + AssignFile(SongFile, Name); + Rewrite(SongFile); + + Writeln(SongFile, '#TITLE:' + Song.Title + ''); + Writeln(SongFile, '#ARTIST:' + Song.Artist); + + if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator); + if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition); + if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre); + if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language); + + Writeln(SongFile, '#MP3:' + Song.Mp3); + + if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover); + if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background); + if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video); + if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish)); + if Relative then Writeln(SongFile, '#RELATIVE:yes'); + + Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(CurrentSong.BPM) do + Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4)); + + for C := 0 to Lines.High do begin + for N := 0 to Lines.Line[C].HighNote do begin + with Lines.Line[C].Note[N] do begin + + + //Golden + Freestyle Note Patch + case Lines.Line[C].Note[N].NoteType of + ntFreestyle: NoteState := 'F '; + ntNormal: NoteState := ': '; + ntGolden: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text; + + + Writeln(SongFile, S); + end; // with + end; // N + + if C < Lines.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Lines.Line[C+1].Start) + else begin + S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime); + RelativeSubTime := Lines.Line[C+1].Start; + end; + Writeln(SongFile, S); + end; + + end; // C + + + Writeln(SongFile, 'E'); + CloseFile(SongFile); + + Result := true; +end; + +end. diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas new file mode 100644 index 00000000..2432503c --- /dev/null +++ b/src/base/UGraphic.pas @@ -0,0 +1,760 @@ +unit UGraphic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + gl, + glext, + UTexture, + TextGL, + ULog, + SysUtils, + ULyrics, + UImage, + UMusic, + 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..7] 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, + 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(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? + Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch? + Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_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(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col); + + Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col); + + Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col); + Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col); + Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col); + end; + + Log.LogStatus('Loading Textures - B', 'LoadTextures'); + + Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0); + Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF); + Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + + + //TimeBar mod + Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); + //eoa TimeBar mod + + //SingBar Mod + Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0); + Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0); + Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 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')), TEXTURE_TYPE_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')), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col); + end; + +//## rating pictures that show a picture according to your rate ## + for P := 0 to 7 do begin + Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0); + end; + + Log.LogStatus('Loading Textures - Done', 'LoadTextures'); +end; + +(* + * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each + * time the pixel-format or render-context (RC) changes. + *) +procedure LoadOpenGLExtensions; +begin + // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility + if (not Load_GL_version_1_2()) then + begin + Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D'); + end; + + // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here + // ... + //Load_GL_EXT_framebuffer_object(); +end; + +procedure Initialize3D (Title: string); +var + Icon: PSDL_Surface; +begin + Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); + if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then + begin + Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); + exit; + end; + + // load icon image (must be 32x32 for win32) + Icon := LoadImage('WINDOWICON'); + if (Icon <> nil) then + SDL_WM_SetIcon(Icon, 0); + + SDL_WM_SetCaption(PChar(Title), nil); + + //Log.BenchmarkStart(2); + + InitializeScreen; + + //Log.BenchmarkEnd(2); + //Log.LogBenchmark('--> Setting Screen', 2); + + //Log.BenchmarkStart(2); + Texture := TTextureUnit.Create; + // FIXME: this does not seem to be correct as Limit is the max. of either + // width or height. + 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); + } + + // Note: do not initialize video modules earlier. They might depend on some + // SDL video functions or OpenGL extensions initialized in InitializeScreen() + InitializeVideo(); + + //Log.BenchmarkStart(2); + + Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); + Display := TDisplay.Create; + + //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); + + // does not work this way because the loading thread tries to access opengl. + // See comment below + //LoadingThread := SDL_CreateThread(@LoadingThread, nil); + + // this would be run in the loadingthread + Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); + LoadScreens; + + + // TODO: + // here should be a loop which + // * 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 + // currently does 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; +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); // Z-Buffer depth + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + + // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under + // linux uses GLX_MESA_swap_control which is not supported by nvidea cards. + // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead. + //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only) + + // 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 (Params.Depth <> -1) then + Depth := Params.Depth + else + Depth := Ini.Depth; + + Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); + //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); + + 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; + + LoadOpenGLExtensions(); + + // define virtual (Render) and real (Screen) screen size + RenderW := 800; + RenderH := 600; + ScreenW := W; + ScreenH := H; + + // clear screen once window is being shown + // Note: SwapBuffers uses RenderW/H, so they must be defined before + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT); + SwapBuffers; +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/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas new file mode 100644 index 00000000..b7174991 --- /dev/null +++ b/src/base/UGraphicClasses.pas @@ -0,0 +1,673 @@ +// notes: +unit UGraphicClasses; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UTexture,SDL; + +const DelayBetweenFrames : Cardinal = 60; +type + + TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); + + TColour3f = Record + r, g, b: Real; + end; + + TParticle = Class + X, Y : Real; //Position + Screen : Integer; + W, H : Cardinal; //dimensions of particle + Col : array of TColour3f; // Colour(s) of particle + Scale : array of Real; // Scaling factors of particle layers + Frame : Byte; //act. Frame + Tex : Cardinal; //Tex num from Textur Manager + Live : Byte; //How many Cycles before Kill + RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote) + StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle + Alpha : Real; // used for fading... + mX, mY : Real; // movement-vector for PerfectLineTwinkle + SizeMod : Real; // experimental size modifier + SurviveSentenceChange : Boolean; + + Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); + Destructor Destroy(); override; + procedure Draw; + procedure LiveOn; + end; + + RectanglePositions = Record + xTop, yTop, xBottom, yBottom : Real; + TotalStarCount : Integer; + CurrentStarCount : Integer; + Screen : Integer; + end; + + PerfectNotePositions = Record + xPos, yPos : Real; + Screen : Integer; + end; + + TEffectManager = Class + Particle : array of TParticle; + LastTime : Cardinal; + RecArray : Array of RectanglePositions; + TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player + PerfNoteArray : Array of PerfectNotePositions; + + FlareTex: TTexture; + + constructor Create; + destructor Destroy; override; + procedure Draw; + function Spawn(X, Y: Real; + Screen: Integer; + Live: Byte; + StartFrame: Integer; + RecArrayIndex: Integer; // this is only used with GoldenNotes + StarType: TParticleType; + Player: Cardinal // for PerfectLineTwinkle + ): Cardinal; + procedure SpawnRec(); + procedure Kill(index: Cardinal); + procedure KillAll(); + procedure SentenceChange(); + procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); + procedure SavePerfectNotePos(Xtop, Ytop: Real); + procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); + procedure SpawnPerfectLineTwinkle(); + end; + +var GoldenRec : TEffectManager; + +implementation + +uses sysutils, + gl, + UIni, + UMain, + UThemes, + USkins, + UGraphic, + UDrawTexture, + UCommon, + math; + +//TParticle +Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); +begin + inherited Create; + // in this constructor we set all initial values for our particle + X := cX; + Y := cY; + Screen := cScreen; + Live := cLive; + Frame:= cFrame; + RecIndex := cRecArrayIndex; + StarType := cStarType; + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + SetLength(Scale,1); + Scale[0] := 1; + SurviveSentenceChange := False; + SizeMod := 1; + case cStarType of + GoldenNote: + begin + Tex := Tex_Note_Star.TexNum; + W := 20; + H := 20; + SetLength(Scale,4); + Scale[1]:=0.8; + Scale[2]:=0.4; + Scale[3]:=0.3; + SetLength(Col,4); + Col[0].r := 1; + Col[0].g := 0.7; + Col[0].b := 0.1; + + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + + Col[2].r := 1; + Col[2].g := 1; + Col[2].b := 1; + + Col[3].r := 1; + Col[3].g := 1; + Col[3].b := 1; + end; + PerfectNote: + begin + Tex := Tex_Note_Perfect_Star.TexNum; + W := 30; + H := 30; + SetLength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := 0.95; + end; + NoteHitTwinkle: + begin + Tex := Tex_Note_Star.TexNum; + Alpha := (Live/16); // linear fade-out + W := 15; + H := 15; + Setlength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := RandomRange(10*Live,100)/90; //0.9; + end; + PerfectLineTwinkle: + begin + Tex := Tex_Note_Star.TexNum; + W := RandomRange(10,20); + H := W; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + SurviveSentenceChange:=True; + // assign colours according to player given + SetLength(Scale,3); + Scale[1]:=0.3; + Scale[2]:=0.2; + SetLength(Col,3); + case Player of + 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); + 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light'); + 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light'); + 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light'); + 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light'); + 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light'); + else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); + end; + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + Col[2].r:=Col[0].r+0.5; + Col[2].g:=Col[0].g+0.5; + Col[2].b:=Col[0].b+0.5; + mX := RandomRange(-5,5); + mY := RandomRange(-5,5); + end; + ColoredStar: + begin + Tex := Tex_Note_Star.TexNum; + W := RandomRange(10,20); + H := W; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + SurviveSentenceChange:=True; + // assign colours according to player given + SetLength(Scale,1); + SetLength(Col,1); + Col[0].b := (Player and $ff)/255; + Col[0].g := ((Player shr 8) and $ff)/255; + Col[0].r := ((Player shr 16) and $ff)/255; + mX := 0; + mY := 0; + end; + Flare: + begin + Tex := Tex_Note_Star.TexNum; + W := 7; + H := 7; + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + mX := RandomRange(-5,5); + mY := RandomRange(-5,5); + SetLength(Scale,4); + Scale[1]:=0.8; + Scale[2]:=0.4; + Scale[3]:=0.3; + SetLength(Col,4); + Col[0].r := 1; + Col[0].g := 0.7; + Col[0].b := 0.1; + + Col[1].r := 1; + Col[1].g := 1; + Col[1].b := 0.4; + + Col[2].r := 1; + Col[2].g := 1; + Col[2].b := 1; + + Col[3].r := 1; + Col[3].g := 1; + Col[3].b := 1; + + end; + else // just some random default values + begin + Tex := Tex_Note_Star.TexNum; + Alpha := 1; + W := 20; + H := 20; + SetLength(Col,1); + Col[0].r := 1; + Col[0].g := 1; + Col[0].b := 1; + end; + end; +end; + +Destructor TParticle.Destroy(); +begin + SetLength(Scale,0); + SetLength(Col,0); + inherited; +end; + +procedure TParticle.LiveOn; +begin + //Live = 0 => Live forever ?? but if this is 0 they would be killed in the Manager at Draw + if (Live > 0) then + Dec(Live); + + // animate frames + Frame := ( Frame + 1 ) mod 16; + + // make our particles do funny stuff (besides being animated) + // changes of any particle-values throughout its life are done here + case StarType of + GoldenNote: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + PerfectNote: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + NoteHitTwinkle: + begin + Alpha := (Live/10); // linear fade-out + end; + PerfectLineTwinkle: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + // move around + X := X + mX; + Y := Y + mY; + end; + ColoredStar: + begin + Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out + end; + Flare: + begin + Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out + SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); + // move around + X := X + mX; + Y := Y + mY; + mY:=mY+1.8; +// mX:=mX/2; + end; + end; +end; + +procedure TParticle.Draw; +var L: Cardinal; +begin + if ScreenAct = Screen then + // this draws (multiple) texture(s) of our particle + for L:=0 to High(Col) do + begin + glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha); + + glBindTexture(GL_TEXTURE_2D, Tex); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + begin + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glEnd; + end; + end; + glcolor4f(1,1,1,1); +end; +// end of TParticle + +// TEffectManager + +constructor TEffectManager.Create; +var c: Cardinal; +begin + inherited; + LastTime := SDL_GetTicks(); + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; + end; +end; + +destructor TEffectManager.Destroy; +begin + Killall; + inherited; +end; + + +procedure TEffectManager.Draw; +var + I: Integer; + CurrentTime: Cardinal; +//const +// DelayBetweenFrames : Cardinal = 100; +begin + + CurrentTime := SDL_GetTicks(); + //Manage particle life + if (CurrentTime - LastTime) > DelayBetweenFrames then + begin + LastTime := CurrentTime; + for I := 0 to high(Particle) do + Particle[I].LiveOn; + end; + + I := 0; + //Kill dead particles + while (I <= High(Particle)) do + begin + if (Particle[I].Live <= 0) then + begin + kill(I); + end + else + begin + inc(I); + end; + end; + + //Draw + for I := 0 to high(Particle) do + begin + Particle[I].Draw; + end; +end; + +// this method creates just one particle +function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal; +begin + Result := Length(Particle); + SetLength(Particle, (Result + 1)); + Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player); +end; + +// manage Sparkling of GoldenNote Bars +procedure TEffectManager.SpawnRec(); +Var + Xkatze, Ykatze : Real; + RandomFrame : Integer; + P : Integer; // P as seen on TV as Positionman +begin +//Spawn a random amount of stars within the given coordinates +//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame +for P:= 0 to high(RecArray) do + begin + while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do + begin + Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); + Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); + RandomFrame := RandomRange(0,14); + // Spawn a GoldenNote Particle + Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); + inc(RecArray[P].CurrentStarCount); + end; + end; + draw; +end; + +// kill one particle (with given index in our particle array) +procedure TEffectManager.Kill(Index: Cardinal); +var + LastParticleIndex : Integer; +begin +// delete particle indexed by Index, +// overwrite it's place in our particle-array with the particle stored at the last array index, +// shorten array + LastParticleIndex := high(Particle); + if not(LastParticleIndex = -1) then // is there still a particle to delete? + begin + if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle... + dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec + // now get rid of that particle + Particle[Index].Destroy; + Particle[Index] := Particle[LastParticleIndex]; + SetLength(Particle, LastParticleIndex); + end; +end; + +// clean up all particles and management structures +procedure TEffectManager.KillAll(); +var c: Cardinal; +begin +//It's the kill all kennies rotuine + while Length(Particle) > 0 do // kill all existing particles + Kill(0); + SetLength(RecArray,0); // remove GoldenRec positions + SetLength(PerfNoteArray,0); // remove PerfectNote positions + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; // reset GoldenNoteHit memory + end; +end; + +procedure TEffectManager.SentenceChange(); +var c: Cardinal; +begin + c:=0; + while c <= High(Particle) do + begin + if Particle[c].SurviveSentenceChange then + inc(c) + else + Kill(c); + end; + SetLength(RecArray,0); // remove GoldenRec positions + SetLength(PerfNoteArray,0); // remove PerfectNote positions + for c:=0 to 5 do + begin + TwinkleArray[c] := 0; // reset GoldenNoteHit memory + end; +end; + +procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); +//Twinkle stars while golden note hit +// this is called from UDraw.pas, SingDrawPlayerCzesc +var + C, P, XKatze, YKatze, LKatze: Integer; + H: Real; +begin + // make sure we spawn only one time at one position + if (TwinkleArray[Player] < Right) then + For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + begin + H := (Top+Bottom)/2; // helper... + with RecArray[P] do + if ((xBottom >= Right) and (xTop <= Right) and + (yTop <= H) and (yBottom >= H)) + and (Screen = ScreenAct) then + begin + TwinkleArray[Player] := Right; // remember twinkle position for this player + for C := 1 to 10 do + begin + Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); + XKatze := RandomRange(-7,3); + LKatze := RandomRange(7,13); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(4,7); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(4,7); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(1,4); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + for C := 1 to 3 do + begin + Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10); + XKatze := RandomRange(-5,1); + LKatze := RandomRange(1,4); + Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); + end; + + exit; // found a matching GoldenRec, did spawning stuff... done + end; + end; +end; + +procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); +var + P : Integer; // P like used in Positions + NewIndex : Integer; +begin + For P := 0 to high(RecArray) do // Do we already have that "new" position? + begin + if (ceil(RecArray[P].xTop) = ceil(Xtop)) and + (ceil(RecArray[P].yTop) = ceil(Ytop)) and + (ScreenAct = RecArray[p].Screen) then + exit; // it's already in the array, so we don't have to create a new one + end; + + // we got a new position, add the new positions to our array + NewIndex := Length(RecArray); + SetLength(RecArray, NewIndex + 1); + RecArray[NewIndex].xTop := Xtop; + RecArray[NewIndex].yTop := Ytop; + RecArray[NewIndex].xBottom := Xbottom; + RecArray[NewIndex].yBottom := Ybottom; + RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3; + RecArray[NewIndex].CurrentStarCount := 0; + RecArray[NewIndex].Screen := ScreenAct; +end; + +procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); +var + P : Integer; // P like used in Positions + NewIndex : Integer; + RandomFrame : Integer; + Xkatze, Ykatze : Integer; +begin + For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? + begin + with PerfNoteArray[P] do + if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and + (Screen = ScreenAct) then + exit; // it's already in the array, so we don't have to create a new one + end; //for + + // we got a new position, add the new positions to our array + NewIndex := Length(PerfNoteArray); + SetLength(PerfNoteArray, NewIndex + 1); + PerfNoteArray[NewIndex].xPos := Xtop; + PerfNoteArray[NewIndex].yPos := Ytop; + PerfNoteArray[NewIndex].Screen := ScreenAct; + + for P:= 0 to 2 do + begin + Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); + Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); + RandomFrame := RandomRange(0,14); + Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); + end; //for + +end; + +procedure TEffectManager.SpawnPerfectLineTwinkle(); +var + P,I,Life: Cardinal; + Left, Right, Top, Bottom: Cardinal; + cScreen: Integer; +begin +// calculation of coordinates done with hardcoded values like in UDraw.pas +// might need to be adjusted if drawing of SingScreen is modified +// coordinates may still be a bit weird and need adjustment + if Ini.SingWindow = 0 then begin + Left := 130; + end else begin + Left := 30; + end; + Right := 770; + // spawn effect for every player with a perfect line + for P:=0 to PlayersPlay-1 do + if Player[P].LastSentencePerfect then + begin + // calculate area where notes of this player are drawn + case PlayersPlay of + 1: begin + Bottom:=Skin_P2_NotesB+10; + Top:=Bottom-105; + cScreen:=1; + end; + 2,4: begin + case P of + 0,2: begin + Bottom:=Skin_P1_NotesB+10; + Top:=Bottom-105; + end; + else begin + Bottom:=Skin_P2_NotesB+10; + Top:=Bottom-105; + end; + end; + case P of + 0,1: cScreen:=1; + else cScreen:=2; + end; + end; + 3,6: begin + case P of + 0,3: begin + Top:=130; + Bottom:=Top+85; + end; + 1,4: begin + Top:=255; + Bottom:=Top+85; + end; + 2,5: begin + Top:=380; + Bottom:=Top+85; + end; + end; + case P of + 0,1,2: cScreen:=1; + else cScreen:=2; + end; + end; + end; + // spawn Sparkling Stars inside calculated coordinates + for I:= 0 to 80 do + begin + Life:=RandomRange(8,16); + Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); + end; + end; +end; + +end. + diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas new file mode 100644 index 00000000..f0ba3276 --- /dev/null +++ b/src/base/UHooks.pas @@ -0,0 +1,434 @@ +unit UHooks; + +{********************* + THookManager + Class for saving, managing and calling of Hooks. + Saves all hookable events and their subscribers +*********************} +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; + +type + //Record that saves info from Subscriber + PSubscriberInfo = ^TSubscriberInfo; + TSubscriberInfo = record + Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) + Next: PSubscriberInfo; //Pointer to next Item in HookChain + + Owner: Integer; //For Error Handling and Plugin Unloading. + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to Hook an Event with a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Hook); //Proc that will be called on Event + True: (ProcOfClass: TUS_Hook_of_Object); + end; + + TEventInfo = record + Name: String[60]; //Name of Event + FirstSubscriber: PSubscriberInfo; //First subscriber in chain + LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + end; + + THookManager = class + private + Events: array of TEventInfo; + SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + + Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); + public + constructor Create(const SpacetoAllocate: Word); + + Function AddEvent (const EventName: PChar): THandle; + Function DelEvent (hEvent: THandle): Integer; + + Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + Function DelSubscriber (const hSubscriber: THandle): Integer; + + Function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; + Function EventExists (const EventName: PChar): Integer; + + Procedure DelbyOwner(const Owner: Integer); + end; + +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; + +var + HookManager: THookManager; + +implementation +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + inherited Create(); + + //Get the Space and "Zero" it + SetLength (Events, SpacetoAllocate); + For I := 0 to SpacetoAllocate-1 do + Events[I].Name[1] := chr(0); + + SpaceinEvents := SpacetoAllocate; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Succesful Created.'); + {$ENDIF} +end; + +//------------ +// AddEvent - Adds an Event and return the Events Handle or 0 on Failure +//------------ +Function THookManager.AddEvent (const EventName: PChar): THandle; +var I: Integer; +begin + Result := 0; + + if (EventExists(EventName) = 0) then + begin + If (SpaceinEvents > 0) then + begin + //There is already Space available + //Go Search it! + For I := 0 to High(Events) do + If (Events[I].Name[1] = chr(0)) then + begin //Found Space + Result := I; + Dec(SpaceinEvents); + Break; + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); + {$ENDIF} + end + else + begin //There is no Space => Go make some! + Result := Length(Events); + SetLength(Events, Result + 1); + end; + + //Set Events Data + Events[Result].Name := EventName; + Events[Result].FirstSubscriber := nil; + Events[Result].LastSubscriber := nil; + + //Handle is Index + 1 + Inc(Result); + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + debugWriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); + {$ENDIF} +end; + +//------------ +// DelEvent - Deletes an Event by Handle Returns False on Failure +//------------ +Function THookManager.DelEvent (hEvent: THandle): Integer; +var + Cur, Last: PSubscriberInfo; +begin + hEvent := hEvent - 1; //Arrayindex is Handle - 1 + Result := -1; + + + If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then + begin //Event exists + //Free the Space for all Subscribers + Cur := Events[hEvent].FirstSubscriber; + + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TSubscriberInfo)); + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); + {$ENDIF} + + //Free the Event + Events[hEvent].Name[1] := chr(0); + Inc(SpaceinEvents); //There is one more space for new events + end + + {$IFDEF DEBUG} + else + debugWriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); + {$ENDIF} +end; + +//------------ +// AddSubscriber - Adds an Subscriber to the Event by Name +// Returns Handle of the Subscribtion or 0 on Failure +//------------ +Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +var + EventHandle: THandle; + EventIndex: Cardinal; + Cur: PSubscriberInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + EventHandle := EventExists(EventName); + + If (EventHandle <> 0) then + begin + EventIndex := EventHandle - 1; + + //Get Memory + GetMem(Cur, SizeOf(TSubscriberInfo)); + + //Fill it with Data + Cur.Next := nil; + + //Add Owner + Cur.Owner := Core.CurExecuted; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID + If (Events[EventIndex].LastSubscriber = nil) then + begin + If (Events[EventIndex].FirstSubscriber = nil) then + begin + Result := (EventHandle SHL 16); + Events[EventIndex].FirstSubscriber := Cur; + end + Else + begin + Result := Events[EventIndex].FirstSubscriber.Self + 1; + end; + end + Else + begin + Result := Events[EventIndex].LastSubscriber.Self + 1; + Events[EventIndex].LastSubscriber.Next := Cur; + end; + + Cur.Self := Result; + + //Add to Chain + Events[EventIndex].LastSubscriber := Cur; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); + {$ENDIF} + end; + end; +end; + +//------------ +// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. +//------------ +Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +begin + //Delete from Chain + If (Last <> nil) then + begin + Last.Next := Cur.Next; + end + else //Was first Popup + begin + Events[EventIndex].FirstSubscriber := Cur.Next; + end; + + //Was this Last subscription ? + If (Cur = Events[EventIndex].LastSubscriber) then + begin //Change Last Subscriber + Events[EventIndex].LastSubscriber := Last; + end; + + //Free Space: + FreeMem(Cur, SizeOf(TSubscriberInfo)); +end; + +//------------ +// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure +//------------ +Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; +var + EventIndex: Cardinal; + Cur, Last: PSubscriberInfo; +begin + Result := -1; + EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; + + //Existing Event ? + If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then + begin + Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription + + //Search for Subscription + Cur := Events[EventIndex].FirstSubscriber; + Last := nil; + + //go through the chain ... + While (Cur <> nil) do + begin + If (Cur.Self = hSubscriber) then + begin //Found Subscription we searched for + FreeSubscriber(EventIndex, Last, Cur); + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); + {$ENDIF} + + //Set Result and Break the Loop + Result := 0; + Break; + end; + + Last := Cur; + Cur := Cur.Next; + end; + + end; +end; + + +//------------ +// CallEventChain - Calls the Chain of a specified EventHandle +// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End +//------------ +Function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; +var + EventIndex: Cardinal; + Cur: PSubscriberInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := -1; + EventIndex := hEvent - 1; + + If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then + begin //Existing Event + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start calling the Chain !!!11 + Cur := Events[EventIndex].FirstSubscriber; + Result := 0; + //Call Hooks until the Chain is at the End or breaked + While ((Cur <> nil) AND (Result = 0)) do + begin + //Set CurExecuted + Core.CurExecuted := Cur.Owner; + if (Cur.isClass) then + Result := Cur.ProcOfClass(wParam, lParam) + else + Result := Cur.Proc(wParam, lParam); + + Cur := Cur.Next; + end; + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + debugWriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); + {$ENDIF} +end; + +//------------ +// EventExists - Returns non Zero if an Event with the given Name exists +//------------ +Function THookManager.EventExists (const EventName: PChar): Integer; +var + I: Integer; + Name: String[60]; +begin + Result := 0; + //If (Length(EventName) < + Name := String(EventName); + + //Sure not to search for empty space + If (Name[1] <> chr(0)) then + begin + //Search for Event + For I := 0 to High(Events) do + If (Events[I].Name = Name) then + begin //Event found + Result := I + 1; + Break; + end; + end; +end; + +//------------ +// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) +//------------ +Procedure THookManager.DelbyOwner(const Owner: Integer); +var + I: Integer; + Cur, Last: PSubscriberInfo; +begin + //Search for Owner in all Hooks Chains + For I := 0 to High(Events) do + begin + If (Events[I].Name[1] <> chr(0)) then + begin + + Last := nil; + Cur := Events[I].FirstSubscriber; + //Went Through Chain + While (Cur <> nil) do + begin + If (Cur.Owner = Owner) then + begin //Found Subscription by Owner -> Delete + FreeSubscriber(I, Last, Cur); + If (Last <> nil) then + Cur := Last.Next + else + Cur := Events[I].FirstSubscriber; + end + Else + begin + //Next Item: + Last := Cur; + Cur := Cur.Next; + end; + end; + end; + end; +end; + + +function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := 0; //Don't break the chain + Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))); +end; + +end. diff --git a/src/base/UImage.pas b/src/base/UImage.pas new file mode 100644 index 00000000..d33c0d38 --- /dev/null +++ b/src/base/UImage.pas @@ -0,0 +1,993 @@ +unit UImage; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SDL; + +{$DEFINE HavePNG} +{$DEFINE HaveBMP} +{$DEFINE HaveJPG} + +const + PixelFmt_RGBA: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 24; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $ff000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_RGB: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 24; + BytesPerPixel: 3; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 0; + Gshift: 8; + Bshift: 16; + Ashift: 0; + Rmask: $000000ff; + Gmask: $0000ff00; + Bmask: $00ff0000; + Amask: $00000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_BGRA: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 32; + BytesPerPixel: 4; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 16; + Gshift: 8; + Bshift: 0; + Ashift: 24; + Rmask: $00ff0000; + Gmask: $0000ff00; + Bmask: $000000ff; + Amask: $ff000000; + ColorKey: 0; + Alpha: 255 + ); + + PixelFmt_BGR: TSDL_Pixelformat = ( + palette: nil; + BitsPerPixel: 24; + BytesPerPixel: 3; + Rloss: 0; + Gloss: 0; + Bloss: 0; + Aloss: 0; + Rshift: 16; + Gshift: 8; + Bshift: 0; + Ashift: 0; + Rmask: $00ff0000; + Gmask: $0000ff00; + Bmask: $000000ff; + Amask: $00000000; + ColorKey: 0; + Alpha: 255 + ); + +type + TImagePixelFmt = ( + ipfRGBA, ipfRGB, ipfBGRA, ipfBGR + ); + +(******************************************************* + * Image saving + *******************************************************) + +{$IFDEF HavePNG} +function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +{$ENDIF} +{$IFDEF HaveBMP} +function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +{$ENDIF} +{$IFDEF HaveJPG} +function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +{$ENDIF} + +(******************************************************* + * Image loading + *******************************************************) + +function LoadImage(const Identifier: string): PSDL_Surface; + +(******************************************************* + * Image manipulation + *******************************************************) + +function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); + + +implementation + +uses + SysUtils, + Classes, + Math, + {$IFDEF MSWINDOWS} + Windows, + {$ENDIF} + {$IFDEF HaveJPG} + {$IFDEF Delphi} + Graphics, + jpeg, + {$ELSE} + jpeglib, + jerror, + jcparam, + jdatadst, jcapimin, jcapistd, + {$ENDIF} + {$ENDIF} + {$IFDEF HavePNG} + png, + {$ENDIF} + zlib, + sdl_image, + sdlutils, + UCommon, + ULog; + + +function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 24) and + (pixelFmt.RMask = $0000FF) and + (pixelFmt.GMask = $00FF00) and + (pixelFmt.BMask = $FF0000); +end; + +function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 32) and + (pixelFmt.RMask = $000000FF) and + (pixelFmt.GMask = $0000FF00) and + (pixelFmt.BMask = $00FF0000) and + (pixelFmt.AMask = $FF000000); +end; + +function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 24) and + (pixelFmt.BMask = $0000FF) and + (pixelFmt.GMask = $00FF00) and + (pixelFmt.RMask = $FF0000); +end; + +function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean; +begin + Result := (pixelFmt.BitsPerPixel = 32) and + (pixelFmt.BMask = $000000FF) and + (pixelFmt.GMask = $0000FF00) and + (pixelFmt.RMask = $00FF0000) and + (pixelFmt.AMask = $FF000000); +end; + +// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is +// sets converted to true if the surface needed to be converted +function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; +var + pixelFmt: PSDL_PixelFormat; +begin + pixelFmt := Surface.format; + if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then + begin + Converted := false; + Result := Surface; + end + else + begin + // invalid format -> needs conversion + if (pixelFmt.AMask <> 0) then + Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE) + else + Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); + Converted := true; + end; +end; + +// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is +// sets converted to true if the surface needed to be converted +function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface; +var + pixelFmt: PSDL_PixelFormat; +begin + pixelFmt := Surface.format; + if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then + begin + Converted := false; + Result := Surface; + end + else + begin + // invalid format -> needs conversion + if (pixelFmt.AMask <> 0) then + Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE) + else + Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); + Converted := true; + end; +end; + + +(******************************************************* + * Image saving + *******************************************************) + +(*************************** + * PNG section + *****************************) + +{$IFDEF HavePNG} + +// delphi does not support setjmp()/longjmp() -> define our own error-handler +procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl; +begin + raise Exception.Create(error_msg); +end; + +procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; +var + inFile: TFileStream; +begin + inFile := TFileStream(png_get_io_ptr(png_ptr)); + inFile.Read(data^, length); +end; + +procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; +var + outFile: TFileStream; +begin + outFile := TFileStream(png_get_io_ptr(png_ptr)); + outFile.Write(data^, length); +end; + +procedure user_flush_data(png_ptr: png_structp); cdecl; +//var +// outFile: TFileStream; +begin + // binary files are flushed automatically, Flush() works with Text-files only + //outFile := TFileStream(png_get_io_ptr(png_ptr)); + //outFile.Flush(); +end; + +procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time); +var + year, month, day: word; + hour, minute, second, msecond: word; +begin + DecodeDate(time, year, month, day); + pngTime.year := year; + pngTime.month := month; + pngTime.day := day; + DecodeTime(time, hour, minute, second, msecond); + pngTime.hour := hour; + pngTime.minute := minute; + pngTime.second := second; +end; + +(* + * ImageData must be in RGB-format + *) +function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +var + png_ptr: png_structp; + info_ptr: png_infop; + pngFile: TFileStream; + row: integer; + rowData: array of png_bytep; +// rowStride: integer; + converted: boolean; + colorType: integer; +// time: png_time; +begin + Result := false; + + // open file for writing + try + pngFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage'); + Exit; + end; + + // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it + Surface := ConvertToRGB_RGBASurface(Surface, converted); + + png_ptr := nil; + + try + // initialize png (and enable a user-defined error-handler that throws an exception on error) + png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil); + // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil + if (png_ptr = nil) then + begin + Log.LogError('png_create_write_struct() failed', 'WritePngImage'); + if (converted) then + SDL_FreeSurface(Surface); + Exit; + end; + + info_ptr := png_create_info_struct(png_ptr); + + if (Surface^.format^.BitsPerPixel = 24) then + colorType := PNG_COLOR_TYPE_RGB + else + colorType := PNG_COLOR_TYPE_RGBA; + + // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi) + png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data); + png_set_IHDR( + png_ptr, info_ptr, + Surface.w, Surface.h, + 8, + colorType, + PNG_INTERLACE_NONE, + PNG_COMPRESSION_TYPE_DEFAULT, + PNG_FILTER_TYPE_DEFAULT + ); + + // TODO: do we need the modification time? + //DateTimeToPngTime(Now, time); + //png_set_tIME(png_ptr, info_ptr, @time); + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // setup data + SetLength(rowData, Surface.h); + for row := 0 to Surface.h-1 do + begin + // set rowData-elements to beginning of each image row + // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) + rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch]; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + png_write_info(png_ptr, info_ptr); + png_write_image(png_ptr, png_bytepp(rowData)); + png_write_end(png_ptr, nil); + + Result := true; + except on E: Exception do + Log.LogError(E.message, 'WritePngImage'); + end; + + // free row-data + SetLength(rowData, 0); + + // free png-resources + if (png_ptr <> nil) then + png_destroy_write_struct(@png_ptr, nil); + + if (converted) then + SDL_FreeSurface(Surface); + + // close file + pngFile.Free; +end; + +{$ENDIF} + +(*************************** + * BMP section + *****************************) + +{$IFDEF HaveBMP} + +{$IFNDEF MSWINDOWS} +const + (* constants for the biCompression field *) + BI_RGB = 0; + BI_RLE8 = 1; + BI_RLE4 = 2; + BI_BITFIELDS = 3; + BI_JPEG = 4; + BI_PNG = 5; + +type + BITMAPINFOHEADER = record + biSize: longword; + biWidth: longint; + biHeight: longint; + biPlanes: word; + biBitCount: word; + biCompression: longword; + biSizeImage: longword; + biXPelsPerMeter: longint; + biYPelsPerMeter: longint; + biClrUsed: longword; + biClrImportant: longword; + end; + LPBITMAPINFOHEADER = ^BITMAPINFOHEADER; + TBITMAPINFOHEADER = BITMAPINFOHEADER; + PBITMAPINFOHEADER = ^BITMAPINFOHEADER; + + RGBTRIPLE = record + rgbtBlue: byte; + rgbtGreen: byte; + rgbtRed: byte; + end; + tagRGBTRIPLE = RGBTRIPLE; + TRGBTRIPLE = RGBTRIPLE; + PRGBTRIPLE = ^RGBTRIPLE; + + RGBQUAD = record + rgbBlue: byte; + rgbGreen: byte; + rgbRed: byte; + rgbReserved: byte; + end; + tagRGBQUAD = RGBQUAD; + TRGBQUAD = RGBQUAD; + PRGBQUAD = ^RGBQUAD; + + BITMAPINFO = record + bmiHeader: BITMAPINFOHEADER; + bmiColors: array[0..0] of RGBQUAD; + end; + LPBITMAPINFO = ^BITMAPINFO; + PBITMAPINFO = ^BITMAPINFO; + TBITMAPINFO = BITMAPINFO; + + {$PACKRECORDS 2} + BITMAPFILEHEADER = record + bfType: word; + bfSize: longword; + bfReserved1: word; + bfReserved2: word; + bfOffBits: longword; + end; + {$PACKRECORDS DEFAULT} +{$ENDIF} + +(* + * ImageData must be in BGR-format + *) +function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +var + bmpFile: TFileStream; + FileInfo: BITMAPINFOHEADER; + FileHeader: BITMAPFILEHEADER; + Converted: boolean; + Row: integer; + RowSize: integer; +begin + Result := false; + + // open file for writing + try + bmpFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage'); + Exit; + end; + + // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it + Surface := ConvertToBGR_BGRASurface(Surface, Converted); + + // aligned (4-byte) row-size in bytes + RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4; + + // initialize bitmap info + FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0); + with FileInfo do + begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := Surface.w; + biHeight := Surface.h; + biPlanes := 1; + biBitCount := Surface^.format^.BitsPerPixel; + biCompression := BI_RGB; + biSizeImage := RowSize * Surface.h; + end; + + // initialize header-data + FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0); + with FileHeader do + begin + bfType := $4D42; // = 'BM' + bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER); + bfSize := bfOffBits + FileInfo.biSizeImage; + end; + + // and move the whole stuff into the file ;-) + try + // write headers + bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER)); + bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER)); + + // write image-data + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // BMP needs 4-byte alignment + if (Surface.pitch mod 4 = 0) then + begin + // aligned correctly -> write whole image at once + bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage); + end + else + begin + // misaligned -> write each line separately + // Note: for the last line unassigned memory (> last Surface.pixels element) + // will be copied to the padding area (last bytes of a row), + // but we do not care because the content of padding data is ignored anyhow. + for Row := 0 to Surface.h do + bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize); + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + Result := true; + finally + Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage'); + end; + + if (Converted) then + SDL_FreeSurface(Surface); + + // close file + bmpFile.Free; +end; + +{$ENDIF} + +(*************************** + * JPG section + *****************************) + +{$IFDEF HaveJPG} + +function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +var + {$IFDEF Delphi} + Bitmap: TBitmap; + BitmapInfo: TBitmapInfo; + Jpeg: TJpegImage; + row: integer; + {$ELSE} + cinfo: jpeg_compress_struct; + jerr : jpeg_error_mgr; + jpgFile: TFileStream; + rowPtr: array[0..0] of JSAMPROW; + {$ENDIF} + converted: boolean; +begin + Result := false; + + {$IFDEF Delphi} + // only 24bit (BGR) data is supported, so convert to it + if (IsBGRSurface(Surface.format)) then + converted := false + else + begin + Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE); + converted := true; + end; + + // create and setup bitmap + Bitmap := TBitmap.Create; + Bitmap.PixelFormat := pf24bit; + Bitmap.Width := Surface.w; + Bitmap.Height := Surface.h; + + // setup bitmap info on source image (Surface parameter) + ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo)); + with BitmapInfo.bmiHeader do + begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := Surface.w; + biHeight := Surface.h; + biPlanes := 1; + biBitCount := 24; + biCompression := BI_RGB; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels + if (Surface.pitch mod 4 = 0) then + begin + // if the image is aligned (to a 4-byte boundary) -> copy all data at once + // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned + SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS); + end + else + begin + // wrong alignment -> copy each line separately. + // Note: for the last line unassigned memory (> last Surface.pixels element) + // will be copied to the padding area (last bytes of a row), + // but we do not care because the content of padding data is ignored anyhow. + for row := 0 to Surface.h do + begin + SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch], + BitmapInfo, DIB_RGB_COLORS); + end; + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + // assign Bitmap to JPEG and store the latter + Jpeg := TJPEGImage.Create; + Jpeg.Assign(Bitmap); + Bitmap.Free; + Jpeg.CompressionQuality := Quality; + try + // compress image (don't forget this line, otherwise it won't be compressed) + Jpeg.Compress(); + Jpeg.SaveToFile(FileName); + except + Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage'); + Exit; + end; + Jpeg.Free; + {$ELSE} + // based on example.pas in FPC's packages/base/pasjpeg directory + + // only 24bit (RGB) data is supported, so convert to it + if (IsRGBSurface(Surface.format)) then + converted := false + else + begin + Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE); + converted := true; + end; + + // allocate and initialize JPEG compression object + cinfo.err := jpeg_std_error(jerr); + // msg_level that will be displayed. (Nomssi) + //jerr.trace_level := 3; + // initialize the JPEG compression object + jpeg_create_compress(@cinfo); + + // open file for writing + try + jpgFile := TFileStream.Create(FileName, fmCreate); + except + Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage'); + Exit; + end; + + // specify data destination + jpeg_stdio_dest(@cinfo, @jpgFile); + + // set parameters for compression + cinfo.image_width := Surface.w; + cinfo.image_height := Surface.h; + cinfo.in_color_space := JCS_RGB; + cinfo.input_components := 3; + cinfo.data_precision := 8; + + // set default compression parameters + jpeg_set_defaults(@cinfo); + jpeg_set_quality(@cinfo, quality, true); + + // start compressor + jpeg_start_compress(@cinfo, true); + + if (SDL_MUSTLOCK(Surface)) then + SDL_LockSurface(Surface); + + while (cinfo.next_scanline < cinfo.image_height) do + begin + // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned) + rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]); + jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1); + end; + + if (SDL_MUSTLOCK(Surface)) then + SDL_UnlockSurface(Surface); + + // finish compression + jpeg_finish_compress(@cinfo); + // close the output file + jpgFile.Free; + + // release JPEG compression object + jpeg_destroy_compress(@cinfo); + {$ENDIF} + + if (converted) then + SDL_FreeSurface(Surface); + + Result := true; +end; + +{$ENDIF} + + +(******************************************************* + * Image loading + *******************************************************) + + +(* + * Loads an image from the given file or resource + *) +function LoadImage(const Identifier: string): PSDL_Surface; +var + TexRWops: PSDL_RWops; + TexStream: TStream; + FileName: string; +begin + Result := nil; + TexRWops := nil; + + if Identifier = '' then + exit; + + //Log.LogStatus( Identifier, 'LoadImage' ); + + FileName := Identifier; + + if (FileExistsInsensitive(FileName)) then + begin + // load from file + //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' ); + try + Result := IMG_Load(PChar(FileName)); + //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + except + Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage'); + Exit; + end; + end + else + begin + //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + TexStream := GetResourceStream(Identifier, 'TEX'); + if (not assigned(TexStream)) then + begin + Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage'); + Exit; + end; + + TexRWops := RWopsFromStream(TexStream); + if (TexRWops = nil) then + begin + Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage'); + TexStream.Free(); + Exit; + end; + + //Log.LogStatus( 'resource Assigned....' , Identifier); + try + Result := IMG_Load_RW(TexRWops, 0); + except + Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage'); + end; + + SDL_FreeRW(TexRWops); + TexStream.Free(); + end; +end; + + +(******************************************************* + * Image manipulation + *******************************************************) + + +function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; +begin + if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and + (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and + (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and + (fmt1^.Bshift = fmt2^.Bshift) + then + Result := true + else + Result := false; +end; + +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface := ImgSurface; + ImgSurface := SDL_ScaleSurfaceRect(TempSurface, + 0, 0, TempSurface^.W,TempSurface^.H, + Width, Height); + SDL_FreeSurface(TempSurface); +end; + +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +var + TempSurface: PSDL_Surface; + ImgFmt: PSDL_PixelFormat; +begin + TempSurface := ImgSurface; + + // create a new surface with given width and height + ImgFmt := TempSurface^.format; + ImgSurface := SDL_CreateRGBSurface( + SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel, + ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask); + + // copy image from temp- to new surface + SDL_SetAlpha(ImgSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface, nil, ImgSurface, nil); + + SDL_FreeSurface(TempSurface); +end; + +(* +// Old slow floating point version of ColorizeTexture. +// For an easier understanding of the faster fixed point version below. +procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); +var + clr: array[0..2] of Double; // [0: R, 1: G, 2: B] + hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)] + delta, f, p, q, t: Double; + max: Double; +begin + clr[0] := PixelColors[0]/255; + clr[1] := PixelColors[1]/255; + clr[2] := PixelColors[2]/255; + max := maxvalue(clr); + delta := max - minvalue(clr); + + hsv[0] := DestinationHue; // set H(ue) + hsv[2] := max; // set V(alue) + // calc S(aturation) + if (max = 0.0) then + hsv[1] := 0.0 + else + hsv[1] := delta/max; + + //ColorizePixel(PByteArray(Pixel), DestinationHue); + h_int := trunc(hsv[0]); // h_int = |_h_| + f := hsv[0]-h_int; // f = h-h_int + p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s) + q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f) + t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f)) + case h_int of + 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) + 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) + 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) + 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) + 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) + 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) + end; + + // and store new rgb back into the image + PixelColors[0] := trunc(255*clr[0]); + PixelColors[1] := trunc(255*clr[1]); + PixelColors[2] := trunc(255*clr[2]); +end; +*) + +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); + + //returns hue within range [0.0-6.0) + function col2hue(Color:Cardinal): double; + var + clr: array[0..2] of double; + hue, max, delta: double; + begin + clr[0] := ((Color and $ff0000) shr 16)/255; // R + clr[1] := ((Color and $ff00) shr 8)/255; // G + clr[2] := (Color and $ff) /255; // B + max := maxvalue(clr); + delta := max - minvalue(clr); + // calc hue + if (delta = 0.0) then hue := 0 + else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta + else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta + else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta; + if (hue < 0.0) then + hue := hue + 6.0; + Result := hue; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; + Pixel: PByte; + PixelColors: PByteArray; + clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B] + hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)] + dhue: UInt32; + h_int: Cardinal; + delta, f, p, q, t: Longint; + max: Uint32; +begin + DestinationHue := col2hue(NewColor); + + dhue := Trunc(DestinationHue*1024); + + Pixel := ImgSurface^.Pixels; + + for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do + begin + PixelColors := PByteArray(Pixel); + // inlined colorize per pixel + + // uses fixed point math + // get color values + clr[0] := PixelColors[0] shl 10; + clr[1] := PixelColors[1] shl 10; + clr[2] := PixelColors[2] shl 10; + //calculate luminance and saturation from rgb + + max := clr[0]; + if clr[1] > max then max := clr[1]; + if clr[2] > max then max := clr[2]; + delta := clr[0]; + if clr[1] < delta then delta := clr[1]; + if clr[2] < delta then delta := clr[2]; + delta := max-delta; + hsv[0] := dhue; // shl 8 + hsv[2] := max; // shl 8 + if (max = 0) then + hsv[1] := 0 + else + hsv[1] := (delta shl 10) div max; // shl 8 + h_int := hsv[0] and $fffffC00; + f := hsv[0]-h_int; //shl 10 + p := (hsv[2]*(1024-hsv[1])) shr 10; + q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10; + t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10; + h_int := h_int shr 10; + case h_int of + 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) + 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) + 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) + 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) + 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) + 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) + end; + + PixelColors[0] := clr[0] shr 10; + PixelColors[1] := clr[1] shr 10; + PixelColors[2] := clr[2] shr 10; + + Inc(Pixel, ImgSurface^.format.BytesPerPixel); + end; +end; + +end. diff --git a/src/base/UIni.pas b/src/base/UIni.pas new file mode 100644 index 00000000..b286c917 --- /dev/null +++ b/src/base/UIni.pas @@ -0,0 +1,928 @@ +unit UIni; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + IniFiles, + ULog, + SysUtils; + +type + // TInputDeviceConfig stores the configuration for an input device. + // Configurations will be stored in the InputDeviceConfig array. + // Note that not all devices listed in InputDeviceConfig are active devices. + // Some might be unplugged and hence unavailable. + // Available devices are held in TAudioInputProcessor.DeviceList. Each + // TAudioInputDevice listed there has a CfgIndex field which is the index to + // its configuration in the InputDeviceConfig array. + // Name: + // the name of the input device + // Input: + // the index of the input source to use for recording + // ChannelToPlayerMap: + // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 + // maps the channel 0 (left) to player 2. A player index of 0 means that + // the channel is not assigned to a player. + PInputDeviceConfig = ^TInputDeviceConfig; + TInputDeviceConfig = record + Name: string; + Input: integer; + ChannelToPlayerMap: array of integer; + end; + +type + +//Options + + TVisualizerOption = (voOff, voWhenNoVideo, voOn); + TBackgroundMusicOption = (bmoOff, bmoOn); + TIni = class + private + function RemoveFileExt(FullName: string): string; + function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; + function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; + function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer; + function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; + IniSection: string; IniProperty: string; Default: integer): integer; + + procedure LoadInputDeviceCfg(IniFile: TMemIniFile); + procedure SaveInputDeviceCfg(IniFile: TIniFile); + procedure LoadThemes(IniFile: TCustomIniFile); + procedure LoadPaths(IniFile: TCustomIniFile); + procedure LoadScreenModes(IniFile: TCustomIniFile); + + public + Name: array[0..11] of string; + + // Templates for Names Mod + NameTeam: array[0..2] of string; + NameTemplate: array[0..11] of string; + + //Filename of the opened iniFile + Filename: string; + + // Game + Players: integer; + Difficulty: integer; + Language: integer; + Tabs: integer; + Tabs_at_startup:integer; //Tabs at Startup fix + Sorting: integer; + Debug: integer; + + // Graphics + Screens: integer; + Resolution: integer; + Depth: integer; + VisualizerOption:integer; + FullScreen: integer; + TextureSize: integer; + SingWindow: integer; + Oscilloscope: integer; + Spectrum: integer; + Spectrograph: integer; + MovieSize: integer; + + // Sound + MicBoost: integer; + ClickAssist: integer; + BeatClick: integer; + SavePlayback: integer; + ThresholdIndex: integer; + AudioOutputBufferSizeIndex:integer; + VoicePassthrough:integer; + + //Song Preview + PreviewVolume: integer; + PreviewFading: integer; + + // Lyrics + LyricsFont: integer; + LyricsEffect: integer; + Solmization: integer; + NoteLines: integer; + + // Themes + Theme: integer; + SkinNo: integer; + Color: integer; + BackgroundMusicOption:integer; + + // Record + InputDeviceConfig: array of TInputDeviceConfig; + + // Advanced + LoadAnimation: integer; + EffectSing: integer; + ScreenFade: integer; + AskBeforeDel: integer; + OnSongClick: integer; + LineBonus: integer; + PartyPopup: integer; + + // Controller + Joypad: integer; + + procedure Load(); + procedure Save(); + procedure SaveNames; + procedure SaveLevel; + end; + +var + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; + + + +const + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); + + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); + + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + sEdition = 0; + sGenre = 1; + sLanguage = 2; + sFolder = 3; + sTitle = 4; + sArtist = 5; + sTitle2 = 6; + sArtist2 = 7; + + IDebug: array[0..1] of string = ('Off', 'On'); + + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + + IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + + + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); + + ISingWindow: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); +//IOscilloscope: array[0..1] of string = ('Off', 'On'); + + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); + + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); + + IVoicePassthrough: array[0..1] of string = ('Off', 'On'); + + IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + + IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + + //Song Preview + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); + + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); + + + ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); + ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + INoteLines: array[0..1] of string = ('Off', 'On'); + + IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimation: array[0..1] of string = ('Off', 'On'); + IEffectSing: array[0..1] of string = ('Off', 'On'); + IScreenFade: array[0..1] of string =('Off', 'On'); + IAskbeforeDel: array[0..1] of string = ('Off', 'On'); + IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + IPartyPopup: array[0..1] of string = ('Off', 'On'); + + IJoypad: array[0..1] of string = ('Off', 'On'); + + // Recording options + IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + +implementation + +uses + StrUtils, + UMain, + SDL, + ULanguage, + UPlatform, + USkins, + URecord, + UCommandLine; + +(** + * Returns the filename without its fileextension + *) +function TIni.RemoveFileExt(FullName: string): string; +begin + Result := ChangeFileExt(FullName, ''); +end; + +(** + * Extracts an index of a key that is surrounded by a Prefix/Suffix pair. + * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1. + *) +function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; +var + Value: string; + Start: integer; +begin + Result := -1; + + if Pos(Prefix, Key) > -1 then + begin + Start := Pos(Prefix, Key) + Length(Prefix); + + // copy all between prefix and suffix + Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start); + Result := StrToIntDef(Value, -1); + end; +end; + +(** + * Finds the maximum key-index in a key-list. + * The indexes of the list are surrounded by Prefix/Suffix, + * e.g. MyKey[1] (Prefix='[', Suffix=']') + *) +function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; +var + i: integer; + KeyIndex: integer; +begin + Result := -1; + + for i := 0 to Keys.Count-1 do + begin + KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix); + if (KeyIndex > Result) then + Result := KeyIndex; + end; +end; + +(** + * Returns the index of Value in SearchArray + * or -1 if Value is not in SearchArray. + *) +function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; + CaseInsensitiv: Boolean = False): integer; +var + i: integer; +begin + Result := -1; + + for i := 0 to High(SearchArray) do + begin + if (SearchArray[i] = Value) or + (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then + begin + Result := i; + Break; + end; + end; +end; + +(** + * Reads the property IniSeaction:IniProperty from IniFile and + * finds its corresponding index in SearchArray. + * If SearchArray does not contain the property value, the default value is + * returned. + *) +function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; + IniSection: string; IniProperty: string; Default: integer): integer; +var + StrValue: string; +begin + StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]); + Result := GetArrayIndex(SearchArray, StrValue); + if (Result = -1) then + begin + Result := Default; + end; +end; + + +procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); +var + DeviceCfg: PInputDeviceConfig; + DeviceIndex: integer; + ChannelCount: integer; + ChannelIndex: integer; + RecordKeys: TStringList; + i: integer; +begin + RecordKeys := TStringList.Create(); + + // read all record-keys for filtering + IniFile.ReadSection('Record', RecordKeys); + + SetLength(InputDeviceConfig, 0); + + for i := 0 to RecordKeys.Count-1 do + begin + // find next device-name + DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']'); + if (DeviceIndex >= 0) then + begin + if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then + break; + + // resize list + SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); + + // read an input device's config. + // Note: All devices are appended to the list whether they exist or not. + // Otherwise an external device's config will be lost if it is not + // connected (e.g. singstar mics or USB-Audio devices). + DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)]; + DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), ''); + DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0); + + // find the largest channel-number of the current device in the ini-file + ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex])); + if (ChannelCount < 0) then + ChannelCount := 0; + + SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount); + + // read channel-to-player mapping for every channel of the current device + // or set non-configured channels to no player (=0). + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + DeviceCfg.ChannelToPlayerMap[ChannelIndex] := + IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0); + end; + end; + end; + + RecordKeys.Free(); + + // MicBoost + //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); + // Threshold + // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); +end; + +procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); +var + DeviceIndex: integer; + ChannelIndex: integer; +begin + for DeviceIndex := 0 to High(InputDeviceConfig) do + begin + // DeviceName and DeviceInput + IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].Name); + IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].Input); + + // Channel-to-Player Mapping + for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do + begin + IniFile.WriteInteger('Record', + Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]); + end; + end; + + // MicBoost + //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); + // Threshold + //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); +end; + +procedure TIni.LoadPaths(IniFile: TCustomIniFile); +var + PathStrings: TStringList; + I: integer; +begin + PathStrings := TStringList.Create; + IniFile.ReadSection('Directories', PathStrings); + + // Load song-paths + for I := 0 to PathStrings.Count-1 do + begin + if (AnsiStartsText('SongDir', PathStrings[I])) then + begin + AddSongPath(IniFile.ReadString('Directories', PathStrings[I], '')); + end; + end; + + PathStrings.Free; +end; + +procedure TIni.LoadThemes(IniFile: TCustomIniFile); +var + SearchResult: TSearchRec; + ThemeIni: TMemIniFile; + ThemeName: string; + I: integer; +begin + // Theme + SetLength(ITheme, 0); + Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme'); + + FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult); + Repeat + Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme'); + + //Read Themename from Theme + ThemeIni := TMemIniFile.Create(SearchResult.Name); + ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name))); + ThemeIni.Free; + + //Search for Skins for this Theme + for I := Low(Skin.Skin) to High(Skin.Skin) do + begin + if UpperCase(Skin.Skin[I].Theme) = ThemeName then + begin + SetLength(ITheme, Length(ITheme)+1); + ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name); + break; + end; + end; + until FindNext(SearchResult) <> 0; + FindClose(SearchResult); + + // No Theme Found + if (Length(ITheme) = 0) then + begin + Log.CriticalError('Could not find any valid Themes.'); + end; + + Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); + if (Theme = -1) then + Theme := 0; + + // Skin + Skin.onThemeChange; + + SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); +end; + +procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); + + // swap two strings + procedure swap(var s1, s2: string); + var + s3: string; + begin + s3 := s1; + s1 := s2; + s2 := s3; + end; + +var + Modes: PPSDL_Rect; + I: integer; +begin + // Screens + Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); + + // FullScreen + FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); + + // Resolution + SetLength(IResolution, 0); + + // Check if there are any modes available + // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not + // possible to select a reasonable fullscreen mode when in windowed mode + if IFullScreen[FullScreen] = 'On' then + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE) + else + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; + + if (Modes = nil) then + begin + Log.LogStatus( 'No resolutions Found' , 'Video'); + end + else if (Modes = PPSDL_Rect(-1)) then + begin + // Fallback to some standard resolutions + SetLength(IResolution, 10); + IResolution[0] := '640x480'; + IResolution[1] := '800x600'; + IResolution[2] := '1024x768'; + IResolution[3] := '1152x864'; + IResolution[4] := '1280x800'; + IResolution[5] := '1280x960'; + IResolution[6] := '1400x1050'; + IResolution[7] := '1440x900'; + IResolution[8] := '1600x1200'; + IResolution[9] := '1680x1050'; + + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); + if Resolution = -1 then + begin + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600'); + Resolution := High(IResolution); + end; + end + else + begin + while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) + begin + Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video'); + SetLength(IResolution, Length(IResolution) + 1); + IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + Inc(Modes); + end; + + // reverse order + for I := 0 to (Length(IResolution) div 2) - 1 do + begin + swap(IResolution[I], IResolution[High(IResolution)-I]); + end; + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); + + if Resolution = -1 then + begin + Resolution := GetArrayIndex(IResolution, '800x600'); + if Resolution = -1 then + Resolution := 0; + end; + end; + + // if no modes were set, then failback to 800x600 + // as per http://sourceforge.net/forum/message.php?msg_id=4544965 + // THANKS : linnex at users.sourceforge.net + if Length(IResolution) < 1 then + begin + Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video'); + SetLength(IResolution, 1); + IResolution[0] := '800x600'; + Resolution := 0; + Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions'); + + // Default to fullscreen OFF, in this case ! + FullScreen := 0; + end; + + // Depth + Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit')); +end; + +procedure TIni.Load(); +var + IniFile: TMemIniFile; + I: integer; +begin + GamePath := Platform.GetGameUserPath; + + Log.LogStatus( 'GamePath : ' +GamePath , '' ); + + if (Params.ConfigFile <> '') then + try + FileName := Params.ConfigFile; + except + FileName := GamePath + 'config.ini'; + end + else + FileName := GamePath + 'config.ini'; + + Log.LogStatus( 'Using config : ' + FileName , 'Ini'); + IniFile := TMemIniFile.Create( FileName ); + + // Name + for I := 0 to 11 do + Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); + + // Templates for Names Mod + for I := 0 to 2 do + NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); + for I := 0 to 11 do + NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); + + // Players + Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); + + // Difficulty + Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); + + // Language + Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); + //Language.ChangeLanguage(ILanguage[Language]); + + // Tabs + Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); + Tabs_at_startup := Tabs; //Tabs at Startup fix + + // Song Sorting + Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); + + // Debug + Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); + + LoadScreenModes(IniFile); + + // TextureSize + TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1])); + + // SingWindow + SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); + + // Oscilloscope + Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar')); + + // Spectrum + Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off')); + + // Spectrograph + Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off')); + + // MovieSize + MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2])); + + // ClickAssist + ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off')); + + // BeatClick + BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0])); + + // SavePlayback + SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0])); + + // AudioOutputBufferSize + AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0); + + //Preview Volume + PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); + + //Preview Fading + PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); + + //AudioRepeat aka VoicePassthrough + VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0])); + + // Lyrics Font + LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1])); + + // Lyrics Effect + LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1])); + + // Solmization + Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0])); + + // NoteLines + NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); + + LoadThemes(IniFile); + + // Color + Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0])); + + LoadInputDeviceCfg(IniFile); + + // LoadAnimation + LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On')); + + // ScreenFade + ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On')); + + // Visualizations + // this could be of use later.. + // VisualizerOption := + // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption), + // IniFile.ReadString('Graphics', 'Visualization', 'Off'))); + // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'))); + VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')); + +{** + * Background music + *} + BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off')); + + // EffectSing + EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On')); + + // AskbeforeDel + AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On')); + + // OnSongClick + OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); + + // Linebonus + LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score')); + + // PartyPopup + PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); + + // Joypad + Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); + + LoadPaths(IniFile); + + IniFile.Free; +end; + +procedure TIni.Save; +var + IniFile: TIniFile; +begin + if (FileExists(Filename) and FileIsReadOnly(Filename)) then + begin + Log.LogError('Config-file is read-only', 'TIni.Save'); + Exit; + end; + + IniFile := TIniFile.Create(Filename); + + // Players + IniFile.WriteString('Game', 'Players', IPlayers[Players]); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); + + // Language + IniFile.WriteString('Game', 'Language', ILanguage[Language]); + + // Tabs + IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]); + + // Sorting + IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]); + + // Debug + IniFile.WriteString('Game', 'Debug', IDebug[Debug]); + + // Screens + IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]); + + // FullScreen + IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]); + + // Visualization + IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]); + + // Resolution + IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]); + + // Depth + IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]); + + // TextureSize + IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]); + + // Sing Window + IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]); + + // Oscilloscope + IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]); + + // Spectrum + IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]); + + // Spectrograph + IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]); + + // Movie Size + IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]); + + // ClickAssist + IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]); + + // BeatClick + IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]); + + // AudioOutputBufferSize + IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]); + + // Background music + IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]); + + // Song Preview + IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); + + // PreviewFading + IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); + + // SavePlayback + IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]); + + // VoicePasstrough + IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]); + + // Lyrics Font + IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]); + + // Lyrics Effect + IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]); + + // Solmization + IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]); + + // NoteLines + IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); + + // Theme + IniFile.WriteString('Themes', 'Theme', ITheme[Theme]); + + // Skin + IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]); + + // Color + IniFile.WriteString('Themes', 'Color', IColor[Color]); + + SaveInputDeviceCfg(IniFile); + + //LoadAnimation + IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]); + + //EffectSing + IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]); + + //ScreenFade + IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]); + + //AskbeforeDel + IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]); + + //OnSongClick + IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]); + + //Line Bonus + IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]); + + //Party Popup + IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]); + + // Joypad + IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); + + // Directories (add a template if section is missing) + if (not IniFile.SectionExists('Directories')) then + IniFile.WriteString('Directories', 'SongDir1', ''); + + IniFile.Free; +end; + +procedure TIni.SaveNames; +var + IniFile: TIniFile; + I: integer; +begin + if not FileIsReadOnly(Filename) then + begin + IniFile := TIniFile.Create(Filename); + + //Name Templates for Names Mod + for I := 1 to 12 do + IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]); + for I := 1 to 3 do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]); + for I := 1 to 12 do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]); + + IniFile.Free; + end; +end; + +procedure TIni.SaveLevel; +var + IniFile: TIniFile; +begin + if not FileIsReadOnly(Filename) then + begin + IniFile := TIniFile.Create(Filename); + + // Difficulty + IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); + + IniFile.Free; + end; +end; + +end. diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas new file mode 100644 index 00000000..0ca7ba09 --- /dev/null +++ b/src/base/UJoystick.pas @@ -0,0 +1,282 @@ +unit UJoystick; + +interface + +{$I switches.inc} + + +uses SDL; + +type + TJoyButton = record + State: integer; + Enabled: boolean; + Type_: byte; + Sym: cardinal; + end; + + TJoyHatState = record + State: Boolean; + LastTick: Cardinal; + Enabled: boolean; + Type_: byte; + Sym: cardinal; + end; + + TJoyUnit = record + Button: array[0..15] of TJoyButton; + HatState: Array[0..3] of TJoyHatState; + end; + + TJoy = class + constructor Create; + procedure Update; + end; + +var + Joy: TJoy; + JoyUnit: TJoyUnit; + SDL_Joy: PSDL_Joystick; + JoyEvent: TSDL_Event; + +implementation + +uses SysUtils, + ULog; + +constructor TJoy.Create; +var + B, N: integer; +begin + inherited; + + //Old Corvus5 Method + {// joystick support + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks <> 1 then + Log.LogStatus('Joystick count <> 1', 'TJoy.Create'); + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then + Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create'); + + if SDL_JoystickNumButtons(SDL_Joy) <> 16 then + Log.LogStatus('Joystick button count <> 16', 'TJoy.Create'); + +// SDL_JoystickEventState(SDL_ENABLE); + // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE) + + // clear states + for B := 0 to 15 do + JoyUnit.Button[B].State := 1; + + // mapping + JoyUnit.Button[1].Enabled := true; + JoyUnit.Button[1].Type_ := SDL_KEYDOWN; + JoyUnit.Button[1].Sym := SDLK_RETURN; + JoyUnit.Button[2].Enabled := true; + JoyUnit.Button[2].Type_ := SDL_KEYDOWN; + JoyUnit.Button[2].Sym := SDLK_ESCAPE; + + JoyUnit.Button[12].Enabled := true; + JoyUnit.Button[12].Type_ := SDL_KEYDOWN; + JoyUnit.Button[12].Sym := SDLK_LEFT; + JoyUnit.Button[13].Enabled := true; + JoyUnit.Button[13].Type_ := SDL_KEYDOWN; + JoyUnit.Button[13].Sym := SDLK_DOWN; + JoyUnit.Button[14].Enabled := true; + JoyUnit.Button[14].Type_ := SDL_KEYDOWN; + JoyUnit.Button[14].Sym := SDLK_RIGHT; + JoyUnit.Button[15].Enabled := true; + JoyUnit.Button[15].Type_ := SDL_KEYDOWN; + JoyUnit.Button[15].Sym := SDLK_UP; + } + //New Sarutas method + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks < 1 then + begin + Log.LogError('No Joystick found'); + exit; + end; + + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then + begin + Log.LogError('Could not Init Joystick'); + exit; + end; + N := SDL_JoystickNumButtons(SDL_Joy); + //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create'); + + for B := 0 to 5 do begin + JoyUnit.Button[B].Enabled := true; + JoyUnit.Button[B].State := 1; + JoyUnit.Button[B].Type_ := SDL_KEYDOWN; + end; + + JoyUnit.Button[0].Sym := SDLK_Return; + JoyUnit.Button[1].Sym := SDLK_Escape; + JoyUnit.Button[2].Sym := SDLK_M; + JoyUnit.Button[3].Sym := SDLK_R; + + JoyUnit.Button[4].Sym := SDLK_RETURN; + JoyUnit.Button[5].Sym := SDLK_ESCAPE; + + //Set HatState + for B := 0 to 3 do begin + JoyUnit.HatState[B].Enabled := true; + JoyUnit.HatState[B].State := False; + JoyUnit.HatState[B].Type_ := SDL_KEYDOWN; + end; + + JoyUnit.HatState[0].Sym := SDLK_UP; + JoyUnit.HatState[1].Sym := SDLK_RIGHT; + JoyUnit.HatState[2].Sym := SDLK_DOWN; + JoyUnit.HatState[3].Sym := SDLK_LEFT; +end; + +procedure TJoy.Update; +var + B: integer; + State: UInt8; + Tick: Cardinal; + Axes: Smallint; +begin + SDL_JoystickUpdate; + + //Manage Buttons + for B := 0 to 15 do begin + if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin + JoyEvent.type_ := JoyUnit.Button[B].Type_; + JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym; + SDL_PushEvent(@JoyEvent); + end; + end; + + + for B := 0 to 15 do begin + JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B); + end; + + //Get Tick + Tick := SDL_GetTicks(); + + //Get CoolieHat + if (SDL_JoystickNumHats(SDL_Joy)>=1) then + State := SDL_JoystickGetHat(SDL_Joy, 0) + else + State := 0; + + //Get Axis + if (SDL_JoystickNumAxes(SDL_Joy)>=2) then + begin + //Down - Up (X- Axis) + Axes := SDL_JoystickGetAxis(SDL_Joy, 1); + If Axes >= 15000 then + State := State or SDL_HAT_Down + Else If Axes <= -15000 then + State := State or SDL_HAT_UP; + + //Left - Right (Y- Axis) + Axes := SDL_JoystickGetAxis(SDL_Joy, 0); + If Axes >= 15000 then + State := State or SDL_HAT_Right + Else If Axes <= -15000 then + State := State or SDL_HAT_Left; + end; + + //Manage Hat and joystick Events + if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then + begin + + //Up Button + If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then + begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs + if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[0].State then + JoyUnit.HatState[0].Lasttick := Tick + 200 + else + JoyUnit.HatState[0].Lasttick := Tick + 500; + + JoyUnit.HatState[0].State := True; + + JoyEvent.type_ := JoyUnit.HatState[0].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[0].State := False; + + //Right Button + If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then + begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs + if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[1].State then + JoyUnit.HatState[1].Lasttick := Tick + 200 + else + JoyUnit.HatState[1].Lasttick := Tick + 500; + + JoyUnit.HatState[1].State := True; + + JoyEvent.type_ := JoyUnit.HatState[1].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[1].State := False; + + //Down button + If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then + begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs + if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[2].State then + JoyUnit.HatState[2].Lasttick := Tick + 200 + else + JoyUnit.HatState[2].Lasttick := Tick + 500; + + JoyUnit.HatState[2].State := True; + + JoyEvent.type_ := JoyUnit.HatState[2].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[2].State := False; + + //Left Button + If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then + begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs + if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then + begin + //Set Tick and State + if JoyUnit.HatState[3].State then + JoyUnit.HatState[3].Lasttick := Tick + 200 + else + JoyUnit.HatState[3].Lasttick := Tick + 500; + + JoyUnit.HatState[3].State := True; + + JoyEvent.type_ := JoyUnit.HatState[3].Type_; + JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym; + SDL_PushEvent(@JoyEvent); + end; + end + else + JoyUnit.HatState[3].State := False; + end; + +end; + +end. diff --git a/src/base/ULCD.pas b/src/base/ULCD.pas new file mode 100644 index 00000000..82f7ba2f --- /dev/null +++ b/src/base/ULCD.pas @@ -0,0 +1,304 @@ +unit ULCD; + +interface + +{$I switches.inc} + +type + TLCD = class + private + Enabled: boolean; + Text: array[1..6] of string; + StartPos: integer; + LineBR: integer; + Position: integer; + procedure WriteCommand(B: byte); + procedure WriteData(B: byte); + procedure WriteString(S: string); + public + HalfInterface: boolean; + constructor Create; + procedure Enable; + procedure Clear; + procedure WriteText(Line: integer; S: string); + procedure MoveCursor(Line, Pos: integer); + procedure ShowCursor; + procedure HideCursor; + + // for 2x16 + procedure AddTextBR(S: string); + procedure MoveCursorBR(Pos: integer); + procedure ScrollUpBR; + procedure AddTextArray(Line:integer; S: string); + end; + +var + LCD: TLCD; + +const + Data = $378; // domyœlny adres portu + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + SDL, + UTime; + +procedure TLCD.WriteCommand(B: Byte); +// Wysylanie komend sterujacych +begin +{$IFDEF UseSerialPort} + if not HalfInterface then + begin + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, B); + zlioportwrite(Control, 0, $03); + end + else + begin + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, B and $F0); + zlioportwrite(Control, 0, $03); + + SDL_Delay( 100 ); + + zlioportwrite(Control, 0, $02); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $03); + end; + + if (B=1) or (B=2) then + Sleep(2) + else + SDL_Delay( 100 ); +{$ENDIF} +end; + +procedure TLCD.WriteData(B: Byte); +// Wysylanie danych +begin +{$IFDEF UseSerialPort} + if not HalfInterface then + begin + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, B); + zlioportwrite(Control, 0, $07); + end + else + begin + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, B and $F0); + zlioportwrite(Control, 0, $07); + + SDL_Delay( 100 ); + + zlioportwrite(Control, 0, $06); + zlioportwrite(Data, 0, (B * 16) and $F0); + zlioportwrite(Control, 0, $07); + end; + + SDL_Delay( 100 ); + Inc(Position); +{$ENDIF} +end; + +procedure TLCD.WriteString(S: string); +// Wysylanie slow +var + I: integer; +begin + for I := 1 to Length(S) do + WriteData(Ord(S[I])); +end; + +constructor TLCD.Create; +begin + inherited; +end; + +procedure TLCD.Enable; +{var + A: byte; + B: byte;} +begin + Enabled := true; + if not HalfInterface then + WriteCommand($38) + else begin + WriteCommand($33); + WriteCommand($32); + WriteCommand($28); + end; + +// WriteCommand($06); +// WriteCommand($0C); +// sleep(10); +end; + +procedure TLCD.Clear; +begin + if Enabled then begin + WriteCommand(1); + WriteCommand(2); + Text[1] := ''; + Text[2] := ''; + Text[3] := ''; + Text[4] := ''; + Text[5] := ''; + Text[6] := ''; + StartPos := 1; + LineBR := 1; + end; +end; + +procedure TLCD.WriteText(Line: integer; S: string); +begin + if Enabled then begin + if Line <= 2 then begin + MoveCursor(Line, 1); + WriteString(S); + end; + + Text[Line] := ''; + AddTextArray(Line, S); + end; +end; + +procedure TLCD.MoveCursor(Line, Pos: integer); +var + I: integer; +begin + if Enabled then begin + Pos := Pos + (Line-1) * 40; + + if Position > Pos then begin + WriteCommand(2); + for I := 1 to Pos-1 do + WriteCommand(20); + end; + + if Position < Pos then + for I := 1 to Pos - Position do + WriteCommand(20); + + Position := Pos; + end; +end; + +procedure TLCD.ShowCursor; +begin + if Enabled then begin + WriteCommand(14); + end; +end; + +procedure TLCD.HideCursor; +begin + if Enabled then begin + WriteCommand(12); + end; +end; + +procedure TLCD.AddTextBR(S: string); +var + Word: string; +// W: integer; + P: integer; + L: integer; +begin + if Enabled then begin + if LineBR <= 6 then begin + L := LineBR; + P := Pos(' ', S); + + if L <= 2 then + MoveCursor(L, 1); + + while (L <= 6) and (P > 0) do begin + Word := Copy(S, 1, P); + if (Length(Text[L]) + Length(Word)-1) > 16 then begin + L := L + 1; + if L <= 2 then + MoveCursor(L, 1); + end; + + if L <= 6 then begin + if L <= 2 then + WriteString(Word); + AddTextArray(L, Word); + end; + + Delete(S, 1, P); + P := Pos(' ', S) + end; + + LineBR := L + 1; + end; + end; +end; + +procedure TLCD.MoveCursorBR(Pos: integer); +{var + I: integer; + L: integer;} +begin + if Enabled then begin + Pos := Pos - (StartPos-1); + if Pos <= Length(Text[1]) then + MoveCursor(1, Pos); + + if Pos > Length(Text[1]) then begin + // bez zawijania +// Pos := Pos - Length(Text[1]); +// MoveCursor(2, Pos); + + // z zawijaniem + Pos := Pos - Length(Text[1]); + ScrollUpBR; + MoveCursor(1, Pos); + end; + end; +end; + +procedure TLCD.ScrollUpBR; +var + T: array[1..5] of string; + SP: integer; + LBR: integer; +begin + if Enabled then begin + T[1] := Text[2]; + T[2] := Text[3]; + T[3] := Text[4]; + T[4] := Text[5]; + T[5] := Text[6]; + SP := StartPos + Length(Text[1]); + LBR := LineBR; + + Clear; + + StartPos := SP; + WriteText(1, T[1]); + WriteText(2, T[2]); + WriteText(3, T[3]); + WriteText(4, T[4]); + WriteText(5, T[5]); + LineBR := LBR-1; + end; +end; + +procedure TLCD.AddTextArray(Line: integer; S: string); +begin + if Enabled then begin + Text[Line] := Text[Line] + S; + end; +end; + +end. + diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas new file mode 100644 index 00000000..d534b4e1 --- /dev/null +++ b/src/base/ULanguage.pas @@ -0,0 +1,240 @@ +unit ULanguage; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + TLanguageEntry = record + ID: string; + Text: string; + end; + + TLanguageList = record + Name: string; + {FileName: string; } + end; + + TLanguage = class + public + Entry: array of TLanguageEntry; //Entrys of Chosen Language + SEntry: array of TLanguageEntry; //Entrys of Standard Language + CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version + Implode_Glue1, Implode_Glue2: String; + public + List: array of TLanguageList; + + constructor Create; + procedure LoadList; + function Translate(Text: String): String; + procedure ChangeLanguage(Language: String); + procedure AddConst(ID, Text: String); + procedure ChangeConst(ID, Text: String); + function Implode(Pieces: Array of String): String; + end; + +var + Language: TLanguage; + +implementation + +uses UMain, + // UFiles, + UIni, + IniFiles, + Classes, + SysUtils, + {$IFDEF win32} + windows, + {$ENDIF} + ULog; + +//---------- +//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues +//---------- +constructor TLanguage.Create; +var + I, J: Integer; +begin + inherited; + + LoadList; + + //Set Implode Glues for Backward Compatibility + Implode_Glue1 := ', '; + Implode_Glue2 := ' and '; + + if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading + Log.CriticalError('Could not load any Language File'); + + //Standard Language (If a Language File is Incomplete) + //Then use English Language + for I := 0 to high(List) do //Search for English Language + begin + //English Language Found -> Load + if Uppercase(List[I].Name) = 'ENGLISH' then + begin + ChangeLanguage('English'); + + SetLength(SEntry, Length(Entry)); + for J := low(Entry) to high(Entry) do + SEntry[J] := Entry[J]; + + SetLength(Entry, 0); + + Break; + end; + + if (I = high(List)) then + Log.LogError('English Languagefile missing! No standard Translation loaded'); + end; + //Standard Language END + +end; + +//---------- +//LoadList - Parse the Language Dir searching Translations +//---------- +procedure TLanguage.LoadList; +var + SR: TSearchRec; // for parsing directory +begin + SetLength(List, 0); + SetLength(ILanguage, 0); + + if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin + repeat + SetLength(List, Length(List)+1); + SetLength(ILanguage, Length(ILanguage)+1); + SR.Name := ChangeFileExt(SR.Name, ''); + + List[High(List)].Name := SR.Name; + ILanguage[High(ILanguage)] := SR.Name; + + until FindNext(SR) <> 0; + SysUtils.FindClose(SR); + end; // if FindFirst +end; + +//---------- +//ChangeLanguage - Load the specified LanguageFile +//---------- +procedure TLanguage.ChangeLanguage(Language: String); +var + IniFile: TIniFile; + E: integer; // entry + S: TStringList; +begin + SetLength(Entry, 0); + IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); + S := TStringList.Create; + + IniFile.ReadSectionValues('Text', S); + SetLength(Entry, S.Count); + for E := 0 to high(Entry) do + begin + if S.Names[E] = 'IMPLODE_GLUE1' then + Implode_Glue1 := S.ValueFromIndex[E]+ ' ' + else if S.Names[E] = 'IMPLODE_GLUE2' then + Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' '; + + Entry[E].ID := S.Names[E]; + Entry[E].Text := S.ValueFromIndex[E]; + end; + + S.Free; + IniFile.Free; +end; + +//---------- +//Translate - Translate the Text +//---------- +Function TLanguage.Translate(Text: String): String; +var + E: integer; // entry +begin + Result := Text; + Text := Uppercase(Result); + + //Const Mod + for E := 0 to high(CEntry) do + if Text = CEntry[E].ID then + begin + Result := CEntry[E].Text; + exit; + end; + //Const Mod End + + for E := 0 to high(Entry) do + if Text = Entry[E].ID then + begin + Result := Entry[E].Text; + exit; + end; + + //Standard Language (If a Language File is Incomplete) + //Then use Standard Language + for E := low(SEntry) to high(SEntry) do + if Text = SEntry[E].ID then + begin + Result := SEntry[E].Text; + Break; + end; + //Standard Language END +end; + +//---------- +//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile +//---------- +procedure TLanguage.AddConst (ID, Text: String); +begin + SetLength (CEntry, Length(CEntry) + 1); + CEntry[high(CEntry)].ID := ID; + CEntry[high(CEntry)].Text := Text; +end; + +//---------- +//ChangeConst - Change a Constant Value by ID +//---------- +procedure TLanguage.ChangeConst(ID, Text: String); +var + I: Integer; +begin + for I := 0 to high(CEntry) do + begin + if CEntry[I].ID = ID then + begin + CEntry[I].Text := Text; + Break; + end; + end; +end; + +//---------- +//Implode - Connect an Array of Strings with ' and ' or ', ' to one String +//---------- +function TLanguage.Implode(Pieces: Array of String): String; +var + I: Integer; +begin + Result := ''; + //Go through Pieces + for I := low(Pieces) to high(Pieces) do + begin + //Add Value + Result := Result + Pieces[I]; + + //Add Glue + if (I < high(Pieces) - 1) then + Result := Result + Implode_Glue1 + else if (I < high(Pieces)) then + Result := Result + Implode_Glue2; + end; +end; + +end. diff --git a/src/base/ULight.pas b/src/base/ULight.pas new file mode 100644 index 00000000..a0a399ab --- /dev/null +++ b/src/base/ULight.pas @@ -0,0 +1,145 @@ +unit ULight; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TLight = class + private + Enabled: boolean; + Light: array[0..7] of boolean; + LightTime: array[0..7] of real; // time to stop, need to call update to change state + LastTime: real; + public + constructor Create; + procedure Enable; + procedure SetState(State: integer); + procedure AutoSetState; + procedure TurnOn; + procedure TurnOff; + procedure LightOne(Number: integer; Time: real); + procedure Refresh; + end; + +var + Light: TLight; + +const + Data = $378; // default port address + Status = Data + 1; + Control = Data + 2; + +implementation + +uses + SysUtils, + {$IFDEF UseSerialPort} + zlportio, + {$ENDIF} + UTime; + +{$IFDEF FPC} + + function GetTime: TDateTime; + var + SystemTime: TSystemTime; + begin + GetLocalTime(SystemTime); + with SystemTime do + begin + {$IFDEF UNIX} + Result := EncodeTime(Hour, Minute, Second, MilliSecond); + {$ELSE} + Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); + {$ENDIF} + end; + end; + +{$ENDIF} + + +constructor TLight.Create; +begin + inherited; + Enabled := false; +end; + +procedure TLight.Enable; +begin + Enabled := true; + LastTime := GetTime; +end; + +procedure TLight.SetState(State: integer); +begin + {$IFDEF UseSerialPort} + if Enabled then + PortWriteB($378, State); + {$ENDIF} +end; + +procedure TLight.AutoSetState; +var + State: integer; +begin + if Enabled then begin + State := 0; + if Light[0] then State := State + 2; + if Light[1] then State := State + 1; + // etc + SetState(State); + end; +end; + +procedure TLight.TurnOn; +begin + if Enabled then + SetState(3); +end; + +procedure TLight.TurnOff; +begin + if Enabled then + SetState(0); +end; + +procedure TLight.LightOne(Number: integer; Time: real); +begin + if Enabled then begin + if Light[Number] = false then begin + Light[Number] := true; + AutoSetState; + end; + + LightTime[Number] := GetTime + Time/1000; // [s] + end; +end; + +procedure TLight.Refresh; +var + Time: real; + L: integer; +begin + if Enabled then begin + Time := GetTime; + for L := 0 to 7 do begin + if Light[L] = true then begin + if LightTime[L] > Time then begin + end else begin + Light[L] := false; + end; + end; + end; + LastTime := Time; + AutoSetState; + end; +end; + +end. + + diff --git a/src/base/ULog.pas b/src/base/ULog.pas new file mode 100644 index 00000000..a9a2f3c4 --- /dev/null +++ b/src/base/ULog.pas @@ -0,0 +1,417 @@ +unit ULog; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes; + +(* + * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each + * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type. + * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g. + * "Level := LOG_LEVEL_ERROR+2" is considered an error level. + * This is nice for debugging if you have more or less important debug messages. + * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and + * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level + * you can hide the less important ones. + *) +const + LOG_LEVEL_DEBUG_MAX = MaxInt; + LOG_LEVEL_DEBUG = 50; + LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1; + LOG_LEVEL_INFO = 40; + LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1; + LOG_LEVEL_STATUS = 30; + LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1; + LOG_LEVEL_WARN = 20; + LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1; + LOG_LEVEL_ERROR = 10; + LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1; + LOG_LEVEL_CRITICAL = 0; + LOG_LEVEL_NONE = -1; + + // define level that Log(File)Level is initialized with + LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN; + LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR; + +type + TLog = class + private + LogFile: TextFile; + LogFileOpened: boolean; + BenchmarkFile: TextFile; + BenchmarkFileOpened: boolean; + + LogLevel: integer; + // level of messages written to the log-file + LogFileLevel: integer; + + procedure LogToFile(const Text: string); + public + BenchmarkTimeStart: array[0..31] of real; + BenchmarkTimeLength: array[0..31] of real;//TDateTime; + + Title: String; //Application Title + + // Write log message to log-file + FileOutputEnabled: Boolean; + + constructor Create; + + // destuctor + destructor Destroy; override; + + // benchmark + procedure BenchmarkStart(Number: integer); + procedure BenchmarkEnd(Number: integer); + procedure LogBenchmark(const Text: string; Number: integer); + + procedure SetLogLevel(Level: integer); + function GetLogLevel(): integer; + + procedure LogMsg(const Text: string; Level: integer); overload; + procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF} + procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF} + procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF} + //Critical Error (Halt + MessageBox) + procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} + procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF} + + // voice + procedure LogVoice(SoundNr: integer); + // buffer + procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string); + end; + +procedure DebugWriteln(const aString: String); + +var + Log: TLog; + +implementation + +uses + SysUtils, + DateUtils, + URecord, + UMain, + UTime, + UCommon, + UCommandLine; + +(* + * Write to console if in debug mode (Thread-safe). + * If debug-mode is disabled nothing is done. + *) +procedure DebugWriteln(const aString: string); +begin + {$IFNDEF DEBUG} + if Params.Debug then + begin + {$ENDIF} + ConsoleWriteLn(aString); + {$IFNDEF DEBUG} + end; + {$ENDIF} +end; + + +constructor TLog.Create; +begin + inherited; + LogLevel := LOG_LEVEL_DEFAULT; + LogFileLevel := LOG_FILE_LEVEL_DEFAULT; + FileOutputEnabled := true; +end; + +destructor TLog.Destroy; +begin + if BenchmarkFileOpened then + CloseFile(BenchmarkFile); + //if AnalyzeFileOpened then + // CloseFile(AnalyzeFile); + if LogFileOpened then + CloseFile(LogFile); + inherited; +end; + +procedure TLog.BenchmarkStart(Number: integer); +begin + BenchmarkTimeStart[Number] := USTime.GetTime; //Time; +end; + +procedure TLog.BenchmarkEnd(Number: integer); +begin + BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; +end; + +procedure TLog.LogBenchmark(const Text: string; Number: integer); +var + Minutes: integer; + Seconds: integer; + Miliseconds: integer; + + MinutesS: string; + SecondsS: string; + MilisecondsS: string; + + ValueText: string; +begin + if (FileOutputEnabled and Params.Benchmark) then + begin + if not BenchmarkFileOpened then + begin + BenchmarkFileOpened := true; + AssignFile(BenchmarkFile, LogPath + 'Benchmark.log'); + {$I-} + Rewrite(BenchmarkFile); + if IOResult = 0 then + BenchmarkFileOpened := true; + {$I+} + + //If File is opened write Date to Benchmark File + If (BenchmarkFileOpened) then + begin + WriteLn(BenchmarkFile, Title + ' Benchmark File'); + WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(BenchmarkFile, '-------------------'); + + Flush(BenchmarkFile); + end; + end; + + if BenchmarkFileOpened then + begin + Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); + Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; + Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); + //ValueText := FloatToStr(BenchmarkTimeLength[Number]); + + { + ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) + + MilliSecondOf(BenchmarkTimeLength[Number])/1000); + if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then + ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; + WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds'); + } + + if (Minutes = 0) and (Seconds = 0) then begin + MilisecondsS := IntToStr(Miliseconds); + ValueText := MilisecondsS + ' miliseconds'; + end; + + if (Minutes = 0) and (Seconds >= 1) then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do + MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + + ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; + end; + + if Minutes >= 1 then begin + MilisecondsS := IntToStr(Miliseconds); + while Length(MilisecondsS) < 3 do + MilisecondsS := '0' + MilisecondsS; + + SecondsS := IntToStr(Seconds); + while Length(SecondsS) < 2 do + SecondsS := '0' + SecondsS; + + MinutesS := IntToStr(Minutes); + + ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; + end; + + WriteLn(BenchmarkFile, Text + ': ' + ValueText); + Flush(BenchmarkFile); + end; + end; +end; + +procedure TLog.LogToFile(const Text: string); +begin + if (FileOutputEnabled and not LogFileOpened) then + begin + AssignFile(LogFile, LogPath + 'Error.log'); + {$I-} + Rewrite(LogFile); + if IOResult = 0 then + LogFileOpened := true; + {$I+} + + //If File is opened write Date to Error File + if (LogFileOpened) then + begin + WriteLn(LogFile, Title + ' Error Log'); + WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); + WriteLn(LogFile, '-------------------'); + + Flush(LogFile); + end; + end; + + if LogFileOpened then + begin + try + WriteLn(LogFile, Text); + Flush(LogFile); + except + LogFileOpened := false; + end; + end; +end; + +procedure TLog.SetLogLevel(Level: integer); +begin + LogLevel := Level; +end; + +function TLog.GetLogLevel(): integer; +begin + Result := LogLevel; +end; + +procedure TLog.LogMsg(const Text: string; Level: integer); +var + LogMsg: string; +begin + // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to + // console or do not log at all? At the moment nothing is logged. + if (Level <= LogLevel) then + begin + if (Level <= LOG_LEVEL_CRITICAL_MAX) then + LogMsg := 'CRITICAL: ' + Text + else if (Level <= LOG_LEVEL_ERROR_MAX) then + LogMsg := 'ERROR: ' + Text + else if (Level <= LOG_LEVEL_WARN_MAX) then + LogMsg := 'WARN: ' + Text + else if (Level <= LOG_LEVEL_STATUS_MAX) then + LogMsg := 'STATUS: ' + Text + else if (Level <= LOG_LEVEL_INFO_MAX) then + LogMsg := 'INFO: ' + Text + else + LogMsg := 'DEBUG: ' + Text; + + // output log-message + if (Level <= LogLevel) then + begin + DebugWriteLn(LogMsg); + end; + + // write message to log-file + if (Level <= LogFileLevel) then + begin + LogToFile(LogMsg); + end; + end; + + // exit application on criticial errors (cannot be turned off) + if (Level <= LOG_LEVEL_CRITICAL_MAX) then + begin + // Show information (window) + ShowMessage(Text, mtError); + Halt; + end; +end; + +procedure TLog.LogMsg(const Msg, Context: string; Level: integer); +begin + LogMsg(Msg + ' ['+Context+']', Level); +end; + +procedure TLog.LogDebug(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_DEBUG); +end; + +procedure TLog.LogInfo(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_INFO); +end; + +procedure TLog.LogStatus(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_STATUS); +end; + +procedure TLog.LogWarn(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_WARN); +end; + +procedure TLog.LogError(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_ERROR); +end; + +procedure TLog.LogError(const Text: string); +begin + LogMsg(Text, LOG_LEVEL_ERROR); +end; + +procedure TLog.CriticalError(const Text: string); +begin + LogMsg(Text, LOG_LEVEL_CRITICAL); +end; + +procedure TLog.LogCritical(const Msg, Context: string); +begin + LogMsg(Msg, Context, LOG_LEVEL_CRITICAL); +end; + +procedure TLog.LogVoice(SoundNr: integer); +var + FS: TFileStream; + FileName: string; + Num: integer; +begin + for Num := 1 to 9999 do begin + FileName := IntToStr(Num); + while Length(FileName) < 4 do + FileName := '0' + FileName; + FileName := LogPath + 'Voice' + FileName + '.raw'; + if not FileExists(FileName) then + break + end; + + FS := TFileStream.Create(FileName, fmCreate); + + AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning); + FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size); + + FS.Free; +end; + +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string); +var + f : TFileStream; +begin + f := nil; + + try + f := TFileStream.Create( filename, fmCreate); + f.Write( buf^, bufLength); + f.Free; + except + on e : Exception do begin + Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); + f.Free; + end; + end; +end; + +end. + + diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas new file mode 100644 index 00000000..305cb91f --- /dev/null +++ b/src/base/ULyrics.pas @@ -0,0 +1,884 @@ +unit ULyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + glext, + UTexture, + UThemes, + UMusic; + +type + // stores two textures for enabled/disabled states + TPlayerIconTex = array [0..1] of TTexture; + + PLyricWord = ^TLyricWord; + TLyricWord = record + X: Real; // left corner + Width: Real; // width + Start: Cardinal; // start of the word in quarters (beats) + Length: Cardinal; // length of the word in quarters + Text: String; // text + Freestyle: Boolean; // is freestyle? + end; + ALyricWord = array of TLyricWord; + + TLyricLine = class + public + Text: String; // text + Tex: glUInt; // texture of the text + Width: Real; // width + Size: Byte; // fontsize + Words: ALyricWord; // words in this line + CurWord: Integer; // current active word idx (only valid if line is active) + Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap) + StartNote: Integer; // start of the first note of this line in quarters + Length: Integer; // length in quarters (from start of first to the end of the last note) + HasFreestyle: Boolean; // one or more word are freestyle? + CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line + Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) + LastLine: Boolean; // is this the last line of the song? + + constructor Create(); + destructor Destroy(); override; + procedure Reset(); + end; + + TLyricEngine = class + private + LastDrawBeat: Real; + UpperLine: TLyricLine; // first line displayed (top) + LowerLine: TLyricLine; // second lind displayed (bottom) + QueueLine: TLyricLine; // third line (will be displayed when lower line is finished) + + IndicatorTex: TTexture; // texture for lyric indikator + BallTex: TTexture; // texture of the ball for the lyric effect + + QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine + LCounter: Word; // line counter + + // duet mode - textures for player icons + // FIXME: do not use a fixed player count, use MAX_PLAYERS instead + PlayerIconTex: array[0..5] of TPlayerIconTex; + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); + procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); + procedure DrawBall(XBall, YBall, Alpha:Real); + + public + // positions, line specific settings + UpperLineX: Real; //X Start Pos of UpperLine + UpperLineW: Real; //Width of UpperLine with Icon(s) and Text + UpperLineY: Real; //Y Start Pos of UpperLine + UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine + + LowerLineX: Real; //X Start Pos of LowerLine + LowerLineW: Real; //Width of LowerLine with Icon(s) and Text + LowerLineY: Real; //Y Start Pos of LowerLine + LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine + + // display propertys + LineColor_en: TRGBA; //Color of Words in an Enabled Line + LineColor_dis: TRGBA; //Color of Words in a Disabled Line + LineColor_act: TRGBA; //Color of teh active Word + FontStyle: Byte; //Font for the Lyric Text + FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen + + { // currently not used + FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos + FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards + } + + UseLinearFilter: Boolean; //Should Linear Tex Filter be used + + // song specific settings + BPM: Real; + Resolution: Integer; + + // properties to easily read options of this class + property IsQueueFull: Boolean read QueueFull; // line in queue? + property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear) + + procedure AddLine(Line: PLine); // adds a line to the queue, if there is space + procedure Draw (Beat: Real); // draw the current (active at beat) lyrics + + // clears all cached song specific information + procedure Clear(cBPM: Real = 0; cResolution: Integer = 0); + + function GetUpperLine(): TLyricLine; + function GetLowerLine(): TLyricLine; + + function GetUpperLineIndex(): Integer; + + constructor Create; overload; + constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload; + procedure LoadTextures; + destructor Destroy; override; + end; + +implementation + +uses SysUtils, + USkins, + TextGL, + UGraphic, + UDisplay, + ULog, + math, + UIni; + +//----------- +//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else +//----------- +procedure glColorRGB(Color: TRGB); overload; +begin + glColor3f(Color.R, Color.G, Color.B); +end; + +procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Alpha); +end; + +procedure glColorRGB(Color: TRGBA); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Color.A); +end; + +procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); +end; + +{ TLyricLine } + +constructor TLyricLine.Create(); +begin + inherited; + Reset(); +end; + +destructor TLyricLine.Destroy(); +begin + SetLength(Words, 0); + inherited; +end; + +procedure TLyricLine.Reset(); +begin + Start := 0; + StartNote := 0; + Length := 0; + LastLine := False; + + Text := ''; + Width := 0; + + // duet mode: players of that line (default: all) + Players := $FF; + + SetLength(Words, 0); + CurWord := -1; + + HasFreestyle := False; + CountFreestyle := 0; +end; + + +{ TLyricEngine } + +//--------------- +// Create - Constructor, just get Memory +//--------------- +constructor TLyricEngine.Create; +begin + inherited; + + BPM := 0; + Resolution := 0; + LCounter := 0; + QueueFull := False; + + UpperLine := TLyricLine.Create; + LowerLine := TLyricLine.Create; + QueueLine := TLyricLine.Create; + + UseLinearFilter := True; + LastDrawBeat := 0; +end; + +constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); +begin + Create; + + UpperLineX := ULX; + UpperLineW := ULW; + UpperLineY := ULY; + UpperLineSize := Trunc(ULS); + + LowerLineX := LLX; + LowerLineW := LLW; + LowerLineY := LLY; + LowerLineSize := Trunc(LLS); + + LoadTextures; +end; + + +//--------------- +// Destroy - Frees Memory +//--------------- +destructor TLyricEngine.Destroy; +begin + UpperLine.Free; + LowerLine.Free; + QueueLine.Free; + inherited; +end; + +//--------------- +// Clear - Clears all cached Song specific Information +//--------------- +procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer); +begin + BPM := cBPM; + Resolution := cResolution; + LCounter := 0; + QueueFull := False; + + LastDrawBeat:=0; +end; + + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +procedure TLyricEngine.LoadTextures; +var + I: Integer; + + function CreateLineTex: glUint; + begin + // generate and bind Texture + glGenTextures(1, @Result); + glBindTexture(GL_TEXTURE_2D, Result); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + if UseLinearFilter then + begin + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + end; + end; + +begin + + // lyric indicator (bar that indicates when the line start) + IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + + // ball for current word hover in ball effect + BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0); + + // duet mode: load player icon + for I := 0 to 5 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); + PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); + end; + + // create line textures + UpperLine.Tex := CreateLineTex; + LowerLine.Tex := CreateLineTex; + QueueLine.Tex := CreateLineTex; +end; + + +//--------------- +// AddLine - Adds LyricLine to queue +// The LyricEngine stores three lines in its queue: +// UpperLine: the upper line displayed in the lyrics +// LowerLine: the lower line displayed in the lyrics +// QueueLine: an offscreen line that precedes LowerLine +// If the queue is full the next call to AddLine will replace UpperLine with +// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. +//--------------- +procedure TLyricEngine.AddLine(Line: PLine); +var + LyricLine: TLyricLine; + PosX: Real; + I: Integer; + CurWord: PLyricWord; + RenderPass: Integer; + + function CalcWidth(LyricLine: TLyricLine): Real; + begin + Result := glTextWidth(PChar(LyricLine.Text)); + + Result := Result + (LyricLine.CountFreestyle * 10); + + // if the line ends with a freestyle not, then leave the place to finish to draw the text italic + if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then + Result := Result + 12; + end; + +begin + // only add lines, if there is space + if not IsQueueFull then + begin + // set LyricLine to line to write to + if (LineCounter = 0) then + LyricLine := UpperLine + else if (LineCounter = 1) then + LyricLine := LowerLine + else + begin + // now the queue is full + LyricLine := QueueLine; + QueueFull := True; + end; + end + else + begin // rotate lines (round-robin-like) + LyricLine := UpperLine; + UpperLine := LowerLine; + LowerLine := QueueLine; + QueueLine := LyricLine; + end; + + // reset line state + LyricLine.Reset(); + + // check if sentence has notes + if (Line <> nil) and (Length(Line.Note) > 0) then + begin + // copy values from SongLine to LyricLine + LyricLine.Start := Line.Start; + LyricLine.StartNote := Line.Note[0].Start; + LyricLine.Length := Line.Note[High(Line.Note)].Start + + Line.Note[High(Line.Note)].Length - + Line.Note[0].Start; + LyricLine.LastLine := Line.LastLine; + + // copy words + SetLength(LyricLine.Words, Length(Line.Note)); + for I := 0 to High(Line.Note) do + begin + LyricLine.Words[I].Start := Line.Note[I].Start; + LyricLine.Words[I].Length := Line.Note[I].Length; + LyricLine.Words[I].Text := Line.Note[I].Text; + LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle; + + LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle; + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; + + if (I > 0) and + LyricLine.Words[I-1].Freestyle and + not LyricLine.Words[I].Freestyle then + begin + Inc(LyricLine.CountFreestyle); + end; + end; + + // set font params + SetFontStyle(FontStyle); + SetFontPos(0, 0); + LyricLine.Size := UpperLineSize; + SetFontSize(LyricLine.Size); + SetFontItalic(False); + SetFontReflection(False, 0); + glColor4f(1, 1, 1, 1); + + // change fontsize to fit the screen + LyricLine.Width := CalcWidth(LyricLine); + while (LyricLine.Width > UpperLineW) do + begin + Dec(LyricLine.Size); + + if (LyricLine.Size <=1) then + Break; + + SetFontSize(LyricLine.Size); + LyricLine.Width := CalcWidth(LyricLine); + end; + + // Offscreen rendering of LyricTexture: + // First we will create a white transparent background to draw on. + // If the text was simply drawn to the screen with blending, the translucent + // parts of the text would be merged with the current color of the background. + // This would result in a texture that partly contains the screen we are + // drawing on. This will be visible in the fonts outline when the LyricTexture + // is drawn to the screen later. + // So we have to draw the text in TWO passes. + // At the first pass we copy the characters to the back-buffer in such a way + // that preceding characters are not repainted by following chars (otherwise + // some characters would be blended twice in the 2nd pass). + // To achieve this we disable blending and enable the depth-test. The z-buffer + // is used as a mask or replacement for the missing stencil-buffer. A z-value + // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel + // that was already drawn on. In addition we set the depth-func in such a way + // that assigned pixels (0) will not be drawn a second time. + // At the second pass we draw the text with blending and without depth-test. + // This will blend overlapping characters but not the background as it was + // repainted in the first pass. + + glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT); + glViewPort(0, 0, 800, 600); + glClearColor(0, 0, 0, 0); + glDepthRange(0, 1); + glClearDepth(1); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + SetFontZ(0); + + // assure blending is off and the correct depth-func is enabled + glDisable(GL_BLEND); + glDepthFunc(GL_LESS); + + // we need two passes to draw the font onto the screen. + for RenderPass := 0 to 1 do + begin + if (RenderPass = 0) then + begin + // first pass: simply copy each character to the screen without overlapping. + SetFontBlend(false); + glEnable(GL_DEPTH_TEST); + end + else + begin + // second pass: now we will blend overlapping characters. + SetFontBlend(true); + glDisable(GL_DEPTH_TEST); + end; + + PosX := 0; + + // set word positions and line size and draw the line to the back-buffer + for I := 0 to High(LyricLine.Words) do + begin + CurWord := @LyricLine.Words[I]; + + SetFontItalic(CurWord.Freestyle); + + CurWord.X := PosX; + + // Draw Lyrics + SetFontPos(PosX, 0); + glPrint(PChar(CurWord.Text)); + + CurWord.Width := glTextWidth(PChar(CurWord.Text)); + if CurWord.Freestyle then + begin + if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then + CurWord.Width := CurWord.Width + 10 + else if (I = High(LyricLine.Words)) then + CurWord.Width := CurWord.Width + 12; + end; + PosX := PosX + CurWord.Width; + end; + end; + + // copy back-buffer to texture + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + // FIXME: this does not work this way + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); + if (glGetError() <> GL_NO_ERROR) then + Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine'); + + // restore OpenGL state + glPopAttrib(); + + // clear buffer (use white to avoid flimmering if no cover/video is available) + glClearColor(1, 1, 1, 1); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; // if (Line <> nil) and (Length(Line.Note) > 0) + + // increase the counter + Inc(LCounter); +end; + + +//--------------- +// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters +// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics +//--------------- +procedure TLyricEngine.Draw(Beat: Real); +begin + DrawLyrics(Beat); + LastDrawBeat := Beat; +end; + +//--------------- +// DrawLyrics(private) - Helper for Draw; main Drawing procedure +//--------------- +procedure TLyricEngine.DrawLyrics(Beat: Real); +begin + DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); +end; + +//--------------- +// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon +//--------------- +procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); +var + IEnabled: Byte; +begin + if Enabled then + IEnabled := 0 + else + IEnabled := 1; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); + + glColor4f(1, 1, 1, Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, 1); glVertex2f(X, Y + Size); + glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); + glTexCoord2f(1, 0); glVertex2f(X + Size, Y); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +//--------------- +// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed +//--------------- +procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real); +begin + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, BallTex.TexNum); + + glColor4f(1, 1, 1, Alpha); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall); + glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20); + glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20); + glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); +end; + +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); +var + CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence + FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics + Progress: Real; // progress of singing the current word + LyricX: Real; // left + LyricX2: Real; // right + LyricY: Real; // top + LyricsHeight: Real; // height the lyrics are displayed + Alpha: Real; // alphalevel to fade out at end + CurWord, LastWord: PLyricWord; // current word + + {// duet mode + IconSize: Real; // size of player icons + IconAlpha: Real; // alpha level of player icons + } +begin + // do not draw empty lines + // Note: lines with no words in it do not have a valid texture + if (Length(Line.Words) = 0) or + (Line.Width <= 0) then + begin + Exit; + end; + + // this is actually a bit more than the real font size + // it helps adjusting the "zoom-center" + LyricsHeight := 30.5 * (Line.Size/10); + + { + // duet mode + IconSize := (2 * Size); + IconAlpha := Frac(Beat/(Resolution*4)); + + DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha); + DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha); + DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha); + } + + LyricX := X + W/2 - Line.Width/2; + LyricX2 := LyricX + Line.Width; + + // maybe center smaller lines + //LyricY := Y; + LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2; + + Alpha := 1; + + // check if this line is active (at least its first note must be active) + if (Beat >= Line.StartNote) then + begin + // if this line just got active, CurWord is -1, + // this means we should try to make the first word active + if (Line.CurWord = -1) then + Line.CurWord := 0; + + // check if the current active word is still active. + // Otherwise proceed to the next word if there is one in this line. + // Note: the max. value of Line.CurWord is High(Line.Words) + if (Line.CurWord < High(Line.Words)) and + (Beat >= Line.Words[Line.CurWord + 1].Start) then + begin + Inc(Line.CurWord); + end; + + FreestyleDiff := 0; + + // determine current and last word in this line. + // If the end of the line is reached use the last word as current word. + LastWord := @Line.Words[High(Line.Words)]; + CurWord := @Line.Words[Line.CurWord]; + + // calc the progress of the lyrics effect + Progress := (Beat - CurWord.Start) / CurWord.Length; + if Progress >= 1 then + Progress := 1; + if Progress <= 0 then + Progress := 0; + + // last word of this line finished, but this line did not hide -> fade out + if Line.LastLine and + (Beat > LastWord.Start + LastWord.Length) then + begin + Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15; + if (Alpha < 0) then + Alpha := 0; + end; + + // determine the start-/end positions of the fragment of the current word + CurWordStart := CurWord.X; + CurWordEnd := CurWord.X + CurWord.Width; + + // Slide Effect + // simply paint the active texture to the current position + if Ini.LyricsEffect = 2 then + begin + CurWordStart := CurWordStart + CurWord.Width * Progress; + CurWordEnd := CurWordStart; + end; + + if CurWord.Freestyle then + begin + if (Line.CurWord < High(Line.Words)) and + (not Line.Words[Line.CurWord + 1].Freestyle) then + begin + FreestyleDiff := 2; + end + else + begin + FreestyleDiff := 12; + CurWordStart := CurWordStart - 1; + CurWordEnd := CurWordEnd - 2; + end; + end; + + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + // draw sentence up to current word + // type 0: simple lyric effect + // type 3: ball lyric effect + // type 4: shift lyric effect + if (Ini.LyricsEffect in [0, 3, 4]) then + // ball lyric effect - only highlight current word and not that ones before in this line + glColorRGB(LineColor_en, Alpha) + else + glColorRGB(LineColor_act, Alpha); + + glBegin(GL_QUADS); + glTexCoord2f(0, 1); + glVertex2f(LyricX, LyricY); + + glTexCoord2f(0, 1-LyricsHeight/64); + glVertex2f(LyricX, LyricY + LyricsHeight); + + glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); + glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight); + + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); + glEnd; + + // draw rest of sentence + glColorRGB(LineColor_en, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); + + glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); + glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); + glVertex2f(LyricX2, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1); + glVertex2f(LyricX2, LyricY); + glEnd; + + // draw active word: + // type 0: simple lyric effect + // type 3: ball lyric effect + // type 4: shift lyric effect + // only change the color of the current word + if (Ini.LyricsEffect in [0, 3, 4]) then + begin + if (Ini.LyricsEffect = 4) then + LyricY := LyricY - 8 * (1-Progress); + + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); + + glTexCoord2f(CurWordStart/1024, 0); + glVertex2f(LyricX + CurWordStart, LyricY + 64); + + glTexCoord2f(CurWordEnd/1024, 0); + glVertex2f(LyricX + CurWordEnd, LyricY + 64); + + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); + glEnd; + + if (Ini.LyricsEffect = 4) then + LyricY := LyricY + 8 * (1-Progress); + end + + // draw active word: + // type 1: zoom lyric effect + // change color and zoom current word + else if Ini.LyricsEffect = 1 then + begin + glPushMatrix; + + glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2, + LyricY + LyricsHeight/2, 0); + + // set current zoom factor + glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0); + + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + glBegin(GL_QUADS); + glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); + glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); + + glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); + glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2); + + glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); + glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2); + + glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); + glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); + glEnd; + + glPopMatrix; + end; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // type 3: ball lyric effect + if Ini.LyricsEffect = 3 then + begin + DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress, + LyricY - 15 - 15*sin(Progress * Pi), Alpha); + end; + end + else + begin + // this section is called if the whole line can be drawn at once and no + // word has to be emphasized. + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + // enable the upper, disable the lower line + if (Line = UpperLine) then + glColorRGB(LineColor_en) + else + glColorRGB(LineColor_dis); + + glBegin(GL_QUADS); + glTexCoord2f(0, 1); + glVertex2f(LyricX, LyricY); + + glTexCoord2f(0, 1-LyricsHeight/64); + glVertex2f(LyricX, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); + glVertex2f(LyricX2, LyricY + LyricsHeight); + + glTexCoord2f(Line.Width/1024, 1); + glVertex2f(LyricX2, LyricY); + glEnd; + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +//--------------- +// GetUpperLine() - Returns a reference to the upper line +//--------------- +function TLyricEngine.GetUpperLine(): TLyricLine; +begin + Result := UpperLine; +end; + +//--------------- +// GetLowerLine() - Returns a reference to the lower line +//--------------- +function TLyricEngine.GetLowerLine(): TLyricLine; +begin + Result := LowerLine; +end; + +//--------------- +// GetUpperLineIndex() - Returns the index of the upper line +//--------------- +function TLyricEngine.GetUpperLineIndex(): Integer; +const + QUEUE_SIZE = 3; +begin + // no line in queue + if (LineCounter <= 0) then + Result := -1 + // no line has been removed from queue yet + else if (LineCounter <= QUEUE_SIZE) then + Result := 0 + // lines have been removed from queue already + else + Result := LineCounter - QUEUE_SIZE; +end; + +end. + diff --git a/src/base/UMain.pas b/src/base/UMain.pas new file mode 100644 index 00000000..5dacd5f8 --- /dev/null +++ b/src/base/UMain.pas @@ -0,0 +1,1107 @@ +unit UMain; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + SDL, + UMusic, + URecord, + UTime, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + USong, + gl; + +type + PPLayerNote = ^TPlayerNote; + TPlayerNote = record + Start: integer; + Length: integer; + Detect: real; // accurate place, detected in the note + Tone: real; + Perfect: boolean; // true if the note matches the original one, lit the star + Hit: boolean; // true if the note Hits the Line + end; + + PPLayer = ^TPlayer; + TPlayer = record + Name: string; + + // Index in Teaminfo record + TeamID: Byte; + PlayerID: Byte; + + // Scores + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreInt: integer; + ScoreLineInt: integer; + ScoreGoldenInt: integer; + ScoreTotalInt: integer; + + // LineBonus + ScoreLast: Real;//Last Line Score + + // PerfectLineTwinkle (effect) + LastSentencePerfect: Boolean; + + HighNote: integer; // index of last note (= High(Note)?) + LengthNote: integer; // number of notes (= Length(Note)?). + Note: array of TPlayerNote; + end; + + +var + // Absolute Paths + GamePath: string; + SoundPath: string; + SongPaths: TStringList; + LogPath: string; + ThemePath: string; + SkinsPath: string; + ScreenshotsPath: string; + CoverPaths: TStringList; + LanguagesPath: string; + PluginPath: string; + VisualsPath: string; + ResourcesPath: string; + PlayListPath: string; + + Done: Boolean; + Event: TSDL_event; + // FIXME: ConversionFileName should not be global + ConversionFileName: string; + Restart: boolean; + + // player and music info + Player: array of TPlayer; + PlayersPlay: integer; + + CurrentSong : TSong; + +const + MAX_SONG_SCORE = 10000; // max. achievable points per song + MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +procedure InitializePaths; +procedure AddSongPath(const Path: string); + +Procedure Main; +procedure MainLoop; +procedure CheckEvents; +procedure Sing(Screen: TScreenSing); +procedure NewSentence(Screen: TScreenSing); +procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click +procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection +procedure NewNote(Screen: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; +procedure ClearScores(PlayerNum: integer); + +implementation + +uses + Math, + StrUtils, + USongs, + UJoystick, + UCommandLine, + ULanguage, + //SDL_ttf, + USkins, + UCovers, + UCatCovers, + UDataBase, + UPlaylist, + UDLLManager, + UParty, + UConfig, + UCore, + UCommon, + UGraphic, + UGraphicClasses, + UPluginDefs, + UPlatform, + UThemes; + + + + +procedure Main; +var + WndTitle: string; +begin + try + WndTitle := USDXVersionStr; + + Platform.Init; + + if Platform.TerminateIfAlreadyRunning(WndTitle) then + Exit; + + // fix floating-point exceptions (FPE) + DisableFloatingPointExceptions(); + // fix the locale for string-to-float parsing in C-libs + SetDefaultNumericLocale(); + + // setup separators for parsing + // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat + ThousandSeparator := ','; + DecimalSeparator := '.'; + + //------------------------------ + //StartUp - Create Classes and Load Files + //------------------------------ + + // Initialize SDL + // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values + SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); + SDL_EnableUnicode(1); + + USTime := TTime.Create; + VideoBGTimer := TRelativeTimer.Create; + + // Commandline Parameter Parser + Params := TCMDParams.Create; + + // Log + Benchmark + Log := TLog.Create; + Log.Title := WndTitle; + Log.FileOutputEnabled := not Params.NoLog; + Log.BenchmarkStart(0); + + // Language + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Paths', 'Initialization'); + InitializePaths; + Log.LogStatus('Load Language', 'Initialization'); + Language := TLanguage.Create; + + // Add Const Values: + Language.AddConst('US_VERSION', USDXVersionStr); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Language', 1); + + { + // SDL_ttf (Not used yet, maybe in version 1.5) + Log.BenchmarkStart(1); + Log.LogStatus('Initialize SDL_ttf', 'Initialization'); + TTF_Init(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing SDL_ttf', 1); + } + + // Skin + Log.BenchmarkStart(1); + Log.LogStatus('Loading Skin List', 'Initialization'); + Skin := TSkin.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Skin List', 1); + + // Ini + Paths + Log.BenchmarkStart(1); + Log.LogStatus('Load Ini', 'Initialization'); + Ini := TIni.Create; + Ini.Load; + + //it's possible that this is the first run, create a .ini file if neccessary + Log.LogStatus('Write Ini', 'Initialization'); + Ini.Save; + + // Load Languagefile + if (Params.Language <> -1) then + Language.ChangeLanguage(ILanguage[Params.Language]) + else + Language.ChangeLanguage(ILanguage[Ini.Language]); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Ini', 1); + + // Sound + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Sound', 'Initialization'); + InitializeSound(); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Sound', 1); + + // Lyrics-engine with media reference timer + LyricsState := TLyricsState.Create(); + + // Theme + Log.BenchmarkStart(1); + Log.LogStatus('Load Themes', 'Initialization'); + Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Themes', 1); + + // Covers Cache + Log.BenchmarkStart(1); + Log.LogStatus('Creating Covers Cache', 'Initialization'); + Covers := TCoverDatabase.Create; + Log.LogBenchmark('Loading Covers Cache Array', 1); + Log.BenchmarkStart(1); + + // Category Covers + Log.BenchmarkStart(1); + Log.LogStatus('Creating Category Covers Array', 'Initialization'); + CatCovers:= TCatCovers.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Category Covers Array', 1); + + // Songs + //Log.BenchmarkStart(1); + Log.LogStatus('Creating Song Array', 'Initialization'); + Songs := TSongs.Create; + //Songs.LoadSongList; + + Log.LogStatus('Creating 2nd Song Array', 'Initialization'); + CatSongs := TCatSongs.Create; + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Songs', 1); + + // PluginManager + Log.BenchmarkStart(1); + Log.LogStatus('PluginManager', 'Initialization'); + DLLMan := TDLLMan.Create; // Load PluginList + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PluginManager', 1); + + {// Party Mode Manager + Log.BenchmarkStart(1); + Log.LogStatus('PartySession Manager', 'Initialization'); + PartySession := TPartySession.Create; //Load PartySession + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading PartySession Manager', 1); } + + // Graphics + Log.BenchmarkStart(1); + Log.LogStatus('Initialize 3D', 'Initialization'); + Initialize3D(WndTitle); + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing 3D', 1); + + // Score Saving System + Log.BenchmarkStart(1); + Log.LogStatus('DataBase System', 'Initialization'); + DataBase := TDataBaseSystem.Create; + + if (Params.ScoreFile = '') then + DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db') + else + DataBase.Init (Params.ScoreFile); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading DataBase System', 1); + + // Playlist Manager + Log.BenchmarkStart(1); + Log.LogStatus('Playlist Manager', 'Initialization'); + PlaylistMan := TPlaylistManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Playlist Manager', 1); + + // GoldenStarsTwinkleMod + Log.BenchmarkStart(1); + Log.LogStatus('Effect Manager', 'Initialization'); + GoldenRec := TEffectManager.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Particle System', 1); + + // Joypad + if (Ini.Joypad = 1) OR (Params.Joypad) then + begin + Log.BenchmarkStart(1); + Log.LogStatus('Initialize Joystick', 'Initialization'); + Joy := TJoy.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Joystick', 1); + end; + + Log.BenchmarkEnd(0); + Log.LogBenchmark('Loading Time', 0); + + Log.LogStatus('Creating Core', 'Initialization'); + {Core := TCore.Create( + USDXShortVersionStr, + MakeVersion(USDX_VERSION_MAJOR, + USDX_VERSION_MINOR, + USDX_VERSION_RELEASE, + chr(0)) + ); } + + Log.LogStatus('Running Core', 'Initialization'); + //Core.Run; + + //------------------------------ + //Start- Mainloop + //------------------------------ + Log.LogStatus('Main Loop', 'Initialization'); + MainLoop; + + finally + //------------------------------ + //Finish Application + //------------------------------ + + // TODO: + // call an uninitialize routine for every initialize step + // or at least use the corresponding Free-Methods + + FinalizeMedia(); + + //TTF_Quit(); + SDL_Quit(); + + if assigned(Log) then + begin + Log.LogStatus('Main Loop', 'Finished'); + Log.Free; + end; + end; +end; + +procedure MainLoop; +var + Delay: integer; +const + MAX_FPS = 100; +begin + Delay := 0; + SDL_EnableKeyRepeat(125, 125); + + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. + while not Done do + begin + // joypad + if (Ini.Joypad = 1) or (Params.Joypad) then + Joy.Update; + + // keyboard events + CheckEvents; + + // display + done := not Display.Draw; + SwapBuffers; + + // delay + CountMidTime; + + Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); + + if Delay >= 1 then + SDL_Delay(Delay); // dynamic, maximum is 100 fps + + CountSkipTime; + + // reinitialization of graphics + if Restart then + begin + Reinitialize3D; + Restart := false; + end; + + end; +End; + +procedure CheckEvents; +begin + if Assigned(Display.NextScreen) then + Exit; + + while SDL_PollEvent( @event ) = 1 do + begin + case Event.type_ of + SDL_QUITEV: + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + { + SDL_MOUSEBUTTONDOWN: + with Event.button Do + begin + if State = SDL_BUTTON_LEFT Then + begin + // + end; + end; + } + SDL_VIDEORESIZE: + begin + ScreenW := Event.resize.w; + ScreenH := Event.resize.h; + // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. + // This would create a new OpenGL render-context and all texture data + // would be invalidated. + // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. + {$IFDEF LINUX} + if boolean( Ini.FullScreen ) then + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) + else + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + {$ENDIF} + end; + SDL_KEYDOWN: + begin + // remap the "keypad enter" key to the "standard enter" key + if (Event.key.keysym.sym = SDLK_KP_ENTER) then + Event.key.keysym.sym := SDLK_RETURN; + + if (Event.key.keysym.sym = SDLK_F11) or + ((Event.key.keysym.sym = SDLK_RETURN) and + ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen + begin + Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); + + // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to + // reload all texture data (-> whitescreen bug). + // Only Linux is able to handle screen-switching this way. + {$IFDEF LINUX} + if boolean( Ini.FullScreen ) then + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + SDL_ShowCursor(0); + end + else + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + SDL_ShowCursor(1); + end; + + glViewPort(0, 0, ScreenW, ScreenH); + {$ENDIF} + end + // if print is pressed -> make screenshot and save to screenshot path + else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then + Display.SaveScreenShot + // if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + else + begin + // check if screen wants to exit + done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True); + + // if screen wants to exit + if done then + begin + // if question option is enabled then show exit popup + if (Ini.AskbeforeDel = 1) then + begin + Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); + end + else // if ask-for-exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; + end; + + end; + end; + SDL_JOYAXISMOTION: + begin + // not implemented + end; + SDL_JOYBUTTONDOWN: + begin + // not implemented + end; + end; // case + end; // while +end; + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(CurrentSong.BPM) = BPMNum then + begin + // last BPM + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end + else + begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then + begin + // there is still remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end + else + begin + // there is no remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := Time * CurrentSong.BPM[0].BPM / 60; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + Result := CurrentSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(CurrentSong.BPM)) and + (Beat > CurrentSong.BPM[CurBPM].StartBeat) do + begin + if (CurBPM < High(CurrentSong.BPM)) and + (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // full range + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(CurrentSong.BPM)) or + (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // in the middle + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (Beat - CurrentSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + + { + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + } + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +procedure Sing(Screen: TScreenSing); +var + Count: integer; + CountGr: integer; + CP: integer; + Done: real; + N: integer; + CurLine: PLine; + CurNote: PLineFragment; +begin + LyricsState.UpdateBeats(); + + // sentences routines + for CountGr := 0 to 0 do //High(Lines) + begin; + CP := CountGr; + // old parts + LyricsState.OldLine := Lines[CP].Current; + + // choose current parts + for Count := 0 to Lines[CP].High do + begin + if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then + Lines[CP].Current := Count; + end; + + // clean player note if there is a new line + // (optimization on halfbeat time) + if Lines[CP].Current <> LyricsState.OldLine then + NewSentence(Screen); + + end; // for CountGr + + // make some operations on clicks + if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then + NewBeatClick(Screen); + + // make some operations when detecting new voice pitch + if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then + NewBeatDetect(Screen); + + CurLine := @Lines[0].Line[Lines[0].Current]; + + // remove moving text + Done := 1; + for N := 0 to CurLine.HighNote do + begin + CurNote := @CurLine.Note[N]; + if (CurNote.Start <= LyricsState.MidBeat) and + (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then + begin + Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length; + end; + end; +end; + +procedure NewSentence(Screen: TScreenSing); +var + i: Integer; +begin + // clean note of player + for i := 0 to High(Player) do + begin + Player[i].LengthNote := 0; + Player[i].HighNote := -1; + SetLength(Player[i].Note, 0); + end; + + // on sentence change... + Screen.onSentenceChange(Lines[0].Current); +end; + +procedure NewBeatClick; +var + Count: integer; +begin + // beat click + if ((Ini.BeatClick = 1) and + ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then + begin + AudioPlayback.PlaySound(SoundLib.Click); + end; + + for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do + begin + if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then + begin + // click assist + if Ini.ClickAssist = 1 then + AudioPlayback.PlaySound(SoundLib.Click); + + // drum machine + (* + TempBeat := LyricsState.CurrentBeat;// + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; + //if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat; + *) + end; + end; +end; + +procedure NewBeatDetect(Screen: TScreenSing); +begin + NewNote(Screen); +end; + +procedure NewNote(Screen: TScreenSing); +var + LineFragmentIndex: integer; + CurrentLineFragment: PLineFragment; + PlayerIndex: integer; + CurrentSound: TCaptureBuffer; + CurrentPlayer: PPlayer; + LastPlayerNote: PPLayerNote; + Line: PLine; + SentenceIndex: integer; + SentenceMin: integer; + SentenceMax: integer; + SentenceDetected: integer; // sentence of detected note + NoteAvailable: boolean; + NewNote: boolean; + Range: integer; + NoteHit: boolean; + MaxSongPoints: integer; // max. points for the song (without line bonus) + MaxLinePoints: Real; // max. points for the current line +begin + // TODO: add duet mode support + // use Lines[LineSetIndex] with LineSetIndex depending on the current player + + // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + SentenceMin := Lines[0].Current-1; + if (SentenceMin < 0) then + SentenceMin := 0; + SentenceMax := Lines[0].Current; + + // check for an active note at the current time defined in the lyrics + NoteAvailable := false; + SentenceDetected := SentenceMin; + for SentenceIndex := SentenceMin to SentenceMax do + begin + Line := @Lines[0].Line[SentenceIndex]; + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + // check if line is active + if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and + (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 + begin + SentenceDetected := SentenceIndex; + NoteAvailable := true; + Break; + end; + end; + // TODO: break here, if NoteAvailable is true? We would then use the first instead + // of the last note matching the current beat if notes overlap. But notes + // should not overlap at all. + //if (NoteAvailable) then + // Break; + end; + + // analyze player signals + for PlayerIndex := 0 to PlayersPlay-1 do + begin + CurrentPlayer := @Player[PlayerIndex]; + CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + + // analyze buffer + CurrentSound.AnalyzeBuffer; + + // add some noise + // TODO: do we need this? + //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; + + // add note if possible + if (CurrentSound.ToneValid and NoteAvailable) then + begin + Line := @Lines[0].Line[SentenceDetected]; + + // process until last note + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and + (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then + begin + // compare notes (from song-file and from player) + + // move players tone to proper octave + while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do + CurrentSound.Tone := CurrentSound.Tone - 12; + + while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do + CurrentSound.Tone := CurrentSound.Tone + 12; + + // half size notes patch + NoteHit := false; + + //if Ini.Difficulty = 0 then Range := 2; + //if Ini.Difficulty = 1 then Range := 1; + //if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + // check if the player hit the correct tone within the tolerated range + if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then + begin + // adjust the players tone to the correct one + // TODO: do we need to do this? + CurrentSound.Tone := CurrentLineFragment.Tone; + + // half size notes patch + NoteHit := true; + + if (Ini.LineBonus > 0) then + MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS + else + MaxSongPoints := MAX_SONG_SCORE; + + // Note: ScoreValue is the sum of all note values of the song + MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue; + + // FIXME: is this correct? Why do we add the points for a whole line + // if just one note is correct? + case CurrentLineFragment.NoteType of + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; + end; + + CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; + CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10; + + CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + + CurrentPlayer.ScoreGoldenInt + + CurrentPlayer.ScoreLineInt; + end; + + end; // operation + end; // for + + // check if we have to add a new note or extend the note's length + if (SentenceDetected = SentenceMax) then + begin + // we will add a new note + NewNote := true; + // if last has the same tone + if ((CurrentPlayer.LengthNote > 0) and + (LastPlayerNote.Tone = CurrentSound.Tone) and + ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then + begin + NewNote := false; + end; + + // if is not as new note to control + for LineFragmentIndex := 0 to Line.HighNote do + begin + if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then + NewNote := true; + end; + + // add new note + if NewNote then + begin + // new note + Inc(CurrentPlayer.LengthNote); + Inc(CurrentPlayer.HighNote); + SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); + + // update player's last note + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + with LastPlayerNote^ do + begin + Start := LyricsState.CurrentBeatD; + Length := 1; + Tone := CurrentSound.Tone; // Tone || ToneAbs + Detect := LyricsState.MidBeat; + Hit := NoteHit; // half note patch + end; + end + else + begin + // extend note length + Inc(LastPlayerNote.Length); + end; + + // check for perfect note and then lit the star (on Draw) + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start = LastPlayerNote.Start) and + (CurrentLineFragment.Length = LastPlayerNote.Length) and + (CurrentLineFragment.Tone = LastPlayerNote.Tone) then + begin + LastPlayerNote.Perfect := true; + end; + end; + end; // if SentenceDetected = SentenceMax + + end; // if Detected + end; // for PlayerIndex + + //Log.LogStatus('EndBeat', 'NewBeat'); + + // on sentence end -> for LineBonus and display of SingBar (rating pop-up) + if (SentenceDetected >= Low(Lines[0].Line)) and + (SentenceDetected <= High(Lines[0].Line)) then + begin + Line := @Lines[0].Line[SentenceDetected]; + CurrentLineFragment := @Line.Note[Line.HighNote]; + if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then + begin + if assigned(Screen) then + Screen.OnSentenceEnd(SentenceDetected); + end; + end; + +end; + +procedure ClearScores(PlayerNum: integer); +begin + with Player[PlayerNum] do + begin + Score := 0; + ScoreInt := 0; + ScoreLine := 0; + ScoreLineInt := 0; + ScoreGolden := 0; + ScoreGoldenInt := 0; + ScoreTotalInt := 0; + end; +end; + +procedure AddSpecialPath(var PathList: TStringList; const Path: string); +var + I: integer; + PathAbs, OldPathAbs: string; +begin + if (PathList = nil) then + PathList := TStringList.Create; + + if (Path = '') or not DirectoryExists(Path) then + Exit; + + PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); + + // check if path or a part of the path was already added + for I := 0 to PathList.Count-1 do + begin + OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I])); + // check if the new directory is a sub-directory of a previously added one. + // This is also true, if both paths point to the same directories. + if (AnsiStartsText(OldPathAbs, PathAbs)) then + begin + // ignore the new path + Exit; + end; + + // check if a previously added directory is a sub-directory of the new one. + if (AnsiStartsText(PathAbs, OldPathAbs)) then + begin + // replace the old with the new one. + PathList[I] := PathAbs; + Exit; + end; + end; + + PathList.Add(PathAbs); +end; + +procedure AddSongPath(const Path: string); +begin + AddSpecialPath(SongPaths, Path); +end; + +procedure AddCoverPath(const Path: string); +begin + AddSpecialPath(CoverPaths, Path); +end; + +(** + * Initialize a path variable + * After setting paths, make sure that paths exist + *) +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +begin + Result := false; + + if (RequestedPath = '') then + Exit; + + // Make sure the directory exists + if (not ForceDirectories(RequestedPath)) then + begin + PathResult := ''; + Exit; + end; + + PathResult := IncludeTrailingPathDelimiter(RequestedPath); + + if (NeedsWritePermission) and + (FileIsReadOnly(RequestedPath)) then + begin + Exit; + end; + + Result := true; +end; + +(** + * Function sets all absolute paths e.g. song path and makes sure the directorys exist + *) +procedure InitializePaths; +begin + // Log directory (must be writable) + if (not FindPath(LogPath, Platform.GetLogPath, true)) then + begin + Log.FileOutputEnabled := false; + Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); + end; + + FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); + FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); + FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); + FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); + FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); + FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); + FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); + + // Playlists are not shared as we need one directory to write too + FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); + + // Screenshot directory (must be writable) + if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then + begin + Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); + end; + + // Add song paths + AddSongPath(Params.SongPath); + AddSongPath(Platform.GetGameSharedPath + 'songs'); + AddSongPath(Platform.GetGameUserPath + 'songs'); + + // Add category cover paths + AddCoverPath(Platform.GetGameSharedPath + 'covers'); + AddCoverPath(Platform.GetGameUserPath + 'covers'); +end; + +end. diff --git a/src/base/UMediaCore_FFmpeg.pas b/src/base/UMediaCore_FFmpeg.pas new file mode 100644 index 00000000..cdd320ac --- /dev/null +++ b/src/base/UMediaCore_FFmpeg.pas @@ -0,0 +1,405 @@ +unit UMediaCore_FFmpeg; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + avcodec, + avformat, + avutil, + ULog, + sdl; + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + FirstListEntry: PAVPacketList; + LastListEntry: PAVPacketList; + PacketCount: integer; + Mutex: PSDL_Mutex; + Condition: PSDL_Cond; + Size: integer; + AbortRequest: boolean; + public + constructor Create(); + destructor Destroy(); override; + + function Put(Packet : PAVPacket): integer; + function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; + procedure FreeStatusInfo(var Packet: TAVPacket); + function GetStatusInfo(var Packet: TAVPacket): Pointer; + function Get(var Packet: TAVPacket; Blocking: boolean): integer; + function GetSize(): integer; + procedure Flush(); + procedure Abort(); + function IsAborted(): boolean; + end; + +const + STATUS_PACKET: PChar = 'STATUS_PACKET'; +const + PKT_STATUS_FLAG_EOF = 1; // signal end-of-file + PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers + PKT_STATUS_FLAG_ERROR = 3; // signal an error state + PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames) + +type + TMediaCore_FFmpeg = class + private + AVCodecLock: PSDL_Mutex; + public + constructor Create(); + destructor Destroy(); override; + class function GetInstance(): TMediaCore_FFmpeg; + + function GetErrorString(ErrorNum: integer): string; + function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean; + function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; + function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; + procedure LockAVCodec(); + procedure UnlockAVCodec(); + end; + +implementation + +uses + SysUtils; + +var + Instance: TMediaCore_FFmpeg; + +constructor TMediaCore_FFmpeg.Create(); +begin + inherited; + AVCodecLock := SDL_CreateMutex(); +end; + +destructor TMediaCore_FFmpeg.Destroy(); +begin + SDL_DestroyMutex(AVCodecLock); + inherited; +end; + +class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg; +begin + if (not Assigned(Instance)) then + Instance := TMediaCore_FFmpeg.Create(); + Result := Instance; +end; + +procedure TMediaCore_FFmpeg.LockAVCodec(); +begin + SDL_mutexP(AVCodecLock); +end; + +procedure TMediaCore_FFmpeg.UnlockAVCodec(); +begin + SDL_mutexV(AVCodecLock); +end; + +function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string; +begin + case ErrorNum of + AVERROR_IO: Result := 'AVERROR_IO'; + AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED'; + AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA'; + AVERROR_NOMEM: Result := 'AVERROR_NOMEM'; + AVERROR_NOFMT: Result := 'AVERROR_NOFMT'; + AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP'; + AVERROR_NOENT: Result := 'AVERROR_NOENT'; + AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME'; + else Result := 'AVERROR_#'+inttostr(ErrorNum); + end; +end; + +{ + @param(FormatCtx is a PAVFormatContext returned from av_open_input_file ) + @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream) + @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream) + @returns(@true on success, @false otherwise) +} +function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean; +var + i: integer; + Stream: PAVStream; +begin + // find the first video stream + FirstAudioStream := -1; + FirstVideoStream := -1; + + for i := 0 to FormatCtx.nb_streams-1 do + begin + Stream := FormatCtx.streams[i]; + + if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and + (FirstVideoStream < 0) then + begin + FirstVideoStream := i; + end; + + if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and + (FirstAudioStream < 0) then + begin + FirstAudioStream := i; + end; + end; + + // return true if either an audio- or video-stream was found + Result := (FirstAudioStream > -1) or + (FirstVideoStream > -1) ; +end; + +function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; +var + i: integer; + StreamIndex: integer; + Stream: PAVStream; +begin + // find the first audio stream + StreamIndex := -1; + + for i := 0 to FormatCtx^.nb_streams-1 do + begin + Stream := FormatCtx^.streams[i]; + + if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then + begin + StreamIndex := i; + Break; + end; + end; + + Result := StreamIndex; +end; + +function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; +begin + case FFmpegFormat of + SAMPLE_FMT_U8: Format := asfU8; + SAMPLE_FMT_S16: Format := asfS16; + SAMPLE_FMT_S24: Format := asfS24; + SAMPLE_FMT_S32: Format := asfS32; + SAMPLE_FMT_FLT: Format := asfFloat; + else begin + Result := false; + Exit; + end; + end; + Result := true; +end; + +{ TPacketQueue } + +constructor TPacketQueue.Create(); +begin + inherited; + + FirstListEntry := nil; + LastListEntry := nil; + PacketCount := 0; + Size := 0; + + Mutex := SDL_CreateMutex(); + Condition := SDL_CreateCond(); +end; + +destructor TPacketQueue.Destroy(); +begin + Flush(); + SDL_DestroyMutex(Mutex); + SDL_DestroyCond(Condition); + inherited; +end; + +procedure TPacketQueue.Abort(); +begin + SDL_LockMutex(Mutex); + + AbortRequest := true; + + SDL_CondBroadcast(Condition); + SDL_UnlockMutex(Mutex); +end; + +function TPacketQueue.IsAborted(): boolean; +begin + SDL_LockMutex(Mutex); + Result := AbortRequest; + SDL_UnlockMutex(Mutex); +end; + +function TPacketQueue.Put(Packet : PAVPacket): integer; +var + CurrentListEntry : PAVPacketList; +begin + Result := -1; + + if (Packet = nil) then + Exit; + + if (PChar(Packet^.data) <> STATUS_PACKET) then + begin + if (av_dup_packet(Packet) < 0) then + Exit; + end; + + CurrentListEntry := av_malloc(SizeOf(TAVPacketList)); + if (CurrentListEntry = nil) then + Exit; + + CurrentListEntry^.pkt := Packet^; + CurrentListEntry^.next := nil; + + SDL_LockMutex(Mutex); + try + if (LastListEntry = nil) then + FirstListEntry := CurrentListEntry + else + LastListEntry^.next := CurrentListEntry; + + LastListEntry := CurrentListEntry; + Inc(PacketCount); + + Size := Size + CurrentListEntry^.pkt.size; + SDL_CondSignal(Condition); + finally + SDL_UnlockMutex(Mutex); + end; + + Result := 0; +end; + +(** + * Adds a status packet (EOF, Flush, etc.) to the end of the queue. + * StatusInfo can be used to pass additional information to the decoder. + * Only assign nil or a valid pointer to data allocated with Getmem() to + * StatusInfo because the pointer will be disposed with Freemem() on a call + * to Flush(). If the packet is removed from the queue it is the decoder's + * responsibility to free the StatusInfo data with FreeStatusInfo(). + *) +function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; +var + TempPacket: PAVPacket; +begin + // create temp. package + TempPacket := av_malloc(SizeOf(TAVPacket)); + if (TempPacket = nil) then + begin + Result := -1; + Exit; + end; + // init package + av_init_packet(TempPacket^); + TempPacket^.data := Pointer(STATUS_PACKET); + TempPacket^.flags := StatusFlag; + TempPacket^.priv := StatusInfo; + // put a copy of the package into the queue + Result := Put(TempPacket); + // data has been copied -> delete temp. package + av_free(TempPacket); +end; + +procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket); +begin + if (Packet.priv <> nil) then + FreeMem(Packet.priv); +end; + +function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer; +begin + Result := Packet.priv; +end; + +function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer; +var + CurrentListEntry: PAVPacketList; +const + WAIT_TIMEOUT = 10; // timeout in ms +begin + Result := -1; + + SDL_LockMutex(Mutex); + try + while (true) do + begin + if (AbortRequest) then + Exit; + + CurrentListEntry := FirstListEntry; + if (CurrentListEntry <> nil) then + begin + FirstListEntry := CurrentListEntry^.next; + if (FirstListEntry = nil) then + LastListEntry := nil; + Dec(PacketCount); + + Size := Size - CurrentListEntry^.pkt.size; + Packet := CurrentListEntry^.pkt; + av_free(CurrentListEntry); + + Result := 1; + Break; + end + else if (not Blocking) then + begin + Result := 0; + Break; + end + else + begin + // block until a new package arrives, + // but do not wait till infinity to avoid deadlocks + if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then + begin + Result := 0; + Break; + end; + end; + end; + finally + SDL_UnlockMutex(Mutex); + end; +end; + +function TPacketQueue.GetSize(): integer; +begin + SDL_LockMutex(Mutex); + Result := Size; + SDL_UnlockMutex(Mutex); +end; + +procedure TPacketQueue.Flush(); +var + CurrentListEntry, TempListEntry: PAVPacketList; +begin + SDL_LockMutex(Mutex); + + CurrentListEntry := FirstListEntry; + while(CurrentListEntry <> nil) do + begin + TempListEntry := CurrentListEntry^.next; + // free status data + if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then + FreeStatusInfo(CurrentListEntry^.pkt); + // free packet data + av_free_packet(@CurrentListEntry^.pkt); + // Note: param must be a pointer to a pointer! + av_freep(@CurrentListEntry); + CurrentListEntry := TempListEntry; + end; + LastListEntry := nil; + FirstListEntry := nil; + PacketCount := 0; + Size := 0; + + SDL_UnlockMutex(Mutex); +end; + +end. diff --git a/src/base/UMediaCore_SDL.pas b/src/base/UMediaCore_SDL.pas new file mode 100644 index 00000000..252f72a0 --- /dev/null +++ b/src/base/UMediaCore_SDL.pas @@ -0,0 +1,38 @@ +unit UMediaCore_SDL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UMusic, + sdl; + +function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; + +implementation + +function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; +begin + case Format of + asfU8: SDLFormat := AUDIO_U8; + asfS8: SDLFormat := AUDIO_S8; + asfU16LSB: SDLFormat := AUDIO_U16LSB; + asfS16LSB: SDLFormat := AUDIO_S16LSB; + asfU16MSB: SDLFormat := AUDIO_U16MSB; + asfS16MSB: SDLFormat := AUDIO_S16MSB; + asfU16: SDLFormat := AUDIO_U16; + asfS16: SDLFormat := AUDIO_S16; + else begin + Result := false; + Exit; + end; + end; + Result := true; +end; + +end. diff --git a/src/base/UMedia_dummy.pas b/src/base/UMedia_dummy.pas new file mode 100644 index 00000000..438b89ab --- /dev/null +++ b/src/base/UMedia_dummy.pas @@ -0,0 +1,243 @@ +unit UMedia_dummy; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +implementation + +uses + SysUtils, + math, + UMusic; + +type + TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) + private + DummyOutputDeviceList: TAudioOutputDeviceList; + public + constructor Create(); + function GetName: string; + + function Init(): boolean; + function Finalize(): boolean; + + 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 SetSyncSource(SyncSource: TSyncSource); + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + + // IAudioInput + function InitializeRecord: boolean; + function FinalizeRecord: boolean; + procedure CaptureStart; + procedure CaptureStop; + procedure GetFFTData(var data: TFFTData); + function GetPCMData(var data: TPCMData): Cardinal; + + // IAudioPlayback + function InitializePlayback: boolean; + function FinalizePlayback: boolean; + + function GetOutputDeviceList(): TAudioOutputDeviceList; + procedure FadeIn(Time: real; TargetVolume: single); + procedure SetAppVolume(Volume: single); + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + procedure Rewind; + + function Finished: boolean; + function Length: real; + + function OpenSound(const Filename: string): TAudioPlaybackStream; + procedure CloseSound(var PlaybackStream: TAudioPlaybackStream); + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); + + function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; + procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream); + end; + +function TMedia_dummy.GetName: string; +begin + Result := 'dummy'; +end; + +procedure TMedia_dummy.GetFrame(Time: Extended); +begin +end; + +procedure TMedia_dummy.DrawGL(Screen: integer); +begin +end; + +constructor TMedia_dummy.Create(); +begin + inherited; +end; + +function TMedia_dummy.Init(): boolean; +begin + Result := true; +end; + +function TMedia_dummy.Finalize(): boolean; +begin + Result := true; +end; + +function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed +begin + Result := false; +end; + +procedure TMedia_dummy.Close; +begin +end; + +procedure TMedia_dummy.Play; +begin +end; + +procedure TMedia_dummy.Pause; +begin +end; + +procedure TMedia_dummy.Stop; +begin +end; + +procedure TMedia_dummy.SetPosition(Time: real); +begin +end; + +function TMedia_dummy.GetPosition: real; +begin + Result := 0; +end; + +procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource); +begin +end; + +// IAudioInput +function TMedia_dummy.InitializeRecord: boolean; +begin + Result := true; +end; + +function TMedia_dummy.FinalizeRecord: boolean; +begin + Result := true; +end; + +procedure TMedia_dummy.CaptureStart; +begin +end; + +procedure TMedia_dummy.CaptureStop; +begin +end; + +procedure TMedia_dummy.GetFFTData(var data: TFFTData); +begin +end; + +function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal; +begin + Result := 0; +end; + +// IAudioPlayback +function TMedia_dummy.InitializePlayback: boolean; +begin + SetLength(DummyOutputDeviceList, 1); + DummyOutputDeviceList[0] := TAudioOutputDevice.Create(); + DummyOutputDeviceList[0].Name := '[Dummy Device]'; + Result := true; +end; + +function TMedia_dummy.FinalizePlayback: boolean; +begin + Result := true; +end; + +function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList; +begin + Result := DummyOutputDeviceList; +end; + +procedure TMedia_dummy.SetAppVolume(Volume: single); +begin +end; + +procedure TMedia_dummy.SetVolume(Volume: single); +begin +end; + +procedure TMedia_dummy.SetLoop(Enabled: boolean); +begin +end; + +procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single); +begin +end; + +procedure TMedia_dummy.Rewind; +begin +end; + +function TMedia_dummy.Finished: boolean; +begin + Result := false; +end; + +function TMedia_dummy.Length: real; +begin + Result := 60; +end; + +function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream; +begin + Result := nil; +end; + +procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream); +begin +end; + +procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream); +begin +end; + +procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream); +begin +end; + +function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; +begin + Result := nil; +end; + +procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream); +begin +end; + +initialization + MediaManager.Add(TMedia_dummy.Create); + +end. diff --git a/src/base/UModules.pas b/src/base/UModules.pas new file mode 100644 index 00000000..554a24c4 --- /dev/null +++ b/src/base/UModules.pas @@ -0,0 +1,26 @@ +unit UModules; + +interface + +{$I switches.inc} + +{********************* + UModules + Unit Contains all used Modules in its uses clausel + and a const with an array of all Modules to load +*********************} + +uses + UCoreModule, + UPluginLoader; + +const + CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( + TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) + TCoreModule, //Remove this later, just a dummy + TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. + ); + +implementation + +end. \ No newline at end of file diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas new file mode 100644 index 00000000..6476f629 --- /dev/null +++ b/src/base/UMusic.pas @@ -0,0 +1,1233 @@ +unit UMusic; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UTime, + Classes; + +type + TNoteType = (ntFreestyle, ntNormal, ntGolden); + + (** + * TLineFragment represents a fragment of a lyrics line. + * This is a text-fragment (e.g. a syllable) assigned to a note pitch, + * represented by a bar in the sing-screen. + *) + PLineFragment = ^TLineFragment; + TLineFragment = record + Color: integer; + Start: integer; // beat the fragment starts at + Length: integer; // length in beats + Tone: integer; // full range tone + Text: string; // text assigned to this fragment (a syllable, word, etc.) + NoteType: TNoteType; // note-type: golden-note/freestyle etc. + end; + + (** + * TLine represents one lyrics line and consists of multiple + * notes. + *) + PLine = ^TLine; + TLine = record + Start: integer; // the start beat of this line (<> start beat of the first note of this line) + Lyric: string; + LyricWidth: real; // @deprecated: width of the line in pixels. + // Do not use this as the width is not correct. + // Use TLyricsEngine.GetUpperLine().Width instead. + End_: integer; + BaseNote: integer; + HighNote: integer; // index of last note in line (= High(Note)?) + TotalNotes: integer; // value of all notes in the line + LastLine: boolean; + Note: array of TLineFragment; + end; + + (** + * TLines stores sets of lyric lines and information on them. + * Normally just one set is defined but in duet mode it might for example + * contain two sets. + *) + TLines = record + Current: integer; // for drawing of current line + High: integer; // (= High(Line)?) + Number: integer; + Resolution: integer; + NotesGAP: integer; + ScoreValue: integer; + Line: array of TLine; + end; + + (** + * TLyricsState contains all information concerning the + * state of the lyrics, e.g. the current beat or duration of the lyrics. + *) + TLyricsState = class + private + Timer: TRelativeTimer; // keeps track of the current time + public + OldBeat: integer; // previous discovered beat + CurrentBeat: integer; // current beat (rounded) + MidBeat: real; // current beat (float) + + // now we use this for super synchronization! + // only used when analyzing voice + // TODO: change ...D to ...Detect(ed) + OldBeatD: integer; // previous discovered beat + CurrentBeatD: integer; // current discovered beat (rounded) + MidBeatD: real; // current discovered beat (float) + + // we use this for audible clicks + // TODO: Change ...C to ...Click + OldBeatC: integer; // previous discovered beat + CurrentBeatC: integer; + MidBeatC: real; // like CurrentBeatC + + OldLine: integer; // previous displayed sentence + + StartTime: real; // time till start of lyrics (= Gap) + TotalTime: real; // total song time + + constructor Create(); + procedure Pause(); + procedure Resume(); + + procedure Reset(); + procedure UpdateBeats(); + + (** + * current song time (in seconds) used as base-timer for lyrics etc. + *) + function GetCurrentTime(): real; + procedure SetCurrentTime(Time: real); + end; + + +const + FFTSize = 512; // size of FFT data (output: FFTSize/2 values) +type + TFFTData = array[0..(FFTSize div 2)-1] of Single; + +type + PPCMStereoSample = ^TPCMStereoSample; + TPCMStereoSample = array[0..1] of SmallInt; + TPCMData = array[0..511] of TPCMStereoSample; + +type + TStreamStatus = (ssStopped, ssPlaying, ssPaused); +const + StreamStatusStr: array[TStreamStatus] of string = + ('Stopped', 'Playing', 'Paused'); + +type + TAudioSampleFormat = ( + asfU8, asfS8, // unsigned/signed 8 bits + asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) + asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) + asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) + asfS24, // signed 24 bits (endianness: System) + asfS32, // signed 32 bits (endianness: System) + asfFloat // float + ); + +const + // Size of one sample (one channel only) in bytes + AudioSampleSize: array[TAudioSampleFormat] of integer = ( + 1, 1, // asfU8, asfS8 + 2, 2, // asfU16LSB, asfS16LSB + 2, 2, // asfU16MSB, asfS16MSB + 2, 2, // asfU16, asfS16 + 3, // asfS24 + 4, // asfS32 + 4 // asfFloat + ); + +const + CHANNELMAP_LEFT = 1; + CHANNELMAP_RIGHT = 2; + CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT; + +type + TAudioFormatInfo = class + private + fSampleRate : double; + fChannels : byte; + fFormat : TAudioSampleFormat; + fFrameSize : integer; + + procedure SetChannels(Channels: byte); + procedure SetFormat(Format: TAudioSampleFormat); + procedure UpdateFrameSize(); + function GetBytesPerSec(): double; + public + constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); + function Copy(): TAudioFormatInfo; + + (** + * Returns the inverse ratio of the size of data in this format to its + * size in a given target format. + * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize + *) + function GetRatio(TargetInfo: TAudioFormatInfo): double; + + property SampleRate: double read fSampleRate write fSampleRate; + property Channels: byte read fChannels write SetChannels; + property Format: TAudioSampleFormat read fFormat write SetFormat; + property FrameSize: integer read fFrameSize; + property BytesPerSec: double read GetBytesPerSec; + end; + +type + TSoundEffect = class + public + EngineData: Pointer; // can be used for engine-specific data + procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract; + end; + + TVoiceRemoval = class(TSoundEffect) + public + procedure Callback(Buffer: PChar; BufSize: integer); override; + end; + +type + TSyncSource = class + function GetClock(): real; virtual; abstract; + end; + + TAudioProcessingStream = class; + TOnCloseHandler = procedure(Stream: TAudioProcessingStream); + + TAudioProcessingStream = class + protected + OnCloseHandlers: array of TOnCloseHandler; + + function GetLength(): real; virtual; abstract; + function GetPosition(): real; virtual; abstract; + procedure SetPosition(Time: real); virtual; abstract; + function GetLoop(): boolean; virtual; abstract; + procedure SetLoop(Enabled: boolean); virtual; abstract; + + procedure PerformOnClose(); + public + function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract; + procedure Close(); virtual; abstract; + + (** + * Adds a new OnClose action handler. + * The handlers are performed in the order they were added. + * If not stated explicitely, member-variables might have been invalidated + * already. So do not use any member (variable/method/...) if you are not + * sure it is valid. + *) + procedure AddOnCloseHandler(Handler: TOnCloseHandler); + + property Length: real read GetLength; + property Position: real read GetPosition write SetPosition; + property Loop: boolean read GetLoop write SetLoop; + end; + + TAudioSourceStream = class(TAudioProcessingStream) + protected + function IsEOF(): boolean; virtual; abstract; + function IsError(): boolean; virtual; abstract; + public + function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract; + + property EOF: boolean read IsEOF; + property Error: boolean read IsError; + end; + + (* + * State-Chart for playback-stream state transitions + * []: Transition, (): State + * + * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\ + * -[Create]->(Stop) (Play) (Pause) + * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--// + * \-<------------[Stop/EOF*/Error]--------------/ + * + * *: if not looped, otherwise stream is repeated + * Note: SetPosition() does not change the state. + *) + + TAudioPlaybackStream = class(TAudioProcessingStream) + protected + SyncSource: TSyncSource; + AvgSyncDiff: double; + SourceStream: TAudioSourceStream; + + function GetLatency(): double; virtual; abstract; + function GetStatus(): TStreamStatus; virtual; abstract; + function GetVolume(): single; virtual; abstract; + procedure SetVolume(Volume: single); virtual; abstract; + function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; + procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); + public + (** + * Opens a SourceStream for playback. + * Note that the caller (not the TAudioPlaybackStream) is responsible to + * free the SourceStream after the Playback-Stream is closed. + * You may use an OnClose-handler to achieve this. GetSourceStream() + * guarantees to deliver this method's SourceStream parameter to + * the OnClose-handler. Freeing SourceStream at OnClose is allowed. + *) + function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract; + + procedure Play(); virtual; abstract; + procedure Pause(); virtual; abstract; + procedure Stop(); virtual; abstract; + procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract; + + procedure GetFFTData(var data: TFFTData); virtual; abstract; + function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract; + + procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; + procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; + + procedure SetSyncSource(SyncSource: TSyncSource); + function GetSourceStream(): TAudioSourceStream; + + property Status: TStreamStatus read GetStatus; + property Volume: single read GetVolume write SetVolume; + end; + + TAudioDecodeStream = class(TAudioSourceStream) + end; + + TAudioVoiceStream = class(TAudioSourceStream) + protected + FormatInfo: TAudioFormatInfo; + ChannelMap: integer; + public + destructor Destroy; override; + + function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; + procedure Close(); override; + + procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + + function GetLength(): real; override; + function GetPosition(): real; override; + procedure SetPosition(Time: real); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + end; + +type + // soundcard output-devices information + TAudioOutputDevice = class + public + Name: string; // soundcard name + end; + TAudioOutputDeviceList = array of TAudioOutputDevice; + +type + IGenericPlayback = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] + function GetName: String; + + function Open(const Filename: string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + property Position: real read GetPosition write SetPosition; + end; + + IVideoPlayback = Interface( IGenericPlayback ) + ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] + function Init(): boolean; + function Finalize: boolean; + + procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC + procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + + end; + + IVideoVisualization = Interface( IVideoPlayback ) + ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] + end; + + IAudioPlayback = Interface( IGenericPlayback ) + ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] + function InitializePlayback: boolean; + function FinalizePlayback: boolean; + + function GetOutputDeviceList(): TAudioOutputDeviceList; + + procedure SetAppVolume(Volume: single); + procedure SetVolume(Volume: single); + procedure SetLoop(Enabled: boolean); + + procedure FadeIn(Time: real; TargetVolume: single); + procedure SetSyncSource(SyncSource: TSyncSource); + + procedure Rewind; + function Finished: boolean; + function Length: real; + + // Sounds + // TODO: + // add a TMediaDummyPlaybackStream implementation that will + // be used by the TSoundLib whenever OpenSound() fails, so checking for + // nil-pointers is not neccessary anymore. + // PlaySound/StopSound will be removed then, OpenSound will be renamed to + // CreateSound. + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(Stream: TAudioPlaybackStream); + procedure StopSound(Stream: TAudioPlaybackStream); + + // Equalizer + procedure GetFFTData(var Data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var Data: TPCMData): Cardinal; + + function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; + end; + + IGenericDecoder = Interface + ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] + function GetName(): String; + function InitializeDecoder(): boolean; + function FinalizeDecoder(): boolean; + //function IsSupported(const Filename: string): boolean; + end; + + (* + IVideoDecoder = Interface( IGenericDecoder ) + ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] + function Open(const Filename: string): TVideoDecodeStream; + end; + *) + + IAudioDecoder = Interface( IGenericDecoder ) + ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] + function Open(const Filename: string): TAudioDecodeStream; + end; + + IAudioInput = Interface + ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] + function GetName: String; + function InitializeRecord: boolean; + function FinalizeRecord(): boolean; + + procedure CaptureStart; + procedure CaptureStop; + end; + +type + TAudioConverter = class + protected + fSrcFormatInfo: TAudioFormatInfo; + fDstFormatInfo: TAudioFormatInfo; + public + function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual; + destructor Destroy(); override; + + (** + * Converts the InputBuffer and stores the result in OutputBuffer. + * If the result is not -1, InputSize will be set to the actual number of + * input-buffer bytes used. + * Returns the number of bytes written to the output-buffer or -1 if an error occured. + *) + function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract; + + (** + * Destination/Source size ratio + *) + function GetRatio(): double; virtual; abstract; + + function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract; + property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo; + property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo; + end; + +(* TODO +const + SOUNDID_START = 0; + SOUNDID_BACK = 1; + SOUNDID_SWOOSH = 2; + SOUNDID_CHANGE = 3; + SOUNDID_OPTION = 4; + SOUNDID_CLICK = 5; + LAST_SOUNDID = SOUNDID_CLICK; + + BaseSoundFilenames: array[0..LAST_SOUNDID] of string = ( + '%SOUNDPATH%/Common start.mp3', // Start + '%SOUNDPATH%/Common back.mp3', // Back + '%SOUNDPATH%/menu swoosh.mp3', // Swoosh + '%SOUNDPATH%/select music change music 50.mp3', // Change + '%SOUNDPATH%/option change col.mp3', // Option + '%SOUNDPATH%/rimshot022b.mp3' // Click + { + '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused) + '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused) + '%SOUNDPATH%/claps050b.mp3', // Clap (unused) + '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused) + } + ); +*) + +type + TSoundLibrary = class + private + // TODO + //Sounds: array of TAudioPlaybackStream; + public + // TODO: move sounds to the private section + // and provide IDs instead. + Start: TAudioPlaybackStream; + Back: TAudioPlaybackStream; + Swoosh: TAudioPlaybackStream; + Change: TAudioPlaybackStream; + Option: TAudioPlaybackStream; + Click: TAudioPlaybackStream; + BGMusic: TAudioPlaybackStream; + + constructor Create(); + destructor Destroy(); override; + + procedure LoadSounds(); + procedure UnloadSounds(); + + procedure StartBgMusic(); + procedure PauseBgMusic(); + // TODO + //function AddSound(Filename: string): integer; + //procedure RemoveSound(ID: integer); + //function GetSound(ID: integer): TAudioPlaybackStream; + //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default; + end; + +var + // TODO: JB --- THESE SHOULD NOT BE GLOBAL + Lines: array of TLines; + LyricsState: TLyricsState; + SoundLib: TSoundLibrary; + + +procedure InitializeSound; +procedure InitializeVideo; +procedure FinalizeMedia; + +function Visualization(): IVideoPlayback; +function VideoPlayback(): IVideoPlayback; +function AudioPlayback(): IAudioPlayback; +function AudioInput(): IAudioInput; +function AudioDecoders(): TInterfaceList; + +function MediaManager: TInterfaceList; + +procedure DumpMediaInterfaces(); + +implementation + +uses + sysutils, + math, + UIni, + UMain, + UCommandLine, + URecord, + ULog; + +var + DefaultVideoPlayback : IVideoPlayback; + DefaultVisualization : IVideoPlayback; + DefaultAudioPlayback : IAudioPlayback; + DefaultAudioInput : IAudioInput; + AudioDecoderList : TInterfaceList; + MediaInterfaceList : TInterfaceList; + + +constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); +begin + inherited Create(); + fChannels := Channels; + fSampleRate := SampleRate; + fFormat := Format; + UpdateFrameSize(); +end; + +procedure TAudioFormatInfo.SetChannels(Channels: byte); +begin + fChannels := Channels; + UpdateFrameSize(); +end; + +procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat); +begin + fFormat := Format; + UpdateFrameSize(); +end; + +function TAudioFormatInfo.GetBytesPerSec(): double; +begin + Result := FrameSize * SampleRate; +end; + +procedure TAudioFormatInfo.UpdateFrameSize(); +begin + fFrameSize := AudioSampleSize[fFormat] * fChannels; +end; + +function TAudioFormatInfo.Copy(): TAudioFormatInfo; +begin + Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format); +end; + +function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double; +begin + Result := (TargetInfo.FrameSize / Self.FrameSize) * + (TargetInfo.SampleRate / Self.SampleRate) +end; + + +function MediaManager: TInterfaceList; +begin + if (not assigned(MediaInterfaceList)) then + MediaInterfaceList := TInterfaceList.Create(); + Result := MediaInterfaceList; +end; + +function VideoPlayback(): IVideoPlayback; +begin + Result := DefaultVideoPlayback; +end; + +function Visualization(): IVideoPlayback; +begin + Result := DefaultVisualization; +end; + +function AudioPlayback(): IAudioPlayback; +begin + Result := DefaultAudioPlayback; +end; + +function AudioInput(): IAudioInput; +begin + Result := DefaultAudioInput; +end; + +function AudioDecoders(): TInterfaceList; +begin + Result := AudioDecoderList; +end; + +procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList); +var + i: integer; + obj: IInterface; +begin + if (not assigned(OutList)) then + Exit; + + OutList.Clear; + for i := 0 to InList.Count-1 do + begin + if assigned(InList[i]) then + begin + // add object to list if it implements the interface searched for + if (InList[i].QueryInterface(IID, obj) = 0) then + OutList.Add(obj); + end; + end; +end; + +procedure InitializeSound; +var + i: integer; + InterfaceList: TInterfaceList; + CurrentAudioDecoder: IAudioDecoder; + CurrentAudioPlayback: IAudioPlayback; + CurrentAudioInput: IAudioInput; +begin + // create a temporary list for interface enumeration + InterfaceList := TInterfaceList.Create(); + + // initialize all audio-decoders first + FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]); + if (not CurrentAudioDecoder.InitializeDecoder()) then + begin + Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName); + MediaManager.Remove(CurrentAudioDecoder); + end; + end; + + // create and setup decoder-list (see AudioDecoders()) + AudioDecoderList := TInterfaceList.Create; + FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders); + + // find and initialize playback interface + DefaultAudioPlayback := nil; + FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]); + if (CurrentAudioPlayback.InitializePlayback()) then + begin + DefaultAudioPlayback := CurrentAudioPlayback; + break; + end; + Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName); + MediaManager.Remove(CurrentAudioPlayback); + end; + + // find and initialize input interface + DefaultAudioInput := nil; + FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + CurrentAudioInput := IAudioInput(InterfaceList[i]); + if (CurrentAudioInput.InitializeRecord()) then + begin + DefaultAudioInput := CurrentAudioInput; + break; + end; + Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName); + MediaManager.Remove(CurrentAudioInput); + end; + + InterfaceList.Free; + + // Update input-device list with registered devices + AudioInputProcessor.UpdateInputDeviceConfig(); + + // Load in-game sounds + SoundLib := TSoundLibrary.Create; +end; + +procedure InitializeVideo(); +var + i: integer; + InterfaceList: TInterfaceList; + VideoInterface: IVideoPlayback; + VisualInterface: IVideoVisualization; +begin + InterfaceList := TInterfaceList.Create; + + // initialize and set video-playback singleton + DefaultVideoPlayback := nil; + FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + VideoInterface := IVideoPlayback(InterfaceList[i]); + if (VideoInterface.Init()) then + begin + DefaultVideoPlayback := VideoInterface; + break; + end; + Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName); + MediaManager.Remove(VideoInterface); + end; + + // initialize and set visualization singleton + DefaultVisualization := nil; + FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + begin + VisualInterface := IVideoVisualization(InterfaceList[i]); + if (VisualInterface.Init()) then + begin + DefaultVisualization := VisualInterface; + break; + end; + Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName); + MediaManager.Remove(VisualInterface); + end; + + InterfaceList.Free; + + // now that we have all interfaces, we can dump them + // TODO: move this to another place + if FindCmdLineSwitch( cMediaInterfaces ) then + begin + DumpMediaInterfaces(); + halt; + end; +end; + +procedure UnloadMediaModules; +var + i: integer; + InterfaceList: TInterfaceList; +begin + FreeAndNil(AudioDecoderList); + DefaultAudioPlayback := nil; + DefaultAudioInput := nil; + DefaultVideoPlayback := nil; + DefaultVisualization := nil; + + // create temporary interface list + InterfaceList := TInterfaceList.Create(); + + // finalize audio playback interfaces (should be done before the decoders) + FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioPlayback(InterfaceList[i]).FinalizePlayback(); + + // finalize audio input interfaces + FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioInput(InterfaceList[i]).FinalizeRecord(); + + // finalize audio decoder interfaces + FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IAudioDecoder(InterfaceList[i]).FinalizeDecoder(); + + // finalize video interfaces + FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IVideoPlayback(InterfaceList[i]).Finalize(); + + // finalize audio decoder interfaces + FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); + for i := 0 to InterfaceList.Count-1 do + IVideoVisualization(InterfaceList[i]).Finalize(); + + InterfaceList.Free; + + // finally free interfaces (by removing all references to them) + FreeAndNil(MediaInterfaceList); +end; + +procedure FinalizeMedia; +begin + // stop, close and free sounds + SoundLib.Free; + + // stop and close music stream + if (AudioPlayback <> nil) then + AudioPlayback.Close; + + // stop any active captures + if (AudioInput <> nil) then + AudioInput.CaptureStop; + + if (VideoPlayback <> nil) then + VideoPlayback.Close; + + if (Visualization <> nil) then + Visualization.Close; + + UnloadMediaModules(); +end; + +procedure DumpMediaInterfaces(); +begin + writeln( '' ); + writeln( '--------------------------------------------------------------' ); + writeln( ' In-use Media Interfaces ' ); + writeln( '--------------------------------------------------------------' ); + writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); + writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); + writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); + writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); + writeln( '--------------------------------------------------------------' ); + writeln( '' ); +end; + + +{ TSoundLibrary } + +constructor TSoundLibrary.Create(); +begin + inherited; + LoadSounds(); +end; + +destructor TSoundLibrary.Destroy(); +begin + UnloadSounds(); + inherited; +end; + +procedure TSoundLibrary.LoadSounds(); +begin + UnloadSounds(); + + Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); + Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); + Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); + Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); + Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); + Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); + + BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3'); + + if (BGMusic <> nil) then + BGMusic.Loop := True; +end; + +procedure TSoundLibrary.UnloadSounds(); +begin + FreeAndNil(Start); + FreeAndNil(Back); + FreeAndNil(Swoosh); + FreeAndNil(Change); + FreeAndNil(Option); + FreeAndNil(Click); + FreeAndNil(BGMusic); +end; + +(* TODO +function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream; +begin + if ((ID >= 0) and (ID < Length(Sounds))) then + Result := Sounds[ID] + else + Result := nil; +end; +*) + +procedure TSoundLibrary.StartBgMusic(); +begin + if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and + (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then + begin + AudioPlayback.PlaySound(Soundlib.BGMusic); + end; +end; + +procedure TSoundLibrary.PauseBgMusic(); +begin + If (Soundlib.BGMusic <> nil) then + begin + Soundlib.BGMusic.Pause; + end; +end; + +{ TVoiceRemoval } + +procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer); +var + FrameIndex, FrameSize: integer; + Value: integer; + Sample: PPCMStereoSample; +begin + FrameSize := 2 * SizeOf(SmallInt); + for FrameIndex := 0 to (BufSize div FrameSize)-1 do + begin + Sample := PPCMStereoSample(Buffer); + // channel difference + Value := Sample[0] - Sample[1]; + // clip + if (Value > High(SmallInt)) then + Value := High(SmallInt) + else if (Value < Low(SmallInt)) then + Value := Low(SmallInt); + // assign result + Sample[0] := Value; + Sample[1] := Value; + // increase to next frame + Inc(Buffer, FrameSize); + end; +end; + + +{ TVoiceRemoval } + +constructor TLyricsState.Create(); +begin + // create a triggered timer, so we can Pause() it, set the time + // and Resume() it afterwards for better synching. + Timer := TRelativeTimer.Create(true); + + // reset state + Reset(); +end; + +procedure TLyricsState.Pause(); +begin + Timer.Pause(); +end; + +procedure TLyricsState.Resume(); +begin + Timer.Resume(); +end; + +procedure TLyricsState.SetCurrentTime(Time: real); +begin + // do not start the timer (if not started already), + // after setting the current time + Timer.SetTime(Time, false); +end; + +function TLyricsState.GetCurrentTime(): real; +begin + Result := Timer.GetTime(); +end; + +(** + * Resets the timer and state of the lyrics. + * The timer will be stopped afterwards so you have to call Resume() + * to start the lyrics timer. + *) +procedure TLyricsState.Reset(); +begin + Pause(); + SetCurrentTime(0); + + StartTime := 0; + TotalTime := 0; + + OldBeat := -1; + MidBeat := -1; + CurrentBeat := -1; + + OldBeatC := -1; + MidBeatC := -1; + CurrentBeatC := -1; + + OldBeatD := -1; + MidBeatD := -1; + CurrentBeatD := -1; +end; + +(** + * Updates the beat information (CurrentBeat/MidBeat/...) according to the + * current lyric time. + *) +procedure TLyricsState.UpdateBeats(); +var + CurLyricsTime: real; +begin + CurLyricsTime := GetCurrentTime(); + + OldBeat := CurrentBeat; + MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeat := Floor(MidBeat); + + OldBeatC := CurrentBeatC; + MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeatC := Floor(MidBeatC); + + OldBeatD := CurrentBeatD; + // MidBeatD = MidBeat with additional GAP + MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); + CurrentBeatD := Floor(MidBeatD); +end; + + +{ TAudioConverter } + +function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; +begin + fSrcFormatInfo := SrcFormatInfo.Copy(); + fDstFormatInfo := DstFormatInfo.Copy(); + Result := true; +end; + +destructor TAudioConverter.Destroy(); +begin + FreeAndNil(fSrcFormatInfo); + FreeAndNil(fDstFormatInfo); +end; + + +{ TAudioProcessingStream } + +procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler); +begin + if (@Handler <> nil) then + begin + SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1); + OnCloseHandlers[High(OnCloseHandlers)] := @Handler; + end; +end; + +procedure TAudioProcessingStream.PerformOnClose(); +var i: integer; +begin + for i := 0 to High(OnCloseHandlers) do + begin + OnCloseHandlers[i](Self); + end; +end; + + +{ TAudioPlaybackStream } + +function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream; +begin + Result := SourceStream; +end; + +procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource); +begin + Self.SyncSource := SyncSource; + AvgSyncDiff := -1; +end; + +(* + * Results an adjusted size of the input buffer size to keep the stream in sync + * with the SyncSource. If no SyncSource was assigned to this stream, the + * input buffer size will be returned, so this method will have no effect. + * + * These are the possible cases: + * - Result > BufferSize: stream is behind the sync-source (stream is too slow), + * (Result-BufferSize) bytes of the buffer must be skipped. + * - Result = BufferSize: stream is in sync, + * there is nothing to do. + * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast), + * (BufferSize-Result) bytes of the buffer must be padded. + *) +function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; +var + TimeDiff: double; + TimeCorrectionFactor: double; +const + AVG_HISTORY_FACTOR = 0.9; + SYNC_THRESHOLD = 0.045; + MAX_SYNC_DIFF_TIME = 0.002; +begin + Result := BufferSize; + + if (not assigned(SyncSource)) then + Exit; + + if (BufferSize <= 0) then + Exit; + + // difference between sync-source and stream position + // (negative if the music-stream's position is ahead of the master clock) + TimeDiff := SyncSource.GetClock() - (Position - GetLatency()); + + // calculate average time difference (some sort of weighted mean). + // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. + // This means that older diffs are weighted more with a higher history factor + // than with a lower. Do not use a too low history factor. FFmpeg produces + // very instable timestamps (pts) for ogg due to some bugs. They may differ + // +-50ms from the real stream position. Without filtering those glitches we + // would synch without any need, resulting in ugly plopping sounds. + if (AvgSyncDiff = -1) then + AvgSyncDiff := TimeDiff + else + AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + + AvgSyncDiff * AVG_HISTORY_FACTOR; + + // check if sync needed + if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then + begin + // TODO: use SetPosition if diff is too large (>5s) + if (TimeDiff < 1) then + TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff + else + TimeCorrectionFactor := TimeDiff; + + // calculate adapted buffer size + // reduce size of data to fetch if music is ahead, increase otherwise + Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize; + if (Result < 0) then + Result := 0; + + // reset average + AvgSyncDiff := -1; + end; + + (* + DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) + + '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) + + '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) + + '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3)); + *) +end; + +(* + * Fills a buffer with copies of the given frame or with 0 if frame. + *) +procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); +var + i: integer; + FrameCopyCount: integer; +begin + // the buffer must at least contain place for one copy of the frame. + if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then + Exit; + + // no valid frame -> fill with 0 + if ((Frame = nil) or (FrameSize <= 0)) then + begin + FillChar(Buffer[0], BufferSize, 0); + Exit; + end; + + // number of frames to copy + FrameCopyCount := BufferSize div FrameSize; + // insert as many copies of frame into the buffer as possible + for i := 0 to FrameCopyCount-1 do + Move(Frame[0], Buffer[i*FrameSize], FrameSize); +end; + +{ TAudioVoiceStream } + +function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; +begin + Self.ChannelMap := ChannelMap; + Self.FormatInfo := FormatInfo.Copy(); + // a voice stream is always mono, reassure the the format is correct + Self.FormatInfo.Channels := 1; + Result := true; +end; + +destructor TAudioVoiceStream.Destroy; +begin + Close(); + inherited; +end; + +procedure TAudioVoiceStream.Close(); +begin + PerformOnClose(); + FreeAndNil(FormatInfo); +end; + +function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + Result := FormatInfo; +end; + +function TAudioVoiceStream.GetLength(): real; +begin + Result := -1; +end; + +function TAudioVoiceStream.GetPosition(): real; +begin + Result := -1; +end; + +procedure TAudioVoiceStream.SetPosition(Time: real); +begin +end; + +function TAudioVoiceStream.GetLoop(): boolean; +begin + Result := false; +end; + +procedure TAudioVoiceStream.SetLoop(Enabled: boolean); +begin +end; + + +end. diff --git a/src/base/UParty.pas b/src/base/UParty.pas new file mode 100644 index 00000000..01a182b1 --- /dev/null +++ b/src/base/UParty.pas @@ -0,0 +1,630 @@ +unit UParty; + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses UPartyDefs, UCoreModule, UPluginDefs; + +type + ARounds = Array [0..252] of Integer; //0..252 needed for + PARounds = ^ARounds; + + TRoundInfo = record + Modi: Cardinal; + Winner: Byte; + end; + + TeamOrderEntry = record + Teamnum: Byte; + Score: Byte; + end; + + TeamOrderArray = Array[0..5] of Byte; + + TUS_ModiInfoEx = record + Info: TUS_ModiInfo; + Owner: Integer; + TimesPlayed: Byte; //Helper for setting Round Plugins + end; + + TPartySession = class (TCoreModule) + private + bPartyMode: Boolean; //Is this Party or Singleplayer + CurRound: Byte; + + Modis: Array of TUS_ModiInfoEx; + Teams: TTeamInfo; + + function IsWinner(Player, Winner: Byte): boolean; + procedure GenScores; + function GetRandomPlugin(TeamMode: Boolean): Cardinal; + function GetRandomPlayer(Team: Byte): Byte; + public + //Teams: TTeamInfo; + Rounds: array of TRoundInfo; + + //TCoreModule methods to inherit + Constructor Create; override; + Procedure Info(const pInfo: PModuleInfo); override; + Function Load: Boolean; override; + Function Init: Boolean; override; + Procedure DeInit; override; + Destructor Destroy; override; + + //Register Modi Service + Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + + //Start new Party + Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success + Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) + Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. + Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + + Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading + Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding + + Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success + Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + + Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... + Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam + end; + +const + StandardModi = 0; //Modi ID that will be played in non party Mode + +implementation + +uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} + +//------------- +// Function that gives some Infos about the Module to the Core +//------------- +Procedure TPartySession.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPartySession'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Manages Party Modi and Party Game'; +end; + +//------------- +// Just the Constructor +//------------- +Constructor TPartySession.Create; +begin + inherited; + //UnSet PartyMode + bPartyMode := False; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +Function TPartySession.Load: Boolean; +begin + //Add Register Party Modi Service + Result := True; + Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); + Core.Services.AddService('Party/StartParty', nil, Self.StartParty); + Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +Function TPartySession.Init: Boolean; +begin + //Just set Prvate Var to true. + Result := true; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +Procedure TPartySession.DeInit; +begin + //Force DeInit + +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TPartySession.Destroy; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Modis, 0); + inherited; +end; + +//------------- +// Registers a new Modi. wParam: Pointer to TUS_ModiInfo +// Service for Plugins +//------------- +Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; +var + Len: Integer; + Info: PUS_ModiInfo; +begin + Info := PModiInfo; + //Copy Info if cbSize is correct + If (Info.cbSize = SizeOf(TUS_ModiInfo)) then + begin + Len := Length(Modis); + SetLength(Modis, Len + 1); + + Modis[Len].Info := Info^; + end + else + Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession')); + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// Returns a Number of a Random Plugin +//---------- +Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal; +var + LowestTP: Byte; + NumPwithLTP: Word; + I: Integer; + R: Word; +begin + Result := StandardModi; //If there are no matching Modis, Play StandardModi + LowestTP := high(Byte); + NumPwithLTP := 0; + + //Search for Plugins not often played yet + For I := 0 to high(Modis) do + begin + if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + lowestTP := Modis[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Plugin + For I := 0 to high(Modis) do + begin + if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + begin + //Plugin Found + if (R = 0) then + begin + Result := I; + Inc(Modis[I].TimesPlayed); + Break; + end; + + Dec(R); + end; + end; +end; + +//---------- +// Starts new Party Mode. Returns Non Zero on Success +//---------- +Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; +var + I: Integer; + aiRounds: PARounds; + TeamMode: Boolean; +begin + Result := 0; + If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then + begin + bPartyMode := false; + aiRounds := PAofIRounds; + + Try + //Is this Teammode(More then one Player per Team) ? + TeamMode := True; + For I := 0 to Teams.NumTeams-1 do + TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1); + + //Set Rounds + SetLength(Rounds, NumRounds); + + For I := 0 to High(Rounds) do + begin //Set Plugins + If (aiRounds[I] = -1) then + Rounds[I].Modi := GetRandomPlugin(TeamMode) + Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then + Rounds[I].Modi := aiRounds[I] + Else + Rounds[I].Modi := StandardModi; + + Rounds[I].Winner := High(Byte); //Set Winner to Not Played + end; + + CurRound := High(Byte); //Set CurRound to not defined + + //Return teh true and Set PartyMode + bPartyMode := True; + Result := 1; + + Except + Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); + end; + end; +end; + +//---------- +// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +//---------- +Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; +begin + If (bPartyMode) AND (CurRound <= High(Rounds)) then + begin //If PartyMode is enabled: + //Return the Plugin of the Cur Round + Result := Integer(@Modis[Rounds[CurRound].Modi]); + end + else + begin //Return StandardModi + Result := Integer(@Modis[StandardModi]); + end; +end; + +//---------- +// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible +//---------- +Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; +begin + Result := -1; + If (bPartyMode) then + begin + // to-do : Whitü: Check here if SingScreen is not Shown atm. + bPartyMode := False; + Result := 1; + end + else + Result := 0; +end; + +//---------- +//GetRandomPlayer - Gives back a Random Player to Play next Round +//---------- +function TPartySession.GetRandomPlayer(Team: Byte): Byte; +var + I, R: Integer; + lowestTP: Byte; + NumPwithLTP: Byte; +begin + LowestTP := high(Byte); + NumPwithLTP := 0; + Result := 0; + + //Search for Players that have not often played yet + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + begin + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + + //Create Random No + R := Random(NumPwithLTP); + + //Search for Random Player + For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + begin + //Player Found + if (R = 0) then + begin + Result := I; + Break; + end; + + Dec(R); + end; + end; +end; + +//---------- +// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played +//---------- +Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; +var I: Integer; +begin + If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin //everythings OK! -> Start the Round, maaaaan + Inc(CurRound); + + //Set Players to play this Round + for I := 0 to Teams.NumTeams-1 do + Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + + // FIXME: return a valid result + Result := 0; + end + else + Result := -1; +end; + +//---------- +//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//---------- +function TPartySession.IsWinner(Player, Winner: Byte): boolean; +var + Bit: Byte; +begin + Bit := 1 shl Player; + + Result := ((Winner AND Bit) = Bit); +end; + +//---------- +//GenScores - Inc Scores for Cur. Round +//---------- +procedure TPartySession.GenScores; +var + I: Byte; +begin + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[CurRound].Winner) then + Inc(Teams.Teaminfo[I].Score); + end; +end; + +//---------- +// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading +//---------- +Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; +begin + If (not bPartyMode) then + begin //Set Rounds if not in PartyMode + SetLength(Rounds, 1); + Rounds[0].Modi := StandardModi; + Rounds[0].Winner := High(Byte); + CurRound := 0; + end; + + Try + //Core. + Except + on E : Exception do + begin + Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); + If (Rounds[CurRound].Modi = StandardModi) then + begin + Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession')); + Halt; + end + Else //Select StandardModi + begin + Rounds[CurRound].Modi := StandardModi + end; + end; + End; + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// CallModiDeInit - Calls DeInitProc and does the RoundEnding +//---------- +Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; +var + I: Integer; + MaxScore: Word; +begin + If (bPartyMode) then + begin + //Get Winner Byte! + if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin + Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) + else + begin //Create winners by Score :/ + Rounds[CurRound].Winner := 0; + MaxScore := 0; + for I := 0 to Teams.NumTeams-1 do + begin + // to-do : recode Percentage stuff + //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; + if (Player[I].ScoreTotalInt > MaxScore) then + begin + MaxScore := Player[I].ScoreTotalInt; + Rounds[CurRound].Winner := 1 shl I; + end + else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then + begin + Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); + end; + end; + + + //When nobody has Points -> Everybody loose + if (MaxScore = 0) then + Rounds[CurRound].Winner := 0; + + end; + + //Generate teh Scores + GenScores; + + //Inc Players TimesPlayed + If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then + begin + For I := 0 to Teams.NumTeams-1 do + Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); + end; + end + else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then + Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID); + + // FIXME: return a valid result + Result := 0; +end; + +//---------- +// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success +//---------- +Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var Info: ^TTeamInfo; +begin + Result := -1; + Info := pTeamInfo; + If (Info <> nil) then + begin + Try + // to - do : Check Delphi memory management in this case + //Not sure if i had to copy PChars to a new address or if delphi manages this o0 + Info^ := Teams; + Result := 0; + Except + Result := -2; + End; + end; +end; + +//---------- +// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success +//---------- +Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var + TeamInfobackup: TTeamInfo; + Info: ^TTeamInfo; +begin + Result := -1; + Info := pTeamInfo; + If (Info <> nil) then + begin + Try + TeamInfoBackup := Teams; + // to - do : Check Delphi memory management in this case + //Not sure if i had to copy PChars to a new address or if delphi manages this o0 + Teams := Info^; + Result := 0; + Except + Teams := TeamInfoBackup; + Result := -2; + End; + end; +end; + +//---------- +// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... +//---------- +Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; +var + I, J: Integer; + ATeams: array [0..5] of TeamOrderEntry; + TempTeam: TeamOrderEntry; +begin + // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing + //Fill Team Array + For I := 0 to Teams.NumTeams-1 do + begin + ATeams[I].Teamnum := I; + ATeams[I].Score := Teams.Teaminfo[I].Score; + end; + + //Sort Teams + for J := 0 to Teams.NumTeams-1 do + for I := 1 to Teams.NumTeams-1 do + if ATeams[I].Score > ATeams[I-1].Score then + begin + TempTeam := ATeams[I-1]; + ATeams[I-1] := ATeams[I]; + ATeams[I] := TempTeam; + end; + + //Copy to Result + Result := 0; + For I := 0 to Teams.NumTeams-1 do + Result := Result or (ATeams[I].TeamNum Shl I*3); +end; + +//---------- +// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam +//---------- +Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; +var + Winners: Array of String; + I: Integer; + ResultStr: String; + S: ^String; +begin + ResultStr := Language.Translate('PARTY_NOBODY'); + + if (wParam <= High(Rounds)) then + begin + if (Rounds[wParam].Winner <> 0) then + begin + if (Rounds[wParam].Winner = 255) then + begin + ResultStr := Language.Translate('PARTY_NOTPLAYEDYET'); + end + else + begin + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[wParam].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; + end; + end; + ResultStr := Language.Implode(Winners); + end; + end; + end; + + //Now Return what we have got + If (lParam = nil) then + begin //ReturnString Length + Result := Length(ResultStr); + end + Else + begin //Return String + Try + S := lParam; + S^ := ResultStr; + Result := 0; + Except + Result := -1; + + End; + end; +end; + +end. diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas new file mode 100644 index 00000000..1dcdb5b9 --- /dev/null +++ b/src/base/UPlatform.pas @@ -0,0 +1,174 @@ +unit UPlatform; + +// Comment by Eddie: +// This unit defines an interface for platform specific utility functions. +// The Interface is implemented in separate files for each platform: +// UPlatformWindows, UPlatformLinux and UPlatformMacOSX. + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes; + +type + TDirectoryEntry = record + Name : WideString; + IsDirectory : boolean; + IsFile : boolean; + end; + + TDirectoryEntryArray = array of TDirectoryEntry; + + TPlatform = class + function GetExecutionDir(): string; + procedure Init; virtual; + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract; + function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual; + function FindSongFile(Dir, Mask: WideString): WideString; virtual; + procedure Halt; virtual; + function GetLogPath : WideString; virtual; abstract; + function GetGameSharedPath : WideString; virtual; abstract; + function GetGameUserPath : WideString; virtual; abstract; + function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual; + end; + + function Platform(): TPlatform; + +implementation + +uses + SysUtils, + {$IFDEF MSWINDOWS} + UPlatformWindows, + {$ENDIF} + {$IFDEF LINUX} + UPlatformLinux, + {$ENDIF} + {$IFDEF DARWIN} + UPlatformMacOSX, + {$ENDIF} + ULog; + + +// I have modified it to use the Platform_singleton in this location ( in the implementaiton ) +// so that this variable can NOT be overwritten from anywhere else in the application. +// the accessor function platform, emulates all previous calls to work the same way. +var + Platform_singleton : TPlatform; + +function Platform : TPlatform; +begin + Result := Platform_singleton; +end; + +(** + * Default Init() implementation + *) +procedure TPlatform.Init; +begin +end; + +(** + * Default Halt() implementation + *) +procedure TPlatform.Halt; +begin + // Note: Application.terminate is NOT the same + System.Halt; +end; + +{** + * Returns the directory of the executable + *} +function TPlatform.GetExecutionDir(): string; +begin + Result := ExtractFilePath(ParamStr(0)); +end; + +(** + * Default TerminateIfAlreadyRunning() implementation + *) +function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean; +begin + Result := false; +end; + +(** + * Default FindSongFile() implementation + *) +function TPlatform.FindSongFile(Dir, Mask: WideString): WideString; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then + begin + Result := SR.Name; + end; + SysUtils.FindClose(SR); +end; + +function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; +const + COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption +var + SourceFile, TargetFile: TFileStream; + FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. + NumberOfBytes: integer; // number of bytes read from SourceFile +begin + Result := false; + SourceFile := nil; + TargetFile := nil; + + // if overwrite is disabled return if the target file already exists + if (FailIfExists and FileExists(Target)) then + Exit; + + try + try + // open source and target file (might throw an exception on error) + SourceFile := TFileStream.Create(Source, fmOpenRead); + TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite); + + while true do + begin + // read a block from the source file and check for errors or EOF + NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer)); + if (NumberOfBytes <= 0) then + Break; + // write block to target file and check if everything was written + if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then + Exit; + end; + except + Exit; + end; + finally + SourceFile.Free; + TargetFile.Free; + end; + + Result := true; +end; + + +initialization +{$IFDEF MSWINDOWS} + Platform_singleton := TPlatformWindows.Create; +{$ENDIF} +{$IFDEF LINUX} + Platform_singleton := TPlatformLinux.Create; +{$ENDIF} +{$IFDEF DARWIN} + Platform_singleton := TPlatformMacOSX.Create; +{$ENDIF} + +finalization + Platform_singleton.Free; + +end. diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas new file mode 100644 index 00000000..3227e4f8 --- /dev/null +++ b/src/base/UPlatformLinux.pas @@ -0,0 +1,173 @@ +unit UPlatformLinux; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + UPlatform, + UConfig; + +type + TPlatformLinux = class(TPlatform) + private + UseLocalDirs: boolean; + + procedure DetectLocalExecution(); + function GetHomeDir(): string; + public + procedure Init; override; + + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; + + function GetLogPath : WideString; override; + function GetGameSharedPath : WideString; override; + function GetGameUserPath : WideString; override; + end; + +implementation + +uses + UCommandLine, + BaseUnix, + {$IF FPC_VERSION_INT >= 2002002} + pwd, + {$IFEND} + SysUtils, + ULog; + +procedure TPlatformLinux.Init; +begin + inherited Init(); + DetectLocalExecution(); +end; + +{** + * Detects whether the game was executed locally or globally. + * - It is local if it was not installed and directly executed from + * within the game folder. In this case resources (themes, language-files) + * reside in the directory of the executable. + * - It is global if the game was installed (e.g. to /usr/bin) and + * the resources are in a separate folder (e.g. /usr/share/ultrastardx) + * which name is stored in the INSTALL_DATADIR constant in config-linux.inc. + * + * Sets UseLocalDirs to true if the game is executed locally, false otherwise. + *} +procedure TPlatformLinux.DetectLocalExecution(); +var + LocalDir: string; +begin + LocalDir := GetExecutionDir(); + + // we just check if the 'languages' folder exists in the + // directory of the executable. If so -> local execution. + UseLocalDirs := (DirectoryExists(LocalDir + 'languages')); +end; + +function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; +var + i: Integer; + TheDir : pDir; + ADirent : pDirent; + Entry : Longint; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FpOpenDir( Dir ); + if Assigned(TheDir) then + begin + repeat + ADirent := FpReadDir(TheDir^); + + if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until (ADirent = nil); + + FpCloseDir(TheDir^); + end; +end; + +function TPlatformLinux.GetLogPath: WideString; +begin + if UseLocalDirs then + Result := GetExecutionDir() + else + Result := GetGameUserPath() + 'logs/'; + + // create non-existing directories + ForceDirectories(Result); +end; + +function TPlatformLinux.GetGameSharedPath: WideString; +begin + if UseLocalDirs then + Result := GetExecutionDir() + else + Result := IncludeTrailingPathDelimiter(INSTALL_DATADIR); +end; + +function TPlatformLinux.GetGameUserPath: WideString; +begin + if UseLocalDirs then + Result := GetExecutionDir() + else + Result := GetHomeDir() + '.ultrastardx/'; +end; + +{** + * Returns the user's home directory terminated by a path delimiter + *} +function TPlatformLinux.GetHomeDir(): string; +{$IF FPC_VERSION_INT >= 2002002} +var + PasswdEntry: PPasswd; +{$IFEND} +begin + Result := ''; + + {$IF FPC_VERSION_INT >= 2002002} + // try to retrieve the info from passwd + PasswdEntry := FpGetpwuid(FpGetuid()); + if (PasswdEntry <> nil) then + Result := PasswdEntry.pw_dir; + {$IFEND} + // fallback if passwd does not contain the path + if (Result = '') then + Result := GetEnvironmentVariable('HOME'); + // add trailing path delimiter (normally '/') + if (Result <> '') then + Result := IncludeTrailingPathDelimiter(Result); + + {$IF FPC_VERSION_INT >= 2002002} + // GetUserDir() is another function that returns a user path. + // It uses env-var HOME or a fallback to a temp-dir. + //Result := GetUserDir(); + {$IFEND} +end; + +end. diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas new file mode 100644 index 00000000..2ab2a390 --- /dev/null +++ b/src/base/UPlatformMacOSX.pas @@ -0,0 +1,294 @@ +unit UPlatformMacOSX; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + ULog, + UPlatform; + +type + {** + * @abstract(Provides Mac OS X specific details.) + * @lastmod(August 1, 2008) + * The UPlatformMacOSX unit takes care of setting paths to resource folders. + * + * (Note for non-Maccies: "folder" is the Mac name for directory.) + * + * Note on the resource folders: + * 1. Installation of an application on the mac works as follows: Extract and copy an application + * and if you don't like or need the application anymore you move the folder + * to the trash - and you're done. + * 2. The use folders in the user's home directory is against Apple's guidelines + * and strange to an average user. + * 3. Even worse is using /usr/local/... since all lowercase folders in / are + * not visible to an average user in the Finder, at least not without some "tricks". + * + * The best way would be to store everything within the application bundle. However, this + * requires USDX to offer the handling of the resources. Until this is implemented, the + * second best solution is as follows: + * + * According to Aple guidelines handling of resources and folders should follow these lines: + * + * Acceptable places for files are folders named UltraStarDeluxe either in + * /Library/Application Support/ + * or + * ~/Library/Application Support/ + * + * So + * GetGameSharedPath could return + * /Library/Application Support/UltraStarDeluxe/Resources/. + * GetGameUserPath could return + * ~/Library/Application Support/UltraStarDeluxe/Resources/. + * + * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + * is used. So every user needs the complete set of files and folders. + * Future versions may also use shared resources in + * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not + * treated yet in the code outside this unit. + * + * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. + * The existence of needed files is then checked and if a file is missing + * it is copied to there from within the Resources folder in the Application + * bundle, which contains the default files. USDX should not delete files or + * folders in Application Support/UltraStarDeluxe automatically or without + * user confirmation. + *} + TPlatformMacOSX = class(TPlatform) + private + {** + * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app. + *} + function GetBundlePath: WideString; + + {** + * GetApplicationSupportPath returns the path to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + *} + function GetApplicationSupportPath: WideString; + + {** + * see the description of @link(Init). + *} + procedure CreateUserFolders(); + + public + {** + * Init simply calls @link(CreateUserFolders), which in turn scans the folder + * UltraStarDeluxe.app/Contents/Resources for all files and folders. + * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked + * for their presence and missing ones are copied. + *} + procedure Init; override; + + {** + * DirectoryFindFiles returns all entries of a folder with names and booleans + * about their type, i.e. file or directory. + *} + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; + + {** + * GetLogPath returns the path for log messages. Currently it is set to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log. + *} + function GetLogPath : WideString; override; + + {** + * GetGameSharedPath returns the path for shared resources. Currently it is set to + * /Library/Application Support/UltraStarDeluxe/Resources. + * However it is not used. + *} + function GetGameSharedPath : WideString; override; + + {** + * GetGameUserPath returns the path for user resources. Currently it is set to + * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * This is where a user can add songs, themes, .... + *} + function GetGameUserPath : WideString; override; + end; + +implementation + +uses + SysUtils, + BaseUnix; + +procedure TPlatformMacOSX.Init; +begin + CreateUserFolders(); +end; + +procedure TPlatformMacOSX.CreateUserFolders(); +var + RelativePath: string; + // BaseDir contains the path to the folder, where a search is performed. + // It is set to the entries in @link(DirectoryList) one after the other. + BaseDir: string; + // OldBaseDir contains the path to the folder, where the search started. + // It is used to return to it, when the search is completed in all folders. + OldBaseDir: string; + // This record contains the result of a file search with FindFirst or FindNext + SearchInfo: TSearchRec; + // These two lists contain all folder and file names found + // within the folder @link(BaseDir). + DirectoryList, FileList: TStringList; + // DirectoryIsFinished contains the index of the folder in @link(DirectoryList), + // which is the last one completely searched. Later folders are still to be + // searched for additional files and folders. + DirectoryIsFinished: longint; + Counter: longint; + + UserPathName: string; +const + // used to construct the @link(UserPathName) + PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; +begin + // Get the current folder and save it in OldBaseDir for returning to it, when + // finished. + GetDir(0, OldBaseDir); + + // UltraStarDeluxe.app/Contents/Resources contains all the default files and + // folders. + BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources'; + ChDir(BaseDir); + + // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + // is used. + UserPathName := GetEnvironmentVariable('HOME') + PathName; + + DirectoryIsFinished := 0; + DirectoryList := TStringList.Create(); + FileList := TStringList.Create(); + DirectoryList.Add('.'); + + // create the folder and file lists + repeat + + RelativePath := DirectoryList[DirectoryIsFinished]; + ChDir(BaseDir + '/' + RelativePath); + if (FindFirst('*', faAnyFile, SearchInfo) = 0) then + begin + repeat + if DirectoryExists(SearchInfo.Name) then + begin + if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then + DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); + end + else + Filelist.Add(RelativePath + '/' + SearchInfo.Name); + until (FindNext(SearchInfo) <> 0); + end; + FindClose(SearchInfo); + Inc(DirectoryIsFinished); + until (DirectoryIsFinished = DirectoryList.Count); + + // create missing folders + for Counter := 0 to DirectoryList.Count-1 do + begin + if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then + Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', + 'TPlatformMacOSX.CreateUserFolders'); + end; + DirectoryList.Free(); + + // copy missing files + for Counter := 0 to Filelist.Count-1 do + begin + CopyFile(BaseDir + '/' + Filelist[Counter], + UserPathName + '/' + Filelist[Counter], true); + end; + FileList.Free(); + + // go back to the initial folder + ChDir(OldBaseDir); +end; + +function TPlatformMacOSX.GetBundlePath: WideString; +var + i, pos : integer; +begin + // Mac applications are packaged in folders. + // We have to cut the last two folders + // to get the application folder. + + Result := GetExecutionDir(); + for i := 1 to 2 do + begin + pos := Length(Result); + repeat + Delete(Result, pos, 1); + pos := Length(Result); + until (pos = 0) or (Result[pos] = '/'); + end; +end; + +function TPlatformMacOSX.GetApplicationSupportPath: WideString; +const + PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources'; +begin + Result := GetEnvironmentVariable('HOME') + PathName + '/'; +end; + +function TPlatformMacOSX.GetLogPath: WideString; +begin + Result := GetApplicationSupportPath + 'Logs'; +end; + +function TPlatformMacOSX.GetGameSharedPath: WideString; +begin + Result := GetApplicationSupportPath; +end; + +function TPlatformMacOSX.GetGameUserPath: WideString; +begin + Result := GetApplicationSupportPath; +end; + +function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; +var + i : integer; + TheDir : pdir; + ADirent : pDirent; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := FPOpenDir(Dir); + if Assigned(TheDir) then + repeat + ADirent := FPReadDir(TheDir); + + if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.d_name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength(Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then + begin + SetLength(Result, i + 1); + Result[i].Name := ADirent^.d_name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until ADirent = nil; + + FPCloseDir(TheDir); +end; + +end. diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas new file mode 100644 index 00000000..029e8d33 --- /dev/null +++ b/src/base/UPlatformWindows.pas @@ -0,0 +1,236 @@ +unit UPlatformWindows; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// turn off messages for platform specific symbols +{$WARN SYMBOL_PLATFORM OFF} + +uses + Classes, + UPlatform; + +type + TPlatformWindows = class(TPlatform) + private + function GetSpecialPath(CSIDL: integer): WideString; + public + function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; + function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; + + function GetLogPath: WideString; override; + function GetGameSharedPath: WideString; override; + function GetGameUserPath: WideString; override; + + function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override; + end; + +implementation + +uses + SysUtils, + ShlObj, + Windows, + UConfig; + +type + TSearchRecW = record + Time: Integer; + Size: Integer; + Attr: Integer; + Name: WideString; + ExcludeAttr: Integer; + FindHandle: THandle; + FindData: TWin32FindDataW; + end; + +function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward; +function FindNextW(var F: TSearchRecW): Integer; forward; +procedure FindCloseW(var F: TSearchRecW); forward; +function FindMatchingFileW(var F: TSearchRecW): Integer; forward; +function DirectoryExistsW(const Directory: widestring): Boolean; forward; + +function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; +const + faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; +begin + F.ExcludeAttr := not Attr and faSpecial; +{$IFDEF Delphi} + F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); +{$ELSE} + F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData); +{$ENDIF} + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Result := FindMatchingFileW(F); + if Result <> 0 then FindCloseW(F); + end else + Result := GetLastError; +end; + +function FindNextW(var F: TSearchRecW): Integer; +begin +{$IFDEF Delphi} + if FindNextFileW(F.FindHandle, F.FindData) then +{$ELSE} + if FindNextFileW(F.FindHandle, @F.FindData) then +{$ENDIF} + Result := FindMatchingFileW(F) + else + Result := GetLastError; +end; + +procedure FindCloseW(var F: TSearchRecW); +begin + if F.FindHandle <> INVALID_HANDLE_VALUE then + begin + Windows.FindClose(F.FindHandle); + F.FindHandle := INVALID_HANDLE_VALUE; + end; +end; + +function FindMatchingFileW(var F: TSearchRecW): Integer; +var + LocalFileTime: TFileTime; +begin + with F do + begin + while FindData.dwFileAttributes and ExcludeAttr <> 0 do +{$IFDEF Delphi} + if not FindNextFileW(FindHandle, FindData) then +{$ELSE} + if not FindNextFileW(FindHandle, @FindData) then +{$ENDIF} + begin + Result := GetLastError; + Exit; + end; + FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); + FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); + Size := FindData.nFileSizeLow; + Attr := FindData.dwFileAttributes; + Name := FindData.cFileName; + end; + Result := 0; +end; + +function DirectoryExistsW(const Directory: widestring): Boolean; +var + Code: Integer; +begin + Code := GetFileAttributesW(PWideChar(Directory)); + Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); +end; + +//------------------------------ +//Start more than One Time Prevention +//------------------------------ +function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean; +var + hWnd: THandle; + I: Integer; +begin + Result := false; + hWnd:= FindWindow(nil, PChar(WndTitle)); + //Programm already started + if (hWnd <> 0) then + begin + I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO); + if (I = IDYes) then + begin + I := 1; + repeat + Inc(I); + hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I))); + until (hWnd = 0); + WndTitle := WndTitle + ' Instance ' + InttoStr(I); + end + else + Result := true; + end; +end; + +function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; +var + i : Integer; + SR : TSearchRecW; + Attrib : Integer; +begin + i := 0; + Filter := LowerCase(Filter); + + if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + begin + Attrib := FileGetAttr(Dir + SR.name); + if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := SR.name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := SR.Name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + until FindNextW(SR) <> 0; + FindCloseW(SR); +end; + +(** + * Returns the path of a special folder. + * + * Some Folder IDs: + * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data) + * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data) + * CSIDL_PROFILE (e.g. C:\Documents and Settings\username) + * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents) + * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music) + *) +function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString; +var + Buffer: array [0..MAX_PATH-1] of WideChar; +begin +{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2 + if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then + Result := Buffer + else +{$IFEND} + Result := ''; +end; + +function TPlatformWindows.GetLogPath: WideString; +begin + Result := GetExecutionDir(); +end; + +function TPlatformWindows.GetGameSharedPath: WideString; +begin + Result := GetExecutionDir(); +end; + +function TPlatformWindows.GetGameUserPath: WideString; +begin + //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim; + Result := GetExecutionDir(); +end; + +function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; +begin + Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists); +end; + +end. diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas new file mode 100644 index 00000000..c867c356 --- /dev/null +++ b/src/base/UPlaylist.pas @@ -0,0 +1,490 @@ +unit UPlaylist; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + USong; + +type + TPlaylistItem = record + Artist: String; + Title: String; + SongID: Integer; + end; + + APlaylistItem = array of TPlaylistItem; + + TPlaylist = record + Name: String; + Filename: String; + Items: APlaylistItem; + end; + + APlaylist = array of TPlaylist; + + //---------- + //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) + //---------- + TPlaylistManager = class + private + + public + Mode: TSingMode; //Current Playlist Mode for SongScreen + CurPlayList: Cardinal; + CurItem: Cardinal; + + Playlists: APlaylist; + + constructor Create; + Procedure LoadPlayLists; + Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; + Procedure SavePlayList(Index: Cardinal); + + Procedure SetPlayList(Index: Cardinal); + + Function AddPlaylist(Name: String): Cardinal; + Procedure DelPlaylist(const Index: Cardinal); + + Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); + Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); + + Procedure GetNames(var PLNames: array of String); + Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; + end; + + {Modes: + 0: Standard Mode + 1: Category Mode + 2: PlayList Mode} + + var + PlayListMan: TPlaylistManager; + + +implementation + +uses USongs, + ULog, + UMain, + //UFiles, + UGraphic, + UThemes, + SysUtils; + +//---------- +//Create - Construct Class - Dummy for now +//---------- +constructor TPlayListManager.Create; +begin + inherited; + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; + PlayListBuffer: TPlayList; +begin + SetLength(Playlists, 0); + + if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then + begin + repeat + Len := Length(Playlists); + SetLength(Playlists, Len +1); + + if not LoadPlayList (Len, Sr.Name) then + SetLength(Playlists, Len) + else + begin + // Sort the Playlists - Insertion Sort + PlayListBuffer := Playlists[Len]; + Dec(Len); + while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do + begin + Playlists[Len+1] := Playlists[Len]; + Dec(Len); + end; + Playlists[Len+1] := PlayListBuffer; + end; + + until FindNext(SR) <> 0; + FindClose(SR); + end; +end; + +//---------- +//LoadPlayList - Load a Playlist in the Array +//---------- +Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; + var + F: TextFile; + Line: String; + PosDelimiter: Integer; + SongID: Integer; + Len: Integer; + + Function FindSong(Artist, Title: String): Integer; + var I: Integer; + begin + Result := -1; + + For I := low(CatSongs.Song) to high(CatSongs.Song) do + begin + if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then + begin + Result := I; + Break; + end; + end; + end; +begin + if not FileExists(PlayListPath + Filename) then + begin + Log.LogError('Could not load Playlist: ' + Filename); + Result := False; + Exit; + end; + Result := True; + + //Load File + AssignFile(F, PlayListPath + FileName); + Reset(F); + + //Set Filename + PlayLists[Index].Filename := Filename; + PlayLists[Index].Name := ''; + + //Read Until End of File + While not Eof(F) do + begin + //Read Curent Line + Readln(F, Line); + + if (Length(Line) > 0) then + begin + PosDelimiter := Pos(':', Line); + if (PosDelimiter <> 0) then + begin + //Comment or Name String + if (Line[1] = '#') then + begin + //Found Name Value + if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then + PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) + + end + //Song Entry + else + begin + SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); + if (SongID <> -1) then + begin + Len := Length(PlayLists[Index].Items); + SetLength(PlayLists[Index].Items, Len + 1); + + PlayLists[Index].Items[Len].SongID := SongID; + + PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); + PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); + end + else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); + end; + end; + end; + end; + + //If no special name is given, use Filename + if PlayLists[Index].Name = '' then + begin + PlayLists[Index].Name := ChangeFileExt(FileName, ''); + end; + + //Finish (Close File) + CloseFile(F); +end; + +//---------- +//SavePlayList - Saves the specified Playlist +//---------- +Procedure TPlayListManager.SavePlayList(Index: Cardinal); +var + F: TextFile; + I: Integer; +begin + if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then + begin + + //open File for Rewriting + AssignFile(F, PlaylistPath + Playlists[Index].Filename); + try + try + Rewrite(F); + + //Write Version (not nessecary but helpful) + WriteLn(F, '######################################'); + WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); + WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); + WriteLn(F, '######################################'); + + //Write Name Information + WriteLn(F, '#Name: ' + Playlists[Index].Name); + + //Write Song Information + WriteLn(F, '#Songs:'); + + For I := 0 to high(Playlists[Index].Items) do + begin + WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); + end; + except + log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); + end; + finally + CloseFile(F); + end; + end; +end; + +//---------- +//SetPlayList - Display a Playlist in CatSongs +//---------- +Procedure TPlayListManager.SetPlayList(Index: Cardinal); +var + I: Integer; +begin + If (Int(Index) > High(PlayLists)) then + exit; + + //Hide all Songs + For I := 0 to high(CatSongs.Song) do + CatSongs.Song[I].Visible := False; + + //Show Songs in PL + For I := 0 to high(PlayLists[Index].Items) do + begin + CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; + end; + + //Set CatSongsMode + Playlist Mode + CatSongs.CatNumShow := -3; + Mode := smPlayListRandom; + + //Set CurPlaylist + CurPlaylist := Index; + + //Show Cat in Topleft: + ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); + + //Fix SongSelection + ScreenSong.Interaction := 0; + ScreenSong.SelectNext; + ScreenSong.FixSelected; + + //Play correct Music + ScreenSong.ChangeMusic; +end; + +//---------- +//AddPlaylist - Adds a Playlist and Returns the Index +//---------- +Function TPlayListManager.AddPlaylist(Name: String): Cardinal; +var + I: Integer; +begin + Result := Length(Playlists); + SetLength(Playlists, Result + 1); + + // Sort the Playlists - Insertion Sort + while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do + begin + Dec(Result); + Playlists[Result+1] := Playlists[Result]; + end; + Playlists[Result].Name := Name; + + I := 1; + if (not FileExists(PlaylistPath + Name + '.upl')) then + Playlists[Result].Filename := Name + '.upl' + else + begin + repeat + Inc(I); + until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); + Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; + end; + + //Save new Playlist + SavePlayList(Result); +end; + +//---------- +//DelPlaylist - Deletes a Playlist +//---------- +Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); +var + I: Integer; + Filename: String; +begin + If Int(Index) > High(Playlists) then + Exit; + + Filename := PlaylistPath + Playlists[Index].Filename; + + //If not FileExists or File is not Writeable then exit + If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then + Exit; + + + //Delete Playlist from FileSystem + if Not DeleteFile(Filename) then + Exit; + + //Delete Playlist from Array + //move all PLs to the Hole + For I := Index to High(Playlists)-1 do + PlayLists[I] := PlayLists[I+1]; + + //Delete last Playlist + SetLength (Playlists, High(Playlists)); + + //If Playlist is Displayed atm + //-> Display Songs + if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then + begin + ScreenSong.UnLoadDetailedCover; + ScreenSong.HideCatTL; + CatSongs.SetFilter('', 0); + ScreenSong.Interaction := 0; + ScreenSong.FixSelected; + ScreenSong.ChangeMusic; + end; +end; + +//---------- +//AddItem - Adds an Item to a specific Playlist +//---------- +Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); +var + P: Cardinal; + Len: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (Int(SongID) <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then + begin + Len := Length(Playlists[P].Items); + SetLength(Playlists[P].Items, Len + 1); + + Playlists[P].Items[Len].SongID := SongID; + Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; + Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; + + //Save Changes + SavePlayList(P); + + //Correct Display when Editing current Playlist + if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); + end; +end; + +//---------- +//DelItem - Deletes an Item from a specific Playlist +//---------- +Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); +var + I: Integer; + P: Cardinal; +begin + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + if (Int(iItem) <= high(Playlists[P].Items)) then + begin + //Move all entrys behind deleted one to Front + For I := iItem to High(Playlists[P].Items) - 1 do + Playlists[P].Items[I] := Playlists[P].Items[I + 1]; + + //Delete Last Entry + SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); + + //Save Changes + SavePlayList(P); + end; + + //Delete Playlist if Last Song is deleted + if (Length(PlayLists[P].Items) = 0) then + begin + DelPlaylist(P); + end + //Correct Display when Editing current Playlist + else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then + SetPlaylist(P); +end; + +//---------- +//GetNames - Writes Playlist Names in a Array +//---------- +Procedure TPlayListManager.GetNames(var PLNames: array of String); +var + I: Integer; + Len: Integer; +begin + Len := High(Playlists); + + if (Length(PLNames) <> Len + 1) then + exit; + + For I := 0 to Len do + PLNames[I] := Playlists[I].Name; +end; + +//---------- +//GetIndexbySongID - Returns Index in the specified Playlist of the given Song +//---------- +Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; +var + P: Integer; + I: Integer; +begin + Result := -1; + + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = Int(SongID)) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas new file mode 100644 index 00000000..77693d0f --- /dev/null +++ b/src/base/UPluginInterface.pas @@ -0,0 +1,156 @@ +unit uPluginInterface; +{********************* + uPluginInterface + Unit fills a TPluginInterface Structur with Method Pointers + Unit Contains all Functions called directly by Plugins +*********************} + +interface + +{$I switches.inc} + +uses uPluginDefs; + +//--------------- +// Methods for Plugin +//--------------- + {******** Hook specific Methods ********} + {Function Creates a new Hookable Event and Returns the Handle + or 0 on Failure. (Name already exists)} + Function CreateHookableEvent (EventName: PChar): THandle; stdcall; + + {Function Destroys an Event and Unhooks all Hooks to this Event. + 0 on success, not 0 on Failure} + Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; + + {Function start calling the Hook Chain + 0 if Chain is called until the End, -1 if Event Handle is not valid + otherwise Return Value of the Hook that breaks the Chain} + Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Hooks an Event by Name. + Returns Hook Handle on Success, otherwise 0} + Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; + + {Function Removes the Hook from the Chain + Returns 0 on Success} + Function UnHookEvent (hHook: THandle): Integer; stdcall; + + {Function Returns Non Zero if a Event with the given Name Exists, + otherwise 0} + Function EventExists (EventName: PChar): Integer; stdcall; + + {******** Service specific Methods ********} + {Function Creates a new Service and Returns the Services Handle + or 0 on Failure. (Name already exists)} + Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; + + {Function Destroys a Service. + 0 on success, not 0 on Failure} + Function DestroyService (hService: THandle): integer; stdcall; + + {Function Calls a Services Proc + Returns Services Return Value or SERVICE_NOT_FOUND on Failure} + Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; + + {Function Returns Non Zero if a Service with the given Name Exists, + otherwise 0} + Function ServiceExists (ServiceName: PChar): Integer; stdcall; + +implementation +uses UCore; + +{******** Hook specific Methods ********} +//--------------- +// Function Creates a new Hookable Event and Returns the Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateHookableEvent (EventName: PChar): THandle; stdcall; +begin + Result := Core.Hooks.AddEvent(EventName); +end; + +//--------------- +// Function Destroys an Event and Unhooks all Hooks to this Event. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; +begin + Result := Core.Hooks.DelEvent(hEvent); +end; + +//--------------- +// Function start calling the Hook Chain +// 0 if Chain is called until the End, -1 if Event Handle is not valid +// otherwise Return Value of the Hook that breaks the Chain +//--------------- +Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); +end; + +//--------------- +// Function Hooks an Event by Name. +// Returns Hook Handle on Success, otherwise 0 +//--------------- +Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; +begin + Result := Core.Hooks.AddSubscriber(EventName, HookProc); +end; + +//--------------- +// Function Removes the Hook from the Chain +// Returns 0 on Success +//--------------- +Function UnHookEvent (hHook: THandle): Integer; stdcall; +begin + Result := Core.Hooks.DelSubscriber(hHook); +end; + +//--------------- +// Function Returns Non Zero if a Event with the given Name Exists, +// otherwise 0 +//--------------- +Function EventExists (EventName: PChar): Integer; stdcall; +begin + Result := Core.Hooks.EventExists(EventName); +end; + + {******** Service specific Methods ********} +//--------------- +// Function Creates a new Service and Returns the Services Handle +// or 0 on Failure. (Name already exists) +//--------------- +Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; +begin + Result := Core.Services.AddService(ServiceName, ServiceProc); +end; + +//--------------- +// Function Destroys a Service. +// 0 on success, not 0 on Failure +//--------------- +Function DestroyService (hService: THandle): integer; stdcall; +begin + Result := Core.Services.DelService(hService); +end; + +//--------------- +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//--------------- +Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; +begin + Result := Core.Services.CallService(ServiceName, wParam, lParam); +end; + +//--------------- +// Function Returns Non Zero if a Service with the given Name Exists, +// otherwise 0 +//--------------- +Function ServiceExists (ServiceName: PChar): Integer; stdcall; +begin + Result := Core.Services.ServiceExists(ServiceName); +end; + +end. diff --git a/src/base/URecord.pas b/src/base/URecord.pas new file mode 100644 index 00000000..8a537dc9 --- /dev/null +++ b/src/base/URecord.pas @@ -0,0 +1,766 @@ +unit URecord; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, + Math, + SysUtils, + sdl, + 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 + VoiceStream: TAudioVoiceStream; // stream for voice passthrough + AnalysisBufferLock: PSDL_Mutex; + + function GetToneString: string; // converts a tone to its string represenatation; + + procedure BoostBuffer(Buffer: PChar; Size: Cardinal); + procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer); + + // we call it to analyze sound by checking Autocorrelation + procedure AnalyzeByAutocorrelation; + // use this to check one frequency by Autocorrelation + function AnalyzeAutocorrelationFreq(Freq: real): real; + public + AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples + AnalysisBufferSize: integer; // number of samples of BufferArray to analyze + + LogBuffer: TMemoryStream; // full buffer + + AudioFormat: TAudioFormatInfo; + + // pitch detection + // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead + 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; + + // use to analyze sound from buffers to get new pitch + procedure AnalyzeBuffer; + procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} + + function MaxSampleVolume: Single; + property ToneString: string READ GetToneString; + end; + +const + DEFAULT_SOURCE_NAME = '[Default]'; + +type + TAudioInputSource = record + Name: string; + end; + + // soundcard input-devices information + TAudioInputDevice = class + public + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Name: string; // soundcard name + Source: array of TAudioInputSource; // soundcard input-sources + SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) + MicSource: integer; // source-index of mic (-1: none detected) + + 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); + + // TODO: add Open/Close functions so Start/Stop becomes faster + //function Open(): boolean; virtual; abstract; + //function Close(): boolean; virtual; abstract; + function Start(): boolean; virtual; abstract; + function Stop(): boolean; virtual; abstract; + + function GetVolume(): single; virtual; abstract; + procedure SetVolume(Volume: single); virtual; abstract; + end; + + TAudioInputProcessor = class + public + Sound: array of TCaptureBuffer; // sound-buffers for every player + DeviceList: array of TAudioInputDevice; + + constructor Create; + destructor Destroy; override; + + procedure UpdateInputDeviceConfig; + + // handle microphone input + procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal; + InputDevice: TAudioInputDevice); + end; + + TAudioInputBase = class( TInterfacedObject, IAudioInput ) + private + Started: boolean; + protected + function UnifyDeviceName(const name: string; deviceIndex: integer): string; + public + function GetName: String; virtual; abstract; + function InitializeRecord: boolean; virtual; abstract; + function FinalizeRecord: boolean; virtual; + + procedure CaptureStart; + procedure CaptureStop; + end; + + + TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; + PSmallIntArray = ^TSmallIntArray; + + function AudioInputProcessor(): TAudioInputProcessor; + +implementation + +uses + ULog, + UMain; + +var + singleton_AudioInputProcessor : TAudioInputProcessor = nil; + + +{ Global } + +function AudioInputProcessor(): TAudioInputProcessor; +begin + if singleton_AudioInputProcessor = nil then + singleton_AudioInputProcessor := TAudioInputProcessor.create(); + + result := singleton_AudioInputProcessor; +end; + + +{ TAudioInputDevice } + +destructor TAudioInputDevice.Destroy; +begin + Stop(); + Source := nil; + CaptureChannel := nil; + FreeAndNil(AudioFormat); + inherited Destroy; +end; + +procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); +var + DeviceCfg: PInputDeviceConfig; + OldSound: TCaptureBuffer; +begin + // check bounds + if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then + Exit; + + // reset previously assigned (old) capture-buffer + OldSound := CaptureChannel[ChannelIndex]; + if (OldSound <> nil) then + begin + // close voice stream + FreeAndNil(OldSound.VoiceStream); + // free old audio-format info + FreeAndNil(OldSound.AudioFormat); + end; + + // set audio-format of new capture-buffer + if (Sound <> nil) then + begin + // copy the input-device audio-format ... + Sound.AudioFormat := AudioFormat.Copy; + // and adjust it because capture buffers are always mono + Sound.AudioFormat.Channels := 1; + DeviceCfg := @Ini.InputDeviceConfig[CfgIndex]; + + if (Ini.VoicePassthrough = 1) then + begin + // TODO: map odd players to the left and even players to the right speaker + Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat); + end; + end; + + // replace old with new buffer (Note: Sound might be nil) + CaptureChannel[ChannelIndex] := Sound; +end; + +{ TSound } + +constructor TCaptureBuffer.Create; +begin + inherited; + LogBuffer := TMemoryStream.Create; + AnalysisBufferLock := SDL_CreateMutex(); + AnalysisBufferSize := Length(AnalysisBuffer); +end; + +destructor TCaptureBuffer.Destroy; +begin + FreeAndNil(LogBuffer); + FreeAndNil(VoiceStream); + FreeAndNil(AudioFormat); + SDL_DestroyMutex(AnalysisBufferLock); + inherited; +end; + +procedure TCaptureBuffer.LockAnalysisBuffer(); +begin + SDL_mutexP(AnalysisBufferLock); +end; + +procedure TCaptureBuffer.UnlockAnalysisBuffer(); +begin + SDL_mutexV(AnalysisBufferLock); +end; + +procedure TCaptureBuffer.Clear; +begin + if assigned(LogBuffer) then + LogBuffer.Clear; + LockAnalysisBuffer(); + FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0); + UnlockAnalysisBuffer(); +end; + +procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer); +var + BufferOffset: integer; + SampleCount: integer; + i: integer; +begin + // apply software boost + //BoostBuffer(Buffer, Size); + + // voice passthrough (send data to playback-device) + if (assigned(VoiceStream)) then + VoiceStream.WriteData(Buffer, BufferSize); + + // we assume that samples are in S16Int format + // TODO: support float too + if (AudioFormat.Format <> asfS16) then + Exit; + + // process BufferArray + BufferOffset := 0; + + SampleCount := BufferSize div SizeOf(SmallInt); + + // check if we have more new samples than we can store + if (SampleCount > Length(AnalysisBuffer)) then + begin + // discard the oldest of the new samples + BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt); + SampleCount := Length(AnalysisBuffer); + end; + + + LockAnalysisBuffer(); + try + + // move old samples to the beginning of the array (if necessary) + for i := 0 to High(AnalysisBuffer)-SampleCount do + AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount]; + + // copy new samples to analysis buffer + Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount], + SampleCount * SizeOf(SmallInt)); + + finally + UnlockAnalysisBuffer(); + end; + + + // save capture-data to BufferLong if enabled + if (Ini.SavePlayback = 1) then + begin + // this is just for debugging (approx 15MB per player for a 3min song!!!) + // For an in-game replay-mode we need to compress data so we do not + // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode? + // Or we could use a faster but not that efficient lossless compression. + LogBuffer.WriteBuffer(Buffer, BufferSize); + end; +end; + +procedure TCaptureBuffer.AnalyzeBuffer; +var + Volume: single; + MaxVolume: single; + SampleIndex: integer; + Threshold: single; +begin + ToneValid := false; + ToneAbs := -1; + Tone := -1; + + LockAnalysisBuffer(); + try + + // find maximum volume of first 1024 samples + MaxVolume := 0; + for SampleIndex := 0 to 1023 do + begin + Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint); + if Volume > MaxVolume then + MaxVolume := Volume; + end; + + Threshold := IThresholdVals[Ini.ThresholdIndex]; + + // check if signal has an acceptable volume (ignore background-noise) + if MaxVolume >= Threshold then + begin + // analyse the current voice pitch + AnalyzeByAutocorrelation; + ToneValid := true; + end; + + finally + UnlockAnalysisBuffer(); + 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; + MaxTone := 0; // this is not needed, but it satifies the compiler + + // 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(AnalysisBuffer[SampleIndex] - AnalysisBuffer[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; + LockAnalysisBuffer(); + try + lMaxVol := 0; + for lSampleIndex := 0 to High(AnalysisBuffer) do + begin + if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then + lMaxVol := Abs(AnalysisBuffer[lSampleIndex]); + end; + finally + UnlockAnalysisBuffer(); + 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; + +procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal); +var + i: integer; + Value: Longint; + SampleCount: integer; + SampleBuffer: PSmallIntArray; // buffer handled as array of samples + Boost: byte; +begin + // TODO: set boost per device + { + case Ini.MicBoost of + 0: Boost := 1; + 1: Boost := 2; + 2: Boost := 4; + 3: Boost := 8; + else Boost := 1; + end; + } + Boost := 1; + + // at the moment we will boost SInt16 data only + if (AudioFormat.Format = asfS16) then + begin + // interpret buffer as buffer of bytes + SampleBuffer := PSmallIntArray(Buffer); + SampleCount := Size div AudioFormat.FrameSize; + + // boost buffer + for i := 0 to SampleCount-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; + end; +end; + + +{ TAudioInputProcessor } + +constructor TAudioInputProcessor.Create; +var + i: integer; +begin + inherited; + SetLength(Sound, 6 {max players});//Ini.Players+1); + for i := 0 to High(Sound) do + Sound[i] := TCaptureBuffer.Create; +end; + +destructor TAudioInputProcessor.Destroy; +var + i: integer; +begin + for i := 0 to High(Sound) do + Sound[i].Free; + SetLength(Sound, 0); + inherited; +end; + +// updates InputDeviceConfig with current input-device information +// See: TIni.LoadInputDeviceCfg() +procedure TAudioInputProcessor.UpdateInputDeviceConfig; +var + deviceIndex: integer; + newDevice: boolean; + deviceIniIndex: integer; + deviceCfg: PInputDeviceConfig; + device: TAudioInputDevice; + channelCount: integer; + channelIndex: integer; + i: integer; +begin + // Input devices - append detected soundcards + for deviceIndex := 0 to High(DeviceList) do + begin + newDevice := true; + //Search for Card in List + for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do + begin + deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex]; + device := DeviceList[deviceIndex]; + + if (deviceCfg.Name = Trim(device.Name)) then + begin + newDevice := false; + + // store highest channel index as an offset for the new channels + channelIndex := High(deviceCfg.ChannelToPlayerMap); + // add missing channels or remove non-existing ones + SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels); + // initialize added channels to 0 + for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do + begin + deviceCfg.ChannelToPlayerMap[i] := 0; + end; + + // associate ini-index with device + device.CfgIndex := deviceIniIndex; + break; + end; + end; + + //If not in List -> Add + if newDevice then + begin + // resize list + SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1); + deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)]; + device := DeviceList[deviceIndex]; + + // associate ini-index with device + device.CfgIndex := High(Ini.InputDeviceConfig); + + deviceCfg.Name := Trim(device.Name); + deviceCfg.Input := 0; + + channelCount := device.AudioFormat.Channels; + SetLength(deviceCfg.ChannelToPlayerMap, channelCount); + + for channelIndex := 0 to channelCount-1 do + begin + // set default at first start of USDX (1st device, 1st channel -> player1) + if ((channelIndex = 0) and (device.CfgIndex = 0)) then + deviceCfg.ChannelToPlayerMap[0] := 1 + else + deviceCfg.ChannelToPlayerMap[channelIndex] := 0; + end; + end; + end; +end; + +{* + * Handles 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: PChar; Size: Cardinal; InputDevice: TAudioInputDevice); +var + MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) + SingleChannelBuffer: PChar; // temporary buffer for new samples per channel + SingleChannelBufferSize: integer; + ChannelIndex: integer; + CaptureChannel: TCaptureBuffer; + AudioFormat: TAudioFormatInfo; + SampleSize: integer; + SampleCount: integer; + SamplesPerChannel: integer; + i: integer; +begin + AudioFormat := InputDevice.AudioFormat; + SampleSize := AudioSampleSize[AudioFormat.Format]; + SampleCount := Size div SampleSize; + SamplesPerChannel := Size div AudioFormat.FrameSize; + + SingleChannelBufferSize := SamplesPerChannel * SampleSize; + GetMem(SingleChannelBuffer, SingleChannelBufferSize); + + // process channels + for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do + begin + CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; + // check if a capture buffer was assigned, otherwise there is nothing to do + if (CaptureChannel <> nil) then + begin + // set offset according to channel index + MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; + // seperate channel-data from interleaved multi-channel (e.g. stereo) data + for i := 0 to SamplesPerChannel-1 do + begin + Move(MultiChannelBuffer[i*AudioFormat.FrameSize], + SingleChannelBuffer[i*SampleSize], + SampleSize); + end; + CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize); + end; + end; + + FreeMem(SingleChannelBuffer); +end; + + +{ TAudioInputBase } + +function TAudioInputBase.FinalizeRecord: boolean; +var + i: integer; +begin + for i := 0 to High(AudioInputProcessor.DeviceList) do + AudioInputProcessor.DeviceList[i].Free(); + AudioInputProcessor.DeviceList := nil; + Result := true; +end; + +{* + * 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.DeviceList) do + begin + Device := AudioInputProcessor.DeviceList[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; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; +begin + for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do + begin + Device := AudioInputProcessor.DeviceList[DeviceIndex]; + if not assigned(Device) then + continue; + + Device.Stop(); + + // disconnect capture buffers + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + Device.LinkCaptureBuffer(ChannelIndex, nil); + 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.DeviceList[i].Name = 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; + +end. + + + diff --git a/src/base/URingBuffer.pas b/src/base/URingBuffer.pas new file mode 100644 index 00000000..ce51e209 --- /dev/null +++ b/src/base/URingBuffer.pas @@ -0,0 +1,128 @@ +unit URingBuffer; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils; + +type + TRingBuffer = class + private + RingBuffer: PChar; + BufferCount: integer; + BufferSize: integer; + WritePos: integer; + ReadPos: integer; + public + constructor Create(Size: integer); + destructor Destroy; override; + function Read(Buffer: PChar; Count: integer): integer; + function Write(Buffer: PChar; Count: integer): integer; + procedure Flush(); + end; + +implementation + +uses + Math; + +constructor TRingBuffer.Create(Size: integer); +begin + BufferSize := Size; + + GetMem(RingBuffer, Size); + if (RingBuffer = nil) then + raise Exception.Create('No memory'); +end; + +destructor TRingBuffer.Destroy; +begin + FreeMem(RingBuffer); +end; + +function TRingBuffer.Read(Buffer: PChar; Count: integer): integer; +var + PartCount: integer; +begin + // adjust output count + if (Count > BufferCount) then + begin + //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); + Count := BufferCount; + end; + + // check if there is something to do + if (Count <= 0) then + begin + Result := Count; + Exit; + end; + + // copy data to output buffer + + // first step: copy from the area between the read-position and the end of the buffer + PartCount := Min(Count, BufferSize - ReadPos); + Move(RingBuffer[ReadPos], Buffer[0], PartCount); + + // second step: if we need more data, copy from the beginning of the buffer + if (PartCount < Count) then + Move(RingBuffer[0], Buffer[0], Count-PartCount); + + // mark the copied part of the buffer as free + BufferCount := BufferCount - Count; + ReadPos := (ReadPos + Count) mod BufferSize; + + Result := Count; +end; + +function TRingBuffer.Write(Buffer: PChar; Count: integer): integer; +var + PartCount: integer; +begin + // check for a reasonable request + if (Count <= 0) then + begin + Result := Count; + Exit; + end; + + // skip input data if the input buffer is bigger than the ring-buffer + if (Count > BufferSize) then + begin + //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize)); + Buffer := @Buffer[Count - BufferSize]; + Count := BufferSize; + end; + + // first step: copy to the area between the write-position and the end of the buffer + PartCount := Min(Count, BufferSize - WritePos); + Move(Buffer[0], RingBuffer[WritePos], PartCount); + + // second step: copy data to front of buffer + if (PartCount < Count) then + Move(Buffer[PartCount], RingBuffer[0], Count-PartCount); + + // update info + BufferCount := Min(BufferCount + Count, BufferSize); + WritePos := (WritePos + Count) mod BufferSize; + // if the buffer is full, we have to reposition the read-position + if (BufferCount = BufferSize) then + ReadPos := WritePos; + + Result := Count; +end; + +procedure TRingBuffer.Flush(); +begin + ReadPos := 0; + WritePos := 0; + BufferCount := 0; +end; + +end. \ No newline at end of file diff --git a/src/base/UServices.pas b/src/base/UServices.pas new file mode 100644 index 00000000..6325444c --- /dev/null +++ b/src/base/UServices.pas @@ -0,0 +1,358 @@ +unit UServices; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses uPluginDefs, + SysUtils; +{********************* + TServiceManager + Class for saving, managing and calling of Services. + Saves all Services and their Procs +*********************} + +type + TServiceName = String[60]; + PServiceInfo = ^TServiceInfo; + TServiceInfo = record + Self: THandle; //Handle of this Service + Hash: Integer; //4 Bit Hash of the Services Name + Name: TServiceName; //Name of this Service + + Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] + + Next: PServiceInfo; //Pointer to the Next Service in teh list + + //Here is s/t tricky + //To avoid writing of Wrapping Functions to offer a Service from a Class + //We save a Normal Proc or a Method of a Class + Case isClass: boolean of + False: (Proc: TUS_Service); //Proc that will be called on Event + True: (ProcOfClass: TUS_Service_of_Object); + end; + + TServiceManager = class + private + //Managing Service List + FirstService: PServiceInfo; + LastService: PServiceInfo; + + //Some Speed improvement by caching the last 4 called Services + //Most of the time a Service is called multiple times + ServiceCache: Array[0..3] of PServiceInfo; + NextCacheItem: Byte; + + //Next Service added gets this Handle: + NextHandle: THandle; + public + Constructor Create; + + Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; + Function DelService(const hService: THandle): integer; + + Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; + + Function NametoHash(const ServiceName: TServiceName): Integer; + Function ServiceExists(const ServiceName: PChar): Integer; + end; + +var + ServiceManager: TServiceManager; + +implementation +uses + ULog, + UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + inherited; + + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Succesful created!'); + {$ENDIF} +end; + +//------------ +// Function Creates a new Service and Returns the Services Handle, +// 0 on Failure. (Name already exists) +//------------ +Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; +var + Cur: PServiceInfo; +begin + Result := 0; + + If (@Proc <> nil) or (@ProcOfClass <> nil) then + begin + If (ServiceExists(ServiceName) = 0) then + begin //There is a Proc and the Service does not already exist + //Ok Add it! + + //Get Memory + GetMem(Cur, SizeOf(TServiceInfo)); + + //Fill it with Data + Cur.Next := nil; + + If (@Proc = nil) then + begin //Use the ProcofClass Method + Cur.isClass := True; + Cur.ProcOfClass := ProcofClass; + end + else //Use the normal Proc + begin + Cur.isClass := False; + Cur.Proc := Proc; + end; + + Cur.Self := NextHandle; + //Zero Name + Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + Cur.Name := String(ServiceName); + Cur.Hash := NametoHash(Cur.Name); + + //Add Owner to Service + Cur.Owner := Core.CurExecuted; + + //Add Service to the List + If (FirstService = nil) then + FirstService := Cur; + + If (LastService <> nil) then + LastService.Next := Cur; + + LastService := Cur; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else debugWriteln('ServiceManager: Try to readd Service: ' + ServiceName); + {$ENDIF} + end; +end; + +//------------ +// Function Destroys a Service, 0 on success, not 0 on Failure +//------------ +Function TServiceManager.DelService(const hService: THandle): integer; +var + Last, Cur: PServiceInfo; + I: Integer; +begin + Result := -1; + + Last := nil; + Cur := FirstService; + + //Search for Service to Delete + While (Cur <> nil) do + begin + If (Cur.Self = hService) then + begin //Found Service => Delete it + + //Delete from List + If (Last = nil) then //Found first Service + FirstService := Cur.Next + Else //Service behind the first + Last.Next := Cur.Next; + + //IF this is the LastService, correct LastService + If (Cur = LastService) then + LastService := Last; + + //Search for Service in Cache and delete it if found + For I := 0 to High(ServiceCache) do + If (ServiceCache[I] = Cur) then + begin + ServiceCache[I] := nil; + end; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Removed Service succesful: ' + Cur.Name); + {$ENDIF} + + //Free Memory + Freemem(Cur, SizeOf(TServiceInfo)); + + //Break the Loop + Break; + end; + + //Go to Next Service + Last := Cur; + Cur := Cur.Next; + end; +end; + +//------------ +// Function Calls a Services Proc +// Returns Services Return Value or SERVICE_NOT_FOUND on Failure +//------------ +Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; +var + SExists: Integer; + Service: PServiceInfo; + CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute +begin + Result := SERVICE_NOT_FOUND; + SExists := ServiceExists(ServiceName); + If (SExists <> 0) then + begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + Service := Pointer(SExists); + + If (Service.isClass) then + //Use Proc of Class + Result := Service.ProcOfClass(wParam, lParam) + Else + //Use normal Proc + Result := Service.Proc(wParam, lParam); + + //Restore CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +// FIXME: check if the non-asm version is fast enough and use it by default if so +{$IF Defined(CPUX86_64)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; RAX: Result; RDX: Current Memory Address } + Mov RCX, 14 + Mov RDX, ServiceName {Save Address of String that should be "Hashed"} + Mov RAX, [RDX] + @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash} + LOOP @FoldLoop {Fold again if there are Chars Left} +end; +{$ELSEIF Defined(CPU386) or Defined(CPUI386)} +{$IFDEF FPC} + {$ASMMODE Intel} +{$ENDIF} +asm + { CL: Counter; EAX: Result; EDX: Current Memory Address } + Mov ECX, 14 {Init Counter, Fold 14 Times to get 4 Bytes out of 60} + Mov EDX, ServiceName {Save Address of String that should be "Hashed"} + Mov EAX, [EDX] + @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } + ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} + LOOP @FoldLoop {Fold again if there are Chars Left} +end; +{$ELSE} +var + i: integer; + ptr: ^integer; +begin + ptr := @ServiceName; + Result := 0; + for i := 1 to 14 do + begin + Result := Result + ptr^; + Inc(ptr); + end; +end; +{$IFEND} + + +//------------ +// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 +//------------ +Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; +var + Name: TServiceName; + Hash: Integer; + Cur: PServiceInfo; + I: Byte; +begin + Result := 0; + // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) + //Zero Name: + Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; + //Add Service Name + Name := String(ServiceName); + Hash := NametoHash(Name); + + //First of all Look for the Service in Cache + For I := 0 to High(ServiceCache) do + begin + If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then + begin + If (ServiceCache[I].Name = Name) then + begin //Found Service in Cache + Result := Integer(ServiceCache[I]); + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); + {$ENDIF} + + Break; + end; + end; + end; + + If (Result = 0) then + begin + Cur := FirstService; + While (Cur <> nil) do + begin + If (Cur.Hash = Hash) then + begin + If (Cur.Name = Name) then + begin //Found the Service + Result := Integer(Cur); + + {$IFDEF DEBUG} + debugWriteln('ServiceManager: Found Service in List: ''' + ServiceName + ''''); + {$ENDIF} + + //Add to Cache + ServiceCache[NextCacheItem] := Cur; + NextCacheItem := (NextCacheItem + 1) AND 3; + Break; + end; + end; + + Cur := Cur.Next; + end; + end; +end; + +end. diff --git a/src/base/USingNotes.pas b/src/base/USingNotes.pas new file mode 100644 index 00000000..3b268d10 --- /dev/null +++ b/src/base/USingNotes.pas @@ -0,0 +1,13 @@ +unit USingNotes; + +interface + +{$I switches.inc} + +{ Dummy Unit atm + For further expantation + Placeholder for Class that will handle the Notes Drawing} + +implementation + +end. diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas new file mode 100644 index 00000000..77d40b84 --- /dev/null +++ b/src/base/USingScores.pas @@ -0,0 +1,973 @@ +unit USingScores; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UThemes, + gl, + UTexture; + +////////////////////////////////////////////////////////////// +// ATTENTION: // +// Enabled Flag does not Work atm. This should cause Popups // +// Not to Move and Scores to stay until Renenabling. // +// To use e.g. in Pause Mode // +// Also InVisible Flag causes Attributes not to change. // +// This should be fixed after next Draw when Visible = True,// +// but not testet yet // +////////////////////////////////////////////////////////////// + +//Some constants containing options that could change by time +const + MaxPlayers = 6; //Maximum of Players that could be added + MaxPositions = 6; //Maximum of Score Positions that could be added + +type + //----------- + // TScorePlayer - Record Containing Information about a Players Score + //----------- + TScorePlayer = record + Position: Byte; //Index of the Position where the Player should be Drawn + Enabled: Boolean; //Is the Score Display Enabled + Visible: Boolean; //Is the Score Display Visible + Score: Word; //Current Score of the Player + ScoreDisplayed: Word; //Score cur. Displayed(for counting up) + ScoreBG: TTexture;//Texture of the Players Scores BG + Color: TRGB; //Teh Players Color + RBPos: Real; //Cur. Percentille of the Rating Bar + RBTarget: Real; //Target Position of Rating Bar + RBVisible:Boolean; //Is Rating bar Drawn + end; + aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; + + //----------- + // TScorePosition - Record Containing Information about a Score Position, that can be used + //----------- + PScorePosition = ^TScorePosition; + TScorePosition = record + //The Position is Used for Which Playercount + PlayerCount: Byte; + // 1 - One Player per Screen + // 2 - 2 Players per Screen + // 4 - 3 Players per Screen + // 6 would be 2 and 3 Players per Screen + + BGX: Real; //X Position of the Score BG + BGY: Real; //Y Position of the Score BG + BGW: Real; //Width of the Score BG + BGH: Real; //Height of the Score BG + + RBX: Real; //X Position of the Rating Bar + RBY: Real; //Y Position of the Rating Bar + RBW: Real; //Width of the Rating Bar + RBH: Real; //Height of the Rating Bar + + TextX: Real; //X Position of the Score Text + TextY: Real; //Y Position of the Score Text + TextFont: Byte; //Font of the Score Text + TextSize: Byte; //Size of the Score Text + + PUW: Real; //Width of the LineBonus Popup + PUH: Real; //Height of the LineBonus Popup + PUFont: Byte; //Font for the PopUps + PUFontSize: Byte; //FontSize for the PopUps + PUStartX: Real; //X Start Position of the LineBonus Popup + PUStartY: Real; //Y Start Position of the LineBonus Popup + PUTargetX: Real; //X Target Position of the LineBonus Popup + PUTargetY: Real; //Y Target Position of the LineBonus Popup + end; + aScorePosition = array[0..MaxPositions-1] of TScorePosition; + + //----------- + // TScorePopUp - Record Containing Information about a LineBonus Popup + // List, Next Item is Saved in Next attribute + //----------- + PScorePopUp = ^TScorePopUp; + TScorePopUp = record + Player: Byte; //Index of the PopUps Player + TimeStamp: Cardinal; //Timestamp of Popups Spawn + Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) + ScoreGiven:Word; //Score that has already been given to the Player + ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score + Next: PScorePopUp; //Next Item in List + end; + aScorePopUp = array of TScorePopUp; + + //----------- + // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups + //----------- + TSingScores = class + private + Positions: aScorePosition; + aPlayers: aScorePlayer; + oPositionCount: Byte; + oPlayerCount: Byte; + + //Saves the First and Last Popup of the List + FirstPopUp: PScorePopUp; + LastPopUp: PScorePopUp; + + //Procedure Draws a Popup by Pointer + Procedure DrawPopUp(const PopUp: PScorePopUp); + + //Procedure Draws a Score by Playerindex + Procedure DrawScore(const Index: Integer); + + //Procedure Draws the RatingBar by Playerindex + Procedure DrawRatingBar(const Index: Integer); + + //Procedure Removes a PopUp w/o destroying the List + Procedure KillPopUp(const last, cur: PScorePopUp); + public + Settings: record //Record containing some Displaying Options + Phase1Time: Real; //time for Phase 1 to complete (in msecs) + //The Plop Up of the PopUp + Phase2Time: Real; //time for Phase 2 to complete (in msecs) + //The Moving (mainly Upwards) of the Popup + Phase3Time: Real; //time for Phase 3 to complete (in msecs) + //The Fade out and Score adding + + PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating + + RatingBar_BG_Tex: TTexture; //Rating Bar Texs + RatingBar_FG_Tex: TTexture; + RatingBar_Bar_Tex: TTexture; + + end; + + Visible: Boolean; //Visibility of all Scores + Enabled: Boolean; //Scores are changed, PopUps are Moved etc. + RBVisible: Boolean; //Visibility of all Rating Bars + + //Propertys for Reading Position and Playercount + Property PositionCount: Byte read oPositionCount; + Property PlayerCount: Byte read oPlayerCount; + Property Players: aScorePlayer read aPlayers; + + //Constructor just sets some standard Settings + Constructor Create; + + //Procedure Adds a Position to Array and Increases Position Count + Procedure AddPosition(const pPosition: PScorePosition); + + //Procedure Adds a Player to Array and Increases Player Count + Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + + //Change a Players Visibility, Enable + Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); + Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + + //Procedure Deletes all Player Information + Procedure ClearPlayers; + + //Procedure Deletes Positions and Playerinformation + Procedure Clear; + + //Procedure Loads some Settings and the Positions from Theme + Procedure LoadfromTheme; + + //Procedure has to be called after Positions and Players have been added, before first call of Draw + //It gives every Player a Score Position + Procedure Init; + + //Spawns a new Line Bonus PopUp for the Player + Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + + //Removes all PopUps from Mem + Procedure KillAllPopUps; + + //Procedure Draws Scores and Linebonus PopUps + Procedure Draw; + end; + + +implementation + +uses SDL, + SysUtils, + ULog, + UGraphic, + TextGL; + +//----------- +//Constructor just sets some standard Settings +//----------- +Constructor TSingScores.Create; +begin + inherited; + + //Clear PopupList Pointers + FirstPopUp := nil; + LastPopUp := nil; + + //Clear Variables + Visible := True; + Enabled := True; + RBVisible := True; + + //Clear Position Index + oPositionCount := 0; + oPlayerCount := 0; + + Settings.Phase1Time := 350; // plop it up . -> [ ] + Settings.Phase2Time := 550; // shift it up ^[ ]^ + Settings.Phase3Time := 200; // increase score [s++] + + Settings.PopUpTex[0].TexNum := 0; + Settings.PopUpTex[1].TexNum := 0; + Settings.PopUpTex[2].TexNum := 0; + Settings.PopUpTex[3].TexNum := 0; + Settings.PopUpTex[4].TexNum := 0; + Settings.PopUpTex[5].TexNum := 0; + Settings.PopUpTex[6].TexNum := 0; + Settings.PopUpTex[7].TexNum := 0; + Settings.PopUpTex[8].TexNum := 0; + + Settings.RatingBar_BG_Tex.TexNum := 0; + Settings.RatingBar_FG_Tex.TexNum := 0; + Settings.RatingBar_Bar_Tex.TexNum := 0; +end; + +//----------- +//Procedure Adds a Position to Array and Increases Position Count +//----------- +Procedure TSingScores.AddPosition(const pPosition: PScorePosition); +begin + if (PositionCount < MaxPositions) then + begin + Positions[PositionCount] := pPosition^; + + Inc(oPositionCount); + end; +end; + +//----------- +//Procedure Adds a Player to Array and Increases Player Count +//----------- +Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); +begin + if (PlayerCount < MaxPlayers) then + begin + aPlayers[PlayerCount].Position := High(byte); + aPlayers[PlayerCount].Enabled := Enabled; + aPlayers[PlayerCount].Visible := Visible; + aPlayers[PlayerCount].Score := Score; + aPlayers[PlayerCount].ScoreDisplayed := Score; + aPlayers[PlayerCount].ScoreBG := ScoreBG; + aPlayers[PlayerCount].Color := Color; + aPlayers[PlayerCount].RBPos := 0.5; + aPlayers[PlayerCount].RBTarget := 0.5; + aPlayers[PlayerCount].RBVisible := True; + + Inc(oPlayerCount); + end; +end; + +//----------- +//Change a Players Visibility +//----------- +Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Visible := pVisible; +end; + +//----------- +//Change Player Enabled +//----------- +Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); +begin + if (Index < MaxPlayers) then + aPlayers[Index].Enabled := pEnabled; +end; + +//----------- +//Procedure Deletes all Player Information +//----------- +Procedure TSingScores.ClearPlayers; +begin + KillAllPopUps; + oPlayerCount := 0; +end; + +//----------- +//Procedure Deletes Positions and Playerinformation +//----------- +Procedure TSingScores.Clear; +begin + KillAllPopUps; + oPlayerCount := 0; + oPositionCount := 0; +end; + +//----------- +//Procedure Loads some Settings and the Positions from Theme +//----------- +Procedure TSingScores.LoadfromTheme; +var I: Integer; + Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); + var nPosition: TScorePosition; + begin + nPosition.PlayerCount := PC; //Only for one Player Playing + + nPosition.BGX := ScoreStatic.X; + nPosition.BGY := ScoreStatic.Y; + nPosition.BGW := ScoreStatic.W; + nPosition.BGH := ScoreStatic.H; + + nPosition.TextX := ScoreText.X; + nPosition.TextY := ScoreText.Y; + nPosition.TextFont := ScoreText.Font; + nPosition.TextSize := ScoreText.Size; + + nPosition.RBX := SingBarStatic.X; + nPosition.RBY := SingBarStatic.Y; + nPosition.RBW := SingBarStatic.W; + nPosition.RBH := SingBarStatic.H; + + nPosition.PUW := nPosition.BGW; + nPosition.PUH := nPosition.BGH; + + nPosition.PUFont := 2; + nPosition.PUFontSize := 6; + + nPosition.PUStartX := nPosition.BGX; + nPosition.PUStartY := nPosition.TextY + 65; + + nPosition.PUTargetX := nPosition.BGX; + nPosition.PUTargetY := nPosition.TextY; + + AddPosition(@nPosition); + end; +begin + Clear; + + //Set Textures + //Popup Tex + For I := 0 to 8 do + Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; + + //Rating Bar Tex + Settings.RatingBar_BG_Tex := Tex_SingBar_Back; + Settings.RatingBar_FG_Tex := Tex_SingBar_Front; + Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; + + //Load Positions from Theme + + // Player1: + AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); + AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); + AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); + + // Player2: + AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); + AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); + + // Player3: + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); +end; + +//----------- +//Spawns a new Line Bonus PopUp for the Player +//----------- +Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); +var Cur: PScorePopUp; +begin + if (PlayerIndex < PlayerCount) then + begin + //Get Memory and Add Data + GetMem(Cur, SizeOf(TScorePopUp)); + + Cur.Player := PlayerIndex; + Cur.TimeStamp := SDL_GetTicks; + Cur.Rating := Rating; + Cur.ScoreGiven:= 0; + If (Players[PlayerIndex].Score < Score) then + begin + Cur.ScoreDiff := Score - Players[PlayerIndex].Score; + aPlayers[PlayerIndex].Score := Score; + end + else + Cur.ScoreDiff := 0; + Cur.Next := nil; + + //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); + + //Add it to the Chain + if (FirstPopUp = nil) then + //the first PopUp in the List + FirstPopUp := Cur + else + //second or earlier popup + LastPopUp.Next := Cur; + + //Set new Popup to Last PopUp in the List + LastPopUp := Cur; + end + else + Log.LogError('TSingScores: Try to add PopUp for not existing player'); +end; + +//----------- +// Removes a PopUp w/o destroying the List +//----------- +Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +var + lTempA , + lTempB : real; +begin + //Give Player the Last Points that missing till now + aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; + + //Change Bars Position + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + if ( lTempA > 0 ) AND + ( lTempB > 0 ) THEN + begin + aPlayers[Cur.Player].RBTarget := lTempA / lTempB; + end; + + If (aPlayers[Cur.Player].RBTarget > 1) then + aPlayers[Cur.Player].RBTarget := 1 + else + If (aPlayers[Cur.Player].RBTarget < 0) then + aPlayers[Cur.Player].RBTarget := 0; + + //If this is the First PopUp => Make Next PopUp the First + If (Cur = FirstPopUp) then + FirstPopUp := Cur.Next + //Else => Remove Curent Popup from Chain + else + Last.Next := Cur.Next; + + //If this is the Last PopUp, Make PopUp before the Last + If (Cur = LastPopUp) then + LastPopUp := Last; + + //Free the Memory + FreeMem(Cur, SizeOf(TScorePopUp)); +end; + +//----------- +//Removes all PopUps from Mem +//----------- +Procedure TSingScores.KillAllPopUps; +var + Cur: PScorePopUp; + Last: PScorePopUp; +begin + Cur := FirstPopUp; + + //Remove all PopUps: + While (Cur <> nil) do + begin + Last := Cur; + Cur := Cur.Next; + FreeMem(Last, SizeOf(TScorePopUp)); + end; + + FirstPopUp := nil; + LastPopUp := nil; +end; + +//----------- +//Init - has to be called after Positions and Players have been added, before first call of Draw +//It gives every Player a Score Position +//----------- +Procedure TSingScores.Init; +var + PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen + I, J: Integer; + MaxPlayersperScreen: Byte; + CurPlayer: Byte; + + Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; + var I: Integer; + begin + Result := 0; + bPlayerCount := 1 shl (bPlayerCount - 1); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + Inc(Result); + end; + end; + + Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; + var I: Integer; + begin + bPlayerCount := 1 shl (bPlayerCount - 1); + Result := High(Byte); + + For I := 0 to PositionCount-1 do + begin + If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + begin + If (bPlayer = 0) then + begin + Result := I; + Break; + end + else + Dec(bPlayer); + end; + end; + end; + +begin + MaxPlayersPerScreen := 0; + + For I := 1 to 6 do + begin + //If there are enough Positions -> Write to MaxPlayers + If (GetPositionCountbyPlayerCount(I) = I) then + MaxPlayersPerScreen := I + else + Break; + end; + + + //Split Players to both Screen or Display on One Screen + if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then + begin + PlC[0] := PlayerCount div 2 + PlayerCount mod 2; + PlC[1] := PlayerCount div 2; + end + else + begin + PlC[0] := PlayerCount; + PlC[1] := 0; + end; + + + //Check if there are enough Positions for all Players + For I := 0 to Screens - 1 do + begin + if (PlC[I] > MaxPlayersperScreen) then + begin + PlC[I] := MaxPlayersperScreen; + Log.LogError('More Players than available Positions, TSingScores'); + end; + end; + + CurPlayer := 0; + //Give every Player a Position + For I := 0 to Screens - 1 do + For J := 0 to PlC[I]-1 do + begin + aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); + //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); + Inc(CurPlayer); + end; +end; + +//----------- +//Procedure Draws Scores and Linebonus PopUps +//----------- +Procedure TSingScores.Draw; +var + I: Integer; + CurTime: Cardinal; + CurPopUp, LastPopUp: PScorePopUp; +begin + CurTime := SDL_GetTicks; + + If Visible then + begin + //Draw Popups + LastPopUp := nil; + CurPopUp := FirstPopUp; + + While (CurPopUp <> nil) do + begin + if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then + begin + KillPopUp(LastPopUp, CurPopUp); + if (LastPopUp = nil) then + CurPopUp := FirstPopUp + else + CurPopUp := LastPopUp.Next; + end + else + begin + DrawPopUp(CurPopUp); + LastPopUp := CurPopUp; + CurPopUp := LastPopUp.Next; + end; + end; + + + IF (RBVisible) then + //Draw Players w/ Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + DrawRatingBar(I); + end + else + //Draw Players w/o Rating Bar + For I := 0 to PlayerCount-1 do + begin + DrawScore(I); + end; + + end; //eo Visible +end; + +//----------- +//Procedure Draws a Popup by Pointer +//----------- +Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); +var + Progress: Real; + CurTime: Cardinal; + X, Y, W, H, Alpha: Real; + FontSize: Byte; + TimeDiff: Cardinal; + PIndex: Byte; + TextLen: Real; + ScoretoAdd: Word; + PosDiff: Real; +begin + if (PopUp <> nil) then + begin + //Only Draw if Player has a Position + PIndex := Players[PopUp.Player].Position; + If PIndex <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then + begin + CurTime := SDL_GetTicks; + If Not (Enabled AND Players[PopUp.Player].Enabled) then + //Increase Timestamp with TIem where there is no Movement ... + begin + //Inc(PopUp.TimeStamp, LastRender); + end; + TimeDiff := CurTime - PopUp.TimeStamp; + + //Get Position of PopUp + PIndex := PIndex AND 127; + + + //Check for Phase ... + If (TimeDiff <= Settings.Phase1Time) then + begin + //Phase 1 - The Ploping up + Progress := TimeDiff / Settings.Phase1Time; + + + W := Positions[PIndex].PUW * Sin(Progress/2*Pi); + H := Positions[PIndex].PUH * Sin(Progress/2*Pi); + + X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; + Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; + + FontSize := Round(Progress * Positions[PIndex].PUFontSize); + Alpha := 1; + end + + Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then + begin + //Phase 2 - The Moving + Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If PosDiff > 0 then + PosDiff := PosDiff + W; + X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If PosDiff < 0 then + PosDiff := PosDiff + Positions[PIndex].BGH; + Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); + + FontSize := Positions[PIndex].PUFontSize; + Alpha := 1 - 0.3 * Progress; + end + + else + begin + //Phase 3 - The Fading out + Score adding + Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; + + If (PopUp.Rating > 0) then + begin + //Add Scores if Player Enabled + If (Enabled AND Players[PopUp.Player].Enabled) then + begin + ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; + Inc(PopUp.ScoreGiven, ScoreToAdd); + aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; + + //Change Bars Position + aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); + If (aPlayers[PopUp.Player].RBTarget > 1) then + aPlayers[PopUp.Player].RBTarget := 1 + else If (aPlayers[PopUp.Player].RBTarget < 0) then + aPlayers[PopUp.Player].RBTarget := 0; + end; + + //Set Positions etc. + Alpha := 0.7 - 0.7 * Progress; + + W := Positions[PIndex].PUW; + H := Positions[PIndex].PUH; + + PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + If (PosDiff > 0) then + PosDiff := W + else + PosDiff := 0; + X := Positions[PIndex].PUTargetX + PosDiff * Progress; + + PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + If (PosDiff < 0) then + PosDiff := -Positions[PIndex].BGH + else + PosDiff := 0; + Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); + + FontSize := Positions[PIndex].PUFontSize; + end + else + begin + //Here the Effect that Should be shown if a PopUp without Score is Drawn + //And or Spawn with the GraphicObjects etc. + //Some Work for Blindy to do :P + + //ATM: Just Let it Slide in the Scores just like the Normal PopUp + Alpha := 0; + end; + end; + + //Draw PopUp + + if (Alpha > 0) AND (Players[PopUp.Player].Visible) then + begin + //Draw BG: + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, Alpha); + glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X, Y); + glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); + glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Set FontStyle and Size + SetFontStyle(Positions[PIndex].PUFont); + SetFontItalic(False); + SetFontSize(FontSize); + + //Draw Text + TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + + //Color and Pos + SetFontPos (X + (W - TextLen) / 2, Y + 12); + glColor4f(1, 1, 1, Alpha); + + //Draw + glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + end; //eo Alpha check + end; //eo Right Screen + end; //eo Player has Position + end + else + Log.LogError('TSingScores: Try to Draw a not existing PopUp'); +end; + +//----------- +//Procedure Draws a Score by Playerindex +//----------- +Procedure TSingScores.DrawScore(const Index: Integer); +var + Position: PScorePosition; + ScoreStr: String; +begin + //Only Draw if Player has a Position + If Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then + begin + Position := @Positions[Players[Index].Position and 127]; + + //Draw ScoreBG + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glColor4f(1,1,1, 1); + glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); + glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); + glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); + glEnd; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + //Draw Score Text + SetFontStyle(Position.TextFont); + SetFontItalic(False); + SetFontSize(Position.TextSize); + SetFontPos(Position.TextX, Position.TextY); + + ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; + While (Length(ScoreStr) < 5) do + ScoreStr := '0' + ScoreStr; + + glPrint(PChar(ScoreStr)); + + end; //eo Right Screen + end; //eo Player has Position +end; + + +Procedure TSingScores.DrawRatingBar(const Index: Integer); +var + Position: PScorePosition; + R,G,B, Size: Real; + Diff: Real; +begin + //Only Draw if Player has a Position + if Players[Index].Position <> high(byte) then + begin + //Only Draw if Player is on Cur Screen + if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and + Players[index].RBVisible and + Players[index].Visible) then + begin + Position := @Positions[Players[Index].Position and 127]; + + if (Enabled AND Players[Index].Enabled) then + begin + //Move Position if Enabled + Diff := Players[Index].RBTarget - Players[Index].RBPos; + If(Abs(Diff) < 0.02) then + aPlayers[Index].RBPos := aPlayers[Index].RBTarget + else + aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; + end; + + //Get Colors for RatingBar + if (Players[index].RBPos <= 0.22) then + begin + R := 1; + G := 0; + B := 0; + end + else if (Players[index].RBPos <= 0.42) then + begin + R := 1; + G := Players[index].RBPos*5; + B := 0; + end + else if (Players[index].RBPos <= 0.57) then + begin + R := 1; + G := 1; + B := 0; + end + else if (Players[index].RBPos <= 0.77) then + begin + R := 1-(Players[index].RBPos-0.57)*5; + G := 1; + B := 0; + end + else + begin + R := 0; + G := 1; + B := 0; + end; + + //Enable all glFuncs Needed + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + //Draw RatingBar BG + glColor4f(1, 1, 1, 0.8); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); + + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); + glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); + + glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); + glVertex2f(Position.RBX+Position.RBW, Position.RBY); + glEnd; + + //Draw Rating bar itself + Size := Position.RBX + Position.RBW * Players[Index].RBPos; + glColor4f(R, G, B, 1); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); + glVertex2f(Size, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); + glVertex2f(Size, Position.RBY); + glEnd; + + //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) + glColor4f(1, 1, 1, 0.6); + glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); + glVertex2f(Position.RBX, Position.RBY); + + glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); + glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); + + glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); + glVertex2f(Position.RBX + Position.RBW, Position.RBY); + glEnd; + + //Disable all Enabled glFuncs + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end; //eo Right Screen + end; //eo Player has Position +end; + +end. diff --git a/src/base/USkins.pas b/src/base/USkins.pas new file mode 100644 index 00000000..88549c9f --- /dev/null +++ b/src/base/USkins.pas @@ -0,0 +1,185 @@ +unit USkins; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TSkinTexture = record + Name: string; + FileName: string; + end; + + TSkinEntry = record + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet + end; + + TSkin = class + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; + constructor Create; + procedure LoadList; + procedure ParseDir(Dir: string); + procedure LoadHeader(FileName: string); + procedure LoadSkin(Name: string); + function GetTextureFileName(TextureName: string): string; + function GetSkinNumber(Name: string): integer; + procedure onThemeChange; + end; + +var + Skin: TSkin; + +implementation + +uses IniFiles, + Classes, + SysUtils, + UMain, + ULog, + UIni; + +constructor TSkin.Create; +begin + inherited; + LoadList; +// LoadSkin('Lisek'); +// SkinColor := Color; +end; + +procedure TSkin.LoadList; +var + SR: TSearchRec; +begin + if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + ParseDir(SkinsPath + SR.Name + PathDelim); + until FindNext(SR) <> 0; + end; // if + FindClose(SR); +end; + +procedure TSkin.ParseDir(Dir: string); +var + SR: TSearchRec; +begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + repeat + + if (SR.Name <> '.') and (SR.Name <> '..') then + LoadHeader(Dir + SR.Name); + + until FindNext(SR) <> 0; + end; +end; + +procedure TSkin.LoadHeader(FileName: string); +var + SkinIni: TMemIniFile; + S: integer; +begin + SkinIni := TMemIniFile.Create(FileName); + + S := Length(Skin); + SetLength(Skin, S+1); + + Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName)); + Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); + Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); + Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + + SkinIni.Free; +end; + +procedure TSkin.LoadSkin(Name: string); +var + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; +begin + S := GetSkinNumber(Name); + SkinPath := Skin[S].Path; + + SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + + SL := TStringList.Create; + SkinIni.ReadSection('Textures', SL); + + SetLength(SkinTexture, SL.Count); + for T := 0 to SL.Count-1 do + begin + SkinTexture[T].Name := SL.Strings[T]; + SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + end; + + SL.Free; + SkinIni.Free; +end; + +function TSkin.GetTextureFileName(TextureName: string): string; +var + T: integer; +begin + Result := ''; + + for T := 0 to High(SkinTexture) do + begin + if ( SkinTexture[T].Name = TextureName ) AND + ( SkinTexture[T].FileName <> '' ) then + begin + Result := SkinPath + SkinTexture[T].FileName; + end; + end; + + if ( TextureName <> '' ) AND + ( Result <> '' ) THEN + begin + //Log.LogError('', '-----------------------------------------'); + //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); + end; + +{ Result := SkinPath + 'Bar.jpg'; + if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} +end; + +function TSkin.GetSkinNumber(Name: string): integer; +var + S: integer; +begin + Result := 0; // set default to the first available skin + for S := 0 to High(Skin) do + if Skin[S].Name = Name then Result := S; +end; + +procedure TSkin.onThemeChange; +var + S: integer; + Name: String; +begin + Ini.SkinNo:=0; + SetLength(ISkin, 0); + Name := Uppercase(ITheme[Ini.Theme]); + for S := 0 to High(Skin) do + if Name = Uppercase(Skin[S].Theme) then begin + SetLength(ISkin, Length(ISkin)+1); + ISkin[High(ISkin)] := Skin[S].Name; + end; + +end; + +end. diff --git a/src/base/USong.pas b/src/base/USong.pas new file mode 100644 index 00000000..3517bce6 --- /dev/null +++ b/src/base/USong.pas @@ -0,0 +1,1027 @@ +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, + UXMLSong; + +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; + function ReadXMLHeader( const aFileName : WideString ): boolean; + public + Path: WideString; + Folder: WideString; // for sorting by folder + fFileName, + FileName: WideString; + + // sorting methods + Category: array of WideString; // TODO: do we need this? + Genre: WideString; + Edition: WideString; + Language: WideString; + + Title: WideString; + Artist: WideString; + + Text: WideString; + Creator: WideString; + + Cover: WideString; + CoverTex: TTexture; + Mp3: WideString; + Background: WideString; + Video: WideString; + VideoGAP: real; + VideoLoaded: boolean; // 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 operate on this file + + Base : array[0..1] of integer; + Rel : array[0..1] of integer; + Mult : integer; + MultBPM : integer; + + constructor Create (); overload; + constructor Create ( const aFileName : WideString ); overload; + function LoadSong: boolean; + function LoadXMLSong: boolean; + function Analyse(): boolean; + function AnalyseXML(): boolean; + procedure Clear(); + end; + +implementation + +uses + TextGL, + UIni, + UMusic, //needed for Lines + UMain; //needed for Player + +constructor TSong.Create(); +begin + inherited; +end; + +constructor TSong.Create( const aFileName : WideString ); +begin + inherited Create(); + + 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; + +//Load TXT Song +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].ScoreValue := 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].HighNote := -1; + Lines[Count].Line[0].LastLine := False; + 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('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 + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; + + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; + 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 + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; + end; + //Total Notes Patch End + end; + end; + Read(SongFile, TempC); + Inc(FileLineNo); + end; // while} + + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + end; + + CloseFile(SongFile); + except + try + CloseFile(SongFile); + except + + end; + + Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); + exit; + end; + + Result := true; +end; + +//Load XML Song +function TSong.LoadXMLSong(): 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,J,X: integer; + + NoteType: Char; + SentenceEnd, Rest, Time: Integer; + Parser: TParser; +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].ScoreValue := 0; + self.Relative := false; + Rel[0] := 0; + CP := 0; + Both := false; + + if Length(Player) = 2 then + Both := true; + + Parser := TParser.Create; + Parser.Settings.DashReplacement := '~'; + + 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].HighNote := -1; + Lines[Count].Line[0].LastLine := False; + end; + +//Try to Parse the Song + + if Parser.ParseSong(Path + PathDelim + FileName) then + begin +// Writeln('XML Inputfile Parsed succesful'); + //Start write parsed information to Song + //Notes Part + for I := 0 to High(Parser.SongInfo.Sentences) do + begin + //Add Notes + for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do + begin + case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of + NT_Normal: NoteType := ':'; + NT_Golden: NoteType := '*'; + NT_Freestyle: NoteType := 'F'; + end; + + Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start + Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration + Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone + ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric + + if not Both then + // P1 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else + begin + // P1 + P2 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + 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 X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do + begin + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + 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 X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do + begin + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + + end; + //Total Notes Patch End + end; + end; { end of for loop } + + end; //J Forloop + + //Add Sentence break + if (I < High(Parser.SongInfo.Sentences)) then + begin + + SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; + Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; + + //Calculate Time + case Rest of + 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; + 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; + else + if (Rest >= 4) then + Time := SentenceEnd + 2 + else //Sentence overlapping :/ + Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + end; + // new sentence + if not Both then + // P1 + NewSentence(0, (Time + Rel[0]) * Mult, Param2) + else + begin + // P1 + P2 + NewSentence(0, (Time + Rel[0]) * Mult, Param2); + NewSentence(1, (Time + Rel[1]) * Mult, Param2); + end; + + end; + end; + //End write parsed information to Song + Parser.Free; + end + else + begin + Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName); + exit; + end; + + for Count := 0 to High(Lines) do + begin + Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + end; + + Result := true; +end; + +function TSong.ReadXMLHeader(const aFileName : WideString): boolean; +var + Line, Identifier, Value: string; + Temp : word; + Done : byte; + Parser : TParser; +begin + Result := true; + Done := 0; + +//Parse XML + Parser := TParser.Create; + Parser.Settings.DashReplacement := '~'; + + + if Parser.ParseSong(self.Path + self.FileName) then + begin + //----------- + //Required Attributes + //----------- + + //Title + self.Title := Parser.SongInfo.Header.Title; + + //Add Title Flag to Done + Done := Done or 1; + + //Artist + self.Artist := Parser.SongInfo.Header.Artist; + + //Add Artist Flag to Done + Done := Done or 2; + + //MP3 File //Test if Exists + self.Mp3 := platform.FindSongFile(Path, '*.mp3'); + if (FileExists(self.Path + self.Mp3)) then + //Add Mp3 Flag to Done + Done := Done or 4; + + //Beats per Minute + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; + + self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; + + if self.BPM[0].BPM <> 0 then + //Add BPM Flag to Done + Done := Done or 8; + + //--------- + //Additional Header Information + //--------- + + // Gap + self.GAP := Parser.SongInfo.Header.Gap; + + //Cover Picture + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + + //Background Picture + self.Background := platform.FindSongFile(Path, '*[BG].jpg'); + + // Video File + // self.Video := Value + + // Video Gap + // self.VideoGAP := song_StrtoFloat( Value ) + + //Genre Sorting + self.Genre := Parser.SongInfo.Header.Genre; + + //Edition Sorting + self.Edition := Parser.SongInfo.Header.Edition; + + //Year Sorting + //Parser.SongInfo.Header.Year + + //Language Sorting + self.Language := Parser.SongInfo.Header.Language; + end else + Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); + + Parser.Free; + + //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 SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName); + end; + +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 + //--------- + + // 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); + HighNote := High(Note); + + Note[HighNote].Start := StartP; + if HighNote = 0 then + begin + if Lines[LineNumber].Number = 1 then + Start := -100; +// Start := Note[HighNote].Start; + end; + + Note[HighNote].Length := DurationP; + + // back to the normal system with normal, golden and now freestyle notes + case TypeP of + 'F': Note[HighNote].NoteType := ntFreestyle; + ':': Note[HighNote].NoteType := ntNormal; + '*': Note[HighNote].NoteType := ntGolden; + end; + + if (Note[HighNote].NoteType = ntGolden) then + Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + + if (Note[HighNote].NoteType <> ntFreestyle) then + Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + + Note[HighNote].Tone := NoteP; + if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; + + Note[HighNote].Text := Copy(LyricS, 2, 100); + Lyric := Lyric + Note[HighNote].Text; + + End_ := Note[HighNote].Start + Note[HighNote].Length; + 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 + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + 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; + + Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False; + + 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; + + +function TSong.AnalyseXML(): boolean; +begin + Result := False; + + //Reset LineNo + FileLineNo := 0; + + //Clear old Song Header + self.clear; + + //Read Header + Result := self.ReadXMLHeader( FileName ); + +end; + +end. diff --git a/src/base/USongs.pas b/src/base/USongs.pas new file mode 100644 index 00000000..710cd44f --- /dev/null +++ b/src/base/USongs.pas @@ -0,0 +1,806 @@ +unit USongs; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +{$IFDEF DARWIN} + {$IFDEF DEBUG} + {$DEFINE USE_PSEUDO_THREAD} + {$ENDIF} +{$ENDIF} + +uses + {$IFDEF MSWINDOWS} + Windows, + DirWatch, + {$ELSE} + {$IFNDEF DARWIN} + syscall, + {$ENDIF} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + USong, + UCatCovers; + +type + + TBPM = record + BPM: real; + StartBeat: real; + end; + + TScore = record + Name: widestring; + Score: integer; + Length: string; + end; + + {$IFDEF USE_PSEUDO_THREAD} + TSongs = class( TPseudoThread ) + {$ELSE} + TSongs = class( TThread ) + {$ENDIF} + private + fNotify, fWatch : longint; + fParseSongDirectory : boolean; + fProcessing : boolean; + {$ifdef MSWINDOWS} + fDirWatch : TDirectoryWatch; + {$endif} + procedure int_LoadSongList; + procedure DoDirChanged(Sender: TObject); + protected + procedure Execute; override; + public + SongList : TList; // array of songs + Selected : integer; // selected song index + constructor Create(); + destructor Destroy(); override; + + + procedure LoadSongList; // load all songs + procedure BrowseDir(Dir: widestring); // should return number of songs in the future + procedure BrowseTXTFiles(Dir: widestring); + procedure BrowseXMLFiles(Dir: widestring); + procedure Sort(Order: integer); + function FindSongFile(Dir, Mask: widestring): widestring; + property Processing : boolean read fProcessing; + end; + + + TCatSongs = class + Song: array of TSong; // array of categories with songs + Selected: integer; // selected song index + Order: integer; // order type (0=title) + CatNumShow: integer; // Category Number being seen + CatCount: integer; //Number of Categorys + + procedure SortSongs(); + procedure Refresh; // refreshes arrays by recreating them from Songs array + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: string; const fType: Byte): Cardinal; + end; + +var + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs + +const + IN_ACCESS = $00000001; //* File was accessed */ + IN_MODIFY = $00000002; //* File was modified */ + IN_ATTRIB = $00000004; //* Metadata changed */ + IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ + IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ + IN_OPEN = $00000020; //* File was opened */ + IN_MOVED_FROM = $00000040; //* File was moved from X */ + IN_MOVED_TO = $00000080; //* File was moved to Y */ + IN_CREATE = $00000100; //* Subfile was created */ + IN_DELETE = $00000200; //* Subfile was deleted */ + IN_DELETE_SELF = $00000400; //* Self was deleted */ + + +implementation + +uses StrUtils, + UGraphic, + UCovers, + UFiles, + UMain, + UIni; + +constructor TSongs.Create(); +begin + // do not start thread BEFORE initialization (suspended = true) + inherited Create(true); + Self.FreeOnTerminate := true; + + SongList := TList.Create(); + + // FIXME: threaded loading does not work this way. + // It will just cause crashes but nothing else at the moment. + (* + {$ifdef MSWINDOWS} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + // now we can start the thread + Resume(); + *) + + // until it is fixed, simply load the song-list + int_LoadSongList(); +end; + +destructor TSongs.Destroy(); +begin + FreeAndNil( SongList ); + inherited; +end; + +procedure TSongs.DoDirChanged(Sender: TObject); +begin + LoadSongList(); +end; + +procedure TSongs.Execute(); +var + fChangeNotify : THandle; +begin +{$IFDEF USE_PSEUDO_THREAD} + int_LoadSongList(); +{$ELSE} + fParseSongDirectory := true; + + while not terminated do + begin + + if fParseSongDirectory then + begin + Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute'); + int_LoadSongList(); + end; + + Suspend(); + end; +{$ENDIF} +end; + +procedure TSongs.int_LoadSongList; +var + I: integer; +begin + try + fProcessing := true; + + Log.LogStatus('Searching For Songs', 'SongList'); + + // browse directories + for I := 0 to SongPaths.Count-1 do + BrowseDir(SongPaths[I]); + + if assigned( CatSongs ) then + CatSongs.Refresh; + + if assigned( CatCovers ) then + CatCovers.Load; + + //if assigned( Covers ) then + // Covers.Load; + + if assigned(ScreenSong) then + begin + ScreenSong.GenerateThumbnails(); + ScreenSong.OnShow; // refresh ScreenSong + end; + + finally + Log.LogStatus('Search Complete', 'SongList'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + Resume(); +end; + +procedure TSongs.BrowseDir(Dir: widestring); +begin + BrowseTXTFiles(Dir); + BrowseXMLFiles(Dir); +end; + +procedure TSongs.BrowseTXTFiles(Dir: widestring); +var + i : integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if lSong.Analyse then + SongList.add( lSong ) + else + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end; + + end; + end; + SetLength( Files, 0); + +end; + +procedure TSongs.BrowseXMLFiles(Dir: widestring); +var + i : integer; + Files : TDirectoryEntryArray; + lSong : TSong; +begin + + Files := Platform.DirectoryFindFiles( Dir, '.xml', true); + + for i := 0 to Length(Files)-1 do + begin + if Files[i].IsDirectory then + begin + BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if lSong.AnalyseXML then + SongList.add( lSong ) + else + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end; + + end; + end; + SetLength( Files, 0); + +end; + +(* + * Comparison functions for sorting + *) + +function CompareByEdition(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition); +end; + +function CompareByGenre(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre); +end; + +function CompareByTitle(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Title, TSong(Song2).Title); +end; + +function CompareByArtist(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist); +end; + +function CompareByFolder(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder); +end; + +function CompareByLanguage(Song1, Song2: Pointer): integer; +begin + Result := CompareText(TSong(Song1).Language, TSong(Song2).Language); +end; + +procedure TSongs.Sort(Order: integer); +var + CompareFunc: TListSortCompare; +begin + // FIXME: what is the difference between artist and artist2, etc.? + case Order of + sEdition: // by edition + CompareFunc := CompareByEdition; + sGenre: // by genre + CompareFunc := CompareByGenre; + sTitle: // by title + CompareFunc := CompareByTitle; + sArtist: // by artist + CompareFunc := CompareByArtist; + sFolder: // by folder + CompareFunc := CompareByFolder; + sTitle2: // by title2 + CompareFunc := CompareByTitle; + sArtist2: // by artist2 + CompareFunc := CompareByArtist; + sLanguage: // by Language + CompareFunc := CompareByLanguage; + else + Log.LogCritical('Unsupported comparison', 'TSongs.Sort'); + Exit; // suppress warning + end; // case + + // Note: Do not use TList.Sort() as it uses QuickSort which is instable. + // For example, if a list is sorted by title first and + // by artist afterwards, the songs of an artist will not be sorted by title anymore. + // The stable MergeSort guarantees to maintain this order. + MergeSort(SongList, CompareFunc); +end; + +function TSongs.FindSongFile(Dir, Mask: widestring): widestring; +var + SR: TSearchRec; // for parsing song directory +begin + Result := ''; + if FindFirst(Dir + Mask, faDirectory, SR) = 0 then + begin + Result := SR.Name; + end; // if + FindClose(SR); +end; + +procedure TCatSongs.SortSongs(); +begin + case Ini.Sorting of + sEdition: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: begin + Songs.Sort(sTitle); + end; + sArtist: begin + Songs.Sort(sTitle); + Songs.Sort(sArtist); + end; + sTitle2: begin + Songs.Sort(sArtist2); + Songs.Sort(sTitle2); + end; + sArtist2: begin + Songs.Sort(sTitle2); + Songs.Sort(sArtist2); + end; + end; // case +end; + +procedure TCatSongs.Refresh; +var + SongIndex: integer; + CurSong: TSong; + CatIndex: integer; // index of current song in Song + Letter: char; // current letter for sorting using letter + CurCategory: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + LetterTmp: char; + CatNumber: integer; // Number of Song in Category + + procedure AddCategoryButton(const CategoryName: string); + var + PrevCatBtnIndex: integer; + begin + Inc(Order); + CatIndex := Length(Song); + SetLength(Song, CatIndex+1); + Song[CatIndex] := TSong.Create(); + Song[CatIndex].Artist := '[' + CategoryName + ']'; + Song[CatIndex].Main := true; + Song[CatIndex].OrderTyp := 0; + Song[CatIndex].OrderNum := Order; + Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); + Song[CatIndex].Visible := true; + + // set number of songs in previous category + PrevCatBtnIndex := CatIndex - CatNumber - 1; + if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then + Song[PrevCatBtnIndex].CatNumber := CatNumber; + + CatNumber := 0; + end; + +begin + CatNumShow := -1; + + SortSongs(); + + CurCategory := ''; + Order := 0; + CatNumber := 0; + + // Note: do NOT set Letter to ' ', otherwise no category-button will be + // created for songs beginning with ' ' if songs of this category exist. + // TODO: trim song-properties so ' ' will not occur as first chararcter. + Letter := #0; + + // clear song-list + for SongIndex := 0 to Songs.SongList.Count-1 do + begin + // free category buttons + // Note: do NOT delete songs, they are just references to Songs.SongList entries + CurSong := TSong(Songs.SongList[SongIndex]); + if (CurSong.Main) then + CurSong.Free; + end; + SetLength(Song, 0); + + for SongIndex := 0 to Songs.SongList.Count-1 do + begin + CurSong := TSong(Songs.SongList[SongIndex]); + // if tabs are on, add section buttons for each new section + if (Ini.Tabs = 1) then + begin + if (Ini.Sorting = sEdition) and + (CompareText(CurCategory, CurSong.Edition) <> 0) then + begin + CurCategory := CurSong.Edition; + + // TODO: remove this block if it is not needed anymore + { + if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; + if CurSection = 'Singstar German' then CoverName := 'Singstar'; + if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; + if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; + if CurSection = 'Singstar French' then CoverName := 'Singstar'; + if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s'; + } + + // add Category Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sGenre) and + (CompareText(CurCategory, CurSong.Genre) <> 0) then + begin + CurCategory := CurSong.Genre; + // add Genre Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sLanguage) and + (CompareText(CurCategory, CurSong.Language) <> 0) then + begin + CurCategory := CurSong.Language; + // add Language Button + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sTitle) and + (Length(CurSong.Title) >= 1) and + (Letter <> UpperCase(CurSong.Title)[1]) then + begin + Letter := Uppercase(CurSong.Title)[1]; + // add a letter Category Button + AddCategoryButton(Letter); + end + + else if (Ini.Sorting = sArtist) and + (Length(CurSong.Artist) >= 1) and + (Letter <> UpperCase(CurSong.Artist)[1]) then + begin + Letter := UpperCase(CurSong.Artist)[1]; + // add a letter Category Button + AddCategoryButton(Letter); + end + + else if (Ini.Sorting = sFolder) and + (CompareText(CurCategory, CurSong.Folder) <> 0) then + begin + CurCategory := CurSong.Folder; + // add folder tab + AddCategoryButton(CurCategory); + end + + else if (Ini.Sorting = sTitle2) and + (Length(CurSong.Title) >= 1) then + begin + // pack all numbers into a category named '#' + if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then + LetterTmp := '#' + else + LetterTmp := UpperCase(CurSong.Title)[1]; + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(Letter); + end; + end + + else if (Ini.Sorting = sArtist2) and + (Length(CurSong.Artist)>=1) then + begin + // pack all numbers into a category named '#' + if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then + LetterTmp := '#' + else + LetterTmp := UpperCase(CurSong.Artist)[1]; + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(Letter); + end; + end; + end; + + CatIndex := Length(Song); + SetLength(Song, CatIndex+1); + + Inc(CatNumber); // increase number of songs in category + + // copy reference to current song + Song[CatIndex] := CurSong; + + // set song's category info + CurSong.OrderNum := Order; // assigns category + CurSong.CatNumber := CatNumber; + + if (Ini.Tabs = 0) then + CurSong.Visible := true + else if (Ini.Tabs = 1) then + CurSong.Visible := false; + + { + if (Ini.Tabs = 1) and (Order = 1) then + begin + //open first tab + CurSong.Visible := true; + end; + CurSong.Visible := true; + } + end; + + // set CatNumber of last category + if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then + begin + // set number of songs in previous category + SongIndex := CatIndex - CatNumber; + if ((SongIndex >= 0) and Song[SongIndex].Main) then + Song[SongIndex].CatNumber := CatNumber; + end; + + // update number of categories + CatCount := Order; +end; + +procedure TCatSongs.ShowCategory(Index: integer); +var + S: integer; // song +begin + CatNumShow := Index; + for S := 0 to high(CatSongs.Song) do + begin +{ + if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false; +} +// KMS: This should be the same, but who knows :-) + CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) ); + end; +end; + +procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category +var + S: integer; // song +begin + for S := 0 to high(CatSongs.Song) do + begin + if not CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := false // hides all at now + end; +end; + +procedure TCatSongs.ClickCategoryButton(Index: integer); +var + Num, S: integer; +begin + Num := CatSongs.Song[Index].OrderNum; + if Num <> CatNumShow then + begin + ShowCategory(Num); + end + else + begin + ShowCategoryList; + end; +end; + +//Hide Categorys when in Category Hack +procedure TCatSongs.ShowCategoryList; +var + Num, S: integer; +begin + // Hide All Songs Show All Cats + for S := 0 to high(CatSongs.Song) do + CatSongs.Song[S].Visible := CatSongs.Song[S].Main; + CatSongs.Selected := CatNumShow; //Show last shown Category + CatNumShow := -1; +end; +//Hide Categorys when in Category Hack End + +//Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +var + I: integer; +begin + Result := -1; + I := SearchFrom + 1; + while not CatSongs.Song[I].Visible do + begin + Inc (I); + if (I>high(CatSongs.Song)) then + I := low(CatSongs.Song); + if (I = SearchFrom) then //Make One Round and no song found->quit + break; + end; +end; +//Wrong song selected when tabs on bug End + +(** + * Returns the number of visible songs. + *) +function TCatSongs.VisibleSongs: integer; +var + SongIndex: integer; +begin + Result := 0; + for SongIndex := 0 to High(CatSongs.Song) do + begin + if (CatSongs.Song[SongIndex].Visible) then + Inc(Result); + end; +end; + +(** + * Returns the index of a song in the subset of all visible songs. + * If all songs are visible, the result will be equal to the Index parameter. + *) +function TCatSongs.VisibleIndex(Index: integer): integer; +var + SongIndex: integer; +begin + Result := 0; + for SongIndex := 0 to Index-1 do + begin + if (CatSongs.Song[SongIndex].Visible) then + Inc(Result); + end; +end; + +function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal; +var + I, J: integer; + cString: string; + SearchStr: array of string; +begin + {fType: 0: All + 1: Title + 2: Artist} + FilterStr := Trim(FilterStr); + if FilterStr<>'' then + begin + Result := 0; + //Create Search Array + SetLength(SearchStr, 1); + I := Pos (' ', FilterStr); + while (I <> 0) do + begin + SetLength (SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I-1); + if (cString <> ' ') and (cString <> '') then + SearchStr[High(SearchStr)-1] := cString; + Delete (FilterStr, 1, I); + + I := Pos (' ', FilterStr); + end; + //Copy last Word + if (FilterStr <> ' ') and (FilterStr <> '') then + SearchStr[High(SearchStr)] := FilterStr; + + for I:=0 to High(Song) do + begin + if not Song[i].Main then + begin + case fType of + 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + 1: cString := Song[I].Title; + 2: cString := Song[I].Artist; + end; + Song[i].Visible:=True; + //Look for every Searched Word + for J := 0 to High(SearchStr) do + begin + Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J]) + end; + if Song[i].Visible then + Inc(Result); + end + else + Song[i].Visible:=False; + end; + CatNumShow := -2; + end + else + begin + for i:=0 to High(Song) do + begin + Song[i].Visible := (Ini.Tabs=1) = Song[i].Main; + CatNumShow := -1; + end; + Result := 0; + end; +end; + +// ----------------------------------------------------------------------------- + +end. diff --git a/src/base/UTextClasses.pas b/src/base/UTextClasses.pas new file mode 100644 index 00000000..9a12e1f5 --- /dev/null +++ b/src/base/UTextClasses.pas @@ -0,0 +1,60 @@ +unit UTextClasses; + +interface + +{$I switches.inc} + +uses + gl, + SDL, + UTexture, + Classes, +// SDL_ttf, + ULog; + +{ +// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf +// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png +// thanks to Bob Pendelton and Koshmaar! +// (1) let's start with a glyph, this represents one character in a word + +type + TGlyph = record + character : Char; // unsigned char, uchar is something else in delphi + glyphsSolid[8] : GlyphTexture; // fast, but not that + glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty + +//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P) + deconstructor procedure ReleaseTextures(); +end; + +// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P + + GlyphTexture = record + textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one + width, + height : Cardinal; + charWidth, + charHeight : Integer; + advance : Integer; // don't know yet for what this one is +} + +{ +// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need + TGlyphsContainer = record + glyphs array of TGlyph; + FontName array of string; + refCount : uChar; // unsigned char, uchar is something else in delphi + font : PTTF_font; + size, + lineSkip : Cardinal; // vertical distance between multi line text output + descent : Integer; + + + +} + + +implementation + +end. diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas new file mode 100644 index 00000000..4879760a --- /dev/null +++ b/src/base/UTexture.pas @@ -0,0 +1,525 @@ +unit UTexture; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + gl, + glu, + glext, + Classes, + SysUtils, + UCommon, + SDL, + SDL_Image; + +type + PTexture = ^TTexture; + TTexture = record + TexNum: GLuint; + X: real; + Y: real; + Z: real; + W: real; + H: real; + ScaleW: real; // for dynamic scalling while leaving width constant + ScaleH: real; // for dynamic scalling while leaving height constant + Rot: real; // 0 - 2*pi + Int: real; // intensity + ColR: real; + ColG: real; + ColB: real; + TexW: real; // percentage of width to use [0..1] + TexH: real; // percentage of height to use [0..1] + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins + end; + +type + TTextureType = ( + TEXTURE_TYPE_PLAIN, // Plain (alpha = 1) + TEXTURE_TYPE_TRANSPARENT, // Alpha is used + TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value + ); + +const + TextureTypeStr: array[TTextureType] of string = ( + 'Plain', + 'Transparent', + 'Colorized' + ); + +function TextureTypeToStr(TexType: TTextureType): string; +function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; + +procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); + +type + PTextureEntry = ^TTextureEntry; + TTextureEntry = record + Name: string; + Typ: TTextureType; + Color: Cardinal; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; // Full-size texture + TextureCache: TTexture; // Thumbnail texture + end; + + TTextureDatabase = class + private + Texture: array of TTextureEntry; + public + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); + function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; + end; + + TTextureUnit = class + private + TextureDatabase: TTextureDatabase; + public + Limit: integer; + + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload; + function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; + function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; + function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: string): TTexture; overload; + function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; + procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; + procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload; + //procedure FlushTextureDatabase(); + + constructor Create; + destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + +implementation + +uses + DateUtils, + StrUtils, + Math, + ULog, + UCovers, + UThemes, + UImage; + +procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + if (Typ = TEXTURE_TYPE_PLAIN) then + NeededPixFmt := @PixelFmt_RGB + else if (Typ = TEXTURE_TYPE_TRANSPARENT) or + (Typ = TEXTURE_TYPE_COLORIZED) then + NeededPixFmt := @PixelFmt_RGBA + else + NeededPixFmt := @PixelFmt_RGB; + + if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then + begin + TempSurface := TexSurface; + TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +{ TTextureDatabase } + +procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +var + TextureIndex: integer; +begin + TextureIndex := FindTexture(Tex.Name, Typ, Color); + if (TextureIndex = -1) then + begin + TextureIndex := Length(Texture); + SetLength(Texture, TextureIndex+1); + + Texture[TextureIndex].Name := Tex.Name; + Texture[TextureIndex].Typ := Typ; + Texture[TextureIndex].Color := Color; + end; + + if (Cache) then + Texture[TextureIndex].TextureCache := Tex + else + Texture[TextureIndex].Texture := Tex; +end; + +function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; +var + TextureIndex: integer; + CurrentTexture: PTextureEntry; +begin + Result := -1; + for TextureIndex := 0 to High(Texture) do + begin + CurrentTexture := @Texture[TextureIndex]; + if (CurrentTexture.Name = Name) and + (CurrentTexture.Typ = Typ) then + begin + // colorized textures must match in their color too + if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or + (CurrentTexture.Color = Color) then + begin + Result := TextureIndex; + Break; + end; + end; + end; +end; + + +{ TTextureUnit } + +constructor TTextureUnit.Create; +begin + inherited Create; + TextureDatabase := TTextureDatabase.Create; +end; + +destructor TTextureUnit.Destroy; +begin + TextureDatabase.Free; + inherited Destroy; +end; + + +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); +begin + TextureDatabase.AddTexture(Tex, Typ, 0, Cache); +end; + +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +begin + TextureDatabase.AddTexture(Tex, Typ, Color, Cache); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +begin + // FIXME: what is the FromRegistry parameter supposed to do? + Result := LoadTexture(Identifier, Typ, Col); +end; + +function TTextureUnit.LoadTexture(const Identifier: string): TTexture; +begin + Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0); +end; + +function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + ActTex: GLuint; +begin + // zero texture data + FillChar(Result, SizeOf(Result), 0); + + // load texture data into memory + TexSurface := LoadImage(Identifier); + if not assigned(TexSurface) then + begin + Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"', + 'TTextureUnit.LoadTexture'); + Exit; + end; + + // convert pixel format as needed + AdjustPixelFormat(TexSurface, Typ); + + // adjust texture size (scale down, if necessary) + newWidth := TexSurface.W; + newHeight := TexSurface.H; + + if (newWidth > Limit) then + newWidth := Limit; + + if (newHeight > Limit) then + newHeight := Limit; + + if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then + ScaleImage(TexSurface, newWidth, newHeight); + + // now we might colorize the whole thing + if (Typ = TEXTURE_TYPE_COLORIZED) then + ColorizeImage(TexSurface, Col); + + // save actual dimensions of our texture + oldWidth := newWidth; + oldHeight := newHeight; + + // make texture dimensions be powers of 2 + newWidth := Round(Power(2, Ceil(Log2(newWidth)))); + newHeight := Round(Power(2, Ceil(Log2(newHeight)))); + if (newHeight <> oldHeight) or (newWidth <> oldWidth) then + FitImage(TexSurface, newWidth, newHeight); + + // at this point we have the image in memory... + // scaled to be at most 1024x1024 pixels large + // scaled so that dimensions are powers of 2 + // and converted to either RGB or RGBA + + // if we got a Texture of Type Plain, Transparent or Colorized, + // then we're done manipulating it + // and could now create our openGL texture from it + + // prepare OpenGL texture + glGenTextures(1, @ActTex); + + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + // load data into gl texture + if (Typ = TEXTURE_TYPE_TRANSPARENT) or + (Typ = TEXTURE_TYPE_COLORIZED) then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + else //if Typ = TEXTURE_TYPE_PLAIN then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + // setup texture struct + with Result do + begin + X := 0; + Y := 0; + Z := 0; + W := 0; + H := 0; + ScaleW := 1; + ScaleH := 1; + Rot := 0; + TexNum := ActTex; + TexW := oldWidth / newWidth; + TexH := oldHeight / newHeight; + + Int := 1; + ColR := 1; + ColG := 1; + ColB := 1; + Alpha := 1; + + // new test - default use whole texure, taking TexW and TexH as const and changing these + TexX1 := 0; + TexY1 := 0; + TexX2 := 1; + TexY2 := 1; + + Name := Identifier; + end; + + SDL_FreeSurface(TexSurface); +end; + +function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture; +begin + Result := GetTexture(Name, Typ, 0, FromCache); +end; + +function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; +var + TextureIndex: integer; + CoverIndex: integer; +begin + if (Name = '') then + begin + // zero texture data + FillChar(Result, SizeOf(Result), 0); + Exit; + end; + + if (FromCache) then + begin + (* + // use cache texture + CoverIndex := Covers.FindCover(Name); + + if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24); + end; + *) + + // use texture + TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); + if (TextureIndex > -1) then + Result := TextureDatabase.Texture[TextureIndex].TextureCache; + Exit; + end; + + // find texture entry in database + TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); + if (TextureIndex = -1) then + begin + // create texture entry in database + TextureIndex := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, TextureIndex+1); + + TextureDatabase.Texture[TextureIndex].Name := Name; + TextureDatabase.Texture[TextureIndex].Typ := Typ; + TextureDatabase.Texture[TextureIndex].Color := Col; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0; + TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0; + end; + + // load full texture + if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then + TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col); + + // use texture + Result := TextureDatabase.Texture[TextureIndex].Texture; +end; + +function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; +var + Error: integer; + ActTex: GLuint; +begin + glGenTextures(1, @ActTex); // ActText = new texture number + glBindTexture(GL_TEXTURE_2D, ActTex); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + + glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); + + { + if Mipmapping then + begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then + Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); + end; + } + + Result.X := 0; + Result.Y := 0; + Result.Z := 0; + Result.W := 0; + Result.H := 0; + Result.ScaleW := 1; + Result.ScaleH := 1; + Result.Rot := 0; + Result.TexNum := ActTex; + Result.TexW := 1; + Result.TexH := 1; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // new test - default use whole texure, taking TexW and TexH as const and changing these + Result.TexX1 := 0; + Result.TexY1 := 0; + Result.TexX2 := 1; + Result.TexY2 := 1; + + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); +begin + UnloadTexture(Name, Typ, 0, FromCache); +end; + +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := TextureDatabase.FindTexture(Name, Typ, Col); + + if not FromCache then + begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum > 0 then + begin + glDeleteTextures(1, PGLuint(@TexNum)); + TextureDatabase.Texture[T].Texture.TexNum := 0; + //Log.LogError('Unload texture no '+IntToStr(TexNum)); + end; + end + else + begin + TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; + if TexNum > 0 then + begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].TextureCache.TexNum := 0; + //Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +(* This needs some work +procedure TTextureUnit.FlushTextureDatabase(); +var + i: integer; + Tex: ^TTexture; +begin + for i := 0 to High(TextureDatabase.Texture) do + begin + // only delete non-cached entries + if (TextureDatabase.Texture[i].Texture.TexNum > 0) then + begin + Tex := @TextureDatabase.Texture[i].Texture; + glDeleteTextures(1, PGLuint(Tex^.TexNum)); + Tex^.TexNum := 0; + end; + end; +end; +*) + +function TextureTypeToStr(TexType: TTextureType): string; +begin + Result := TextureTypeStr[TexType]; +end; + +function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; +var + TexType: TTextureType; + UpCaseStr: string; +begin + UpCaseStr := UpperCase(TypeStr); + for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do + begin + if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then + begin + Result := TexType; + Exit; + end; + end; + Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType'); + Result := TEXTURE_TYPE_PLAIN; +end; + +end. diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas new file mode 100644 index 00000000..fca75c24 --- /dev/null +++ b/src/base/UThemes.pas @@ -0,0 +1,2234 @@ +unit UThemes; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + ULog, + IniFiles, + SysUtils, + Classes, + UTexture; + +type + TRGB = record + R: single; + G: single; + B: single; + end; + + TRGBA = record + R, G, B, A: Double; + end; + + TThemeBackground = record + Tex: string; + end; + + TThemeStatic = record + X: integer; + Y: integer; + Z: real; + W: integer; + H: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Tex: string; + Typ: TTextureType; + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + //Reflection + Reflection: boolean; + Reflectionspacing: Real; + end; + AThemeStatic = array of TThemeStatic; + + TThemeText = record + X: integer; + Y: integer; + W: integer; + Z: real; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Font: integer; + Size: integer; + Align: integer; + Text: string; + //Reflection + Reflection: boolean; + ReflectionSpacing: Real; + end; + AThemeText = array of TThemeText; + + TThemeButton = record + Text: AThemeText; + X: integer; + Y: integer; + Z: Real; + W: integer; + H: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Int: real; + DColor: string; + DColR: real; + DColG: real; + DColB: real; + DInt: real; + Tex: string; + Typ: TTextureType; + + Visible: Boolean; + + //Reflection Mod + Reflection: boolean; + Reflectionspacing: Real; + //Fade Mod + SelectH: integer; + SelectW: integer; + Fade: boolean; + FadeText: boolean; + DeSelectReflectionspacing : Real; + FadeTex: string; + FadeTexPos: integer; + + //Button Collection Mod + Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement + end; + + //Button Collection Mod + TThemeButtonCollection = record + Style: TThemeButton; + ChildCount: Byte; //No of assigned Childs + FirstChild: Byte; //No of Child on whose Interaction Position the Button should be + end; + + AThemeButtonCollection = array of TThemeButtonCollection; + PAThemeButtonCollection = ^AThemeButtonCollection; + + TThemeSelectSlide = record + Tex: string; + TexSBG: string; + X: integer; + Y: integer; + W: integer; + H: integer; + Z: real; + + TextSize: integer; + + //SBGW Mod + SBGW: integer; + + Text: string; + ColR, ColG, ColB, Int: real; + DColR, DColG, DColB, DInt: real; + TColR, TColG, TColB, TInt: real; + TDColR, TDColG, TDColB, TDInt: real; + SBGColR, SBGColG, SBGColB, SBGInt: real; + SBGDColR, SBGDColG, SBGDColB, SBGDInt: real; + STColR, STColG, STColB, STInt: real; + STDColR, STDColG, STDColB, STDInt: real; + SkipX: integer; + end; + + PThemeBasic = ^TThemeBasic; + TThemeBasic = class + Background: TThemeBackground; + Text: AThemeText; + Static: AThemeStatic; + + //Button Collection Mod + ButtonCollection: AThemeButtonCollection; + end; + + TThemeLoading = class(TThemeBasic) + StaticAnimation: TThemeStatic; + TextLoading: TThemeText; + end; + + TThemeMain = class(TThemeBasic) + ButtonSolo: TThemeButton; + ButtonMulti: TThemeButton; + ButtonStat: TThemeButton; + ButtonEditor: TThemeButton; + ButtonOptions: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextDescriptionLong: TThemeText; + Description: array[0..5] of string; + DescriptionLong: array[0..5] of string; + end; + + TThemeName = class(TThemeBasic) + ButtonPlayer: array[1..6] of TThemeButton; + end; + + TThemeLevel = class(TThemeBasic) + ButtonEasy: TThemeButton; + ButtonMedium: TThemeButton; + ButtonHard: TThemeButton; + end; + + TThemeSong = class(TThemeBasic) + TextArtist: TThemeText; + TextTitle: TThemeText; + TextNumber: TThemeText; + + //Video Icon Mod + VideoIcon: TThemeStatic; + + //Show Cat in TopLeft Mod + TextCat: TThemeText; + StaticCat: TThemeStatic; + + //Cover Mod + Cover: record + Reflections: Boolean; + X: Integer; + Y: Integer; + Z: Integer; + W: Integer; + H: Integer; + Style: Integer; + end; + + //Equalizer Mod + Equalizer: record + Visible: Boolean; + Direction: Boolean; + Alpha: real; + X: Integer; + Y: Integer; + Z: Real; + W: Integer; + H: Integer; + Space: Integer; + Bands: Integer; + Length: Integer; + ColR, ColG, ColB: Real; + end; + + + //Party and Non Party specific Statics and Texts + StaticParty: AThemeStatic; + TextParty: AThemeText; + + StaticNonParty: AThemeStatic; + TextNonParty: AThemeText; + + //Party Mode + StaticTeam1Joker1: TThemeStatic; + StaticTeam1Joker2: TThemeStatic; + StaticTeam1Joker3: TThemeStatic; + StaticTeam1Joker4: TThemeStatic; + StaticTeam1Joker5: TThemeStatic; + StaticTeam2Joker1: TThemeStatic; + StaticTeam2Joker2: TThemeStatic; + StaticTeam2Joker3: TThemeStatic; + StaticTeam2Joker4: TThemeStatic; + StaticTeam2Joker5: TThemeStatic; + StaticTeam3Joker1: TThemeStatic; + StaticTeam3Joker2: TThemeStatic; + StaticTeam3Joker3: TThemeStatic; + StaticTeam3Joker4: TThemeStatic; + StaticTeam3Joker5: TThemeStatic; + + + end; + + TThemeSing = class(TThemeBasic) + + //TimeBar mod + StaticTimeProgress: TThemeStatic; + TextTimeText : TThemeText; + //eoa TimeBar mod + + StaticP1: TThemeStatic; + TextP1: TThemeText; + StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG + TextP1Score: TThemeText; + + //moveable singbar mod + StaticP1SingBar: TThemeStatic; + StaticP1ThreePSingBar: TThemeStatic; + StaticP1TwoPSingBar: TThemeStatic; + StaticP2RSingBar: TThemeStatic; + StaticP2MSingBar: TThemeStatic; + StaticP3SingBar: TThemeStatic; + //eoa moveable singbar + + //added for ps3 skin + //game in 2/4 player modi + StaticP1TwoP: TThemeStatic; + StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG + TextP1TwoP: TThemeText; + TextP1TwoPScore: TThemeText; + //game in 3/6 player modi + StaticP1ThreeP: TThemeStatic; + StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG + TextP1ThreeP: TThemeText; + TextP1ThreePScore: TThemeText; + //eoa + + StaticP2R: TThemeStatic; + StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG + TextP2R: TThemeText; + TextP2RScore: TThemeText; + + StaticP2M: TThemeStatic; + StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG + TextP2M: TThemeText; + TextP2MScore: TThemeText; + + StaticP3R: TThemeStatic; + StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG + TextP3R: TThemeText; + TextP3RScore: TThemeText; + + //Linebonus Translations + LineBonusText: Array [0..8] of String; + + //Pause Popup + PausePopUp: TThemeStatic; + end; + + TThemeScore = class(TThemeBasic) + TextArtist: TThemeText; + TextTitle: TThemeText; + + TextArtistTitle: TThemeText; + + PlayerStatic: array[1..6] of AThemeStatic; + PlayerTexts: array[1..6] of AThemeText; + + TextName: array[1..6] of TThemeText; + TextScore: array[1..6] of TThemeText; + + TextNotes: array[1..6] of TThemeText; + TextNotesScore: array[1..6] of TThemeText; + TextLineBonus: array[1..6] of TThemeText; + TextLineBonusScore: array[1..6] of TThemeText; + TextGoldenNotes: array[1..6] of TThemeText; + TextGoldenNotesScore: array[1..6] of TThemeText; + TextTotal: array[1..6] of TThemeText; + TextTotalScore: array[1..6] of TThemeText; + + StaticBoxLightest: array[1..6] of TThemeStatic; + StaticBoxLight: array[1..6] of TThemeStatic; + StaticBoxDark: array[1..6] of TThemeStatic; + + StaticRatings: array[1..6] of TThemeStatic; + + StaticBackLevel: array[1..6] of TThemeStatic; + StaticBackLevelRound: array[1..6] of TThemeStatic; + StaticLevel: array[1..6] of TThemeStatic; + StaticLevelRound: array[1..6] of TThemeStatic; + +// Description: array[0..5] of string;} + end; + + TThemeTop5 = class(TThemeBasic) + TextLevel: TThemeText; + TextArtistTitle: TThemeText; + + StaticNumber: AThemeStatic; + TextNumber: AThemeText; + TextName: AThemeText; + TextScore: AThemeText; + end; + + TThemeOptions = class(TThemeBasic) + ButtonGame: TThemeButton; + ButtonGraphics: TThemeButton; + ButtonSound: TThemeButton; + ButtonLyrics: TThemeButton; + ButtonThemes: TThemeButton; + ButtonRecord: TThemeButton; + ButtonAdvanced: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + Description: array[0..7] of string; + end; + + TThemeOptionsGame = class(TThemeBasic) + SelectPlayers: TThemeSelectSlide; + SelectDifficulty: TThemeSelectSlide; + SelectLanguage: TThemeSelectSlide; + SelectTabs: TThemeSelectSlide; + SelectSorting: TThemeSelectSlide; + SelectDebug: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsGraphics = class(TThemeBasic) + SelectFullscreen: TThemeSelectSlide; + SelectResolution: TThemeSelectSlide; + SelectDepth: TThemeSelectSlide; + SelectVisualizer: TThemeSelectSlide; + SelectOscilloscope: TThemeSelectSlide; + SelectLineBonus: TThemeSelectSlide; + SelectMovieSize: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsSound = class(TThemeBasic) + SelectMicBoost: TThemeSelectSlide; + SelectBackgroundMusic: TThemeSelectSlide; + SelectClickAssist: TThemeSelectSlide; + SelectBeatClick: TThemeSelectSlide; + SelectThreshold: TThemeSelectSlide; + SelectSlidePreviewVolume: TThemeSelectSlide; + SelectSlidePreviewFading: TThemeSelectSlide; + SelectSlideVoicePassthrough: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsLyrics = class(TThemeBasic) + SelectLyricsFont: TThemeSelectSlide; + SelectLyricsEffect: TThemeSelectSlide; +// SelectSolmization: TThemeSelectSlide; + SelectNoteLines: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsThemes = class(TThemeBasic) + SelectTheme: TThemeSelectSlide; + SelectSkin: TThemeSelectSlide; + SelectColor: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsRecord = class(TThemeBasic) + SelectSlideCard: TThemeSelectSlide; + SelectSlideInput: TThemeSelectSlide; + SelectSlideChannel: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsAdvanced = class(TThemeBasic) + SelectLoadAnimation: TThemeSelectSlide; + SelectEffectSing: TThemeSelectSlide; + SelectScreenFade: TThemeSelectSlide; + SelectLineBonus: TThemeSelectSlide; + SelectAskbeforeDel: TThemeSelectSlide; + SelectOnSongClick: TThemeSelectSlide; + SelectPartyPopup: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + //Error- and Check-Popup + TThemeError = class(TThemeBasic) + Button1: TThemeButton; + TextError: TThemeText; + end; + + TThemeCheck = class(TThemeBasic) + Button1: TThemeButton; + Button2: TThemeButton; + TextCheck: TThemeText; + end; + + + //ScreenSong Menue + TThemeSongMenu = class(TThemeBasic) + Button1: TThemeButton; + Button2: TThemeButton; + Button3: TThemeButton; + Button4: TThemeButton; + + SelectSlide3: TThemeSelectSlide; + + TextMenu: TThemeText; + end; + + TThemeSongJumpTo = class(TThemeBasic) + ButtonSearchText: TThemeButton; + SelectSlideType: TThemeSelectSlide; + TextFound: TThemeText; + + //Translated Texts + Songsfound: String; + NoSongsfound: String; + CatText: String; + IType: array [0..2] of String; + end; + + //Party Screens + TThemePartyNewRound = class(TThemeBasic) + TextRound1: TThemeText; + TextRound2: TThemeText; + TextRound3: TThemeText; + TextRound4: TThemeText; + TextRound5: TThemeText; + TextRound6: TThemeText; + TextRound7: TThemeText; + TextWinner1: TThemeText; + TextWinner2: TThemeText; + TextWinner3: TThemeText; + TextWinner4: TThemeText; + TextWinner5: TThemeText; + TextWinner6: TThemeText; + TextWinner7: TThemeText; + TextNextRound: TThemeText; + TextNextRoundNo: TThemeText; + TextNextPlayer1: TThemeText; + TextNextPlayer2: TThemeText; + TextNextPlayer3: TThemeText; + + StaticRound1: TThemeStatic; + StaticRound2: TThemeStatic; + StaticRound3: TThemeStatic; + StaticRound4: TThemeStatic; + StaticRound5: TThemeStatic; + StaticRound6: TThemeStatic; + StaticRound7: TThemeStatic; + + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + TextTeam1Players: TThemeText; + TextTeam2Players: TThemeText; + TextTeam3Players: TThemeText; + + StaticTeam1: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticNextPlayer1: TThemeStatic; + StaticNextPlayer2: TThemeStatic; + StaticNextPlayer3: TThemeStatic; + end; + + TThemePartyScore = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam1BG: TThemeStatic; + StaticTeam1Deco: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam2BG: TThemeStatic; + StaticTeam2Deco: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticTeam3BG: TThemeStatic; + StaticTeam3Deco: TThemeStatic; + + DecoTextures: record + ChangeTextures: Boolean; + + FirstTexture: String; + FirstTyp: TTextureType; + FirstColor: String; + + SecondTexture: String; + SecondTyp: TTextureType; + SecondColor: String; + + ThirdTexture: String; + ThirdTyp: TTextureType; + ThirdColor: String; + end; + + + TextWinner: TThemeText; + end; + + TThemePartyWin = class(TThemeBasic) + TextScoreTeam1: TThemeText; + TextScoreTeam2: TThemeText; + TextScoreTeam3: TThemeText; + TextNameTeam1: TThemeText; + TextNameTeam2: TThemeText; + TextNameTeam3: TThemeText; + StaticTeam1: TThemeStatic; + StaticTeam1BG: TThemeStatic; + StaticTeam1Deco: TThemeStatic; + StaticTeam2: TThemeStatic; + StaticTeam2BG: TThemeStatic; + StaticTeam2Deco: TThemeStatic; + StaticTeam3: TThemeStatic; + StaticTeam3BG: TThemeStatic; + StaticTeam3Deco: TThemeStatic; + + TextWinner: TThemeText; + end; + + TThemePartyOptions = class(TThemeBasic) + SelectLevel: TThemeSelectSlide; + SelectPlayList: TThemeSelectSlide; + SelectPlayList2: TThemeSelectSlide; + SelectRounds: TThemeSelectSlide; + SelectTeams: TThemeSelectSlide; + SelectPlayers1: TThemeSelectSlide; + SelectPlayers2: TThemeSelectSlide; + SelectPlayers3: TThemeSelectSlide; + + {ButtonNext: TThemeButton; + ButtonPrev: TThemeButton;} + end; + + TThemePartyPlayer = class(TThemeBasic) + Team1Name: TThemeButton; + Player1Name: TThemeButton; + Player2Name: TThemeButton; + Player3Name: TThemeButton; + Player4Name: TThemeButton; + + Team2Name: TThemeButton; + Player5Name: TThemeButton; + Player6Name: TThemeButton; + Player7Name: TThemeButton; + Player8Name: TThemeButton; + + Team3Name: TThemeButton; + Player9Name: TThemeButton; + Player10Name: TThemeButton; + Player11Name: TThemeButton; + Player12Name: TThemeButton; + + {ButtonNext: TThemeButton; + ButtonPrev: TThemeButton;} + end; + + //Stats Screens + TThemeStatMain = class(TThemeBasic) + ButtonScores: TThemeButton; + ButtonSingers: TThemeButton; + ButtonSongs: TThemeButton; + ButtonBands: TThemeButton; + ButtonExit: TThemeButton; + + TextOverview: TThemeText; + end; + + TThemeStatDetail = class(TThemeBasic) + ButtonNext: TThemeButton; + ButtonPrev: TThemeButton; + ButtonReverse: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextPage: TThemeText; + TextList: AThemeText; + + Description: array[0..3] of string; + DescriptionR: array[0..3] of string; + FormatStr: array[0..3] of string; + PageStr: String; + end; + + //Playlist Translations + TThemePlaylist = record + CatText: string; + end; + + TTheme = class + private + {$IFDEF THEMESAVE} + ThemeIni: TIniFile; + {$ELSE} + ThemeIni: TMemIniFile; + {$ENDIF} + + LastThemeBasic: TThemeBasic; + procedure create_theme_objects(); + public + + Loading: TThemeLoading; + Main: TThemeMain; + Name: TThemeName; + Level: TThemeLevel; + Song: TThemeSong; + Sing: TThemeSing; + Score: TThemeScore; + Top5: TThemeTop5; + Options: TThemeOptions; + OptionsGame: TThemeOptionsGame; + OptionsGraphics: TThemeOptionsGraphics; + OptionsSound: TThemeOptionsSound; + OptionsLyrics: TThemeOptionsLyrics; + OptionsThemes: TThemeOptionsThemes; + OptionsRecord: TThemeOptionsRecord; + OptionsAdvanced: TThemeOptionsAdvanced; + //error and check popup + ErrorPopup: TThemeError; + CheckPopup: TThemeCheck; + //ScreenSong extensions + SongMenu: TThemeSongMenu; + SongJumpto: TThemeSongJumpTo; + //Party Screens: + PartyNewRound: TThemePartyNewRound; + PartyScore: TThemePartyScore; + PartyWin: TThemePartyWin; + PartyOptions: TThemePartyOptions; + PartyPlayer: TThemePartyPlayer; + + //Stats Screens: + StatMain: TThemeStatMain; + StatDetail: TThemeStatDetail; + + Playlist: TThemePlaylist; + + ILevel: array[0..2] of String; + + constructor Create(FileName: string); overload; // Initialize theme system + constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color + function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file + + procedure LoadColors; + + procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string); + procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); + procedure ThemeLoadText(var ThemeText: TThemeText; Name: string); + procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string); + procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); + procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); + procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil); + procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); + procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); + procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); + + procedure ThemeSave(FileName: string); + procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string); + procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); + procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); + procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); + procedure ThemeSaveText(ThemeText: TThemeText; Name: string); + procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string); + procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string); + + end; + + TColor = record + Name: string; + RGB: TRGB; + end; + +function ColorExists(Name: string): integer; +procedure LoadColor(var R, G, B: real; ColorName: string); +function GetSystemColor(Color: integer): TRGB; +function ColorSqrt(RGB: TRGB): TRGB; + +var + //Skin: TSkin; + Theme: TTheme; + Color: array of TColor; + +implementation + +uses + UCommon, + ULanguage, + USkins, + UIni; + +constructor TTheme.Create(FileName: string); +begin + Create(FileName, 0); +end; + +constructor TTheme.Create(FileName: string; Color: integer); +begin + inherited Create(); + + Loading := TThemeLoading.Create; + Main := TThemeMain.Create; + Name := TThemeName.Create; + Level := TThemeLevel.Create; + Song := TThemeSong.Create; + Sing := TThemeSing.Create; + Score := TThemeScore.Create; + Top5 := TThemeTop5.Create; + Options := TThemeOptions.Create; + OptionsGame := TThemeOptionsGame.Create; + OptionsGraphics := TThemeOptionsGraphics.Create; + OptionsSound := TThemeOptionsSound.Create; + OptionsLyrics := TThemeOptionsLyrics.Create; + OptionsThemes := TThemeOptionsThemes.Create; + OptionsRecord := TThemeOptionsRecord.Create; + OptionsAdvanced := TThemeOptionsAdvanced.Create; + + ErrorPopup := TThemeError.Create; + CheckPopup := TThemeCheck.Create; + + SongMenu := TThemeSongMenu.Create; + SongJumpto := TThemeSongJumpto.Create; + //Party Screens + PartyNewRound := TThemePartyNewRound.Create; + PartyWin := TThemePartyWin.Create; + PartyScore := TThemePartyScore.Create; + PartyOptions := TThemePartyOptions.Create; + PartyPlayer := TThemePartyPlayer.Create; + + //Stats Screens: + StatMain := TThemeStatMain.Create; + StatDetail := TThemeStatDetail.Create; + + LoadTheme(FileName, Color); + +end; + + +function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; +var + I: integer; + Path: string; +begin + Result := false; + + create_theme_objects(); + + Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); + + FileName := AdaptFilePaths( FileName ); + + if not FileExists(FileName) then + begin + Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme'); + end; + + if FileExists(FileName) then + begin + Result := true; + + {$IFDEF THEMESAVE} + ThemeIni := TIniFile.Create(FileName); + {$ELSE} + ThemeIni := TMemIniFile.Create(FileName); + {$ENDIF} + + if ThemeIni.ReadString('Theme', 'Name', '') <> '' then + begin + + {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar'); + Skin.SkinPath := 'Skins\' + Skin.SkinName + '\'; + Skin.SkinReg := false; } + Skin.Color := sColor; + + Skin.LoadSkin(ISkin[Ini.SkinNo]); + + LoadColors; + +// ThemeIni.Free; +// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini'); + + // Loading + ThemeLoadBasic(Loading, 'Loading'); + ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading'); + ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation'); + + // Main + ThemeLoadBasic(Main, 'Main'); + + ThemeLoadText(Main.TextDescription, 'MainTextDescription'); + ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); + ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo'); + ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti'); + ThemeLoadButton(Main.ButtonStat, 'MainButtonStats'); + ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor'); + ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions'); + ThemeLoadButton(Main.ButtonExit, 'MainButtonExit'); + + //Main Desc Text Translation Start + + Main.Description[0] := Language.Translate('SING_SING'); + Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); + Main.Description[1] := Language.Translate('SING_MULTI'); + Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC'); + Main.Description[2] := Language.Translate('SING_STATS'); + Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC'); + Main.Description[3] := Language.Translate('SING_EDITOR'); + Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC'); + Main.Description[4] := Language.Translate('SING_GAME_OPTIONS'); + Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC'); + Main.Description[5] := Language.Translate('SING_EXIT'); + Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC'); + + //Main Desc Text Translation End + + Main.TextDescription.Text := Main.Description[0]; + Main.TextDescriptionLong.Text := Main.DescriptionLong[0]; + + // Name + ThemeLoadBasic(Name, 'Name'); + + for I := 1 to 6 do + ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I)); + + // Level + ThemeLoadBasic(Level, 'Level'); + + ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy'); + ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium'); + ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard'); + + + // Song + ThemeLoadBasic(Song, 'Song'); + + ThemeLoadText(Song.TextArtist, 'SongTextArtist'); + ThemeLoadText(Song.TextTitle, 'SongTextTitle'); + ThemeLoadText(Song.TextNumber, 'SongTextNumber'); + + //Video Icon Mod + ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon'); + + //Show Cat in TopLeft Mod + ThemeLoadStatic(Song.StaticCat, 'SongStaticCat'); + ThemeLoadText(Song.TextCat, 'SongTextCat'); + + //Load Cover Pos and Size from Theme Mod + Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); + Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190); + Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); + Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); + Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4); + Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1); + //Load Cover Pos and Size from Theme Mod End + + //Load Equalizer Pos and Size from Theme Mod + Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1); + Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1); + Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1); + Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1); + Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0); + Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0); + Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1); + Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8); + Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8); + Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5); + Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12); + + //Color + I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black')); + if I >= 0 then begin + Song.Equalizer.ColR := Color[I].RGB.R; + Song.Equalizer.ColG := Color[I].RGB.G; + Song.Equalizer.ColB := Color[I].RGB.B; + end + else begin + Song.Equalizer.ColR := 0; + Song.Equalizer.ColG := 0; + Song.Equalizer.ColB := 0; + end; + //Load Equalizer Pos and Size from Theme Mod End + + //Party and Non Party specific Statics and Texts + ThemeLoadStatics (Song.StaticParty, 'SongStaticParty'); + ThemeLoadTexts (Song.TextParty, 'SongTextParty'); + + ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty'); + ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty'); + + //Party Mode + ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1'); + ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2'); + ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3'); + ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4'); + ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5'); + + ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1'); + ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2'); + ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3'); + ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4'); + ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5'); + + ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1'); + ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2'); + ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3'); + ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); + ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); + + + // Sing + ThemeLoadBasic(Sing, 'Sing'); + + //TimeBar mod + ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); + ThemeLoadText(Sing.TextTimeText, 'SingTimeText'); + //eoa TimeBar mod + + //moveable singbar mod + ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); + ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); + ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); + ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); + ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); + ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); + //eoa moveable singbar + + ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); + ThemeLoadText(Sing.TextP1, 'SingP1Text'); + ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); + ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); + //Added for ps3 skin + //This one is shown in 2/4P mode + //if it exists, otherwise the one Player equivaltents are used + if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then + begin + ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); + ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); + ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); + ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + end + else + begin + Sing.StaticP1TwoP := Sing.StaticP1; + Sing.TextP1TwoP := Sing.TextP1; + Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG; + Sing.TextP1TwoPScore := Sing.TextP1Score; + end; + + //This one is shown in 3/6P mode + //if it exists, otherwise the one Player equivaltents are used + if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then + begin + ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); + ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); + ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); + ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + end + else + begin + Sing.StaticP1ThreeP := Sing.StaticP1; + Sing.TextP1ThreeP := Sing.TextP1; + Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG; + Sing.TextP1ThreePScore := Sing.TextP1Score; + end; + //eoa + ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); + ThemeLoadText(Sing.TextP2R, 'SingP2RText'); + ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); + ThemeLoadText(Sing.TextP2M, 'SingP2MText'); + ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); + ThemeLoadText(Sing.TextP3R, 'SingP3RText'); + ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); + + //Line Bonus Texts + Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL'); + Sing.LineBonusText[1] := Sing.LineBonusText[0]; + Sing.LineBonusText[2] := Language.Translate('POPUP_POOR'); + Sing.LineBonusText[3] := Language.Translate('POPUP_BAD'); + Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD'); + Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD'); + Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT'); + Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME'); + Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT'); + + //PausePopup + ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic'); + + // Score + ThemeLoadBasic(Score, 'Score'); + + ThemeLoadText(Score.TextArtist, 'ScoreTextArtist'); + ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); + ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle'); + + for I := 1 to 6 do begin + ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); + ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text'); + + ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); + ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); + ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); + ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); + ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); + ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); + ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); + ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); + ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); + ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); + ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); + ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); + ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); + + ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I)); + end; + + // Top5 + ThemeLoadBasic(Top5, 'Top5'); + + ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); + ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); + ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); + ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); + ThemeLoadTexts(Top5.TextName, 'Top5TextName'); + ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); + + // Options + ThemeLoadBasic(Options, 'Options'); + + ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame'); + ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics'); + ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound'); + ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics'); + ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes'); + ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); + ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced'); + ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); + + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC'); + Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC'); + Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); + + ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); + Options.TextDescription.Text := Options.Description[0]; + + // Options Game + ThemeLoadBasic(OptionsGame, 'OptionsGame'); + + ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); + ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); + ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); + ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); + ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); + ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); + ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); + + // Options Graphics + ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); + + ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); + ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution'); + ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); + ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer'); + ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); + ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); + ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); + ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); + + // Options Sound + ThemeLoadBasic(OptionsSound, 'OptionsSound'); + + ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic'); + ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); + ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); + ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); + ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); + //Song Preview + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); + ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough'); + + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines'); + ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); + + // Options Themes + ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); + + ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); + ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); + ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor'); + ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); + + // Options Record + ThemeLoadBasic(OptionsRecord, 'OptionsRecord'); + + ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel'); + ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); + + //Options Advanced + ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); + + ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); + ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); + + //error and check popup + ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); + ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); + ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText'); + ThemeLoadBasic (CheckPopup, 'CheckPopup'); + ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1'); + ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2'); + ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText'); + + //Song Menu + ThemeLoadBasic (SongMenu, 'SongMenu'); + ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1'); + ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2'); + ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3'); + ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4'); + ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3'); + + ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu'); + + //Song Jumpto + ThemeLoadBasic (SongJumpto, 'SongJumpto'); + ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText'); + ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType'); + ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound'); + //Translations + SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1'); + SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2'); + SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3'); + SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND'); + SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND'); + SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT'); + + //Party Screens: + //Party NewRound + ThemeLoadBasic(PartyNewRound, 'PartyNewRound'); + + ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1'); + ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2'); + ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3'); + ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4'); + ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5'); + ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6'); + ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7'); + ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1'); + ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2'); + ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3'); + ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4'); + ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5'); + ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6'); + ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7'); + ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound'); + ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo'); + ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1'); + ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2'); + ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3'); + + ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1'); + ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2'); + ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3'); + ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4'); + ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5'); + ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6'); + ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7'); + + ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1'); + ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2'); + ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3'); + ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1'); + ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2'); + ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3'); + + ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players'); + ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players'); + ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players'); + + ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); + ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); + ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); + ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); + + //Party Score + ThemeLoadBasic(PartyScore, 'PartyScore'); + + ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1'); + ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2'); + ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3'); + ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1'); + ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2'); + ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3'); + + ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1'); + ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG'); + ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco'); + ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2'); + ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG'); + ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco'); + ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); + ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG'); + ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco'); + + //Load Party Score DecoTextures Object + PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1); + PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); + PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED); + PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); + + ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); + + //Party Win + ThemeLoadBasic(PartyWin, 'PartyWin'); + + ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1'); + ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2'); + ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3'); + ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1'); + ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2'); + ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3'); + + ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1'); + ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG'); + ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco'); + ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); + ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); + ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco'); + ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); + ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); + ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco'); + + ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); + + //Party Options + ThemeLoadBasic(PartyOptions, 'PartyOptions'); + ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2'); + ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds'); + ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2'); + ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3'); + + {ThemeLoadButton (ButtonNext, 'ButtonNext'); + ThemeLoadButton (ButtonPrev, 'ButtonPrev');} + + //Party Player + ThemeLoadBasic(PartyPlayer, 'PartyPlayer'); + ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name'); + ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name'); + ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name'); + ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name'); + ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name'); + + ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name'); + ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name'); + ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name'); + ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name'); + ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name'); + + ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name'); + ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name'); + ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name'); + ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name'); + ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name'); + + {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); + ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} + + ThemeLoadBasic(StatMain, 'StatMain'); + + ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores'); + ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers'); + ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs'); + ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands'); + ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit'); + + ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview'); + + + ThemeLoadBasic(StatDetail, 'StatDetail'); + + ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext'); + ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev'); + ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse'); + ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit'); + + ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription'); + ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage'); + ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList'); + + //Translate Texts + StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES'); + StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS'); + StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS'); + StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS'); + + StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED'); + StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED'); + StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED'); + StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED'); + + StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES'); + StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS'); + StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS'); + StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS'); + + StatDetail.PageStr := Language.Translate('STAT_PAGE'); + + //Playlist Translations + Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT'); + + //Level Translations + //Fill ILevel + ILevel[0] := Language.Translate('SING_EASY'); + ILevel[1] := Language.Translate('SING_MEDIUM'); + ILevel[2] := Language.Translate('SING_HARD'); + end; + + ThemeIni.Free; + end; +end; + +procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string); +begin + ThemeLoadBackground(Theme.Background, Name); + ThemeLoadTexts(Theme.Text, Name + 'Text'); + ThemeLoadStatics(Theme.Static, Name + 'Static'); + ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection'); + + LastThemeBasic := Theme; +end; + +procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); +begin + ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); +end; + +procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); +var + C: integer; +begin + ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0); + + ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0); + + ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0); + ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0); + ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); + + ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); + ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); + ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); + + ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); + + //Reflection + ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1; + ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); + + C := ColorExists(ThemeText.Color); + if C >= 0 then begin + ThemeText.ColR := Color[C].RGB.R; + ThemeText.ColG := Color[C].RGB.G; + ThemeText.ColB := Color[C].RGB.B; + end; +end; + +procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string); +var + T: integer; +begin + T := 1; + while ThemeIni.SectionExists(Name + IntToStr(T)) do begin + SetLength(ThemeText, T); + ThemeLoadText(ThemeText[T-1], Name + IntToStr(T)); + Inc(T); + end; +end; + +procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); +var + C: integer; +begin + ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', ''); + + ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0); + ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0); + + ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); + ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); + + C := ColorExists(ThemeStatic.Color); + if C >= 0 then begin + ThemeStatic.ColR := Color[C].RGB.R; + ThemeStatic.ColG := Color[C].RGB.G; + ThemeStatic.ColB := Color[C].RGB.B; + end; + + ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0); + ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0); + ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1); + ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1); + + //Reflection Mod + ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); +end; + +procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); +var + S: integer; +begin + S := 1; + while ThemeIni.SectionExists(Name + IntToStr(S)) do begin + SetLength(ThemeStatic, S); + ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S)); + Inc(S); + end; +end; + +//Button Collection Mod +procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); +var T: Integer; +begin + //Load Collection Style + ThemeLoadButton(Collection.Style, Name); + + //Load Other Attributes + T := ThemeIni.ReadInteger (Name, 'FirstChild', 0); + if (T > 0) And (T < 256) then + Collection.FirstChild := T + else + Collection.FirstChild := 0; +end; + +procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); +var + I: integer; +begin + I := 1; + while ThemeIni.SectionExists(Name + IntToStr(I)) do begin + SetLength(Collections, I); + ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I)); + Inc(I); + end; +end; +//End Button Collection Mod + +procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection); +var + C: integer; + TLen: integer; + T: integer; + Collections2: PAThemeButtonCollection; +begin + if not ThemeIni.SectionExists(Name) then + begin + ThemeButton.Visible := False; + exit; + end; + ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); + ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0); + ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0); + ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0); + ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0); + ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0); + ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); + + //Reflection Mod + ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); + + ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); + ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); + ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); + ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); + ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); + ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); + ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', ''); + C := ColorExists(ThemeButton.Color); + if C >= 0 then begin + ThemeButton.ColR := Color[C].RGB.R; + ThemeButton.ColG := Color[C].RGB.G; + ThemeButton.ColB := Color[C].RGB.B; + end; + + ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', ''); + C := ColorExists(ThemeButton.DColor); + if C >= 0 then begin + ThemeButton.DColR := Color[C].RGB.R; + ThemeButton.DColG := Color[C].RGB.G; + ThemeButton.DColB := Color[C].RGB.B; + end; + + ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1); + + //Fade Mod + ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H); + ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W); + + ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing); + + ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1); + ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1); + + + ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', ''); + ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0); + if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then + ThemeButton.FadeTexPos := 0; + + //Button Collection Mod + T := ThemeIni.ReadInteger(Name, 'Parent', 0); + + //Set Collections to Last Basic Collections if no valid Value + if (Collections = nil) then + Collections2 := @LastThemeBasic.ButtonCollection + else + Collections2 := Collections; + //Test for valid Value + if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then + begin + Inc(Collections2^[T-1].ChildCount); + ThemeButton.Parent := T; + end + else + ThemeButton.Parent := 0; + + //Read ButtonTexts + TLen := ThemeIni.ReadInteger(Name, 'Texts', 0); + SetLength(ThemeButton.Text, TLen); + for T := 1 to TLen do + ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T)); +end; + +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); +var + C: integer; +begin + ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + + ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); + ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); + + ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0); + + ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); + + ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10); + + ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); + + ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450); + + LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', '')); + ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', '')); + ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', '')); + ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); + LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); + ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); + + LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); + ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); + LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); + ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); + + LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', '')); + ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); + LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); + ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); +end; + +procedure TTheme.LoadColors; +var + SL: TStringList; + C: integer; + S: string; + Col: integer; + RGB: TRGB; +begin + SL := TStringList.Create; + ThemeIni.ReadSection('Colors', SL); + + // normal colors + SetLength(Color, SL.Count); + for C := 0 to SL.Count-1 do begin + Color[C].Name := SL.Strings[C]; + + S := ThemeIni.ReadString('Colors', SL.Strings[C], ''); + + Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; + Delete(S, 1, Pos(' ', S)); + + Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; + Delete(S, 1, Pos(' ', S)); + + Color[C].RGB.B := StrToInt(S)/255; + end; + + // skin color + SetLength(Color, SL.Count + 3); + C := SL.Count; + Color[C].Name := 'ColorDark'; + Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color); + + C := C+1; + Color[C].Name := 'ColorLight'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'ColorLightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // players colors + SetLength(Color, Length(Color)+18); + + // P1 + C := C+1; + Color[C].Name := 'P1Dark'; + Color[C].RGB := GetSystemColor(0); // 0 - blue + + C := C+1; + Color[C].Name := 'P1Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P1Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P2 + C := C+1; + Color[C].Name := 'P2Dark'; + Color[C].RGB := GetSystemColor(3); // 3 - red + + C := C+1; + Color[C].Name := 'P2Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P2Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P3 + C := C+1; + Color[C].Name := 'P3Dark'; + Color[C].RGB := GetSystemColor(1); // 1 - green + + C := C+1; + Color[C].Name := 'P3Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P3Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P4 + C := C+1; + Color[C].Name := 'P4Dark'; + Color[C].RGB := GetSystemColor(4); // 4 - brown + + C := C+1; + Color[C].Name := 'P4Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P4Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P5 + C := C+1; + Color[C].Name := 'P5Dark'; + Color[C].RGB := GetSystemColor(5); // 5 - yellow + + C := C+1; + Color[C].Name := 'P5Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P5Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + // P6 + C := C+1; + Color[C].Name := 'P6Dark'; + Color[C].RGB := GetSystemColor(6); // 6 - violet + + C := C+1; + Color[C].Name := 'P6Light'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + C := C+1; + Color[C].Name := 'P6Lightest'; + Color[C].RGB := ColorSqrt(Color[C-1].RGB); + + + SL.Free; +end; + +function ColorExists(Name: string): integer; +var + C: integer; +begin + Result := -1; + for C := 0 to High(Color) do + if Color[C].Name = Name then Result := C; +end; + +procedure LoadColor(var R, G, B: real; ColorName: string); +var + C: integer; +begin + C := ColorExists(ColorName); + if C >= 0 then begin + R := Color[C].RGB.R; + G := Color[C].RGB.G; + B := Color[C].RGB.B; + end; +end; + +function GetSystemColor(Color: integer): TRGB; +begin + case Color of + 0: begin + // blue + Result.R := 71/255; + Result.G := 175/255; + Result.B := 247/255; + end; + 1: begin + // green + Result.R := 63/255; + Result.G := 191/255; + Result.B := 63/255; + end; + 2: begin + // pink + Result.R := 255/255; +{ Result.G := 63/255; + Result.B := 192/255;} + Result.G := 175/255; + Result.B := 247/255; + end; + 3: begin + // red + Result.R := 247/255; + Result.G := 71/255; + Result.B := 71/255; + end; + //'Violet', 'Orange', 'Yellow', 'Brown', 'Black' + //New Theme-Color Patch + 4: begin + // violet + Result.R := 230/255; + Result.G := 63/255; + Result.B := 230/255; + end; + 5: begin + // orange + Result.R := 255/255; + Result.G := 144/255; + Result.B := 0; + end; + 6: begin + // yellow + Result.R := 230/255; + Result.G := 230/255; + Result.B := 95/255; + end; + 7: begin + // brown + Result.R := 192/255; + Result.G := 127/255; + Result.B := 31/255; + end; + 8: begin + // black + Result.R := 0; + Result.G := 0; + Result.B := 0; + end; + //New Theme-Color Patch End + + end; +end; + +function ColorSqrt(RGB: TRGB): TRGB; +begin + Result.R := sqrt(RGB.R); + Result.G := sqrt(RGB.G); + Result.B := sqrt(RGB.B); +end; + +procedure TTheme.ThemeSave(FileName: string); +var + I: integer; +begin + {$IFDEF THEMESAVE} + ThemeIni := TIniFile.Create(FileName); + {$ELSE} + ThemeIni := TMemIniFile.Create(FileName); + {$ENDIF} + + ThemeSaveBasic(Loading, 'Loading'); + + ThemeSaveBasic(Main, 'Main'); + ThemeSaveText(Main.TextDescription, 'MainTextDescription'); + ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); + ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo'); + ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor'); + ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions'); + ThemeSaveButton(Main.ButtonExit, 'MainButtonExit'); + + ThemeSaveBasic(Name, 'Name'); + for I := 1 to 6 do + ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I)); + + ThemeSaveBasic(Level, 'Level'); + ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy'); + ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium'); + ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard'); + + ThemeSaveBasic(Song, 'Song'); + ThemeSaveText(Song.TextArtist, 'SongTextArtist'); + ThemeSaveText(Song.TextTitle, 'SongTextTitle'); + ThemeSaveText(Song.TextNumber, 'SongTextNumber'); + + //Show CAt in Top Left Mod + ThemeSaveText(Song.TextCat, 'SongTextCat'); + ThemeSaveStatic(Song.StaticCat, 'SongStaticCat'); + + ThemeSaveBasic(Sing, 'Sing'); + + //TimeBar mod + ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); + ThemeSaveText(Sing.TextTimeText, 'SingTimeText'); + //eoa TimeBar mod + + ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); + ThemeSaveText(Sing.TextP1, 'SingP1Text'); + ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); + ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); + + //moveable singbar mod + ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); + ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); + ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); + ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); + ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); + ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); + //eoa moveable singbar + + //Added for ps3 skin + //This one is shown in 2/4P mode + ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); + ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText'); + ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); + ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); + + //This one is shown in 3/6P mode + ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); + ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText'); + ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); + ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); + //eoa + + ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); + ThemeSaveText(Sing.TextP2R, 'SingP2RText'); + ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); + ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore'); + + ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic'); + ThemeSaveText(Sing.TextP2M, 'SingP2MText'); + ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); + ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); + + ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); + ThemeSaveText(Sing.TextP3R, 'SingP3RText'); + ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); + ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore'); + + ThemeSaveBasic(Score, 'Score'); + ThemeSaveText(Score.TextArtist, 'ScoreTextArtist'); + ThemeSaveText(Score.TextTitle, 'ScoreTextTitle'); + + for I := 1 to 6 do begin + ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); + + ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); + ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); + ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); + ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); + ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); + ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); + ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); + ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); + ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); + ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); + + ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); + ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); + ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); + ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); + end; + + ThemeSaveBasic(Top5, 'Top5'); + ThemeSaveText(Top5.TextLevel, 'Top5TextLevel'); + ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); + ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber'); + ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber'); + ThemeSaveTexts(Top5.TextName, 'Top5TextName'); + ThemeSaveTexts(Top5.TextScore, 'Top5TextScore'); + + + ThemeIni.Free; +end; + +procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string); +begin + ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); + + ThemeSaveBackground(Theme.Background, Name + 'Background'); + ThemeSaveStatics(Theme.Static, Name + 'Static'); + ThemeSaveTexts(Theme.Text, Name + 'Text'); +end; + +procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); +begin + if ThemeBackground.Tex <> '' then + ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) + else begin + ThemeIni.EraseSection(Name); + end; +end; + +procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); +begin + ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y); + ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W); + ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H); + + ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex); + ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ)); + ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color); + + ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1); + ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1); + ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2); + ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2); +end; + +procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); +var + S: integer; +begin + for S := 0 to Length(ThemeStatic)-1 do + ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1)); + + ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1)); +end; + +procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string); +begin + ThemeIni.WriteInteger(Name, 'X', ThemeText.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y); + + ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font); + ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size); + ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align); + + ThemeIni.WriteString(Name, 'Text', ThemeText.Text); + ThemeIni.WriteString(Name, 'Color', ThemeText.Color); + + ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection); + ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing); +end; + +procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string); +var + T: integer; +begin + for T := 0 to Length(ThemeText)-1 do + ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1)); + + ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1)); +end; + +procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string); +var + T: integer; +begin + ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex); + ThemeIni.WriteInteger(Name, 'X', ThemeButton.X); + ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y); + ThemeIni.WriteInteger(Name, 'W', ThemeButton.W); + ThemeIni.WriteInteger(Name, 'H', ThemeButton.H); + ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ)); + ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text)); + + ThemeIni.WriteString(Name, 'Color', ThemeButton.Color); + +{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); + ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); + ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); + ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); + ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); + ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); + ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);} + +{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', '')); + if C >= 0 then begin + ThemeButton.ColR := Color[C].RGB.R; + ThemeButton.ColG := Color[C].RGB.G; + ThemeButton.ColB := Color[C].RGB.B; + end; + + C := ColorExists(ThemeIni.ReadString(Name, 'DColor', '')); + if C >= 0 then begin + ThemeButton.DColR := Color[C].RGB.R; + ThemeButton.DColG := Color[C].RGB.G; + ThemeButton.DColB := Color[C].RGB.B; + end;} + + for T := 0 to High(ThemeButton.Text) do + ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1)); +end; + +procedure TTheme.create_theme_objects(); +begin + freeandnil( Loading ); + Loading := TThemeLoading.Create; + + freeandnil( Main ); + Main := TThemeMain.Create; + + freeandnil( Name ); + Name := TThemeName.Create; + + freeandnil( Level ); + Level := TThemeLevel.Create; + + freeandnil( Song ); + Song := TThemeSong.Create; + + freeandnil( Sing ); + Sing := TThemeSing.Create; + + freeandnil( Score ); + Score := TThemeScore.Create; + + freeandnil( Top5 ); + Top5 := TThemeTop5.Create; + + freeandnil( Options ); + Options := TThemeOptions.Create; + + freeandnil( OptionsGame ); + OptionsGame := TThemeOptionsGame.Create; + + freeandnil( OptionsGraphics ); + OptionsGraphics := TThemeOptionsGraphics.Create; + + freeandnil( OptionsSound ); + OptionsSound := TThemeOptionsSound.Create; + + freeandnil( OptionsLyrics ); + OptionsLyrics := TThemeOptionsLyrics.Create; + + freeandnil( OptionsThemes ); + OptionsThemes := TThemeOptionsThemes.Create; + + freeandnil( OptionsRecord ); + OptionsRecord := TThemeOptionsRecord.Create; + + freeandnil( OptionsAdvanced ); + OptionsAdvanced := TThemeOptionsAdvanced.Create; + + + freeandnil( ErrorPopup ); + ErrorPopup := TThemeError.Create; + + freeandnil( CheckPopup ); + CheckPopup := TThemeCheck.Create; + + + freeandnil( SongMenu ); + SongMenu := TThemeSongMenu.Create; + + freeandnil( SongJumpto ); + SongJumpto := TThemeSongJumpto.Create; + + //Party Screens + freeandnil( PartyNewRound ); + PartyNewRound := TThemePartyNewRound.Create; + + freeandnil( PartyWin ); + PartyWin := TThemePartyWin.Create; + + freeandnil( PartyScore ); + PartyScore := TThemePartyScore.Create; + + freeandnil( PartyOptions ); + PartyOptions := TThemePartyOptions.Create; + + freeandnil( PartyPlayer ); + PartyPlayer := TThemePartyPlayer.Create; + + + //Stats Screens: + freeandnil( StatMain ); + StatMain := TThemeStatMain.Create; + + freeandnil( StatDetail ); + StatDetail := TThemeStatDetail.Create; + + end; + +end. diff --git a/src/base/UTime.pas b/src/base/UTime.pas new file mode 100644 index 00000000..f8ae91c4 --- /dev/null +++ b/src/base/UTime.pas @@ -0,0 +1,185 @@ +unit UTime; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + TTime = class + public + constructor Create; + function GetTime(): real; + end; + + TRelativeTimer = class + private + AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime + RelativeTimeOffset: real; + Paused: boolean; + TriggerMode: boolean; + public + constructor Create(TriggerMode: boolean = false); + procedure Pause(); + procedure Resume(); + function GetTime(): real; + function GetAndResetTime(): real; + procedure SetTime(Time: real; Trigger: boolean = true); + procedure Reset(); + end; + +procedure CountSkipTimeSet; +procedure CountSkipTime; +procedure CountMidTime; + +var + USTime : TTime; + VideoBGTimer: TRelativeTimer; + + TimeNew : int64; + TimeOld : int64; + TimeSkip : real; + TimeMid : real; + TimeMidTemp : int64; + +implementation + +uses + sdl, + ucommon; + +const + cSDLCorrectionRatio = 1000; + +(* +BEST Option now ( after discussion with whiteshark ) seems to be to use SDL +timer functions... + +SDL_delay +SDL_GetTicks +http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7 +*) + + +procedure CountSkipTimeSet; +begin + TimeNew := SDL_GetTicks(); +end; + +procedure CountSkipTime; +begin + TimeOld := TimeNew; + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; +end; + +procedure CountMidTime; +begin + TimeMidTemp := SDL_GetTicks(); + TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; +end; + +{** + * TTime + **} + +constructor TTime.Create; +begin + inherited; + CountSkipTimeSet; +end; + +function TTime.GetTime: real; +begin + Result := SDL_GetTicks() / cSDLCorrectionRatio; +end; + +{** + * TRelativeTimer + **} + +(* + * Creates a new timer. + * If TriggerMode is false (default), the timer + * will immediately begin with counting. + * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called + * for the first time. + *) +constructor TRelativeTimer.Create(TriggerMode: boolean); +begin + inherited Create(); + Self.TriggerMode := TriggerMode; + Reset(); + Paused := false; +end; + +procedure TRelativeTimer.Pause(); +begin + RelativeTimeOffset := GetTime(); + Paused := true; +end; + +procedure TRelativeTimer.Resume(); +begin + AbsoluteTime := SDL_GetTicks(); + Paused := false; +end; + +(* + * Returns the counter of the timer. + * If in TriggerMode it will return 0 and start the counter on the first call. + *) +function TRelativeTimer.GetTime: real; +begin + // initialize absolute time on first call in triggered mode + if (TriggerMode and (AbsoluteTime = 0)) then + begin + AbsoluteTime := SDL_GetTicks(); + Result := RelativeTimeOffset; + Exit; + end; + + if Paused then + Result := RelativeTimeOffset + else + Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio; +end; + +(* + * Returns the counter of the timer and resets the counter to 0 afterwards. + * Note: In TriggerMode the counter will not be stopped as with Reset(). + *) +function TRelativeTimer.GetAndResetTime(): real; +begin + Result := GetTime(); + SetTime(0); +end; + +(* + * Sets the timer to the given time. This will trigger in TriggerMode if + * Trigger is set to true. Otherwise the counter's state will not change. + *) +procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean); +begin + RelativeTimeOffset := Time; + if ((not TriggerMode) or Trigger) then + AbsoluteTime := SDL_GetTicks(); +end; + +(* + * Resets the counter of the timer to 0. + * If in TriggerMode the timer will not start counting until it is triggered again. + *) +procedure TRelativeTimer.Reset(); +begin + RelativeTimeOffset := 0; + if (TriggerMode) then + AbsoluteTime := 0 + else + AbsoluteTime := SDL_GetTicks(); +end; + +end. diff --git a/src/base/UVideo.pas b/src/base/UVideo.pas new file mode 100644 index 00000000..0ab1d350 --- /dev/null +++ b/src/base/UVideo.pas @@ -0,0 +1,828 @@ +{############################################################################## + # FFmpeg support for UltraStar deluxe # + # # + # Created by b1indy # + # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # + # with modifications by Jay Binks # + # # + # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # + # http://www.nabble.com/file/p11795857/mpegpas01.zip # + # # + ##############################################################################} + +unit UVideo; + +// uncomment if you want to see the debug stuff +{.$define DebugDisplay} +{.$define DebugFrames} +{.$define VideoBenchmark} +{.$define Info} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +// use BGR-format for accelerated colorspace conversion with swscale +{$IFDEF UseSWScale} + {$DEFINE PIXEL_FMT_BGR} +{$ENDIF} + +implementation + +uses + SDL, + textgl, + avcodec, + avformat, + avutil, + avio, + rational, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} + UMediaCore_FFmpeg, + math, + gl, + glext, + SysUtils, + UCommon, + UConfig, + ULog, + UMusic, + UGraphicClasses, + UGraphic; + +const +{$IFDEF PIXEL_FMT_BGR} + PIXEL_FMT_OPENGL = GL_BGR; + PIXEL_FMT_FFMPEG = PIX_FMT_BGR24; +{$ELSE} + PIXEL_FMT_OPENGL = GL_RGB; + PIXEL_FMT_FFMPEG = PIX_FMT_RGB24; +{$ENDIF} + +type + TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback ) + private + fVideoOpened, + fVideoPaused: Boolean; + + VideoStream: PAVStream; + VideoStreamIndex : Integer; + VideoFormatContext: PAVFormatContext; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + FrameBuffer: PByte; + + {$IFDEF UseSWScale} + SoftwareScaleContext: PSwsContext; + {$ENDIF} + + fVideoTex: GLuint; + TexWidth, TexHeight: Cardinal; + + VideoAspect: Real; + VideoTimeBase, VideoTime: Extended; + fLoopTime: Extended; + + EOF: boolean; + Loop: boolean; + + Initialized: boolean; + + procedure Reset(); + function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; + procedure SynchronizeVideo(Frame: PAVFrame; var pts: double); + public + function GetName: String; + + function Init(): boolean; + function Finalize: boolean; + + 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; + +var + FFmpegCore: TMediaCore_FFmpeg; + + +// These are called whenever we allocate a frame buffer. +// We use this to store the global_pts in a frame at the time it is allocated. +function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl; +var + pts: Pint64; + VideoPktPts: Pint64; +begin + Result := avcodec_default_get_buffer(CodecCtx, Frame); + VideoPktPts := CodecCtx^.opaque; + if (VideoPktPts <> nil) then + begin + // Note: we must copy the pts instead of passing a pointer, because the packet + // (and with it the pts) might change before a frame is returned by av_decode_video. + pts := av_malloc(sizeof(int64)); + pts^ := VideoPktPts^; + Frame^.opaque := pts; + end; +end; + +procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl; +begin + if (Frame <> nil) then + av_freep(@Frame^.opaque); + avcodec_default_release_buffer(CodecCtx, Frame); +end; + + +{*------------------------------------------------------------------------------ + * TVideoPlayback_ffmpeg + *------------------------------------------------------------------------------} + +function TVideoPlayback_FFmpeg.GetName: String; +begin + result := 'FFmpeg_Video'; +end; + +function TVideoPlayback_FFmpeg.Init(): boolean; +begin + Result := true; + + if (Initialized) then + Exit; + Initialized := true; + + FFmpegCore := TMediaCore_FFmpeg.GetInstance(); + + Reset(); + av_register_all(); + glGenTextures(1, PGLuint(@fVideoTex)); +end; + +function TVideoPlayback_FFmpeg.Finalize(): boolean; +begin + Close(); + glDeleteTextures(1, PGLuint(@fVideoTex)); + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.Reset(); +begin + // close previously opened video + Close(); + + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + VideoStream := nil; + VideoStreamIndex := -1; + + EOF := false; + + // TODO: do we really want this by default? + Loop := true; + fLoopTime := 0; +end; + +function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed +var + errnum: Integer; + AudioStreamIndex: integer; +begin + Result := false; + + Reset(); + + errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil); + if (errnum <> 0) then + begin + Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')'); + Exit; + end; + + // update video info + if (av_find_stream_info(VideoFormatContext) < 0) then + begin + Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); + + // find video stream + FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); + if (VideoStreamIndex < 0) then + begin + Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + VideoStream := VideoFormatContext^.streams[VideoStreamIndex]; + VideoCodecContext := VideoStream^.codec; + + VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id); + if (VideoCodec = nil) then + begin + Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // set debug options + VideoCodecContext^.debug_mv := 0; + VideoCodecContext^.debug := 0; + + // detect bug-workarounds automatically + VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT; + // error resilience strategy (careful/compliant/agressive/very_aggressive) + //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; + // allow non spec compliant speedup tricks. + //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST; + + // Note: avcodec_open() and avcodec_close() are not thread-safe and will + // fail if called concurrently by different threads. + FFmpegCore.LockAVCodec(); + try + errnum := avcodec_open(VideoCodecContext, VideoCodec); + finally + FFmpegCore.UnlockAVCodec(); + end; + if (errnum < 0) then + begin + Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // register custom callbacks for pts-determination + VideoCodecContext^.get_buffer := PtsGetBuffer; + VideoCodecContext^.release_buffer := PtsReleaseBuffer; + + {$ifdef DebugDisplay} + DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak + + sLineBreak + + ' Width = '+inttostr(VideoCodecContext^.width) + + ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak + + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' + + inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak + + ' 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(); + FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG, + VideoCodecContext^.width, VideoCodecContext^.height)); + + if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then + begin + Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT + // (otherwise video will be distorted if width/height is not a multiple of the alignment) + errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG, + VideoCodecContext^.width, VideoCodecContext^.height); + if (errnum < 0) then + begin + Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + + // calculate some information for video display + VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio); + if (VideoAspect = 0) then + VideoAspect := VideoCodecContext^.width / + VideoCodecContext^.height + else + VideoAspect := VideoAspect * VideoCodecContext^.width / + VideoCodecContext^.height; + + VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate); + + // hack to get reasonable timebase (for divx and others) + if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps + begin + VideoTimeBase := av_q2d(VideoStream^.r_frame_rate); + while (VideoTimeBase > 50) do + VideoTimeBase := VideoTimeBase/10; + VideoTimeBase := 1/VideoTimeBase; + end; + + Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open'); + Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open'); + + {$IFDEF UseSWScale} + // if available get a SWScale-context -> faster than the deprecated img_convert(). + // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555. + // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!! + // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its + // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up + // could be observed in comparison to the RGB versions. + SoftwareScaleContext := sws_getContext( + VideoCodecContext^.width, VideoCodecContext^.height, + integer(VideoCodecContext^.pix_fmt), + VideoCodecContext^.width, VideoCodecContext^.height, + integer(PIXEL_FMT_FFMPEG), + SWS_FAST_BILINEAR, nil, nil, nil); + if (SoftwareScaleContext = nil) then + begin + Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open'); + Close(); + Exit; + end; + {$ENDIF} + + TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); + TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); + + // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later. + // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height. + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0, + PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + + fVideoOpened := True; + + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.Close; +begin + if (FrameBuffer <> nil) then + av_free(FrameBuffer); + if (AVFrameRGB <> nil) then + av_free(AVFrameRGB); + if (AVFrame <> nil) then + av_free(AVFrame); + + AVFrame := nil; + AVFrameRGB := nil; + FrameBuffer := nil; + + if (VideoCodecContext <> nil) then + begin + // avcodec_close() is not thread-safe + FFmpegCore.LockAVCodec(); + try + avcodec_close(VideoCodecContext); + finally + FFmpegCore.UnlockAVCodec(); + end; + end; + + if (VideoFormatContext <> nil) then + av_close_input_file(VideoFormatContext); + + VideoCodecContext := nil; + VideoFormatContext := nil; + + fVideoOpened := False; +end; + +procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double); +var + FrameDelay: double; +begin + if (pts <> 0) then + begin + // if we have pts, set video clock to it + VideoTime := pts; + end else + begin + // if we aren't given a pts, set it to the clock + pts := VideoTime; + end; + // update the video clock + FrameDelay := av_q2d(VideoCodecContext^.time_base); + // if we are repeating a frame, adjust clock accordingly + FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5); + VideoTime := VideoTime + FrameDelay; +end; + +function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; +var + FrameFinished: Integer; + VideoPktPts: int64; + pbIOCtx: PByteIOContext; + errnum: integer; +begin + Result := false; + FrameFinished := 0; + + if EOF then + Exit; + + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished = 0) do + begin + errnum := av_read_frame(VideoFormatContext, AVPacket); + if (errnum < 0) then + begin + // failed to read a frame, check reason + + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} + pbIOCtx := VideoFormatContext^.pb; + {$ELSE} + pbIOCtx := @VideoFormatContext^.pb; + {$IFEND} + + // check for end-of-file (eof is not an error) + if (url_feof(pbIOCtx) <> 0) then + begin + EOF := true; + Exit; + end; + + // check for errors + if (url_ferror(pbIOCtx) <> 0) then + Exit; + + // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov) + // so we have to do it this way. + if ((VideoFormatContext^.file_size <> 0) and + (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then + begin + EOF := true; + Exit; + end; + + // no error -> wait for user input + SDL_Delay(100); + continue; + end; + + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index = VideoStreamIndex) then + begin + // save pts to be stored in pFrame in first call of PtsGetBuffer() + VideoPktPts := AVPacket.pts; + VideoCodecContext^.opaque := @VideoPktPts; + + // decode packet + avcodec_decode_video(VideoCodecContext, AVFrame, + frameFinished, AVPacket.data, AVPacket.size); + + // reset opaque data + VideoCodecContext^.opaque := nil; + + // update pts + if (AVPacket.dts <> AV_NOPTS_VALUE) then + begin + pts := AVPacket.dts; + end + else if ((AVFrame^.opaque <> nil) and + (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then + begin + pts := Pint64(AVFrame^.opaque)^; + end + else + begin + pts := 0; + end; + pts := pts * av_q2d(VideoStream^.time_base); + + // synchronize on each complete frame + if (frameFinished <> 0) then + SynchronizeVideo(AVFrame, pts); + end; + + // free the packet from av_read_frame + av_free_packet( @AVPacket ); + end; + + Result := true; +end; + +procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended); +var + AVPacket: TAVPacket; + errnum: Integer; + myTime: Extended; + TimeDifference: Extended; + DropFrameCount: Integer; + pts: double; + i: Integer; +const + FRAME_DROPCOUNT = 3; +begin + if not fVideoOpened then + Exit; + + if fVideoPaused then + Exit; + + // current time, relative to last loop (if any) + myTime := Time - fLoopTime; + // time since the last frame was returned + TimeDifference := myTime - VideoTime; + + {$IFDEF DebugDisplay} + DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // check if a new frame is needed + if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then + begin + {$ifdef DebugFrames} + // frame delay debug display + GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); + {$endif} + + {$IFDEF DebugDisplay} + DebugWriteln('not getting new frame' + sLineBreak + + 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + + 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // we do not need a new frame now + Exit; + end; + + // update video-time to the next frame + VideoTime := VideoTime + VideoTimeBase; + TimeDifference := myTime - VideoTime; + + // check if we have to skip frames + if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then + begin + {$IFDEF DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); + {$ENDIF} + {$IFDEF DebugDisplay} + DebugWriteln('skipping frames' + sLineBreak + + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); + {$endif} + + // update video-time + DropFrameCount := Trunc(TimeDifference / VideoTimeBase); + VideoTime := VideoTime + DropFrameCount*VideoTimeBase; + + // skip half of the frames, this is much smoother than to skip all at once + for i := 1 to DropFrameCount (*div 2*) do + DecodeFrame(AVPacket, pts); + end; + + {$IFDEF VideoBenchmark} + Log.BenchmarkStart(15); + {$ENDIF} + + if (not DecodeFrame(AVPacket, pts)) then + begin + if Loop then + begin + // Record the time we looped. This is used to keep the loops in time. otherwise they speed + SetPosition(0); + fLoopTime := Time; + end; + Exit; + end; + + // TODO: support for pan&scan + //if (AVFrame.pan_scan <> nil) then + //begin + // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height])); + //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), PIXEL_FMT_FFMPEG, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); + {$ENDIF} + + if (errnum < 0) then + begin + Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame'); + Exit; + end; + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(15); + Log.BenchmarkStart(16); + {$ENDIF} + + // TODO: data is not padded, so we will need to tell OpenGL. + // Or should we add padding with avpicture_fill? (check which one is faster) + //glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, + VideoCodecContext^.width, VideoCodecContext^.height, + PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); + + {$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00); + {$endif} + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(16); + Log.LogBenchmark('FFmpeg', 15); + Log.LogBenchmark('Texture', 16); + {$ENDIF} +end; + +procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer); +var + TexVideoRightPos, TexVideoLowerPos: Single; + ScreenLeftPos, ScreenRightPos: Single; + ScreenUpperPos, ScreenLowerPos: Single; + ScaledVideoWidth, ScaledVideoHeight: Single; + ScreenMidPosX, ScreenMidPosY: Single; + ScreenAspect: Single; +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; + + {$IFDEF VideoBenchmark} + Log.BenchmarkStart(15); + {$ENDIF} + + // TODO: add a SetAspectCorrectionMode() function so we can switch + // aspect correction. The screens video backgrounds look very ugly with aspect + // correction because of the white bars at the top and bottom. + + ScreenAspect := ScreenW / ScreenH; + ScaledVideoWidth := RenderW; + ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect; + + // Note: Scaling the width does not look good because the video might contain + // black borders at the top already + //ScaledVideoHeight := RenderH; + //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect; + + // center the video + ScreenMidPosX := RenderW/2; + ScreenMidPosY := RenderH/2; + ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2; + ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2; + ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2; + ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2; + // the video-texture contains empty borders because its width and height must be + // a power of 2. So we have to determine the texture coords of the video. + TexVideoRightPos := VideoCodecContext^.width / TexWidth; + TexVideoLowerPos := VideoCodecContext^.height / TexHeight; + + // we could use blending for brightness control, but do we need this? + glDisable(GL_BLEND); + + // TODO: disable other stuff like lightning, etc. + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glColor3f(1, 1, 1); + glBegin(GL_QUADS); + // upper-left coord + glTexCoord2f(0, 0); + glVertex2f(ScreenLeftPos, ScreenUpperPos); + // lower-left coord + glTexCoord2f(0, TexVideoLowerPos); + glVertex2f(ScreenLeftPos, ScreenLowerPos); + // lower-right coord + glTexCoord2f(TexVideoRightPos, TexVideoLowerPos); + glVertex2f(ScreenRightPos, ScreenLowerPos); + // upper-right coord + glTexCoord2f(TexVideoRightPos, 0); + glVertex2f(ScreenRightPos, ScreenUpperPos); + glEnd; + glDisable(GL_TEXTURE_2D); + + {$IFDEF VideoBenchmark} + Log.BenchmarkEnd(15); + Log.LogBenchmark('DrawGL', 15); + {$ENDIF} + + {$IFDEF Info} + if (fVideoSkipTime+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; + +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); +var + SeekFlags: integer; +begin + if not fVideoOpened then + Exit; + + if (Time < 0) then + Time := 0; + + // TODO: handle loop-times + //Time := Time mod VideoDuration; + + // backward seeking might fail without AVSEEK_FLAG_BACKWARD + SeekFlags := AVSEEK_FLAG_ANY; + if (Time < VideoTime) then + SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; + + VideoTime := Time; + EOF := false; + + if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then + begin + Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition'); + Exit; + end; + + avcodec_flush_buffers(VideoCodecContext); +end; + +function TVideoPlayback_FFmpeg.GetPosition: real; +begin + // TODO: return video-position in seconds + Result := VideoTime; +end; + +initialization + MediaManager.Add(TVideoPlayback_FFmpeg.Create); + +end. diff --git a/src/base/UVisualizer.pas b/src/base/UVisualizer.pas new file mode 100644 index 00000000..e2125201 --- /dev/null +++ b/src/base/UVisualizer.pas @@ -0,0 +1,442 @@ +unit UVisualizer; + +(* TODO: + * - fix video/visualizer switching + * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer, + * this will prevent plugins from messing up our render-context + * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()). + * - create a generic (C-compatible) interface for visualization plugins + * - create a visualization plugin manager + * - write a plugin for projectM in C/C++ (so we need no wrapper anymore) + *) + +{* Note: + * It would be easier to create a seperate Render-Context (RC) for projectM + * and switch to it when necessary. This can be achieved by pbuffers + * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension + * (fast and plattform-independent but not supported by older graphic-cards/drivers). + * + * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt + * + * To support as many cards as possible we will stick to the current dirty + * solution for now even if it is a pain to save/restore projectM's state due + * to bugs etc. + * + * This also restricts us to projectM. As other plug-ins might have different + * needs and bugs concerning the OpenGL state, USDX's state would probably be + * corrupted after the plug-in finshed drawing. + *} + +interface + +{$IFDEF FPC} + {$MODE DELPHI} +{$ENDIF} + +{$I switches.inc} + +uses + SDL, + UGraphicClasses, + textgl, + math, + gl, + SysUtils, + UIni, + projectM, + UMusic; + +implementation + +uses + UGraphic, + UMain, + UConfig, + ULog; + +{$IF PROJECTM_VERSION < 1000000} // < 1.0 +// Initialization data used on projectM 0.9x creation. +// Since projectM 1.0 this data is passed via the config-file. +const + meshX = 32; + meshY = 24; + fps = 30; + textureSize = 512; +{$IFEND} + +type + TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) + private + pm: TProjectM; + ProjectMPath : string; + Initialized: boolean; + + VisualizerStarted: boolean; + VisualizerPaused: boolean; + + VisualTex: GLuint; + PCMData: TPCMData; + RndPCMcount: integer; + + projMatrix: array[0..3, 0..3] of GLdouble; + texMatrix: array[0..3, 0..3] of GLdouble; + + procedure VisualizerStart; + procedure VisualizerStop; + + procedure VisualizerTogglePause; + + function GetRandomPCMData(var data: TPCMData): Cardinal; + + procedure SaveOpenGLState(); + procedure RestoreOpenGLState(); + + public + function GetName: String; + + function Init(): boolean; + function Finalize(): boolean; + + 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; + + +function TVideoPlayback_ProjectM.GetName: String; +begin + Result := 'ProjectM'; +end; + +function TVideoPlayback_ProjectM.Init(): boolean; +begin + Result := true; + + if (Initialized) then + Exit; + Initialized := true; + + RndPCMcount := 0; + + ProjectMPath := ProjectM_DataDir + PathDelim; + + VisualizerStarted := False; + VisualizerPaused := False; + + {$IFDEF UseTexture} + glGenTextures(1, PglUint(@VisualTex)); + glBindTexture(GL_TEXTURE_2D, VisualTex); + + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + {$ENDIF} +end; + +function TVideoPlayback_ProjectM.Finalize(): boolean; +begin + VisualizerStop(); + {$IFDEF UseTexture} + glDeleteTextures(1, PglUint(@VisualTex)); + {$ENDIF} + Result := true; +end; + +function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed +begin + Result := false; +end; + +procedure TVideoPlayback_ProjectM.Close; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.Play; +begin + VisualizerStart(); +end; + +procedure TVideoPlayback_ProjectM.Pause; +begin + VisualizerTogglePause(); +end; + +procedure TVideoPlayback_ProjectM.Stop; +begin + VisualizerStop(); +end; + +procedure TVideoPlayback_ProjectM.SetPosition(Time: real); +begin + if assigned(pm) then + pm.RandomPreset(); +end; + +function TVideoPlayback_ProjectM.GetPosition: real; +begin + Result := 0; +end; + +{** + * Saves the current OpenGL state. + * This is necessary to prevent projectM from corrupting USDX's current + * OpenGL state. + * + * The following steps are performed: + * - All attributes are pushed to the attribute-stack + * - Projection-/Texture-matrices are saved + * - Modelview-matrix is pushed to the Modelview-stack + * - the OpenGL error-state (glGetError) is cleared + *} +procedure TVideoPlayback_ProjectM.SaveOpenGLState(); +begin + // save all OpenGL state-machine attributes + glPushAttrib(GL_ALL_ATTRIB_BITS); + + // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks. + // OpenGL specifies the depth of those stacks to be at least 2 but projectM + // already uses 2 stack-entries so overflows might be possible on older hardware. + // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can + // use glPushMatrix() for this stack. + + // save projection-matrix + glMatrixMode(GL_PROJECTION); + glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix); + {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 + // bugfix: projection-matrix is popped without being pushed first + glPushMatrix(); + {$IFEND} + + // save texture-matrix + glMatrixMode(GL_TEXTURE); + glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix); + + // save modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 + // bugfix: modelview-matrix is popped without being pushed first + glPushMatrix(); + {$IFEND} + + // reset OpenGL error-state + glGetError(); +end; + +{** + * Restores the OpenGL state saved by SaveOpenGLState() + * and resets the error-state. + *} +procedure TVideoPlayback_ProjectM.RestoreOpenGLState(); +begin + // reset OpenGL error-state + glGetError(); + + // restore projection-matrix + glMatrixMode(GL_PROJECTION); + glLoadMatrixd(@projMatrix); + + // restore texture-matrix + glMatrixMode(GL_TEXTURE); + glLoadMatrixd(@texMatrix); + + // restore modelview-matrix + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + + // restore all OpenGL state-machine attributes + glPopAttrib(); +end; + +procedure TVideoPlayback_ProjectM.VisualizerStart; +begin + if VisualizerStarted then + Exit; + + // the OpenGL state must be saved before + SaveOpenGLState(); + try + + try + {$IF PROJECTM_VERSION >= 1000000} // >= 1.0 + pm := TProjectM.Create(ProjectMPath + 'config.inp'); + {$ELSE} + pm := TProjectM.Create( + meshX, meshY, fps, textureSize, ScreenW, ScreenH, + ProjectMPath + 'presets', ProjectMPath + 'fonts'); + {$IFEND} + except on E: Exception do + begin + // Create() might fail if the config-file is not found + Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart'); + Exit; + end; + end; + + // initialize OpenGL + pm.ResetGL(ScreenW, ScreenH); + // skip projectM default-preset + pm.RandomPreset(); + // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension. + // Unfortunately it does NOT reset the framebuffer-context after + // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for + // a manual reset or TProjectM.RenderFrame() must be called. + // We use the latter so we do not need to load the FBO extension in USDX. + pm.RenderFrame(); + + VisualizerStarted := True; + finally + RestoreOpenGLState(); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerStop; +begin + if VisualizerStarted then + begin + VisualizerStarted := False; + FreeAndNil(pm); + end; +end; + +procedure TVideoPlayback_ProjectM.VisualizerTogglePause; +begin + VisualizerPaused := not VisualizerPaused; +end; + +procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); +var + nSamples: cardinal; + stackDepth: Integer; +begin + if not VisualizerStarted then + Exit; + + if VisualizerPaused then + Exit; + + // get audio data + nSamples := AudioPlayback.GetPCMData(PcmData); + + // generate some data if non is available + if (nSamples = 0) then + nSamples := GetRandomPCMData(PcmData); + + // send audio-data to projectM + if (nSamples > 0) then + pm.AddPCM16Data(PSmallInt(@PcmData), nSamples); + + // store OpenGL state (might be messed up otherwise) + SaveOpenGLState(); + try + // setup projectM's OpenGL state + pm.ResetGL(ScreenW, ScreenH); + + // let projectM render a frame + pm.RenderFrame(); + + {$IFDEF UseTexture} + glBindTexture(GL_TEXTURE_2D, VisualTex); + glFlush(); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); + {$ENDIF} + finally + // restore USDX OpenGL state + RestoreOpenGLState(); + end; + + // discard projectM's depth buffer information (avoid overlay) + glClear(GL_DEPTH_BUFFER_BIT); +end; + +{** + * Draws the current frame to screen. + * TODO: this is not used yet. Data is directly drawn on GetFrame(). + *} +procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); +begin + {$IFDEF UseTexture} + // have a nice black background to draw on + 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 VisualizerStarted then + Exit; + + // setup display + glMatrixMode(GL_PROJECTION); + glPushMatrix(); + glLoadIdentity(); + gluOrtho2D(0, 1, 0, 1); + glMatrixMode(GL_MODELVIEW); + glPushMatrix(); + glLoadIdentity(); + + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); + glBindTexture(GL_TEXTURE_2D, VisualTex); + glColor4f(1, 1, 1, 1); + + // draw projectM frame + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(0, 0); + glTexCoord2f(1, 0); glVertex2f(1, 0); + glTexCoord2f(1, 1); glVertex2f(1, 1); + glTexCoord2f(0, 1); glVertex2f(0, 1); + glEnd(); + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + + // restore state + glMatrixMode(GL_PROJECTION); + glPopMatrix(); + glMatrixMode(GL_MODELVIEW); + glPopMatrix(); + {$ENDIF} +end; + +{** + * Produces random "sound"-data in case no audio-data is available. + * Otherwise the visualization will look rather boring. + *} +function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; +var + i: integer; +begin + // Produce some fake PCM data + if (RndPCMcount mod 500 = 0) then + begin + FillChar(data, SizeOf(TPCMData), 0); + end + else + begin + for i := 0 to 511 do + begin + data[i][0] := Random(High(Word)+1); + data[i][1] := Random(High(Word)+1); + end; + end; + Inc(RndPCMcount); + Result := 512; +end; + + +initialization + MediaManager.Add(TVideoPlayback_ProjectM.Create); + +end. diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas new file mode 100644 index 00000000..1a1fe6bc --- /dev/null +++ b/src/base/UXMLSong.pas @@ -0,0 +1,573 @@ +unit UXMLSong; + +interface +uses Classes; + +type + TNote = record + Start: Cardinal; + Duration: Cardinal; + Tone: Integer; + NoteTyp: Byte; + Lyric: String; + end; + ANote = Array of TNote; + + TSentence = record + Singer: Byte; + Duration: Cardinal; + Notes: ANote; + end; + ASentence = Array of TSentence; + + TSongInfo = Record + ID: Cardinal; + DualChannel: Boolean; + Header: Record + Artist: String; + Title: String; + Gap: Cardinal; + BPM: Real; + Resolution: Byte; + Edition: String; + Genre: String; + Year: String; + Language: String; + end; + CountSentences: Cardinal; + Sentences: ASentence; + end; + + TParser = class + private + SSFile: TStringList; + + ParserState: Byte; + CurPosinSong: Cardinal; //Cur Beat Pos in the Song + CurDuettSinger: Byte; //Who sings this Part? + BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space) + FirstNote: Boolean; //Is this the First Note found? For Gap calculating + + Function ParseLine(Line: String): Boolean; + public + SongInfo: TSongInfo; + ErrorMessage: String; + Edition: String; + SingstarVersion: String; + + Settings: Record + DashReplacement: Char; + end; + + Constructor Create; + + Function ParseConfigforEdition(const Filename: String): String; + + Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only + Function ParseSong (const Filename: String): Boolean; //Parse whole Song + end; + +const + PS_None = 0; + PS_Melody = 1; + PS_Sentence = 2; + + NT_Normal = 1; + NT_Freestyle = 0; + NT_Golden = 2; + + DS_Player1 = 1; + DS_Player2 = 2; + DS_Both = 3; + +implementation +uses SysUtils, StrUtils; + +Constructor TParser.Create; +begin + inherited Create; + ErrorMessage := ''; + + DecimalSeparator := '.'; +end; + +Function TParser.ParseSong (const Filename: String): Boolean; +var I: Integer; +begin + Result := False; + if FileExists(Filename) then + begin + SSFile := TStringList.Create; + + try + ErrorMessage := 'Can''t open melody.xml file'; + SSFile.LoadFromFile(Filename); + ErrorMessage := ''; + Result := True; + I := 0; + + SongInfo.CountSentences := 0; + CurDuettSinger := DS_Both; //Both is Singstar Standard + CurPosinSong := 0; //Start at Pos 0 + BindLyrics := True; //Dont start with Space + FirstNote := True; //First Note found should be the First Note ;) + + SongInfo.Header.Language := ''; + SongInfo.Header.Edition := Edition; + SongInfo.DualChannel := False; + + ParserState := PS_None; + + SetLength(SongInfo.Sentences, 0); + + While Result And (I < SSFile.Count) do + begin + Result := ParseLine(SSFile.Strings[I]); + + Inc(I); + end; + + finally + SSFile.Free; + end; + end; +end; + +Function TParser.ParseSongHeader (const Filename: String): Boolean; +var I: Integer; +begin + Result := False; + if FileExists(Filename) then + begin + SSFile := TStringList.Create; + SSFile.Clear; + + try + SSFile.LoadFromFile(Filename); + + If (SSFile.Count > 0) then + begin + Result := True; + I := 0; + + SongInfo.CountSentences := 0; + CurDuettSinger := DS_Both; //Both is Singstar Standard + CurPosinSong := 0; //Start at Pos 0 + BindLyrics := True; //Dont start with Space + FirstNote := True; //First Note found should be the First Note ;) + + SongInfo.ID := 0; + SongInfo.Header.Language := ''; + SongInfo.Header.Edition := Edition; + SongInfo.DualChannel := False; + ParserState := PS_None; + + While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do + begin + Result := ParseLine(SSFile.Strings[I]); + + Inc(I); + end; + end + else + ErrorMessage := 'Can''t open melody.xml file'; + + finally + SSFile.Free; + end; + end + else + ErrorMessage := 'Can''t find melody.xml file'; +end; + +Function TParser.ParseLine(Line: String): Boolean; +var + Tag: String; + Values: String; + AValues: Array of Record + Name: String; + Value: String; + end; + I, J, K: Integer; + Duration, Tone: Integer; + Lyric: String; + NoteType: Byte; + + Procedure MakeValuesArray; + var Len, Pos, State, StateChange: Integer; + begin + Len := -1; + SetLength(AValues, Len + 1); + + Pos := 1; + State := 0; + While (Pos <= Length(Values)) AND (Pos <> 0) do + begin + Case State of + + 0: begin //Search for ValueName + If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then + begin + //Found Something + State := 1; //State search for '=' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('=', Values, Pos + 1); + end + else Inc(Pos); //When nothing found then go to next char + end; + + 1: begin //Search for Equal Mark + //Add New Value + Inc(Len); + SetLength(AValues, Len + 1); + + AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange)); + + + State := 2; //Now Search for starting '"' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('"', Values, Pos + 1); + end; + + 2: begin //Search for starting '"' or ' ' <- End if there was no " + If (Values[Pos] = '"') then + begin //Found starting '"' + State := 3; //Now Search for ending '"' + StateChange := Pos; //Save Pos of Change + Pos := PosEx('"', Values, Pos + 1); + end + else If (Values[Pos] = ' ') then //Found ending Space + begin + //Save Value to Array + AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); + + //Search for next Valuename + State := 0; + StateChange := Pos; + Inc(Pos); + end; + end; + + 3: begin //Search for ending '"' + //Save Value to Array + AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); + + //Search for next Valuename + State := 0; + StateChange := Pos; + Inc(Pos); + end; + end; + + If (State >= 2) then + begin //Save Last Value + AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange); + end; + end; + end; +begin + Result := True; + + Line := Trim(Line); + If (Length(Line) > 0) then + begin + I := Pos('<', Line); + J := PosEx(' ', Line, I+1); + K := PosEx('>', Line, I+1); + + If (J = 0) then J := K + Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator + Tag := UpperCase(copy(Line, I + 1, J - I - 1)); + Values := copy(Line, J + 1, K - J - 1); + + Case ParserState of + PS_None: begin//Search for Melody Tag + If (Tag = 'MELODY') then + begin + Inc(SongInfo.ID); //Inc SongID when header Information is added + MakeValuesArray; + For I := 0 to High(AValues) do + begin + If (AValues[I].Name = 'TEMPO') then + begin + SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0); + If (SongInfo.Header.BPM <= 0) then + begin + Result := False; + ErrorMessage := 'Can''t read BPM from Song'; + end; + end + + Else If (AValues[I].Name = 'RESOLUTION') then + begin + AValues[I].Value := Uppercase(AValues[I].Value); + //Ultrastar Resolution is "how often a Beat is split / 4" + If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then + SongInfo.Header.Resolution := 64 div 4 + Else If (AValues[I].Value = 'DEMISEMIQUAVER') then + SongInfo.Header.Resolution := 32 div 4 + Else If (AValues[I].Value = 'SEMIQUAVER') then + SongInfo.Header.Resolution := 16 div 4 + Else If (AValues[I].Value = 'QUAVER') then + SongInfo.Header.Resolution := 8 div 4 + Else If (AValues[I].Value = 'CROTCHET') then + SongInfo.Header.Resolution := 4 div 4 + Else + begin //Can't understand teh Resolution :/ + Result := False; + ErrorMessage := 'Can''t read Resolution from Song'; + end; + end + + Else If (AValues[I].Name = 'GENRE') then + begin + SongInfo.Header.Genre := AValues[I].Value; + end + + Else If (AValues[I].Name = 'YEAR') then + begin + SongInfo.Header.Year := AValues[I].Value; + end + + Else If (AValues[I].Name = 'VERSION') then + begin + SingstarVersion := AValues[I].Value; + end; + end; + + ParserState := PS_Melody; //In Melody Tag + end; + end; + + + PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody + If (Tag = 'SENTENCE') then + begin + ParserState := PS_Sentence; //Parse in a Sentence Tag now + + //Increase SentenceCount + Inc(SongInfo.CountSentences); + + BindLyrics := True; //Don't let Txts Begin w/ Space + + //Search for Duett Singer Info + MakeValuesArray; + For I := 0 to High(AValues) do + If (AValues[I].Name = 'SINGER') then + begin + AValues[I].Value := Uppercase(AValues[I].Value); + If (AValues[I].Value = 'SOLO 1') then + CurDuettSinger := DS_Player1 + Else If (AValues[I].Value = 'SOLO 2') then + CurDuettSinger := DS_Player2 + Else + CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both + end; + end + + Else If (Tag = '!--') then + begin //Comment, this may be Artist or Title Info + I := Pos(':', Values); //Search for Delimiter + + If (I <> 0) then //If Found check for Title or Artist + begin + //Copy Title or Artist Tag to Tag String + Tag := Uppercase(Trim(Copy(Values, 1, I - 1))); + + If (Tag = 'ARTIST') then + begin + SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + Inc(SongInfo.ID); //Inc SongID when header Information is added + end + Else If (Tag = 'TITLE') then + begin + SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + Inc(SongInfo.ID); //Inc SongID when header Information is added + end; + end; + end + + //Parsing for weird "Die toten Hosen" Tags + Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then + begin //Comment, with Artist Info + I := Pos(':', Values); //Search for Delimiter + + Inc(SongInfo.ID); //Inc SongID when header Information is added + + SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + end + + Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then + begin //Comment, with Artist Info + I := Pos(':', Values); //Search for Delimiter + + Inc(SongInfo.ID); //Inc SongID when header Information is added + + SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); + end + + Else If (Tag = '/MELODY') then + begin + ParserState := PS_None; + Exit; //Stop Parsing, Melody iTag ended + end + end; + + + PS_Sentence: begin //Search for Notes or eo Sentence + If (Tag = 'NOTE') then + begin //Found Note + //Get Values + MakeValuesArray; + + NoteType := NT_Normal; + For I := 0 to High(AValues) do + begin + If (AValues[I].Name = 'DURATION') then + begin + Duration := StrtoIntDef(AValues[I].Value, -1); + If (Duration < 0) then + begin + Result := False; + ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"'; + Exit; + end; + end + Else If (AValues[I].Name = 'MIDINOTE') then + begin + Tone := StrtoIntDef(AValues[I].Value, 0); + end + Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then + begin + NoteType := NT_Golden; + end + Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then + begin + NoteType := NT_Freestyle; + end + Else If (AValues[I].Name = 'LYRIC') then + begin + Lyric := AValues[I].Value; + + If (Length(Lyric) > 0) then + begin + If (Lyric = '-') then + Lyric[1] := Settings.DashReplacement; + + If (not BindLyrics) then + Lyric := ' ' + Lyric; + + + If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then + begin //Between this and the next Lyric should be no space + BindLyrics := True; + SetLength(Lyric, Length(Lyric) - 2); + end + else + BindLyrics := False; //There should be a Space + end; + end; + end; + + //Add Note + I := SongInfo.CountSentences - 1; + + If (Length(Lyric) > 0) then + begin //Real note, no rest + //First Note of Sentence + If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then + begin + SetLength(SongInfo.Sentences, SongInfo.CountSentences); + SetLength(SongInfo.Sentences[I].Notes, 0); + end; + + //First Note of Song -> Generate Gap + If (FirstNote) then + begin + //Calculate Gap + If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then + SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000) + Else + begin + Result := False; + ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.'; + Exit; + end; + + CurPosinSong := 0; //Start at 0, because Gap goes until here + Inc(SongInfo.ID); //Add Header Value therefore Inc + FirstNote := False; + end; + + J := Length(SongInfo.Sentences[I].Notes); + SetLength(SongInfo.Sentences[I].Notes, J + 1); + SongInfo.Sentences[I].Notes[J].Start := CurPosinSong; + SongInfo.Sentences[I].Notes[J].Duration := Duration; + SongInfo.Sentences[I].Notes[J].Tone := Tone; + SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType; + SongInfo.Sentences[I].Notes[J].Lyric := Lyric; + + //Inc Pos in Song + Inc(CurPosInSong, Duration); + end + else + begin + //just change pos in Song + Inc(CurPosInSong, Duration); + end; + + + end + Else If (Tag = '/SENTENCE') then + begin //End of Sentence Tag + ParserState := PS_Melody; + + //Delete Sentence if no Note is Added + If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then + begin + SongInfo.CountSentences := Length(SongInfo.Sentences); + end; + end; + end; + end; + + end + else //Empty Line -> parsed succesful ;) + Result := true; +end; + +Function TParser.ParseConfigforEdition(const Filename: String): String; +var + txt: TStringlist; + I: Integer; + J, K: Integer; + S: String; +begin + Result := ''; + txt := TStringlist.Create; + try + txt.LoadFromFile(Filename); + + For I := 0 to txt.Count-1 do + begin + S := Trim(txt.Strings[I]); + J := Pos('', S); + + If (J <> 0) then + begin + Inc(J, 14); + K := Pos('', S); + If (K nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) + function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) + + end; + + {********************* + TtehPlugins + Class Represents the Plugins in Module Chain. + It Calls the Plugins Procs and Funcs + *********************} + TtehPlugins = class (TCoreModule) + private + PluginLoader: PPluginLoader; + public + //TCoreModule methods to inherit + constructor Create; override; + + procedure Info(const pInfo: PModuleInfo); override; + function Load: Boolean; override; + function Init: Boolean; override; + procedure DeInit; override; + end; + +const + {$IFDEF MSWINDOWS} + PluginFileExtension = '.dll'; + {$ENDIF} + {$IFDEF LINUX} + PluginFileExtension = '.so'; + {$ENDIF} + {$IFDEF DARWIN} + PluginFileExtension = '.dylib'; + {$ENDIF} + +implementation + +uses + UCore, + UPluginInterface, +{$IFDEF MSWINDOWS} + windows, +{$ELSE} + dynlibs, +{$ENDIF} + UMain, + SysUtils; + +{********************* + TPluginLoader + Implentation +*********************} + +//------------- +// function that gives some Infos about the Module to the Core +//------------- +procedure TPluginLoader.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPluginLoader'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Searches for Plugins, loads and unloads them'; +end; + +//------------- +// Just the Constructor +//------------- +constructor TPluginLoader.Create; +begin + inherited; + + //Init PluginInterface + //Using Methods from UPluginInterface + PluginInterface.CreateHookableEvent := CreateHookableEvent; + PluginInterface.DestroyHookableEvent := DestroyHookableEvent; + PluginInterface.NotivyEventHooks := NotivyEventHooks; + PluginInterface.HookEvent := HookEvent; + PluginInterface.UnHookEvent := UnHookEvent; + PluginInterface.EventExists := EventExists; + + PluginInterface.CreateService := @CreateService; + PluginInterface.DestroyService := DestroyService; + PluginInterface.CallService := CallService; + PluginInterface.ServiceExists := ServiceExists; + + //UnSet Private Var + LoadingProcessFinished := False; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +function TPluginLoader.Load: Boolean; +begin + Result := True; + + try + //Start Searching for Plugins + BrowseDir(PluginPath); + except + Result := False; + Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader')); + end; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +function TPluginLoader.Init: Boolean; +begin + //Just set Prvate Var to true. + LoadingProcessFinished := True; + Result := True; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +procedure TPluginLoader.DeInit; +var + I: integer; +begin + //Force DeInit + //If some Plugins aren't DeInited for some Reason o0 + for I := 0 to High(Plugins) do + begin + if (Plugins[I].State < 4) then + FreePlugin(I); + end; + + //Nothing to do here. Core will remove the Hooks +end; + +//------------- +//Is Called if this Module will be unloaded and has been created +//Should be used to Free Memory +//------------- +Destructor TPluginLoader.Destroy; +begin + //Just save some Memory if it wasn't done now.. + SetLength(Plugins, 0); + inherited; +end; + +//-------------- +// Browses the Path at _Path_ for Plugins +//-------------- +procedure TPluginLoader.BrowseDir(Path: String); +var + SR: TSearchRec; +begin + //Search for other Dirs to Browse + if FindFirst(Path + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Path + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; + FindClose(SR); + + //Search for Plugins at Path + if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then + begin + repeat + AddPlugin(Path + SR.Name); + until FindNext(SR) <> 0; + end; + FindClose(SR); +end; + +//-------------- +// If Plugin Exists: Index of Plugin, else -1 +//-------------- +function TPluginLoader.PluginExists(Name: String): integer; +var + I: integer; +begin + Result := -1; + + if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then + begin + for I := 0 to High(Plugins) do + if (Plugins[I].Info.Name = Name) then + begin //Found the Plugin + Result := I; + Break; + end; + end; +end; + +//-------------- +// Adds Plugin to the Array +//-------------- +procedure TPluginLoader.AddPlugin(Filename: String); +var + hLib: THandle; + PInfo: Proc_PluginInfo; + Info: TUS_PluginInfo; + PluginID: integer; +begin + if (FileExists(Filename)) then + begin //Load Libary + hLib := LoadLibrary(PChar(Filename)); + if (hLib <> 0) then + begin //Try to get Address of the Info Proc + PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); + if (@PInfo <> nil) then + begin + Info.cbSize := SizeOf(TUS_PluginInfo); + + try //Call Info Proc + PInfo(@Info); + except + Info.Name := ''; + Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader')); + end; + + //Is Name set ? + if (Trim(Info.Name) <> '') then + begin + PluginID := PluginExists(Info.Name); + + if (PluginID > 0) and (Plugins[PluginID].State >=4) then + PluginID := -1; + + if (PluginID = -1) then + begin + //Add new item to array + PluginID := Length(Plugins); + SetLength(Plugins, PluginID + 1); + + //Fill with Info: + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + Plugins[PluginID].State := 255; + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + + //Emulate loading process if this Plugin is loaded to late + if (LoadingProcessFinished) then + begin + CallLoad(PluginID); + CallInit(PluginID); + end; + end + else if (LoadingProcessFinished = False) then + begin + if (Plugins[PluginID].Info.Version < Info.Version) then + begin //Found newer Version of this Plugin + Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + + //Unload Old Plugin + UnloadPlugin(PluginID, nil); + + //Fill with new Info + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + //Try to get Procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + FreeLibrary(hLib); + Plugins[PluginID].State := 255; + Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin //Newer Version already loaded + FreeLibrary(hLib); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader')); + end; +end; + +//-------------- +// Calls Load Func of Plugin with the given Index +//-------------- +function TPluginLoader.CallLoad(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then + begin + try + Result := Plugins[Index].Procs.Load(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + Plugins[Index].State := 1 + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls Init Func of Plugin with the given Index +//-------------- +function TPluginLoader.CallInit(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then + begin + try + Result := Plugins[Index].Procs.Init(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + begin + Plugins[Index].State := 2; + Plugins[Index].NeedsDeInit := True; + end + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls DeInit Proc of Plugin with the given Index +//-------------- +procedure TPluginLoader.CallDeInit(Index: Cardinal); +begin + if(Index < Length(Plugins)) then + begin + if (Plugins[Index].State < 4) then + begin + if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then + try + Plugins[Index].Procs.DeInit(@PluginInterface); + except + + End; + + //Don't forget to remove Services and Subscriptions by this Plugin + Core.Hooks.DelbyOwner(-1 - Index); + + FreePlugin(Index); + end; + end; +end; + +//-------------- +// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions +//-------------- +procedure TPluginLoader.FreePlugin(Index: Cardinal); +begin + Plugins[Index].State := 4; + Plugins[Index].Procs.Load := nil; + Plugins[Index].Procs.Init := nil; + Plugins[Index].Procs.DeInit := nil; + + if (Plugins[Index].hLib <> 0) then + FreeLibrary(Plugins[Index].hLib); +end; + + + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +//-------------- +function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sFile: String; +begin + Result := -1; + sFile := ''; + //lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //lParam is PChar + try + sFile := String(PChar(lParam)); + Index := PluginExists(sFile); + if (Index < 0) And FileExists(sFile) then + begin //Is Filename + AddPlugin(sFile); + Result := Plugins[High(Plugins)].State; + end; + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + begin + AddPlugin(Plugins[Index].Path); + Result := Plugins[Index].State; + end; +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +//-------------- +function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sName: String; +begin + Result := -1; + //lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //wParam is PChar + try + sName := String(PChar(lParam)); + Index := PluginExists(sName); + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + CallDeInit(Index) +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) +//-------------- +function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := 0; + if (wParam > 0) then + begin //Get Info of 1 Plugin + if (lParam <> nil) and (wParam < Length(Plugins)) then + begin + try + Result := 1; + PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; + except + + End; + end; + end + else if (lParam = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); + End; + end; + +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam)) +//-------------- +function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := -1; + if (wParam > 0) then + begin //Get State of 1 Plugin + if (wParam < Length(Plugins)) then + begin + Result := Plugins[wParam].State; + end; + end + else if (lParam = nil) then + begin //Get Length of Plugin (Info) Array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader')); + End; + end; +end; + + +{********************* + TtehPlugins + Implentation +*********************} + +//------------- +// function that gives some Infos about the Module to the Core +//------------- +procedure TtehPlugins.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TtehPlugins'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Module executing the Plugins!'; +end; + +//------------- +// Just the Constructor +//------------- +constructor TtehPlugins.Create; +begin + inherited; + PluginLoader := nil; +end; + +//------------- +//Is Called on Loading. +//In this Method only Events and Services should be created +//to offer them to other Modules or Plugins during the Init process +//If False is Returned this will cause a Forced Exit +//------------- +function TtehPlugins.Load: Boolean; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + //Get Pointer to PluginLoader + PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); + if (PluginLoader = nil) then + begin + Result := false; + Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins')); + end + else + begin + Result := true; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + for i := 0 to High(PluginLoader.Plugins) do + begin + Core.CurExecuted := -1 - i; + + try + //Unload Plugin if not correctly Executed + if (PluginLoader.CallLoad(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + begin + Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + on E: Exception do + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); + end; + end; + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; +end; + +//------------- +//Is Called on Init Process +//In this Method you can Hook some Events and Create + Init +//your Classes, Variables etc. +//If False is Returned this will cause a Forced Exit +//------------- +function TtehPlugins.Init: Boolean; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + Result := true; + + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loading the Plugins + for i := 0 to High(PluginLoader.Plugins) do + try + Core.CurExecuted := -1 - i; + + //Unload Plugin if not correctly Executed + if (PluginLoader.CallInit(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + except + //Plugin could not be loaded. + // => Show Error Message, then ShutDown Plugin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +//------------- +//Is Called if this Module has been Inited and there is a Exit. +//Deinit is in backwards Initing Order +//------------- +procedure TtehPlugins.DeInit; +var + i: integer; //Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + //Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + //Start Loop + + for i := 0 to High(PluginLoader.Plugins) do + begin + try + //DeInit Plugin + PluginLoader.CallDeInit(i); + except + end; + end; + + //Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. -- cgit v1.2.3 From cbc9a8cc44af46886cacdf4cd825b3551894d0f7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 3 Sep 2008 23:21:38 +0000 Subject: Fixing a crash with Access violation if the folder Resources is missing in Application Support/UltraStarDeluxe git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1341 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 2ab2a390..217d4755 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -190,6 +190,8 @@ begin until (DirectoryIsFinished = DirectoryList.Count); // create missing folders + if not DirectoryExists(UserPathName) then + ForceDirectories(UserPathName); for Counter := 0 to DirectoryList.Count-1 do begin if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then -- cgit v1.2.3 From baa8e6ee782197a75038d0ab39c53f231bb66ba7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 4 Sep 2008 23:08:20 +0000 Subject: not needed test on presence of dir removed. Courtesy to tobigun git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1345 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 217d4755..788e0dda 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -190,8 +190,7 @@ begin until (DirectoryIsFinished = DirectoryList.Count); // create missing folders - if not DirectoryExists(UserPathName) then - ForceDirectories(UserPathName); + ForceDirectories(UserPathName); / should not be necessary since (UserPathName+'/.') is created. for Counter := 0 to DirectoryList.Count-1 do begin if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then -- cgit v1.2.3 From f5ea14a97fe530ff7670645c3c6e5051b961d2a7 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 6 Sep 2008 09:46:24 +0000 Subject: - fixed out-of-range error. In NewNote() CurrentPlayer.Note[CurrentPlayer.HighNote] was accessed although CurrentPlayer.Note is empty (always the case at the beginning of a song). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1346 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 5dacd5f8..08b9cc4a 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -769,7 +769,7 @@ var PlayerIndex: integer; CurrentSound: TCaptureBuffer; CurrentPlayer: PPlayer; - LastPlayerNote: PPLayerNote; + LastPlayerNote: PPlayerNote; Line: PLine; SentenceIndex: integer; SentenceMin: integer; @@ -823,7 +823,12 @@ begin begin CurrentPlayer := @Player[PlayerIndex]; CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + + // At the beginning of the song there is no previous note + if (Length(CurrentPlayer.Note) > 0) then + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] + else + LastPlayerNote := nil; // analyze buffer CurrentSound.AnalyzeBuffer; @@ -902,8 +907,10 @@ begin begin // we will add a new note NewNote := true; - // if last has the same tone + + // if previous note (if any) was the same, extend prrevious note if ((CurrentPlayer.LengthNote > 0) and + (LastPlayerNote <> nil) and (LastPlayerNote.Tone = CurrentSound.Tone) and ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then begin @@ -939,7 +946,8 @@ begin else begin // extend note length - Inc(LastPlayerNote.Length); + if (LastPlayerNote <> nil) then + Inc(LastPlayerNote.Length); end; // check for perfect note and then lit the star (on Draw) -- cgit v1.2.3 From 1ef212ba89e50965b6b3b2d756be2c17e110b3ee Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 6 Sep 2008 09:53:53 +0000 Subject: Delphi-mode set for FPC git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1348 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCatCovers.pas | 7 ++++++- src/base/UJoystick.pas | 8 ++++++-- src/base/ULCD.pas | 4 ++++ src/base/UModules.pas | 4 ++++ src/base/UPluginInterface.pas | 4 ++++ src/base/USingNotes.pas | 4 ++++ src/base/UTextClasses.pas | 4 ++++ src/base/UXMLSong.pas | 10 +++++++++- 8 files changed, 41 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index d8f6cdb0..c031c663 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -6,9 +6,14 @@ unit UCatCovers; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} -uses UIni; +uses + UIni; type TCatCovers = class diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas index 0ca7ba09..ec804295 100644 --- a/src/base/UJoystick.pas +++ b/src/base/UJoystick.pas @@ -2,10 +2,14 @@ unit UJoystick; interface -{$I switches.inc} +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +{$I switches.inc} -uses SDL; +uses + SDL; type TJoyButton = record diff --git a/src/base/ULCD.pas b/src/base/ULCD.pas index 82f7ba2f..bbd41c53 100644 --- a/src/base/ULCD.pas +++ b/src/base/ULCD.pas @@ -2,6 +2,10 @@ unit ULCD; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} type diff --git a/src/base/UModules.pas b/src/base/UModules.pas index 554a24c4..f4503aeb 100644 --- a/src/base/UModules.pas +++ b/src/base/UModules.pas @@ -2,6 +2,10 @@ unit UModules; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} {********************* diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas index 77693d0f..1a80ad1b 100644 --- a/src/base/UPluginInterface.pas +++ b/src/base/UPluginInterface.pas @@ -7,6 +7,10 @@ unit uPluginInterface; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses uPluginDefs; diff --git a/src/base/USingNotes.pas b/src/base/USingNotes.pas index 3b268d10..36e9515f 100644 --- a/src/base/USingNotes.pas +++ b/src/base/USingNotes.pas @@ -2,6 +2,10 @@ unit USingNotes; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} { Dummy Unit atm diff --git a/src/base/UTextClasses.pas b/src/base/UTextClasses.pas index 9a12e1f5..fea183ee 100644 --- a/src/base/UTextClasses.pas +++ b/src/base/UTextClasses.pas @@ -2,6 +2,10 @@ unit UTextClasses; interface +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + {$I switches.inc} uses diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas index 1a1fe6bc..c4420cb7 100644 --- a/src/base/UXMLSong.pas +++ b/src/base/UXMLSong.pas @@ -1,7 +1,15 @@ unit UXMLSong; interface -uses Classes; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes; type TNote = record -- cgit v1.2.3 From f3e8cb5a09ada2c74292047f2fad4fd47a01b99a Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 7 Sep 2008 21:41:53 +0000 Subject: fixed typo git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1350 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 788e0dda..cd58c3e8 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -190,7 +190,7 @@ begin until (DirectoryIsFinished = DirectoryList.Count); // create missing folders - ForceDirectories(UserPathName); / should not be necessary since (UserPathName+'/.') is created. + ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created. for Counter := 0 to DirectoryList.Count-1 do begin if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then -- cgit v1.2.3 From 5e1dd23ad5ed2fe8b0a618a9f9e10eac1694fe2b Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 9 Sep 2008 12:50:50 +0000 Subject: - better conformance of Makefiles to GNU coding standards - bindir/prefix, etc. can be changed anytime make is performed and is not hardcoded on configure time anymore - paths are written to the intermediate paths.inc file (instead of config-xyz.inc) - binary is not stripped anymore - fpc.m4 rewrite - additional options like heaptrace, range-checks - noexecstack workaround - some more changes - configure.ac helper functions moved to ax_ectract_version.m4 and pkg_config_utils.m4 - some icons moved from artwork to icons git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1351 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformLinux.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas index 3227e4f8..9095b192 100644 --- a/src/base/UPlatformLinux.pas +++ b/src/base/UPlatformLinux.pas @@ -41,6 +41,9 @@ uses SysUtils, ULog; +const + {$I paths.inc} + procedure TPlatformLinux.Init; begin inherited Init(); @@ -54,7 +57,7 @@ end; * reside in the directory of the executable. * - It is global if the game was installed (e.g. to /usr/bin) and * the resources are in a separate folder (e.g. /usr/share/ultrastardx) - * which name is stored in the INSTALL_DATADIR constant in config-linux.inc. + * which name is stored in the INSTALL_DATADIR constant in paths.inc. * * Sets UseLocalDirs to true if the game is executed locally, false otherwise. *} -- cgit v1.2.3 From 8dc13b99b51555be6fa16d271ddb02d995b46d96 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 10 Sep 2008 06:24:16 +0000 Subject: FreeBSD compatibility fixes: - {$IF Defined(Linux)} -> {$IF Defined(Linux) or Defined(BSD)} or {$IF Defined(UNIX)} - config-freebsd.inc added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1357 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UAudioCore_Portaudio.pas | 6 +++--- src/base/UCommon.pas | 17 +++++++++-------- src/base/UConfig.pas | 2 ++ src/base/UDLLManager.pas | 31 +++++++++++++++---------------- src/base/UMain.pas | 8 ++++---- src/base/UPlatform.pas | 24 ++++++++++-------------- src/base/uPluginLoader.pas | 12 +++++------- 7 files changed, 48 insertions(+), 52 deletions(-) (limited to 'src/base') diff --git a/src/base/UAudioCore_Portaudio.pas b/src/base/UAudioCore_Portaudio.pas index bcc8a001..cd279d99 100644 --- a/src/base/UAudioCore_Portaudio.pas +++ b/src/base/UAudioCore_Portaudio.pas @@ -50,11 +50,11 @@ const // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment // Note2: Windows Default-API is MME, but DirectSound is faster array[0..0] of TPaHostApiTypeId = ( paDirectSound ); -{$ELSEIF Defined(LINUX)} - // Note: Portmixer has no mixer support for JACK at the moment - array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); {$ELSEIF Defined(DARWIN)} array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio +{$ELSEIF Defined(UNIX)} + // Note: Portmixer has no mixer support for JACK at the moment + array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); {$ELSE} array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); {$IFEND} diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index 41e3c1f1..54c54760 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -81,7 +81,7 @@ uses // data used by the ...Locale() functions -{$IFDEF LINUX} +{$IF Defined(LINUX) or Defined(BSD)} var PrevNumLocale: string; @@ -91,7 +91,7 @@ const function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale'; -{$ENDIF} +{$IFEND} // In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') // to set the language/country specific locale (e.g. charset) for this application. @@ -111,17 +111,17 @@ function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' // for each call to projectM instead of changing it globally. procedure SetDefaultNumericLocale(); begin - {$ifdef LINUX} + {$IF Defined(LINUX) or Defined(BSD)} PrevNumLocale := setlocale(LC_NUMERIC, nil); setlocale(LC_NUMERIC, 'C'); - {$endif} + {$IFEND} end; procedure RestoreNumericLocale(); begin - {$ifdef LINUX} + {$IF Defined(LINUX) or Defined(BSD)} setlocale(LC_NUMERIC, PChar(PrevNumLocale)); - {$endif} + {$IFEND} end; (* @@ -275,7 +275,7 @@ var FilePath, LocalFileName: string; SearchInfo: TSearchRec; begin -{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems +{$IF Defined(LINUX) or Defined(BSD)} // speed up standard case if FileExists(FileName) then begin @@ -300,8 +300,9 @@ begin end; FindClose(SearchInfo); {$ELSE} + // Windows and Mac OS X do not have case sensitive file systems Result := FileExists(FileName); -{$ENDIF} +{$IFEND} end; diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index b77c2a5a..9ee0a668 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -85,6 +85,8 @@ const {$I ../config-win.inc} {$ELSEIF Defined(Linux)} {$I ../config-linux.inc} + {$ELSEIF Defined(FreeBSD)} + {$I ../config-freebsd.inc} {$ELSEIF Defined(Darwin)} {$I ../config-darwin.inc} {$ELSE} diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index 3d32a72a..e71a7eb0 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -45,25 +45,24 @@ var const DLLPath = 'Plugins'; - {$IFDEF MSWINDOWS} - DLLExt = '.dll'; - {$ENDIF} - {$IFDEF LINUX} - DLLExt = '.so'; - {$ENDIF} - {$IFDEF DARWIN} - DLLExt = '.dylib'; - {$ENDIF} +{$IF Defined(MSWINDOWS)} + DLLExt = '.dll'; +{$ELSEIF Defined(DARWIN)} + DLLExt = '.dylib'; +{$ELSEIF Defined(UNIX)} + DLLExt = '.so'; +{$IFEND} implementation -uses {$IFDEF MSWINDOWS} - windows, - {$ELSE} - dynlibs, - {$ENDIF} - ULog, - SysUtils; +uses + {$IFDEF MSWINDOWS} + windows, + {$ELSE} + dynlibs, + {$ENDIF} + ULog, + SysUtils; constructor TDLLMan.Create; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 08b9cc4a..c9167aa7 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -451,12 +451,12 @@ begin // This would create a new OpenGL render-context and all texture data // would be invalidated. // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. - {$IFDEF LINUX} + {$IF Defined(LINUX) or Defined(BSD)} if boolean( Ini.FullScreen ) then SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) else SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - {$ENDIF} + {$IFEND} end; SDL_KEYDOWN: begin @@ -473,7 +473,7 @@ begin // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to // reload all texture data (-> whitescreen bug). // Only Linux is able to handle screen-switching this way. - {$IFDEF LINUX} + {$IF Defined(LINUX) or Defined(BSD)} if boolean( Ini.FullScreen ) then begin SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); @@ -486,7 +486,7 @@ begin end; glViewPort(0, 0, ScreenW, ScreenH); - {$ENDIF} + {$IFEND} end // if print is pressed -> make screenshot and save to screenshot path else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index 1dcdb5b9..e88e45b2 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -43,15 +43,13 @@ implementation uses SysUtils, - {$IFDEF MSWINDOWS} + {$IF Defined(MSWINDOWS)} UPlatformWindows, - {$ENDIF} - {$IFDEF LINUX} - UPlatformLinux, - {$ENDIF} - {$IFDEF DARWIN} + {$ELSEIF Defined(DARWIN)} UPlatformMacOSX, - {$ENDIF} + {$ELSEIF Defined(UNIX)} + UPlatformLinux, + {$IFEND} ULog; @@ -158,15 +156,13 @@ end; initialization -{$IFDEF MSWINDOWS} +{$IF Defined(MSWINDOWS)} Platform_singleton := TPlatformWindows.Create; -{$ENDIF} -{$IFDEF LINUX} - Platform_singleton := TPlatformLinux.Create; -{$ENDIF} -{$IFDEF DARWIN} +{$ELSEIF Defined(DARWIN)} Platform_singleton := TPlatformMacOSX.Create; -{$ENDIF} +{$ELSEIF Defined(UNIX)} + Platform_singleton := TPlatformLinux.Create; +{$IFEND} finalization Platform_singleton.Free; diff --git a/src/base/uPluginLoader.pas b/src/base/uPluginLoader.pas index b2142702..d0e878c4 100644 --- a/src/base/uPluginLoader.pas +++ b/src/base/uPluginLoader.pas @@ -93,15 +93,13 @@ type end; const - {$IFDEF MSWINDOWS} +{$IF Defined(MSWINDOWS)} PluginFileExtension = '.dll'; - {$ENDIF} - {$IFDEF LINUX} - PluginFileExtension = '.so'; - {$ENDIF} - {$IFDEF DARWIN} +{$ELSEIF Defined(DARWIN)} PluginFileExtension = '.dylib'; - {$ENDIF} +{$ELSEIF Defined(UNIX)} + PluginFileExtension = '.so'; +{$IFEND} implementation -- cgit v1.2.3 From 6849d07fa827d28859e3172844baae78a2a86559 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 10 Sep 2008 17:01:50 +0000 Subject: Halt if the initial SDL_SetVideoMode() in InitializeScreen() call fails git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1359 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 2432503c..e8312300 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -598,8 +598,7 @@ begin if (screen = nil) then begin - Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D'); - exit; + Log.LogCritical('SDL_SetVideoMode Failed', 'Initialize3D'); end; LoadOpenGLExtensions(); -- cgit v1.2.3 From 4c869f07fa060261a20a7b54778b80a5e6bb7531 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 11 Sep 2008 00:32:35 +0000 Subject: GetExecution dirs forced to absolute path git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1361 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatform.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index e88e45b2..0942ec7b 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -85,7 +85,7 @@ end; *} function TPlatform.GetExecutionDir(): string; begin - Result := ExtractFilePath(ParamStr(0)); + Result := ExpandFileName(ExtractFilePath(ParamStr(0))); end; (** -- cgit v1.2.3 From 780d96129a06e31ed65bf4173eb18d3c7222e862 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 11 Sep 2008 15:10:24 +0000 Subject: SongDir1 template in config.ini is now created on Unix too git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1364 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index b286c917..4f401b01 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -883,8 +883,9 @@ begin IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); // Directories (add a template if section is missing) + // Note: Value must be ' ' and not '', otherwise no key is generated on Linux if (not IniFile.SectionExists('Directories')) then - IniFile.WriteString('Directories', 'SongDir1', ''); + IniFile.WriteString('Directories', 'SongDir1', ' '); IniFile.Free; end; -- cgit v1.2.3 From e0c41662841a34898134f6efb2222989fc816469 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 11 Sep 2008 15:54:09 +0000 Subject: -Creation of default directories (songs, covers) working again. - BSD redefined to FreeBSD git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1365 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index c9167aa7..f9f56c3e 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -451,7 +451,7 @@ begin // This would create a new OpenGL render-context and all texture data // would be invalidated. // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. - {$IF Defined(LINUX) or Defined(BSD)} + {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) else @@ -472,8 +472,8 @@ begin // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to // reload all texture data (-> whitescreen bug). - // Only Linux is able to handle screen-switching this way. - {$IF Defined(LINUX) or Defined(BSD)} + // Only Linux (and FreeBSD) is able to handle screen-switching this way. + {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then begin SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); @@ -1005,7 +1005,7 @@ begin if (PathList = nil) then PathList := TStringList.Create; - if (Path = '') or not DirectoryExists(Path) then + if (Path = '') or not ForceDirectories(Path) then Exit; PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); -- cgit v1.2.3 From b8e1a9b524f0922329c5307b0396f78a3dc2b44f Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 11 Sep 2008 16:05:43 +0000 Subject: Define BSD changed to FreeBSD as Darwin also defines BSD git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1366 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommon.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index 54c54760..38a68d84 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -81,7 +81,7 @@ uses // data used by the ...Locale() functions -{$IF Defined(LINUX) or Defined(BSD)} +{$IF Defined(Linux) or Defined(FreeBSD)} var PrevNumLocale: string; @@ -111,7 +111,7 @@ function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' // for each call to projectM instead of changing it globally. procedure SetDefaultNumericLocale(); begin - {$IF Defined(LINUX) or Defined(BSD)} + {$IF Defined(LINUX) or Defined(FreeBSD)} PrevNumLocale := setlocale(LC_NUMERIC, nil); setlocale(LC_NUMERIC, 'C'); {$IFEND} @@ -119,7 +119,7 @@ end; procedure RestoreNumericLocale(); begin - {$IF Defined(LINUX) or Defined(BSD)} + {$IF Defined(LINUX) or Defined(FreeBSD)} setlocale(LC_NUMERIC, PChar(PrevNumLocale)); {$IFEND} end; @@ -275,7 +275,7 @@ var FilePath, LocalFileName: string; SearchInfo: TSearchRec; begin -{$IF Defined(LINUX) or Defined(BSD)} +{$IF Defined(Linux) or Defined(FreeBSD)} // speed up standard case if FileExists(FileName) then begin -- cgit v1.2.3 From abf47ddd1fe77287136535e2d05ada48b99b8e1f Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 12 Sep 2008 09:51:33 +0000 Subject: - Windows resources (.rc) reduced to the icon - Texture resource names are now directly written to resources.inc - Fonts are no resources anymore. They are moved to game/fonts and can be changed to support multiple charsets (until the TTF part is finished). Fonts are registered in fonts/fonts.in git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1367 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 93 ++++++++++++++++++++++++++++------------------- src/base/UCommon.pas | 101 ++++++++++++++++++++++----------------------------- src/base/UMain.pas | 4 +- 3 files changed, 103 insertions(+), 95 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index f7b3ac95..f02a261c 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -12,7 +12,6 @@ uses gl, SDL, UTexture, - Classes, // SDL_ttf, ULog; @@ -73,81 +72,101 @@ uses UMain, UCommon, SysUtils, + IniFiles, + Classes, UGraphic; var // Colours for the reflection TempColor: array[0..3] of GLfloat; -procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string); +{** + * Load font info. + * FontFile is the name of the image (.png) not the data (.dat) file + *} +procedure LoadFontInfo(FontID: integer; const FontFile: string); var - stream: TStream; + Stream: TFileStream; + DatFile: string; begin - stream := GetResourceStream(aResourceName, aType); - if (not assigned(stream)) then - begin - Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont'); - Exit; - end; + DatFile := ChangeFileExt(FontFile, '.dat'); + FillChar(Fonts[FontID].Width[0], Length(Fonts[FontID].Width), 0); + + Stream := nil; try - stream.Read(Fonts[ aID ].Width, 256); + Stream := TFileStream.Create(DatFile, fmOpenRead); + Stream.Read(Fonts[FontID].Width, 256); except - Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont'); + Log.LogError('Error while reading font['+ inttostr(FontID) +']', 'LoadFontInfo'); end; - stream.Free; + Stream.Free; end; // Builds bitmap fonts procedure BuildFont; var Count: integer; + FontIni: TMemIniFile; + FontFile: string; // filename of the image (with .png/... ending) begin ActFont := 0; - SetLength(Fonts, 5); - Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0); + SetLength(Fonts, 4); + FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); + + // Normal + + FontFile := FontPath + FontIni.ReadString('Normal', 'File', ''); + + Fonts[0].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); Fonts[0].Tex.H := 30; Fonts[0].AspectW := 0.9; Fonts[0].Outline := 0; - Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0); + LoadFontInfo(0, FontFile); + + // Bold + + FontFile := FontPath + FontIni.ReadString('Bold', 'File', ''); + + Fonts[1].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); Fonts[1].Tex.H := 30; Fonts[1].AspectW := 1; Fonts[1].Outline := 0; - Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0); + LoadFontInfo(1, FontFile); + for Count := 0 to 255 do + Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; + + // Outline1 + + FontFile := FontPath + FontIni.ReadString('Outline1', 'File', ''); + + Fonts[2].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); Fonts[2].Tex.H := 30; Fonts[2].AspectW := 0.95; Fonts[2].Outline := 5; - Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[3].Tex.H := 30; - Fonts[3].AspectW := 0.95; - Fonts[3].Outline := 4; + LoadFontInfo(2, FontFile); + for Count := 0 to 255 do + Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; -{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen - Fonts[4].Tex.H := 30; - Fonts[4].AspectW := 0.95; - Fonts[4].Done := -1; - Fonts[4].Outline := 5;} + // Outline2 - // load font info - LoadBitmapFontInfo( 0, 'FNT', 'Font'); - LoadBitmapFontInfo( 1, 'FNT', 'FontB'); - LoadBitmapFontInfo( 2, 'FNT', 'FontO'); - LoadBitmapFontInfo( 3, 'FNT', 'FontO2'); + FontFile := FontPath + FontIni.ReadString('Outline2', 'File', ''); - for Count := 0 to 255 do - Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; - - for Count := 0 to 255 do - Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; + Fonts[3].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); + Fonts[3].Tex.H := 30; + Fonts[3].AspectW := 0.95; + Fonts[3].Outline := 4; + LoadFontInfo(3, FontFile); for Count := 0 to 255 do Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; -{ for Count := 0 to 255 do - Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;} + + // close ini-file + FontIni.Free; // enable blending by default for Count := 0 to High(Fonts) do diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index 38a68d84..3f41dae6 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -306,87 +306,74 @@ begin end; -{$IFDEF Unix} - // include resource-file info (stored in the constant array "resources") - {$I ../resource.inc} -{$ENDIF} +// include resource-file info (stored in the constant array "resources") +{$I ../resource.inc} function GetResourceStream(const aName, aType: string): TStream; -{$IFDEF Unix} var ResIndex: integer; Filename: string; -{$ENDIF} begin Result := nil; - {$IFDEF Unix} for ResIndex := 0 to High(resources) do begin - if (resources[ResIndex][0] = aName ) and - (resources[ResIndex][1] = aType ) then + if (Resources[ResIndex][0] = aName ) then begin try - Filename := ResourcesPath + resources[ResIndex][2]; + Filename := ResourcesPath + Resources[ResIndex][1]; Result := TFileStream.Create(Filename, fmOpenRead); except - Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream'); + Log.LogError('Failed to open: "'+ resources[ResIndex][1] +'"', 'GetResourceStream'); end; - exit; + Exit; end; end; - {$ELSE} - try - Result := TResourceStream.Create(HInstance, aName , PChar(aType)); - except - Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream'); - end; - {$ENDIF} end; // +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ - function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; - var - stream : TStream; - origin : Word; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); - case whence of - 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. - 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. - 2 : origin := soFromEnd; - else - origin := soFromBeginning; // just in case - end; - Result := stream.Seek( offset, origin ); +function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; +var + stream : TStream; + origin : Word; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); + case whence of + 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. + 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. + 2 : origin := soFromEnd; + else + origin := soFromBeginning; // just in case end; + Result := stream.Seek( offset, origin ); +end; - function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; - var - stream : TStream; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); - try - Result := stream.read( Ptr^, Size * maxnum ) div size; - except - Result := -1; - end; +function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; +var + stream : TStream; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); + try + Result := stream.read( Ptr^, Size * maxnum ) div size; + except + Result := -1; end; +end; - function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; - var - stream : TStream; - begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); - stream.Free; - Result := 1; - end; +function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; +var + stream : TStream; +begin + stream := TStream( context.unknown ); + if ( stream = nil ) then + raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream.Free; + Result := 1; +end; // ----------------------------------------------- (* diff --git a/src/base/UMain.pas b/src/base/UMain.pas index f9f56c3e..7d9886b6 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -77,6 +77,7 @@ var LanguagesPath: string; PluginPath: string; VisualsPath: string; + FontPath: string; ResourcesPath: string; PlayListPath: string; @@ -100,7 +101,7 @@ function FindPath(out PathResult: string; const RequestedPath: string; NeedsWrit procedure InitializePaths; procedure AddSongPath(const Path: string); -Procedure Main; +procedure Main; procedure MainLoop; procedure CheckEvents; procedure Sing(Screen: TScreenSing); @@ -1091,6 +1092,7 @@ begin FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); + FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); // Playlists are not shared as we need one directory to write too -- cgit v1.2.3 From 3b5af758a1ffb8c02c3fad2ef0acbc0c241b3de5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 12 Sep 2008 13:19:17 +0000 Subject: removed resource.inc git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1371 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommon.pas | 27 -------------------- src/base/UGraphic.pas | 5 +++- src/base/UImage.pas | 68 +++++++++++++-------------------------------------- 3 files changed, 21 insertions(+), 79 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index 3f41dae6..f2f98537 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -25,7 +25,6 @@ procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); procedure ConsoleWriteLn(const msg: string); -function GetResourceStream(const aName, aType : string): TStream; function RWopsFromStream(Stream: TStream): PSDL_RWops; {$IFDEF FPC} @@ -305,32 +304,6 @@ begin {$IFEND} end; - -// include resource-file info (stored in the constant array "resources") -{$I ../resource.inc} - -function GetResourceStream(const aName, aType: string): TStream; -var - ResIndex: integer; - Filename: string; -begin - Result := nil; - - for ResIndex := 0 to High(resources) do - begin - if (Resources[ResIndex][0] = aName ) then - begin - try - Filename := ResourcesPath + Resources[ResIndex][1]; - Result := TFileStream.Create(Filename, fmOpenRead); - except - Log.LogError('Failed to open: "'+ resources[ResIndex][1] +'"', 'GetResourceStream'); - end; - Exit; - end; - end; -end; - // +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; var diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index e8312300..6fa0aa8f 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -416,6 +416,9 @@ begin //Load_GL_EXT_framebuffer_object(); end; +const + WINDOW_ICON = 'icons/ultrastardx-icon.png'; + procedure Initialize3D (Title: string); var Icon: PSDL_Surface; @@ -428,7 +431,7 @@ begin end; // load icon image (must be 32x32 for win32) - Icon := LoadImage('WINDOWICON'); + Icon := LoadImage(ResourcesPath + WINDOW_ICON); if (Icon <> nil) then SDL_WM_SetIcon(Icon, 0); diff --git a/src/base/UImage.pas b/src/base/UImage.pas index d33c0d38..5114df25 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -119,7 +119,7 @@ function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: i * Image loading *******************************************************) -function LoadImage(const Identifier: string): PSDL_Surface; +function LoadImage(const Filename: string): PSDL_Surface; (******************************************************* * Image manipulation @@ -741,64 +741,30 @@ end; (* - * Loads an image from the given file or resource + * Loads an image from the given file *) -function LoadImage(const Identifier: string): PSDL_Surface; +function LoadImage(const Filename: string): PSDL_Surface; var - TexRWops: PSDL_RWops; - TexStream: TStream; - FileName: string; + FilenameFound: string; begin Result := nil; - TexRWops := nil; - if Identifier = '' then - exit; + // FileExistsInsensitive() requires a var-arg + FilenameFound := Filename; - //Log.LogStatus( Identifier, 'LoadImage' ); - - FileName := Identifier; - - if (FileExistsInsensitive(FileName)) then + // try to find the file case insensitive + if (not FileExistsInsensitive(FilenameFound)) then begin - // load from file - //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' ); - try - Result := IMG_Load(PChar(FileName)); - //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); - except - Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage'); - Exit; - end; - end - else - begin - //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); - - TexStream := GetResourceStream(Identifier, 'TEX'); - if (not assigned(TexStream)) then - begin - Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage'); - Exit; - end; - - TexRWops := RWopsFromStream(TexStream); - if (TexRWops = nil) then - begin - Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage'); - TexStream.Free(); - Exit; - end; - - //Log.LogStatus( 'resource Assigned....' , Identifier); - try - Result := IMG_Load_RW(TexRWops, 0); - except - Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage'); - end; + Log.LogError('Image-File does not exist "'+FilenameFound+'"', 'LoadImage'); + Exit; + end; - SDL_FreeRW(TexRWops); - TexStream.Free(); + // load from file + try + Result := IMG_Load(PChar(FilenameFound)); + except + Log.LogError('Could not load from file "'+FilenameFound+'"', 'LoadImage'); + Exit; end; end; -- cgit v1.2.3 From 4c6d2f4cd49a4f6016026ef81db31c3656bb5e8c Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 13 Sep 2008 08:27:50 +0000 Subject: Media modules moved from base to media git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1374 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UAudioConverter.pas | 458 ------------- src/base/UAudioCore_Bass.pas | 123 ---- src/base/UAudioCore_Portaudio.pas | 257 -------- src/base/UAudioDecoder_Bass.pas | 242 ------- src/base/UAudioDecoder_FFmpeg.pas | 1114 -------------------------------- src/base/UAudioInput_Bass.pas | 481 -------------- src/base/UAudioInput_Portaudio.pas | 474 -------------- src/base/UAudioPlaybackBase.pas | 292 --------- src/base/UAudioPlayback_Bass.pas | 731 --------------------- src/base/UAudioPlayback_Portaudio.pas | 361 ----------- src/base/UAudioPlayback_SDL.pas | 160 ----- src/base/UAudioPlayback_SoftMixer.pas | 1132 --------------------------------- src/base/UMediaCore_FFmpeg.pas | 405 ------------ src/base/UMediaCore_SDL.pas | 38 -- src/base/UMedia_dummy.pas | 243 ------- src/base/UVideo.pas | 828 ------------------------ src/base/UVisualizer.pas | 442 ------------- 17 files changed, 7781 deletions(-) delete mode 100644 src/base/UAudioConverter.pas delete mode 100644 src/base/UAudioCore_Bass.pas delete mode 100644 src/base/UAudioCore_Portaudio.pas delete mode 100644 src/base/UAudioDecoder_Bass.pas delete mode 100644 src/base/UAudioDecoder_FFmpeg.pas delete mode 100644 src/base/UAudioInput_Bass.pas delete mode 100644 src/base/UAudioInput_Portaudio.pas delete mode 100644 src/base/UAudioPlaybackBase.pas delete mode 100644 src/base/UAudioPlayback_Bass.pas delete mode 100644 src/base/UAudioPlayback_Portaudio.pas delete mode 100644 src/base/UAudioPlayback_SDL.pas delete mode 100644 src/base/UAudioPlayback_SoftMixer.pas delete mode 100644 src/base/UMediaCore_FFmpeg.pas delete mode 100644 src/base/UMediaCore_SDL.pas delete mode 100644 src/base/UMedia_dummy.pas delete mode 100644 src/base/UVideo.pas delete mode 100644 src/base/UVisualizer.pas (limited to 'src/base') diff --git a/src/base/UAudioConverter.pas b/src/base/UAudioConverter.pas deleted file mode 100644 index 5647f27b..00000000 --- a/src/base/UAudioConverter.pas +++ /dev/null @@ -1,458 +0,0 @@ -unit UAudioConverter; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - ULog, - ctypes, - {$IFDEF UseSRCResample} - samplerate, - {$ENDIF} - {$IFDEF UseFFmpegResample} - avcodec, - {$ENDIF} - UMediaCore_SDL, - sdl, - SysUtils, - Math; - -type - {* - * Notes: - * - 44.1kHz to 48kHz conversion or vice versa is not supported - * by SDL 1.2 (will be introduced in 1.3). - * No conversion takes place in this cases. - * This is because SDL just converts differences in powers of 2. - * So the result might not be that accurate. - * This IS audible (voice to high/low) and it needs good synchronization - * with the video or the lyrics timer. - * - float<->int16 conversion is not supported (will be part of 1.3) and - * SDL (<1.3) is not capable of handling floats at all. - * -> Using FFmpeg or libsamplerate for resampling is preferred. - * Use SDL for channel and format conversion only. - *} - TAudioConverter_SDL = class(TAudioConverter) - private - cvt: TSDL_AudioCVT; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - - {$IFDEF UseFFmpegResample} - // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so - // the quality should be good. - TAudioConverter_FFmpeg = class(TAudioConverter) - private - // TODO: use SDL for multi-channel->stereo and format conversion - ResampleContext: PReSampleContext; - Ratio: double; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - {$ENDIF} - - {$IFDEF UseSRCResample} - TAudioConverter_SRC = class(TAudioConverter) - private - ConverterState: PSRC_STATE; - ConversionData: SRC_DATA; - FormatConverter: TAudioConverter; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override; - destructor Destroy(); override; - - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override; - function GetOutputBufferSize(InputSize: integer): integer; override; - function GetRatio(): double; override; - end; - - // Note: SRC (=libsamplerate) provides several converters with different quality - // speed trade-offs. The SINC-types are slow but offer best quality. - // The SRC_SINC_* converters are too slow for realtime conversion, - // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting - // in audible clicks and pops. - // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD - // because it interpolates the samples. Normal "non-audiophile" users should not - // be able to hear a difference between the SINC_* ones and LINEAR. Especially - // if people sing along with the song. - // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR. - const - SRC_CONVERTER_TYPE = SRC_LINEAR; - {$ENDIF} - -implementation - -function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean; -var - srcFormat: UInt16; - dstFormat: UInt16; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or - not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then - begin - Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion'); - Exit; - end; - - if (SDL_BuildAudioCVT(@cvt, - srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate), - dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then - begin - Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion'); - Exit; - end; - - Result := true; -end; - -destructor TAudioConverter_SDL.Destroy(); -begin - // nothing to be done here - inherited; -end; - -(* - * Returns the size of the output buffer. This might be bigger than the actual - * size of resampled audio data. - *) -function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer; -begin - // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2. - // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2 - Result := InputSize * cvt.len_mult; -end; - -function TAudioConverter_SDL.GetRatio(): double; -begin - Result := cvt.len_ratio; -end; - -function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -begin - Result := -1; - - if (InputSize <= 0) then - begin - // avoid div-by-zero problems - if (InputSize = 0) then - Result := 0; - Exit; - end; - - // OutputBuffer is always bigger than or equal to InputBuffer - Move(InputBuffer[0], OutputBuffer[0], InputSize); - cvt.buf := PUint8(OutputBuffer); - cvt.len := InputSize; - if (SDL_ConvertAudio(@cvt) = -1) then - Exit; - - Result := cvt.len_cvt; -end; - - -{$IFDEF UseFFmpegResample} - -function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - // Note: ffmpeg does not support resampling for more than 2 input channels - - if (srcFormatInfo.Format <> asfS16) then - begin - Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - // TODO: use SDL here - if (srcFormatInfo.Format <> dstFormatInfo.Format) then - begin - Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - ResampleContext := audio_resample_init( - dstFormatInfo.Channels, srcFormatInfo.Channels, - Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate)); - if (ResampleContext = nil) then - begin - Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init'); - Exit; - end; - - // calculate ratio - Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) * - (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate); - - Result := true; -end; - -destructor TAudioConverter_FFmpeg.Destroy(); -begin - if (ResampleContext <> nil) then - audio_resample_close(ResampleContext); - inherited; -end; - -function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -var - InputSampleCount: integer; - OutputSampleCount: integer; -begin - Result := -1; - - if (InputSize <= 0) then - begin - // avoid div-by-zero in audio_resample() - if (InputSize = 0) then - Result := 0; - Exit; - end; - - InputSampleCount := InputSize div SrcFormatInfo.FrameSize; - OutputSampleCount := audio_resample( - ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer), - InputSampleCount); - if (OutputSampleCount = -1) then - begin - Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert'); - Exit; - end; - Result := OutputSampleCount * DstFormatInfo.FrameSize; -end; - -function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer; -begin - Result := Ceil(InputSize * GetRatio()); -end; - -function TAudioConverter_FFmpeg.GetRatio(): double; -begin - Result := Ratio; -end; - -{$ENDIF} - - -{$IFDEF UseSRCResample} - -function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -var - error: integer; - TempSrcFormatInfo: TAudioFormatInfo; - TempDstFormatInfo: TAudioFormatInfo; -begin - inherited Init(SrcFormatInfo, DstFormatInfo); - - Result := false; - - FormatConverter := nil; - - // SRC does not handle channel or format conversion - if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or - not (SrcFormatInfo.Format in [asfS16, asfFloat])) then - begin - // SDL can not convert to float, so we have to convert to SInt16 first - TempSrcFormatInfo := TAudioFormatInfo.Create( - SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format); - TempDstFormatInfo := TAudioFormatInfo.Create( - DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16); - - // init format/channel conversion - FormatConverter := TAudioConverter_SDL.Create(); - if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then - begin - Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init'); - FormatConverter.Free; - // exit after the format-info is freed - end; - - // this info was copied so we do not need it anymore - TempSrcFormatInfo.Free; - TempDstFormatInfo.Free; - - // leave if the format is not supported - if (not assigned(FormatConverter)) then - Exit; - - // adjust our copy of the input audio-format for SRC conversion - Self.SrcFormatInfo.Channels := DstFormatInfo.Channels; - Self.SrcFormatInfo.Format := asfS16; - end; - - if ((DstFormatInfo.Format <> asfS16) and - (DstFormatInfo.Format <> asfFloat)) then - begin - Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init'); - Exit; - end; - - ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate; - if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then - begin - Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init'); - Exit; - end; - - ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error); - if (ConverterState = nil) then - begin - Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init'); - Exit; - end; - - Result := true; -end; - -destructor TAudioConverter_SRC.Destroy(); -begin - if (ConverterState <> nil) then - src_delete(ConverterState); - FormatConverter.Free; - inherited; -end; - -function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; -var - FloatInputBuffer: PSingle; - FloatOutputBuffer: PSingle; - TempBuffer: PChar; - TempSize: integer; - NumSamples: integer; - OutputSize: integer; - error: integer; -begin - Result := -1; - - TempBuffer := nil; - - // format conversion with external converter (to correct number of channels and format) - if (assigned(FormatConverter)) then - begin - TempSize := FormatConverter.GetOutputBufferSize(InputSize); - GetMem(TempBuffer, TempSize); - InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize); - InputBuffer := TempBuffer; - end; - - if (InputSize <= 0) then - begin - // avoid div-by-zero problems - if (InputSize = 0) then - Result := 0; - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - Exit; - end; - - if (SrcFormatInfo.Format = asfFloat) then - begin - FloatInputBuffer := PSingle(InputBuffer); - end else begin - NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format]; - GetMem(FloatInputBuffer, NumSamples * SizeOf(Single)); - src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples); - end; - - // calculate approx. output size - OutputSize := Ceil(InputSize * ConversionData.src_ratio); - - if (DstFormatInfo.Format = asfFloat) then - begin - FloatOutputBuffer := PSingle(OutputBuffer); - end else begin - NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format]; - GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single)); - end; - - with ConversionData do - begin - data_in := PCFloat(FloatInputBuffer); - input_frames := InputSize div SrcFormatInfo.FrameSize; - data_out := PCFloat(FloatOutputBuffer); - output_frames := OutputSize div DstFormatInfo.FrameSize; - // TODO: set this to 1 at end of file-playback - end_of_input := 0; - end; - - error := src_process(ConverterState, @ConversionData); - if (error <> 0) then - begin - Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert'); - if (SrcFormatInfo.Format <> asfFloat) then - FreeMem(FloatInputBuffer); - if (DstFormatInfo.Format <> asfFloat) then - FreeMem(FloatOutputBuffer); - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - Exit; - end; - - if (SrcFormatInfo.Format <> asfFloat) then - FreeMem(FloatInputBuffer); - - if (DstFormatInfo.Format <> asfFloat) then - begin - NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels; - src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples); - FreeMem(FloatOutputBuffer); - end; - - // free format conversion buffer if used - if (TempBuffer <> nil) then - FreeMem(TempBuffer); - - if (assigned(FormatConverter)) then - InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize - else - InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize; - - // set result to output size according to SRC - Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize; -end; - -function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer; -begin - Result := Ceil(InputSize * GetRatio()); -end; - -function TAudioConverter_SRC.GetRatio(): double; -begin - // if we need additional channel/format conversion, use this ratio - if (assigned(FormatConverter)) then - Result := FormatConverter.GetRatio() - else - Result := 1.0; - - // now the SRC ratio (Note: the format might change from SInt16 to float) - Result := Result * - ConversionData.src_ratio * - (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize); -end; - -{$ENDIF} - -end. \ No newline at end of file diff --git a/src/base/UAudioCore_Bass.pas b/src/base/UAudioCore_Bass.pas deleted file mode 100644 index beb2db16..00000000 --- a/src/base/UAudioCore_Bass.pas +++ /dev/null @@ -1,123 +0,0 @@ -unit UAudioCore_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - SysUtils, - UMusic, - bass; // (Note: DWORD is defined here) - -type - TAudioCore_Bass = class - public - constructor Create(); - class function GetInstance(): TAudioCore_Bass; - function ErrorGetString(): string; overload; - function ErrorGetString(errCode: integer): string; overload; - function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; - function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; - end; - -implementation - -uses - UMain, - ULog; - -var - Instance: TAudioCore_Bass; - -constructor TAudioCore_Bass.Create(); -begin - inherited; -end; - -class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass; -begin - if (not Assigned(Instance)) then - Instance := TAudioCore_Bass.Create(); - Result := Instance; -end; - -function TAudioCore_Bass.ErrorGetString(): string; -begin - Result := ErrorGetString(BASS_ErrorGetCode()); -end; - -function TAudioCore_Bass.ErrorGetString(errCode: integer): string; -begin - case errCode of - BASS_OK: result := 'No error'; - BASS_ERROR_MEM: result := 'Insufficient memory'; - BASS_ERROR_FILEOPEN: result := 'File could not be opened'; - BASS_ERROR_DRIVER: result := 'Device driver not available'; - BASS_ERROR_BUFLOST: result := 'Buffer lost'; - BASS_ERROR_HANDLE: result := 'Invalid Handle'; - BASS_ERROR_FORMAT: result := 'Sample-Format not supported'; - BASS_ERROR_POSITION: result := 'Illegal position'; - BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called'; - BASS_ERROR_START: result := 'Paused/stopped'; - BASS_ERROR_ALREADY: result := 'Already created/used'; - BASS_ERROR_NOCHAN: result := 'No free channels'; - BASS_ERROR_ILLTYPE: result := 'Type is invalid'; - BASS_ERROR_ILLPARAM: result := 'Illegal parameter'; - BASS_ERROR_NO3D: result := 'No 3D support'; - BASS_ERROR_NOEAX: result := 'No EAX support'; - BASS_ERROR_DEVICE: result := 'Invalid device number'; - BASS_ERROR_NOPLAY: result := 'Channel not playing'; - BASS_ERROR_FREQ: result := 'Freq out of range'; - BASS_ERROR_NOTFILE: result := 'Not a file stream'; - BASS_ERROR_NOHW: result := 'No hardware support'; - BASS_ERROR_EMPTY: result := 'Is empty'; - BASS_ERROR_NONET: result := 'Network unavailable'; - BASS_ERROR_CREATE: result := 'Creation error'; - BASS_ERROR_NOFX: result := 'DX8 effects unavailable'; - BASS_ERROR_NOTAVAIL: result := 'Not available'; - BASS_ERROR_DECODE: result := 'Is a decoding channel'; - BASS_ERROR_DX: result := 'Insufficient version of DirectX'; - BASS_ERROR_TIMEOUT: result := 'Timeout'; - BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported'; - BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support'; - BASS_ERROR_VERSION: result := 'Version error'; - BASS_ERROR_CODEC: result := 'Codec not available/supported'; - BASS_ERROR_ENDED: result := 'The channel/file has ended'; - BASS_ERROR_UNKNOWN: result := 'Unknown error'; - else result := 'Unknown error'; - end; -end; - -function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean; -begin - case Format of - asfS16: Flags := 0; - asfFloat: Flags := BASS_SAMPLE_FLOAT; - asfU8: Flags := BASS_SAMPLE_8BITS; - else begin - Result := false; - Exit; - end; - end; - - Result := true; -end; - -function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean; -begin - if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then - Format := asfFloat - else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then - Format := asfU8 - else - Format := asfS16; - - Result := true; -end; - -end. diff --git a/src/base/UAudioCore_Portaudio.pas b/src/base/UAudioCore_Portaudio.pas deleted file mode 100644 index cd279d99..00000000 --- a/src/base/UAudioCore_Portaudio.pas +++ /dev/null @@ -1,257 +0,0 @@ -unit UAudioCore_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I ../switches.inc} - - -uses - Classes, - SysUtils, - portaudio; - -type - TAudioCore_Portaudio = class - public - constructor Create(); - class function GetInstance(): TAudioCore_Portaudio; - function GetPreferredApiIndex(): TPaHostApiIndex; - function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; - end; - -implementation - -uses - ULog; - -{* - * The default API used by Portaudio is the least common denominator - * and might lack efficiency. In addition it might not even work. - * We use an array named ApiPreferenceOrder with which we define the order of - * preferred APIs to use. The first API-type in the list is tried first. - * If it is not available the next one is tried and so on ... - * If none of the preferred APIs was found the default API (detected by - * portaudio) is used. - * - * Pascal does not permit zero-length static arrays, so you must use paDefaultApi - * as an array's only member if you do not have any preferences. - * You can also append paDefaultApi to a non-zero length preferences array but - * this is optional because the default API is always used as a fallback. - *} -const - paDefaultApi = -1; -const - ApiPreferenceOrder: -{$IF Defined(MSWINDOWS)} - // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment - // Note2: Windows Default-API is MME, but DirectSound is faster - array[0..0] of TPaHostApiTypeId = ( paDirectSound ); -{$ELSEIF Defined(DARWIN)} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio -{$ELSEIF Defined(UNIX)} - // Note: Portmixer has no mixer support for JACK at the moment - array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS ); -{$ELSE} - array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); -{$IFEND} - - -{ TAudioInput_Portaudio } - -var - Instance: TAudioCore_Portaudio; - -constructor TAudioCore_Portaudio.Create(); -begin - inherited; -end; - -class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio; -begin - if not assigned(Instance) then - Instance := TAudioCore_Portaudio.Create(); - Result := Instance; -end; - -function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; -var - i: integer; - apiIndex: TPaHostApiIndex; - apiInfo: PPaHostApiInfo; -begin - result := -1; - - // select preferred sound-API - for i:= 0 to High(ApiPreferenceOrder) do - begin - if(ApiPreferenceOrder[i] <> paDefaultApi) then - begin - // check if API is available - apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); - if(apiIndex >= 0) then - begin - // we found an API but we must check if it works - // (on linux portaudio might detect OSS but does not provide - // any devices if ALSA is enabled) - apiInfo := Pa_GetHostApiInfo(apiIndex); - if (apiInfo^.deviceCount > 0) then - begin - Result := apiIndex; - break; - end; - end; - end; - end; - - // None of the preferred APIs is available -> use default - if(result < 0) then - begin - result := Pa_GetDefaultHostApi(); - end; -end; - -{* - * Portaudio test callback used by TestDevice(). - *} -function TestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - // this callback is called only once - result := paAbort; -end; - -(* - * Tests if the callback works. Some devices can be opened without - * an error but the callback is never called. Calling Pa_StopStream() on such - * a stream freezes USDX then. Probably because the callback-thread is deadlocked - * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream() - * block forever too and though can't be used for testing. - * - * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream) - * can be used to force the stream to stop. But for some reason this stops debugging - * in gdb with a "no process found" message. - * - * Because freezing devices are non-working devices we test the devices here to - * be able to exclude them from the device-selection list. - * - * Portaudio does not provide any test to check this error case (probably because - * it should not even occur). So we have to open the device, start the stream and - * check if the callback is called (the stream is stopped if the callback is called - * for the first time, so we can poll until the stream is stopped). - * - * Another error that occurs is that some devices (even the default device) might - * work at the beginning but stop after a few calls (maybe 50) of the callback. - * For me this problem occurs with the default output-device. The "dmix" or "front" - * device must be selected instead. Another problem is that (due to a bug in - * portaudio or ALSA) the "front" device is not detected every time portaudio - * is started. Sometimes it needs two or more restarts. - * - * There is no reasonable way to test for these errors. For the first error-case - * we could test if the callback is called 50 times but this can take a second - * for each device and it can fail in the 51st or even 100th callback call then. - * - * The second error-case cannot be tested at all. How should we now that one - * device is missing if portaudio is not even able to detect it. - * We could start and terminate Portaudio for several times and see if the device - * count changes but this is ugly. - * - * Conclusion: We are not able to autodetect a working device with - * portaudio (at least not with the newest v19_20071207) at the moment. - * So we have to provide the possibility to manually select an output device - * in the UltraStar options if we want to use portaudio instead of SDL. - *) -function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean; -var - stream: PPaStream; - err: TPaError; - cbWorks: boolean; - cbPolls: integer; - i: integer; -const - altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates -begin - Result := false; - - if (sampleRate <= 0) then - sampleRate := 44100; - - // check if device supports our input-format - err := Pa_IsFormatSupported(inParams, outParams, sampleRate); - if(err <> paNoError) then - begin - // we cannot fix the error -> exit - if (err <> paInvalidSampleRate) then - Exit; - - // try alternative sample-rates to the detected one - sampleRate := 0; - for i := 0 to High(altSampleRates) do - begin - // do not check the detected sample-rate twice - if (altSampleRates[i] = sampleRate) then - continue; - // check alternative - err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]); - if (err = paNoError) then - begin - // sample-rate works - sampleRate := altSampleRates[i]; - break; - end; - end; - // no working sample-rate found - if (sampleRate = 0) then - Exit; - end; - - // FIXME: for some reason gdb stops after a call of Pa_AbortStream() - // which is implicitely called by Pa_CloseStream(). - // gdb's stops with the message: "ptrace: no process found". - // Probably because the callback-thread is killed what confuses gdb. - {$IF Defined(Debug) and Defined(Linux)} - cbWorks := true; - {$ELSE} - // open device for testing - err := Pa_OpenStream(stream, inParams, outParams, sampleRate, - paFramesPerBufferUnspecified, - paNoFlag, @TestCallback, nil); - if(err <> paNoError) then - begin - exit; - end; - - // start the callback - err := Pa_StartStream(stream); - if(err <> paNoError) then - begin - Pa_CloseStream(stream); - exit; - end; - - cbWorks := false; - // check if the callback was called (poll for max. 200ms) - for cbPolls := 1 to 20 do - begin - // if the test-callback was called it should be aborted now - if (Pa_IsStreamActive(stream) = 0) then - begin - cbWorks := true; - break; - end; - // not yet aborted, wait and try (poll) again - Pa_Sleep(10); - end; - - // finally abort the stream - Pa_CloseStream(stream); - {$IFEND} - - Result := cbWorks; -end; - -end. diff --git a/src/base/UAudioDecoder_Bass.pas b/src/base/UAudioDecoder_Bass.pas deleted file mode 100644 index dba1fde4..00000000 --- a/src/base/UAudioDecoder_Bass.pas +++ /dev/null @@ -1,242 +0,0 @@ -unit UAudioDecoder_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - Classes, - SysUtils, - UMain, - UMusic, - UAudioCore_Bass, - ULog, - bass; - -type - TBassDecodeStream = class(TAudioDecodeStream) - private - Handle: HSTREAM; - FormatInfo : TAudioFormatInfo; - Error: boolean; - public - constructor Create(Handle: HSTREAM); - destructor Destroy(); override; - - procedure Close(); override; - - function GetLength(): real; override; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - - function ReadData(Buffer: PChar; BufSize: integer): integer; override; - end; - -type - TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder ) - public - function GetName: string; - - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - function Open(const Filename: string): TAudioDecodeStream; - end; - -var - BassCore: TAudioCore_Bass; - - -{ TBassDecodeStream } - -constructor TBassDecodeStream.Create(Handle: HSTREAM); -var - ChannelInfo: BASS_CHANNELINFO; - Format: TAudioSampleFormat; -begin - inherited Create(); - Self.Handle := Handle; - - // setup format info - if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then - begin - raise Exception.Create('Failed to open decode-stream'); - end; - BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format); - FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format); - - Error := false; -end; - -destructor TBassDecodeStream.Destroy(); -begin - Close(); - inherited; -end; - -procedure TBassDecodeStream.Close(); -begin - if (Handle <> 0) then - begin - BASS_StreamFree(Handle); - Handle := 0; - end; - PerformOnClose(); - FreeAndNil(FormatInfo); - Error := false; -end; - -function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TBassDecodeStream.GetLength(): real; -var - bytes: QWORD; -begin - bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE); - Result := BASS_ChannelBytes2Seconds(Handle, bytes); -end; - -function TBassDecodeStream.GetPosition: real; -var - bytes: QWORD; -begin - bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE); - Result := BASS_ChannelBytes2Seconds(Handle, bytes); -end; - -procedure TBassDecodeStream.SetPosition(Time: real); -var - bytes: QWORD; -begin - bytes := BASS_ChannelSeconds2Bytes(Handle, Time); - BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE); -end; - -function TBassDecodeStream.GetLoop(): boolean; -var - flags: DWORD; -begin - // retrieve channel flags - flags := BASS_ChannelFlags(Handle, 0, 0); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop'); - Result := false; - Exit; - end; - Result := (flags and BASS_SAMPLE_LOOP) <> 0; -end; - -procedure TBassDecodeStream.SetLoop(Enabled: boolean); -var - flags: DWORD; -begin - // set/unset loop-flag - if (Enabled) then - flags := BASS_SAMPLE_LOOP - else - flags := 0; - - // set new flag-bits - if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then - begin - Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop'); - Exit; - end; -end; - -function TBassDecodeStream.IsEOF(): boolean; -begin - Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED); -end; - -function TBassDecodeStream.IsError(): boolean; -begin - Result := Error; -end; - -function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer; -begin - Result := BASS_ChannelGetData(Handle, Buffer, BufSize); - // check error state (do not handle EOF as error) - if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then - Error := true - else - Error := false; -end; - - -{ TAudioDecoder_Bass } - -function TAudioDecoder_Bass.GetName: String; -begin - result := 'BASS_Decoder'; -end; - -function TAudioDecoder_Bass.InitializeDecoder(): boolean; -begin - BassCore := TAudioCore_Bass.GetInstance(); - Result := true; -end; - -function TAudioDecoder_Bass.FinalizeDecoder(): boolean; -begin - Result := true; -end; - -function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream; -var - Stream: HSTREAM; - ChannelInfo: BASS_CHANNELINFO; - FileExt: string; -begin - Result := nil; - - // check if BASS was initialized - // in case the decoder is not used with BASS playback, init the NO_SOUND device - if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then - BASS_Init(0, 44100, 0, 0, nil); - - // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files? - // disadvantage: seeking will slow down. - Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE); - if (Stream = 0) then - begin - //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open'); - Exit; - end; - - // check if BASS opened some erroneously recognized file-formats - if BASS_ChannelGetInfo(Stream, channelInfo) then - begin - fileExt := ExtractFileExt(Filename); - // BASS opens FLV-files (maybe others too) although it cannot handle them. - // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help. - if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then - begin - BASS_StreamFree(Stream); - Exit; - end; - end; - - Result := TBassDecodeStream.Create(Stream); -end; - - -initialization - MediaManager.Add(TAudioDecoder_Bass.Create); - -end. diff --git a/src/base/UAudioDecoder_FFmpeg.pas b/src/base/UAudioDecoder_FFmpeg.pas deleted file mode 100644 index d9b4c93c..00000000 --- a/src/base/UAudioDecoder_FFmpeg.pas +++ /dev/null @@ -1,1114 +0,0 @@ -unit UAudioDecoder_FFmpeg; - -(******************************************************************************* - * - * This unit is primarily based upon - - * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - * - * and tutorial03.c - * - * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - * - *******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// show FFmpeg specific debug output -{.$DEFINE DebugFFmpegDecode} - -// FFmpeg is very verbose and shows a bunch of errors. -// Those errors (they can be considered as warnings by us) can be ignored -// as they do not give any useful information. -// There is no solution to fix this except for turning them off. -{.$DEFINE EnableFFmpegErrorOutput} - -implementation - -uses - Classes, - SysUtils, - Math, - UMusic, - UIni, - UMain, - avcodec, - avformat, - avutil, - avio, - mathematics, // used for av_rescale_q - rational, - UMediaCore_FFmpeg, - SDL, - ULog, - UCommon, - UConfig; - -const - MAX_AUDIOQ_SIZE = (5 * 16 * 1024); - -const - // TODO: The factor 3/2 might not be necessary as we do not need extra - // space for synchronizing as in the tutorial. - AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2; - -type - TFFmpegDecodeStream = class(TAudioDecodeStream) - private - StateLock: PSDL_Mutex; - - EOFState: boolean; // end-of-stream flag (locked by StateLock) - ErrorState: boolean; // error flag (locked by StateLock) - - QuitRequest: boolean; // (locked by StateLock) - ParserIdleCond: PSDL_Cond; - - // parser pause/resume data - ParserLocked: boolean; - ParserPauseRequestCount: integer; - ParserUnlockedCond: PSDL_Cond; - ParserResumeCond: PSDL_Cond; - - SeekRequest: boolean; // (locked by StateLock) - SeekFlags: integer; // (locked by StateLock) - SeekPos: double; // stream position to seek for (in secs) (locked by StateLock) - SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock) - SeekFinishedCond: PSDL_Cond; - - Loop: boolean; // (locked by StateLock) - - ParseThread: PSDL_Thread; - PacketQueue: TPacketQueue; - - FormatInfo: TAudioFormatInfo; - - // FFmpeg specific data - FormatCtx: PAVFormatContext; - CodecCtx: PAVCodecContext; - Codec: PAVCodec; - - AudioStreamIndex: integer; - AudioStream: PAVStream; - AudioStreamPos: double; // stream position in seconds (locked by DecoderLock) - - // decoder pause/resume data - DecoderLocked: boolean; - DecoderPauseRequestCount: integer; - DecoderUnlockedCond: PSDL_Cond; - DecoderResumeCond: PSDL_Cond; - - // state-vars for DecodeFrame (locked by DecoderLock) - AudioPaket: TAVPacket; - AudioPaketData: PChar; - AudioPaketSize: integer; - AudioPaketSilence: integer; // number of bytes of silence to return - - // state-vars for AudioCallback (locked by DecoderLock) - AudioBufferPos: integer; - AudioBufferSize: integer; - AudioBuffer: PChar; - - Filename: string; - - procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); - procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} - procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF} - function IsSeeking(): boolean; - function IsQuit(): boolean; - - procedure Reset(); - - procedure Parse(); - function ParseLoop(): boolean; - procedure PauseParser(); - procedure ResumeParser(); - - function DecodeFrame(Buffer: PChar; BufferSize: integer): integer; - procedure FlushCodecBuffers(); - procedure PauseDecoder(); - procedure ResumeDecoder(); - public - constructor Create(); - destructor Destroy(); override; - - function Open(const Filename: string): boolean; - procedure Close(); override; - - function GetLength(): real; override; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - end; - -type - TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder ) - public - function GetName: string; - - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - function Open(const Filename: string): TAudioDecodeStream; - end; - -var - FFmpegCore: TMediaCore_FFmpeg; - -function ParseThreadMain(Data: Pointer): integer; cdecl; forward; - - -{ TFFmpegDecodeStream } - -constructor TFFmpegDecodeStream.Create(); -begin - inherited Create(); - - StateLock := SDL_CreateMutex(); - ParserUnlockedCond := SDL_CreateCond(); - ParserResumeCond := SDL_CreateCond(); - ParserIdleCond := SDL_CreateCond(); - SeekFinishedCond := SDL_CreateCond(); - DecoderUnlockedCond := SDL_CreateCond(); - DecoderResumeCond := SDL_CreateCond(); - - // according to the documentation of avcodec_decode_audio(2), sample-data - // should be aligned on a 16 byte boundary. Otherwise internal calls - // (e.g. to SSE or Altivec operations) might fail or lack performance on some - // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher - // alignment for buffers of this size (alignment depends on the size of the - // requested buffer), we will set the alignment explicitly as the minimum - // alignment used by Delphi and FPC is on an 8 byte boundary. - // - // Note: AudioBuffer was previously defined as a field of type TAudioBuffer - // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated. - // Fields of records are aligned different to memory allocated with GetMem(), - // aligning depending on the type but will be at least 2 bytes. - // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive - // was not applicable as Delphi in contrast to FPC provides at most 8 byte - // alignment ({$ALIGN 16} is not supported) by this directive. - AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16); - - Reset(); -end; - -procedure TFFmpegDecodeStream.Reset(); -begin - ParseThread := nil; - - EOFState := false; - ErrorState := false; - Loop := false; - QuitRequest := false; - - AudioPaketData := nil; - AudioPaketSize := 0; - AudioPaketSilence := 0; - - AudioBufferPos := 0; - AudioBufferSize := 0; - - ParserLocked := false; - ParserPauseRequestCount := 0; - DecoderLocked := false; - DecoderPauseRequestCount := 0; - - FillChar(AudioPaket, SizeOf(TAVPacket), 0); -end; - -{* - * Frees the decode-stream data. - *} -destructor TFFmpegDecodeStream.Destroy(); -begin - Close(); - - SDL_DestroyMutex(StateLock); - SDL_DestroyCond(ParserUnlockedCond); - SDL_DestroyCond(ParserResumeCond); - SDL_DestroyCond(ParserIdleCond); - SDL_DestroyCond(SeekFinishedCond); - SDL_DestroyCond(DecoderUnlockedCond); - SDL_DestroyCond(DecoderResumeCond); - - FreeAlignedMem(AudioBuffer); - - inherited; -end; - -function TFFmpegDecodeStream.Open(const Filename: string): boolean; -var - SampleFormat: TAudioSampleFormat; - AVResult: integer; -begin - Result := false; - - Close(); - Reset(); - - if (not FileExists(Filename)) then - begin - Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg'); - Exit; - end; - - Self.Filename := Filename; - - // open audio file - if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then - begin - Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg'); - Exit; - end; - - // generate PTS values if they do not exist - FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS; - - // retrieve stream information - if (av_find_stream_info(FormatCtx) < 0) then - begin - Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end - FormatCtx^.pb.eof_reached := 0; - - {$IFDEF DebugFFmpegDecode} - dump_format(FormatCtx, 0, pchar(Filename), 0); - {$ENDIF} - - AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx); - if (AudioStreamIndex < 0) then - begin - Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg'); - - AudioStream := FormatCtx.streams[AudioStreamIndex]; - CodecCtx := AudioStream^.codec; - - // TODO: should we use this or not? Should we allow 5.1 channel audio? - (* - {$IF LIBAVCODEC_VERSION >= 51042000} - if (CodecCtx^.channels > 0) then - CodecCtx^.request_channels := Min(2, CodecCtx^.channels) - else - CodecCtx^.request_channels := 2; - {$IFEND} - *) - - Codec := avcodec_find_decoder(CodecCtx^.codec_id); - if (Codec = nil) then - begin - Log.LogError('Unsupported codec!', 'UAudio_FFmpeg'); - CodecCtx := nil; - Close(); - Exit; - end; - - // set debug options - CodecCtx^.debug_mv := 0; - CodecCtx^.debug := 0; - - // detect bug-workarounds automatically - CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT; - // error resilience strategy (careful/compliant/agressive/very_aggressive) - //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; - // allow non spec compliant speedup tricks. - //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST; - - // Note: avcodec_open() and avcodec_close() are not thread-safe and will - // fail if called concurrently by different threads. - FFmpegCore.LockAVCodec(); - try - AVResult := avcodec_open(CodecCtx, Codec); - finally - FFmpegCore.UnlockAVCodec(); - end; - if (AVResult < 0) then - begin - Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg'); - Close(); - Exit; - end; - - // now initialize the audio-format - - if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then - begin - // try standard format - SampleFormat := asfS16; - end; - - FormatInfo := TAudioFormatInfo.Create( - CodecCtx^.channels, - CodecCtx^.sample_rate, - SampleFormat - ); - - - PacketQueue := TPacketQueue.Create(); - - // finally start the decode thread - ParseThread := SDL_CreateThread(@ParseThreadMain, Self); - - Result := true; -end; - -procedure TFFmpegDecodeStream.Close(); -var - ThreadResult: integer; -begin - // wake threads waiting for packet-queue data - // Note: normally, there are no waiting threads. If there were waiting - // ones, they would block the audio-callback thread. - if (assigned(PacketQueue)) then - PacketQueue.Abort(); - - // send quit request (to parse-thread etc) - SDL_mutexP(StateLock); - QuitRequest := true; - SDL_CondBroadcast(ParserIdleCond); - SDL_mutexV(StateLock); - - // abort parse-thread - if (ParseThread <> nil) then - begin - // and wait until it terminates - SDL_WaitThread(ParseThread, ThreadResult); - ParseThread := nil; - end; - - // Close the codec - if (CodecCtx <> nil) then - begin - // avcodec_close() is not thread-safe - FFmpegCore.LockAVCodec(); - try - avcodec_close(CodecCtx); - finally - FFmpegCore.UnlockAVCodec(); - end; - CodecCtx := nil; - end; - - // Close the video file - if (FormatCtx <> nil) then - begin - av_close_input_file(FormatCtx); - FormatCtx := nil; - end; - - PerformOnClose(); - - FreeAndNil(PacketQueue); - FreeAndNil(FormatInfo); -end; - -function TFFmpegDecodeStream.GetLength(): real; -begin - // do not forget to consider the start_time value here - Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE; -end; - -function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TFFmpegDecodeStream.IsEOF(): boolean; -begin - SDL_mutexP(StateLock); - Result := EOFState; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetEOF(State: boolean); -begin - SDL_mutexP(StateLock); - EOFState := State; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsError(): boolean; -begin - SDL_mutexP(StateLock); - Result := ErrorState; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetError(State: boolean); -begin - SDL_mutexP(StateLock); - ErrorState := State; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsSeeking(): boolean; -begin - SDL_mutexP(StateLock); - Result := SeekRequest; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.IsQuit(): boolean; -begin - SDL_mutexP(StateLock); - Result := QuitRequest; - SDL_mutexV(StateLock); -end; - -function TFFmpegDecodeStream.GetPosition(): real; -var - BufferSizeSec: double; -begin - PauseDecoder(); - - // ReadData() does not return all of the buffer retrieved by DecodeFrame(). - // Determine the size of the unused part of the decode-buffer. - BufferSizeSec := (AudioBufferSize - AudioBufferPos) / - FormatInfo.BytesPerSec; - - // subtract the size of unused buffer-data from the audio clock. - Result := AudioStreamPos - BufferSizeSec; - - ResumeDecoder(); -end; - -procedure TFFmpegDecodeStream.SetPosition(Time: real); -begin - SetPositionIntern(Time, true, true); -end; - -function TFFmpegDecodeStream.GetLoop(): boolean; -begin - SDL_mutexP(StateLock); - Result := Loop; - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean); -begin - SDL_mutexP(StateLock); - Loop := Enabled; - SDL_mutexV(StateLock); -end; - - -(******************************************** - * Parser section - ********************************************) - -procedure TFFmpegDecodeStream.PauseParser(); -begin - if (SDL_ThreadID() = ParseThread.threadid) then - Exit; - - SDL_mutexP(StateLock); - Inc(ParserPauseRequestCount); - while (ParserLocked) do - SDL_CondWait(ParserUnlockedCond, StateLock); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.ResumeParser(); -begin - if (SDL_ThreadID() = ParseThread.threadid) then - Exit; - - SDL_mutexP(StateLock); - Dec(ParserPauseRequestCount); - SDL_CondSignal(ParserResumeCond); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean); -begin - // - Pause the parser first to prevent it from putting obsolete packages - // into the queue after the queue was flushed and before seeking is done. - // Otherwise we will hear fragments of old data, if the stream was seeked - // in stopped mode and resumed afterwards (applies to non-blocking mode only). - // - Pause the decoder to avoid race-condition that might occur otherwise. - // - Last lock the state lock because we are manipulating some shared state-vars. - PauseParser(); - PauseDecoder(); - SDL_mutexP(StateLock); - - // configure seek parameters - SeekPos := Time; - SeekFlush := Flush; - SeekFlags := AVSEEK_FLAG_ANY; - SeekRequest := true; - - // Note: the BACKWARD-flag seeks to the first position <= the position - // searched for. Otherwise e.g. position 0 might not be seeked correct. - // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame - // following. In streams with few key-frames (like many flv-files) the next - // key-frame after 0 might be 5secs ahead. - if (Time < AudioStreamPos) then - SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; - - EOFState := false; - ErrorState := false; - - // send a reuse signal in case the parser was stopped (e.g. because of an EOF) - SDL_CondSignal(ParserIdleCond); - - SDL_mutexV(StateLock); - ResumeDecoder(); - ResumeParser(); - - // in blocking mode, wait until seeking is done - if (Blocking) then - begin - SDL_mutexP(StateLock); - while (SeekRequest) do - SDL_CondWait(SeekFinishedCond, StateLock); - SDL_mutexV(StateLock); - end; -end; - -function ParseThreadMain(Data: Pointer): integer; cdecl; -var - Stream: TFFmpegDecodeStream; -begin - Stream := TFFmpegDecodeStream(Data); - if (Stream <> nil) then - Stream.Parse(); - Result := 0; -end; - -procedure TFFmpegDecodeStream.Parse(); -begin - // reuse thread as long as the stream is not terminated - while (ParseLoop()) do - begin - // wait for reuse or destruction of stream - SDL_mutexP(StateLock); - while (not (SeekRequest or QuitRequest)) do - SDL_CondWait(ParserIdleCond, StateLock); - SDL_mutexV(StateLock); - end; -end; - -(** - * Parser main loop. - * Will not return until parsing of the stream is finished. - * Reasons for the parser to return are: - * - the end-of-file is reached - * - an error occured - * - the stream was quited (received a quit-request) - * Returns true if the stream can be resumed or false if the stream has to - * be terminated. - *) -function TFFmpegDecodeStream.ParseLoop(): boolean; -var - Packet: TAVPacket; - StatusPacket: PAVPacket; - SeekTarget: int64; - ByteIOCtx: PByteIOContext; - ErrorCode: integer; - StartSilence: double; // duration of silence at start of stream - StartSilencePtr: PDouble; // pointer for the EMPTY status packet - - // Note: pthreads wakes threads waiting on a mutex in the order of their - // priority and not in FIFO order. SDL does not provide any option to - // control priorities. This might (and already did) starve threads waiting - // on the mutex (e.g. SetPosition) making usdx look like it was froozen. - // Instead of simply locking the critical section we set a ParserLocked flag - // instead and give priority to the threads requesting the parser to pause. - procedure LockParser(); - begin - SDL_mutexP(StateLock); - while (ParserPauseRequestCount > 0) do - SDL_CondWait(ParserResumeCond, StateLock); - ParserLocked := true; - SDL_mutexV(StateLock); - end; - - procedure UnlockParser(); - begin - SDL_mutexP(StateLock); - ParserLocked := false; - SDL_CondBroadcast(ParserUnlockedCond); - SDL_mutexV(StateLock); - end; - -begin - Result := true; - - while (true) do - begin - LockParser(); - try - - if (IsQuit()) then - begin - Result := false; - Exit; - end; - - // handle seek-request (Note: no need to lock SeekRequest here) - if (SeekRequest) then - begin - // first try: seek on the audio stream - SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base)); - StartSilence := 0; - if (SeekTarget < AudioStream^.start_time) then - StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base); - ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags); - - if (ErrorCode < 0) then - begin - // second try: seek on the default stream (necessary for flv-videos and some ogg-files) - SeekTarget := Round(SeekPos * AV_TIME_BASE); - StartSilence := 0; - if (SeekTarget < FormatCtx^.start_time) then - StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE; - ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags); - end; - - // pause decoder and lock state (keep the lock-order to avoid deadlocks). - // Note that the decoder does not block in the packet-queue in seeking state, - // so locking the decoder here does not cause a dead-lock. - PauseDecoder(); - SDL_mutexP(StateLock); - try - if (ErrorCode < 0) then - begin - // seeking failed - ErrorState := true; - Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg'); - end - else - begin - if (SeekFlush) then - begin - // flush queue (we will send a Flush-Packet when seeking is finished) - PacketQueue.Flush(); - - // flush the decode buffers - AudioBufferSize := 0; - AudioBufferPos := 0; - AudioPaketSize := 0; - AudioPaketSilence := 0; - FlushCodecBuffers(); - - // Set preliminary stream position. The position will be set to - // the correct value as soon as the first packet is decoded. - AudioStreamPos := SeekPos; - end - else - begin - // request avcodec buffer flush - PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil); - end; - - // fill the gap between position 0 and start_time with silence - // but not if we are in loop mode - if ((StartSilence > 0) and (not Loop)) then - begin - GetMem(StartSilencePtr, SizeOf(StartSilence)); - StartSilencePtr^ := StartSilence; - PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr); - end; - end; - - SeekRequest := false; - SDL_CondBroadcast(SeekFinishedCond); - finally - SDL_mutexV(StateLock); - ResumeDecoder(); - end; - end; - - if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then - begin - SDL_Delay(10); - Continue; - end; - - if (av_read_frame(FormatCtx, Packet) < 0) then - begin - // failed to read a frame, check reason - {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} - ByteIOCtx := FormatCtx^.pb; - {$ELSE} - ByteIOCtx := @FormatCtx^.pb; - {$IFEND} - - // check for end-of-file (eof is not an error) - if (url_feof(ByteIOCtx) <> 0) then - begin - if (GetLoop()) then - begin - // rewind stream (but do not flush) - SetPositionIntern(0, false, false); - Continue; - end - else - begin - // signal end-of-file - PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil); - Exit; - end; - end; - - // check for errors - if (url_ferror(ByteIOCtx) <> 0) then - begin - // an error occured -> abort and wait for repositioning or termination - PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil); - Exit; - end; - - // no error -> wait for user input - SDL_Delay(100); - Continue; - end; - - if (Packet.stream_index = AudioStreamIndex) then - PacketQueue.Put(@Packet) - else - av_free_packet(@Packet); - - finally - UnlockParser(); - end; - end; -end; - - -(******************************************** - * Decoder section - ********************************************) - -procedure TFFmpegDecodeStream.PauseDecoder(); -begin - SDL_mutexP(StateLock); - Inc(DecoderPauseRequestCount); - while (DecoderLocked) do - SDL_CondWait(DecoderUnlockedCond, StateLock); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.ResumeDecoder(); -begin - SDL_mutexP(StateLock); - Dec(DecoderPauseRequestCount); - SDL_CondSignal(DecoderResumeCond); - SDL_mutexV(StateLock); -end; - -procedure TFFmpegDecodeStream.FlushCodecBuffers(); -begin - // if no flush operation is specified, avcodec_flush_buffers will not do anything. - if (@CodecCtx.codec.flush <> nil) then - begin - // flush buffers used by avcodec_decode_audio, etc. - avcodec_flush_buffers(CodecCtx); - end - else - begin - // we need a Workaround to avoid plopping noise with ogg-vorbis and - // mp3 (in older versions of FFmpeg). - // We will just reopen the codec. - FFmpegCore.LockAVCodec(); - try - avcodec_close(CodecCtx); - avcodec_open(CodecCtx, Codec); - finally - FFmpegCore.UnlockAVCodec(); - end; - end; -end; - -function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer; -var - PaketDecodedSize: integer; // size of packet data used for decoding - DataSize: integer; // size of output data decoded by FFmpeg - BlockQueue: boolean; - SilenceDuration: double; - {$IFDEF DebugFFmpegDecode} - TmpPos: double; - {$ENDIF} -begin - Result := -1; - - if (EOF) then - Exit; - - while(true) do - begin - // for titles with start_time > 0 we have to generate silence - // until we reach the pts of the first data packet. - if (AudioPaketSilence > 0) then - begin - DataSize := Min(AudioPaketSilence, BufferSize); - FillChar(Buffer[0], DataSize, 0); - Dec(AudioPaketSilence, DataSize); - AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; - Result := DataSize; - Exit; - end; - - // read packet data - while (AudioPaketSize > 0) do - begin - DataSize := BufferSize; - - {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 - PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer), - DataSize, AudioPaketData, AudioPaketSize); - {$ELSE} - PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer), - DataSize, AudioPaketData, AudioPaketSize); - {$IFEND} - - if(PaketDecodedSize < 0) then - begin - // if error, skip frame - {$IFDEF DebugFFmpegDecode} - DebugWriteln('Skip audio frame'); - {$ENDIF} - AudioPaketSize := 0; - Break; - end; - - Inc(AudioPaketData, PaketDecodedSize); - Dec(AudioPaketSize, PaketDecodedSize); - - // check if avcodec_decode_audio returned data, otherwise fetch more frames - if (DataSize <= 0) then - Continue; - - // update stream position by the amount of fetched data - AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec; - - // we have data, return it and come back for more later - Result := DataSize; - Exit; - end; - - // free old packet data - if (AudioPaket.data <> nil) then - av_free_packet(@AudioPaket); - - // do not block queue on seeking (to avoid deadlocks on the DecoderLock) - if (IsSeeking()) then - BlockQueue := false - else - BlockQueue := true; - - // request a new packet and block if none available. - // If this fails, the queue was aborted. - if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then - Exit; - - // handle Status-packet - if (PChar(AudioPaket.data) = STATUS_PACKET) then - begin - AudioPaket.data := nil; - AudioPaketData := nil; - AudioPaketSize := 0; - - case (AudioPaket.flags) of - PKT_STATUS_FLAG_FLUSH: - begin - // just used if SetPositionIntern was called without the flush flag. - FlushCodecBuffers; - end; - PKT_STATUS_FLAG_EOF: // end-of-file - begin - // ignore EOF while seeking - if (not IsSeeking()) then - SetEOF(true); - // buffer contains no data -> result = -1 - Exit; - end; - PKT_STATUS_FLAG_ERROR: - begin - SetError(true); - Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame'); - Exit; - end; - PKT_STATUS_FLAG_EMPTY: - begin - SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^; - AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize; - PacketQueue.FreeStatusInfo(AudioPaket); - end - else - begin - Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame'); - end; - end; - - Continue; - end; - - AudioPaketData := PChar(AudioPaket.data); - AudioPaketSize := AudioPaket.size; - - // if available, update the stream position to the presentation time of this package - if(AudioPaket.pts <> AV_NOPTS_VALUE) then - begin - {$IFDEF DebugFFmpegDecode} - TmpPos := AudioStreamPos; - {$ENDIF} - AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts; - {$IFDEF DebugFFmpegDecode} - DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' + - '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' + - 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3)); - {$ENDIF} - end; - end; -end; - -function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - CopyByteCount: integer; // number of bytes to copy - RemainByteCount: integer; // number of bytes left (remain) to read - BufferPos: integer; - - // prioritize pause requests - procedure LockDecoder(); - begin - SDL_mutexP(StateLock); - while (DecoderPauseRequestCount > 0) do - SDL_CondWait(DecoderResumeCond, StateLock); - DecoderLocked := true; - SDL_mutexV(StateLock); - end; - - procedure UnlockDecoder(); - begin - SDL_mutexP(StateLock); - DecoderLocked := false; - SDL_CondBroadcast(DecoderUnlockedCond); - SDL_mutexV(StateLock); - end; - -begin - Result := -1; - - // set number of bytes to copy to the output buffer - BufferPos := 0; - - LockDecoder(); - try - // leave if end-of-file is reached - if (EOF) then - Exit; - - // copy data to output buffer - while (BufferPos < BufferSize) do - begin - // check if we need more data - if (AudioBufferPos >= AudioBufferSize) then - begin - AudioBufferPos := 0; - - // we have already sent all our data; get more - AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE); - - // check for errors or EOF - if(AudioBufferSize < 0) then - begin - Result := BufferPos; - Exit; - end; - end; - - // calc number of new bytes in the decode-buffer - CopyByteCount := AudioBufferSize - AudioBufferPos; - // resize copy-count if more bytes available than needed (remaining bytes are used the next time) - RemainByteCount := BufferSize - BufferPos; - if (CopyByteCount > RemainByteCount) then - CopyByteCount := RemainByteCount; - - Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount); - - Inc(BufferPos, CopyByteCount); - Inc(AudioBufferPos, CopyByteCount); - end; - finally - UnlockDecoder(); - end; - - Result := BufferSize; -end; - - -{ TAudioDecoder_FFmpeg } - -function TAudioDecoder_FFmpeg.GetName: String; -begin - Result := 'FFmpeg_Decoder'; -end; - -function TAudioDecoder_FFmpeg.InitializeDecoder: boolean; -begin - //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg'); - FFmpegCore := TMediaCore_FFmpeg.GetInstance(); - av_register_all(); - - // Do not show uninformative error messages by default. - // FFmpeg prints all error-infos on the console by default what - // is very confusing as the playback of the files is correct. - // We consider these errors to be internal to FFMpeg. They can be fixed - // by the FFmpeg guys only and do not provide any useful information in - // respect to USDX. - {$IFNDEF EnableFFmpegErrorOutput} - {$IF LIBAVUTIL_VERSION_MAJOR >= 50} - av_log_set_level(AV_LOG_FATAL); - {$ELSE} - // FATAL and ERROR share one log-level, so we have to use QUIET - av_log_set_level(AV_LOG_QUIET); - {$IFEND} - {$ENDIF} - - Result := true; -end; - -function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean; -begin - Result := true; -end; - -function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream; -var - Stream: TFFmpegDecodeStream; -begin - Result := nil; - - Stream := TFFmpegDecodeStream.Create(); - if (not Stream.Open(Filename)) then - begin - Stream.Free; - Exit; - end; - - Result := Stream; -end; - - -initialization - MediaManager.Add(TAudioDecoder_FFmpeg.Create); - -end. diff --git a/src/base/UAudioInput_Bass.pas b/src/base/UAudioInput_Bass.pas deleted file mode 100644 index 65a4704d..00000000 --- a/src/base/UAudioInput_Bass.pas +++ /dev/null @@ -1,481 +0,0 @@ -unit UAudioInput_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - URecord, - UMusic; - -implementation - -uses - UMain, - UIni, - ULog, - UAudioCore_Bass, - UCommon, // (Note: for MakeLong on non-windows platforms) - {$IFDEF MSWINDOWS} - Windows, // (Note: for MakeLong) - {$ENDIF} - bass; // (Note: DWORD is redefined here -> insert after Windows-unit) - -type - TAudioInput_Bass = class(TAudioInputBase) - private - function EnumDevices(): boolean; - public - function GetName: String; override; - function InitializeRecord: boolean; override; - function FinalizeRecord: boolean; override; - end; - - TBassInputDevice = class(TAudioInputDevice) - private - RecordStream: HSTREAM; - BassDeviceID: DWORD; // DeviceID used by BASS - SingleIn: boolean; - - function SetInputSource(SourceIndex: integer): boolean; - function GetInputSource(): integer; - public - function Open(): boolean; - function Close(): boolean; - function Start(): boolean; override; - function Stop(): boolean; override; - - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - end; - -var - BassCore: TAudioCore_Bass; - - -{ Global } - -{* - * Bass input capture callback. - * Params: - * stream - BASS input stream - * buffer - buffer of captured samples - * len - size of buffer in bytes - * user - players associated with left/right channels - *} -function MicrophoneCallback(stream: HSTREAM; buffer: Pointer; - len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -begin - AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice); - Result := true; -end; - - -{ TBassInputDevice } - -function TBassInputDevice.GetInputSource(): integer; -var - SourceCnt: integer; - i: integer; - flags: DWORD; -begin - // get input-source config (subtract virtual device to get BASS indices) - SourceCnt := Length(Source)-1; - - // find source - Result := -1; - for i := 0 to SourceCnt-1 do - begin - // get input settings - flags := BASS_RecordGetInput(i, PSingle(nil)^); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); - Exit; - end; - - // check if current source is selected - if ((flags and BASS_INPUT_OFF) = 0) then - begin - // selected source found - Result := i; - Exit; - end; - end; -end; - -function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean; -var - SourceCnt: integer; - i: integer; - flags: DWORD; -begin - Result := false; - - // check for invalid source index - if (SourceIndex < 0) then - Exit; - - // get input-source config (subtract virtual device to get BASS indices) - SourceCnt := Length(Source)-1; - - // turn on selected source (turns off the others for single-in devices) - if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then - begin - Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); - Exit; - end; - - // turn off all other sources (not needed for single-in devices) - if (not SingleIn) then - begin - for i := 0 to SourceCnt-1 do - begin - if (i = SourceIndex) then - continue; - // get input settings - flags := BASS_RecordGetInput(i, PSingle(nil)^); - if (flags = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource'); - Exit; - end; - // deselect source if selected - if ((flags and BASS_INPUT_OFF) = 0) then - BASS_RecordSetInput(i, BASS_INPUT_OFF, -1); - end; - end; - - Result := true; -end; - -function TBassInputDevice.Open(): boolean; -var - FormatFlags: DWORD; - SourceIndex: integer; -const - latency = 20; // 20ms callback period (= latency) -begin - Result := false; - - if (not BASS_RecordInit(BassDeviceID)) then - begin - Log.LogError('BASS_RecordInit['+Name+']: ' + - BassCore.ErrorGetString(), 'TBassInputDevice.Open'); - Exit; - end; - - if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then - begin - Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open'); - Exit; - end; - - // start capturing in paused state - RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels, - MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency), - @MicrophoneCallback, Self); - if (RecordStream = 0) then - begin - Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open'); - BASS_RecordFree; - Exit; - end; - - // save current source selection and select new source - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // nothing to do if default source is used - SourceRestore := -1; - end - else - begin - // store current source-index and select new source - SourceRestore := GetInputSource(); - SetInputSource(SourceIndex); - end; - - Result := true; -end; - -{* Start input-capturing on this device. *} -function TBassInputDevice.Start(): boolean; -begin - Result := false; - - // recording already started -> stop first - if (RecordStream <> 0) then - Stop(); - - // TODO: Do not open the device here (takes too much time). - if not Open() then - Exit; - - if (not BASS_ChannelPlay(RecordStream, true)) then - begin - Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start'); - Exit; - end; - - Result := true; -end; - -{* Stop input-capturing on this device. *} -function TBassInputDevice.Stop(): boolean; -begin - Result := false; - - if (RecordStream = 0) then - Exit; - if (not BASS_RecordSetDevice(BassDeviceID)) then - Exit; - - if (not BASS_ChannelStop(RecordStream)) then - begin - Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop'); - end; - - // TODO: Do not close the device here (takes too much time). - Result := Close(); -end; - -function TBassInputDevice.Close(): boolean; -begin - // restore source selection - if (SourceRestore >= 0) then - begin - SetInputSource(SourceRestore); - end; - - // free data - if (not BASS_RecordFree()) then - begin - Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close'); - Result := false; - end - else - begin - Result := true; - end; - - RecordStream := 0; -end; - -function TBassInputDevice.GetVolume(): single; -var - SourceIndex: integer; - lVolume: Single; -begin - Result := 0; - - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // if default source used find selected source - SourceIndex := GetInputSource(); - if (SourceIndex = -1) then - Exit; - end; - - if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then - begin - Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume'); - Exit; - end; - Result := lVolume; -end; - -procedure TBassInputDevice.SetVolume(Volume: single); -var - SourceIndex: integer; -begin - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // if default source used find selected source - SourceIndex := GetInputSource(); - if (SourceIndex = -1) then - Exit; - end; - - // clip volume to valid range - if (Volume > 1.0) then - Volume := 1.0 - else if (Volume < 0) then - Volume := 0; - - if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then - begin - Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume'); - end; -end; - - -{ TAudioInput_Bass } - -function TAudioInput_Bass.GetName: String; -begin - result := 'BASS_Input'; -end; - -function TAudioInput_Bass.EnumDevices(): boolean; -var - Descr: PChar; - SourceName: PChar; - Flags: integer; - BassDeviceID: integer; - BassDevice: TBassInputDevice; - DeviceIndex: integer; - DeviceInfo: BASS_DEVICEINFO; - SourceIndex: integer; - RecordInfo: BASS_RECORDINFO; - SelectedSourceIndex: integer; -begin - result := false; - - DeviceIndex := 0; - BassDeviceID := 0; - SetLength(AudioInputProcessor.DeviceList, 0); - - // checks for recording devices and puts them into an array - while true do - begin - if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then - break; - - // try to initialize the device - if not BASS_RecordInit(BassDeviceID) then - begin - Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']', - 'TAudioInput_Bass.InitializeRecord'); - end - else - begin - SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1); - - // TODO: free object on termination - BassDevice := TBassInputDevice.Create(); - AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice; - - Descr := DeviceInfo.name; - - BassDevice.BassDeviceID := BassDeviceID; - BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex); - - // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX) - FillChar(RecordInfo, SizeOf(RecordInfo), 0); - // retrieve recording device info - BASS_RecordGetInfo(RecordInfo); - - // check if BASS has capture-freq. info - if (RecordInfo.freq > 0) then - begin - // use current input sample rate (available only on Windows Vista and OSX). - // Recording at this rate will give the best quality and performance, as no resampling is required. - // FIXME: does BASS use LSB/MSB or system integer values for 16bit? - BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16) - end - else - begin - // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats) - // but it doesn't fail if we use stereo input on a mono device - // -> use stereo by default - BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16) - end; - - // get info if multiple input-sources can be selected at once - BassDevice.SingleIn := RecordInfo.singlein; - - // init list for capture buffers per channel - SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels); - - BassDevice.MicSource := -1; - BassDevice.SourceRestore := -1; - - // add a virtual default source (will not change mixer-settings) - SetLength(BassDevice.Source, 1); - BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME; - - // add real input sources - SourceIndex := 1; - - // process each input - while true do - begin - SourceName := BASS_RecordGetInputName(SourceIndex-1); - - {$IFDEF DARWIN} - // Under MacOSX the SingStar Mics have an empty InputName. - // So, we have to add a hard coded Workaround for this problem - // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem? - // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe - // BASS is not able to detect any mic-sources (the default source will work then). - // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case - // we could use this value to check if the device exists. - // Please check that, eddie. - // If it returns false, then the source is not detected and it does not make sense to add a second - // fake device here. - // What about BASS_RecordGetInput()? Does it return a value <> -1? - // - Does it even work at all with this fake source-index, now that input switching works? - // This info was not used before (sources were never switched), so it did not matter what source-index was used. - // But now BASS_RecordSetInput() will probably fail. - if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then - SourceName := 'Microphone' - {$ENDIF} - - if (SourceName = nil) then - break; - - SetLength(BassDevice.Source, Length(BassDevice.Source)+1); - BassDevice.Source[SourceIndex].Name := SourceName; - - // get input-source info - Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^); - if (Flags <> -1) then - begin - // is the current source a mic-source? - if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then - BassDevice.MicSource := SourceIndex; - end; - - Inc(SourceIndex); - end; - - // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called. - // Maybe because the sound-device was not released properly? - BASS_RecordFree; - - Inc(DeviceIndex); - end; - - Inc(BassDeviceID); - end; - - result := true; -end; - -function TAudioInput_Bass.InitializeRecord(): boolean; -begin - BassCore := TAudioCore_Bass.GetInstance(); - Result := EnumDevices(); -end; - -function TAudioInput_Bass.FinalizeRecord(): boolean; -begin - CaptureStop; - Result := inherited FinalizeRecord; -end; - - -initialization - MediaManager.Add(TAudioInput_Bass.Create); - -end. diff --git a/src/base/UAudioInput_Portaudio.pas b/src/base/UAudioInput_Portaudio.pas deleted file mode 100644 index 9a1c3e99..00000000 --- a/src/base/UAudioInput_Portaudio.pas +++ /dev/null @@ -1,474 +0,0 @@ -unit UAudioInput_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I ../switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - {$IFDEF UsePortmixer} - portmixer, - {$ENDIF} - portaudio, - UAudioCore_Portaudio, - URecord, - UIni, - ULog, - UMain; - -type - TAudioInput_Portaudio = class(TAudioInputBase) - private - AudioCore: TAudioCore_Portaudio; - function EnumDevices(): boolean; - public - function GetName: String; override; - function InitializeRecord: boolean; override; - function FinalizeRecord: boolean; override; - end; - - TPortaudioInputDevice = class(TAudioInputDevice) - private - RecordStream: PPaStream; - {$IFDEF UsePortmixer} - Mixer: PPxMixer; - {$ENDIF} - PaDeviceIndex: TPaDeviceIndex; - public - function Open(): boolean; - function Close(): boolean; - function Start(): boolean; override; - function Stop(): boolean; override; - - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - end; - -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - -function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; forward; - - -{ TPortaudioInputDevice } - -function TPortaudioInputDevice.Open(): boolean; -var - Error: TPaError; - inputParams: TPaStreamParameters; - deviceInfo: PPaDeviceInfo; - SourceIndex: integer; -begin - Result := false; - - // get input latency info - deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); - - // set input stream parameters - with inputParams do - begin - device := PaDeviceIndex; - channelCount := AudioFormat.Channels; - sampleFormat := paInt16; - suggestedLatency := deviceInfo^.defaultLowInputLatency; - hostApiSpecificStreamInfo := nil; - end; - - //Log.LogStatus(deviceInfo^.name, 'Portaudio'); - //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); - - // open input stream - Error := Pa_OpenStream(RecordStream, @inputParams, nil, - AudioFormat.SampleRate, - paFramesPerBufferUnspecified, paNoFlag, - @MicrophoneCallback, Pointer(Self)); - if(Error <> paNoError) then - begin - Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); - Exit; - end; - - {$IFDEF UsePortmixer} - // open default mixer - Mixer := Px_OpenMixer(RecordStream, 0); - if (Mixer = nil) then - begin - Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open'); - end - else - begin - // save current source selection and select new source - SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1; - if (SourceIndex = -1) then - begin - // nothing to do if default source is used - SourceRestore := -1; - end - else - begin - // store current source-index and select new source - SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case - Px_SetCurrentInputSource(Mixer, SourceIndex); - end; - end; - {$ENDIF} - - Result := true; -end; - -function TPortaudioInputDevice.Start(): boolean; -var - Error: TPaError; -begin - Result := false; - - // recording already started -> stop first - if (RecordStream <> nil) then - Stop(); - - // TODO: Do not open the device here (takes too much time). - if (not Open()) then - Exit; - - // start capture - Error := Pa_StartStream(RecordStream); - if(Error <> paNoError) then - begin - Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start'); - Close(); - RecordStream := nil; - Exit; - end; - - Result := true; -end; - -function TPortaudioInputDevice.Stop(): boolean; -var - Error: TPaError; -begin - Result := false; - - if (RecordStream = nil) then - Exit; - - // Note: do NOT call Pa_StopStream here! - // It gets stuck on devices with non-working callback as Pa_StopStream - // waits until all buffers have been handled (which never occurs in that case). - Error := Pa_AbortStream(RecordStream); - if (Error <> paNoError) then - begin - Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop'); - end; - - Result := Close(); -end; - -function TPortaudioInputDevice.Close(): boolean; -var - Error: TPaError; -begin - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - begin - // restore source selection - if (SourceRestore >= 0) then - begin - Px_SetCurrentInputSource(Mixer, SourceRestore); - end; - - // close mixer - Px_CloseMixer(Mixer); - Mixer := nil; - end; - {$ENDIF} - - Error := Pa_CloseStream(RecordStream); - if (Error <> paNoError) then - begin - Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close'); - Result := false; - end - else - begin - Result := true; - end; - - RecordStream := nil; -end; - -function TPortaudioInputDevice.GetVolume(): single; -begin - Result := 0; - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - Result := Px_GetInputVolume(Mixer); - {$ENDIF} -end; - -procedure TPortaudioInputDevice.SetVolume(Volume: single); -begin - {$IFDEF UsePortmixer} - if (Mixer <> nil) then - begin - // clip to valid range - if (Volume > 1.0) then - Volume := 1.0 - else if (Volume < 0) then - Volume := 0; - Px_SetInputVolume(Mixer, Volume); - end; - {$ENDIF} -end; - - -{ TAudioInput_Portaudio } - -function TAudioInput_Portaudio.GetName: String; -begin - result := 'Portaudio'; -end; - -function TAudioInput_Portaudio.EnumDevices(): boolean; -var - i: integer; - paApiIndex: TPaHostApiIndex; - paApiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - channelCnt: integer; - SC: integer; // soundcard - err: TPaError; - errMsg: string; - paDevice: TPortaudioInputDevice; - inputParams: TPaStreamParameters; - stream: PPaStream; - streamInfo: PPaStreamInfo; - sampleRate: double; - latency: TPaTime; - {$IFDEF UsePortmixer} - mixer: PPxMixer; - sourceCnt: integer; - sourceIndex: integer; - sourceName: string; - {$ENDIF} - cbPolls: integer; - cbWorks: boolean; -begin - Result := false; - - // choose the best available Audio-API - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices'); - Exit; - end; - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - - SC := 0; - - // init array-size to max. input-devices count - SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount); - for i:= 0 to High(AudioInputProcessor.DeviceList) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - channelCnt := deviceInfo^.maxInputChannels; - - // current device is no input device -> skip - if (channelCnt <= 0) then - continue; - - // portaudio returns a channel-count of 128 for some devices - // (e.g. the "default"-device), so we have to detect those - // fantasy channel counts. - if (channelCnt > 8) then - channelCnt := 2; - - paDevice := TPortaudioInputDevice.Create(); - AudioInputProcessor.DeviceList[SC] := paDevice; - - // retrieve device-name - deviceName := deviceInfo^.name; - paDevice.Name := deviceName; - paDevice.PaDeviceIndex := deviceIndex; - - sampleRate := deviceInfo^.defaultSampleRate; - - // on vista and xp the defaultLowInputLatency may be set to 0 but it works. - // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) - latency := deviceInfo^.defaultLowInputLatency; - - // setup desired input parameters - // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might - // not be set correctly in OSS) - with inputParams do - begin - device := deviceIndex; - channelCount := channelCnt; - sampleFormat := paInt16; - suggestedLatency := latency; - hostApiSpecificStreamInfo := nil; - end; - - // check souncard and adjust sample-rate - if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then - begin - // ignore device if it does not work - Log.LogError('Device "'+paDevice.Name+'" does not work', - 'TAudioInput_Portaudio.EnumDevices'); - paDevice.Free(); - continue; - end; - - // open device for further info - err := Pa_OpenStream(stream, @inputParams, nil, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); - if(err <> paNoError) then - begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', - 'TAudioInput_Portaudio.EnumDevices'); - paDevice.Free(); - continue; - end; - - // adjust sample-rate (might be changed by portaudio) - streamInfo := Pa_GetStreamInfo(stream); - if (streamInfo <> nil) then - begin - if (sampleRate <> streamInfo^.sampleRate) then - begin - Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + - ' to ' + FloatToStr(streamInfo^.sampleRate), - 'TAudioInput_Portaudio.InitializeRecord'); - sampleRate := streamInfo^.sampleRate; - end; - end; - - // create audio-format info and resize capture-buffer array - paDevice.AudioFormat := TAudioFormatInfo.Create( - channelCnt, - sampleRate, - asfS16 - ); - SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); - - Log.LogStatus('InputDevice "'+paDevice.Name+'"@' + - IntToStr(paDevice.AudioFormat.Channels)+'x'+ - FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ - FloatTostr(inputParams.suggestedLatency)+'sec)' , - 'Portaudio.EnumDevices'); - - // portaudio does not provide a source-type check - paDevice.MicSource := -1; - paDevice.SourceRestore := -1; - - // add a virtual default source (will not change mixer-settings) - SetLength(paDevice.Source, 1); - paDevice.Source[0].Name := DEFAULT_SOURCE_NAME; - - {$IFDEF UsePortmixer} - // use default mixer - mixer := Px_OpenMixer(stream, 0); - - // get input count - sourceCnt := Px_GetNumInputSources(mixer); - SetLength(paDevice.Source, sourceCnt+1); - - // get input names - for sourceIndex := 1 to sourceCnt do - begin - sourceName := Px_GetInputSourceName(mixer, sourceIndex-1); - paDevice.Source[sourceIndex].Name := sourceName; - end; - - Px_CloseMixer(mixer); - {$ENDIF} - - // close test-stream - Pa_CloseStream(stream); - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(AudioInputProcessor.DeviceList, SC); - - Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio'); - - Result := true; -end; - -function TAudioInput_Portaudio.InitializeRecord(): boolean; -var - err: TPaError; -begin - AudioCore := TAudioCore_Portaudio.GetInstance(); - - // initialize portaudio - err := Pa_Initialize(); - if(err <> paNoError) then - begin - Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); - Result := false; - Exit; - end; - - Result := EnumDevices(); -end; - -function TAudioInput_Portaudio.FinalizeRecord: boolean; -begin - CaptureStop; - Pa_Terminate(); - Result := inherited FinalizeRecord(); -end; - -{* - * Portaudio input capture callback. - *} -function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice); - result := paContinue; -end; - -{* - * Portaudio test capture callback. - *} -function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - inputDevice: Pointer): Integer; cdecl; -begin - // this callback is called only once - result := paAbort; -end; - - -initialization - MediaManager.add(TAudioInput_Portaudio.Create); - -end. diff --git a/src/base/UAudioPlaybackBase.pas b/src/base/UAudioPlaybackBase.pas deleted file mode 100644 index 2337d43f..00000000 --- a/src/base/UAudioPlaybackBase.pas +++ /dev/null @@ -1,292 +0,0 @@ -unit UAudioPlaybackBase; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic; - -type - TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback) - protected - OutputDeviceList: TAudioOutputDeviceList; - MusicStream: TAudioPlaybackStream; - function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract; - procedure ClearOutputDeviceList(); - function GetLatency(): double; virtual; abstract; - - // open sound or music stream (used by Open() and OpenSound()) - function OpenStream(const Filename: string): TAudioPlaybackStream; - function OpenDecodeStream(const Filename: string): TAudioDecodeStream; - public - function GetName: string; virtual; abstract; - - function Open(const Filename: string): boolean; // true if succeed - procedure Close; - - procedure Play; - procedure Pause; - procedure Stop; - procedure FadeIn(Time: real; TargetVolume: single); - - procedure SetSyncSource(SyncSource: TSyncSource); - - procedure SetPosition(Time: real); - function GetPosition: real; - - function InitializePlayback: boolean; virtual; abstract; - function FinalizePlayback: boolean; virtual; - - //function SetOutputDevice(Device: TAudioOutputDevice): boolean; - function GetOutputDeviceList(): TAudioOutputDeviceList; - - procedure SetAppVolume(Volume: single); virtual; abstract; - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - - procedure Rewind; - function Finished: boolean; - function Length: real; - - // Sounds - function OpenSound(const Filename: string): TAudioPlaybackStream; - procedure PlaySound(Stream: TAudioPlaybackStream); - procedure StopSound(Stream: TAudioPlaybackStream); - - // Equalizer - procedure GetFFTData(var Data: TFFTData); - - // Interface for Visualizer - function GetPCMData(var Data: TPCMData): Cardinal; - - function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract; - end; - - -implementation - -uses - ULog, - SysUtils; - -{ TAudioPlaybackBase } - -function TAudioPlaybackBase.FinalizePlayback: boolean; -begin - FreeAndNil(MusicStream); - ClearOutputDeviceList(); - Result := true; -end; - -function TAudioPlaybackBase.Open(const Filename: string): boolean; -begin - // free old MusicStream - MusicStream.Free; - - MusicStream := OpenStream(Filename); - if not assigned(MusicStream) then - begin - Result := false; - Exit; - end; - - //MusicStream.AddSoundEffect(TVoiceRemoval.Create()); - - Result := true; -end; - -procedure TAudioPlaybackBase.Close; -begin - FreeAndNil(MusicStream); -end; - -function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream; -var - i: integer; -begin - for i := 0 to AudioDecoders.Count-1 do - begin - Result := IAudioDecoder(AudioDecoders[i]).Open(Filename); - if (assigned(Result)) then - begin - Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() + - ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream'); - Exit; - end; - end; - Result := nil; -end; - -procedure OnClosePlaybackStream(Stream: TAudioProcessingStream); -var - PlaybackStream: TAudioPlaybackStream; - SourceStream: TAudioSourceStream; -begin - PlaybackStream := TAudioPlaybackStream(Stream); - SourceStream := PlaybackStream.GetSourceStream(); - SourceStream.Free; -end; - -function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream; -var - PlaybackStream: TAudioPlaybackStream; - DecodeStream: TAudioDecodeStream; -begin - Result := nil; - - //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); - - DecodeStream := OpenDecodeStream(Filename); - if (not assigned(DecodeStream)) then - begin - Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream'); - Exit; - end; - - // create a matching playback-stream for the decoder - PlaybackStream := CreatePlaybackStream(); - if (not PlaybackStream.Open(DecodeStream)) then - begin - FreeAndNil(PlaybackStream); - FreeAndNil(DecodeStream); - Exit; - end; - - PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream); - - Result := PlaybackStream; -end; - -procedure TAudioPlaybackBase.Play; -begin - if assigned(MusicStream) then - MusicStream.Play(); -end; - -procedure TAudioPlaybackBase.Pause; -begin - if assigned(MusicStream) then - MusicStream.Pause(); -end; - -procedure TAudioPlaybackBase.Stop; -begin - if assigned(MusicStream) then - MusicStream.Stop(); -end; - -function TAudioPlaybackBase.Length: real; -begin - if assigned(MusicStream) then - Result := MusicStream.Length - else - Result := 0; -end; - -function TAudioPlaybackBase.GetPosition: real; -begin - if assigned(MusicStream) then - Result := MusicStream.Position - else - Result := 0; -end; - -procedure TAudioPlaybackBase.SetPosition(Time: real); -begin - if assigned(MusicStream) then - MusicStream.Position := Time; -end; - -procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource); -begin - if assigned(MusicStream) then - MusicStream.SetSyncSource(SyncSource); -end; - -procedure TAudioPlaybackBase.Rewind; -begin - SetPosition(0); -end; - -function TAudioPlaybackBase.Finished: boolean; -begin - if assigned(MusicStream) then - Result := (MusicStream.Status = ssStopped) - else - Result := true; -end; - -procedure TAudioPlaybackBase.SetVolume(Volume: single); -begin - if assigned(MusicStream) then - MusicStream.Volume := Volume; -end; - -procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single); -begin - if assigned(MusicStream) then - MusicStream.FadeIn(Time, TargetVolume); -end; - -procedure TAudioPlaybackBase.SetLoop(Enabled: boolean); -begin - if assigned(MusicStream) then - MusicStream.Loop := Enabled; -end; - -// Equalizer -procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData); -begin - if assigned(MusicStream) then - MusicStream.GetFFTData(data); -end; - -{* - * Copies interleaved PCM SInt16 stereo samples into data. - * Returns the number of frames - *} -function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal; -begin - if assigned(MusicStream) then - Result := MusicStream.GetPCMData(data) - else - Result := 0; -end; - -function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream; -begin - Result := OpenStream(Filename); -end; - -procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream); -begin - if assigned(stream) then - stream.Play(); -end; - -procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream); -begin - if assigned(stream) then - stream.Stop(); -end; - -procedure TAudioPlaybackBase.ClearOutputDeviceList(); -var - DeviceIndex: integer; -begin - for DeviceIndex := 0 to High(OutputDeviceList) do - OutputDeviceList[DeviceIndex].Free(); - SetLength(OutputDeviceList, 0); -end; - -function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList; -begin - Result := OutputDeviceList; -end; - -end. diff --git a/src/base/UAudioPlayback_Bass.pas b/src/base/UAudioPlayback_Bass.pas deleted file mode 100644 index 41a91173..00000000 --- a/src/base/UAudioPlayback_Bass.pas +++ /dev/null @@ -1,731 +0,0 @@ -unit UAudioPlayback_Bass; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - Classes, - SysUtils, - Math, - UIni, - UMain, - UMusic, - UAudioPlaybackBase, - UAudioCore_Bass, - ULog, - sdl, - bass; - -type - PHDSP = ^HDSP; - -type - TBassPlaybackStream = class(TAudioPlaybackStream) - private - Handle: HSTREAM; - NeedsRewind: boolean; - PausedSeek: boolean; // true if a seek was performed in pause state - - procedure Reset(); - function IsEOF(): boolean; - protected - function GetLatency(): double; override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function GetLength(): real; override; - function GetStatus(): TStreamStatus; override; - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - public - constructor Create(); - destructor Destroy(); override; - - function Open(SourceStream: TAudioSourceStream): boolean; override; - procedure Close(); override; - - procedure Play(); override; - procedure Pause(); override; - procedure Stop(); override; - procedure FadeIn(Time: real; TargetVolume: single); override; - - procedure AddSoundEffect(Effect: TSoundEffect); override; - procedure RemoveSoundEffect(Effect: TSoundEffect); override; - - procedure GetFFTData(var Data: TFFTData); override; - function GetPCMData(var Data: TPCMData): Cardinal; override; - - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - property EOF: boolean READ IsEOF; - end; - -const - MAX_VOICE_DELAY = 0.020; // 20ms - -type - TBassVoiceStream = class(TAudioVoiceStream) - private - Handle: HSTREAM; - public - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; - procedure Close(); override; - - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - end; - -type - TAudioPlayback_Bass = class(TAudioPlaybackBase) - private - function EnumDevices(): boolean; - protected - function GetLatency(): double; override; - function CreatePlaybackStream(): TAudioPlaybackStream; override; - public - function GetName: String; override; - function InitializePlayback(): boolean; override; - function FinalizePlayback: boolean; override; - procedure SetAppVolume(Volume: single); override; - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; - end; - - TBassOutputDevice = class(TAudioOutputDevice) - private - BassDeviceID: DWORD; // DeviceID used by BASS - end; - -var - BassCore: TAudioCore_Bass; - - -{ TBassPlaybackStream } - -function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD; -{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - PlaybackStream: TBassPlaybackStream; - BytesRead: integer; -begin - PlaybackStream := TBassPlaybackStream(user); - if (not assigned (PlaybackStream)) then - begin - Result := BASS_STREAMPROC_END; - Exit; - end; - - BytesRead := PlaybackStream.ReadData(buffer, length); - // check for errors - if (BytesRead < 0) then - Result := BASS_STREAMPROC_END - // check for EOF - else if (PlaybackStream.EOF) then - Result := BytesRead or BASS_STREAMPROC_END - // no error/EOF - else - Result := BytesRead; -end; - -function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - AdjustedSize: integer; - RequestedSourceSize, SourceSize: integer; - SkipCount: integer; - SourceFormatInfo: TAudioFormatInfo; - FrameSize: integer; - PadFrame: PChar; - //Info: BASS_INFO; - //Latency: double; -begin - Result := -1; - - if (not assigned(SourceStream)) then - Exit; - - // sanity check - if (BufferSize = 0) then - begin - Result := 0; - Exit; - end; - - SourceFormatInfo := SourceStream.GetAudioFormatInfo(); - FrameSize := SourceFormatInfo.FrameSize; - - // check how much data to fetch to be in synch - AdjustedSize := Synchronize(BufferSize, SourceFormatInfo); - - // skip data if we are too far behind - SkipCount := AdjustedSize - BufferSize; - while (SkipCount > 0) do - begin - RequestedSourceSize := Min(SkipCount, BufferSize); - SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); - // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData() - if (SourceSize <= 0) then - break; - Dec(SkipCount, SourceSize); - end; - - // get source data (e.g. from a decoder) - RequestedSourceSize := Min(AdjustedSize, BufferSize); - SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize); - if (SourceSize < 0) then - Exit; - - // set preliminary result - Result := SourceSize; - - // if we are to far ahead, fill output-buffer with last frame of source data - // Note that AdjustedSize is used instead of SourceSize as the SourceSize might - // be less than expected because of errors etc. - if (AdjustedSize < BufferSize) then - begin - // use either the last frame for padding or fill with zero - if (SourceSize >= FrameSize) then - PadFrame := @Buffer[SourceSize-FrameSize] - else - PadFrame := nil; - - FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize, - PadFrame, FrameSize); - Result := BufferSize; - end; -end; - -constructor TBassPlaybackStream.Create(); -begin - inherited; - Reset(); -end; - -destructor TBassPlaybackStream.Destroy(); -begin - Close(); - inherited; -end; - -function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; -var - FormatInfo: TAudioFormatInfo; - FormatFlags: DWORD; -begin - Result := false; - - // close previous stream and reset state - Reset(); - - // sanity check if stream is valid - if not assigned(SourceStream) then - Exit; - - Self.SourceStream := SourceStream; - FormatInfo := SourceStream.GetAudioFormatInfo(); - if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then - begin - Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open'); - Exit; - end; - - // create matching playback stream - Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags, - @PlaybackStreamHandler, Self); - if (Handle = 0) then - begin - Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()), - 'TBassPlaybackStream.Open'); - Exit; - end; - - Result := true; -end; - -procedure TBassPlaybackStream.Close(); -begin - // stop and free stream - if (Handle <> 0) then - begin - Bass_StreamFree(Handle); - Handle := 0; - end; - - // Note: PerformOnClose must be called before SourceStream is invalidated - PerformOnClose(); - // unset source-stream - SourceStream := nil; -end; - -procedure TBassPlaybackStream.Reset(); -begin - Close(); - NeedsRewind := false; - PausedSeek := false; -end; - -procedure TBassPlaybackStream.Play(); -var - NeedsFlush: boolean; -begin - if (not assigned(SourceStream)) then - Exit; - - NeedsFlush := true; - - if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then - begin - // only paused (and not seeked while paused) streams are not flushed - if (not PausedSeek) then - NeedsFlush := false; - // paused streams do not need a rewind - NeedsRewind := false; - end; - - // rewind if necessary. Cases that require no rewind are: - // - stream was created and never played - // - stream was paused and is resumed now - // - stream was stopped and set to a new position already - if (NeedsRewind) then - SourceStream.Position := 0; - - NeedsRewind := true; - PausedSeek := false; - - // start playing and flush buffers on rewind - BASS_ChannelPlay(Handle, NeedsFlush); -end; - -procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single); -begin - // start stream - Play(); - // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime - BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000)); -end; - -procedure TBassPlaybackStream.Pause(); -begin - BASS_ChannelPause(Handle); -end; - -procedure TBassPlaybackStream.Stop(); -begin - BASS_ChannelStop(Handle); -end; - -function TBassPlaybackStream.IsEOF(): boolean; -begin - if (assigned(SourceStream)) then - Result := SourceStream.EOF - else - Result := true; -end; - -function TBassPlaybackStream.GetLatency(): double; -begin - // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)? - //if (BASS_GetInfo(Info)) then - // Latency := Info.latency / 1000 - //else - // Latency := 0; - Result := 0; -end; - -function TBassPlaybackStream.GetVolume(): single; -var - lVolume: single; -begin - if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then - begin - Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(), - 'TBassPlaybackStream.GetVolume'); - Result := 0; - Exit; - end; - Result := Round(lVolume); -end; - -procedure TBassPlaybackStream.SetVolume(Volume: single); -begin - // clamp volume - if Volume < 0 then - Volume := 0; - if Volume > 1.0 then - Volume := 1.0; - // set volume - BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume); -end; - -function TBassPlaybackStream.GetPosition: real; -var - BufferPosByte: QWORD; - BufferPosSec: double; -begin - if assigned(SourceStream) then - begin - BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE); - BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte); - // decrease the decoding position by the amount buffered (and hence not played) - // in the BASS playback stream. - Result := SourceStream.Position - BufferPosSec; - end - else - begin - Result := -1; - end; -end; - -procedure TBassPlaybackStream.SetPosition(Time: real); -var - ChannelState: DWORD; -begin - if assigned(SourceStream) then - begin - ChannelState := BASS_ChannelIsActive(Handle); - if (ChannelState = BASS_ACTIVE_STOPPED) then - begin - // if the stream is stopped, do not rewind when the stream is played next time - NeedsRewind := false - end - else if (ChannelState = BASS_ACTIVE_PAUSED) then - begin - // buffers must be flushed if in paused state but there is no - // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play(). - PausedSeek := true; - end; - - // set new position - SourceStream.Position := Time; - end; -end; - -function TBassPlaybackStream.GetLength(): real; -begin - if assigned(SourceStream) then - Result := SourceStream.Length - else - Result := -1; -end; - -function TBassPlaybackStream.GetStatus(): TStreamStatus; -var - State: DWORD; -begin - State := BASS_ChannelIsActive(Handle); - case State of - BASS_ACTIVE_PLAYING, - BASS_ACTIVE_STALLED: - Result := ssPlaying; - BASS_ACTIVE_PAUSED: - Result := ssPaused; - BASS_ACTIVE_STOPPED: - Result := ssStopped; - else - begin - Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus'); - Result := ssStopped; - end; - end; -end; - -function TBassPlaybackStream.GetLoop(): boolean; -begin - if assigned(SourceStream) then - Result := SourceStream.Loop - else - Result := false; -end; - -procedure TBassPlaybackStream.SetLoop(Enabled: boolean); -begin - if assigned(SourceStream) then - SourceStream.Loop := Enabled; -end; - -procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer); -{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF} -var - Effect: TSoundEffect; -begin - Effect := TSoundEffect(user); - if assigned(Effect) then - Effect.Callback(buffer, length); -end; - -procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect); -var - DspHandle: HDSP; -begin - if assigned(Effect.engineData) then - begin - Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect'); - Exit; - end; - - DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0); - if (DspHandle = 0) then - begin - Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect'); - Exit; - end; - - GetMem(Effect.EngineData, SizeOf(HDSP)); - PHDSP(Effect.EngineData)^ := DspHandle; -end; - -procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); -begin - if not assigned(Effect.EngineData) then - begin - Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect'); - Exit; - end; - - if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then - begin - Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect'); - Exit; - end; - - FreeMem(Effect.EngineData); - Effect.EngineData := nil; -end; - -procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData); -begin - // get FFT channel data (Mono, FFT512 -> 256 values) - BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512); -end; - -{* - * Copies interleaved PCM SInt16 stereo samples into data. - * Returns the number of frames - *} -function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; -var - Info: BASS_CHANNELINFO; - nBytes: DWORD; -begin - Result := 0; - - FillChar(Data, SizeOf(TPCMData), 0); - - // no support for non-stereo files at the moment - BASS_ChannelGetInfo(Handle, Info); - if (Info.chans <> 2) then - Exit; - - nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData)); - if(nBytes <= 0) then - Result := 0 - else - Result := nBytes div SizeOf(TPCMStereoSample); -end; - -function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - if assigned(SourceStream) then - Result := SourceStream.GetAudioFormatInfo() - else - Result := nil; -end; - - -{ TBassVoiceStream } - -function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -var - Flags: DWORD; -begin - Result := false; - - Close(); - - if (not inherited Open(ChannelMap, FormatInfo)) then - Exit; - - // get channel flags - BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags); - - (* - // distribute the mics equally to both speakers - if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then - Flags := Flags or BASS_SPEAKER_FRONTLEFT; - if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then - Flags := Flags or BASS_SPEAKER_FRONTRIGHT; - *) - - // create the channel - Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil); - - // start the channel - BASS_ChannelPlay(Handle, true); - - Result := true; -end; - -procedure TBassVoiceStream.Close(); -begin - if (Handle <> 0) then - begin - BASS_ChannelStop(Handle); - BASS_StreamFree(Handle); - end; - inherited Close(); -end; - -procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); -var QueueSize: DWORD; -begin - if ((Handle <> 0) and (BufferSize > 0)) then - begin - // query the queue size (normally 0) - QueueSize := BASS_StreamPutData(Handle, nil, 0); - // flush the buffer if the delay would be too high - if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then - BASS_ChannelPlay(Handle, true); - // send new data to playback buffer - BASS_StreamPutData(Handle, Buffer, BufferSize); - end; -end; - -// Note: we do not need the read-function for the BASS implementation -function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -begin - Result := -1; -end; - -function TBassVoiceStream.IsEOF(): boolean; -begin - Result := false; -end; - -function TBassVoiceStream.IsError(): boolean; -begin - Result := false; -end; - - -{ TAudioPlayback_Bass } - -function TAudioPlayback_Bass.GetName: String; -begin - Result := 'BASS_Playback'; -end; - -function TAudioPlayback_Bass.EnumDevices(): boolean; -var - BassDeviceID: DWORD; - DeviceIndex: integer; - Device: TBassOutputDevice; - DeviceInfo: BASS_DEVICEINFO; -begin - Result := true; - - ClearOutputDeviceList(); - - // skip "no sound"-device (ID = 0) - BassDeviceID := 1; - - while (true) do - begin - // check for device - if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then - Break; - - // set device info - Device := TBassOutputDevice.Create(); - Device.Name := DeviceInfo.name; - Device.BassDeviceID := BassDeviceID; - - // add device to list - SetLength(OutputDeviceList, BassDeviceID); - OutputDeviceList[BassDeviceID-1] := Device; - - Inc(BassDeviceID); - end; -end; - -function TAudioPlayback_Bass.InitializePlayback(): boolean; -begin - result := false; - - BassCore := TAudioCore_Bass.GetInstance(); - - EnumDevices(); - - //Log.BenchmarkStart(4); - //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); - - // TODO: use BASS_DEVICE_LATENCY to determine the latency - if not BASS_Init(-1, 44100, 0, 0, nil) then - begin - Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback'); - Exit; - end; - - //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4); - - // config playing buffer - //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10); - //BASS_SetConfig(BASS_CONFIG_BUFFER, 100); - - result := true; -end; - -function TAudioPlayback_Bass.FinalizePlayback(): boolean; -begin - Close; - BASS_Free; - inherited FinalizePlayback(); - Result := true; -end; - -function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream; -begin - Result := TBassPlaybackStream.Create(); -end; - -procedure TAudioPlayback_Bass.SetAppVolume(Volume: single); -begin - // set volume for this application (ranges from 0..10000 since BASS 2.4) - BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000)); -end; - -function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -var - VoiceStream: TAudioVoiceStream; -begin - Result := nil; - - VoiceStream := TBassVoiceStream.Create(); - if (not VoiceStream.Open(ChannelMap, FormatInfo)) then - begin - VoiceStream.Free; - Exit; - end; - - Result := VoiceStream; -end; - -function TAudioPlayback_Bass.GetLatency(): double; -begin - Result := 0; -end; - - -initialization - MediaManager.Add(TAudioPlayback_Bass.Create); - -end. diff --git a/src/base/UAudioPlayback_Portaudio.pas b/src/base/UAudioPlayback_Portaudio.pas deleted file mode 100644 index c3717ba6..00000000 --- a/src/base/UAudioPlayback_Portaudio.pas +++ /dev/null @@ -1,361 +0,0 @@ -unit UAudioPlayback_Portaudio; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - portaudio, - UAudioCore_Portaudio, - UAudioPlayback_SoftMixer, - ULog, - UIni, - UMain; - -type - TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer) - private - paStream: PPaStream; - AudioCore: TAudioCore_Portaudio; - Latency: double; - function OpenDevice(deviceIndex: TPaDeviceIndex): boolean; - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - function GetLatency(): double; override; - public - function GetName: String; override; - end; - - TPortaudioOutputDevice = class(TAudioOutputDevice) - private - PaDeviceIndex: TPaDeviceIndex; - end; - - -{ TAudioPlayback_Portaudio } - -function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword; - timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; - userData: Pointer): Integer; cdecl; -var - Engine: TAudioPlayback_Portaudio; -begin - Engine := TAudioPlayback_Portaudio(userData); - // update latency - Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime; - // call superclass callback - Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize); - Result := paContinue; -end; - -function TAudioPlayback_Portaudio.GetName: String; -begin - Result := 'Portaudio_Playback'; -end; - -function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean; -var - DeviceInfo : PPaDeviceInfo; - SampleRate : double; - OutParams : TPaStreamParameters; - StreamInfo : PPaStreamInfo; - err : TPaError; -begin - Result := false; - - DeviceInfo := Pa_GetDeviceInfo(deviceIndex); - - Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); - - SampleRate := DeviceInfo^.defaultSampleRate; - - with OutParams do - begin - device := deviceIndex; - channelCount := 2; - sampleFormat := paInt16; - suggestedLatency := DeviceInfo^.defaultLowOutputLatency; - hostApiSpecificStreamInfo := nil; - end; - - // check souncard and adjust sample-rate - if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then - begin - Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice'); - Exit; - end; - - // open output stream - err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate, - paFramesPerBufferUnspecified, - paNoFlag, @PortaudioAudioCallback, Self); - if(err <> paNoError) then - begin - Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice'); - paStream := nil; - Exit; - end; - - // get estimated latency (will be updated with real latency in the callback) - StreamInfo := Pa_GetStreamInfo(paStream); - if (StreamInfo <> nil) then - Latency := StreamInfo^.outputLatency - else - Latency := 0; - - FormatInfo := TAudioFormatInfo.Create( - OutParams.channelCount, - SampleRate, - asfS16 // FIXME: is paInt16 system-dependant or -independant? - ); - - Result := true; -end; - -function TAudioPlayback_Portaudio.EnumDevices(): boolean; -var - i: integer; - paApiIndex: TPaHostApiIndex; - paApiInfo: PPaHostApiInfo; - deviceName: string; - deviceIndex: TPaDeviceIndex; - deviceInfo: PPaDeviceInfo; - channelCnt: integer; - SC: integer; // soundcard - err: TPaError; - errMsg: string; - paDevice: TPortaudioOutputDevice; - outputParams: TPaStreamParameters; - stream: PPaStream; - streamInfo: PPaStreamInfo; - sampleRate: double; - latency: TPaTime; - cbPolls: integer; - cbWorks: boolean; -begin - Result := false; - -(* - // choose the best available Audio-API - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices'); - Exit; - end; - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - - SC := 0; - - // init array-size to max. output-devices count - SetLength(OutputDeviceList, paApiInfo^.deviceCount); - for i:= 0 to High(OutputDeviceList) do - begin - // convert API-specific device-index to global index - deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i); - deviceInfo := Pa_GetDeviceInfo(deviceIndex); - - channelCnt := deviceInfo^.maxOutputChannels; - - // current device is no output device -> skip - if (channelCnt <= 0) then - continue; - - // portaudio returns a channel-count of 128 for some devices - // (e.g. the "default"-device), so we have to detect those - // fantasy channel counts. - if (channelCnt > 8) then - channelCnt := 2; - - paDevice := TPortaudioOutputDevice.Create(); - OutputDeviceList[SC] := paDevice; - - // retrieve device-name - deviceName := deviceInfo^.name; - paDevice.Name := deviceName; - paDevice.PaDeviceIndex := deviceIndex; - - if (deviceInfo^.defaultSampleRate > 0) then - sampleRate := deviceInfo^.defaultSampleRate - else - sampleRate := 44100; - - // on vista and xp the defaultLowInputLatency may be set to 0 but it works. - // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?) - latency := deviceInfo^.defaultLowInputLatency; - - // setup desired output parameters - // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might - // not be set correctly in OSS) - with outputParams do - begin - device := deviceIndex; - channelCount := channelCnt; - sampleFormat := paInt16; - suggestedLatency := latency; - hostApiSpecificStreamInfo := nil; - end; - - // check if mic-callback works (might not be called on some devices) - if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then - begin - // ignore device if callback did not work - Log.LogError('Device "'+paDevice.Name+'" does not respond', - 'TAudioPlayback_Portaudio.InitializeRecord'); - paDevice.Free(); - continue; - end; - - // open device for further info - err := Pa_OpenStream(stream, nil, @outputParams, sampleRate, - paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil); - if(err <> paNoError) then - begin - // unable to open device -> skip - errMsg := Pa_GetErrorText(err); - Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')', - 'TAudioPlayback_Portaudio.InitializeRecord'); - paDevice.Free(); - continue; - end; - - // adjust sample-rate (might be changed by portaudio) - streamInfo := Pa_GetStreamInfo(stream); - if (streamInfo <> nil) then - begin - if (sampleRate <> streamInfo^.sampleRate) then - begin - Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) + - ' to ' + FloatToStr(streamInfo^.sampleRate), - 'TAudioInput_Portaudio.InitializeRecord'); - sampleRate := streamInfo^.sampleRate; - end; - end; - - // create audio-format info and resize capture-buffer array - paDevice.AudioFormat := TAudioFormatInfo.Create( - channelCnt, - sampleRate, - asfS16 - ); - SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels); - - Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' + - IntToStr(paDevice.AudioFormat.Channels)+'x'+ - FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+ - FloatTostr(outputParams.suggestedLatency)+'sec)' , - 'TAudioInput_Portaudio.InitializeRecord'); - - // close test-stream - Pa_CloseStream(stream); - - Inc(SC); - end; - - // adjust size to actual input-device count - SetLength(OutputDeviceList, SC); - - Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio'); -*) - - Result := true; -end; - -function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean; -var - paApiIndex : TPaHostApiIndex; - paApiInfo : PPaHostApiInfo; - paOutDevice : TPaDeviceIndex; - err: TPaError; -begin - Result := false; - - AudioCore := TAudioCore_Portaudio.GetInstance(); - - // initialize portaudio - err := Pa_Initialize(); - if(err <> paNoError) then - begin - Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord'); - Exit; - end; - - paApiIndex := AudioCore.GetPreferredApiIndex(); - if(paApiIndex = -1) then - begin - Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine'); - Exit; - end; - - EnumDevices(); - - paApiInfo := Pa_GetHostApiInfo(paApiIndex); - Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice'); - - paOutDevice := paApiInfo^.defaultOutputDevice; - if (not OpenDevice(paOutDevice)) then - begin - Exit; - end; - - Result := true; -end; - -function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean; -var - err: TPaError; -begin - Result := false; - - if (paStream = nil) then - Exit; - - err := Pa_StartStream(paStream); - if(err <> paNoError) then - begin - Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); - Exit; - end; - - Result := true; -end; - -procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine(); -begin - if (paStream <> nil) then - Pa_StopStream(paStream); -end; - -function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean; -begin - Pa_Terminate(); - Result := true; -end; - -function TAudioPlayback_Portaudio.GetLatency(): double; -begin - Result := Latency; -end; - - -initialization - MediaManager.Add(TAudioPlayback_Portaudio.Create); - -end. diff --git a/src/base/UAudioPlayback_SDL.pas b/src/base/UAudioPlayback_SDL.pas deleted file mode 100644 index deef91e8..00000000 --- a/src/base/UAudioPlayback_SDL.pas +++ /dev/null @@ -1,160 +0,0 @@ -unit UAudioPlayback_SDL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - UMusic; - -implementation - -uses - sdl, - UAudioPlayback_SoftMixer, - ULog, - UIni, - UMain; - -type - TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer) - private - Latency: double; - function EnumDevices(): boolean; - protected - function InitializeAudioPlaybackEngine(): boolean; override; - function StartAudioPlaybackEngine(): boolean; override; - procedure StopAudioPlaybackEngine(); override; - function FinalizeAudioPlaybackEngine(): boolean; override; - function GetLatency(): double; override; - public - function GetName: String; override; - procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override; - end; - - -{ TAudioPlayback_SDL } - -procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; -var - Engine: TAudioPlayback_SDL; -begin - Engine := TAudioPlayback_SDL(userdata); - Engine.AudioCallback(stream, len); -end; - -function TAudioPlayback_SDL.GetName: String; -begin - Result := 'SDL_Playback'; -end; - -function TAudioPlayback_SDL.EnumDevices(): boolean; -begin - // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3) - ClearOutputDeviceList(); - SetLength(OutputDeviceList, 1); - OutputDeviceList[0] := TAudioOutputDevice.Create(); - OutputDeviceList[0].Name := '[SDL Default-Device]'; - Result := true; -end; - -function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean; -var - DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec; - SampleBufferSize: integer; -begin - Result := false; - - EnumDevices(); - - if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then - begin - Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - Exit; - end; - - SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex]; - if (SampleBufferSize <= 0) then - begin - // Automatic setting default - // FIXME: too much glitches with 1024 samples - SampleBufferSize := 2048; //1024; - end; - - FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0); - with DesiredAudioSpec do - begin - freq := 44100; - format := AUDIO_S16SYS; - channels := 2; - samples := SampleBufferSize; - callback := @SDLAudioCallback; - userdata := Self; - end; - - // Note: always use the "obtained" parameter, otherwise SDL might try to convert - // the samples itself if the desired format is not available. This might lead - // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz. - // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with - // its crappy (non working) converter resulting in a wrong (too high) pitch. - if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then - begin - Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - Exit; - end; - - FormatInfo := TAudioFormatInfo.Create( - ObtainedAudioSpec.channels, - ObtainedAudioSpec.freq, - asfS16 - ); - - // Note: SDL does not provide info of the internal buffer state. - // So we use the average buffer-size. - Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate; - - Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine'); - - Result := true; -end; - -function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean; -begin - SDL_PauseAudio(0); - Result := true; -end; - -procedure TAudioPlayback_SDL.StopAudioPlaybackEngine(); -begin - SDL_PauseAudio(1); -end; - -function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean; -begin - SDL_CloseAudio(); - SDL_QuitSubSystem(SDL_INIT_AUDIO); - Result := true; -end; - -function TAudioPlayback_SDL.GetLatency(): double; -begin - Result := Latency; -end; - -procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); -begin - SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME)); -end; - - -initialization - MediaManager.add(TAudioPlayback_SDL.Create); - -end. diff --git a/src/base/UAudioPlayback_SoftMixer.pas b/src/base/UAudioPlayback_SoftMixer.pas deleted file mode 100644 index 6ddae980..00000000 --- a/src/base/UAudioPlayback_SoftMixer.pas +++ /dev/null @@ -1,1132 +0,0 @@ -unit UAudioPlayback_SoftMixer; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - - -uses - Classes, - SysUtils, - sdl, - URingBuffer, - UMusic, - UAudioPlaybackBase; - -type - TAudioPlayback_SoftMixer = class; - - TGenericPlaybackStream = class(TAudioPlaybackStream) - private - Engine: TAudioPlayback_SoftMixer; - - SampleBuffer: PChar; - SampleBufferSize: integer; - SampleBufferCount: integer; // number of available bytes in SampleBuffer - SampleBufferPos: cardinal; - - SourceBuffer: PChar; - SourceBufferSize: integer; - SourceBufferCount: integer; // number of available bytes in SourceBuffer - - Converter: TAudioConverter; - Status: TStreamStatus; - InternalLock: PSDL_Mutex; - SoundEffects: TList; - fVolume: single; - - FadeInStartTime, FadeInTime: cardinal; - FadeInStartVolume, FadeInTargetVolume: single; - - NeedsRewind: boolean; - - procedure Reset(); - - procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer); - function InitFormatConversion(): boolean; - procedure FlushBuffers(); - - procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - protected - function GetLatency(): double; override; - function GetStatus(): TStreamStatus; override; - function GetVolume(): single; override; - procedure SetVolume(Volume: single); override; - function GetLength(): real; override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - function GetPosition: real; override; - procedure SetPosition(Time: real); override; - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - destructor Destroy(); override; - - function Open(SourceStream: TAudioSourceStream): boolean; override; - procedure Close(); override; - - procedure Play(); override; - procedure Pause(); override; - procedure Stop(); override; - procedure FadeIn(Time: real; TargetVolume: single); override; - - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - function GetPCMData(var Data: TPCMData): Cardinal; override; - procedure GetFFTData(var Data: TFFTData); override; - - procedure AddSoundEffect(Effect: TSoundEffect); override; - procedure RemoveSoundEffect(Effect: TSoundEffect); override; - end; - - TAudioMixerStream = class - private - Engine: TAudioPlayback_SoftMixer; - - ActiveStreams: TList; - MixerBuffer: PChar; - InternalLock: PSDL_Mutex; - - AppVolume: single; - - procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF} - procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF} - - function GetVolume(): single; - procedure SetVolume(Volume: single); - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - destructor Destroy(); override; - procedure AddStream(Stream: TAudioPlaybackStream); - procedure RemoveStream(Stream: TAudioPlaybackStream); - function ReadData(Buffer: PChar; BufferSize: integer): integer; - - property Volume: single read GetVolume write SetVolume; - end; - - TAudioPlayback_SoftMixer = class(TAudioPlaybackBase) - private - MixerStream: TAudioMixerStream; - protected - FormatInfo: TAudioFormatInfo; - - function InitializeAudioPlaybackEngine(): boolean; virtual; abstract; - function StartAudioPlaybackEngine(): boolean; virtual; abstract; - procedure StopAudioPlaybackEngine(); virtual; abstract; - function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract; - procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF} - - function CreatePlaybackStream(): TAudioPlaybackStream; override; - public - function GetName: String; override; abstract; - function InitializePlayback(): boolean; override; - function FinalizePlayback: boolean; override; - - procedure SetAppVolume(Volume: single); override; - - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override; - - function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF} - function GetAudioFormatInfo(): TAudioFormatInfo; - - procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual; - end; - -type - TGenericVoiceStream = class(TAudioVoiceStream) - private - VoiceBuffer: TRingBuffer; - BufferLock: PSDL_Mutex; - PlaybackStream: TGenericPlaybackStream; - Engine: TAudioPlayback_SoftMixer; - public - constructor Create(Engine: TAudioPlayback_SoftMixer); - - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override; - procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); override; - function ReadData(Buffer: PChar; BufferSize: integer): integer; override; - function IsEOF(): boolean; override; - function IsError(): boolean; override; - end; - -const - SOURCE_BUFFER_FRAMES = 4096; - -const - MAX_VOICE_DELAY = 0.500; // 20ms - -implementation - -uses - Math, - ULog, - UIni, - UFFT, - UAudioConverter, - UMain; - -{ TAudioMixerStream } - -constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - - Self.Engine := Engine; - - ActiveStreams := TList.Create; - InternalLock := SDL_CreateMutex(); - AppVolume := 1.0; -end; - -destructor TAudioMixerStream.Destroy(); -begin - if assigned(MixerBuffer) then - Freemem(MixerBuffer); - ActiveStreams.Free; - SDL_DestroyMutex(InternalLock); - inherited; -end; - -procedure TAudioMixerStream.Lock(); -begin - SDL_mutexP(InternalLock); -end; - -procedure TAudioMixerStream.Unlock(); -begin - SDL_mutexV(InternalLock); -end; - -function TAudioMixerStream.GetVolume(): single; -begin - Lock(); - Result := AppVolume; - Unlock(); -end; - -procedure TAudioMixerStream.SetVolume(Volume: single); -begin - Lock(); - AppVolume := Volume; - Unlock(); -end; - -procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream); -begin - if not assigned(Stream) then - Exit; - - Lock(); - // check if stream is already in list to avoid duplicates - if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then - ActiveStreams.Add(Pointer(Stream)); - Unlock(); -end; - -(* - * Sets the entry of stream in the ActiveStreams-List to nil - * but does not remove it from the list (Count is not changed!). - * Otherwise iterations over the elements might fail due to a - * changed Count-property. - * Call ActiveStreams.Pack() to remove the nil-pointers - * or check for nil-pointers when accessing ActiveStreams. - *) -procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream); -var - Index: integer; -begin - Lock(); - Index := activeStreams.IndexOf(Pointer(Stream)); - if (Index <> -1) then - begin - // remove entry but do not decrease count-property - ActiveStreams[Index] := nil; - end; - Unlock(); -end; - -function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - i: integer; - Size: integer; - Stream: TGenericPlaybackStream; - NeedsPacking: boolean; -begin - Result := BufferSize; - - // zero target-buffer (silence) - FillChar(Buffer^, BufferSize, 0); - - // resize mixer-buffer if necessary - ReallocMem(MixerBuffer, BufferSize); - if not assigned(MixerBuffer) then - Exit; - - Lock(); - - NeedsPacking := false; - - // mix streams to one stream - for i := 0 to ActiveStreams.Count-1 do - begin - if (ActiveStreams[i] = nil) then - begin - NeedsPacking := true; - continue; - end; - - Stream := TGenericPlaybackStream(ActiveStreams[i]); - // fetch data from current stream - Size := Stream.ReadData(MixerBuffer, BufferSize); - if (Size > 0) then - begin - // mix stream-data with mixer-buffer - // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking - Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume); - end; - end; - - // remove nil-pointers from list - if (NeedsPacking) then - begin - ActiveStreams.Pack(); - end; - - Unlock(); -end; - - -{ TGenericPlaybackStream } - -constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - Self.Engine := Engine; - InternalLock := SDL_CreateMutex(); - SoundEffects := TList.Create; - Status := ssStopped; - Reset(); -end; - -destructor TGenericPlaybackStream.Destroy(); -begin - Close(); - SDL_DestroyMutex(InternalLock); - FreeAndNil(SoundEffects); - inherited; -end; - -procedure TGenericPlaybackStream.Reset(); -begin - SourceStream := nil; - - FreeAndNil(Converter); - - FreeMem(SampleBuffer); - SampleBuffer := nil; - SampleBufferPos := 0; - SampleBufferSize := 0; - SampleBufferCount := 0; - - FreeMem(SourceBuffer); - SourceBuffer := nil; - SourceBufferSize := 0; - SourceBufferCount := 0; - - NeedsRewind := false; - - fVolume := 0; - SoundEffects.Clear; - FadeInTime := 0; -end; - -function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean; -begin - Result := false; - - Close(); - - if (not assigned(SourceStream)) then - Exit; - Self.SourceStream := SourceStream; - - if (not InitFormatConversion()) then - begin - // reset decode-stream so it will not be freed on destruction - Self.SourceStream := nil; - Exit; - end; - - SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize; - GetMem(SourceBuffer, SourceBufferSize); - fVolume := 1.0; - - Result := true; -end; - -procedure TGenericPlaybackStream.Close(); -begin - // stop audio-callback on this stream - Stop(); - - // Note: PerformOnClose must be called before SourceStream is invalidated - PerformOnClose(); - // and free data - Reset(); -end; - -procedure TGenericPlaybackStream.LockSampleBuffer(); -begin - SDL_mutexP(InternalLock); -end; - -procedure TGenericPlaybackStream.UnlockSampleBuffer(); -begin - SDL_mutexV(InternalLock); -end; - -function TGenericPlaybackStream.InitFormatConversion(): boolean; -var - SrcFormatInfo: TAudioFormatInfo; - DstFormatInfo: TAudioFormatInfo; -begin - Result := false; - - SrcFormatInfo := SourceStream.GetAudioFormatInfo(); - DstFormatInfo := GetAudioFormatInfo(); - - // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead - {$IF Defined(UseFFmpegResample)} - Converter := TAudioConverter_FFmpeg.Create(); - {$ELSEIF Defined(UseSRCResample)} - Converter := TAudioConverter_SRC.Create(); - {$ELSE} - Converter := TAudioConverter_SDL.Create(); - {$IFEND} - - Result := Converter.Init(SrcFormatInfo, DstFormatInfo); -end; - -procedure TGenericPlaybackStream.Play(); -var - Mixer: TAudioMixerStream; -begin - // only paused streams are not flushed - if (Status = ssPaused) then - NeedsRewind := false; - - // rewind if necessary. Cases that require no rewind are: - // - stream was created and never played - // - stream was paused and is resumed now - // - stream was stopped and set to a new position already - if (NeedsRewind) then - SetPosition(0); - - // update status - Status := ssPlaying; - - NeedsRewind := true; - - // add this stream to the mixer - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.AddStream(Self); -end; - -procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single); -begin - FadeInTime := Trunc(Time * 1000); - FadeInStartTime := SDL_GetTicks(); - FadeInStartVolume := fVolume; - FadeInTargetVolume := TargetVolume; - Play(); -end; - -procedure TGenericPlaybackStream.Pause(); -var - Mixer: TAudioMixerStream; -begin - if (Status <> ssPlaying) then - Exit; - - Status := ssPaused; - - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.RemoveStream(Self); -end; - -procedure TGenericPlaybackStream.Stop(); -var - Mixer: TAudioMixerStream; -begin - if (Status = ssStopped) then - Exit; - - Status := ssStopped; - - Mixer := Engine.GetMixer(); - if (Mixer <> nil) then - Mixer.RemoveStream(Self); -end; - -function TGenericPlaybackStream.GetLoop(): boolean; -begin - if assigned(SourceStream) then - Result := SourceStream.Loop - else - Result := false; -end; - -procedure TGenericPlaybackStream.SetLoop(Enabled: boolean); -begin - if assigned(SourceStream) then - SourceStream.Loop := Enabled; -end; - -function TGenericPlaybackStream.GetLength(): real; -begin - if assigned(SourceStream) then - Result := SourceStream.Length - else - Result := -1; -end; - -function TGenericPlaybackStream.GetLatency(): double; -begin - Result := Engine.GetLatency(); -end; - -function TGenericPlaybackStream.GetStatus(): TStreamStatus; -begin - Result := Status; -end; - -function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := Engine.GetAudioFormatInfo(); -end; - -procedure TGenericPlaybackStream.FlushBuffers(); -begin - SampleBufferCount := 0; - SampleBufferPos := 0; - SourceBufferCount := 0; -end; - -procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer); -var - i: integer; -begin - for i := 0 to SoundEffects.Count-1 do - begin - if (SoundEffects[i] <> nil) then - begin - TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize); - end; - end; -end; - -function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -var - ConversionInputCount: integer; - ConversionOutputSize: integer; // max. number of converted data (= buffer size) - ConversionOutputCount: integer; // actual number of converted data - SourceSize: integer; - RequestedSourceSize: integer; - NeededSampleBufferSize: integer; - BytesNeeded, BytesAvail: integer; - SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo; - SourceFrameSize, OutputFrameSize: integer; - SkipOutputCount: integer; // number of output-data bytes to skip - SkipSourceCount: integer; // number of source-data bytes to skip - FillCount: integer; // number of bytes to fill with padding data - CopyCount: integer; - PadFrame: PChar; - i: integer; -begin - Result := -1; - - // sanity check for the source-stream - if (not assigned(SourceStream)) then - Exit; - - SkipOutputCount := 0; - SkipSourceCount := 0; - FillCount := 0; - - SourceFormatInfo := SourceStream.GetAudioFormatInfo(); - SourceFrameSize := SourceFormatInfo.FrameSize; - OutputFormatInfo := GetAudioFormatInfo(); - OutputFrameSize := OutputFormatInfo.FrameSize; - - // synchronize (adjust buffer size) - BytesNeeded := Synchronize(BufferSize, OutputFormatInfo); - if (BytesNeeded > BufferSize) then - begin - SkipOutputCount := BytesNeeded - BufferSize; - BytesNeeded := BufferSize; - end - else if (BytesNeeded < BufferSize) then - begin - FillCount := BufferSize - BytesNeeded; - end; - - // lock access to sample-buffer - LockSampleBuffer(); - try - - // skip sample-buffer data - SampleBufferPos := SampleBufferPos + SkipOutputCount; - // size of available bytes in SampleBuffer after skipping - SampleBufferCount := SampleBufferCount - SampleBufferPos; - // update byte skip-count - SkipOutputCount := -SampleBufferCount; - - // now that we skipped all buffered data from the last pass, we have to skip - // data directly after fetching it from the source-stream. - if (SkipOutputCount > 0) then - begin - SampleBufferCount := 0; - // convert skip-count to source-format units and resize to a multiple of - // the source frame-size. - SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) / - SourceFrameSize) * SourceFrameSize; - SkipOutputCount := 0; - end; - - // copy data to front of buffer - if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then - Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount); - SampleBufferPos := 0; - - // resize buffer to a reasonable size - if (BufferSize > SampleBufferCount) then - begin - // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing - SampleBufferSize := BufferSize; - ReallocMem(SampleBuffer, SampleBufferSize); - if (not assigned(SampleBuffer)) then - Exit; - end; - - // fill sample-buffer (fetch and convert one block of source data per loop) - while (SampleBufferCount < BytesNeeded) do - begin - // move remaining source data from the previous pass to front of buffer - if (SourceBufferCount > 0) then - begin - Move(SourceBuffer[SourceBufferSize-SourceBufferCount], - SourceBuffer[0], - SourceBufferCount); - end; - - SourceSize := SourceStream.ReadData( - @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount); - // break on error (-1) or if no data is available (0), e.g. while seeking - if (SourceSize <= 0) then - begin - // if we do not have data -> exit - if (SourceBufferCount = 0) then - begin - FlushBuffers(); - Exit; - end; - // if we have some data, stop retrieving data from the source stream - // and use the data we have so far - Break; - end; - - SourceBufferCount := SourceBufferCount + SourceSize; - - // end-of-file reached -> stop playback - if (SourceStream.EOF) then - begin - if (Loop) then - SourceStream.Position := 0 - else - Stop(); - end; - - if (SkipSourceCount > 0) then - begin - // skip data and update source buffer count - SourceBufferCount := SourceBufferCount - SkipSourceCount; - SkipSourceCount := -SourceBufferCount; - // continue with next pass if we skipped all data - if (SourceBufferCount <= 0) then - begin - SourceBufferCount := 0; - Continue; - end; - end; - - // calc buffer size (might be bigger than actual resampled byte count) - ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount); - NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize; - - // resize buffer if necessary - if (SampleBufferSize < NeededSampleBufferSize) then - begin - SampleBufferSize := NeededSampleBufferSize; - ReallocMem(SampleBuffer, SampleBufferSize); - if (not assigned(SampleBuffer)) then - begin - FlushBuffers(); - Exit; - end; - end; - - // resample source data (Note: ConversionInputCount might be adjusted by Convert()) - ConversionInputCount := SourceBufferCount; - ConversionOutputCount := Converter.Convert( - SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount); - if (ConversionOutputCount = -1) then - begin - FlushBuffers(); - Exit; - end; - - // adjust sample- and source-buffer count by the number of converted bytes - SampleBufferCount := SampleBufferCount + ConversionOutputCount; - SourceBufferCount := SourceBufferCount - ConversionInputCount; - end; - - // apply effects - ApplySoundEffects(SampleBuffer, SampleBufferCount); - - // copy data to result buffer - CopyCount := Min(BytesNeeded, SampleBufferCount); - Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount); - Dec(BytesNeeded, CopyCount); - SampleBufferPos := CopyCount; - - // release buffer lock - finally - UnlockSampleBuffer(); - end; - - // pad the buffer with the last frame if we are to fast - if (FillCount > 0) then - begin - if (CopyCount >= OutputFrameSize) then - PadFrame := @Buffer[CopyCount-OutputFrameSize] - else - PadFrame := nil; - FillBufferWithFrame(@Buffer[CopyCount], FillCount, - PadFrame, OutputFrameSize); - end; - - // BytesNeeded now contains the number of remaining bytes we were not able to fetch - Result := BufferSize - BytesNeeded; -end; - -function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal; -var - ByteCount: integer; -begin - Result := 0; - - // just SInt16 stereo support for now - if ((Engine.GetAudioFormatInfo().Format <> asfS16) or - (Engine.GetAudioFormatInfo().Channels <> 2)) then - begin - Exit; - end; - - // zero memory - FillChar(Data, SizeOf(Data), 0); - - // TODO: At the moment just the first samples of the SampleBuffer - // are returned, even if there is newer data in the upper samples. - - LockSampleBuffer(); - ByteCount := Min(SizeOf(Data), SampleBufferCount); - if (ByteCount > 0) then - begin - Move(SampleBuffer[0], Data, ByteCount); - end; - UnlockSampleBuffer(); - - Result := ByteCount div SizeOf(TPCMStereoSample); -end; - -procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData); -var - i: integer; - Frames: integer; - DataIn: PSingleArray; - AudioFormat: TAudioFormatInfo; -begin - // only works with SInt16 and Float values at the moment - AudioFormat := GetAudioFormatInfo(); - - DataIn := AllocMem(FFTSize * SizeOf(Single)); - if (DataIn = nil) then - Exit; - - LockSampleBuffer(); - // TODO: We just use the first Frames frames, the others are ignored. - Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize); - // use only first channel and convert data to float-values - case AudioFormat.Format of - asfS16: - begin - for i := 0 to Frames-1 do - DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt); - end; - asfFloat: - begin - for i := 0 to Frames-1 do - DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^; - end; - end; - UnlockSampleBuffer(); - - WindowFunc(fwfHanning, FFTSize, DataIn); - PowerSpectrum(FFTSize, DataIn, @Data); - FreeMem(DataIn); - - // resize data to a 0..1 range - for i := 0 to High(TFFTData) do - begin - Data[i] := Sqrt(Data[i]) / 100; - end; -end; - -procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect); -begin - if (not assigned(Effect)) then - Exit; - - LockSampleBuffer(); - // check if effect is already in list to avoid duplicates - if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then - SoundEffects.Add(Pointer(Effect)); - UnlockSampleBuffer(); -end; - -procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect); -begin - LockSampleBuffer(); - SoundEffects.Remove(Effect); - UnlockSampleBuffer(); -end; - -function TGenericPlaybackStream.GetPosition: real; -var - BufferedTime: double; -begin - if assigned(SourceStream) then - begin - LockSampleBuffer(); - - // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer) - // but not yet outputed - BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec + - SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec; - // and subtract it from the source position - Result := SourceStream.Position - BufferedTime; - - UnlockSampleBuffer(); - end - else - begin - Result := -1; - end; -end; - -procedure TGenericPlaybackStream.SetPosition(Time: real); -begin - if assigned(SourceStream) then - begin - LockSampleBuffer(); - - SourceStream.Position := Time; - if (Status = ssStopped) then - NeedsRewind := false; - // do not use outdated data - FlushBuffers(); - - AvgSyncDiff := -1; - - UnlockSampleBuffer(); - end; -end; - -function TGenericPlaybackStream.GetVolume(): single; -var - FadeAmount: Single; -begin - LockSampleBuffer(); - // adjust volume if fading is enabled - if (FadeInTime > 0) then - begin - FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime; - // check if fade-target is reached - if (FadeAmount >= 1) then - begin - // target reached -> stop fading - FadeInTime := 0; - fVolume := FadeInTargetVolume; - end - else - begin - // fading in progress - fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume; - end; - end; - // return current volume - Result := fVolume; - UnlockSampleBuffer(); -end; - -procedure TGenericPlaybackStream.SetVolume(Volume: single); -begin - LockSampleBuffer(); - // stop fading - FadeInTime := 0; - // clamp volume - if (Volume > 1.0) then - fVolume := 1.0 - else if (Volume < 0) then - fVolume := 0 - else - fVolume := Volume; - UnlockSampleBuffer(); -end; - - -{ TGenericVoiceStream } - -constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer); -begin - inherited Create(); - Self.Engine := Engine; -end; - -function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -var - BufferSize: integer; -begin - Result := false; - - Close(); - - if (not inherited Open(ChannelMap, FormatInfo)) then - Exit; - - // Note: - // - use Self.FormatInfo instead of FormatInfo as the latter one might have a - // channel size of 2. - // - the buffer-size must be a multiple of the FrameSize - BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) * - Self.FormatInfo.FrameSize; - VoiceBuffer := TRingBuffer.Create(BufferSize); - - BufferLock := SDL_CreateMutex(); - - - // create a matching playback stream for the voice-stream - PlaybackStream := TGenericPlaybackStream.Create(Engine); - // link voice- and playback-stream - if (not PlaybackStream.Open(Self)) then - begin - PlaybackStream.Free; - Exit; - end; - - // start voice passthrough - PlaybackStream.Play(); - - Result := true; -end; - -procedure TGenericVoiceStream.Close(); -begin - // stop and free the playback stream - FreeAndNil(PlaybackStream); - - // free data - FreeAndNil(VoiceBuffer); - if (BufferLock <> nil) then - SDL_DestroyMutex(BufferLock); - - inherited Close(); -end; - -procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer); -begin - // lock access to buffer - SDL_mutexP(BufferLock); - try - if (VoiceBuffer = nil) then - Exit; - VoiceBuffer.Write(Buffer, BufferSize); - finally - SDL_mutexV(BufferLock); - end; -end; - -function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer; -begin - Result := -1; - - // lock access to buffer - SDL_mutexP(BufferLock); - try - if (VoiceBuffer = nil) then - Exit; - Result := VoiceBuffer.Read(Buffer, BufferSize); - finally - SDL_mutexV(BufferLock); - end; -end; - -function TGenericVoiceStream.IsEOF(): boolean; -begin - SDL_mutexP(BufferLock); - Result := (VoiceBuffer = nil); - SDL_mutexV(BufferLock); -end; - -function TGenericVoiceStream.IsError(): boolean; -begin - Result := false; -end; - - -{ TAudioPlayback_SoftMixer } - -function TAudioPlayback_SoftMixer.InitializePlayback: boolean; -begin - Result := false; - - //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer'); - - if(not InitializeAudioPlaybackEngine()) then - Exit; - - MixerStream := TAudioMixerStream.Create(Self); - - if(not StartAudioPlaybackEngine()) then - Exit; - - Result := true; -end; - -function TAudioPlayback_SoftMixer.FinalizePlayback: boolean; -begin - Close; - StopAudioPlaybackEngine(); - - FreeAndNil(MixerStream); - FreeAndNil(FormatInfo); - - FinalizeAudioPlaybackEngine(); - inherited FinalizePlayback; - Result := true; -end; - -procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer); -begin - MixerStream.ReadData(Buffer, Size); -end; - -function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream; -begin - Result := MixerStream; -end; - -function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream; -begin - Result := TGenericPlaybackStream.Create(Self); -end; - -function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -var - VoiceStream: TGenericVoiceStream; -begin - Result := nil; - - // create a voice stream - VoiceStream := TGenericVoiceStream.Create(Self); - if (not VoiceStream.Open(ChannelMap, FormatInfo)) then - begin - VoiceStream.Free; - Exit; - end; - - Result := VoiceStream; -end; - -procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single); -begin - // sets volume only for this application - MixerStream.Volume := Volume; -end; - -procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); -var - SampleIndex: Cardinal; - SampleInt: Integer; - SampleFlt: Single; -begin - SampleIndex := 0; - case FormatInfo.Format of - asfS16: - begin - while (SampleIndex < Size) do - begin - // apply volume and sum with previous mixer value - SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ + - Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume); - // clip result - if (SampleInt > High(SmallInt)) then - SampleInt := High(SmallInt) - else if (SampleInt < Low(SmallInt)) then - SampleInt := Low(SmallInt); - // assign result - PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt; - // increase index by one sample - Inc(SampleIndex, SizeOf(SmallInt)); - end; - end; - asfFloat: - begin - while (SampleIndex < Size) do - begin - // apply volume and sum with previous mixer value - SampleFlt := PSingle(@DstBuffer[SampleIndex])^ + - PSingle(@SrcBuffer[SampleIndex])^ * Volume; - // clip result - if (SampleFlt > 1.0) then - SampleFlt := 1.0 - else if (SampleFlt < -1.0) then - SampleFlt := -1.0; - // assign result - PSingle(@DstBuffer[SampleIndex])^ := SampleFlt; - // increase index by one sample - Inc(SampleIndex, SizeOf(Single)); - end; - end; - else - begin - Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio'); - end; - end; -end; - -end. diff --git a/src/base/UMediaCore_FFmpeg.pas b/src/base/UMediaCore_FFmpeg.pas deleted file mode 100644 index cdd320ac..00000000 --- a/src/base/UMediaCore_FFmpeg.pas +++ /dev/null @@ -1,405 +0,0 @@ -unit UMediaCore_FFmpeg; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - avcodec, - avformat, - avutil, - ULog, - sdl; - -type - PPacketQueue = ^TPacketQueue; - TPacketQueue = class - private - FirstListEntry: PAVPacketList; - LastListEntry: PAVPacketList; - PacketCount: integer; - Mutex: PSDL_Mutex; - Condition: PSDL_Cond; - Size: integer; - AbortRequest: boolean; - public - constructor Create(); - destructor Destroy(); override; - - function Put(Packet : PAVPacket): integer; - function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; - procedure FreeStatusInfo(var Packet: TAVPacket); - function GetStatusInfo(var Packet: TAVPacket): Pointer; - function Get(var Packet: TAVPacket; Blocking: boolean): integer; - function GetSize(): integer; - procedure Flush(); - procedure Abort(); - function IsAborted(): boolean; - end; - -const - STATUS_PACKET: PChar = 'STATUS_PACKET'; -const - PKT_STATUS_FLAG_EOF = 1; // signal end-of-file - PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers - PKT_STATUS_FLAG_ERROR = 3; // signal an error state - PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames) - -type - TMediaCore_FFmpeg = class - private - AVCodecLock: PSDL_Mutex; - public - constructor Create(); - destructor Destroy(); override; - class function GetInstance(): TMediaCore_FFmpeg; - - function GetErrorString(ErrorNum: integer): string; - function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean; - function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; - function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; - procedure LockAVCodec(); - procedure UnlockAVCodec(); - end; - -implementation - -uses - SysUtils; - -var - Instance: TMediaCore_FFmpeg; - -constructor TMediaCore_FFmpeg.Create(); -begin - inherited; - AVCodecLock := SDL_CreateMutex(); -end; - -destructor TMediaCore_FFmpeg.Destroy(); -begin - SDL_DestroyMutex(AVCodecLock); - inherited; -end; - -class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg; -begin - if (not Assigned(Instance)) then - Instance := TMediaCore_FFmpeg.Create(); - Result := Instance; -end; - -procedure TMediaCore_FFmpeg.LockAVCodec(); -begin - SDL_mutexP(AVCodecLock); -end; - -procedure TMediaCore_FFmpeg.UnlockAVCodec(); -begin - SDL_mutexV(AVCodecLock); -end; - -function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string; -begin - case ErrorNum of - AVERROR_IO: Result := 'AVERROR_IO'; - AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED'; - AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA'; - AVERROR_NOMEM: Result := 'AVERROR_NOMEM'; - AVERROR_NOFMT: Result := 'AVERROR_NOFMT'; - AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP'; - AVERROR_NOENT: Result := 'AVERROR_NOENT'; - AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME'; - else Result := 'AVERROR_#'+inttostr(ErrorNum); - end; -end; - -{ - @param(FormatCtx is a PAVFormatContext returned from av_open_input_file ) - @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream) - @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream) - @returns(@true on success, @false otherwise) -} -function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean; -var - i: integer; - Stream: PAVStream; -begin - // find the first video stream - FirstAudioStream := -1; - FirstVideoStream := -1; - - for i := 0 to FormatCtx.nb_streams-1 do - begin - Stream := FormatCtx.streams[i]; - - if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and - (FirstVideoStream < 0) then - begin - FirstVideoStream := i; - end; - - if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and - (FirstAudioStream < 0) then - begin - FirstAudioStream := i; - end; - end; - - // return true if either an audio- or video-stream was found - Result := (FirstAudioStream > -1) or - (FirstVideoStream > -1) ; -end; - -function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer; -var - i: integer; - StreamIndex: integer; - Stream: PAVStream; -begin - // find the first audio stream - StreamIndex := -1; - - for i := 0 to FormatCtx^.nb_streams-1 do - begin - Stream := FormatCtx^.streams[i]; - - if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then - begin - StreamIndex := i; - Break; - end; - end; - - Result := StreamIndex; -end; - -function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean; -begin - case FFmpegFormat of - SAMPLE_FMT_U8: Format := asfU8; - SAMPLE_FMT_S16: Format := asfS16; - SAMPLE_FMT_S24: Format := asfS24; - SAMPLE_FMT_S32: Format := asfS32; - SAMPLE_FMT_FLT: Format := asfFloat; - else begin - Result := false; - Exit; - end; - end; - Result := true; -end; - -{ TPacketQueue } - -constructor TPacketQueue.Create(); -begin - inherited; - - FirstListEntry := nil; - LastListEntry := nil; - PacketCount := 0; - Size := 0; - - Mutex := SDL_CreateMutex(); - Condition := SDL_CreateCond(); -end; - -destructor TPacketQueue.Destroy(); -begin - Flush(); - SDL_DestroyMutex(Mutex); - SDL_DestroyCond(Condition); - inherited; -end; - -procedure TPacketQueue.Abort(); -begin - SDL_LockMutex(Mutex); - - AbortRequest := true; - - SDL_CondBroadcast(Condition); - SDL_UnlockMutex(Mutex); -end; - -function TPacketQueue.IsAborted(): boolean; -begin - SDL_LockMutex(Mutex); - Result := AbortRequest; - SDL_UnlockMutex(Mutex); -end; - -function TPacketQueue.Put(Packet : PAVPacket): integer; -var - CurrentListEntry : PAVPacketList; -begin - Result := -1; - - if (Packet = nil) then - Exit; - - if (PChar(Packet^.data) <> STATUS_PACKET) then - begin - if (av_dup_packet(Packet) < 0) then - Exit; - end; - - CurrentListEntry := av_malloc(SizeOf(TAVPacketList)); - if (CurrentListEntry = nil) then - Exit; - - CurrentListEntry^.pkt := Packet^; - CurrentListEntry^.next := nil; - - SDL_LockMutex(Mutex); - try - if (LastListEntry = nil) then - FirstListEntry := CurrentListEntry - else - LastListEntry^.next := CurrentListEntry; - - LastListEntry := CurrentListEntry; - Inc(PacketCount); - - Size := Size + CurrentListEntry^.pkt.size; - SDL_CondSignal(Condition); - finally - SDL_UnlockMutex(Mutex); - end; - - Result := 0; -end; - -(** - * Adds a status packet (EOF, Flush, etc.) to the end of the queue. - * StatusInfo can be used to pass additional information to the decoder. - * Only assign nil or a valid pointer to data allocated with Getmem() to - * StatusInfo because the pointer will be disposed with Freemem() on a call - * to Flush(). If the packet is removed from the queue it is the decoder's - * responsibility to free the StatusInfo data with FreeStatusInfo(). - *) -function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer; -var - TempPacket: PAVPacket; -begin - // create temp. package - TempPacket := av_malloc(SizeOf(TAVPacket)); - if (TempPacket = nil) then - begin - Result := -1; - Exit; - end; - // init package - av_init_packet(TempPacket^); - TempPacket^.data := Pointer(STATUS_PACKET); - TempPacket^.flags := StatusFlag; - TempPacket^.priv := StatusInfo; - // put a copy of the package into the queue - Result := Put(TempPacket); - // data has been copied -> delete temp. package - av_free(TempPacket); -end; - -procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket); -begin - if (Packet.priv <> nil) then - FreeMem(Packet.priv); -end; - -function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer; -begin - Result := Packet.priv; -end; - -function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer; -var - CurrentListEntry: PAVPacketList; -const - WAIT_TIMEOUT = 10; // timeout in ms -begin - Result := -1; - - SDL_LockMutex(Mutex); - try - while (true) do - begin - if (AbortRequest) then - Exit; - - CurrentListEntry := FirstListEntry; - if (CurrentListEntry <> nil) then - begin - FirstListEntry := CurrentListEntry^.next; - if (FirstListEntry = nil) then - LastListEntry := nil; - Dec(PacketCount); - - Size := Size - CurrentListEntry^.pkt.size; - Packet := CurrentListEntry^.pkt; - av_free(CurrentListEntry); - - Result := 1; - Break; - end - else if (not Blocking) then - begin - Result := 0; - Break; - end - else - begin - // block until a new package arrives, - // but do not wait till infinity to avoid deadlocks - if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then - begin - Result := 0; - Break; - end; - end; - end; - finally - SDL_UnlockMutex(Mutex); - end; -end; - -function TPacketQueue.GetSize(): integer; -begin - SDL_LockMutex(Mutex); - Result := Size; - SDL_UnlockMutex(Mutex); -end; - -procedure TPacketQueue.Flush(); -var - CurrentListEntry, TempListEntry: PAVPacketList; -begin - SDL_LockMutex(Mutex); - - CurrentListEntry := FirstListEntry; - while(CurrentListEntry <> nil) do - begin - TempListEntry := CurrentListEntry^.next; - // free status data - if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then - FreeStatusInfo(CurrentListEntry^.pkt); - // free packet data - av_free_packet(@CurrentListEntry^.pkt); - // Note: param must be a pointer to a pointer! - av_freep(@CurrentListEntry); - CurrentListEntry := TempListEntry; - end; - LastListEntry := nil; - FirstListEntry := nil; - PacketCount := 0; - Size := 0; - - SDL_UnlockMutex(Mutex); -end; - -end. diff --git a/src/base/UMediaCore_SDL.pas b/src/base/UMediaCore_SDL.pas deleted file mode 100644 index 252f72a0..00000000 --- a/src/base/UMediaCore_SDL.pas +++ /dev/null @@ -1,38 +0,0 @@ -unit UMediaCore_SDL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UMusic, - sdl; - -function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; - -implementation - -function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean; -begin - case Format of - asfU8: SDLFormat := AUDIO_U8; - asfS8: SDLFormat := AUDIO_S8; - asfU16LSB: SDLFormat := AUDIO_U16LSB; - asfS16LSB: SDLFormat := AUDIO_S16LSB; - asfU16MSB: SDLFormat := AUDIO_U16MSB; - asfS16MSB: SDLFormat := AUDIO_S16MSB; - asfU16: SDLFormat := AUDIO_U16; - asfS16: SDLFormat := AUDIO_S16; - else begin - Result := false; - Exit; - end; - end; - Result := true; -end; - -end. diff --git a/src/base/UMedia_dummy.pas b/src/base/UMedia_dummy.pas deleted file mode 100644 index 438b89ab..00000000 --- a/src/base/UMedia_dummy.pas +++ /dev/null @@ -1,243 +0,0 @@ -unit UMedia_dummy; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -implementation - -uses - SysUtils, - math, - UMusic; - -type - TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput ) - private - DummyOutputDeviceList: TAudioOutputDeviceList; - public - constructor Create(); - function GetName: string; - - function Init(): boolean; - function Finalize(): boolean; - - 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 SetSyncSource(SyncSource: TSyncSource); - - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); - - // IAudioInput - function InitializeRecord: boolean; - function FinalizeRecord: boolean; - procedure CaptureStart; - procedure CaptureStop; - procedure GetFFTData(var data: TFFTData); - function GetPCMData(var data: TPCMData): Cardinal; - - // IAudioPlayback - function InitializePlayback: boolean; - function FinalizePlayback: boolean; - - function GetOutputDeviceList(): TAudioOutputDeviceList; - procedure FadeIn(Time: real; TargetVolume: single); - procedure SetAppVolume(Volume: single); - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - procedure Rewind; - - function Finished: boolean; - function Length: real; - - function OpenSound(const Filename: string): TAudioPlaybackStream; - procedure CloseSound(var PlaybackStream: TAudioPlaybackStream); - procedure PlaySound(stream: TAudioPlaybackStream); - procedure StopSound(stream: TAudioPlaybackStream); - - function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; - procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream); - end; - -function TMedia_dummy.GetName: string; -begin - Result := 'dummy'; -end; - -procedure TMedia_dummy.GetFrame(Time: Extended); -begin -end; - -procedure TMedia_dummy.DrawGL(Screen: integer); -begin -end; - -constructor TMedia_dummy.Create(); -begin - inherited; -end; - -function TMedia_dummy.Init(): boolean; -begin - Result := true; -end; - -function TMedia_dummy.Finalize(): boolean; -begin - Result := true; -end; - -function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed -begin - Result := false; -end; - -procedure TMedia_dummy.Close; -begin -end; - -procedure TMedia_dummy.Play; -begin -end; - -procedure TMedia_dummy.Pause; -begin -end; - -procedure TMedia_dummy.Stop; -begin -end; - -procedure TMedia_dummy.SetPosition(Time: real); -begin -end; - -function TMedia_dummy.GetPosition: real; -begin - Result := 0; -end; - -procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource); -begin -end; - -// IAudioInput -function TMedia_dummy.InitializeRecord: boolean; -begin - Result := true; -end; - -function TMedia_dummy.FinalizeRecord: boolean; -begin - Result := true; -end; - -procedure TMedia_dummy.CaptureStart; -begin -end; - -procedure TMedia_dummy.CaptureStop; -begin -end; - -procedure TMedia_dummy.GetFFTData(var data: TFFTData); -begin -end; - -function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal; -begin - Result := 0; -end; - -// IAudioPlayback -function TMedia_dummy.InitializePlayback: boolean; -begin - SetLength(DummyOutputDeviceList, 1); - DummyOutputDeviceList[0] := TAudioOutputDevice.Create(); - DummyOutputDeviceList[0].Name := '[Dummy Device]'; - Result := true; -end; - -function TMedia_dummy.FinalizePlayback: boolean; -begin - Result := true; -end; - -function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList; -begin - Result := DummyOutputDeviceList; -end; - -procedure TMedia_dummy.SetAppVolume(Volume: single); -begin -end; - -procedure TMedia_dummy.SetVolume(Volume: single); -begin -end; - -procedure TMedia_dummy.SetLoop(Enabled: boolean); -begin -end; - -procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single); -begin -end; - -procedure TMedia_dummy.Rewind; -begin -end; - -function TMedia_dummy.Finished: boolean; -begin - Result := false; -end; - -function TMedia_dummy.Length: real; -begin - Result := 60; -end; - -function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream; -begin - Result := nil; -end; - -procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream); -begin -end; - -procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream); -begin -end; - -procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream); -begin -end; - -function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; -begin - Result := nil; -end; - -procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream); -begin -end; - -initialization - MediaManager.Add(TMedia_dummy.Create); - -end. diff --git a/src/base/UVideo.pas b/src/base/UVideo.pas deleted file mode 100644 index 0ab1d350..00000000 --- a/src/base/UVideo.pas +++ /dev/null @@ -1,828 +0,0 @@ -{############################################################################## - # FFmpeg support for UltraStar deluxe # - # # - # Created by b1indy # - # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # - # with modifications by Jay Binks # - # # - # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # - # http://www.nabble.com/file/p11795857/mpegpas01.zip # - # # - ##############################################################################} - -unit UVideo; - -// uncomment if you want to see the debug stuff -{.$define DebugDisplay} -{.$define DebugFrames} -{.$define VideoBenchmark} -{.$define Info} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// use BGR-format for accelerated colorspace conversion with swscale -{$IFDEF UseSWScale} - {$DEFINE PIXEL_FMT_BGR} -{$ENDIF} - -implementation - -uses - SDL, - textgl, - avcodec, - avformat, - avutil, - avio, - rational, - {$IFDEF UseSWScale} - swscale, - {$ENDIF} - UMediaCore_FFmpeg, - math, - gl, - glext, - SysUtils, - UCommon, - UConfig, - ULog, - UMusic, - UGraphicClasses, - UGraphic; - -const -{$IFDEF PIXEL_FMT_BGR} - PIXEL_FMT_OPENGL = GL_BGR; - PIXEL_FMT_FFMPEG = PIX_FMT_BGR24; -{$ELSE} - PIXEL_FMT_OPENGL = GL_RGB; - PIXEL_FMT_FFMPEG = PIX_FMT_RGB24; -{$ENDIF} - -type - TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback ) - private - fVideoOpened, - fVideoPaused: Boolean; - - VideoStream: PAVStream; - VideoStreamIndex : Integer; - VideoFormatContext: PAVFormatContext; - VideoCodecContext: PAVCodecContext; - VideoCodec: PAVCodec; - - AVFrame: PAVFrame; - AVFrameRGB: PAVFrame; - FrameBuffer: PByte; - - {$IFDEF UseSWScale} - SoftwareScaleContext: PSwsContext; - {$ENDIF} - - fVideoTex: GLuint; - TexWidth, TexHeight: Cardinal; - - VideoAspect: Real; - VideoTimeBase, VideoTime: Extended; - fLoopTime: Extended; - - EOF: boolean; - Loop: boolean; - - Initialized: boolean; - - procedure Reset(); - function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; - procedure SynchronizeVideo(Frame: PAVFrame; var pts: double); - public - function GetName: String; - - function Init(): boolean; - function Finalize: boolean; - - 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; - -var - FFmpegCore: TMediaCore_FFmpeg; - - -// These are called whenever we allocate a frame buffer. -// We use this to store the global_pts in a frame at the time it is allocated. -function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl; -var - pts: Pint64; - VideoPktPts: Pint64; -begin - Result := avcodec_default_get_buffer(CodecCtx, Frame); - VideoPktPts := CodecCtx^.opaque; - if (VideoPktPts <> nil) then - begin - // Note: we must copy the pts instead of passing a pointer, because the packet - // (and with it the pts) might change before a frame is returned by av_decode_video. - pts := av_malloc(sizeof(int64)); - pts^ := VideoPktPts^; - Frame^.opaque := pts; - end; -end; - -procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl; -begin - if (Frame <> nil) then - av_freep(@Frame^.opaque); - avcodec_default_release_buffer(CodecCtx, Frame); -end; - - -{*------------------------------------------------------------------------------ - * TVideoPlayback_ffmpeg - *------------------------------------------------------------------------------} - -function TVideoPlayback_FFmpeg.GetName: String; -begin - result := 'FFmpeg_Video'; -end; - -function TVideoPlayback_FFmpeg.Init(): boolean; -begin - Result := true; - - if (Initialized) then - Exit; - Initialized := true; - - FFmpegCore := TMediaCore_FFmpeg.GetInstance(); - - Reset(); - av_register_all(); - glGenTextures(1, PGLuint(@fVideoTex)); -end; - -function TVideoPlayback_FFmpeg.Finalize(): boolean; -begin - Close(); - glDeleteTextures(1, PGLuint(@fVideoTex)); - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.Reset(); -begin - // close previously opened video - Close(); - - fVideoOpened := False; - fVideoPaused := False; - VideoTimeBase := 0; - VideoTime := 0; - VideoStream := nil; - VideoStreamIndex := -1; - - EOF := false; - - // TODO: do we really want this by default? - Loop := true; - fLoopTime := 0; -end; - -function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed -var - errnum: Integer; - AudioStreamIndex: integer; -begin - Result := false; - - Reset(); - - errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil); - if (errnum <> 0) then - begin - Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')'); - Exit; - end; - - // update video info - if (av_find_stream_info(VideoFormatContext) < 0) then - begin - Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open'); - - // find video stream - FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex); - if (VideoStreamIndex < 0) then - begin - Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - VideoStream := VideoFormatContext^.streams[VideoStreamIndex]; - VideoCodecContext := VideoStream^.codec; - - VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id); - if (VideoCodec = nil) then - begin - Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // set debug options - VideoCodecContext^.debug_mv := 0; - VideoCodecContext^.debug := 0; - - // detect bug-workarounds automatically - VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT; - // error resilience strategy (careful/compliant/agressive/very_aggressive) - //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT; - // allow non spec compliant speedup tricks. - //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST; - - // Note: avcodec_open() and avcodec_close() are not thread-safe and will - // fail if called concurrently by different threads. - FFmpegCore.LockAVCodec(); - try - errnum := avcodec_open(VideoCodecContext, VideoCodec); - finally - FFmpegCore.UnlockAVCodec(); - end; - if (errnum < 0) then - begin - Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // register custom callbacks for pts-determination - VideoCodecContext^.get_buffer := PtsGetBuffer; - VideoCodecContext^.release_buffer := PtsReleaseBuffer; - - {$ifdef DebugDisplay} - DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak + - sLineBreak + - ' Width = '+inttostr(VideoCodecContext^.width) + - ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak + - ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' + - inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak + - ' 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(); - FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG, - VideoCodecContext^.width, VideoCodecContext^.height)); - - if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then - begin - Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT - // (otherwise video will be distorted if width/height is not a multiple of the alignment) - errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG, - VideoCodecContext^.width, VideoCodecContext^.height); - if (errnum < 0) then - begin - Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - - // calculate some information for video display - VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio); - if (VideoAspect = 0) then - VideoAspect := VideoCodecContext^.width / - VideoCodecContext^.height - else - VideoAspect := VideoAspect * VideoCodecContext^.width / - VideoCodecContext^.height; - - VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate); - - // hack to get reasonable timebase (for divx and others) - if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps - begin - VideoTimeBase := av_q2d(VideoStream^.r_frame_rate); - while (VideoTimeBase > 50) do - VideoTimeBase := VideoTimeBase/10; - VideoTimeBase := 1/VideoTimeBase; - end; - - Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open'); - Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open'); - - {$IFDEF UseSWScale} - // if available get a SWScale-context -> faster than the deprecated img_convert(). - // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555. - // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!! - // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its - // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up - // could be observed in comparison to the RGB versions. - SoftwareScaleContext := sws_getContext( - VideoCodecContext^.width, VideoCodecContext^.height, - integer(VideoCodecContext^.pix_fmt), - VideoCodecContext^.width, VideoCodecContext^.height, - integer(PIXEL_FMT_FFMPEG), - SWS_FAST_BILINEAR, nil, nil, nil); - if (SoftwareScaleContext = nil) then - begin - Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open'); - Close(); - Exit; - end; - {$ENDIF} - - TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); - TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); - - // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later. - // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height. - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0, - PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - - fVideoOpened := True; - - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.Close; -begin - if (FrameBuffer <> nil) then - av_free(FrameBuffer); - if (AVFrameRGB <> nil) then - av_free(AVFrameRGB); - if (AVFrame <> nil) then - av_free(AVFrame); - - AVFrame := nil; - AVFrameRGB := nil; - FrameBuffer := nil; - - if (VideoCodecContext <> nil) then - begin - // avcodec_close() is not thread-safe - FFmpegCore.LockAVCodec(); - try - avcodec_close(VideoCodecContext); - finally - FFmpegCore.UnlockAVCodec(); - end; - end; - - if (VideoFormatContext <> nil) then - av_close_input_file(VideoFormatContext); - - VideoCodecContext := nil; - VideoFormatContext := nil; - - fVideoOpened := False; -end; - -procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double); -var - FrameDelay: double; -begin - if (pts <> 0) then - begin - // if we have pts, set video clock to it - VideoTime := pts; - end else - begin - // if we aren't given a pts, set it to the clock - pts := VideoTime; - end; - // update the video clock - FrameDelay := av_q2d(VideoCodecContext^.time_base); - // if we are repeating a frame, adjust clock accordingly - FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5); - VideoTime := VideoTime + FrameDelay; -end; - -function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean; -var - FrameFinished: Integer; - VideoPktPts: int64; - pbIOCtx: PByteIOContext; - errnum: integer; -begin - Result := false; - FrameFinished := 0; - - if EOF then - Exit; - - // read packets until we have a finished frame (or there are no more packets) - while (FrameFinished = 0) do - begin - errnum := av_read_frame(VideoFormatContext, AVPacket); - if (errnum < 0) then - begin - // failed to read a frame, check reason - - {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} - pbIOCtx := VideoFormatContext^.pb; - {$ELSE} - pbIOCtx := @VideoFormatContext^.pb; - {$IFEND} - - // check for end-of-file (eof is not an error) - if (url_feof(pbIOCtx) <> 0) then - begin - EOF := true; - Exit; - end; - - // check for errors - if (url_ferror(pbIOCtx) <> 0) then - Exit; - - // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov) - // so we have to do it this way. - if ((VideoFormatContext^.file_size <> 0) and - (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then - begin - EOF := true; - Exit; - end; - - // no error -> wait for user input - SDL_Delay(100); - continue; - end; - - // if we got a packet from the video stream, then decode it - if (AVPacket.stream_index = VideoStreamIndex) then - begin - // save pts to be stored in pFrame in first call of PtsGetBuffer() - VideoPktPts := AVPacket.pts; - VideoCodecContext^.opaque := @VideoPktPts; - - // decode packet - avcodec_decode_video(VideoCodecContext, AVFrame, - frameFinished, AVPacket.data, AVPacket.size); - - // reset opaque data - VideoCodecContext^.opaque := nil; - - // update pts - if (AVPacket.dts <> AV_NOPTS_VALUE) then - begin - pts := AVPacket.dts; - end - else if ((AVFrame^.opaque <> nil) and - (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then - begin - pts := Pint64(AVFrame^.opaque)^; - end - else - begin - pts := 0; - end; - pts := pts * av_q2d(VideoStream^.time_base); - - // synchronize on each complete frame - if (frameFinished <> 0) then - SynchronizeVideo(AVFrame, pts); - end; - - // free the packet from av_read_frame - av_free_packet( @AVPacket ); - end; - - Result := true; -end; - -procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended); -var - AVPacket: TAVPacket; - errnum: Integer; - myTime: Extended; - TimeDifference: Extended; - DropFrameCount: Integer; - pts: double; - i: Integer; -const - FRAME_DROPCOUNT = 3; -begin - if not fVideoOpened then - Exit; - - if fVideoPaused then - Exit; - - // current time, relative to last loop (if any) - myTime := Time - fLoopTime; - // time since the last frame was returned - TimeDifference := myTime - VideoTime; - - {$IFDEF DebugDisplay} - DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // check if a new frame is needed - if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then - begin - {$ifdef DebugFrames} - // frame delay debug display - GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); - {$endif} - - {$IFDEF DebugDisplay} - DebugWriteln('not getting new frame' + sLineBreak + - 'Time: '+inttostr(floor(Time*1000)) + sLineBreak + - 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // we do not need a new frame now - Exit; - end; - - // update video-time to the next frame - VideoTime := VideoTime + VideoTimeBase; - TimeDifference := myTime - VideoTime; - - // check if we have to skip frames - if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then - begin - {$IFDEF DebugFrames} - //frame drop debug display - GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); - {$ENDIF} - {$IFDEF DebugDisplay} - DebugWriteln('skipping frames' + sLineBreak + - 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak + - 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); - {$endif} - - // update video-time - DropFrameCount := Trunc(TimeDifference / VideoTimeBase); - VideoTime := VideoTime + DropFrameCount*VideoTimeBase; - - // skip half of the frames, this is much smoother than to skip all at once - for i := 1 to DropFrameCount (*div 2*) do - DecodeFrame(AVPacket, pts); - end; - - {$IFDEF VideoBenchmark} - Log.BenchmarkStart(15); - {$ENDIF} - - if (not DecodeFrame(AVPacket, pts)) then - begin - if Loop then - begin - // Record the time we looped. This is used to keep the loops in time. otherwise they speed - SetPosition(0); - fLoopTime := Time; - end; - Exit; - end; - - // TODO: support for pan&scan - //if (AVFrame.pan_scan <> nil) then - //begin - // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height])); - //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), PIXEL_FMT_FFMPEG, - PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, - VideoCodecContext^.width, VideoCodecContext^.height); - {$ENDIF} - - if (errnum < 0) then - begin - Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame'); - Exit; - end; - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(15); - Log.BenchmarkStart(16); - {$ENDIF} - - // TODO: data is not padded, so we will need to tell OpenGL. - // Or should we add padding with avpicture_fill? (check which one is faster) - //glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0, - VideoCodecContext^.width, VideoCodecContext^.height, - PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); - - {$ifdef DebugFrames} - //frame decode debug display - GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00); - {$endif} - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(16); - Log.LogBenchmark('FFmpeg', 15); - Log.LogBenchmark('Texture', 16); - {$ENDIF} -end; - -procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer); -var - TexVideoRightPos, TexVideoLowerPos: Single; - ScreenLeftPos, ScreenRightPos: Single; - ScreenUpperPos, ScreenLowerPos: Single; - ScaledVideoWidth, ScaledVideoHeight: Single; - ScreenMidPosX, ScreenMidPosY: Single; - ScreenAspect: Single; -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; - - {$IFDEF VideoBenchmark} - Log.BenchmarkStart(15); - {$ENDIF} - - // TODO: add a SetAspectCorrectionMode() function so we can switch - // aspect correction. The screens video backgrounds look very ugly with aspect - // correction because of the white bars at the top and bottom. - - ScreenAspect := ScreenW / ScreenH; - ScaledVideoWidth := RenderW; - ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect; - - // Note: Scaling the width does not look good because the video might contain - // black borders at the top already - //ScaledVideoHeight := RenderH; - //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect; - - // center the video - ScreenMidPosX := RenderW/2; - ScreenMidPosY := RenderH/2; - ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2; - ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2; - ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2; - ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2; - // the video-texture contains empty borders because its width and height must be - // a power of 2. So we have to determine the texture coords of the video. - TexVideoRightPos := VideoCodecContext^.width / TexWidth; - TexVideoLowerPos := VideoCodecContext^.height / TexHeight; - - // we could use blending for brightness control, but do we need this? - glDisable(GL_BLEND); - - // TODO: disable other stuff like lightning, etc. - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, fVideoTex); - glColor3f(1, 1, 1); - glBegin(GL_QUADS); - // upper-left coord - glTexCoord2f(0, 0); - glVertex2f(ScreenLeftPos, ScreenUpperPos); - // lower-left coord - glTexCoord2f(0, TexVideoLowerPos); - glVertex2f(ScreenLeftPos, ScreenLowerPos); - // lower-right coord - glTexCoord2f(TexVideoRightPos, TexVideoLowerPos); - glVertex2f(ScreenRightPos, ScreenLowerPos); - // upper-right coord - glTexCoord2f(TexVideoRightPos, 0); - glVertex2f(ScreenRightPos, ScreenUpperPos); - glEnd; - glDisable(GL_TEXTURE_2D); - - {$IFDEF VideoBenchmark} - Log.BenchmarkEnd(15); - Log.LogBenchmark('DrawGL', 15); - {$ENDIF} - - {$IFDEF Info} - if (fVideoSkipTime+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; - -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); -var - SeekFlags: integer; -begin - if not fVideoOpened then - Exit; - - if (Time < 0) then - Time := 0; - - // TODO: handle loop-times - //Time := Time mod VideoDuration; - - // backward seeking might fail without AVSEEK_FLAG_BACKWARD - SeekFlags := AVSEEK_FLAG_ANY; - if (Time < VideoTime) then - SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD; - - VideoTime := Time; - EOF := false; - - if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then - begin - Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition'); - Exit; - end; - - avcodec_flush_buffers(VideoCodecContext); -end; - -function TVideoPlayback_FFmpeg.GetPosition: real; -begin - // TODO: return video-position in seconds - Result := VideoTime; -end; - -initialization - MediaManager.Add(TVideoPlayback_FFmpeg.Create); - -end. diff --git a/src/base/UVisualizer.pas b/src/base/UVisualizer.pas deleted file mode 100644 index e2125201..00000000 --- a/src/base/UVisualizer.pas +++ /dev/null @@ -1,442 +0,0 @@ -unit UVisualizer; - -(* TODO: - * - fix video/visualizer switching - * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer, - * this will prevent plugins from messing up our render-context - * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()). - * - create a generic (C-compatible) interface for visualization plugins - * - create a visualization plugin manager - * - write a plugin for projectM in C/C++ (so we need no wrapper anymore) - *) - -{* Note: - * It would be easier to create a seperate Render-Context (RC) for projectM - * and switch to it when necessary. This can be achieved by pbuffers - * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension - * (fast and plattform-independent but not supported by older graphic-cards/drivers). - * - * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt - * - * To support as many cards as possible we will stick to the current dirty - * solution for now even if it is a pain to save/restore projectM's state due - * to bugs etc. - * - * This also restricts us to projectM. As other plug-ins might have different - * needs and bugs concerning the OpenGL state, USDX's state would probably be - * corrupted after the plug-in finshed drawing. - *} - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - UGraphicClasses, - textgl, - math, - gl, - SysUtils, - UIni, - projectM, - UMusic; - -implementation - -uses - UGraphic, - UMain, - UConfig, - ULog; - -{$IF PROJECTM_VERSION < 1000000} // < 1.0 -// Initialization data used on projectM 0.9x creation. -// Since projectM 1.0 this data is passed via the config-file. -const - meshX = 32; - meshY = 24; - fps = 30; - textureSize = 512; -{$IFEND} - -type - TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization ) - private - pm: TProjectM; - ProjectMPath : string; - Initialized: boolean; - - VisualizerStarted: boolean; - VisualizerPaused: boolean; - - VisualTex: GLuint; - PCMData: TPCMData; - RndPCMcount: integer; - - projMatrix: array[0..3, 0..3] of GLdouble; - texMatrix: array[0..3, 0..3] of GLdouble; - - procedure VisualizerStart; - procedure VisualizerStop; - - procedure VisualizerTogglePause; - - function GetRandomPCMData(var data: TPCMData): Cardinal; - - procedure SaveOpenGLState(); - procedure RestoreOpenGLState(); - - public - function GetName: String; - - function Init(): boolean; - function Finalize(): boolean; - - 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; - - -function TVideoPlayback_ProjectM.GetName: String; -begin - Result := 'ProjectM'; -end; - -function TVideoPlayback_ProjectM.Init(): boolean; -begin - Result := true; - - if (Initialized) then - Exit; - Initialized := true; - - RndPCMcount := 0; - - ProjectMPath := ProjectM_DataDir + PathDelim; - - VisualizerStarted := False; - VisualizerPaused := False; - - {$IFDEF UseTexture} - glGenTextures(1, PglUint(@VisualTex)); - glBindTexture(GL_TEXTURE_2D, VisualTex); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - {$ENDIF} -end; - -function TVideoPlayback_ProjectM.Finalize(): boolean; -begin - VisualizerStop(); - {$IFDEF UseTexture} - glDeleteTextures(1, PglUint(@VisualTex)); - {$ENDIF} - Result := true; -end; - -function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed -begin - Result := false; -end; - -procedure TVideoPlayback_ProjectM.Close; -begin - VisualizerStop(); -end; - -procedure TVideoPlayback_ProjectM.Play; -begin - VisualizerStart(); -end; - -procedure TVideoPlayback_ProjectM.Pause; -begin - VisualizerTogglePause(); -end; - -procedure TVideoPlayback_ProjectM.Stop; -begin - VisualizerStop(); -end; - -procedure TVideoPlayback_ProjectM.SetPosition(Time: real); -begin - if assigned(pm) then - pm.RandomPreset(); -end; - -function TVideoPlayback_ProjectM.GetPosition: real; -begin - Result := 0; -end; - -{** - * Saves the current OpenGL state. - * This is necessary to prevent projectM from corrupting USDX's current - * OpenGL state. - * - * The following steps are performed: - * - All attributes are pushed to the attribute-stack - * - Projection-/Texture-matrices are saved - * - Modelview-matrix is pushed to the Modelview-stack - * - the OpenGL error-state (glGetError) is cleared - *} -procedure TVideoPlayback_ProjectM.SaveOpenGLState(); -begin - // save all OpenGL state-machine attributes - glPushAttrib(GL_ALL_ATTRIB_BITS); - - // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks. - // OpenGL specifies the depth of those stacks to be at least 2 but projectM - // already uses 2 stack-entries so overflows might be possible on older hardware. - // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can - // use glPushMatrix() for this stack. - - // save projection-matrix - glMatrixMode(GL_PROJECTION); - glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix); - {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 - // bugfix: projection-matrix is popped without being pushed first - glPushMatrix(); - {$IFEND} - - // save texture-matrix - glMatrixMode(GL_TEXTURE); - glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix); - - // save modelview-matrix - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01 - // bugfix: modelview-matrix is popped without being pushed first - glPushMatrix(); - {$IFEND} - - // reset OpenGL error-state - glGetError(); -end; - -{** - * Restores the OpenGL state saved by SaveOpenGLState() - * and resets the error-state. - *} -procedure TVideoPlayback_ProjectM.RestoreOpenGLState(); -begin - // reset OpenGL error-state - glGetError(); - - // restore projection-matrix - glMatrixMode(GL_PROJECTION); - glLoadMatrixd(@projMatrix); - - // restore texture-matrix - glMatrixMode(GL_TEXTURE); - glLoadMatrixd(@texMatrix); - - // restore modelview-matrix - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - - // restore all OpenGL state-machine attributes - glPopAttrib(); -end; - -procedure TVideoPlayback_ProjectM.VisualizerStart; -begin - if VisualizerStarted then - Exit; - - // the OpenGL state must be saved before - SaveOpenGLState(); - try - - try - {$IF PROJECTM_VERSION >= 1000000} // >= 1.0 - pm := TProjectM.Create(ProjectMPath + 'config.inp'); - {$ELSE} - pm := TProjectM.Create( - meshX, meshY, fps, textureSize, ScreenW, ScreenH, - ProjectMPath + 'presets', ProjectMPath + 'fonts'); - {$IFEND} - except on E: Exception do - begin - // Create() might fail if the config-file is not found - Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart'); - Exit; - end; - end; - - // initialize OpenGL - pm.ResetGL(ScreenW, ScreenH); - // skip projectM default-preset - pm.RandomPreset(); - // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension. - // Unfortunately it does NOT reset the framebuffer-context after - // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for - // a manual reset or TProjectM.RenderFrame() must be called. - // We use the latter so we do not need to load the FBO extension in USDX. - pm.RenderFrame(); - - VisualizerStarted := True; - finally - RestoreOpenGLState(); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerStop; -begin - if VisualizerStarted then - begin - VisualizerStarted := False; - FreeAndNil(pm); - end; -end; - -procedure TVideoPlayback_ProjectM.VisualizerTogglePause; -begin - VisualizerPaused := not VisualizerPaused; -end; - -procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended); -var - nSamples: cardinal; - stackDepth: Integer; -begin - if not VisualizerStarted then - Exit; - - if VisualizerPaused then - Exit; - - // get audio data - nSamples := AudioPlayback.GetPCMData(PcmData); - - // generate some data if non is available - if (nSamples = 0) then - nSamples := GetRandomPCMData(PcmData); - - // send audio-data to projectM - if (nSamples > 0) then - pm.AddPCM16Data(PSmallInt(@PcmData), nSamples); - - // store OpenGL state (might be messed up otherwise) - SaveOpenGLState(); - try - // setup projectM's OpenGL state - pm.ResetGL(ScreenW, ScreenH); - - // let projectM render a frame - pm.RenderFrame(); - - {$IFDEF UseTexture} - glBindTexture(GL_TEXTURE_2D, VisualTex); - glFlush(); - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0); - {$ENDIF} - finally - // restore USDX OpenGL state - RestoreOpenGLState(); - end; - - // discard projectM's depth buffer information (avoid overlay) - glClear(GL_DEPTH_BUFFER_BIT); -end; - -{** - * Draws the current frame to screen. - * TODO: this is not used yet. Data is directly drawn on GetFrame(). - *} -procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer); -begin - {$IFDEF UseTexture} - // have a nice black background to draw on - 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 VisualizerStarted then - Exit; - - // setup display - glMatrixMode(GL_PROJECTION); - glPushMatrix(); - glLoadIdentity(); - gluOrtho2D(0, 1, 0, 1); - glMatrixMode(GL_MODELVIEW); - glPushMatrix(); - glLoadIdentity(); - - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE); - glBindTexture(GL_TEXTURE_2D, VisualTex); - glColor4f(1, 1, 1, 1); - - // draw projectM frame - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(1, 0); glVertex2f(1, 0); - glTexCoord2f(1, 1); glVertex2f(1, 1); - glTexCoord2f(0, 1); glVertex2f(0, 1); - glEnd(); - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // restore state - glMatrixMode(GL_PROJECTION); - glPopMatrix(); - glMatrixMode(GL_MODELVIEW); - glPopMatrix(); - {$ENDIF} -end; - -{** - * Produces random "sound"-data in case no audio-data is available. - * Otherwise the visualization will look rather boring. - *} -function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal; -var - i: integer; -begin - // Produce some fake PCM data - if (RndPCMcount mod 500 = 0) then - begin - FillChar(data, SizeOf(TPCMData), 0); - end - else - begin - for i := 0 to 511 do - begin - data[i][0] := Random(High(Word)+1); - data[i][1] := Random(High(Word)+1); - end; - end; - Inc(RndPCMcount); - Result := 512; -end; - - -initialization - MediaManager.Add(TVideoPlayback_ProjectM.Create); - -end. -- cgit v1.2.3 From 76cf2462d732357522cc6aadcf66027bd55cad0f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 13 Sep 2008 11:26:03 +0000 Subject: SourceForge patch [2086204] applied. Thanks hawkear. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1378 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 316 ++++++++++++++++++++++++++--------------------------- 1 file changed, 154 insertions(+), 162 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 3517bce6..a99ca4a4 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -234,8 +234,8 @@ begin Lines[Count].Line[0].LastLine := False; end; - // TempC := ':'; - // TempC := Text[1]; // read from backup variable, don't use default ':' value + //TempC := ':'; + //TempC := Text[1]; // read from backup variable, don't use default ':' value while (TempC <> 'E') AND (not EOF(SongFile)) do begin @@ -248,20 +248,19 @@ begin Read(SongFile, Param3); Read(SongFile, ParamS); - - //Check for ZeroNote - if Param2 = 0 then Log.LogError('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 + //Check for ZeroNote + if Param2 = 0 then Log.LogError('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 @@ -402,11 +401,12 @@ begin Lines[Count].Line[0].LastLine := False; end; -//Try to Parse the Song + //Try to Parse the Song if Parser.ParseSong(Path + PathDelim + FileName) then begin -// Writeln('XML Inputfile Parsed succesful'); + //Writeln('XML Inputfile Parsed succesful'); + //Start write parsed information to Song //Notes Part for I := 0 to High(Parser.SongInfo.Sentences) do @@ -414,93 +414,90 @@ begin //Add Notes for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do begin - case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of - NT_Normal: NoteType := ':'; - NT_Golden: NoteType := '*'; - NT_Freestyle: NoteType := 'F'; - end; - - Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start - Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration - Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone - ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric - - if not Both then - // P1 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else - begin - // P1 + P2 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; + case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of + NT_Normal: NoteType := ':'; + NT_Golden: NoteType := '*'; + NT_Freestyle: NoteType := 'F'; + 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 X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; - 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 X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; - - end; - //Total Notes Patch End - end; - end; { end of for loop } + Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start + Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration + Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone + ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric + + if not Both then + // P1 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) + else + begin + // P1 + P2 + ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); + ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); + 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 X := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do + begin + if (Lines[CP].Line[Lines[CP].High].Note[X].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + + if (Lines[CP].Line[Lines[CP].High].Note[X].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + 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 X := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do + begin + if (Lines[Count].Line[Lines[Count].High].Note[X].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + if (Lines[Count].Line[Lines[Count].High].Note[X].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + + end; + //Total Notes Patch End + end; + end; { end of for loop } end; //J Forloop - //Add Sentence break + //Add Sentence break if (I < High(Parser.SongInfo.Sentences)) then begin - - SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; - Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; - - //Calculate Time - case Rest of - 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; - 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; - else - if (Rest >= 4) then - Time := SentenceEnd + 2 - else //Sentence overlapping :/ - Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - end; - // new sentence - if not Both then - // P1 - NewSentence(0, (Time + Rel[0]) * Mult, Param2) - else - begin - // P1 + P2 - NewSentence(0, (Time + Rel[0]) * Mult, Param2); - NewSentence(1, (Time + Rel[1]) * Mult, Param2); - end; + SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; + Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; + + //Calculate Time + case Rest of + 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; + 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; + else + if (Rest >= 4) then + Time := SentenceEnd + 2 + else //Sentence overlapping :/ + Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; + end; + // new sentence + if not Both then // P1 + NewSentence(0, (Time + Rel[0]) * Mult, Param2) + else + begin // P1 + P2 + NewSentence(0, (Time + Rel[0]) * Mult, Param2); + NewSentence(1, (Time + Rel[1]) * Mult, Param2); + end; end; end; @@ -531,79 +528,78 @@ begin Result := true; Done := 0; -//Parse XML - Parser := TParser.Create; - Parser.Settings.DashReplacement := '~'; + //Parse XML + Parser := TParser.Create; + Parser.Settings.DashReplacement := '~'; + if Parser.ParseSong(self.Path + self.FileName) then + begin + //----------- + //Required Attributes + //----------- - if Parser.ParseSong(self.Path + self.FileName) then - begin - //----------- - //Required Attributes - //----------- - - //Title - self.Title := Parser.SongInfo.Header.Title; + //Title + self.Title := Parser.SongInfo.Header.Title; - //Add Title Flag to Done - Done := Done or 1; + //Add Title Flag to Done + Done := Done or 1; - //Artist - self.Artist := Parser.SongInfo.Header.Artist; + //Artist + self.Artist := Parser.SongInfo.Header.Artist; - //Add Artist Flag to Done - Done := Done or 2; + //Add Artist Flag to Done + Done := Done or 2; - //MP3 File //Test if Exists - self.Mp3 := platform.FindSongFile(Path, '*.mp3'); - if (FileExists(self.Path + self.Mp3)) then - //Add Mp3 Flag to Done - Done := Done or 4; + //MP3 File //Test if Exists + self.Mp3 := platform.FindSongFile(Path, '*.mp3'); + //Add Mp3 Flag to Done + if (FileExists(self.Path + self.Mp3)) then + Done := Done or 4; - //Beats per Minute - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; + //Beats per Minute + SetLength(self.BPM, 1); + self.BPM[0].StartBeat := 0; - self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; + self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; - if self.BPM[0].BPM <> 0 then - //Add BPM Flag to Done - Done := Done or 8; + //Add BPM Flag to Done + if self.BPM[0].BPM <> 0 then + Done := Done or 8; - //--------- - //Additional Header Information - //--------- + //--------- + //Additional Header Information + //--------- - // Gap - self.GAP := Parser.SongInfo.Header.Gap; + // Gap + self.GAP := Parser.SongInfo.Header.Gap; - //Cover Picture - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + //Cover Picture + self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); - //Background Picture - self.Background := platform.FindSongFile(Path, '*[BG].jpg'); + //Background Picture + self.Background := platform.FindSongFile(Path, '*[BG].jpg'); - // Video File - // self.Video := Value + // Video File + // self.Video := Value - // Video Gap - // self.VideoGAP := song_StrtoFloat( Value ) + // Video Gap + // self.VideoGAP := song_StrtoFloat( Value ) - //Genre Sorting - self.Genre := Parser.SongInfo.Header.Genre; + //Genre Sorting + self.Genre := Parser.SongInfo.Header.Genre; - //Edition Sorting - self.Edition := Parser.SongInfo.Header.Edition; + //Edition Sorting + self.Edition := Parser.SongInfo.Header.Edition; - //Year Sorting - //Parser.SongInfo.Header.Year + //Year Sorting + //Parser.SongInfo.Header.Year - //Language Sorting - self.Language := Parser.SongInfo.Header.Language; - end else - Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); + //Language Sorting + self.Language := Parser.SongInfo.Header.Language; + end else + Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); - Parser.Free; + Parser.Free; //Check if all Required Values are given if (Done <> 15) then @@ -629,7 +625,6 @@ 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; @@ -650,7 +645,7 @@ begin //Read first Line ReadLn (SongFile, Line); - if (Length(Line)<=0) then + if (Length(Line) <= 0) then begin Log.LogError('File Starts with Empty Line: ' + aFileName); Result := False; @@ -658,8 +653,8 @@ begin end; //Read Lines while Line starts with # or its empty - while ( Length(Line) = 0 ) or - ( Line[1] = '#' ) do + while (Length(Line) = 0) or + (Line[1] = '#') do begin //Increase Line Number Inc (FileLineNo); @@ -675,14 +670,13 @@ begin //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); + if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then + Value := Utf8Encode(Value); {$ENDIF} //Title @@ -828,8 +822,6 @@ begin 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 @@ -880,7 +872,7 @@ begin begin if Lines[LineNumber].Number = 1 then Start := -100; -// Start := Note[HighNote].Start; + //Start := Note[HighNote].Start; end; Note[HighNote].Length := DurationP; -- cgit v1.2.3 From b8888af755c5ce6102d66bb057fc7e8d4b128b74 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 13 Sep 2008 12:04:40 +0000 Subject: rename X: integer to NoteIndex: integer git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1379 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 23 ++++++++++++----------- 1 file changed, 12 insertions(+), 11 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index a99ca4a4..b3410550 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -360,7 +360,8 @@ var Param2: integer; Param3: integer; ParamS: string; - I,J,X: integer; + I, J: integer; + NoteIndex: integer; NoteType: Char; SentenceEnd, Rest, Time: Integer; @@ -441,13 +442,13 @@ begin 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 X := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do + for NoteIndex := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do begin - if (Lines[CP].Line[Lines[CP].High].Note[X].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType = ntGolden) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; - if (Lines[CP].Line[Lines[CP].High].Note[X].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length; + if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType <> ntFreestyle) then + Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; end; //Total Notes Patch End end @@ -459,12 +460,12 @@ begin 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 X := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do + for NoteIndex := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do begin - if (Lines[Count].Line[Lines[Count].High].Note[X].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; - if (Lines[Count].Line[Lines[Count].High].Note[X].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length; + if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType = ntGolden) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; + if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType <> ntFreestyle) then + Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; end; //Total Notes Patch End -- cgit v1.2.3 From b0dcfe05f53197bd9f159e46d6cbc2cd3ebff5ca Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 13 Sep 2008 12:18:08 +0000 Subject: minor layout changes. no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1380 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 55 +++++++++++++++++++++++++++++++++++------------------- 1 file changed, 36 insertions(+), 19 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index b3410550..e5a7cf57 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -168,6 +168,7 @@ var Param3: integer; ParamS: string; I: integer; + begin Result := false; @@ -307,7 +308,9 @@ begin Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; end; //Total Notes Patch End - end else begin + end + else + begin for Count := 0 to High(Lines) do begin Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; @@ -350,22 +353,24 @@ end; //Load XML Song function TSong.LoadXMLSong(): 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, J: integer; + //TempC: char; + Text: string; + CP: integer; // Current Player (0 or 1) + Count: integer; + Both: boolean; + Param1: integer; + Param2: integer; + Param3: integer; + ParamS: string; + I, J: integer; NoteIndex: integer; - NoteType: Char; - SentenceEnd, Rest, Time: Integer; + NoteType: char; + SentenceEnd, Rest, Time: integer; Parser: TParser; + begin Result := false; @@ -520,11 +525,13 @@ begin end; function TSong.ReadXMLHeader(const aFileName : WideString): boolean; + var Line, Identifier, Value: string; Temp : word; Done : byte; Parser : TParser; + begin Result := true; Done := 0; @@ -624,8 +631,10 @@ end; function TSong.ReadTXTHeader(const aFileName : WideString): boolean; function song_StrtoFloat( aValue : string ) : Extended; + var lValue : string; + begin lValue := aValue; @@ -639,6 +648,7 @@ var Line, Identifier, Value: string; Temp : word; Done : byte; + begin Result := true; Done := 0; @@ -823,6 +833,7 @@ begin end; procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + begin case Ini.Solmization of 1: // european @@ -902,8 +913,10 @@ begin end; procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); + var I: integer; + begin // stara czesc //Alter Satz //Update Old Part @@ -943,6 +956,7 @@ begin end; procedure TSong.clear(); + begin //Main Information Title := ''; @@ -976,7 +990,9 @@ begin end; + function TSong.Analyse(): boolean; + begin Result := False; @@ -987,15 +1003,15 @@ begin AssignFile(SongFile, self.Path + self.FileName); try - Reset(SongFile); + Reset(SongFile); - //Clear old Song Header - self.clear; + //Clear old Song Header + self.clear; - //Read Header - Result := self.ReadTxTHeader( FileName ) + //Read Header + Result := self.ReadTxTHeader( FileName ) - //And Close File + //And Close File finally CloseFile(SongFile); end; @@ -1003,6 +1019,7 @@ end; function TSong.AnalyseXML(): boolean; + begin Result := False; -- cgit v1.2.3 From a40eb015f8dc43ee087bb8374e67c6a75eb9fbc6 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 13 Sep 2008 13:02:27 +0000 Subject: - stop both Video and Visualizer (because of the video-toggle with 'v'-key both could have been active) (See SF-tracker Patch 2078902) - VideoLoaded does not belong to the song state anymore git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1381 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 1 - 1 file changed, 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index e5a7cf57..8229b9d9 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -80,7 +80,6 @@ type Background: WideString; Video: WideString; VideoGAP: real; - VideoLoaded: boolean; // true if the video has been loaded NotesGAP: integer; Start: real; // in seconds Finish: integer; // in miliseconds -- cgit v1.2.3 From d416ec72d686b15dc1d8083251b33cfe017213fc Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 14 Sep 2008 15:47:04 +0000 Subject: SDL_InitSubSystem() in Initialize3D() is now handled as critical error (to avoid crashes as aftereffects). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1382 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 6fa0aa8f..74088cd9 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -426,8 +426,7 @@ begin Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then begin - Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D'); - exit; + Log.LogCritical('SDL_Init Failed', 'UGraphic.Initialize3D'); end; // load icon image (must be 32x32 for win32) -- cgit v1.2.3 From b277ee24fdac7c45e159262ac9645d7cc42c5f22 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 15 Sep 2008 08:39:59 +0000 Subject: Do not set a minimum size for the alpha component of the screen mode (SDL_GL_ALPHA_SIZE), otherwise on a few systems with some versions of SDL (at least 1.2.11) SDL_SetVideoMode will fail. The problem occured if the adjusted color component sizes did not leave any space for alpha, e.g. red/green/blue ajusted from 5 to 8: r_size+g_size+b_size = 24, so an alpha of at least 5 is just available if the depth is 32bit. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1383 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 16 +++++++++++----- 1 file changed, 11 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 74088cd9..35d8fd3b 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -445,8 +445,8 @@ begin //Log.BenchmarkStart(2); Texture := TTextureUnit.Create; - // FIXME: this does not seem to be correct as Limit is the max. of either - // width or height. + // FIXME: this does not seem to be correct as Limit. + // Is the max. of either width or height. Texture.Limit := 1024*1024; //LoadTextures; @@ -504,7 +504,7 @@ begin // TODO: // here should be a loop which // * draws the loading screen (form time to time) - // * controlls the "process of the loading screen + // * 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 @@ -555,10 +555,17 @@ begin else Screens := Ini.Screens + 1; + // Set minimum color component sizes + // Note: Do NOT use SDL_GL_ALPHA_SIZE here, otherwise on a few systems with + // some versions of SDL (at least 1.2.11) SDL_SetVideoMode will fail. + // The problem occured if the adjusted color component sizes did not leave + // any space for alpha, e.g. red/green/blue ajusted from 5 to 8: + // r_size+g_size+b_size = 24, so an alpha of at least 5 is just available if + // the depth is 32bit. 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); // Z-Buffer depth SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); @@ -584,7 +591,6 @@ begin Depth := Ini.Depth; Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); - //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 ); if (Ini.FullScreen = 0) and (Not Params.FullScreen) then begin -- cgit v1.2.3 From be3de7a824381249d32e301646503afe4f1aca66 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 15 Sep 2008 09:41:41 +0000 Subject: - It is not possible to handle the window/fullscreen command-line parameters with a single boolean member like TCMDParams.Fullscreen. It was replaced by ScreenMode: TScreenMode with TScreenMode = (scmDefault, scmFullscreen, scmWindowed) - cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1384 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommandLine.pas | 250 +++++++++++++++++++++------------------------- src/base/UGraphic.pas | 21 ++-- 2 files changed, 130 insertions(+), 141 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas index 8bdc4f5a..cd1b0352 100644 --- a/src/base/UCommandLine.pas +++ b/src/base/UCommandLine.pas @@ -10,44 +10,46 @@ interface type - //----------- - // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables - //----------- + TScreenMode = (scmDefault, scmFullscreen, scmWindowed); + + {** + * Reads infos from ParamStr and set some easy interface variables + *} TCMDParams = class private - sLanguage: String; - sResolution: String; - public - //Some Boolean Variables Set when Reading Infos - Debug: Boolean; - Benchmark: Boolean; - NoLog: Boolean; - FullScreen: Boolean; - Joypad: Boolean; - - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - Depth: Integer; - Screens: Integer; - - //Some Strings Set when Reading Infos {Length=0 Not Set} - SongPath: String; - ConfigFile: String; - ScoreFile: String; + fLanguage: string; + fResolution: string; - procedure showhelp(); + procedure ShowHelp(); - //Pseudo Integer Values - Function GetLanguage: Integer; - Property Language: Integer read GetLanguage; + procedure ReadParamInfo; + procedure ResetVariables; - Function GetResolution: Integer; - Property Resolution: Integer read GetResolution; - - //Some Procedures for Reading Infos - Constructor Create; - - Procedure ResetVariables; - Procedure ReadParamInfo; + function GetLanguage: integer; + function GetResolution: integer; + public + // some boolean variables set when reading infos + Debug: boolean; + Benchmark: boolean; + NoLog: boolean; + ScreenMode: TScreenMode; + Joypad: boolean; + + // some value variables set when reading infos {-1: Not Set, others: Value} + Depth: integer; + Screens: integer; + + // some strings set when reading infos {Length=0: Not Set} + SongPath: string; + ConfigFile: string; + ScoreFile: string; + + // pseudo integer values + property Language: integer read GetLanguage; + property Resolution: integer read GetResolution; + + // some procedures for reading infos + constructor Create; end; var @@ -62,98 +64,93 @@ const implementation uses SysUtils, - uPlatform; -// uINI -- Nasty requirement... ( removed with permission of blindy ) + UPlatform; - -//------------- -// Constructor - Create class, Reset Variables and Read Infos -//------------- -Constructor TCMDParams.Create; +{** + * Resets variables and reads info + *} +constructor TCMDParams.Create; begin inherited; if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then - showhelp(); + ShowHelp(); ResetVariables; ReadParamInfo; end; -procedure TCMDParams.showhelp(); +procedure TCMDParams.ShowHelp(); - function s( aString : String ) : string; + function Fmt(aString : string) : string; begin - result := aString + StringofChar( ' ', 15 - length( aString ) ); + Result := Format('%-15s', [aString]); end; - -begin - writeln( '' ); - writeln( '**************************************************************' ); - writeln( ' UltraStar Deluxe - Command line switches ' ); - writeln( '**************************************************************' ); - writeln( '' ); - writeln( ' '+s( 'Switch' ) +' : Purpose' ); - writeln( ' ----------------------------------------------------------' ); - writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' ); - writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' ); - writeln( '' ); +begin + writeln; + writeln('**************************************************************'); + writeln(' UltraStar Deluxe - Command line switches '); + writeln('**************************************************************'); + writeln; + writeln(' '+ Fmt('Switch') +' : Purpose'); + writeln(' ----------------------------------------------------------'); + writeln(' '+ Fmt(cMediaInterfaces) +' : Show in-use media interfaces'); + writeln(' '+ Fmt(cDebug) +' : Display Debugging info'); + writeln; platform.halt; end; -//------------- -// ResetVariables - Reset Class Variables -//------------- -Procedure TCMDParams.ResetVariables; +{** + * Reset Class Variables + *} +procedure TCMDParams.ResetVariables; begin Debug := False; Benchmark := False; NoLog := False; - FullScreen := False; + ScreenMode := scmDefault; Joypad := False; - //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value} - sResolution := ''; - sLanguage := ''; + // some value variables set when reading infos {-1: Not Set, others: Value} + fResolution := ''; + fLanguage := ''; Depth := -1; Screens := -1; - //Some Strings Set when Reading Infos {Length=0 Not Set} + // some strings set when reading infos {Length=0 Not Set} SongPath := ''; ConfigFile := ''; ScoreFile := ''; end; -//------------- -// ReadParamInfo - Read Infos from Parameters -//------------- -Procedure TCMDParams.ReadParamInfo; +{** + * Read command-line parameters + *} +procedure TCMDParams.ReadParamInfo; var - I: Integer; - PCount: Integer; - Command: String; + I: integer; + PCount: integer; + Command: string; begin PCount := ParamCount; //Log.LogError('ParamCount: ' + Inttostr(PCount)); - - //Check all Parameters - For I := 1 to PCount do + // check all parameters + for I := 1 to PCount do begin - Command := Paramstr(I); - //Log.LogError('Start parsing Command: ' + Command); - //Is String Parameter ? - if (Length(Command) > 1) AND (Command[1] = '-') then + Command := ParamStr(I); + // check if the string is a parameter + if (Length(Command) > 1) and (Command[1] = '-') then begin - //Remove - from Command - Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1))); + // remove '-' from command + Command := LowerCase(Trim(Copy(Command, 2, Length(Command) - 1))); //Log.LogError('Command prepared: ' + Command); - //Check Command + // check command - // Boolean Triggers: + // boolean triggers if (Command = 'debug') then Debug := True else if (Command = 'benchmark') then @@ -161,21 +158,22 @@ begin else if (Command = 'nolog') then NoLog := True else if (Command = 'fullscreen') then - Fullscreen := True + ScreenMode := scmFullscreen else if (Command = 'window') then - Fullscreen := False + ScreenMode := scmWindowed else if (Command = 'joypad') then Joypad := True - //Integer Variables + // integer variables else if (Command = 'depth') then begin - //Check if there is another Parameter to get the Value from + // check if there is another Parameter to get the Value from if (PCount > I) then begin Command := ParamStr(I + 1); - //Check for valid Value + // check for valid value + // FIXME: guessing an array-index of depth is very error prone. If (Command = '16') then Depth := 0 Else If (Command = '32') then @@ -185,12 +183,12 @@ begin else if (Command = 'screens') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin Command := ParamStr(I + 1); - //Check for valid Value + // check for valid value If (Command = '1') then Screens := 0 Else If (Command = '2') then @@ -198,47 +196,47 @@ begin end; end - //Pseudo Integer Values + // pseudo integer values else if (Command = 'language') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin - //Write Value to String - sLanguage := Lowercase(ParamStr(I + 1)); + // write value to string + fLanguage := Lowercase(ParamStr(I + 1)); end; end else if (Command = 'resolution') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin - //Write Value to String - sResolution := Lowercase(ParamStr(I + 1)); + // write value to string + fResolution := Lowercase(ParamStr(I + 1)); end; end - //String Values + // string values else if (Command = 'songpath') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin - //Write Value to String + // write value to string SongPath := ParamStr(I + 1); end; end else if (Command = 'configfile') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin - //Write Value to String + // write value to string ConfigFile := ParamStr(I + 1); - //is this a relative PAth -> then add Gamepath + // is this a relative path -> then add gamepath if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; end; @@ -246,10 +244,10 @@ begin else if (Command = 'scorefile') then begin - //Check if there is another Parameter to get the Value from + // check if there is another parameter to get the value from if (PCount > I) then begin - //Write Value to String + // write value to string ScoreFile := ParamStr(I + 1); end; end; @@ -258,43 +256,27 @@ begin end; -{ Log.LogError('Values: '); - - if Debug then - Log.LogError('Debug'); - - if Benchmark then - Log.LogError('Benchmark'); - - if NoLog then - Log.LogError('NoLog'); - - if Fullscreen then - Log.LogError('FullScreen'); - - if JoyStick then - Log.LogError('Joystick'); - - - Log.LogError('Screens: ' + Inttostr(Screens)); - Log.LogError('Depth: ' + Inttostr(Depth)); +{ + Log.LogInfo('Screens: ' + Inttostr(Screens)); + Log.LogInfo('Depth: ' + Inttostr(Depth)); - Log.LogError('Resolution: ' + Inttostr(Resolution)); - Log.LogError('Resolution: ' + Inttostr(Language)); + Log.LogInfo('Resolution: ' + Inttostr(Resolution)); + Log.LogInfo('Resolution: ' + Inttostr(Language)); - Log.LogError('sResolution: ' + sResolution); - Log.LogError('sLanguage: ' + sLanguage); + Log.LogInfo('sResolution: ' + sResolution); + Log.LogInfo('sLanguage: ' + sLanguage); - Log.LogError('ConfigFile: ' + ConfigFile); - Log.LogError('SongPath: ' + SongPath); - Log.LogError('ScoreFile: ' + ScoreFile); } + Log.LogInfo('ConfigFile: ' + ConfigFile); + Log.LogInfo('SongPath: ' + SongPath); + Log.LogInfo('ScoreFile: ' + ScoreFile); +} end; //------------- // GetLanguage - Get Language ID from saved String Information //------------- -Function TCMDParams.GetLanguage: Integer; +function TCMDParams.GetLanguage: integer; var I: integer; begin @@ -314,7 +296,7 @@ end; //------------- // GetResolution - Get Resolution ID from saved String Information //------------- -Function TCMDParams.GetResolution: Integer; +function TCMDParams.GetResolution: integer; var I: integer; begin diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 35d8fd3b..724e3bed 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -549,6 +549,7 @@ var I: integer; W, H: integer; Depth: Integer; + Fullscreen: boolean; begin if (Params.Screens <> -1) then Screens := Params.Screens + 1 @@ -592,16 +593,22 @@ begin Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); - 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 + // check whether to start in fullscreen or windowed mode. + // The command-line parameters take precedence over the ini settings. + Fullscreen := ((Ini.FullScreen = 1) or (Params.ScreenMode = scmFullscreen)) and + not (Params.ScreenMode = scmWindowed); + + if Fullscreen then 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 + else + begin + Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); + screen := SDL_SetVideoMode(W, H, 0, SDL_OPENGL or SDL_RESIZABLE); + SDL_ShowCursor(1); end; if (screen = nil) then @@ -631,7 +638,7 @@ begin Display.CurrentScreen := @ScreenLoading; - swapbuffers; + SwapBuffers; ScreenLoading.Draw; Display.Draw; -- cgit v1.2.3 From 20d12d5af15bd364cbec888100de6e18bb89561e Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 20 Sep 2008 18:19:37 +0000 Subject: Equalizer class written TRGB methods now in UThemes instead of ULyrics equalizer reflection now available Reading from Reflectionsettings from theme follows on sunday :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1387 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/ULyrics.pas | 23 ----------------------- src/base/UThemes.pas | 34 +++++++++++++++++++++++++++++++++- 2 files changed, 33 insertions(+), 24 deletions(-) (limited to 'src/base') diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index 305cb91f..ffc5d5af 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -136,29 +136,6 @@ uses SysUtils, math, UIni; -//----------- -//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else -//----------- -procedure glColorRGB(Color: TRGB); overload; -begin - glColor3f(Color.R, Color.G, Color.B); -end; - -procedure glColorRGB(Color: TRGB; Alpha: Real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Alpha); -end; - -procedure glColorRGB(Color: TRGBA); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Color.A); -end; - -procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); -end; - { TLyricLine } constructor TLyricLine.Create(); diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index fca75c24..2319107a 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -725,6 +725,11 @@ type RGB: TRGB; end; +procedure glColorRGB(Color: TRGB); overload; +procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +procedure glColorRGB(Color: TRGBA); overload; +procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; + function ColorExists(Name: string): integer; procedure LoadColor(var R, G, B: real; ColorName: string); function GetSystemColor(Color: integer): TRGB; @@ -741,7 +746,34 @@ uses UCommon, ULanguage, USkins, - UIni; + UIni, + gl, + glext, + math; + +//----------- +//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else +//----------- +procedure glColorRGB(Color: TRGB); overload; +begin + glColor3f(Color.R, Color.G, Color.B); +end; + +procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Alpha); +end; + +procedure glColorRGB(Color: TRGBA); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Color.A); +end; + +procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); +end; + constructor TTheme.Create(FileName: string); begin -- cgit v1.2.3 From 688182ae4f56aabaf12233f32763274286c5d634 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 21 Sep 2008 11:34:25 +0000 Subject: missing files commited Equalizer now loads reflection settings from theme old equalizer methods removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1388 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 91 +++++++++++++++++++++++++++++----------------------- 1 file changed, 51 insertions(+), 40 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 2319107a..6097e3ee 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -145,6 +145,23 @@ type SkipX: integer; end; + TThemeEqualizer = record + Visible: Boolean; + Direction: Boolean; + Alpha: real; + X: Integer; + Y: Integer; + Z: Real; + W: Integer; + H: Integer; + Space: Integer; + Bands: Integer; + Length: Integer; + ColR, ColG, ColB: Real; + Reflection: boolean; + Reflectionspacing: Real; + end; + PThemeBasic = ^TThemeBasic; TThemeBasic = class Background: TThemeBackground; @@ -208,20 +225,7 @@ type end; //Equalizer Mod - Equalizer: record - Visible: Boolean; - Direction: Boolean; - Alpha: real; - X: Integer; - Y: Integer; - Z: Real; - W: Integer; - H: Integer; - Space: Integer; - Bands: Integer; - Length: Integer; - ColR, ColG, ColB: Real; - end; + Equalizer: TThemeEqualizer; //Party and Non Party specific Statics and Texts @@ -708,6 +712,7 @@ type procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); + procedure ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; Name: string); procedure ThemeSave(FileName: string); procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string); @@ -939,32 +944,7 @@ begin Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1); //Load Cover Pos and Size from Theme Mod End - //Load Equalizer Pos and Size from Theme Mod - Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1); - Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1); - Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1); - Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1); - Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0); - Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0); - Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1); - Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8); - Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8); - Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5); - Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12); - - //Color - I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black')); - if I >= 0 then begin - Song.Equalizer.ColR := Color[I].RGB.R; - Song.Equalizer.ColG := Color[I].RGB.G; - Song.Equalizer.ColB := Color[I].RGB.B; - end - else begin - Song.Equalizer.ColR := 0; - Song.Equalizer.ColG := 0; - Song.Equalizer.ColB := 0; - end; - //Load Equalizer Pos and Size from Theme Mod End + ThemeLoadEqualizer(Song.Equalizer, 'SongEqualizer'); //Party and Non Party specific Statics and Texts ThemeLoadStatics (Song.StaticParty, 'SongStaticParty'); @@ -1717,6 +1697,37 @@ begin ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); end; +procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; Name: string); +var I: Integer; +begin + ThemeEqualizer.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 0) = 1); + ThemeEqualizer.Direction := (ThemeIni.ReadInteger(Name, 'Direction', 0) = 1); + ThemeEqualizer.Alpha := ThemeIni.ReadInteger(Name, 'Alpha', 1); + ThemeEqualizer.Space := ThemeIni.ReadInteger(Name, 'Space', 1); + ThemeEqualizer.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeEqualizer.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeEqualizer.Z := ThemeIni.ReadInteger(Name, 'Z', 1); + ThemeEqualizer.W := ThemeIni.ReadInteger(Name, 'PieceW', 8); + ThemeEqualizer.H := ThemeIni.ReadInteger(Name, 'PieceH', 8); + ThemeEqualizer.Bands := ThemeIni.ReadInteger(Name, 'Bands', 5); + ThemeEqualizer.Length := ThemeIni.ReadInteger(Name, 'Length', 12); + ThemeEqualizer.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); + ThemeEqualizer.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); + + //Color + I := ColorExists(ThemeIni.ReadString(Name, 'Color', 'Black')); + if I >= 0 then begin + ThemeEqualizer.ColR := Color[I].RGB.R; + ThemeEqualizer.ColG := Color[I].RGB.G; + ThemeEqualizer.ColB := Color[I].RGB.B; + end + else begin + ThemeEqualizer.ColR := 0; + ThemeEqualizer.ColG := 0; + ThemeEqualizer.ColB := 0; + end; +end; + procedure TTheme.LoadColors; var SL: TStringList; -- cgit v1.2.3 From 8d08a609e1a6ef840dbeacfaa44e0f30e143c4c0 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 21 Sep 2008 12:02:58 +0000 Subject: fixed a typo in USingScores that causes that the singbar settings are not loaded correct from theme git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1390 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 77d40b84..1fb85ca9 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -369,7 +369,7 @@ begin AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); // Player3: - AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore); + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RSingBar, Theme.Sing.TextP3RScore); end; //----------- -- cgit v1.2.3 From 7209a59d1667d529fe42c592287ebe93935ad3f0 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 21 Sep 2008 14:17:02 +0000 Subject: fixed another typo from last commit git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1391 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 1fb85ca9..e4c28701 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -369,7 +369,7 @@ begin AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); // Player3: - AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RSingBar, Theme.Sing.TextP3RScore); + AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore); end; //----------- -- cgit v1.2.3 From 8c649b5959469659555b162d55a736d69ec7725d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 21 Sep 2008 17:41:16 +0000 Subject: Repaired ratingbar algo, it was broken after some changes to avoid division by zero errors. Still needs some finetuning according sensibility. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1392 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index e4c28701..59cdaf67 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -425,13 +425,13 @@ begin aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; //Change Bars Position - lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); - lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + lTempA := ( (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff ); if ( lTempA > 0 ) AND ( lTempB > 0 ) THEN begin - aPlayers[Cur.Player].RBTarget := lTempA / lTempB; + aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + lTempA / lTempB * (Cur.Rating / 20 - 0.26); end; If (aPlayers[Cur.Player].RBTarget > 1) then -- cgit v1.2.3 From 0214da20cb257aba5a8a9bca35c22efddf3004f3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 21 Sep 2008 18:35:29 +0000 Subject: fixed popups w/ rating = 0 doesn't change the rating bar value git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1393 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 29 ++++++++++++++++++----------- 1 file changed, 18 insertions(+), 11 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 59cdaf67..02b0b9e2 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -385,7 +385,14 @@ begin Cur.Player := PlayerIndex; Cur.TimeStamp := SDL_GetTicks; - Cur.Rating := Rating; + + //limit rating value to 8 + //a higher value would cause a crash when selecting the bg textur + if (Rating > 8) then + Cur.Rating := 8 + else + Cur.Rating := Rating; + Cur.ScoreGiven:= 0; If (Players[PlayerIndex].Score < Score) then begin @@ -417,21 +424,21 @@ end; // Removes a PopUp w/o destroying the List //----------- Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); -var - lTempA , - lTempB : real; begin //Give Player the Last Points that missing till now aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; //Change Bars Position - lTempA := ( (Cur.ScoreDiff - Cur.ScoreGiven) ); - lTempB := ( Cur.ScoreDiff ); - - if ( lTempA > 0 ) AND - ( lTempB > 0 ) THEN - begin - aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + lTempA / lTempB * (Cur.Rating / 20 - 0.26); + if (Cur.ScoreDiff > 0) THEN + begin //Popup w/ scorechange -> give missing percents + aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + + (Cur.ScoreDiff - Cur.ScoreGiven) / Cur.ScoreDiff + * (Cur.Rating / 20 - 0.26); + end + else + begin //Popup w/o scorechange -> give complete percentage + aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + + (Cur.Rating / 20 - 0.26); end; If (aPlayers[Cur.Player].RBTarget > 1) then -- cgit v1.2.3 From 15dd96cc03fe7780608cf42a2e66fb1fa3742e59 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 22 Sep 2008 14:58:20 +0000 Subject: Without SDL_GL_ALPHA_SIZE the lyrics won't work anymore on some systems as the offscreen lyrics rendering needs an alpha component in the back-buffer. -> Leave SDL_GL_ALPHA_SIZE until the lyrics-engine is changed. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1394 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 724e3bed..93fac85c 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -557,15 +557,21 @@ begin Screens := Ini.Screens + 1; // Set minimum color component sizes - // Note: Do NOT use SDL_GL_ALPHA_SIZE here, otherwise on a few systems with - // some versions of SDL (at least 1.2.11) SDL_SetVideoMode will fail. - // The problem occured if the adjusted color component sizes did not leave - // any space for alpha, e.g. red/green/blue ajusted from 5 to 8: - // r_size+g_size+b_size = 24, so an alpha of at least 5 is just available if - // the depth is 32bit. + // Note: + // - SDL_GL_ALPHA_SIZE should not be set here, otherwise on a few systems with + // some versions of SDL (at least 1.2.11) SDL_SetVideoMode will fail. + // The problem occured if the adjusted color component sizes did not leave + // any space for alpha, e.g. red/green/blue ajusted from 5 to 8: + // r_size+g_size+b_size = 24, so an alpha of at least 5 is just available if + // the depth is 32bit. + // - Without SDL_GL_ALPHA_SIZE the lyrics won't work anymore on some systems + // as the offscreen lyrics rendering needs an alpha component in the + // back-buffer. + // -> Leave SDL_GL_ALPHA_SIZE until the lyrics-engine is changed. 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); // Z-Buffer depth SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); -- cgit v1.2.3 From a359afffdfc982e990633f5c0e27304d45750a54 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 20:21:30 +0000 Subject: Uppercase/Lowercase corrections andother typos in comments, no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1401 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/uPluginLoader.pas | 264 ++++++++++++++++++++++----------------------- 1 file changed, 132 insertions(+), 132 deletions(-) (limited to 'src/base') diff --git a/src/base/uPluginLoader.pas b/src/base/uPluginLoader.pas index d0e878c4..e0e894b1 100644 --- a/src/base/uPluginLoader.pas +++ b/src/base/uPluginLoader.pas @@ -1,9 +1,9 @@ unit UPluginLoader; {********************* UPluginLoader - Unit contains to Classes - TPluginLoader: Class Searching for and Loading the Plugins - TtehPlugins: Class that represents the Plugins in Modules chain + Unit contains two classes + TPluginLoader: Class searching for and loading the plugins + TtehPlugins: Class representing the plugins in modules chain *********************} interface @@ -21,11 +21,11 @@ uses type TPluginListItem = record Info: TUS_PluginInfo; - State: Byte; //State of this Plugin: 0 - undefined; 1 - Loaded; 2 - Inited / Running; 4 - Unloaded; 254 - Loading aborted by Plugin; 255 - Unloaded because of Error - Path: String; //Path to this Plugin - NeedsDeInit: Boolean; //If this is Inited correctly this should be true - hLib: THandle; //Handle of Loaded Libary - Procs: record //Procs offered by Plugin. Don't call this directly use wrappers of TPluginLoader + State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error + Path: String; // path to this plugin + NeedsDeInit: Boolean; // if this is inited correctly this should be true + hLib: THandle; // handle of loaded libary + Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader Load: Func_Load; Init: Func_Init; DeInit: Proc_DeInit; @@ -33,7 +33,7 @@ type end; {********************* TPluginLoader - Class Searches for Plugins and Manages loading and unloading + Class searches for plugins and manages loading and unloading *********************} PPluginLoader = ^TPluginLoader; TPluginLoader = class (TCoreModule) @@ -49,7 +49,7 @@ type PluginInterface: TUS_PluginInterface; Plugins: array of TPluginListItem; - //TCoreModule methods to inherit + // TCoreModule methods to inherit constructor Create; override; procedure Info(const pInfo: PModuleInfo); override; function Load: Boolean; override; @@ -57,10 +57,10 @@ type procedure DeInit; override; Destructor Destroy; override; - //New Methods - procedure BrowseDir(Path: String); //Browses the Path at _Path_ for Plugins - function PluginExists(Name: String): integer; //If Plugin Exists: Index of Plugin, else -1 - procedure AddPlugin(Filename: String);//Adds Plugin to the Array + // New methods + procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins + function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1 + procedure AddPlugin(Filename: String); // adds plugin to the array function CallLoad(Index: Cardinal): integer; function CallInit(Index: Cardinal): integer; @@ -76,14 +76,14 @@ type {********************* TtehPlugins - Class Represents the Plugins in Module Chain. - It Calls the Plugins Procs and Funcs + Class represents the plugins in module chain. + It calls the plugins procs and funcs *********************} TtehPlugins = class (TCoreModule) private PluginLoader: PPluginLoader; public - //TCoreModule methods to inherit + // TCoreModule methods to inherit constructor Create; override; procedure Info(const pInfo: PModuleInfo); override; @@ -116,28 +116,28 @@ uses {********************* TPluginLoader - Implentation + Implementation *********************} //------------- -// function that gives some Infos about the Module to the Core +// function that gives some infos about the module to the core //------------- procedure TPluginLoader.Info(const pInfo: PModuleInfo); begin pInfo^.Name := 'TPluginLoader'; pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Searches for Plugins, loads and unloads them'; + pInfo^.Description := 'Searches for plugins, loads and unloads them'; end; //------------- -// Just the Constructor +// Just the constructor //------------- constructor TPluginLoader.Create; begin inherited; - //Init PluginInterface - //Using Methods from UPluginInterface + // Init PluginInterface + // Using methods from UPluginInterface PluginInterface.CreateHookableEvent := CreateHookableEvent; PluginInterface.DestroyHookableEvent := DestroyHookableEvent; PluginInterface.NotivyEventHooks := NotivyEventHooks; @@ -150,80 +150,80 @@ begin PluginInterface.CallService := CallService; PluginInterface.ServiceExists := ServiceExists; - //UnSet Private Var + // UnSet private var LoadingProcessFinished := False; end; //------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit +// Is called on loading. +// In this method only events and services should be created +// to offer them to other modules or plugins during the init process +// if false is returned this will cause a forced exit //------------- function TPluginLoader.Load: Boolean; begin Result := True; try - //Start Searching for Plugins + // Start searching for plugins BrowseDir(PluginPath); except Result := False; - Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); end; end; //------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit +// Is called on init process +// In this method you can hook some events and create + init +// your classes, variables etc. +// If false is returned this will cause a forced exit //------------- function TPluginLoader.Init: Boolean; begin - //Just set Prvate Var to true. + // Just set private var to true. LoadingProcessFinished := True; Result := True; end; //------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order //------------- procedure TPluginLoader.DeInit; var I: integer; begin - //Force DeInit - //If some Plugins aren't DeInited for some Reason o0 + // Force deinit + // if some plugins aren't deinited for some reason o0 for I := 0 to High(Plugins) do begin if (Plugins[I].State < 4) then FreePlugin(I); end; - //Nothing to do here. Core will remove the Hooks + // Nothing to do here. Core will remove the hooks end; //------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory +// Is called if this module will be unloaded and has been created +// Should be used to free memory //------------- Destructor TPluginLoader.Destroy; begin - //Just save some Memory if it wasn't done now.. + // Just save some memory if it wasn't done now.. SetLength(Plugins, 0); inherited; end; //-------------- -// Browses the Path at _Path_ for Plugins +// Browses the path at _Path_ for plugins //-------------- procedure TPluginLoader.BrowseDir(Path: String); var SR: TSearchRec; begin - //Search for other Dirs to Browse + // Search for other dirs to browse if FindFirst(Path + '*', faDirectory, SR) = 0 then begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -232,7 +232,7 @@ begin end; FindClose(SR); - //Search for Plugins at Path + // Search for plugins at path if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then begin repeat @@ -243,7 +243,7 @@ begin end; //-------------- -// If Plugin Exists: Index of Plugin, else -1 +// If plugin exists: Index of plugin, else -1 //-------------- function TPluginLoader.PluginExists(Name: String): integer; var @@ -263,7 +263,7 @@ begin end; //-------------- -// Adds Plugin to the Array +// Adds plugin to the array //-------------- procedure TPluginLoader.AddPlugin(Filename: String); var @@ -276,20 +276,20 @@ begin begin //Load Libary hLib := LoadLibrary(PChar(Filename)); if (hLib <> 0) then - begin //Try to get Address of the Info Proc + begin // Try to get address of the info proc PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); if (@PInfo <> nil) then begin Info.cbSize := SizeOf(TUS_PluginInfo); - try //Call Info Proc + try // Call info proc PInfo(@Info); except Info.Name := ''; - Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error getting plugin info: ' + Filename)), PChar('TPluginLoader')); end; - //Is Name set ? + // Is name set ? if (Trim(Info.Name) <> '') then begin PluginID := PluginExists(Info.Name); @@ -299,18 +299,18 @@ begin if (PluginID = -1) then begin - //Add new item to array + // Add new item to array PluginID := Length(Plugins); SetLength(Plugins, PluginID + 1); - //Fill with Info: + // Fill with info: Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; Plugins[PluginID].NeedsDeInit := False; Plugins[PluginID].hLib := hLib; - //Try to get Procs + // Try to get procs Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); @@ -319,10 +319,10 @@ begin begin Plugins[PluginID].State := 255; FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); end; - //Emulate loading process if this Plugin is loaded to late + // Emulate loading process if this plugin is loaded too late if (LoadingProcessFinished) then begin CallLoad(PluginID); @@ -332,20 +332,20 @@ begin else if (LoadingProcessFinished = False) then begin if (Plugins[PluginID].Info.Version < Info.Version) then - begin //Found newer Version of this Plugin - Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + begin // Found newer version of this plugin + Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader')); - //Unload Old Plugin + // Unload old plugin UnloadPlugin(PluginID, nil); - //Fill with new Info + // Fill with new info Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; Plugins[PluginID].NeedsDeInit := False; Plugins[PluginID].hLib := hLib; - //Try to get Procs + // Try to get procs Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); @@ -354,18 +354,18 @@ begin begin FreeLibrary(hLib); Plugins[PluginID].State := 255; - Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); end; end else - begin //Newer Version already loaded + begin // Newer Version already loaded FreeLibrary(hLib); end; end else begin FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); end; end else @@ -377,16 +377,16 @@ begin else begin FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Can''t find info procedure: ' + Filename)), PChar('TPluginLoader')); end; end else - Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Can''t load plugin libary: ' + Filename)), PChar('TPluginLoader')); end; end; //-------------- -// Calls Load Func of Plugin with the given Index +// Calls load func of plugin with the given index //-------------- function TPluginLoader.CallLoad(Index: Cardinal): integer; begin @@ -407,14 +407,14 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; end; //-------------- -// Calls Init Func of Plugin with the given Index +// Calls init func of plugin with the given index //-------------- function TPluginLoader.CallInit(Index: Cardinal): integer; begin @@ -438,14 +438,14 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; end; //-------------- -// Calls DeInit Proc of Plugin with the given Index +// Calls deinit proc of plugin with the given index //-------------- procedure TPluginLoader.CallDeInit(Index: Cardinal); begin @@ -460,7 +460,7 @@ begin End; - //Don't forget to remove Services and Subscriptions by this Plugin + // Don't forget to remove services and subscriptions by this plugin Core.Hooks.DelbyOwner(-1 - Index); FreePlugin(Index); @@ -469,7 +469,7 @@ begin end; //-------------- -// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions +// Frees all plugin sources (procs and handles) - helper for deiniting functions //-------------- procedure TPluginLoader.FreePlugin(Index: Cardinal); begin @@ -485,7 +485,7 @@ end; //-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin //-------------- function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; var @@ -494,7 +494,7 @@ var begin Result := -1; sFile := ''; - //lParam is ID + // lParam is ID if (lParam = nil) then begin Index := wParam; @@ -505,7 +505,7 @@ begin sFile := String(PChar(lParam)); Index := PluginExists(sFile); if (Index < 0) And FileExists(sFile) then - begin //Is Filename + begin // Is filename AddPlugin(sFile); Result := Plugins[High(Plugins)].State; end; @@ -523,7 +523,7 @@ begin end; //-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin //-------------- function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; var @@ -531,13 +531,13 @@ var sName: String; begin Result := -1; - //lParam is ID + // lParam is ID if (lParam = nil) then begin Index := wParam; end else - begin //wParam is PChar + begin // wParam is PChar try sName := String(PChar(lParam)); Index := PluginExists(sName); @@ -552,14 +552,14 @@ begin end; //-------------- -// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) +// if wParam = -1 then (if lParam = nil then get length of moduleinfo array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of plugin with Index(wParam) to address at lParam) //-------------- function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; var I: integer; begin Result := 0; if (wParam > 0) then - begin //Get Info of 1 Plugin + begin // Get info of 1 plugin if (lParam <> nil) and (wParam < Length(Plugins)) then begin try @@ -571,7 +571,7 @@ begin end; end else if (lParam = nil) then - begin //Get Length of Plugin (Info) Array + begin // Get length of plugin (info) array Result := Length(Plugins); end else //Write PluginInfo Array to Address in lParam @@ -588,31 +588,31 @@ begin end; //-------------- -// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam)) +// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam)) //-------------- function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; var I: integer; begin Result := -1; if (wParam > 0) then - begin //Get State of 1 Plugin + begin // Get state of 1 plugin if (wParam < Length(Plugins)) then begin Result := Plugins[wParam].State; end; end else if (lParam = nil) then - begin //Get Length of Plugin (Info) Array + begin // Get length of plugin (info) array Result := Length(Plugins); end - else //Write PluginInfo Array to Address in lParam + else // Write plugininfo array to address in lParam begin try for I := 0 to high(Plugins) do Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; Result := Length(Plugins); except - Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); End; end; end; @@ -620,11 +620,11 @@ end; {********************* TtehPlugins - Implentation + Implementation *********************} //------------- -// function that gives some Infos about the Module to the Core +// function that gives some infos about the module to the core //------------- procedure TtehPlugins.Info(const pInfo: PModuleInfo); begin @@ -634,7 +634,7 @@ begin end; //------------- -// Just the Constructor +// Just the constructor //------------- constructor TtehPlugins.Create; begin @@ -643,130 +643,130 @@ begin end; //------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit +// Is called on loading. +// In this method only events and services should be created +// to offer them to other modules or plugins during the init process +// if false is returned this will cause a forced exit //------------- function TtehPlugins.Load: Boolean; var - i: integer; //Counter + i: integer; // Counter CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute begin - //Get Pointer to PluginLoader + // Get pointer to pluginloader PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); if (PluginLoader = nil) then begin Result := false; - Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins')); + Core.ReportError(integer(PChar('Could not get pointer to pluginLoader')), PChar('TtehPlugins')); end else begin Result := true; - //Backup CurExecuted + // Backup curexecuted CurExecutedBackup := Core.CurExecuted; - //Start Loading the Plugins + // Start loading the plugins for i := 0 to High(PluginLoader.Plugins) do begin Core.CurExecuted := -1 - i; try - //Unload Plugin if not correctly Executed + // Unload plugin if not correctly executed if (PluginLoader.CallLoad(i) <> 0) then begin PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + PluginLoader.Plugins[i].State := 254; // Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else begin - Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; except - //Plugin could not be loaded. - // => Show Error Message, then ShutDown Plugin + // Plugin could not be loaded. + // => Show error message, then shutdown plugin on E: Exception do begin PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); + PluginLoader.Plugins[i].State := 255; // Plugin causes error + Core.ReportError(integer(PChar('Plugin causes error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); end; end; end; - //Reset CurExecuted + // Reset CurExecuted Core.CurExecuted := CurExecutedBackup; end; end; //------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit +// Is called on init process +// in this method you can hook some events and create + init +// your classes, variables etc. +// if false is returned this will cause a forced exit //------------- function TtehPlugins.Init: Boolean; var - i: integer; //Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute begin Result := true; - //Backup CurExecuted + // Backup CurExecuted CurExecutedBackup := Core.CurExecuted; - //Start Loading the Plugins + // Start loading the plugins for i := 0 to High(PluginLoader.Plugins) do try Core.CurExecuted := -1 - i; - //Unload Plugin if not correctly Executed + // Unload plugin if not correctly executed if (PluginLoader.CallInit(i) <> 0) then begin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else - Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); except - //Plugin could not be loaded. - // => Show Error Message, then ShutDown Plugin + // Plugin could not be loaded. + // => Show error message, then shut down plugin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; - //Reset CurExecuted + // Reset CurExecuted Core.CurExecuted := CurExecutedBackup; end; //------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order //------------- procedure TtehPlugins.DeInit; var - i: integer; //Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute begin - //Backup CurExecuted + // Backup CurExecuted CurExecutedBackup := Core.CurExecuted; - //Start Loop + // Start loop for i := 0 to High(PluginLoader.Plugins) do begin try - //DeInit Plugin + // DeInit plugin PluginLoader.CallDeInit(i); except end; end; - //Reset CurExecuted + // Reset CurExecuted Core.CurExecuted := CurExecutedBackup; end; -- cgit v1.2.3 From 2e3e8c1d6ac056b309d7ad335c0dd9f8011bdac9 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 20:55:37 +0000 Subject: pure editing and typos, no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1402 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphicClasses.pas | 392 +++++++++++++++++++++++-------------------- 1 file changed, 207 insertions(+), 185 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas index b7174991..0e620cac 100644 --- a/src/base/UGraphicClasses.pas +++ b/src/base/UGraphicClasses.pas @@ -1,4 +1,3 @@ -// notes: unit UGraphicClasses; interface @@ -9,106 +8,124 @@ interface {$I switches.inc} -uses UTexture,SDL; +uses + UTexture, + SDL; + +const + DelayBetweenFrames : cardinal = 60; -const DelayBetweenFrames : Cardinal = 60; type - TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); + TParticleType = (GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); - TColour3f = Record - r, g, b: Real; - end; + TColour3f = record + r, g, b: real; + end; - TParticle = Class - X, Y : Real; //Position - Screen : Integer; - W, H : Cardinal; //dimensions of particle + TParticle = class + X, Y : real; //Position + Screen : integer; + W, H : cardinal; //dimensions of particle Col : array of TColour3f; // Colour(s) of particle - Scale : array of Real; // Scaling factors of particle layers - Frame : Byte; //act. Frame - Tex : Cardinal; //Tex num from Textur Manager - Live : Byte; //How many Cycles before Kill - RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote) + Scale : array of real; // Scaling factors of particle layers + Frame : byte; //act. Frame + Tex : cardinal; //Tex num from Textur Manager + Live : byte; //How many Cycles before Kill + RecIndex : integer; //To which rectangle this particle belongs (only GoldenNote) StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle - Alpha : Real; // used for fading... - mX, mY : Real; // movement-vector for PerfectLineTwinkle - SizeMod : Real; // experimental size modifier + Alpha : real; // used for fading... + mX, mY : real; // movement-vector for PerfectLineTwinkle + SizeMod : real; // experimental size modifier SurviveSentenceChange : Boolean; - Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); - Destructor Destroy(); override; + constructor Create(cX, cY : real; + cScreen : integer; + cLive : byte; + cFrame : integer; + cRecArrayIndex : integer; + cStarType : TParticleType; + Player : cardinal); + destructor Destroy(); override; procedure Draw; procedure LiveOn; end; - RectanglePositions = Record - xTop, yTop, xBottom, yBottom : Real; - TotalStarCount : Integer; - CurrentStarCount : Integer; - Screen : Integer; + RectanglePositions = record + xTop, yTop, xBottom, yBottom : real; + TotalStarCount : integer; + CurrentStarCount : integer; + Screen : integer; end; - PerfectNotePositions = Record - xPos, yPos : Real; - Screen : Integer; + PerfectNotePositions = record + xPos, yPos : real; + Screen : integer; end; - TEffectManager = Class + TEffectManager = class Particle : array of TParticle; - LastTime : Cardinal; - RecArray : Array of RectanglePositions; - TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player - PerfNoteArray : Array of PerfectNotePositions; + LastTime : cardinal; + RecArray : array of RectanglePositions; + TwinkleArray : array[0..5] of real; // store x-position of last twinkle for every player + PerfNoteArray : array of PerfectNotePositions; FlareTex: TTexture; constructor Create; destructor Destroy; override; procedure Draw; - function Spawn(X, Y: Real; - Screen: Integer; - Live: Byte; - StartFrame: Integer; - RecArrayIndex: Integer; // this is only used with GoldenNotes + function Spawn(X, Y: real; + Screen: integer; + Live: byte; + StartFrame: integer; + RecArrayIndex: integer; // this is only used with GoldenNotes StarType: TParticleType; - Player: Cardinal // for PerfectLineTwinkle - ): Cardinal; + Player: cardinal // for PerfectLineTwinkle + ): cardinal; procedure SpawnRec(); - procedure Kill(index: Cardinal); + procedure Kill(index: cardinal); procedure KillAll(); procedure SentenceChange(); - procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); - procedure SavePerfectNotePos(Xtop, Ytop: Real); - procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); + procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real); + procedure SavePerfectNotePos(Xtop, Ytop: real); + procedure GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer); procedure SpawnPerfectLineTwinkle(); end; -var GoldenRec : TEffectManager; +var + GoldenRec : TEffectManager; implementation -uses sysutils, - gl, - UIni, - UMain, - UThemes, - USkins, - UGraphic, - UDrawTexture, - UCommon, - math; +uses + sysutils, + gl, + UIni, + UMain, + UThemes, + USkins, + UGraphic, + UDrawTexture, + UCommon, + math; //TParticle -Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal); +constructor TParticle.Create(cX, cY : real; + cScreen : integer; + cLive : byte; + cFrame : integer; + cRecArrayIndex : integer; + cStarType : TParticleType; + Player : cardinal); begin inherited Create; // in this constructor we set all initial values for our particle X := cX; Y := cY; Screen := cScreen; - Live := cLive; - Frame:= cFrame; + Live := cLive; + Frame := cFrame; RecIndex := cRecArrayIndex; StarType := cStarType; Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out @@ -123,9 +140,9 @@ begin W := 20; H := 20; SetLength(Scale,4); - Scale[1]:=0.8; - Scale[2]:=0.4; - Scale[3]:=0.3; + Scale[1] := 0.8; + Scale[2] := 0.4; + Scale[3] := 0.3; SetLength(Col,4); Col[0].r := 1; Col[0].g := 0.7; @@ -170,11 +187,11 @@ begin W := RandomRange(10,20); H := W; SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange:=True; + SurviveSentenceChange := True; // assign colours according to player given SetLength(Scale,3); - Scale[1]:=0.3; - Scale[2]:=0.2; + Scale[1] := 0.3; + Scale[2] := 0.2; SetLength(Col,3); case Player of 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); @@ -188,9 +205,9 @@ begin Col[1].r := 1; Col[1].g := 1; Col[1].b := 0.4; - Col[2].r:=Col[0].r+0.5; - Col[2].g:=Col[0].g+0.5; - Col[2].b:=Col[0].b+0.5; + Col[2].r := Col[0].r+0.5; + Col[2].g := Col[0].g+0.5; + Col[2].b := Col[0].b+0.5; mX := RandomRange(-5,5); mY := RandomRange(-5,5); end; @@ -200,7 +217,7 @@ begin W := RandomRange(10,20); H := W; SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange:=True; + SurviveSentenceChange := True; // assign colours according to player given SetLength(Scale,1); SetLength(Col,1); @@ -219,9 +236,9 @@ begin mX := RandomRange(-5,5); mY := RandomRange(-5,5); SetLength(Scale,4); - Scale[1]:=0.8; - Scale[2]:=0.4; - Scale[3]:=0.3; + Scale[1] := 0.8; + Scale[2] := 0.4; + Scale[3] := 0.3; SetLength(Col,4); Col[0].r := 1; Col[0].g := 0.7; @@ -254,7 +271,7 @@ begin end; end; -Destructor TParticle.Destroy(); +destructor TParticle.Destroy(); begin SetLength(Scale,0); SetLength(Col,0); @@ -304,18 +321,19 @@ begin // move around X := X + mX; Y := Y + mY; - mY:=mY+1.8; -// mX:=mX/2; + mY := mY+1.8; +// mX := mX/2; end; end; end; procedure TParticle.Draw; -var L: Cardinal; +var + L: cardinal; begin if ScreenAct = Screen then // this draws (multiple) texture(s) of our particle - for L:=0 to High(Col) do + for L := 0 to High(Col) do begin glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha); @@ -324,14 +342,12 @@ begin glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable(GL_BLEND); - begin - glBegin(GL_QUADS); - glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glEnd; - end; + glBegin(GL_QUADS); + glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); + glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); + glEnd; end; glcolor4f(1,1,1,1); end; @@ -340,11 +356,12 @@ end; // TEffectManager constructor TEffectManager.Create; -var c: Cardinal; +var + c: cardinal; begin inherited; LastTime := SDL_GetTicks(); - for c:=0 to 5 do + for c := 0 to 5 do begin TwinkleArray[c] := 0; end; @@ -359,44 +376,44 @@ end; procedure TEffectManager.Draw; var - I: Integer; - CurrentTime: Cardinal; + I: integer; + CurrentTime: cardinal; //const -// DelayBetweenFrames : Cardinal = 100; +// DelayBetweenFrames : cardinal = 100; begin CurrentTime := SDL_GetTicks(); //Manage particle life if (CurrentTime - LastTime) > DelayBetweenFrames then - begin - LastTime := CurrentTime; - for I := 0 to high(Particle) do - Particle[I].LiveOn; - end; + begin + LastTime := CurrentTime; + for I := 0 to high(Particle) do + Particle[I].LiveOn; + end; I := 0; //Kill dead particles while (I <= High(Particle)) do + begin + if (Particle[I].Live <= 0) then begin - if (Particle[I].Live <= 0) then - begin - kill(I); - end - else - begin - inc(I); - end; + kill(I); + end + else + begin + inc(I); end; + end; //Draw - for I := 0 to high(Particle) do - begin - Particle[I].Draw; - end; + for I := 0 to high(Particle) do + begin + Particle[I].Draw; + end; end; // this method creates just one particle -function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal; +function TEffectManager.Spawn(X, Y: real; Screen: integer; Live: byte; StartFrame : integer; RecArrayIndex : integer; StarType : TParticleType; Player: cardinal): cardinal; begin Result := Length(Particle); SetLength(Particle, (Result + 1)); @@ -405,32 +422,32 @@ end; // manage Sparkling of GoldenNote Bars procedure TEffectManager.SpawnRec(); -Var - Xkatze, Ykatze : Real; - RandomFrame : Integer; - P : Integer; // P as seen on TV as Positionman +var + Xkatze, Ykatze : real; + RandomFrame : integer; + P : integer; // P as seen on TV as Positionman begin //Spawn a random amount of stars within the given coordinates //RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame -for P:= 0 to high(RecArray) do + for P := 0 to high(RecArray) do begin while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do - begin - Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); - Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); - RandomFrame := RandomRange(0,14); - // Spawn a GoldenNote Particle - Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); - inc(RecArray[P].CurrentStarCount); - end; + begin + Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); + Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); + RandomFrame := RandomRange(0,14); + // Spawn a GoldenNote Particle + Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); + inc(RecArray[P].CurrentStarCount); end; + end; draw; end; // kill one particle (with given index in our particle array) -procedure TEffectManager.Kill(Index: Cardinal); +procedure TEffectManager.Kill(Index: cardinal); var - LastParticleIndex : Integer; + LastParticleIndex : integer; begin // delete particle indexed by Index, // overwrite it's place in our particle-array with the particle stored at the last array index, @@ -449,23 +466,25 @@ end; // clean up all particles and management structures procedure TEffectManager.KillAll(); -var c: Cardinal; +var + c: cardinal; begin //It's the kill all kennies rotuine while Length(Particle) > 0 do // kill all existing particles Kill(0); SetLength(RecArray,0); // remove GoldenRec positions SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c:=0 to 5 do + for c := 0 to 5 do begin TwinkleArray[c] := 0; // reset GoldenNoteHit memory end; end; procedure TEffectManager.SentenceChange(); -var c: Cardinal; +var + c: cardinal; begin - c:=0; + c := 0; while c <= High(Particle) do begin if Particle[c].SurviveSentenceChange then @@ -475,22 +494,22 @@ begin end; SetLength(RecArray,0); // remove GoldenRec positions SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c:=0 to 5 do + for c := 0 to 5 do begin TwinkleArray[c] := 0; // reset GoldenNoteHit memory end; end; -procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer); +procedure TeffectManager.GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer); //Twinkle stars while golden note hit // this is called from UDraw.pas, SingDrawPlayerCzesc var - C, P, XKatze, YKatze, LKatze: Integer; - H: Real; + C, P, XKatze, YKatze, LKatze: integer; + H: real; begin // make sure we spawn only one time at one position if (TwinkleArray[Player] < Right) then - For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? + for P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? begin H := (Top+Bottom)/2; // helper... with RecArray[P] do @@ -540,12 +559,12 @@ begin end; end; -procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real); +procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real); var - P : Integer; // P like used in Positions - NewIndex : Integer; + P : integer; // P like used in Positions + NewIndex : integer; begin - For P := 0 to high(RecArray) do // Do we already have that "new" position? + for P := 0 to high(RecArray) do // Do we already have that "new" position? begin if (ceil(RecArray[P].xTop) = ceil(Xtop)) and (ceil(RecArray[P].yTop) = ceil(Ytop)) and @@ -565,105 +584,108 @@ begin RecArray[NewIndex].Screen := ScreenAct; end; -procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real); +procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: real); var - P : Integer; // P like used in Positions - NewIndex : Integer; - RandomFrame : Integer; - Xkatze, Ykatze : Integer; + P : integer; // P like used in Positions + NewIndex : integer; + RandomFrame : integer; + Xkatze, Ykatze : integer; begin - For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? - begin - with PerfNoteArray[P] do - if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and - (Screen = ScreenAct) then - exit; // it's already in the array, so we don't have to create a new one - end; //for + for P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? + begin + with PerfNoteArray[P] do + if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and + (Screen = ScreenAct) then + exit; // it's already in the array, so we don't have to create a new one + end; //for // we got a new position, add the new positions to our array - NewIndex := Length(PerfNoteArray); - SetLength(PerfNoteArray, NewIndex + 1); - PerfNoteArray[NewIndex].xPos := Xtop; - PerfNoteArray[NewIndex].yPos := Ytop; - PerfNoteArray[NewIndex].Screen := ScreenAct; + NewIndex := Length(PerfNoteArray); + SetLength(PerfNoteArray, NewIndex + 1); + PerfNoteArray[NewIndex].xPos := Xtop; + PerfNoteArray[NewIndex].yPos := Ytop; + PerfNoteArray[NewIndex].Screen := ScreenAct; - for P:= 0 to 2 do - begin - Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); - Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); - RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); - end; //for + for P := 0 to 2 do + begin + Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); + Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); + RandomFrame := RandomRange(0,14); + Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); + end; //for end; procedure TEffectManager.SpawnPerfectLineTwinkle(); var - P,I,Life: Cardinal; - Left, Right, Top, Bottom: Cardinal; - cScreen: Integer; + P, I, Life: cardinal; + Left, Right, Top, Bottom: cardinal; + cScreen: integer; begin // calculation of coordinates done with hardcoded values like in UDraw.pas // might need to be adjusted if drawing of SingScreen is modified // coordinates may still be a bit weird and need adjustment - if Ini.SingWindow = 0 then begin + if Ini.SingWindow = 0 then + begin Left := 130; - end else begin + end + else + begin Left := 30; end; Right := 770; // spawn effect for every player with a perfect line - for P:=0 to PlayersPlay-1 do + for P := 0 to PlayersPlay-1 do if Player[P].LastSentencePerfect then begin // calculate area where notes of this player are drawn case PlayersPlay of 1: begin - Bottom:=Skin_P2_NotesB+10; - Top:=Bottom-105; - cScreen:=1; + Bottom := Skin_P2_NotesB+10; + Top := Bottom-105; + cScreen := 1; end; 2,4: begin case P of 0,2: begin - Bottom:=Skin_P1_NotesB+10; - Top:=Bottom-105; + Bottom := Skin_P1_NotesB+10; + Top := Bottom-105; end; else begin - Bottom:=Skin_P2_NotesB+10; - Top:=Bottom-105; + Bottom := Skin_P2_NotesB+10; + Top := Bottom-105; end; end; case P of - 0,1: cScreen:=1; - else cScreen:=2; + 0,1: cScreen := 1; + else cScreen := 2; end; end; 3,6: begin case P of 0,3: begin - Top:=130; - Bottom:=Top+85; + Top := 130; + Bottom := Top+85; end; 1,4: begin - Top:=255; - Bottom:=Top+85; + Top := 255; + Bottom := Top+85; end; 2,5: begin - Top:=380; - Bottom:=Top+85; + Top := 380; + Bottom := Top+85; end; end; case P of - 0,1,2: cScreen:=1; - else cScreen:=2; + 0,1,2: cScreen := 1; + else cScreen := 2; end; end; end; // spawn Sparkling Stars inside calculated coordinates - for I:= 0 to 80 do + for I := 0 to 80 do begin - Life:=RandomRange(8,16); + Life := RandomRange(8,16); Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); end; end; -- cgit v1.2.3 From dbf39d5bfc56c24a67d481187c619dc84828221f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 21:17:22 +0000 Subject: gpl header added and property svn:header set to "HeadURL Id" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1403 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 25 +++++++++++++++++++++++++ src/base/UCatCovers.pas | 25 +++++++++++++++++++++++++ src/base/UCommandLine.pas | 25 +++++++++++++++++++++++++ src/base/UCommon.pas | 25 +++++++++++++++++++++++++ src/base/UConfig.pas | 25 +++++++++++++++++++++++++ src/base/UCore.pas | 25 +++++++++++++++++++++++++ src/base/UCoreModule.pas | 25 +++++++++++++++++++++++++ src/base/UCovers.pas | 25 +++++++++++++++++++++++++ src/base/UDLLManager.pas | 25 +++++++++++++++++++++++++ src/base/UDataBase.pas | 25 +++++++++++++++++++++++++ src/base/UDraw.pas | 25 +++++++++++++++++++++++++ src/base/UEditorLyrics.pas | 25 +++++++++++++++++++++++++ src/base/UFiles.pas | 25 +++++++++++++++++++++++++ src/base/UGraphic.pas | 25 +++++++++++++++++++++++++ src/base/UGraphicClasses.pas | 25 +++++++++++++++++++++++++ src/base/UHooks.pas | 25 +++++++++++++++++++++++++ src/base/UImage.pas | 25 +++++++++++++++++++++++++ src/base/UIni.pas | 25 +++++++++++++++++++++++++ src/base/UJoystick.pas | 25 +++++++++++++++++++++++++ src/base/ULCD.pas | 25 +++++++++++++++++++++++++ src/base/ULanguage.pas | 25 +++++++++++++++++++++++++ src/base/ULight.pas | 25 +++++++++++++++++++++++++ src/base/ULog.pas | 25 +++++++++++++++++++++++++ src/base/ULyrics.pas | 25 +++++++++++++++++++++++++ src/base/UMain.pas | 25 +++++++++++++++++++++++++ src/base/UModules.pas | 25 +++++++++++++++++++++++++ src/base/UMusic.pas | 25 +++++++++++++++++++++++++ src/base/UParty.pas | 25 +++++++++++++++++++++++++ src/base/UPlatform.pas | 25 +++++++++++++++++++++++++ src/base/UPlatformLinux.pas | 25 +++++++++++++++++++++++++ src/base/UPlatformMacOSX.pas | 25 +++++++++++++++++++++++++ src/base/UPlatformWindows.pas | 25 +++++++++++++++++++++++++ src/base/UPlaylist.pas | 25 +++++++++++++++++++++++++ src/base/UPluginInterface.pas | 25 +++++++++++++++++++++++++ src/base/URecord.pas | 25 +++++++++++++++++++++++++ src/base/URingBuffer.pas | 25 +++++++++++++++++++++++++ src/base/UServices.pas | 25 +++++++++++++++++++++++++ src/base/USingNotes.pas | 25 +++++++++++++++++++++++++ src/base/USingScores.pas | 25 +++++++++++++++++++++++++ src/base/USkins.pas | 25 +++++++++++++++++++++++++ src/base/USong.pas | 25 +++++++++++++++++++++++++ src/base/USongs.pas | 25 +++++++++++++++++++++++++ src/base/UTextClasses.pas | 25 +++++++++++++++++++++++++ src/base/UTexture.pas | 25 +++++++++++++++++++++++++ src/base/UThemes.pas | 25 +++++++++++++++++++++++++ src/base/UTime.pas | 25 +++++++++++++++++++++++++ src/base/UXMLSong.pas | 25 +++++++++++++++++++++++++ src/base/uPluginLoader.pas | 25 +++++++++++++++++++++++++ 48 files changed, 1200 insertions(+) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index f02a261c..799a0ab8 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit TextGL; interface diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index c031c663..4fc54199 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCatCovers; ///////////////////////////////////////////////////////////////////////// // UCatCovers by Whiteshark // diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas index cd1b0352..68095346 100644 --- a/src/base/UCommandLine.pas +++ b/src/base/UCommandLine.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCommandLine; interface diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index f2f98537..6195a680 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCommon; interface diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index 9ee0a668..cb663e2d 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UConfig; // ------------------------------------------------------------------- diff --git a/src/base/UCore.pas b/src/base/UCore.pas index fe23a68e..901f2f96 100644 --- a/src/base/UCore.pas +++ b/src/base/UCore.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCore; interface diff --git a/src/base/UCoreModule.pas b/src/base/UCoreModule.pas index 031fb04e..8fda6dc2 100644 --- a/src/base/UCoreModule.pas +++ b/src/base/UCoreModule.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCoreModule; interface diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas index 7bb57b4a..3ed2b633 100644 --- a/src/base/UCovers.pas +++ b/src/base/UCovers.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UCovers; { diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index e71a7eb0..b332d3be 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UDLLManager; interface diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index cd315df3..d2e0cbd0 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UDataBase; interface diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index ff0920f5..1c7788ef 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UDraw; interface diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index 25e8423e..e307ba2d 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UEditorLyrics; interface diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index ca43bb21..eb7f2cad 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UFiles; interface diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 93fac85c..a624d14f 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UGraphic; interface diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas index 0e620cac..3fbe262f 100644 --- a/src/base/UGraphicClasses.pas +++ b/src/base/UGraphicClasses.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UGraphicClasses; interface diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas index f0ba3276..ba948e6b 100644 --- a/src/base/UHooks.pas +++ b/src/base/UHooks.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UHooks; {********************* diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 5114df25..18b0035c 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UImage; interface diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 4f401b01..ee517df1 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UIni; interface diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas index ec804295..25d1d663 100644 --- a/src/base/UJoystick.pas +++ b/src/base/UJoystick.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UJoystick; interface diff --git a/src/base/ULCD.pas b/src/base/ULCD.pas index bbd41c53..e1f59765 100644 --- a/src/base/ULCD.pas +++ b/src/base/ULCD.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit ULCD; interface diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index d534b4e1..38a32f7d 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit ULanguage; interface diff --git a/src/base/ULight.pas b/src/base/ULight.pas index a0a399ab..b85a958a 100644 --- a/src/base/ULight.pas +++ b/src/base/ULight.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit ULight; interface diff --git a/src/base/ULog.pas b/src/base/ULog.pas index a9a2f3c4..582120bc 100644 --- a/src/base/ULog.pas +++ b/src/base/ULog.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit ULog; interface diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index ffc5d5af..46354cbe 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit ULyrics; interface diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 7d9886b6..0c86563d 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UMain; interface diff --git a/src/base/UModules.pas b/src/base/UModules.pas index f4503aeb..97494180 100644 --- a/src/base/UModules.pas +++ b/src/base/UModules.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UModules; interface diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 6476f629..b7553f4c 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UMusic; interface diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 01a182b1..27c2fd44 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UParty; interface diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index 0942ec7b..a43b7e50 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPlatform; // Comment by Eddie: diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas index 9095b192..30499a97 100644 --- a/src/base/UPlatformLinux.pas +++ b/src/base/UPlatformLinux.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPlatformLinux; interface diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index cd58c3e8..1aa37cd4 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPlatformMacOSX; interface diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index 029e8d33..e198958a 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPlatformWindows; interface diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index c867c356..409e8dbe 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPlaylist; interface diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas index 1a80ad1b..a8b4a789 100644 --- a/src/base/UPluginInterface.pas +++ b/src/base/UPluginInterface.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit uPluginInterface; {********************* uPluginInterface diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 8a537dc9..022b6945 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit URecord; interface diff --git a/src/base/URingBuffer.pas b/src/base/URingBuffer.pas index ce51e209..515d0efb 100644 --- a/src/base/URingBuffer.pas +++ b/src/base/URingBuffer.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit URingBuffer; interface diff --git a/src/base/UServices.pas b/src/base/UServices.pas index 6325444c..c82b27d4 100644 --- a/src/base/UServices.pas +++ b/src/base/UServices.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UServices; interface diff --git a/src/base/USingNotes.pas b/src/base/USingNotes.pas index 36e9515f..f6b81e3e 100644 --- a/src/base/USingNotes.pas +++ b/src/base/USingNotes.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit USingNotes; interface diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 02b0b9e2..9469d5b5 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit USingScores; interface diff --git a/src/base/USkins.pas b/src/base/USkins.pas index 88549c9f..df736684 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit USkins; interface diff --git a/src/base/USong.pas b/src/base/USong.pas index 8229b9d9..66288503 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit USong; interface diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 710cd44f..d6f016bf 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit USongs; interface diff --git a/src/base/UTextClasses.pas b/src/base/UTextClasses.pas index fea183ee..ddc8906c 100644 --- a/src/base/UTextClasses.pas +++ b/src/base/UTextClasses.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UTextClasses; interface diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 4879760a..cbaf6e70 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UTexture; interface diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 6097e3ee..790cbf1f 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UThemes; interface diff --git a/src/base/UTime.pas b/src/base/UTime.pas index f8ae91c4..3f35dffd 100644 --- a/src/base/UTime.pas +++ b/src/base/UTime.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UTime; interface diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas index c4420cb7..58b48789 100644 --- a/src/base/UXMLSong.pas +++ b/src/base/UXMLSong.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UXMLSong; interface diff --git a/src/base/uPluginLoader.pas b/src/base/uPluginLoader.pas index e0e894b1..876f23c6 100644 --- a/src/base/uPluginLoader.pas +++ b/src/base/uPluginLoader.pas @@ -1,3 +1,28 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + unit UPluginLoader; {********************* UPluginLoader -- cgit v1.2.3 From 015b6c092b0779ee9b53ed1ee78044737f8dc592 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 21:43:52 +0000 Subject: indentation unified, no code change. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1406 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommandLine.pas | 1 - src/base/UCoreModule.pas | 7 ++- src/base/UCovers.pas | 2 +- src/base/UDLLManager.pas | 5 +- src/base/UDataBase.pas | 9 +-- src/base/UFiles.pas | 23 ++++---- src/base/UHooks.pas | 134 +++++++++++++++++++++--------------------- src/base/ULanguage.pas | 22 +++---- src/base/UParty.pas | 5 +- src/base/UPlatform.pas | 3 +- src/base/UPlaylist.pas | 1 - src/base/UPluginInterface.pas | 7 ++- src/base/URecord.pas | 15 ++--- src/base/UServices.pas | 5 +- src/base/USingNotes.pas | 2 +- src/base/USingScores.pas | 7 ++- src/base/USong.pas | 38 ++++++------ src/base/USongs.pas | 46 +++++++-------- src/base/UThemes.pas | 10 ++-- 19 files changed, 178 insertions(+), 164 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas index 68095346..17ea1a19 100644 --- a/src/base/UCommandLine.pas +++ b/src/base/UCommandLine.pas @@ -33,7 +33,6 @@ interface {$I switches.inc} - type TScreenMode = (scmDefault, scmFullscreen, scmWindowed); diff --git a/src/base/UCoreModule.pas b/src/base/UCoreModule.pas index 8fda6dc2..b87fec85 100644 --- a/src/base/UCoreModule.pas +++ b/src/base/UCoreModule.pas @@ -35,10 +35,11 @@ interface {********************* TCoreModule - Dummy Class that has Methods that will be called from Core - In the Best case every Piece of this Software is a Module + Dummy class that has methods that will be called from core + In the best case every piece of this software is a module *********************} -uses UPluginDefs; +uses + UPluginDefs; type PCoreModule = ^TCoreModule; diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas index 3ed2b633..d4b4e471 100644 --- a/src/base/UCovers.pas +++ b/src/base/UCovers.pas @@ -44,7 +44,7 @@ interface {$I switches.inc} uses - sdl, + SDL, SQLite3, SQLiteTable3, SysUtils, diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index b332d3be..5e64f221 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -33,8 +33,9 @@ interface {$I switches.inc} -uses ModiSDK, - UFiles; +uses + ModiSDK, + UFiles; type TDLLMan = class diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index d2e0cbd0..1b9e432c 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -33,10 +33,11 @@ interface {$I switches.inc} -uses USongs, - USong, - Classes, - SQLiteTable3; +uses + USongs, + USong, + Classes, + SQLiteTable3; //-------------------- //DataBaseSystem - Class including all DB Methods diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index eb7f2cad..add81f23 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -32,13 +32,15 @@ interface {$ENDIF} {$I switches.inc} -uses SysUtils, - ULog, - UMusic, - USongs, - USong; +uses + SysUtils, + ULog, + UMusic, + USongs, + USong; procedure ResetSingTemp; + function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; var @@ -53,11 +55,12 @@ var implementation -uses TextGL, - UIni, - UPlatform, - UMain; - +uses + TextGL, + UIni, + UPlatform, + UMain; + //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables //-------------------- diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas index ba948e6b..ab830090 100644 --- a/src/base/UHooks.pas +++ b/src/base/UHooks.pas @@ -27,7 +27,7 @@ unit UHooks; {********************* THookManager - Class for saving, managing and calling of Hooks. + Class for saving, managing and calling of hooks. Saves all hookable events and their subscribers *********************} interface @@ -38,28 +38,29 @@ interface {$I switches.inc} -uses uPluginDefs, - SysUtils; +uses + uPluginDefs, + SysUtils; type //Record that saves info from Subscriber PSubscriberInfo = ^TSubscriberInfo; TSubscriberInfo = record - Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook) + Self: THandle; //ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) Next: PSubscriberInfo; //Pointer to next Item in HookChain - Owner: Integer; //For Error Handling and Plugin Unloading. + Owner: integer; //For Error Handling and Plugin Unloading. //Here is s/t tricky //To avoid writing of Wrapping Functions to Hook an Event with a Class //We save a Normal Proc or a Method of a Class - Case isClass: boolean of + case isClass: boolean of False: (Proc: TUS_Hook); //Proc that will be called on Event True: (ProcOfClass: TUS_Hook_of_Object); end; TEventInfo = record - Name: String[60]; //Name of Event + Name: string[60]; //Name of Event FirstSubscriber: PSubscriberInfo; //First subscriber in chain LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding end; @@ -67,22 +68,22 @@ type THookManager = class private Events: array of TEventInfo; - SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items) + SpaceinEvents: word; //Number of empty Items in Events Array. (e.g. Deleted Items) - Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); + procedure FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); public - constructor Create(const SpacetoAllocate: Word); + constructor Create(const SpacetoAllocate: word); - Function AddEvent (const EventName: PChar): THandle; - Function DelEvent (hEvent: THandle): Integer; + function AddEvent (const EventName: Pchar): THandle; + function DelEvent (hEvent: THandle): integer; - Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; - Function DelSubscriber (const hSubscriber: THandle): Integer; + function AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; + function DelSubscriber (const hSubscriber: THandle): integer; - Function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; - Function EventExists (const EventName: PChar): Integer; + function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; + function EventExists (const EventName: Pchar): integer; - Procedure DelbyOwner(const Owner: Integer); + procedure DelbyOwner(const Owner: integer); end; function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; @@ -91,6 +92,7 @@ var HookManager: THookManager; implementation + uses ULog, UCore; @@ -98,14 +100,14 @@ uses //------------ // Create - Creates Class and Set Standard Values //------------ -constructor THookManager.Create(const SpacetoAllocate: Word); -var I: Integer; +constructor THookManager.Create(const SpacetoAllocate: word); +var I: integer; begin inherited Create(); //Get the Space and "Zero" it SetLength (Events, SpacetoAllocate); - For I := 0 to SpacetoAllocate-1 do + for I := 0 to SpacetoAllocate-1 do Events[I].Name[1] := chr(0); SpaceinEvents := SpacetoAllocate; @@ -118,19 +120,19 @@ end; //------------ // AddEvent - Adds an Event and return the Events Handle or 0 on Failure //------------ -Function THookManager.AddEvent (const EventName: PChar): THandle; -var I: Integer; +function THookManager.AddEvent (const EventName: Pchar): THandle; +var I: integer; begin Result := 0; if (EventExists(EventName) = 0) then begin - If (SpaceinEvents > 0) then + if (SpaceinEvents > 0) then begin //There is already Space available //Go Search it! - For I := 0 to High(Events) do - If (Events[I].Name[1] = chr(0)) then + for I := 0 to High(Events) do + if (Events[I].Name[1] = chr(0)) then begin //Found Space Result := I; Dec(SpaceinEvents); @@ -168,7 +170,7 @@ end; //------------ // DelEvent - Deletes an Event by Handle Returns False on Failure //------------ -Function THookManager.DelEvent (hEvent: THandle): Integer; +function THookManager.DelEvent (hEvent: THandle): integer; var Cur, Last: PSubscriberInfo; begin @@ -176,12 +178,12 @@ begin Result := -1; - If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then + if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then begin //Event exists //Free the Space for all Subscribers Cur := Events[hEvent].FirstSubscriber; - While (Cur <> nil) do + while (Cur <> nil) do begin Last := Cur; Cur := Cur.Next; @@ -207,7 +209,7 @@ end; // AddSubscriber - Adds an Subscriber to the Event by Name // Returns Handle of the Subscribtion or 0 on Failure //------------ -Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; +function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; var EventHandle: THandle; EventIndex: Cardinal; @@ -215,11 +217,11 @@ var begin Result := 0; - If (@Proc <> nil) or (@ProcOfClass <> nil) then + if (@Proc <> nil) or (@ProcOfClass <> nil) then begin EventHandle := EventExists(EventName); - If (EventHandle <> 0) then + if (EventHandle <> 0) then begin EventIndex := EventHandle - 1; @@ -232,7 +234,7 @@ begin //Add Owner Cur.Owner := Core.CurExecuted; - If (@Proc = nil) then + if (@Proc = nil) then begin //Use the ProcofClass Method Cur.isClass := True; Cur.ProcOfClass := ProcofClass; @@ -243,20 +245,20 @@ begin Cur.Proc := Proc; end; - //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID - If (Events[EventIndex].LastSubscriber = nil) then + //Create Handle (1st word: Handle of Event; 2nd word: unique ID + if (Events[EventIndex].LastSubscriber = nil) then begin - If (Events[EventIndex].FirstSubscriber = nil) then + if (Events[EventIndex].FirstSubscriber = nil) then begin Result := (EventHandle SHL 16); Events[EventIndex].FirstSubscriber := Cur; end - Else + else begin Result := Events[EventIndex].FirstSubscriber.Self + 1; end; end - Else + else begin Result := Events[EventIndex].LastSubscriber.Self + 1; Events[EventIndex].LastSubscriber.Next := Cur; @@ -277,10 +279,10 @@ end; //------------ // FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. //------------ -Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo); +procedure THookManager.FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); begin //Delete from Chain - If (Last <> nil) then + if (Last <> nil) then begin Last.Next := Cur.Next; end @@ -290,7 +292,7 @@ begin end; //Was this Last subscription ? - If (Cur = Events[EventIndex].LastSubscriber) then + if (Cur = Events[EventIndex].LastSubscriber) then begin //Change Last Subscriber Events[EventIndex].LastSubscriber := Last; end; @@ -302,16 +304,16 @@ end; //------------ // DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure //------------ -Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer; +function THookManager.DelSubscriber (const hSubscriber: THandle): integer; var EventIndex: Cardinal; Cur, Last: PSubscriberInfo; begin Result := -1; - EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1; + EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1; //Existing Event ? - If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then + if (EventIndex < Length(Events)) and (Events[EventIndex].Name[1] <> chr(0)) then begin Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription @@ -320,9 +322,9 @@ begin Last := nil; //go through the chain ... - While (Cur <> nil) do + while (Cur <> nil) do begin - If (Cur.Self = hSubscriber) then + if (Cur.Self = hSubscriber) then begin //Found Subscription we searched for FreeSubscriber(EventIndex, Last, Cur); @@ -347,16 +349,16 @@ end; // CallEventChain - Calls the Chain of a specified EventHandle // Returns: -1: Handle doesn't Exist, 0 Chain is called until the End //------------ -Function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer; +function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; var EventIndex: Cardinal; Cur: PSubscriberInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute begin Result := -1; EventIndex := hEvent - 1; - If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then + if ((EventIndex <= High(Events)) and (Events[EventIndex].Name[1] <> chr(0))) then begin //Existing Event //Backup CurExecuted CurExecutedBackup := Core.CurExecuted; @@ -365,7 +367,7 @@ begin Cur := Events[EventIndex].FirstSubscriber; Result := 0; //Call Hooks until the Chain is at the End or breaked - While ((Cur <> nil) AND (Result = 0)) do + while ((Cur <> nil) and (Result = 0)) do begin //Set CurExecuted Core.CurExecuted := Cur.Owner; @@ -389,21 +391,21 @@ end; //------------ // EventExists - Returns non Zero if an Event with the given Name exists //------------ -Function THookManager.EventExists (const EventName: PChar): Integer; +function THookManager.EventExists (const EventName: Pchar): integer; var - I: Integer; - Name: String[60]; + I: integer; + Name: string[60]; begin Result := 0; - //If (Length(EventName) < - Name := String(EventName); + //if (Length(EventName) < + Name := string(EventName); //Sure not to search for empty space - If (Name[1] <> chr(0)) then + if (Name[1] <> chr(0)) then begin //Search for Event - For I := 0 to High(Events) do - If (Events[I].Name = Name) then + for I := 0 to High(Events) do + if (Events[I].Name = Name) then begin //Event found Result := I + 1; Break; @@ -414,31 +416,31 @@ end; //------------ // DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) //------------ -Procedure THookManager.DelbyOwner(const Owner: Integer); +procedure THookManager.DelbyOwner(const Owner: integer); var - I: Integer; + I: integer; Cur, Last: PSubscriberInfo; begin //Search for Owner in all Hooks Chains - For I := 0 to High(Events) do + for I := 0 to High(Events) do begin - If (Events[I].Name[1] <> chr(0)) then + if (Events[I].Name[1] <> chr(0)) then begin Last := nil; Cur := Events[I].FirstSubscriber; //Went Through Chain - While (Cur <> nil) do + while (Cur <> nil) do begin - If (Cur.Owner = Owner) then + if (Cur.Owner = Owner) then begin //Found Subscription by Owner -> Delete FreeSubscriber(I, Last, Cur); - If (Last <> nil) then + if (Last <> nil) then Cur := Last.Next else Cur := Events[I].FirstSubscriber; end - Else + else begin //Next Item: Last := Cur; @@ -453,7 +455,7 @@ end; function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam))))); + Core.ShowMessage(CORE_SM_INFO, Pchar(string(Pchar(Pointer(lParam))) + ': ' + string(Pchar(Pointer(wParam))))); end; end. diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index 38a32f7d..31840f5f 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -32,7 +32,6 @@ interface {$ENDIF} {$I switches.inc} - type TLanguageEntry = record @@ -68,16 +67,17 @@ var implementation -uses UMain, - // UFiles, - UIni, - IniFiles, - Classes, - SysUtils, - {$IFDEF win32} - windows, - {$ENDIF} - ULog; +uses + UMain, + // UFiles, + UIni, + IniFiles, + Classes, + SysUtils, + {$IFDEF win32} + windows, + {$ENDIF} + ULog; //---------- //Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 27c2fd44..cf19e46e 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -33,7 +33,10 @@ interface {$I switches.inc} -uses UPartyDefs, UCoreModule, UPluginDefs; +uses + UPartyDefs, + UCoreModule, + UPluginDefs; type ARounds = Array [0..252] of Integer; //0..252 needed for diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index a43b7e50..e4cb6f0c 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -38,7 +38,8 @@ interface {$I switches.inc} -uses Classes; +uses + Classes; type TDirectoryEntry = record diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 409e8dbe..11ed84de 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -32,7 +32,6 @@ interface {$ENDIF} {$I switches.inc} - uses USong; diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas index a8b4a789..f299796f 100644 --- a/src/base/UPluginInterface.pas +++ b/src/base/UPluginInterface.pas @@ -26,8 +26,8 @@ unit uPluginInterface; {********************* uPluginInterface - Unit fills a TPluginInterface Structur with Method Pointers - Unit Contains all Functions called directly by Plugins + Unit fills a TPluginInterface structure with method pointers + Unit contains all functions called directly by plugins *********************} interface @@ -38,7 +38,8 @@ interface {$I switches.inc} -uses uPluginDefs; +uses + uPluginDefs; //--------------- // Methods for Plugin diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 022b6945..3946c87c 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -33,13 +33,14 @@ interface {$I switches.inc} -uses Classes, - Math, - SysUtils, - sdl, - UCommon, - UMusic, - UIni; +uses + Classes, + Math, + SysUtils, + sdl, + UCommon, + UMusic, + UIni; const BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) diff --git a/src/base/UServices.pas b/src/base/UServices.pas index c82b27d4..3783c543 100644 --- a/src/base/UServices.pas +++ b/src/base/UServices.pas @@ -33,8 +33,9 @@ interface {$I switches.inc} -uses uPluginDefs, - SysUtils; +uses + uPluginDefs, + SysUtils; {********************* TServiceManager Class for saving, managing and calling of Services. diff --git a/src/base/USingNotes.pas b/src/base/USingNotes.pas index f6b81e3e..dcfaff9f 100644 --- a/src/base/USingNotes.pas +++ b/src/base/USingNotes.pas @@ -34,7 +34,7 @@ interface {$I switches.inc} { Dummy Unit atm - For further expantation + For further explanation Placeholder for Class that will handle the Notes Drawing} implementation diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 9469d5b5..cf00b776 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -33,9 +33,10 @@ interface {$I switches.inc} -uses UThemes, - gl, - UTexture; +uses + UThemes, + gl, + UTexture; ////////////////////////////////////////////////////////////// // ATTENTION: // diff --git a/src/base/USong.pas b/src/base/USong.pas index 66288503..0f36662b 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -34,29 +34,29 @@ interface {$I switches.inc} uses - {$IFDEF MSWINDOWS} + {$IFDEF MSWINDOWS} Windows, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, + {$ELSE} + {$IFNDEF DARWIN} + syscall, {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} PseudoThread, - {$ENDIF} - UCatCovers, - UXMLSong; + {$ENDIF} + UCatCovers, + UXMLSong; type diff --git a/src/base/USongs.pas b/src/base/USongs.pas index d6f016bf..6f1f7c51 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -40,30 +40,30 @@ interface {$ENDIF} uses - {$IFDEF MSWINDOWS} - Windows, - DirWatch, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, + {$IFDEF MSWINDOWS} + Windows, + DirWatch, + {$ELSE} + {$IFNDEF DARWIN} + syscall, {$ENDIF} - USong, - UCatCovers; + baseunix, + UnixType, + {$ENDIF} + SysUtils, + Classes, + UPlatform, + ULog, + UTexture, + UCommon, + {$IFDEF DARWIN} + cthreads, + {$ENDIF} + {$IFDEF USE_PSEUDO_THREAD} + PseudoThread, + {$ENDIF} + USong, + UCatCovers; type diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 790cbf1f..38bd3ca4 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -34,11 +34,11 @@ interface {$I switches.inc} uses - ULog, - IniFiles, - SysUtils, - Classes, - UTexture; + ULog, + IniFiles, + SysUtils, + Classes, + UTexture; type TRGB = record -- cgit v1.2.3 From bf7b206aac69a390a65a6c50717f226bb737a40d Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 21:58:57 +0000 Subject: base/uPluginLoader.pas renamed to UPluginLoader.pas. no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1408 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPluginLoader.pas | 798 +++++++++++++++++++++++++++++++++++++++++++++ src/base/uPluginLoader.pas | 798 --------------------------------------------- 2 files changed, 798 insertions(+), 798 deletions(-) create mode 100644 src/base/UPluginLoader.pas delete mode 100644 src/base/uPluginLoader.pas (limited to 'src/base') diff --git a/src/base/UPluginLoader.pas b/src/base/UPluginLoader.pas new file mode 100644 index 00000000..5e581c23 --- /dev/null +++ b/src/base/UPluginLoader.pas @@ -0,0 +1,798 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/uPluginLoader.pas $ + * $Id: uPluginLoader.pas 1403 2008-09-23 21:17:22Z k-m_schindler $ + *} + +unit UPluginLoader; +{********************* + UPluginLoader + Unit contains two classes + TPluginLoader: Class searching for and loading the plugins + TtehPlugins: Class representing the plugins in modules chain +*********************} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UPluginDefs, + UCoreModule; + +type + TPluginListItem = record + Info: TUS_PluginInfo; + State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error + Path: String; // path to this plugin + NeedsDeInit: Boolean; // if this is inited correctly this should be true + hLib: THandle; // handle of loaded libary + Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader + Load: Func_Load; + Init: Func_Init; + DeInit: Proc_DeInit; + end; + end; + {********************* + TPluginLoader + Class searches for plugins and manages loading and unloading + *********************} + PPluginLoader = ^TPluginLoader; + TPluginLoader = class (TCoreModule) + private + LoadingProcessFinished: Boolean; + sUnloadPlugin: THandle; + sLoadPlugin: THandle; + sGetPluginInfo: THandle; + sGetPluginState: THandle; + + procedure FreePlugin(Index: Cardinal); + public + PluginInterface: TUS_PluginInterface; + Plugins: array of TPluginListItem; + + // TCoreModule methods to inherit + constructor Create; override; + procedure Info(const pInfo: PModuleInfo); override; + function Load: Boolean; override; + function Init: Boolean; override; + procedure DeInit; override; + Destructor Destroy; override; + + // New methods + procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins + function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1 + procedure AddPlugin(Filename: String); // adds plugin to the array + + function CallLoad(Index: Cardinal): integer; + function CallInit(Index: Cardinal): integer; + procedure CallDeInit(Index: Cardinal); + + //Services offered + function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin + function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) + function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) + + end; + + {********************* + TtehPlugins + Class represents the plugins in module chain. + It calls the plugins procs and funcs + *********************} + TtehPlugins = class (TCoreModule) + private + PluginLoader: PPluginLoader; + public + // TCoreModule methods to inherit + constructor Create; override; + + procedure Info(const pInfo: PModuleInfo); override; + function Load: Boolean; override; + function Init: Boolean; override; + procedure DeInit; override; + end; + +const +{$IF Defined(MSWINDOWS)} + PluginFileExtension = '.dll'; +{$ELSEIF Defined(DARWIN)} + PluginFileExtension = '.dylib'; +{$ELSEIF Defined(UNIX)} + PluginFileExtension = '.so'; +{$IFEND} + +implementation + +uses + UCore, + UPluginInterface, +{$IFDEF MSWINDOWS} + windows, +{$ELSE} + dynlibs, +{$ENDIF} + UMain, + SysUtils; + +{********************* + TPluginLoader + Implementation +*********************} + +//------------- +// function that gives some infos about the module to the core +//------------- +procedure TPluginLoader.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TPluginLoader'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Searches for plugins, loads and unloads them'; +end; + +//------------- +// Just the constructor +//------------- +constructor TPluginLoader.Create; +begin + inherited; + + // Init PluginInterface + // Using methods from UPluginInterface + PluginInterface.CreateHookableEvent := CreateHookableEvent; + PluginInterface.DestroyHookableEvent := DestroyHookableEvent; + PluginInterface.NotivyEventHooks := NotivyEventHooks; + PluginInterface.HookEvent := HookEvent; + PluginInterface.UnHookEvent := UnHookEvent; + PluginInterface.EventExists := EventExists; + + PluginInterface.CreateService := @CreateService; + PluginInterface.DestroyService := DestroyService; + PluginInterface.CallService := CallService; + PluginInterface.ServiceExists := ServiceExists; + + // UnSet private var + LoadingProcessFinished := False; +end; + +//------------- +// Is called on loading. +// In this method only events and services should be created +// to offer them to other modules or plugins during the init process +// if false is returned this will cause a forced exit +//------------- +function TPluginLoader.Load: Boolean; +begin + Result := True; + + try + // Start searching for plugins + BrowseDir(PluginPath); + except + Result := False; + Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); + end; +end; + +//------------- +// Is called on init process +// In this method you can hook some events and create + init +// your classes, variables etc. +// If false is returned this will cause a forced exit +//------------- +function TPluginLoader.Init: Boolean; +begin + // Just set private var to true. + LoadingProcessFinished := True; + Result := True; +end; + +//------------- +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order +//------------- +procedure TPluginLoader.DeInit; +var + I: integer; +begin + // Force deinit + // if some plugins aren't deinited for some reason o0 + for I := 0 to High(Plugins) do + begin + if (Plugins[I].State < 4) then + FreePlugin(I); + end; + + // Nothing to do here. Core will remove the hooks +end; + +//------------- +// Is called if this module will be unloaded and has been created +// Should be used to free memory +//------------- +Destructor TPluginLoader.Destroy; +begin + // Just save some memory if it wasn't done now.. + SetLength(Plugins, 0); + inherited; +end; + +//-------------- +// Browses the path at _Path_ for plugins +//-------------- +procedure TPluginLoader.BrowseDir(Path: String); +var + SR: TSearchRec; +begin + // Search for other dirs to browse + if FindFirst(Path + '*', faDirectory, SR) = 0 then begin + repeat + if (SR.Name <> '.') and (SR.Name <> '..') then + BrowseDir(Path + Sr.Name + PathDelim); + until FindNext(SR) <> 0; + end; + FindClose(SR); + + // Search for plugins at path + if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then + begin + repeat + AddPlugin(Path + SR.Name); + until FindNext(SR) <> 0; + end; + FindClose(SR); +end; + +//-------------- +// If plugin exists: Index of plugin, else -1 +//-------------- +function TPluginLoader.PluginExists(Name: String): integer; +var + I: integer; +begin + Result := -1; + + if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then + begin + for I := 0 to High(Plugins) do + if (Plugins[I].Info.Name = Name) then + begin //Found the Plugin + Result := I; + Break; + end; + end; +end; + +//-------------- +// Adds plugin to the array +//-------------- +procedure TPluginLoader.AddPlugin(Filename: String); +var + hLib: THandle; + PInfo: Proc_PluginInfo; + Info: TUS_PluginInfo; + PluginID: integer; +begin + if (FileExists(Filename)) then + begin //Load Libary + hLib := LoadLibrary(PChar(Filename)); + if (hLib <> 0) then + begin // Try to get address of the info proc + PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); + if (@PInfo <> nil) then + begin + Info.cbSize := SizeOf(TUS_PluginInfo); + + try // Call info proc + PInfo(@Info); + except + Info.Name := ''; + Core.ReportError(integer(PChar('Error getting plugin info: ' + Filename)), PChar('TPluginLoader')); + end; + + // Is name set ? + if (Trim(Info.Name) <> '') then + begin + PluginID := PluginExists(Info.Name); + + if (PluginID > 0) and (Plugins[PluginID].State >=4) then + PluginID := -1; + + if (PluginID = -1) then + begin + // Add new item to array + PluginID := Length(Plugins); + SetLength(Plugins, PluginID + 1); + + // Fill with info: + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + // Try to get procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + Plugins[PluginID].State := 255; + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + + // Emulate loading process if this plugin is loaded too late + if (LoadingProcessFinished) then + begin + CallLoad(PluginID); + CallInit(PluginID); + end; + end + else if (LoadingProcessFinished = False) then + begin + if (Plugins[PluginID].Info.Version < Info.Version) then + begin // Found newer version of this plugin + Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + + // Unload old plugin + UnloadPlugin(PluginID, nil); + + // Fill with new info + Plugins[PluginID].Info := Info; + Plugins[PluginID].State := 0; + Plugins[PluginID].Path := Filename; + Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].hLib := hLib; + + // Try to get procs + Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); + Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); + Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); + + if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + begin + FreeLibrary(hLib); + Plugins[PluginID].State := 255; + Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin // Newer Version already loaded + FreeLibrary(hLib); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + begin + FreeLibrary(hLib); + Core.ReportError(integer(PChar('Can''t find info procedure: ' + Filename)), PChar('TPluginLoader')); + end; + end + else + Core.ReportError(integer(PChar('Can''t load plugin libary: ' + Filename)), PChar('TPluginLoader')); + end; +end; + +//-------------- +// Calls load func of plugin with the given index +//-------------- +function TPluginLoader.CallLoad(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then + begin + try + Result := Plugins[Index].Procs.Load(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + Plugins[Index].State := 1 + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls init func of plugin with the given index +//-------------- +function TPluginLoader.CallInit(Index: Cardinal): integer; +begin + Result := -2; + if(Index < Length(Plugins)) then + begin + if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then + begin + try + Result := Plugins[Index].Procs.Init(@PluginInterface); + except + Result := -3; + End; + + if (Result = 0) then + begin + Plugins[Index].State := 2; + Plugins[Index].NeedsDeInit := True; + end + else + begin + FreePlugin(Index); + Plugins[Index].State := 255; + Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + end; + end; + end; +end; + +//-------------- +// Calls deinit proc of plugin with the given index +//-------------- +procedure TPluginLoader.CallDeInit(Index: Cardinal); +begin + if(Index < Length(Plugins)) then + begin + if (Plugins[Index].State < 4) then + begin + if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then + try + Plugins[Index].Procs.DeInit(@PluginInterface); + except + + End; + + // Don't forget to remove services and subscriptions by this plugin + Core.Hooks.DelbyOwner(-1 - Index); + + FreePlugin(Index); + end; + end; +end; + +//-------------- +// Frees all plugin sources (procs and handles) - helper for deiniting functions +//-------------- +procedure TPluginLoader.FreePlugin(Index: Cardinal); +begin + Plugins[Index].State := 4; + Plugins[Index].Procs.Load := nil; + Plugins[Index].Procs.Init := nil; + Plugins[Index].Procs.DeInit := nil; + + if (Plugins[Index].hLib <> 0) then + FreeLibrary(Plugins[Index].hLib); +end; + + + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin +//-------------- +function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sFile: String; +begin + Result := -1; + sFile := ''; + // lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin //lParam is PChar + try + sFile := String(PChar(lParam)); + Index := PluginExists(sFile); + if (Index < 0) And FileExists(sFile) then + begin // Is filename + AddPlugin(sFile); + Result := Plugins[High(Plugins)].State; + end; + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + begin + AddPlugin(Plugins[Index].Path); + Result := Plugins[Index].State; + end; +end; + +//-------------- +// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin +//-------------- +function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; +var + Index: integer; + sName: String; +begin + Result := -1; + // lParam is ID + if (lParam = nil) then + begin + Index := wParam; + end + else + begin // wParam is PChar + try + sName := String(PChar(lParam)); + Index := PluginExists(sName); + except + Index := -2; + end; + end; + + + if (Index >= 0) and (Index < Length(Plugins)) then + CallDeInit(Index) +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of moduleinfo array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of plugin with Index(wParam) to address at lParam) +//-------------- +function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := 0; + if (wParam > 0) then + begin // Get info of 1 plugin + if (lParam <> nil) and (wParam < Length(Plugins)) then + begin + try + Result := 1; + PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; + except + + End; + end; + end + else if (lParam = nil) then + begin // Get length of plugin (info) array + Result := Length(Plugins); + end + else //Write PluginInfo Array to Address in lParam + begin + try + for I := 0 to high(Plugins) do + PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); + End; + end; + +end; + +//-------------- +// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam)) +//-------------- +function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; +var I: integer; +begin + Result := -1; + if (wParam > 0) then + begin // Get state of 1 plugin + if (wParam < Length(Plugins)) then + begin + Result := Plugins[wParam].State; + end; + end + else if (lParam = nil) then + begin // Get length of plugin (info) array + Result := Length(Plugins); + end + else // Write plugininfo array to address in lParam + begin + try + for I := 0 to high(Plugins) do + Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + Result := Length(Plugins); + except + Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); + End; + end; +end; + + +{********************* + TtehPlugins + Implementation +*********************} + +//------------- +// function that gives some infos about the module to the core +//------------- +procedure TtehPlugins.Info(const pInfo: PModuleInfo); +begin + pInfo^.Name := 'TtehPlugins'; + pInfo^.Version := MakeVersion(1,0,0,chr(0)); + pInfo^.Description := 'Module executing the Plugins!'; +end; + +//------------- +// Just the constructor +//------------- +constructor TtehPlugins.Create; +begin + inherited; + PluginLoader := nil; +end; + +//------------- +// Is called on loading. +// In this method only events and services should be created +// to offer them to other modules or plugins during the init process +// if false is returned this will cause a forced exit +//------------- +function TtehPlugins.Load: Boolean; +var + i: integer; // Counter + CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute +begin + // Get pointer to pluginloader + PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); + if (PluginLoader = nil) then + begin + Result := false; + Core.ReportError(integer(PChar('Could not get pointer to pluginLoader')), PChar('TtehPlugins')); + end + else + begin + Result := true; + + // Backup curexecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loading the plugins + for i := 0 to High(PluginLoader.Plugins) do + begin + Core.CurExecuted := -1 - i; + + try + // Unload plugin if not correctly executed + if (PluginLoader.CallLoad(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; // Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + begin + Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + except + // Plugin could not be loaded. + // => Show error message, then shutdown plugin + on E: Exception do + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; // Plugin causes error + Core.ReportError(integer(PChar('Plugin causes error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); + end; + end; + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; + end; +end; + +//------------- +// Is called on init process +// in this method you can hook some events and create + init +// your classes, variables etc. +// if false is returned this will cause a forced exit +//------------- +function TtehPlugins.Init: Boolean; +var + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute +begin + Result := true; + + // Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loading the plugins + for i := 0 to High(PluginLoader.Plugins) do + try + Core.CurExecuted := -1 - i; + + // Unload plugin if not correctly executed + if (PluginLoader.CallInit(i) <> 0) then + begin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 254; //Plugin asks for unload + Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end + else + Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + except + // Plugin could not be loaded. + // => Show error message, then shut down plugin + PluginLoader.CallDeInit(i); + PluginLoader.Plugins[i].State := 255; //Plugin causes Error + Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +//------------- +// Is called if this module has been inited and there is a exit. +// Deinit is in backwards initing order +//------------- +procedure TtehPlugins.DeInit; +var + i: integer; // Counter + CurExecutedBackup: integer; // backup of Core.CurExecuted attribute +begin + // Backup CurExecuted + CurExecutedBackup := Core.CurExecuted; + + // Start loop + + for i := 0 to High(PluginLoader.Plugins) do + begin + try + // DeInit plugin + PluginLoader.CallDeInit(i); + except + end; + end; + + // Reset CurExecuted + Core.CurExecuted := CurExecutedBackup; +end; + +end. diff --git a/src/base/uPluginLoader.pas b/src/base/uPluginLoader.pas deleted file mode 100644 index 876f23c6..00000000 --- a/src/base/uPluginLoader.pas +++ /dev/null @@ -1,798 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UPluginLoader; -{********************* - UPluginLoader - Unit contains two classes - TPluginLoader: Class searching for and loading the plugins - TtehPlugins: Class representing the plugins in modules chain -*********************} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UPluginDefs, - UCoreModule; - -type - TPluginListItem = record - Info: TUS_PluginInfo; - State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error - Path: String; // path to this plugin - NeedsDeInit: Boolean; // if this is inited correctly this should be true - hLib: THandle; // handle of loaded libary - Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader - Load: Func_Load; - Init: Func_Init; - DeInit: Proc_DeInit; - end; - end; - {********************* - TPluginLoader - Class searches for plugins and manages loading and unloading - *********************} - PPluginLoader = ^TPluginLoader; - TPluginLoader = class (TCoreModule) - private - LoadingProcessFinished: Boolean; - sUnloadPlugin: THandle; - sLoadPlugin: THandle; - sGetPluginInfo: THandle; - sGetPluginState: THandle; - - procedure FreePlugin(Index: Cardinal); - public - PluginInterface: TUS_PluginInterface; - Plugins: array of TPluginListItem; - - // TCoreModule methods to inherit - constructor Create; override; - procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; - procedure DeInit; override; - Destructor Destroy; override; - - // New methods - procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins - function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1 - procedure AddPlugin(Filename: String); // adds plugin to the array - - function CallLoad(Index: Cardinal): integer; - function CallInit(Index: Cardinal): integer; - procedure CallDeInit(Index: Cardinal); - - //Services offered - function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) - function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) - - end; - - {********************* - TtehPlugins - Class represents the plugins in module chain. - It calls the plugins procs and funcs - *********************} - TtehPlugins = class (TCoreModule) - private - PluginLoader: PPluginLoader; - public - // TCoreModule methods to inherit - constructor Create; override; - - procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; - procedure DeInit; override; - end; - -const -{$IF Defined(MSWINDOWS)} - PluginFileExtension = '.dll'; -{$ELSEIF Defined(DARWIN)} - PluginFileExtension = '.dylib'; -{$ELSEIF Defined(UNIX)} - PluginFileExtension = '.so'; -{$IFEND} - -implementation - -uses - UCore, - UPluginInterface, -{$IFDEF MSWINDOWS} - windows, -{$ELSE} - dynlibs, -{$ENDIF} - UMain, - SysUtils; - -{********************* - TPluginLoader - Implementation -*********************} - -//------------- -// function that gives some infos about the module to the core -//------------- -procedure TPluginLoader.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TPluginLoader'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Searches for plugins, loads and unloads them'; -end; - -//------------- -// Just the constructor -//------------- -constructor TPluginLoader.Create; -begin - inherited; - - // Init PluginInterface - // Using methods from UPluginInterface - PluginInterface.CreateHookableEvent := CreateHookableEvent; - PluginInterface.DestroyHookableEvent := DestroyHookableEvent; - PluginInterface.NotivyEventHooks := NotivyEventHooks; - PluginInterface.HookEvent := HookEvent; - PluginInterface.UnHookEvent := UnHookEvent; - PluginInterface.EventExists := EventExists; - - PluginInterface.CreateService := @CreateService; - PluginInterface.DestroyService := DestroyService; - PluginInterface.CallService := CallService; - PluginInterface.ServiceExists := ServiceExists; - - // UnSet private var - LoadingProcessFinished := False; -end; - -//------------- -// Is called on loading. -// In this method only events and services should be created -// to offer them to other modules or plugins during the init process -// if false is returned this will cause a forced exit -//------------- -function TPluginLoader.Load: Boolean; -begin - Result := True; - - try - // Start searching for plugins - BrowseDir(PluginPath); - except - Result := False; - Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); - end; -end; - -//------------- -// Is called on init process -// In this method you can hook some events and create + init -// your classes, variables etc. -// If false is returned this will cause a forced exit -//------------- -function TPluginLoader.Init: Boolean; -begin - // Just set private var to true. - LoadingProcessFinished := True; - Result := True; -end; - -//------------- -// Is called if this module has been inited and there is a exit. -// Deinit is in backwards initing order -//------------- -procedure TPluginLoader.DeInit; -var - I: integer; -begin - // Force deinit - // if some plugins aren't deinited for some reason o0 - for I := 0 to High(Plugins) do - begin - if (Plugins[I].State < 4) then - FreePlugin(I); - end; - - // Nothing to do here. Core will remove the hooks -end; - -//------------- -// Is called if this module will be unloaded and has been created -// Should be used to free memory -//------------- -Destructor TPluginLoader.Destroy; -begin - // Just save some memory if it wasn't done now.. - SetLength(Plugins, 0); - inherited; -end; - -//-------------- -// Browses the path at _Path_ for plugins -//-------------- -procedure TPluginLoader.BrowseDir(Path: String); -var - SR: TSearchRec; -begin - // Search for other dirs to browse - if FindFirst(Path + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Path + Sr.Name + PathDelim); - until FindNext(SR) <> 0; - end; - FindClose(SR); - - // Search for plugins at path - if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then - begin - repeat - AddPlugin(Path + SR.Name); - until FindNext(SR) <> 0; - end; - FindClose(SR); -end; - -//-------------- -// If plugin exists: Index of plugin, else -1 -//-------------- -function TPluginLoader.PluginExists(Name: String): integer; -var - I: integer; -begin - Result := -1; - - if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then - begin - for I := 0 to High(Plugins) do - if (Plugins[I].Info.Name = Name) then - begin //Found the Plugin - Result := I; - Break; - end; - end; -end; - -//-------------- -// Adds plugin to the array -//-------------- -procedure TPluginLoader.AddPlugin(Filename: String); -var - hLib: THandle; - PInfo: Proc_PluginInfo; - Info: TUS_PluginInfo; - PluginID: integer; -begin - if (FileExists(Filename)) then - begin //Load Libary - hLib := LoadLibrary(PChar(Filename)); - if (hLib <> 0) then - begin // Try to get address of the info proc - PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); - if (@PInfo <> nil) then - begin - Info.cbSize := SizeOf(TUS_PluginInfo); - - try // Call info proc - PInfo(@Info); - except - Info.Name := ''; - Core.ReportError(integer(PChar('Error getting plugin info: ' + Filename)), PChar('TPluginLoader')); - end; - - // Is name set ? - if (Trim(Info.Name) <> '') then - begin - PluginID := PluginExists(Info.Name); - - if (PluginID > 0) and (Plugins[PluginID].State >=4) then - PluginID := -1; - - if (PluginID = -1) then - begin - // Add new item to array - PluginID := Length(Plugins); - SetLength(Plugins, PluginID + 1); - - // Fill with info: - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; - Plugins[PluginID].hLib := hLib; - - // Try to get procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then - begin - Plugins[PluginID].State := 255; - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - - // Emulate loading process if this plugin is loaded too late - if (LoadingProcessFinished) then - begin - CallLoad(PluginID); - CallInit(PluginID); - end; - end - else if (LoadingProcessFinished = False) then - begin - if (Plugins[PluginID].Info.Version < Info.Version) then - begin // Found newer version of this plugin - Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader')); - - // Unload old plugin - UnloadPlugin(PluginID, nil); - - // Fill with new info - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; - Plugins[PluginID].hLib := hLib; - - // Try to get procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then - begin - FreeLibrary(hLib); - Plugins[PluginID].State := 255; - Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin // Newer Version already loaded - FreeLibrary(hLib); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t find info procedure: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - Core.ReportError(integer(PChar('Can''t load plugin libary: ' + Filename)), PChar('TPluginLoader')); - end; -end; - -//-------------- -// Calls load func of plugin with the given index -//-------------- -function TPluginLoader.CallLoad(Index: Cardinal): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then - begin - try - Result := Plugins[Index].Procs.Load(@PluginInterface); - except - Result := -3; - End; - - if (Result = 0) then - Plugins[Index].State := 1 - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls init func of plugin with the given index -//-------------- -function TPluginLoader.CallInit(Index: Cardinal): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then - begin - try - Result := Plugins[Index].Procs.Init(@PluginInterface); - except - Result := -3; - End; - - if (Result = 0) then - begin - Plugins[Index].State := 2; - Plugins[Index].NeedsDeInit := True; - end - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls deinit proc of plugin with the given index -//-------------- -procedure TPluginLoader.CallDeInit(Index: Cardinal); -begin - if(Index < Length(Plugins)) then - begin - if (Plugins[Index].State < 4) then - begin - if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then - try - Plugins[Index].Procs.DeInit(@PluginInterface); - except - - End; - - // Don't forget to remove services and subscriptions by this plugin - Core.Hooks.DelbyOwner(-1 - Index); - - FreePlugin(Index); - end; - end; -end; - -//-------------- -// Frees all plugin sources (procs and handles) - helper for deiniting functions -//-------------- -procedure TPluginLoader.FreePlugin(Index: Cardinal); -begin - Plugins[Index].State := 4; - Plugins[Index].Procs.Load := nil; - Plugins[Index].Procs.Init := nil; - Plugins[Index].Procs.DeInit := nil; - - if (Plugins[Index].hLib <> 0) then - FreeLibrary(Plugins[Index].hLib); -end; - - - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin -//-------------- -function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sFile: String; -begin - Result := -1; - sFile := ''; - // lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin //lParam is PChar - try - sFile := String(PChar(lParam)); - Index := PluginExists(sFile); - if (Index < 0) And FileExists(sFile) then - begin // Is filename - AddPlugin(sFile); - Result := Plugins[High(Plugins)].State; - end; - except - Index := -2; - end; - end; - - - if (Index >= 0) and (Index < Length(Plugins)) then - begin - AddPlugin(Plugins[Index].Path); - Result := Plugins[Index].State; - end; -end; - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin -//-------------- -function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sName: String; -begin - Result := -1; - // lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin // wParam is PChar - try - sName := String(PChar(lParam)); - Index := PluginExists(sName); - except - Index := -2; - end; - end; - - - if (Index >= 0) and (Index < Length(Plugins)) then - CallDeInit(Index) -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of moduleinfo array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of plugin with Index(wParam) to address at lParam) -//-------------- -function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := 0; - if (wParam > 0) then - begin // Get info of 1 plugin - if (lParam <> nil) and (wParam < Length(Plugins)) then - begin - try - Result := 1; - PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; - except - - End; - end; - end - else if (lParam = nil) then - begin // Get length of plugin (info) array - Result := Length(Plugins); - end - else //Write PluginInfo Array to Address in lParam - begin - try - for I := 0 to high(Plugins) do - PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); - End; - end; - -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam)) -//-------------- -function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := -1; - if (wParam > 0) then - begin // Get state of 1 plugin - if (wParam < Length(Plugins)) then - begin - Result := Plugins[wParam].State; - end; - end - else if (lParam = nil) then - begin // Get length of plugin (info) array - Result := Length(Plugins); - end - else // Write plugininfo array to address in lParam - begin - try - for I := 0 to high(Plugins) do - Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); - End; - end; -end; - - -{********************* - TtehPlugins - Implementation -*********************} - -//------------- -// function that gives some infos about the module to the core -//------------- -procedure TtehPlugins.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TtehPlugins'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Module executing the Plugins!'; -end; - -//------------- -// Just the constructor -//------------- -constructor TtehPlugins.Create; -begin - inherited; - PluginLoader := nil; -end; - -//------------- -// Is called on loading. -// In this method only events and services should be created -// to offer them to other modules or plugins during the init process -// if false is returned this will cause a forced exit -//------------- -function TtehPlugins.Load: Boolean; -var - i: integer; // Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute -begin - // Get pointer to pluginloader - PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); - if (PluginLoader = nil) then - begin - Result := false; - Core.ReportError(integer(PChar('Could not get pointer to pluginLoader')), PChar('TtehPlugins')); - end - else - begin - Result := true; - - // Backup curexecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loading the plugins - for i := 0 to High(PluginLoader.Plugins) do - begin - Core.CurExecuted := -1 - i; - - try - // Unload plugin if not correctly executed - if (PluginLoader.CallLoad(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; // Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - begin - Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - except - // Plugin could not be loaded. - // => Show error message, then shutdown plugin - on E: Exception do - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; // Plugin causes error - Core.ReportError(integer(PChar('Plugin causes error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); - end; - end; - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; -end; - -//------------- -// Is called on init process -// in this method you can hook some events and create + init -// your classes, variables etc. -// if false is returned this will cause a forced exit -//------------- -function TtehPlugins.Init: Boolean; -var - i: integer; // Counter - CurExecutedBackup: integer; // backup of Core.CurExecuted attribute -begin - Result := true; - - // Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loading the plugins - for i := 0 to High(PluginLoader.Plugins) do - try - Core.CurExecuted := -1 - i; - - // Unload plugin if not correctly executed - if (PluginLoader.CallInit(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - except - // Plugin could not be loaded. - // => Show error message, then shut down plugin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -//------------- -// Is called if this module has been inited and there is a exit. -// Deinit is in backwards initing order -//------------- -procedure TtehPlugins.DeInit; -var - i: integer; // Counter - CurExecutedBackup: integer; // backup of Core.CurExecuted attribute -begin - // Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loop - - for i := 0 to High(PluginLoader.Plugins) do - begin - try - // DeInit plugin - PluginLoader.CallDeInit(i); - except - end; - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -end. -- cgit v1.2.3 From 5e65c66f550a7f3a9218c7bd7493e9c07647193d Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 23 Sep 2008 22:41:25 +0000 Subject: remove junk tab whitespace git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1411 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 113 +++++++++++++++++++++++++-------------------------- 1 file changed, 55 insertions(+), 58 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 38bd3ca4..3ee2798e 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -863,7 +863,7 @@ begin Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); - FileName := AdaptFilePaths( FileName ); + FileName := AdaptFilePaths(FileName); if not FileExists(FileName) then begin @@ -2211,91 +2211,88 @@ end; procedure TTheme.create_theme_objects(); begin - freeandnil( Loading ); - Loading := TThemeLoading.Create; - - freeandnil( Main ); - Main := TThemeMain.Create; - - freeandnil( Name ); - Name := TThemeName.Create; + freeandnil(Loading); + Loading := TThemeLoading.Create; - freeandnil( Level ); - Level := TThemeLevel.Create; + freeandnil(Main); + Main := TThemeMain.Create; - freeandnil( Song ); - Song := TThemeSong.Create; + freeandnil(Name); + Name := TThemeName.Create; - freeandnil( Sing ); - Sing := TThemeSing.Create; + freeandnil(Level); + Level := TThemeLevel.Create; - freeandnil( Score ); - Score := TThemeScore.Create; + freeandnil(Song); + Song := TThemeSong.Create; - freeandnil( Top5 ); - Top5 := TThemeTop5.Create; + freeandnil(Sing); + Sing := TThemeSing.Create; - freeandnil( Options ); - Options := TThemeOptions.Create; + freeandnil(Score); + Score := TThemeScore.Create; - freeandnil( OptionsGame ); - OptionsGame := TThemeOptionsGame.Create; + freeandnil(Top5); + Top5 := TThemeTop5.Create; - freeandnil( OptionsGraphics ); - OptionsGraphics := TThemeOptionsGraphics.Create; + freeandnil(Options); + Options := TThemeOptions.Create; - freeandnil( OptionsSound ); - OptionsSound := TThemeOptionsSound.Create; + freeandnil(OptionsGame); + OptionsGame := TThemeOptionsGame.Create; - freeandnil( OptionsLyrics ); - OptionsLyrics := TThemeOptionsLyrics.Create; + freeandnil(OptionsGraphics); + OptionsGraphics := TThemeOptionsGraphics.Create; - freeandnil( OptionsThemes ); - OptionsThemes := TThemeOptionsThemes.Create; + freeandnil(OptionsSound); + OptionsSound := TThemeOptionsSound.Create; - freeandnil( OptionsRecord ); - OptionsRecord := TThemeOptionsRecord.Create; + freeandnil(OptionsLyrics); + OptionsLyrics := TThemeOptionsLyrics.Create; - freeandnil( OptionsAdvanced ); - OptionsAdvanced := TThemeOptionsAdvanced.Create; + freeandnil(OptionsThemes); + OptionsThemes := TThemeOptionsThemes.Create; + freeandnil(OptionsRecord); + OptionsRecord := TThemeOptionsRecord.Create; - freeandnil( ErrorPopup ); - ErrorPopup := TThemeError.Create; + freeandnil(OptionsAdvanced); + OptionsAdvanced := TThemeOptionsAdvanced.Create; - freeandnil( CheckPopup ); - CheckPopup := TThemeCheck.Create; + freeandnil(ErrorPopup); + ErrorPopup := TThemeError.Create; + freeandnil(CheckPopup); + CheckPopup := TThemeCheck.Create; - freeandnil( SongMenu ); - SongMenu := TThemeSongMenu.Create; + freeandnil(SongMenu); + SongMenu := TThemeSongMenu.Create; - freeandnil( SongJumpto ); - SongJumpto := TThemeSongJumpto.Create; + freeandnil(SongJumpto); + SongJumpto := TThemeSongJumpto.Create; //Party Screens - freeandnil( PartyNewRound ); - PartyNewRound := TThemePartyNewRound.Create; - - freeandnil( PartyWin ); - PartyWin := TThemePartyWin.Create; + freeandnil(PartyNewRound); + PartyNewRound := TThemePartyNewRound.Create; - freeandnil( PartyScore ); - PartyScore := TThemePartyScore.Create; + freeandnil(PartyWin); + PartyWin := TThemePartyWin.Create; - freeandnil( PartyOptions ); - PartyOptions := TThemePartyOptions.Create; + freeandnil(PartyScore); + PartyScore := TThemePartyScore.Create; - freeandnil( PartyPlayer ); - PartyPlayer := TThemePartyPlayer.Create; + freeandnil(PartyOptions); + PartyOptions := TThemePartyOptions.Create; + freeandnil(PartyPlayer); + PartyPlayer := TThemePartyPlayer.Create; //Stats Screens: - freeandnil( StatMain ); - StatMain := TThemeStatMain.Create; + freeandnil(StatMain); + StatMain := TThemeStatMain.Create; - freeandnil( StatDetail ); - StatDetail := TThemeStatDetail.Create; + freeandnil(StatDetail); + StatDetail := TThemeStatDetail.Create; end; -- cgit v1.2.3 From 70f986ccf78fe87240026811c6396b9d7224c6db Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 24 Sep 2008 15:29:55 +0000 Subject: Removed fixed font offset from ratin indication popup variable offset is caculatied w/ popup height and fontsize git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1414 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index cf00b776..71ae2651 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -456,13 +456,13 @@ begin //Change Bars Position if (Cur.ScoreDiff > 0) THEN - begin //Popup w/ scorechange -> give missing percents + begin //Popup w/ scorechange -> give missing Percentille aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) / Cur.ScoreDiff * (Cur.Rating / 20 - 0.26); end else - begin //Popup w/o scorechange -> give complete percentage + begin //Popup w/o scorechange -> give complete Percentille aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.Rating / 20 - 0.26); end; @@ -664,6 +664,7 @@ var CurTime: Cardinal; X, Y, W, H, Alpha: Real; FontSize: Byte; + FontOffset: Real; TimeDiff: Cardinal; PIndex: Byte; TextLen: Real; @@ -704,7 +705,8 @@ begin X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; - FontSize := Round(Progress * Positions[PIndex].PUFontSize); + FontSize := Round(Progress * Positions[PIndex].PUFontSize); + FontOffset := H / 2 - FontSize; Alpha := 1; end @@ -726,7 +728,8 @@ begin PosDiff := PosDiff + Positions[PIndex].BGH; Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); - FontSize := Positions[PIndex].PUFontSize; + FontSize := Positions[PIndex].PUFontSize; + FontOffset := H / 2 - FontSize; Alpha := 1 - 0.3 * Progress; end @@ -772,7 +775,8 @@ begin PosDiff := 0; Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); - FontSize := Positions[PIndex].PUFontSize; + FontSize := Positions[PIndex].PUFontSize; + FontOffset := H / 2 - FontSize; end else begin @@ -816,7 +820,7 @@ begin TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); //Color and Pos - SetFontPos (X + (W - TextLen) / 2, Y + 12); + SetFontPos (X + (W - TextLen) / 2, Y + FontOffset{12}); glColor4f(1, 1, 1, Alpha); //Draw -- cgit v1.2.3 From f4e974f904307d6120c243c6c180e4429fe12708 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 28 Sep 2008 13:55:05 +0000 Subject: correction of byte order (correct colors) in texture output on powerpc. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1419 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTexture.pas | 13 +++++++++++++ 1 file changed, 13 insertions(+) (limited to 'src/base') diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index cbaf6e70..17d81687 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -319,11 +319,19 @@ begin if (Typ = TEXTURE_TYPE_TRANSPARENT) or (Typ = TEXTURE_TYPE_COLORIZED) then begin + {$IFDEF FPC_LITTLE_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, TexSurface.pixels); + {$ENDIF} end else //if Typ = TEXTURE_TYPE_PLAIN then begin + {$IFDEF FPC_LITTLE_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_BGR, GL_UNSIGNED_BYTE, TexSurface.pixels); + {$ENDIF} end; // setup texture struct @@ -433,12 +441,17 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + {$IFDEF FPC_LITTLE_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_BGR, GL_UNSIGNED_BYTE, Data); + {$ENDIF} { if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); +// FPC_BIG_ENDIAN Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_BGR, GL_UNSIGNED_BYTE, @Data[0]); if Error > 0 then Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); end; -- cgit v1.2.3 From cbf062e0f808c56c51932a06ae015db764d0e056 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 28 Sep 2008 14:00:53 +0000 Subject: Adding hints to possible endian related problems. No code change, yet. Only suggestions for test. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1420 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 799a0ab8..8569fadf 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -474,6 +474,9 @@ begin glBindTexture(GL_TEXTURE_2D, texture); glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); +// on big endian machines (powerpc) this may need to be changed to +// Needs to be tests. KaMiSchi Sept 2008 +// glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, intermediary.pixels); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); -- cgit v1.2.3 From e5222f99929e0a893fca4ea0ffe08c3bb90fd5c3 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 28 Sep 2008 16:30:08 +0000 Subject: Songclass now reports an error if there is no linebreak in a txt file. Error is written to log. Added detailed error description to ERROR_CORRUPT_SONG Popup. Some translation may be added to this one git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1423 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 19 ++++++++++++++++++- 1 file changed, 18 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 0f36662b..3679863b 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -129,6 +129,8 @@ type Mult : integer; MultBPM : integer; + LastError: String; + constructor Create (); overload; constructor Create ( const aFileName : WideString ); overload; function LoadSong: boolean; @@ -159,6 +161,8 @@ begin MultBPM := 4; fFileName := aFileName; + LastError := ''; + if fileexists( aFileName ) then begin self.Path := ExtractFilePath( aFileName ); @@ -195,9 +199,11 @@ var begin Result := false; + LastError := ''; if not FileExists(Path + PathDelim + FileName) then begin + LastError := 'File not found'; Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); exit; end; @@ -240,7 +246,7 @@ begin begin //Song File Corrupted - No Notes CloseFile(SongFile); Log.LogError('Could not load txt File, no Notes found: ' + FileName); - Result := False; + LastError := 'Can''t find any notes'; Exit; end; Read(SongFile, TempC); @@ -361,6 +367,16 @@ begin end; CloseFile(SongFile); + + For I := 0 to High(Lines) do + begin + If ((Both) or (I = 0)) AND (Length(Lines[I].Line) < 2) then + begin + LastError := 'Can''t find any linebreaks'; + Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); + exit; + end; + end; except try CloseFile(SongFile); @@ -368,6 +384,7 @@ begin end; + LastError := 'Error reading line ' + inttostr(FileLineNo); Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); exit; end; -- cgit v1.2.3 From 26de26ea9cb80fe303b93fbeb535bae241c2222f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 28 Sep 2008 17:47:04 +0000 Subject: one more version of fixing the endian problem in SDL git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1424 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTexture.pas | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 17d81687..83ff8239 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -319,18 +319,18 @@ begin if (Typ = TEXTURE_TYPE_TRANSPARENT) or (Typ = TEXTURE_TYPE_COLORIZED) then begin - {$IFDEF FPC_LITTLE_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - {$ELSE} + {$IFDEF FPC_BIG_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, TexSurface.pixels); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); {$ENDIF} end else //if Typ = TEXTURE_TYPE_PLAIN then begin - {$IFDEF FPC_LITTLE_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - {$ELSE} + {$IFDEF FPC_BIG_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_BGR, GL_UNSIGNED_BYTE, TexSurface.pixels); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); {$ENDIF} end; @@ -441,10 +441,10 @@ begin glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - {$IFDEF FPC_LITTLE_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); - {$ELSE} + {$IFDEF FPC_BIG_ENDIAN} glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_BGR, GL_UNSIGNED_BYTE, Data); + {$ELSE} + glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); {$ENDIF} { -- cgit v1.2.3 From 276411ffc65aa73fce9fdc1bec7555d6df76357c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 28 Sep 2008 18:51:06 +0000 Subject: Fixed some minor bugs in txt file reader Added workaround for empty sentences. Ignores the emtpy sentences and use values from 2nd linebreak. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1425 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 92 +++++++++++++++++++++++++++++++++--------------------- 1 file changed, 56 insertions(+), 36 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 3679863b..47ac0a30 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -233,9 +233,6 @@ begin if (self.FileName = '') then self.Filename := ExtractFileName(FileName); - Result := False; - - Reset(SongFile); FileLineNo := 0; //Search for Note Begining repeat @@ -292,9 +289,9 @@ begin ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); end; end; //Zeronote check - end; // if + end // if - if TempC = '-' then + Else if TempC = '-' then begin // reads sentence Read(SongFile, Param1); @@ -309,9 +306,9 @@ begin NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); end; - end; // if + end // if - if TempC = 'B' then + Else if TempC = 'B' then begin SetLength(self.BPM, Length(self.BPM) + 1); Read(SongFile, self.BPM[High(self.BPM)].StartBeat); @@ -342,7 +339,7 @@ begin else begin for Count := 0 to High(Lines) do - begin + 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 @@ -357,26 +354,40 @@ begin //Total Notes Patch End end; end; + ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) + Read(SongFile, TempC); Inc(FileLineNo); end; // while} - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; - end; - CloseFile(SongFile); For I := 0 to High(Lines) do begin - If ((Both) or (I = 0)) AND (Length(Lines[I].Line) < 2) then + If ((Both) or (I = 0)) then begin - LastError := 'Can''t find any linebreaks'; - Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); - exit; + If (Length(Lines[I].Line) < 2) then + begin + LastError := 'Can''t find any linebreaks'; + Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); + exit; + end; + + If (Lines[I].Line[Lines[I].High].HighNote < 0) then + begin + SetLength(Lines[I].Line, Lines[I].Number - 1); + Lines[I].High := Lines[I].High - 1; + Lines[I].Number := Lines[I].Number - 1; + Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + Filename); + end; end; end; + + for Count := 0 to High(Lines) do + begin + If (High(Lines[Count].Line) >= 0) then + Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + end; except try CloseFile(SongFile); @@ -414,6 +425,7 @@ var begin Result := false; + LastError := ''; if not FileExists(Path + PathDelim + FileName) then begin @@ -936,7 +948,7 @@ begin ':': Note[HighNote].NoteType := ntNormal; '*': Note[HighNote].NoteType := ntGolden; end; - + if (Note[HighNote].NoteType = ntGolden) then Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; @@ -960,27 +972,35 @@ var 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)); + If (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then + begin //Update old Sentence if it has notes and create a new sentence + // 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 + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; + end; + //Total Notes Patch End - //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 - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - 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; + end + else + begin //Use old Sentence if it has no notes + Log.LogError('Error loading Song, sentence w/o note found in line ' + InttoStr(FileLineNo) + ': ' + Filename); + 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 -- cgit v1.2.3 From 5a237b4a0da9b4058e08b0db1a46e4c66277ede4 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 28 Sep 2008 19:17:48 +0000 Subject: Fixed effects from last song are drawn in next song, see http://www.assembla.com/spaces/usdx/tickets/23 ClearScores method updated: this fixes that first sentence of song is awful if a song was sung before git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1426 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 0c86563d..f9ac4ebe 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -1013,13 +1013,18 @@ procedure ClearScores(PlayerNum: integer); begin with Player[PlayerNum] do begin - Score := 0; - ScoreInt := 0; - ScoreLine := 0; - ScoreLineInt := 0; - ScoreGolden := 0; - ScoreGoldenInt := 0; + Score := 0; + ScoreLine := 0; + ScoreGolden := 0; + + ScoreInt := 0; + ScoreLineInt := 0; + ScoreGoldenInt:= 0; ScoreTotalInt := 0; + + ScoreLast := 0; + + LastSentencePerfect := False; end; end; -- cgit v1.2.3 From 08a0ddf3d8f9eb819e03d9cd6c8d79bd8634fec6 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 1 Oct 2008 12:28:15 +0000 Subject: - FFmpeg header update - update to newest revision - if linked libs are too new, USDX will not compile anymore and display an error message (to avoid mysterious crashes if an unsupported version of FFmpeg is used) - comment change in UVisualizer.pas git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1428 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index b7553f4c..792d5e3f 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -156,9 +156,9 @@ type asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) - asfS24, // signed 24 bits (endianness: System) asfS32, // signed 32 bits (endianness: System) - asfFloat // float + asfFloat, // float + asfDouble // double ); const -- cgit v1.2.3 From 93e52c516659926933b729593885a30550017482 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 5 Oct 2008 17:50:00 +0000 Subject: remove ULCD.pas and ULight.pas + some more cleanup of ULCD routines and {$UNDEF UseSerialPort} git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1435 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/ULCD.pas | 333 ---------------------------------------------------- src/base/ULight.pas | 170 --------------------------- 2 files changed, 503 deletions(-) delete mode 100644 src/base/ULCD.pas delete mode 100644 src/base/ULight.pas (limited to 'src/base') diff --git a/src/base/ULCD.pas b/src/base/ULCD.pas deleted file mode 100644 index e1f59765..00000000 --- a/src/base/ULCD.pas +++ /dev/null @@ -1,333 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit ULCD; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -type - TLCD = class - private - Enabled: boolean; - Text: array[1..6] of string; - StartPos: integer; - LineBR: integer; - Position: integer; - procedure WriteCommand(B: byte); - procedure WriteData(B: byte); - procedure WriteString(S: string); - public - HalfInterface: boolean; - constructor Create; - procedure Enable; - procedure Clear; - procedure WriteText(Line: integer; S: string); - procedure MoveCursor(Line, Pos: integer); - procedure ShowCursor; - procedure HideCursor; - - // for 2x16 - procedure AddTextBR(S: string); - procedure MoveCursorBR(Pos: integer); - procedure ScrollUpBR; - procedure AddTextArray(Line:integer; S: string); - end; - -var - LCD: TLCD; - -const - Data = $378; // domyœlny adres portu - Status = Data + 1; - Control = Data + 2; - -implementation - -uses - SysUtils, - {$IFDEF UseSerialPort} - zlportio, - {$ENDIF} - SDL, - UTime; - -procedure TLCD.WriteCommand(B: Byte); -// Wysylanie komend sterujacych -begin -{$IFDEF UseSerialPort} - if not HalfInterface then - begin - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, B); - zlioportwrite(Control, 0, $03); - end - else - begin - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, B and $F0); - zlioportwrite(Control, 0, $03); - - SDL_Delay( 100 ); - - zlioportwrite(Control, 0, $02); - zlioportwrite(Data, 0, (B * 16) and $F0); - zlioportwrite(Control, 0, $03); - end; - - if (B=1) or (B=2) then - Sleep(2) - else - SDL_Delay( 100 ); -{$ENDIF} -end; - -procedure TLCD.WriteData(B: Byte); -// Wysylanie danych -begin -{$IFDEF UseSerialPort} - if not HalfInterface then - begin - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, B); - zlioportwrite(Control, 0, $07); - end - else - begin - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, B and $F0); - zlioportwrite(Control, 0, $07); - - SDL_Delay( 100 ); - - zlioportwrite(Control, 0, $06); - zlioportwrite(Data, 0, (B * 16) and $F0); - zlioportwrite(Control, 0, $07); - end; - - SDL_Delay( 100 ); - Inc(Position); -{$ENDIF} -end; - -procedure TLCD.WriteString(S: string); -// Wysylanie slow -var - I: integer; -begin - for I := 1 to Length(S) do - WriteData(Ord(S[I])); -end; - -constructor TLCD.Create; -begin - inherited; -end; - -procedure TLCD.Enable; -{var - A: byte; - B: byte;} -begin - Enabled := true; - if not HalfInterface then - WriteCommand($38) - else begin - WriteCommand($33); - WriteCommand($32); - WriteCommand($28); - end; - -// WriteCommand($06); -// WriteCommand($0C); -// sleep(10); -end; - -procedure TLCD.Clear; -begin - if Enabled then begin - WriteCommand(1); - WriteCommand(2); - Text[1] := ''; - Text[2] := ''; - Text[3] := ''; - Text[4] := ''; - Text[5] := ''; - Text[6] := ''; - StartPos := 1; - LineBR := 1; - end; -end; - -procedure TLCD.WriteText(Line: integer; S: string); -begin - if Enabled then begin - if Line <= 2 then begin - MoveCursor(Line, 1); - WriteString(S); - end; - - Text[Line] := ''; - AddTextArray(Line, S); - end; -end; - -procedure TLCD.MoveCursor(Line, Pos: integer); -var - I: integer; -begin - if Enabled then begin - Pos := Pos + (Line-1) * 40; - - if Position > Pos then begin - WriteCommand(2); - for I := 1 to Pos-1 do - WriteCommand(20); - end; - - if Position < Pos then - for I := 1 to Pos - Position do - WriteCommand(20); - - Position := Pos; - end; -end; - -procedure TLCD.ShowCursor; -begin - if Enabled then begin - WriteCommand(14); - end; -end; - -procedure TLCD.HideCursor; -begin - if Enabled then begin - WriteCommand(12); - end; -end; - -procedure TLCD.AddTextBR(S: string); -var - Word: string; -// W: integer; - P: integer; - L: integer; -begin - if Enabled then begin - if LineBR <= 6 then begin - L := LineBR; - P := Pos(' ', S); - - if L <= 2 then - MoveCursor(L, 1); - - while (L <= 6) and (P > 0) do begin - Word := Copy(S, 1, P); - if (Length(Text[L]) + Length(Word)-1) > 16 then begin - L := L + 1; - if L <= 2 then - MoveCursor(L, 1); - end; - - if L <= 6 then begin - if L <= 2 then - WriteString(Word); - AddTextArray(L, Word); - end; - - Delete(S, 1, P); - P := Pos(' ', S) - end; - - LineBR := L + 1; - end; - end; -end; - -procedure TLCD.MoveCursorBR(Pos: integer); -{var - I: integer; - L: integer;} -begin - if Enabled then begin - Pos := Pos - (StartPos-1); - if Pos <= Length(Text[1]) then - MoveCursor(1, Pos); - - if Pos > Length(Text[1]) then begin - // bez zawijania -// Pos := Pos - Length(Text[1]); -// MoveCursor(2, Pos); - - // z zawijaniem - Pos := Pos - Length(Text[1]); - ScrollUpBR; - MoveCursor(1, Pos); - end; - end; -end; - -procedure TLCD.ScrollUpBR; -var - T: array[1..5] of string; - SP: integer; - LBR: integer; -begin - if Enabled then begin - T[1] := Text[2]; - T[2] := Text[3]; - T[3] := Text[4]; - T[4] := Text[5]; - T[5] := Text[6]; - SP := StartPos + Length(Text[1]); - LBR := LineBR; - - Clear; - - StartPos := SP; - WriteText(1, T[1]); - WriteText(2, T[2]); - WriteText(3, T[3]); - WriteText(4, T[4]); - WriteText(5, T[5]); - LineBR := LBR-1; - end; -end; - -procedure TLCD.AddTextArray(Line: integer; S: string); -begin - if Enabled then begin - Text[Line] := Text[Line] + S; - end; -end; - -end. - diff --git a/src/base/ULight.pas b/src/base/ULight.pas deleted file mode 100644 index b85a958a..00000000 --- a/src/base/ULight.pas +++ /dev/null @@ -1,170 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit ULight; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -type - TLight = class - private - Enabled: boolean; - Light: array[0..7] of boolean; - LightTime: array[0..7] of real; // time to stop, need to call update to change state - LastTime: real; - public - constructor Create; - procedure Enable; - procedure SetState(State: integer); - procedure AutoSetState; - procedure TurnOn; - procedure TurnOff; - procedure LightOne(Number: integer; Time: real); - procedure Refresh; - end; - -var - Light: TLight; - -const - Data = $378; // default port address - Status = Data + 1; - Control = Data + 2; - -implementation - -uses - SysUtils, - {$IFDEF UseSerialPort} - zlportio, - {$ENDIF} - UTime; - -{$IFDEF FPC} - - function GetTime: TDateTime; - var - SystemTime: TSystemTime; - begin - GetLocalTime(SystemTime); - with SystemTime do - begin - {$IFDEF UNIX} - Result := EncodeTime(Hour, Minute, Second, MilliSecond); - {$ELSE} - Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); - {$ENDIF} - end; - end; - -{$ENDIF} - - -constructor TLight.Create; -begin - inherited; - Enabled := false; -end; - -procedure TLight.Enable; -begin - Enabled := true; - LastTime := GetTime; -end; - -procedure TLight.SetState(State: integer); -begin - {$IFDEF UseSerialPort} - if Enabled then - PortWriteB($378, State); - {$ENDIF} -end; - -procedure TLight.AutoSetState; -var - State: integer; -begin - if Enabled then begin - State := 0; - if Light[0] then State := State + 2; - if Light[1] then State := State + 1; - // etc - SetState(State); - end; -end; - -procedure TLight.TurnOn; -begin - if Enabled then - SetState(3); -end; - -procedure TLight.TurnOff; -begin - if Enabled then - SetState(0); -end; - -procedure TLight.LightOne(Number: integer; Time: real); -begin - if Enabled then begin - if Light[Number] = false then begin - Light[Number] := true; - AutoSetState; - end; - - LightTime[Number] := GetTime + Time/1000; // [s] - end; -end; - -procedure TLight.Refresh; -var - Time: real; - L: integer; -begin - if Enabled then begin - Time := GetTime; - for L := 0 to 7 do begin - if Light[L] = true then begin - if LightTime[L] > Time then begin - end else begin - Light[L] := false; - end; - end; - end; - LastTime := Time; - AutoSetState; - end; -end; - -end. - - -- cgit v1.2.3 From 528d8cd40ec3763bb3018da4829803404d1cd04b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 9 Oct 2008 17:57:10 +0000 Subject: Errormessages during songload now translatable German and English translations updated Added four new language strings: ERROR_CORRUPT_SONG_FILE_NOT_FOUND ERROR_CORRUPT_SONG_NO_NOTES ERROR_CORRUPT_SONG_NO_BREAKS ERROR_CORRUPT_SONG_UNKNOWN_IN_LINE git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1443 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 19 +++++++++++++++---- 1 file changed, 15 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 47ac0a30..6c81cecc 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -130,6 +130,9 @@ type MultBPM : integer; LastError: String; + Function GetErrorLineNo: Integer; + Property ErrorLineNo: Integer read GetErrorLineNo; + constructor Create (); overload; constructor Create ( const aFileName : WideString ); overload; @@ -203,7 +206,7 @@ begin if not FileExists(Path + PathDelim + FileName) then begin - LastError := 'File not found'; + LastError := 'ERROR_CORRUPT_SONG_FILE_NOT_FOUND'; Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); exit; end; @@ -243,7 +246,7 @@ begin begin //Song File Corrupted - No Notes CloseFile(SongFile); Log.LogError('Could not load txt File, no Notes found: ' + FileName); - LastError := 'Can''t find any notes'; + LastError := 'ERROR_CORRUPT_SONG_NO_NOTES'; Exit; end; Read(SongFile, TempC); @@ -368,7 +371,7 @@ begin begin If (Length(Lines[I].Line) < 2) then begin - LastError := 'Can''t find any linebreaks'; + LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS'; Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); exit; end; @@ -395,7 +398,7 @@ begin end; - LastError := 'Error reading line ' + inttostr(FileLineNo); + LastError := 'ERROR_CORRUPT_SONG_ERROR_IN_LINE'; Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); exit; end; @@ -885,6 +888,14 @@ begin end; +Function TSong.GetErrorLineNo: Integer; +begin + If (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then + Result := FileLineNo + Else + Result := -1; +end; + procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); begin -- cgit v1.2.3 From 322b798413826681915eca1960f081cbc4dd302c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 13 Oct 2008 14:14:32 +0000 Subject: Abstraction of the menus background 5 different bg types: none(fallback), colored, texture, video, and fade(for overlays) Some sideeffect is 5 mb less memory usage, don't know for which reasons :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1446 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 64 +++++++++++++++++++++++++-------------------------- src/base/UThemes.pas | 42 ++++++++++++++++++++++++++++++--- 2 files changed, 71 insertions(+), 35 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index a624d14f..eea7db0b 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -767,39 +767,39 @@ begin end; procedure UnLoadScreens; +var I: Integer; 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 ); + ScreenMain.Destroy; + ScreenName.Destroy; + ScreenLevel.Destroy; + ScreenSong.Destroy; + ScreenSing.Destroy; + ScreenScore.Destroy; + ScreenTop5.Destroy; + ScreenOptions.Destroy; + ScreenOptionsGame.Destroy; + ScreenOptionsGraphics.Destroy; + ScreenOptionsSound.Destroy; + ScreenOptionsLyrics.Destroy; +// ScreenOptionsThemes.Destroy; + ScreenOptionsRecord.Destroy; + ScreenOptionsAdvanced.Destroy; + ScreenEditSub.Destroy; + ScreenEdit.Destroy; + ScreenEditConvert.Destroy; + ScreenOpen.Destroy; + ScreenSingModi.Destroy; + ScreenSongMenu.Destroy; + ScreenSongJumpto.Destroy; + ScreenPopupCheck.Destroy; + ScreenPopupError.Destroy; + ScreenPartyNewRound.Destroy; + ScreenPartyScore.Destroy; + ScreenPartyWin.Destroy; + ScreenPartyOptions.Destroy; + ScreenPartyPlayer.Destroy; + ScreenStatMain.Destroy; + ScreenStatDetail.Destroy; end; end. diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 3ee2798e..e5232c17 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -51,10 +51,29 @@ type R, G, B, A: Double; end; - TThemeBackground = record - Tex: string; +TThemeBackground = record + BGType: Byte; + Color: TRGB; + Tex: string; + Alpha: Real; end; +const + BGT_Names: Array [0..4] of String = ('none', 'color', 'texture', 'video', 'fade'); + BGT_None = 0; + BGT_Color = 1; + BGT_Texture = 2; + BGT_Video = 3; + BGT_Fade = 4; + BGT_Auto = 255; + //Defaul Background for Screens w/o Theme e.g. editor + DEFAULTBACKGROUND: TThemeBackground = (BGType: BGT_Color; + Color: (R:1; G:1; B:1); + Tex: ''; + Alpha: 1.0); + + +type TThemeStatic = record X: integer; Y: integer; @@ -1468,8 +1487,25 @@ begin end; procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); +var + BGType: String; + I: Integer; begin - ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); + BGType := lowercase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto')); + + ThemeBackground.BGType := BGT_Auto; + For I := 0 to high(BGT_Names) do + If (BGT_Names[I] = BGType) then + begin + ThemeBackground.BGType := I; + Break; + end; + + ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); + ThemeBackground.Color.R := ThemeIni.ReadFloat(Name + 'Background', 'ColR', 1); + ThemeBackground.Color.G := ThemeIni.ReadFloat(Name + 'Background', 'ColG', 1); + ThemeBackground.Color.B := ThemeIni.ReadFloat(Name + 'Background', 'ColB', 1); + ThemeBackground.Alpha := ThemeIni.ReadFloat(Name + 'Background', 'Alpha', 1); end; procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); -- cgit v1.2.3 From 68667a9069a53b2d427661d15fc1a6c3eeca110f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 18 Oct 2008 17:14:52 +0000 Subject: Error-log entry slightly changed for TTextureUnit.LoadTexture (" added) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1451 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTexture.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 83ff8239..0f0117ff 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -263,7 +263,7 @@ begin TexSurface := LoadImage(Identifier); if not assigned(TexSurface) then begin - Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"', + Log.LogError('Could not load texture: "' + Identifier +'" with type "'+ TextureTypeToStr(Typ) +'"', 'TTextureUnit.LoadTexture'); Exit; end; -- cgit v1.2.3 From ed4193810a054698f2620cff7c6e949325f5a33d Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 18 Oct 2008 18:00:13 +0000 Subject: - polish stuff removed - cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1452 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 39 +++++---------------------------------- 1 file changed, 5 insertions(+), 34 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 1c7788ef..a28543b8 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -326,7 +326,7 @@ begin GoldenStarPos := Rec.Left; //done - // srodkowa czesc - middle part + // middle part Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length @@ -340,7 +340,7 @@ begin glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // prawa czesc - right part + // right part Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; @@ -939,38 +939,9 @@ begin end; end; - // Draw Lyrics - ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); - - // todo: Lyrics -{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie - FS := 1.3; - BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start; - if BarFrom > 40 then BarFrom := 40; - if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more - (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem - (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie - BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom; - Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX; - Rec.Right := Rec.Left + 50; - Rec.Top := Skin_LyricsT + 3; - Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); - glBegin(GL_QUADS); - glColor4f(1, 1, 1, 0); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glColor4f(1, 1, 1, 0.5); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - glDisable(GL_BLEND); - end; - } + // Draw Lyrics + ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); + // TODO: Lyrics helper // oscilloscope | the thing that moves when you yell into your mic (imho) if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin -- cgit v1.2.3 From de23c24da37349de117bdb0fad972e30ee0534a4 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 18 Oct 2008 18:01:59 +0000 Subject: - unused (polish) constants and comments removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1453 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 9 --------- 1 file changed, 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index eea7db0b..1134333b 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -216,14 +216,6 @@ const 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; @@ -298,7 +290,6 @@ var R, G, B: real; Col: integer; begin - // zaladowanie tekstur Log.LogStatus('Loading Textures', 'LoadTextures'); Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? -- cgit v1.2.3 From e60c0d3e29be2c77e7ab8deca6c37d0b07ebf085 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 18 Oct 2008 21:13:16 +0000 Subject: style adjustments. no code change. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1456 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 215 +++++++++++++++++++++++++++------------------------ 1 file changed, 115 insertions(+), 100 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index e5232c17..3f00ce52 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -52,14 +52,14 @@ type end; TThemeBackground = record - BGType: Byte; + BGType: byte; Color: TRGB; Tex: string; - Alpha: Real; + Alpha: real; end; const - BGT_Names: Array [0..4] of String = ('none', 'color', 'texture', 'video', 'fade'); + BGT_Names: array [0..4] of string = ('none', 'color', 'texture', 'video', 'fade'); BGT_None = 0; BGT_Color = 1; BGT_Texture = 2; @@ -92,7 +92,7 @@ type TexY2: real; //Reflection Reflection: boolean; - Reflectionspacing: Real; + Reflectionspacing: real; end; AThemeStatic = array of TThemeStatic; @@ -111,7 +111,7 @@ type Text: string; //Reflection Reflection: boolean; - ReflectionSpacing: Real; + ReflectionSpacing: real; end; AThemeText = array of TThemeText; @@ -119,7 +119,7 @@ type Text: AThemeText; X: integer; Y: integer; - Z: Real; + Z: real; W: integer; H: integer; Color: string; @@ -135,29 +135,29 @@ type Tex: string; Typ: TTextureType; - Visible: Boolean; + Visible: boolean; //Reflection Mod Reflection: boolean; - Reflectionspacing: Real; + Reflectionspacing: real; //Fade Mod SelectH: integer; SelectW: integer; Fade: boolean; FadeText: boolean; - DeSelectReflectionspacing : Real; + DeSelectReflectionspacing : real; FadeTex: string; FadeTexPos: integer; //Button Collection Mod - Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement + Parent: byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement end; //Button Collection Mod TThemeButtonCollection = record Style: TThemeButton; - ChildCount: Byte; //No of assigned Childs - FirstChild: Byte; //No of Child on whose Interaction Position the Button should be + ChildCount: byte; //No of assigned Childs + FirstChild: byte; //No of Child on whose Interaction Position the Button should be end; AThemeButtonCollection = array of TThemeButtonCollection; @@ -172,8 +172,8 @@ type H: integer; Z: real; - TextSize: integer; - + TextSize: integer; + //SBGW Mod SBGW: integer; @@ -190,20 +190,20 @@ type end; TThemeEqualizer = record - Visible: Boolean; - Direction: Boolean; + Visible: boolean; + Direction: boolean; Alpha: real; - X: Integer; - Y: Integer; - Z: Real; - W: Integer; - H: Integer; - Space: Integer; - Bands: Integer; - Length: Integer; - ColR, ColG, ColB: Real; + X: integer; + Y: integer; + Z: real; + W: integer; + H: integer; + Space: integer; + Bands: integer; + Length: integer; + ColR, ColG, ColB: real; Reflection: boolean; - Reflectionspacing: Real; + Reflectionspacing: real; end; PThemeBasic = ^TThemeBasic; @@ -259,13 +259,13 @@ type //Cover Mod Cover: record - Reflections: Boolean; - X: Integer; - Y: Integer; - Z: Integer; - W: Integer; - H: Integer; - Style: Integer; + Reflections: boolean; + X: integer; + Y: integer; + Z: integer; + W: integer; + H: integer; + Style: integer; end; //Equalizer Mod @@ -349,7 +349,7 @@ type TextP3RScore: TThemeText; //Linebonus Translations - LineBonusText: Array [0..8] of String; + LineBonusText: array [0..8] of string; //Pause Popup PausePopUp: TThemeStatic; @@ -428,7 +428,7 @@ type SelectFullscreen: TThemeSelectSlide; SelectResolution: TThemeSelectSlide; SelectDepth: TThemeSelectSlide; - SelectVisualizer: TThemeSelectSlide; + SelectVisualizer: TThemeSelectSlide; SelectOscilloscope: TThemeSelectSlide; SelectLineBonus: TThemeSelectSlide; SelectMovieSize: TThemeSelectSlide; @@ -511,10 +511,10 @@ type TextFound: TThemeText; //Translated Texts - Songsfound: String; - NoSongsfound: String; - CatText: String; - IType: array [0..2] of String; + Songsfound: string; + NoSongsfound: string; + CatText: string; + IType: array [0..2] of string; end; //Party Screens @@ -556,7 +556,7 @@ type TextTeam1Players: TThemeText; TextTeam2Players: TThemeText; TextTeam3Players: TThemeText; - + StaticTeam1: TThemeStatic; StaticTeam2: TThemeStatic; StaticTeam3: TThemeStatic; @@ -583,19 +583,19 @@ type StaticTeam3Deco: TThemeStatic; DecoTextures: record - ChangeTextures: Boolean; + ChangeTextures: boolean; - FirstTexture: String; + FirstTexture: string; FirstTyp: TTextureType; - FirstColor: String; + FirstColor: string; - SecondTexture: String; + SecondTexture: string; SecondTyp: TTextureType; - SecondColor: String; + SecondColor: string; - ThirdTexture: String; + ThirdTexture: string; ThirdTyp: TTextureType; - ThirdColor: String; + ThirdColor: string; end; @@ -683,7 +683,7 @@ type Description: array[0..3] of string; DescriptionR: array[0..3] of string; FormatStr: array[0..3] of string; - PageStr: String; + PageStr: string; end; //Playlist Translations @@ -738,7 +738,7 @@ type Playlist: TThemePlaylist; - ILevel: array[0..2] of String; + ILevel: array[0..2] of string; constructor Create(FileName: string); overload; // Initialize theme system constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color @@ -775,9 +775,9 @@ type end; procedure glColorRGB(Color: TRGB); overload; -procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +procedure glColorRGB(Color: TRGB; Alpha: real); overload; procedure glColorRGB(Color: TRGBA); overload; -procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; +procedure glColorRGB(Color: TRGBA; Alpha: real); overload; function ColorExists(Name: string): integer; procedure LoadColor(var R, G, B: real; ColorName: string); @@ -808,7 +808,7 @@ begin glColor3f(Color.R, Color.G, Color.B); end; -procedure glColorRGB(Color: TRGB; Alpha: Real); overload; +procedure glColorRGB(Color: TRGB; Alpha: real); overload; begin glColor4f(Color.R, Color.G, Color.B, Alpha); end; @@ -818,12 +818,11 @@ begin glColor4f(Color.R, Color.G, Color.B, Color.A); end; -procedure glColorRGB(Color: TRGBA; Alpha: Real); overload; +procedure glColorRGB(Color: TRGBA; Alpha: real); overload; begin glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); end; - constructor TTheme.Create(FileName: string); begin Create(FileName, 0); @@ -870,7 +869,6 @@ begin end; - function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; var I: integer; @@ -879,7 +877,7 @@ begin Result := false; create_theme_objects(); - + Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); FileName := AdaptFilePaths(FileName); @@ -1109,7 +1107,8 @@ begin ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle'); - for I := 1 to 6 do begin + for I := 1 to 6 do + begin ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text'); @@ -1138,7 +1137,7 @@ begin // Top5 ThemeLoadBasic(Top5, 'Top5'); - + ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); @@ -1488,14 +1487,14 @@ end; procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); var - BGType: String; - I: Integer; + BGType: string; + I: integer; begin BGType := lowercase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto')); ThemeBackground.BGType := BGT_Auto; - For I := 0 to high(BGT_Names) do - If (BGT_Names[I] = BGType) then + for I := 0 to high(BGT_Names) do + if (BGT_Names[I] = BGType) then begin ThemeBackground.BGType := I; Break; @@ -1510,7 +1509,7 @@ end; procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); var - C: integer; + C: integer; begin ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); @@ -1534,7 +1533,8 @@ begin ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); C := ColorExists(ThemeText.Color); - if C >= 0 then begin + if C >= 0 then + begin ThemeText.ColR := Color[C].RGB.R; ThemeText.ColG := Color[C].RGB.G; ThemeText.ColB := Color[C].RGB.B; @@ -1543,10 +1543,11 @@ end; procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string); var - T: integer; + T: integer; begin T := 1; - while ThemeIni.SectionExists(Name + IntToStr(T)) do begin + while ThemeIni.SectionExists(Name + IntToStr(T)) do + begin SetLength(ThemeText, T); ThemeLoadText(ThemeText[T-1], Name + IntToStr(T)); Inc(T); @@ -1555,7 +1556,7 @@ end; procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); var - C: integer; + C: integer; begin ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', ''); @@ -1569,7 +1570,8 @@ begin ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); C := ColorExists(ThemeStatic.Color); - if C >= 0 then begin + if C >= 0 then + begin ThemeStatic.ColR := Color[C].RGB.R; ThemeStatic.ColG := Color[C].RGB.G; ThemeStatic.ColB := Color[C].RGB.B; @@ -1587,10 +1589,11 @@ end; procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); var - S: integer; + S: integer; begin S := 1; - while ThemeIni.SectionExists(Name + IntToStr(S)) do begin + while ThemeIni.SectionExists(Name + IntToStr(S)) do + begin SetLength(ThemeStatic, S); ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S)); Inc(S); @@ -1599,7 +1602,7 @@ end; //Button Collection Mod procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); -var T: Integer; +var T: integer; begin //Load Collection Style ThemeLoadButton(Collection.Style, Name); @@ -1614,10 +1617,11 @@ end; procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); var - I: integer; + I: integer; begin I := 1; - while ThemeIni.SectionExists(Name + IntToStr(I)) do begin + while ThemeIni.SectionExists(Name + IntToStr(I)) do + begin SetLength(Collections, I); ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I)); Inc(I); @@ -1627,9 +1631,9 @@ end; procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection); var - C: integer; - TLen: integer; - T: integer; + C: integer; + TLen: integer; + T: integer; Collections2: PAThemeButtonCollection; begin if not ThemeIni.SectionExists(Name) then @@ -1660,7 +1664,8 @@ begin ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', ''); C := ColorExists(ThemeButton.Color); - if C >= 0 then begin + if C >= 0 then + begin ThemeButton.ColR := Color[C].RGB.R; ThemeButton.ColG := Color[C].RGB.G; ThemeButton.ColB := Color[C].RGB.B; @@ -1668,7 +1673,8 @@ begin ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', ''); C := ColorExists(ThemeButton.DColor); - if C >= 0 then begin + if C >= 0 then + begin ThemeButton.DColR := Color[C].RGB.R; ThemeButton.DColG := Color[C].RGB.G; ThemeButton.DColB := Color[C].RGB.B; @@ -1717,7 +1723,7 @@ end; procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); var - C: integer; + C: integer; begin ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); @@ -1759,7 +1765,7 @@ begin end; procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; Name: string); -var I: Integer; +var I: integer; begin ThemeEqualizer.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 0) = 1); ThemeEqualizer.Direction := (ThemeIni.ReadInteger(Name, 'Direction', 0) = 1); @@ -1777,12 +1783,14 @@ begin //Color I := ColorExists(ThemeIni.ReadString(Name, 'Color', 'Black')); - if I >= 0 then begin + if I >= 0 then + begin ThemeEqualizer.ColR := Color[I].RGB.R; ThemeEqualizer.ColG := Color[I].RGB.G; ThemeEqualizer.ColB := Color[I].RGB.B; end - else begin + else + begin ThemeEqualizer.ColR := 0; ThemeEqualizer.ColG := 0; ThemeEqualizer.ColB := 0; @@ -1791,18 +1799,19 @@ end; procedure TTheme.LoadColors; var - SL: TStringList; - C: integer; - S: string; - Col: integer; - RGB: TRGB; + SL: TStringList; + C: integer; + S: string; + Col: integer; + RGB: TRGB; begin SL := TStringList.Create; ThemeIni.ReadSection('Colors', SL); // normal colors SetLength(Color, SL.Count); - for C := 0 to SL.Count-1 do begin + for C := 0 to SL.Count-1 do + begin Color[C].Name := SL.Strings[C]; S := ThemeIni.ReadString('Colors', SL.Strings[C], ''); @@ -1917,19 +1926,21 @@ end; function ColorExists(Name: string): integer; var - C: integer; + C: integer; begin Result := -1; for C := 0 to High(Color) do - if Color[C].Name = Name then Result := C; + if Color[C].Name = Name then + Result := C; end; procedure LoadColor(var R, G, B: real; ColorName: string); var - C: integer; + C: integer; begin C := ColorExists(ColorName); - if C >= 0 then begin + if C >= 0 then + begin R := Color[C].RGB.R; G := Color[C].RGB.G; B := Color[C].RGB.B; @@ -2011,7 +2022,7 @@ end; procedure TTheme.ThemeSave(FileName: string); var - I: integer; + I: integer; begin {$IFDEF THEMESAVE} ThemeIni := TIniFile.Create(FileName); @@ -2101,7 +2112,8 @@ begin ThemeSaveText(Score.TextArtist, 'ScoreTextArtist'); ThemeSaveText(Score.TextTitle, 'ScoreTextTitle'); - for I := 1 to 6 do begin + for I := 1 to 6 do + begin ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); @@ -2146,7 +2158,8 @@ procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: st begin if ThemeBackground.Tex <> '' then ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) - else begin + else + begin ThemeIni.EraseSection(Name); end; end; @@ -2170,7 +2183,7 @@ end; procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); var - S: integer; + S: integer; begin for S := 0 to Length(ThemeStatic)-1 do ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1)); @@ -2196,7 +2209,7 @@ end; procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string); var - T: integer; + T: integer; begin for T := 0 to Length(ThemeText)-1 do ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1)); @@ -2206,7 +2219,7 @@ end; procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string); var - T: integer; + T: integer; begin ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex); ThemeIni.WriteInteger(Name, 'X', ThemeButton.X); @@ -2228,14 +2241,16 @@ begin ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);} { C := ColorExists(ThemeIni.ReadString(Name, 'Color', '')); - if C >= 0 then begin + if C >= 0 then + begin ThemeButton.ColR := Color[C].RGB.R; ThemeButton.ColG := Color[C].RGB.G; ThemeButton.ColB := Color[C].RGB.B; end; C := ColorExists(ThemeIni.ReadString(Name, 'DColor', '')); - if C >= 0 then begin + if C >= 0 then + begin ThemeButton.DColR := Color[C].RGB.R; ThemeButton.DColG := Color[C].RGB.G; ThemeButton.DColB := Color[C].RGB.B; -- cgit v1.2.3 From 6edda5db659a67a119b3469ad92080e168ed2944 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 19 Oct 2008 11:36:41 +0000 Subject: offscreen rendering removed: - fixes zoom errors - fixes missing lyric lines if window is too small - better text quality - fixes some other errors git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1457 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 150 ++-------- src/base/UGraphic.pas | 12 +- src/base/ULyrics.pas | 765 ++++++++++++++++++++------------------------------ 3 files changed, 331 insertions(+), 596 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 8569fadf..03351adf 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -37,7 +37,6 @@ uses gl, SDL, UTexture, -// SDL_ttf, ULog; procedure BuildFont; // build our bitmap font @@ -45,6 +44,7 @@ procedure KillFont; // delete the font function glTextWidth(text: PChar): real; // returns text width procedure glPrintLetter(letter: char); procedure glPrint(text: pchar); // custom GL "Print" routine +procedure ResetFont(); // reset font settings of active font procedure SetFontPos(X, Y: real); // sets X and Y procedure SetFontZ(Z: real); // sets Z procedure SetFontSize(Size: real); @@ -209,13 +209,19 @@ function glTextWidth(text: pchar): real; var Letter: char; i: integer; + Font: PFont; begin Result := 0; + Font := @Fonts[ActFont]; + for i := 0 to Length(text) -1 do begin Letter := Text[i]; - Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW; + Result := Result + Font.Width[Ord(Letter)] * Font.Tex.H / 30 * Font.AspectW; end; + + if ((Result > 0) and Font.Italic) then + Result := Result + 12 * Font.Tex.H / 60 * Font.AspectW; end; procedure glPrintLetter(Letter: char); @@ -332,6 +338,14 @@ begin end; end; +procedure ResetFont(); +begin + SetFontPos(0, 0); + SetFontZ(0); + SetFontItalic(False); + SetFontReflection(False, 0); +end; + procedure SetFontPos(X, Y: real); begin Fonts[ActFont].Tex.X := X; @@ -374,136 +388,4 @@ begin Fonts[ActFont].Blend := Enable; end; - - - -(* - I uncommented this, because it was some kind of after hour hack together with blindy -it's actually just a prove of concept, as it's having some flaws -- instead nice and clean ttf code should be placed here :) - -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} - -function NextPowerOfTwo(Value: integer): integer; -begin - Result:= 1; -{$IF Defined(CPUX86_64)} - asm - mov rcx, -1 - bsr rcx, Value - inc rcx - shl Result, cl - end; -{$ELSEIF Defined(CPU386) or Defined(CPUI386)} - asm - mov ecx, -1 - bsr ecx, Value - inc ecx - shl Result, cl - end; -{$ELSE} - while (Result <= Value) do - Result := 2 * Result; -{$IFEND} -end; - -function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; -begin - if (FileExists(FileName)) then - begin - Result := TTF_OpenFont( FileName, PointSize ); - end - else - begin - Log.LogStatus('ERROR Could not find font in ' + FileName , ''); - ShowMessage( 'ERROR Could not find font in ' + FileName ); - Result := nil; - end; -end; - -function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface; -var - clr : TSDL_color; -begin - clr.r := ((Color and $ff0000) shr 16 ) div 255; - clr.g := ((Color and $ff00 ) shr 8 ) div 255; - clr.b := ( Color and $ff ) div 255 ; - - result := TTF_RenderText_Blended( font, text, cLr); -end; - -procedure printrandomtext(); -var - stext,intermediary : PSDL_surface; - clrFg, clrBG : TSDL_color; - texture : Gluint; - font : PTTF_Font; - w,h : integer; -begin - - font := LoadFont('fonts\comicbd.ttf', 42); - - clrFg.r := 255; - clrFg.g := 255; - clrFg.b := 255; - clrFg.unused := 255; - - clrBg.r := 255; - clrbg.g := 0; - clrbg.b := 255; - clrbg.unused := 0; - - sText := RenderText(font, 'katzeeeeeee', $fe198e); - //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG); - - // Convert the rendered text to a known format - w := nextpoweroftwo(sText.w); - h := nextpoweroftwo(sText.h); - - intermediary := SDL_CreateRGBSurface(0, w, h, 32, - $000000ff, $0000ff00, $00ff0000, $ff000000); - - SDL_SetAlpha(intermediary, 0, 255); - SDL_SetAlpha(sText, 0, 255); - SDL_BlitSurface(sText, nil, intermediary, nil); - - glGenTextures(1, @texture); - - glBindTexture(GL_TEXTURE_2D, texture); - - glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels); -// on big endian machines (powerpc) this may need to be changed to -// Needs to be tests. KaMiSchi Sept 2008 -// glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, intermediary.pixels); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_BLEND); - glBindTexture(GL_TEXTURE_2D, texture); - glColor4f(1, 0, 1, 1); - - glbegin(gl_quads); - glTexCoord2f(0, 0); glVertex2f(200 , 300 ); - glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h); - glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h); - glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 ); - glEnd; - glfinish(); - glDisable(GL_BLEND); - gldisable(gl_texture_2d); - - SDL_FreeSurface(sText); - SDL_FreeSurface(intermediary); - glDeleteTextures(1, @texture); - TTF_CloseFont(font); - -end; -*) - - end. diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 1134333b..a6620c0d 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -232,7 +232,17 @@ const Skin_OscG = 0; Skin_OscB = 0; - Skin_LyricsT = 494; // 500 / 510 / 400 + // TODO: add to theme ini file + Skin_LyricsT = 493; + Skin_LyricsUpperX = 80; + Skin_LyricsUpperW = 640; + Skin_LyricsUpperY = Skin_LyricsT; + Skin_LyricsUpperH = 41; + Skin_LyricsLowerX = 80; + Skin_LyricsLowerW = 640; + Skin_LyricsLowerY = Skin_LyricsT + Skin_LyricsUpperH + 1; + Skin_LyricsLowerH = 41; + Skin_SpectrumT = 470; Skin_SpectrumBot = 570; Skin_SpectrumH = 100; diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index 46354cbe..ece9f1d4 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -44,32 +44,31 @@ type // stores two textures for enabled/disabled states TPlayerIconTex = array [0..1] of TTexture; + TLyricsEffect = (lfxSimple, lfxZoom, lfxSlide, lfxBall, lfxShift); + PLyricWord = ^TLyricWord; TLyricWord = record - X: Real; // left corner - Width: Real; // width - Start: Cardinal; // start of the word in quarters (beats) - Length: Cardinal; // length of the word in quarters - Text: String; // text - Freestyle: Boolean; // is freestyle? + X: real; // left corner + Width: real; // width + Start: cardinal; // start of the word in quarters (beats) + Length: cardinal; // length of the word in quarters + Text: string; // text + Freestyle: boolean; // is freestyle? end; - ALyricWord = array of TLyricWord; + TLyricWordArray = array of TLyricWord; TLyricLine = class public - Text: String; // text - Tex: glUInt; // texture of the text - Width: Real; // width - Size: Byte; // fontsize - Words: ALyricWord; // words in this line - CurWord: Integer; // current active word idx (only valid if line is active) - Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap) - StartNote: Integer; // start of the first note of this line in quarters - Length: Integer; // length in quarters (from start of first to the end of the last note) - HasFreestyle: Boolean; // one or more word are freestyle? - CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line - Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) - LastLine: Boolean; // is this the last line of the song? + Text: string; // text + Width: real; // width + Height: real; // height + Words: TLyricWordArray; // words in this line + CurWord: integer; // current active word idx (only valid if line is active) + Start: integer; // start of this line in quarters (Note: negative start values are possible due to gap) + StartNote: integer; // start of the first note of this line in quarters + Length: integer; // length in quarters (from start of first to the end of the last note) + Players: byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) + LastLine: boolean; // is this the last line of the song? constructor Create(); destructor Destroy(); override; @@ -78,7 +77,7 @@ type TLyricEngine = class private - LastDrawBeat: Real; + LastDrawBeat: real; UpperLine: TLyricLine; // first line displayed (top) LowerLine: TLyricLine; // second lind displayed (bottom) QueueLine: TLyricLine; // third line (will be displayed when lower line is finished) @@ -86,80 +85,79 @@ type IndicatorTex: TTexture; // texture for lyric indikator BallTex: TTexture; // texture of the ball for the lyric effect - QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine - LCounter: Word; // line counter + QueueFull: boolean; // set to true if the queue is full and a line will be replaced with the next AddLine + LCounter: integer; // line counter // duet mode - textures for player icons // FIXME: do not use a fixed player count, use MAX_PLAYERS instead PlayerIconTex: array[0..5] of TPlayerIconTex; - //Some helper Procedures for Lyric Drawing - procedure DrawLyrics (Beat: Real); - procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); - procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); - procedure DrawBall(XBall, YBall, Alpha:Real); + // Some helper procedures for lyric drawing + procedure DrawLyrics (Beat: real); + procedure UpdateLineMetrics(LyricLine: TLyricLine); + procedure DrawLyricsWords(LyricLine: TLyricLine; X, Y: real; StartWord, EndWord: integer); + procedure DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real); + procedure DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real); + procedure DrawBall(XBall, YBall, Alpha: real); public // positions, line specific settings - UpperLineX: Real; //X Start Pos of UpperLine - UpperLineW: Real; //Width of UpperLine with Icon(s) and Text - UpperLineY: Real; //Y Start Pos of UpperLine - UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine + UpperLineX: real; // X start-pos of UpperLine + UpperLineW: real; // Width of UpperLine with icon(s) and text + UpperLineY: real; // Y start-pos of UpperLine + UpperLineH: real; // Max. font-size of lyrics text in UpperLine - LowerLineX: Real; //X Start Pos of LowerLine - LowerLineW: Real; //Width of LowerLine with Icon(s) and Text - LowerLineY: Real; //Y Start Pos of LowerLine - LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine + LowerLineX: real; // X start-pos of LowerLine + LowerLineW: real; // Width of LowerLine with icon(s) and text + LowerLineY: real; // Y start-pos of LowerLine + LowerLineH: real; // Max. font-size of lyrics text in LowerLine // display propertys - LineColor_en: TRGBA; //Color of Words in an Enabled Line - LineColor_dis: TRGBA; //Color of Words in a Disabled Line - LineColor_act: TRGBA; //Color of teh active Word - FontStyle: Byte; //Font for the Lyric Text - FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen + LineColor_en: TRGBA; // Color of words in an enabled line + LineColor_dis: TRGBA; // Color of words in a disabled line + LineColor_act: TRGBA; // Color of the active word + FontStyle: byte; // Font for the lyric text { // currently not used - FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos - FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards + FadeInEffect: byte; // Effect for line fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos + FadeOutEffect: byte; // Effect for line fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards } - UseLinearFilter: Boolean; //Should Linear Tex Filter be used - // song specific settings - BPM: Real; - Resolution: Integer; + BPM: real; + Resolution: integer; // properties to easily read options of this class - property IsQueueFull: Boolean read QueueFull; // line in queue? - property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear) + property IsQueueFull: boolean read QueueFull; // line in queue? + property LineCounter: integer read LCounter; // lines that were progressed so far (after last clear) procedure AddLine(Line: PLine); // adds a line to the queue, if there is space - procedure Draw (Beat: Real); // draw the current (active at beat) lyrics + procedure Draw (Beat: real); // draw the current (active at beat) lyrics // clears all cached song specific information - procedure Clear(cBPM: Real = 0; cResolution: Integer = 0); + procedure Clear(cBPM: real = 0; cResolution: integer = 0); function GetUpperLine(): TLyricLine; function GetLowerLine(): TLyricLine; - function GetUpperLineIndex(): Integer; + function GetUpperLineIndex(): integer; - constructor Create; overload; - constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload; + constructor Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real); procedure LoadTextures; destructor Destroy; override; end; implementation -uses SysUtils, - USkins, - TextGL, - UGraphic, - UDisplay, - ULog, - math, - UIni; +uses + SysUtils, + USkins, + TextGL, + UGraphic, + UDisplay, + ULog, + math, + UIni; { TLyricLine } @@ -190,20 +188,17 @@ begin SetLength(Words, 0); CurWord := -1; - - HasFreestyle := False; - CountFreestyle := 0; end; { TLyricEngine } -//--------------- -// Create - Constructor, just get Memory -//--------------- -constructor TLyricEngine.Create; +{** + * Initializes the engine. + *} +constructor TLyricEngine.Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real); begin - inherited; + inherited Create(); BPM := 0; Resolution := 0; @@ -214,31 +209,25 @@ begin LowerLine := TLyricLine.Create; QueueLine := TLyricLine.Create; - UseLinearFilter := True; LastDrawBeat := 0; -end; -constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); -begin - Create; - UpperLineX := ULX; UpperLineW := ULW; UpperLineY := ULY; - UpperLineSize := Trunc(ULS); + UpperLineH := ULH; LowerLineX := LLX; LowerLineW := LLW; LowerLineY := LLY; - LowerLineSize := Trunc(LLS); + LowerLineH := LLH; LoadTextures; end; -//--------------- -// Destroy - Frees Memory -//--------------- +{** + * Frees memory. + *} destructor TLyricEngine.Destroy; begin UpperLine.Free; @@ -247,10 +236,10 @@ begin inherited; end; -//--------------- -// Clear - Clears all cached Song specific Information -//--------------- -procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer); +{** + * Clears all cached Song specific Information. + *} +procedure TLyricEngine.Clear(cBPM: real; cResolution: integer); begin BPM := cBPM; Resolution := cResolution; @@ -261,31 +250,14 @@ begin end; -//--------------- -// LoadTextures - Load Player Textures and Create Lyric Textures -//--------------- +{** + * Loads textures needed for the drawing the lyrics, + * player icons, a ball for the ball effect and the lyric indicator. + *} procedure TLyricEngine.LoadTextures; var I: Integer; - - function CreateLineTex: glUint; - begin - // generate and bind Texture - glGenTextures(1, @Result); - glBindTexture(GL_TEXTURE_2D, Result); - - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - if UseLinearFilter then - begin - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - end; - end; - begin - // lyric indicator (bar that indicates when the line start) IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); @@ -298,42 +270,21 @@ begin PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); end; - - // create line textures - UpperLine.Tex := CreateLineTex; - LowerLine.Tex := CreateLineTex; - QueueLine.Tex := CreateLineTex; end; - -//--------------- -// AddLine - Adds LyricLine to queue -// The LyricEngine stores three lines in its queue: -// UpperLine: the upper line displayed in the lyrics -// LowerLine: the lower line displayed in the lyrics -// QueueLine: an offscreen line that precedes LowerLine -// If the queue is full the next call to AddLine will replace UpperLine with -// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. -//--------------- +{** + * Adds LyricLine to queue. + * The LyricEngine stores three lines in its queue: + * UpperLine: the upper line displayed in the lyrics + * LowerLine: the lower line displayed in the lyrics + * QueueLine: an offscreen line that precedes LowerLine + * If the queue is full the next call to AddLine will replace UpperLine with + * LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. + *} procedure TLyricEngine.AddLine(Line: PLine); var LyricLine: TLyricLine; - PosX: Real; - I: Integer; - CurWord: PLyricWord; - RenderPass: Integer; - - function CalcWidth(LyricLine: TLyricLine): Real; - begin - Result := glTextWidth(PChar(LyricLine.Text)); - - Result := Result + (LyricLine.CountFreestyle * 10); - - // if the line ends with a freestyle not, then leave the place to finish to draw the text italic - if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then - Result := Result + 12; - end; - + I: integer; begin // only add lines, if there is space if not IsQueueFull then @@ -352,7 +303,7 @@ begin end else begin // rotate lines (round-robin-like) - LyricLine := UpperLine; + LyricLine := UpperLine; UpperLine := LowerLine; LowerLine := QueueLine; QueueLine := LyricLine; @@ -381,160 +332,42 @@ begin LyricLine.Words[I].Text := Line.Note[I].Text; LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle; - LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle; - LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; - - if (I > 0) and - LyricLine.Words[I-1].Freestyle and - not LyricLine.Words[I].Freestyle then - begin - Inc(LyricLine.CountFreestyle); - end; - end; - - // set font params - SetFontStyle(FontStyle); - SetFontPos(0, 0); - LyricLine.Size := UpperLineSize; - SetFontSize(LyricLine.Size); - SetFontItalic(False); - SetFontReflection(False, 0); - glColor4f(1, 1, 1, 1); - - // change fontsize to fit the screen - LyricLine.Width := CalcWidth(LyricLine); - while (LyricLine.Width > UpperLineW) do - begin - Dec(LyricLine.Size); - - if (LyricLine.Size <=1) then - Break; - - SetFontSize(LyricLine.Size); - LyricLine.Width := CalcWidth(LyricLine); + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; end; - // Offscreen rendering of LyricTexture: - // First we will create a white transparent background to draw on. - // If the text was simply drawn to the screen with blending, the translucent - // parts of the text would be merged with the current color of the background. - // This would result in a texture that partly contains the screen we are - // drawing on. This will be visible in the fonts outline when the LyricTexture - // is drawn to the screen later. - // So we have to draw the text in TWO passes. - // At the first pass we copy the characters to the back-buffer in such a way - // that preceding characters are not repainted by following chars (otherwise - // some characters would be blended twice in the 2nd pass). - // To achieve this we disable blending and enable the depth-test. The z-buffer - // is used as a mask or replacement for the missing stencil-buffer. A z-value - // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel - // that was already drawn on. In addition we set the depth-func in such a way - // that assigned pixels (0) will not be drawn a second time. - // At the second pass we draw the text with blending and without depth-test. - // This will blend overlapping characters but not the background as it was - // repainted in the first pass. - - glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT); - glViewPort(0, 0, 800, 600); - glClearColor(0, 0, 0, 0); - glDepthRange(0, 1); - glClearDepth(1); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - - SetFontZ(0); - - // assure blending is off and the correct depth-func is enabled - glDisable(GL_BLEND); - glDepthFunc(GL_LESS); - - // we need two passes to draw the font onto the screen. - for RenderPass := 0 to 1 do - begin - if (RenderPass = 0) then - begin - // first pass: simply copy each character to the screen without overlapping. - SetFontBlend(false); - glEnable(GL_DEPTH_TEST); - end - else - begin - // second pass: now we will blend overlapping characters. - SetFontBlend(true); - glDisable(GL_DEPTH_TEST); - end; - - PosX := 0; - - // set word positions and line size and draw the line to the back-buffer - for I := 0 to High(LyricLine.Words) do - begin - CurWord := @LyricLine.Words[I]; - - SetFontItalic(CurWord.Freestyle); - - CurWord.X := PosX; - - // Draw Lyrics - SetFontPos(PosX, 0); - glPrint(PChar(CurWord.Text)); - - CurWord.Width := glTextWidth(PChar(CurWord.Text)); - if CurWord.Freestyle then - begin - if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then - CurWord.Width := CurWord.Width + 10 - else if (I = High(LyricLine.Words)) then - CurWord.Width := CurWord.Width + 12; - end; - PosX := PosX + CurWord.Width; - end; - end; - - // copy back-buffer to texture - glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); - // FIXME: this does not work this way - glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); - if (glGetError() <> GL_NO_ERROR) then - Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine'); - - // restore OpenGL state - glPopAttrib(); - - // clear buffer (use white to avoid flimmering if no cover/video is available) - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); - end; // if (Line <> nil) and (Length(Line.Note) > 0) + UpdateLineMetrics(LyricLine); + end; // increase the counter Inc(LCounter); end; - -//--------------- -// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters -// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics -//--------------- -procedure TLyricEngine.Draw(Beat: Real); +{** + * Draws Lyrics. + * Draw just manages the Lyrics, drawing is done by a call of DrawLyrics. + * @param Beat: current Beat in Quarters + *} +procedure TLyricEngine.Draw(Beat: real); begin DrawLyrics(Beat); LastDrawBeat := Beat; end; -//--------------- -// DrawLyrics(private) - Helper for Draw; main Drawing procedure -//--------------- -procedure TLyricEngine.DrawLyrics(Beat: Real); +{** + * Main Drawing procedure. + *} +procedure TLyricEngine.DrawLyrics(Beat: real); begin - DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat); + DrawLyricsLine(UpperLineX, UpperLineW, UpperLineY, UpperLineH, UpperLine, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerLineY, LowerLineH, LowerLine, Beat); end; -//--------------- -// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon -//--------------- -procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real); +{** + * Draws a Player's icon. + *} +procedure TLyricEngine.DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real); var - IEnabled: Byte; + IEnabled: byte; begin if Enabled then IEnabled := 0 @@ -558,10 +391,10 @@ begin glDisable(GL_TEXTURE_2D); end; -//--------------- -// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed -//--------------- -procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real); +{** + * Draws the Ball over the LyricLine if needed. + *} +procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: real); begin glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); @@ -580,41 +413,122 @@ begin glDisable(GL_TEXTURE_2D); end; -//--------------- -// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine -//--------------- -procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real); +procedure TLyricEngine.DrawLyricsWords(LyricLine: TLyricLine; + X, Y: real; StartWord, EndWord: integer); var - CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence - FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics - Progress: Real; // progress of singing the current word - LyricX: Real; // left - LyricX2: Real; // right - LyricY: Real; // top - LyricsHeight: Real; // height the lyrics are displayed - Alpha: Real; // alphalevel to fade out at end - CurWord, LastWord: PLyricWord; // current word + I: integer; + PosX: real; + CurWord: PLyricWord; +begin + PosX := X; + + // set word positions and line size and draw the line + for I := StartWord to EndWord do + begin + CurWord := @LyricLine.Words[I]; + SetFontItalic(CurWord.Freestyle); + SetFontPos(PosX, Y); + glPrint(PChar(CurWord.Text)); + PosX := PosX + CurWord.Width; + end; +end; +procedure TLyricEngine.UpdateLineMetrics(LyricLine: TLyricLine); +var + I: integer; + PosX: real; + CurWord: PLyricWord; + RequestWidth, RequestHeight: real; +begin + PosX := 0; + + // setup font + SetFontStyle(FontStyle); + ResetFont(); + + // check if line is lower or upper line and set sizes accordingly + // Note: at the moment upper and lower lines have same width/height + // and this function is just called by AddLine() but this may change + // so that it is called by DrawLyricsLine(). + //if (LyricLine = LowerLine) then + //begin + // RequestWidth := LowerLineW; + // RequestHeight := LowerLineH; + //end + //else + //begin + RequestWidth := UpperLineW; + RequestHeight := UpperLineH; + //end; + + // set font size to a reasonable value + LyricLine.Height := RequestHeight * 0.9; + SetFontSize(LyricLine.Height/3); + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + + // change font-size to fit into the lyric bar + if (LyricLine.Width > RequestWidth) then + begin + LyricLine.Height := Trunc(LyricLine.Height * (RequestWidth / LyricLine.Width)); + // the line is very loooong, set font to at least 1px + if (LyricLine.Height < 1) then + LyricLine.Height := 1; + + SetFontSize(LyricLine.Height/3); + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + end; + + // calc word positions and widths + for I := 0 to High(LyricLine.Words) do + begin + CurWord := @LyricLine.Words[I]; + + // - if current word is italic but not the next word get the width of the + // italic font to avoid overlapping. + // - if two italic words follow each other use the normal style's + // width otherwise the spacing between the words will be too big. + // - if it is the line's last word use normal width + if CurWord.Freestyle and + (I+1 < Length(LyricLine.Words)) and + (not LyricLine.Words[I+1].Freestyle) then + begin + SetFontItalic(true); + end; + + CurWord.X := PosX; + CurWord.Width := glTextWidth(PChar(CurWord.Text)); + PosX := PosX + CurWord.Width; + SetFontItalic(false); + end; +end; + + +{** + * Draws one LyricLine + *} +procedure TLyricEngine.DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real); +var + CurWord: PLyricWord; // current word + LastWord: PLyricWord; // last word in line + NextWord: PLyricWord; // word following current word + Progress: real; // progress of singing the current word + LyricX, LyricY: real; // left/top lyric position + WordY: real; // word y-position + LyricsEffect: TLyricsEffect; + Alpha: real; // alphalevel to fade out at end + ClipPlaneEq: array[0..3] of GLdouble; // clipping plane for slide effect {// duet mode - IconSize: Real; // size of player icons - IconAlpha: Real; // alpha level of player icons + IconSize: real; // size of player icons + IconAlpha: real; // alpha level of player icons } begin // do not draw empty lines - // Note: lines with no words in it do not have a valid texture - if (Length(Line.Words) = 0) or - (Line.Width <= 0) then - begin + if (Length(Line.Words) = 0) then Exit; - end; - - // this is actually a bit more than the real font size - // it helps adjusting the "zoom-center" - LyricsHeight := 30.5 * (Line.Size/10); { // duet mode - IconSize := (2 * Size); + IconSize := (2 * Height); IconAlpha := Frac(Beat/(Resolution*4)); DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha); @@ -622,13 +536,19 @@ begin DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha); } - LyricX := X + W/2 - Line.Width/2; - LyricX2 := LyricX + Line.Width; + // set font size and style + SetFontStyle(FontStyle); + ResetFont(); + SetFontSize(Line.Height/3); + glColor4f(1, 1, 1, 1); - // maybe center smaller lines - //LyricY := Y; - LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2; + // center lyrics + LyricX := X + (W - Line.Width) / 2; + LyricY := Y + (H - Line.Height) / 2; + // get lyrics effect + LyricsEffect := TLyricsEffect(Ini.LyricsEffect); + // TODO: what about alpha in freetype outline fonts? Alpha := 1; // check if this line is active (at least its first note must be active) @@ -648,18 +568,20 @@ begin Inc(Line.CurWord); end; - FreestyleDiff := 0; - // determine current and last word in this line. // If the end of the line is reached use the last word as current word. LastWord := @Line.Words[High(Line.Words)]; CurWord := @Line.Words[Line.CurWord]; + if (Line.CurWord+1 < Length(Line.Words)) then + NextWord := @Line.Words[Line.CurWord+1] + else + NextWord := nil; // calc the progress of the lyrics effect Progress := (Beat - CurWord.Start) / CurWord.Length; - if Progress >= 1 then + if (Progress >= 1) then Progress := 1; - if Progress <= 0 then + if (Progress <= 0) then Progress := 0; // last word of this line finished, but this line did not hide -> fade out @@ -671,157 +593,93 @@ begin Alpha := 0; end; - // determine the start-/end positions of the fragment of the current word - CurWordStart := CurWord.X; - CurWordEnd := CurWord.X + CurWord.Width; - - // Slide Effect - // simply paint the active texture to the current position - if Ini.LyricsEffect = 2 then - begin - CurWordStart := CurWordStart + CurWord.Width * Progress; - CurWordEnd := CurWordStart; - end; - - if CurWord.Freestyle then - begin - if (Line.CurWord < High(Line.Words)) and - (not Line.Words[Line.CurWord + 1].Freestyle) then - begin - FreestyleDiff := 2; - end - else - begin - FreestyleDiff := 12; - CurWordStart := CurWordStart - 1; - CurWordEnd := CurWordEnd - 2; - end; - end; - - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, Line.Tex); - - // draw sentence up to current word - // type 0: simple lyric effect - // type 3: ball lyric effect - // type 4: shift lyric effect - if (Ini.LyricsEffect in [0, 3, 4]) then - // ball lyric effect - only highlight current word and not that ones before in this line + // draw sentence before current word + if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then + // only highlight current word and not that ones before in this line glColorRGB(LineColor_en, Alpha) else glColorRGB(LineColor_act, Alpha); + DrawLyricsWords(Line, LyricX, LyricY, 0, Line.CurWord-1); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); - glVertex2f(LyricX, LyricY); - - glTexCoord2f(0, 1-LyricsHeight/64); - glVertex2f(LyricX, LyricY + LyricsHeight); - - glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); - glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight); - - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); - glEnd; - - // draw rest of sentence + // draw rest of sentence (without current word) glColorRGB(LineColor_en, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); - - glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); - glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); - glVertex2f(LyricX2, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1); - glVertex2f(LyricX2, LyricY); - glEnd; - - // draw active word: - // type 0: simple lyric effect - // type 3: ball lyric effect - // type 4: shift lyric effect - // only change the color of the current word - if (Ini.LyricsEffect in [0, 3, 4]) then + if (NextWord <> nil) then begin - if (Ini.LyricsEffect = 4) then - LyricY := LyricY - 8 * (1-Progress); - - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY); - - glTexCoord2f(CurWordStart/1024, 0); - glVertex2f(LyricX + CurWordStart, LyricY + 64); - - glTexCoord2f(CurWordEnd/1024, 0); - glVertex2f(LyricX + CurWordEnd, LyricY + 64); + DrawLyricsWords(Line, LyricX + NextWord.X, LyricY, + Line.CurWord+1, High(Line.Words)); + end; - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY); - glEnd; + // draw current word + if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then + begin + if (LyricsEffect = lfxShift) then + WordY := LyricY - 8 * (1-Progress) + else + WordY := LyricY; - if (Ini.LyricsEffect = 4) then - LyricY := LyricY + 8 * (1-Progress); + // change the color of the current word + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + DrawLyricsWords(Line, LyricX + CurWord.X, WordY, Line.CurWord, Line.CurWord); end - - // draw active word: - // type 1: zoom lyric effect // change color and zoom current word - else if Ini.LyricsEffect = 1 then + else if (LyricsEffect = lfxZoom) then begin glPushMatrix; - glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2, - LyricY + LyricsHeight/2, 0); - - // set current zoom factor + // zoom at word center + glTranslatef(LyricX + CurWord.X + CurWord.Width/2, + LyricY + Line.Height/2, 0); glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0); glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - glBegin(GL_QUADS); - glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1); - glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); + DrawLyricsWords(Line, -CurWord.Width/2, -Line.Height/2, Line.CurWord, Line.CurWord); + + glPopMatrix; + end + // split current word into active and non-active part + else if (LyricsEffect = lfxSlide) then + begin + // enable clipping and set clip equation coefficients to zeros + glEnable(GL_CLIP_PLANE0); + FillChar(ClipPlaneEq[0], SizeOf(ClipPlaneEq), 0); - glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64); - glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2); + glPushMatrix; + glTranslatef(LyricX + CurWord.X, LyricY, 0); - glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64); - glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2); + // clip non-active right part of the current word + ClipPlaneEq[0] := -1; + ClipPlaneEq[3] := CurWord.Width * Progress; + glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq); + // and draw active left part + glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); + DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord); - glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1); - glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2); - glEnd; + // clip active left part of the current word + ClipPlaneEq[0] := -ClipPlaneEq[0]; + ClipPlaneEq[3] := -ClipPlaneEq[3]; + glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq); + // and draw non-active right part + glColor4f(LineColor_en.r, LineColor_en.g, LineColor_en.b, Alpha); + DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord); glPopMatrix; - end; - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); + glDisable(GL_CLIP_PLANE0); + end; - // type 3: ball lyric effect - if Ini.LyricsEffect = 3 then + // draw the ball onto the current word + if (LyricsEffect = lfxBall) then begin - DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress, + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + DrawBall(LyricX + CurWord.X + CurWord.Width * Progress, LyricY - 15 - 15*sin(Progress * Pi), Alpha); end; end else begin // this section is called if the whole line can be drawn at once and no - // word has to be emphasized. - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Line.Tex); + // word is highlighted. // enable the upper, disable the lower line if (Line = UpperLine) then @@ -829,45 +687,30 @@ begin else glColorRGB(LineColor_dis); - glBegin(GL_QUADS); - glTexCoord2f(0, 1); - glVertex2f(LyricX, LyricY); - - glTexCoord2f(0, 1-LyricsHeight/64); - glVertex2f(LyricX, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64); - glVertex2f(LyricX2, LyricY + LyricsHeight); - - glTexCoord2f(Line.Width/1024, 1); - glVertex2f(LyricX2, LyricY); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); + DrawLyricsWords(Line, LyricX, LyricY, 0, High(Line.Words)); end; end; -//--------------- -// GetUpperLine() - Returns a reference to the upper line -//--------------- +{** + * @returns a reference to the upper line + *} function TLyricEngine.GetUpperLine(): TLyricLine; begin Result := UpperLine; end; -//--------------- -// GetLowerLine() - Returns a reference to the lower line -//--------------- +{** + * @returns a reference to the lower line + *} function TLyricEngine.GetLowerLine(): TLyricLine; begin Result := LowerLine; end; -//--------------- -// GetUpperLineIndex() - Returns the index of the upper line -//--------------- -function TLyricEngine.GetUpperLineIndex(): Integer; +{** + * @returns the index of the upper line + *} +function TLyricEngine.GetUpperLineIndex(): integer; const QUEUE_SIZE = 3; begin -- cgit v1.2.3 From af9523c588b9440880e2d1bebe0cf79235cc4d59 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 19 Oct 2008 11:45:07 +0000 Subject: - background-type -> enum - some string function-parameters defined const git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1458 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 148 +++++++++++++++++++++++++-------------------------- 1 file changed, 74 insertions(+), 74 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 3f00ce52..745a5d9b 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -51,26 +51,30 @@ type R, G, B, A: Double; end; -TThemeBackground = record - BGType: byte; +type + TBackgroundType = + (bgtNone, bgtColor, bgtTexture, bgtVideo, bgtFade, bgtAuto); + +const + BGT_Names: array [TBackgroundType] of string = + ('none', 'color', 'texture', 'video', 'fade', 'auto'); + +type + TThemeBackground = record + BGType: TBackgroundType; Color: TRGB; Tex: string; Alpha: real; end; const - BGT_Names: array [0..4] of string = ('none', 'color', 'texture', 'video', 'fade'); - BGT_None = 0; - BGT_Color = 1; - BGT_Texture = 2; - BGT_Video = 3; - BGT_Fade = 4; - BGT_Auto = 255; //Defaul Background for Screens w/o Theme e.g. editor - DEFAULTBACKGROUND: TThemeBackground = (BGType: BGT_Color; - Color: (R:1; G:1; B:1); - Tex: ''; - Alpha: 1.0); + DEFAULT_BACKGROUND: TThemeBackground = ( + BGType: bgtColor; + Color: (R:1; G:1; B:1); + Tex: ''; + Alpha: 1.0 + ); type @@ -266,7 +270,7 @@ type W: integer; H: integer; Style: integer; - end; + end; //Equalizer Mod Equalizer: TThemeEqualizer; @@ -700,9 +704,9 @@ type {$ENDIF} LastThemeBasic: TThemeBasic; - procedure create_theme_objects(); + procedure CreateThemeObjects(); + public - Loading: TThemeLoading; Main: TThemeMain; Name: TThemeName; @@ -740,33 +744,32 @@ type ILevel: array[0..2] of string; - constructor Create(FileName: string); overload; // Initialize theme system - constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color + constructor Create(const FileName: string); overload; // Initialize theme system + constructor Create(const FileName: string; Color: integer); overload; // Initialize theme system with color function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file procedure LoadColors; - procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string); - procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); - procedure ThemeLoadText(var ThemeText: TThemeText; Name: string); - procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string); - procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); - procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); - procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil); - procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); - procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); - procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); - procedure ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; Name: string); - - procedure ThemeSave(FileName: string); - procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string); - procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); - procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); - procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); - procedure ThemeSaveText(ThemeText: TThemeText; Name: string); - procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string); - procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string); - + procedure ThemeLoadBasic(Theme: TThemeBasic; const Name: string); + procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string); + procedure ThemeLoadText(var ThemeText: TThemeText; const Name: string); + procedure ThemeLoadTexts(var ThemeText: AThemeText; const Name: string); + procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string); + procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string); + procedure ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection = nil); + procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string); + procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string); + procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string); + procedure ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string); + + procedure ThemeSave(const FileName: string); + procedure ThemeSaveBasic(Theme: TThemeBasic; const Name: string); + procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string); + procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string); + procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string); + procedure ThemeSaveText(ThemeText: TThemeText; const Name: string); + procedure ThemeSaveTexts(ThemeText: AThemeText; const Name: string); + procedure ThemeSaveButton(ThemeButton: TThemeButton; const Name: string); end; TColor = record @@ -823,12 +826,12 @@ begin glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); end; -constructor TTheme.Create(FileName: string); +constructor TTheme.Create(const FileName: string); begin Create(FileName, 0); end; -constructor TTheme.Create(FileName: string; Color: integer); +constructor TTheme.Create(const FileName: string; Color: integer); begin inherited Create(); @@ -872,11 +875,10 @@ end; function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; var I: integer; - Path: string; begin Result := false; - create_theme_objects(); + CreateThemeObjects(); Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); @@ -1475,7 +1477,7 @@ begin end; end; -procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string); +procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; const Name: string); begin ThemeLoadBackground(Theme.Background, Name); ThemeLoadTexts(Theme.Text, Name + 'Text'); @@ -1485,20 +1487,22 @@ begin LastThemeBasic := Theme; end; -procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string); +procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string); var BGType: string; - I: integer; + I: TBackgroundType; begin - BGType := lowercase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto')); + BGType := LowerCase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto')); - ThemeBackground.BGType := BGT_Auto; - for I := 0 to high(BGT_Names) do + ThemeBackground.BGType := bgtAuto; + for I := Low(BGT_Names) to High(BGT_Names) do + begin if (BGT_Names[I] = BGType) then begin ThemeBackground.BGType := I; Break; end; + end; ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); ThemeBackground.Color.R := ThemeIni.ReadFloat(Name + 'Background', 'ColR', 1); @@ -1507,7 +1511,7 @@ begin ThemeBackground.Alpha := ThemeIni.ReadFloat(Name + 'Background', 'Alpha', 1); end; -procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string); +procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; const Name: string); var C: integer; begin @@ -1541,7 +1545,7 @@ begin end; end; -procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string); +procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; const Name: string); var T: integer; begin @@ -1554,7 +1558,7 @@ begin end; end; -procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string); +procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string); var C: integer; begin @@ -1587,7 +1591,7 @@ begin ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); end; -procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string); +procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string); var S: integer; begin @@ -1601,7 +1605,7 @@ begin end; //Button Collection Mod -procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string); +procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string); var T: integer; begin //Load Collection Style @@ -1615,7 +1619,7 @@ begin Collection.FirstChild := 0; end; -procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string); +procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string); var I: integer; begin @@ -1629,7 +1633,7 @@ begin end; //End Button Collection Mod -procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection); +procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection); var C: integer; TLen: integer; @@ -1721,9 +1725,7 @@ begin ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T)); end; -procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); -var - C: integer; +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string); begin ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); @@ -1764,7 +1766,7 @@ begin ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); end; -procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; Name: string); +procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string); var I: integer; begin ThemeEqualizer.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 0) = 1); @@ -1799,11 +1801,9 @@ end; procedure TTheme.LoadColors; var - SL: TStringList; - C: integer; - S: string; - Col: integer; - RGB: TRGB; + SL: TStringList; + C: integer; + S: string; begin SL := TStringList.Create; ThemeIni.ReadSection('Colors', SL); @@ -2020,7 +2020,7 @@ begin Result.B := sqrt(RGB.B); end; -procedure TTheme.ThemeSave(FileName: string); +procedure TTheme.ThemeSave(const FileName: string); var I: integer; begin @@ -2145,7 +2145,7 @@ begin ThemeIni.Free; end; -procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string); +procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; const Name: string); begin ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); @@ -2154,7 +2154,7 @@ begin ThemeSaveTexts(Theme.Text, Name + 'Text'); end; -procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string); +procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string); begin if ThemeBackground.Tex <> '' then ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) @@ -2164,7 +2164,7 @@ begin end; end; -procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string); +procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string); begin ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X); ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y); @@ -2181,7 +2181,7 @@ begin ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2); end; -procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string); +procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string); var S: integer; begin @@ -2191,7 +2191,7 @@ begin ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1)); end; -procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string); +procedure TTheme.ThemeSaveText(ThemeText: TThemeText; const Name: string); begin ThemeIni.WriteInteger(Name, 'X', ThemeText.X); ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y); @@ -2207,7 +2207,7 @@ begin ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing); end; -procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string); +procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; const Name: string); var T: integer; begin @@ -2217,7 +2217,7 @@ begin ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1)); end; -procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string); +procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; const Name: string); var T: integer; begin @@ -2260,7 +2260,7 @@ begin ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1)); end; -procedure TTheme.create_theme_objects(); +procedure TTheme.CreateThemeObjects(); begin freeandnil(Loading); Loading := TThemeLoading.Create; -- cgit v1.2.3 From 2f768387f3849699320229a5b756db78af1207a2 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 19 Oct 2008 16:24:59 +0000 Subject: The size given to TextGL.SetSize() now expresses the size in pixel (formerly it was 1/3 of the pixel-size). For theme and plugin compatibility the following functions multiply the size with 3: - UScreenSingModi.Print - TTheme.ThemeLoadText - TTheme.ThemeLoadSelectSlide TODO: Convert the themes/plugins and remove the "*3" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1459 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 2 +- src/base/UDraw.pas | 2 +- src/base/ULyrics.pas | 6 +- src/base/USingScores.pas | 196 +++++++++++++++++++++++------------------------ src/base/UThemes.pas | 6 +- 5 files changed, 107 insertions(+), 105 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 03351adf..ad4c0ee2 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -359,7 +359,7 @@ end; procedure SetFontSize(Size: real); begin - Fonts[ActFont].Tex.H := 30 * (Size/10); + Fonts[ActFont].Tex.H := Size; end; procedure SetFontStyle(Style: integer); diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index a28543b8..61335a53 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -1222,7 +1222,7 @@ begin //Set Font Propertys SetFontStyle(2); //Font: Outlined1 -if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6); +if Age < 5 then SetFontSize((Age + 1) * 3) else SetFontSize(18); SetFontItalic(False); //Check Font Size diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index ece9f1d4..5c5449b1 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -463,7 +463,7 @@ begin // set font size to a reasonable value LyricLine.Height := RequestHeight * 0.9; - SetFontSize(LyricLine.Height/3); + SetFontSize(LyricLine.Height); LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); // change font-size to fit into the lyric bar @@ -474,7 +474,7 @@ begin if (LyricLine.Height < 1) then LyricLine.Height := 1; - SetFontSize(LyricLine.Height/3); + SetFontSize(LyricLine.Height); LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); end; @@ -539,7 +539,7 @@ begin // set font size and style SetFontStyle(FontStyle); ResetFont(); - SetFontSize(Line.Height/3); + SetFontSize(Line.Height); glColor4f(1, 1, 1, 1); // center lyrics diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 71ae2651..8e2455e1 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -93,19 +93,19 @@ type RBW: Real; //Width of the Rating Bar RBH: Real; //Height of the Rating Bar - TextX: Real; //X Position of the Score Text - TextY: Real; //Y Position of the Score Text - TextFont: Byte; //Font of the Score Text - TextSize: Byte; //Size of the Score Text - - PUW: Real; //Width of the LineBonus Popup - PUH: Real; //Height of the LineBonus Popup - PUFont: Byte; //Font for the PopUps - PUFontSize: Byte; //FontSize for the PopUps - PUStartX: Real; //X Start Position of the LineBonus Popup - PUStartY: Real; //Y Start Position of the LineBonus Popup - PUTargetX: Real; //X Target Position of the LineBonus Popup - PUTargetY: Real; //Y Target Position of the LineBonus Popup + TextX: Real; //X Position of the Score Text + TextY: Real; //Y Position of the Score Text + TextFont: Byte; //Font of the Score Text + TextSize: integer; //Size of the Score Text + + PUW: Real; //Width of the LineBonus Popup + PUH: Real; //Height of the LineBonus Popup + PUFont: Byte; //Font for the PopUps + PUFontSize: integer; //FontSize for the PopUps + PUStartX: Real; //X Start Position of the LineBonus Popup + PUStartY: Real; //Y Start Position of the LineBonus Popup + PUTargetX: Real; //X Target Position of the LineBonus Popup + PUTargetY: Real; //Y Target Position of the LineBonus Popup end; aScorePosition = array[0..MaxPositions-1] of TScorePosition; @@ -138,17 +138,17 @@ type FirstPopUp: PScorePopUp; LastPopUp: PScorePopUp; - //Procedure Draws a Popup by Pointer - Procedure DrawPopUp(const PopUp: PScorePopUp); + // Draws a Popup by Pointer + procedure DrawPopUp(const PopUp: PScorePopUp); - //Procedure Draws a Score by Playerindex - Procedure DrawScore(const Index: Integer); + // Draws a Score by Playerindex + procedure DrawScore(const Index: Integer); - //Procedure Draws the RatingBar by Playerindex - Procedure DrawRatingBar(const Index: Integer); + // Draws the RatingBar by Playerindex + procedure DrawRatingBar(const Index: Integer); - //Procedure Removes a PopUp w/o destroying the List - Procedure KillPopUp(const last, cur: PScorePopUp); + // Removes a PopUp w/o destroying the List + procedure KillPopUp(const last, cur: PScorePopUp); public Settings: record //Record containing some Displaying Options Phase1Time: Real; //time for Phase 1 to complete (in msecs) @@ -158,7 +158,7 @@ type Phase3Time: Real; //time for Phase 3 to complete (in msecs) //The Fade out and Score adding - PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating + PopUpTex: array [0..8] of TTexture; //Textures for every Popup Rating RatingBar_BG_Tex: TTexture; //Rating Bar Texs RatingBar_FG_Tex: TTexture; @@ -171,44 +171,44 @@ type RBVisible: Boolean; //Visibility of all Rating Bars //Propertys for Reading Position and Playercount - Property PositionCount: Byte read oPositionCount; - Property PlayerCount: Byte read oPlayerCount; - Property Players: aScorePlayer read aPlayers; + property PositionCount: Byte read oPositionCount; + property PlayerCount: Byte read oPlayerCount; + property Players: aScorePlayer read aPlayers; //Constructor just sets some standard Settings - Constructor Create; + constructor Create; - //Procedure Adds a Position to Array and Increases Position Count - Procedure AddPosition(const pPosition: PScorePosition); + // Adds a Position to Array and Increases Position Count + procedure AddPosition(const pPosition: PScorePosition); - //Procedure Adds a Player to Array and Increases Player Count - Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + // Adds a Player to Array and Increases Player Count + procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); //Change a Players Visibility, Enable - Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); - Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); + procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); - //Procedure Deletes all Player Information - Procedure ClearPlayers; + // Deletes all Player Information + procedure ClearPlayers; - //Procedure Deletes Positions and Playerinformation - Procedure Clear; + // Deletes Positions and Playerinformation + procedure Clear; - //Procedure Loads some Settings and the Positions from Theme - Procedure LoadfromTheme; + // Loads some Settings and the Positions from Theme + procedure LoadfromTheme; - //Procedure has to be called after Positions and Players have been added, before first call of Draw + // has to be called after Positions and Players have been added, before first call of Draw //It gives every Player a Score Position - Procedure Init; + procedure Init; //Spawns a new Line Bonus PopUp for the Player - Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); //Removes all PopUps from Mem - Procedure KillAllPopUps; + procedure KillAllPopUps; - //Procedure Draws Scores and Linebonus PopUps - Procedure Draw; + // Draws Scores and Linebonus PopUps + procedure Draw; end; @@ -220,9 +220,9 @@ uses SDL, UGraphic, TextGL; -//----------- -//Constructor just sets some standard Settings -//----------- +{** + * Sets some standard Settings + *} Constructor TSingScores.Create; begin inherited; @@ -259,9 +259,9 @@ begin Settings.RatingBar_Bar_Tex.TexNum := 0; end; -//----------- -//Procedure Adds a Position to Array and Increases Position Count -//----------- +{** + * Adds a Position to Array and Increases Position Count + *} Procedure TSingScores.AddPosition(const pPosition: PScorePosition); begin if (PositionCount < MaxPositions) then @@ -272,9 +272,9 @@ begin end; end; -//----------- -//Procedure Adds a Player to Array and Increases Player Count -//----------- +{** + * Adds a Player to Array and Increases Player Count + *} Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); begin if (PlayerCount < MaxPlayers) then @@ -294,46 +294,46 @@ begin end; end; -//----------- -//Change a Players Visibility -//----------- +{** + * Change a Players Visibility + *} Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); begin if (Index < MaxPlayers) then aPlayers[Index].Visible := pVisible; end; -//----------- -//Change Player Enabled -//----------- +{** + * Change Player Enabled + *} Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); begin if (Index < MaxPlayers) then aPlayers[Index].Enabled := pEnabled; end; -//----------- -//Procedure Deletes all Player Information -//----------- -Procedure TSingScores.ClearPlayers; +{** + * Procedure Deletes all Player Information + *} +Procedure TSingScores.ClearPlayers; begin KillAllPopUps; oPlayerCount := 0; end; -//----------- -//Procedure Deletes Positions and Playerinformation -//----------- -Procedure TSingScores.Clear; +{** + * Procedure Deletes Positions and Playerinformation + *} +Procedure TSingScores.Clear; begin KillAllPopUps; oPlayerCount := 0; oPositionCount := 0; end; -//----------- -//Procedure Loads some Settings and the Positions from Theme -//----------- +{** + * Procedure Loads some Settings and the Positions from Theme + *} Procedure TSingScores.LoadfromTheme; var I: Integer; Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); @@ -360,7 +360,7 @@ var I: Integer; nPosition.PUH := nPosition.BGH; nPosition.PUFont := 2; - nPosition.PUFontSize := 6; + nPosition.PUFontSize := 18; nPosition.PUStartX := nPosition.BGX; nPosition.PUStartY := nPosition.TextY + 65; @@ -398,9 +398,9 @@ begin AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore); end; -//----------- -//Spawns a new Line Bonus PopUp for the Player -//----------- +{** + * Spawns a new Line Bonus PopUp for the Player + *} Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); var Cur: PScorePopUp; begin @@ -446,9 +446,9 @@ begin Log.LogError('TSingScores: Try to add PopUp for not existing player'); end; -//----------- -// Removes a PopUp w/o destroying the List -//----------- +{** + * Removes a PopUp w/o destroying the List + *} Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); begin //Give Player the Last Points that missing till now @@ -488,9 +488,9 @@ begin FreeMem(Cur, SizeOf(TScorePopUp)); end; -//----------- -//Removes all PopUps from Mem -//----------- +{** + * Removes all PopUps from Mem + *} Procedure TSingScores.KillAllPopUps; var Cur: PScorePopUp; @@ -510,10 +510,10 @@ begin LastPopUp := nil; end; -//----------- -//Init - has to be called after Positions and Players have been added, before first call of Draw -//It gives every Player a Score Position -//----------- +{** + * Has to be called after Positions and Players have been added, before first call of Draw + * It gives every Player a Score Position + *} Procedure TSingScores.Init; var PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen @@ -602,9 +602,9 @@ begin end; end; -//----------- -//Procedure Draws Scores and Linebonus PopUps -//----------- +{** + * Draws Scores and Linebonus PopUps + *} Procedure TSingScores.Draw; var I: Integer; @@ -655,15 +655,15 @@ begin end; //eo Visible end; -//----------- -//Procedure Draws a Popup by Pointer -//----------- +{** + * Draws a Popup by Pointer + *} Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); var Progress: Real; CurTime: Cardinal; X, Y, W, H, Alpha: Real; - FontSize: Byte; + FontSize: integer; FontOffset: Real; TimeDiff: Cardinal; PIndex: Byte; @@ -706,7 +706,7 @@ begin Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; FontSize := Round(Progress * Positions[PIndex].PUFontSize); - FontOffset := H / 2 - FontSize; + FontOffset := (H - FontSize) / 2; Alpha := 1; end @@ -729,7 +729,7 @@ begin Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); FontSize := Positions[PIndex].PUFontSize; - FontOffset := H / 2 - FontSize; + FontOffset := (H - FontSize) / 2; Alpha := 1 - 0.3 * Progress; end @@ -776,7 +776,7 @@ begin Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); FontSize := Positions[PIndex].PUFontSize; - FontOffset := H / 2 - FontSize; + FontOffset := (H - FontSize) / 2; end else begin @@ -820,7 +820,7 @@ begin TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); //Color and Pos - SetFontPos (X + (W - TextLen) / 2, Y + FontOffset{12}); + SetFontPos (X + (W - TextLen) / 2, Y + FontOffset); glColor4f(1, 1, 1, Alpha); //Draw @@ -833,9 +833,9 @@ begin Log.LogError('TSingScores: Try to Draw a not existing PopUp'); end; -//----------- -//Procedure Draws a Score by Playerindex -//----------- +{** + * Draws a Score by Playerindex + *} Procedure TSingScores.DrawScore(const Index: Integer); var Position: PScorePosition; diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 745a5d9b..02fdf10a 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -1526,7 +1526,8 @@ begin ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); - ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); + // FIXME: FONTSIZE + ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0) * 3; ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); @@ -1739,7 +1740,8 @@ begin ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10); + // FIXME: FONTSIZE + ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10) * 3; ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); -- cgit v1.2.3 From 459d18c6aa2f82468a53595565278d95bcbd1110 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 19 Oct 2008 23:23:45 +0000 Subject: font-size is now in pixels (not pixels/3) in themes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1460 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 02fdf10a..361ed87d 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -1526,8 +1526,7 @@ begin ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); - // FIXME: FONTSIZE - ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0) * 3; + ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); @@ -1740,8 +1739,7 @@ begin ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - // FIXME: FONTSIZE - ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10) * 3; + ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 30); ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); -- cgit v1.2.3 From f4e9ef3a2f98b9f9d0cfc18ed81e5b4b1de0fd12 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 20 Oct 2008 10:14:21 +0000 Subject: Alpha plane request (SDL_GL_ALPHA_SIZE) removed as we do not need it anymore (was only needed for backbuffer offscreen rendering). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1464 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 16 ++++------------ 1 file changed, 4 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index a6620c0d..75c90134 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -583,21 +583,13 @@ begin Screens := Ini.Screens + 1; // Set minimum color component sizes - // Note: - // - SDL_GL_ALPHA_SIZE should not be set here, otherwise on a few systems with - // some versions of SDL (at least 1.2.11) SDL_SetVideoMode will fail. - // The problem occured if the adjusted color component sizes did not leave - // any space for alpha, e.g. red/green/blue ajusted from 5 to 8: - // r_size+g_size+b_size = 24, so an alpha of at least 5 is just available if - // the depth is 32bit. - // - Without SDL_GL_ALPHA_SIZE the lyrics won't work anymore on some systems - // as the offscreen lyrics rendering needs an alpha component in the - // back-buffer. - // -> Leave SDL_GL_ALPHA_SIZE until the lyrics-engine is changed. + // Note: do not request an alpha plane with SDL_GL_ALPHA_SIZE here as + // some cards/implementations do not support them (SDL_SetVideoMode fails). + // We do not the alpha plane anymore since offscreen rendering in back-buffer + // was removed. 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); // Z-Buffer depth SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); -- cgit v1.2.3 From bb859133a8813b651a4c352d6dd7c86e9cdccec4 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 20 Oct 2008 21:46:57 +0000 Subject: Do not use Main try-except block if in debug mode to make debugging easier git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1465 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index f9ac4ebe..6e6d2ad7 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -171,14 +171,16 @@ procedure Main; var WndTitle: string; begin + {$IFNDEF Debug} try + {$ENDIF} WndTitle := USDXVersionStr; Platform.Init; if Platform.TerminateIfAlreadyRunning(WndTitle) then Exit; - + // fix floating-point exceptions (FPE) DisableFloatingPointExceptions(); // fix the locale for string-to-float parsing in C-libs @@ -380,7 +382,9 @@ begin Log.LogStatus('Main Loop', 'Initialization'); MainLoop; + {$IFNDEF Debug} finally + {$ENDIF} //------------------------------ //Finish Application //------------------------------ @@ -399,7 +403,9 @@ begin Log.LogStatus('Main Loop', 'Finished'); Log.Free; end; + {$IFNDEF Debug} end; + {$ENDIF} end; procedure MainLoop; -- cgit v1.2.3 From ccf54c61f6659de2343b4e642ef94de0b708b64c Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 10:10:36 +0000 Subject: SDL_RESIZABLE removed at SDL_ListModes() on fullscreen mode git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1466 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index ee517df1..3a4d6129 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -545,7 +545,7 @@ begin // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not // possible to select a reasonable fullscreen mode when in windowed mode if IFullScreen[FullScreen] = 'On' then - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE) + Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN) else Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; -- cgit v1.2.3 From e73b884d020019c29aadf11a2c5ac8fe5b53b0dd Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 10:11:41 +0000 Subject: font-engine added (not used atm) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1467 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 2646 ++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 2646 insertions(+) create mode 100644 src/base/UFont.pas (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas new file mode 100644 index 00000000..947a1c6f --- /dev/null +++ b/src/base/UFont.pas @@ -0,0 +1,2646 @@ +unit UFont; + +{$IFDEF FPC} + {$mode delphi}{$H+} +{$ENDIF} + +{$DEFINE HasInline} + +interface + +// Flip direction of y-axis. +// Default is a cartesian coordinate system with y-axis in upper direction +// but with USDX the y-axis is in lower direction. +{$DEFINE FLIP_YAXIS} +{$DEFINE BITMAP_FONT} + +uses + FreeType, + gl, + glext, + glu, + sdl, + {$IFDEF BITMAP_FONT} + UTexture, + {$ENDIF} + Math, + Classes, + SysUtils; + +type + + PGLubyteArray = ^TGLubyteArray; + TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; + TGLubyteDynArray = array of GLubyte; + + TWideStringArray = array of WideString; + + TGLColor = packed record + case byte of + 0: ( vals: array[0..3] of GLfloat; ); + 1: ( r, g, b, a: GLfloat; ); + end; + + TBoundsDbl = record + Left, Right: double; + Bottom, Top: double; + end; + + TPositionDbl = record + X, Y: double; + end; + + TTextureSize = record + Width, Height: integer; + end; + + TBitmapCoords = record + Left, Top: double; + Width, Height: integer; + end; + + {** + * Abstract base class representing a glyph. + *} + TGlyph = class + protected + function GetAdvance(): TPositionDbl; virtual; abstract; + function GetBounds(): TBoundsDbl; virtual; abstract; + public + procedure Render(UseDisplayLists: boolean); virtual; abstract; + procedure RenderReflection(); virtual; abstract; + + {** Distance to next glyph (in pixels) *} + property Advance: TPositionDbl read GetAdvance; + {** Glyph bounding box (in pixels) *} + property Bounds: TBoundsDbl read GetBounds; + end; + + {** + * Font styles used by TFont.Style + *} + TFontStyle = set of (Italic, Underline, Reflect); + + {** + * Base font class. + *} + TFont = class + private + {** Non-virtual reset-method used in Create() and Reset() } + procedure ResetIntern(); + + protected + fStyle: TFontStyle; + fUseKerning: boolean; + fLineSpacing: single; // must be inited by subclass + fReflectionSpacing: single; // must be inited by subclass to -2*Descender + fGlyphSpacing: single; + fReflectionPass: boolean; + + {** + * Splits lines in Text seperated by newline (char-code #13). + * @param Text UTF-8 encoded string + * @param Lines splitted WideString lines + *} + procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + + {** + * Print an array of WideStrings. Each array-item is a line of text. + * Lines of text are seperated by the line-spacing. + * This is the base function for all text drawing. + *} + procedure Print(const Text: TWideStringArray); overload; virtual; + + {** + * Draws an underline. + *} + procedure DrawUnderline(const Text: WideString); virtual; + + {** + * Renders (one) line of text. + *} + procedure Render(const Text: WideString); virtual; abstract; + + {** + * Returns the bounds of text-lines contained in Text. + * @param(Advance if true the right bound is set to the advance instead + * of the minimal right bound.) + *} + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + + {** + * Resets all user settings to default values. + * Override methods should always call the inherited version. + *} + procedure Reset(); virtual; + + function GetHeight(): single; virtual; abstract; + function GetAscender(): single; virtual; abstract; + function GetDescender(): single; virtual; abstract; + procedure SetLineSpacing(Spacing: single); virtual; + function GetLineSpacing(): single; virtual; + procedure SetGlyphSpacing(Spacing: single); virtual; + function GetGlyphSpacing(): single; virtual; + procedure SetReflectionSpacing(Spacing: single); virtual; + function GetReflectionSpacing(): single; virtual; + procedure SetStyle(Style: TFontStyle); virtual; + function GetStyle(): TFontStyle; virtual; + function GetUnderlinePosition(): single; virtual; abstract; + function GetUnderlineThickness(): single; virtual; abstract; + procedure SetUseKerning(Enable: boolean); virtual; + function GetUseKerning(): boolean; virtual; + procedure SetReflectionPass(Enable: boolean); virtual; + + {** Returns true if the current render-pass is used to draw the reflection } + property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Prints a text. + *} + procedure Print(const Text: WideString); overload; + {** UTF-8 version of @link(Print) } + procedure Print(const Text: string); overload; + + {** + * Calculates the bounding box (width and height) around Text. + * Works with Italic and Underline styles but reflections created + * with the Reflect style are not considered. + * Note that the width might differ due to kerning with appended text, + * e.g. Width('VA') <= Width('V') + Width('A'). + * @param Advance if set to true, Result.Right is set to the advance of + * the given text rather than the min. right border. The advance width is + * bigger than the text's width as it additionally contains the advance + * and glyph-spacing of the last character. + *} + function BBox(const Text: WideString; Advance: boolean = false): TBoundsDbl; overload; + {** UTF-8 version of @link(BBox) } + function BBox(const Text: UTF8String; Advance: boolean = false): TBoundsDbl; overload; + + {** Font height } + property Height: single read GetHeight; + {** Vertical distance from baseline to top of glyph } + property Ascender: single read GetAscender; + {** Vertical distance from baseline to bottom of glyph } + property Descender: single read GetDescender; + {** Vertical distance between two baselines } + property LineSpacing: single read GetLineSpacing write SetLineSpacing; + {** Space between end and start of next glyph added to the advance width } + property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; + {** Distance between normal baseline and baseline of the reflection } + property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; + {** Font style (italic/underline/...) } + property Style: TFontStyle read GetStyle write SetStyle; + {** If set to true (default) kerning will be used if available } + property UseKerning: boolean read GetUseKerning write SetUseKerning; + end; + +const + //** Max. number of mipmap levels that a TScalableFont can contain + cMaxMipmapLevel = 5; + +type + {** + * Wrapper around TFont to allow font size changes. + * The font is scaled to the requested size by a modelview matrix + * transformation (glScale) and not by rescaling the internal bitmap + * representation. This way changing the size is really fast but the result + * may lack quality on large or small scale factors. + *} + TScalableFont = class(TFont) + private + procedure ResetIntern(); + + protected + fScale: single; //**< current height to base-font height ratio + fAspect: single; //**< width to height aspect + fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] + fUseMipmaps: boolean; //**< true if mipmap fonts are generated + /// Mipmap fonts (size[level+1] = size[level]/2) + fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; + + procedure Render(const Text: WideString); override; + procedure Print(const Text: TWideStringArray); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + {** + * Callback called for creation of each mipmap font. + * Must be defined by the subclass. + * Mipmaps created by this method are managed and freed by TScalableFont. + *} + function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; + + {** + * Returns the mipmap level considering the current scale and projection + * matrix. + *} + function GetMipmapLevel(): integer; + + {** + * Returns the scale applied to the given mipmap font. + * fScale * fBaseFont.Height / fMipmapFont[Level].Height + *} + function GetMipmapScale(Level: integer): single; + + {** + * Chooses the mipmap that looks nicest with current scale and projection + * matrix. + *} + function ChooseMipmapFont(): TFont; + + procedure SetHeight(Height: single); virtual; + function GetHeight(): single; override; + procedure SetAspect(Aspect: single); virtual; + function GetAspect(): single; virtual; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + function GetLineSpacing(): single; override; + procedure SetGlyphSpacing(Spacing: single); override; + function GetGlyphSpacing(): single; override; + procedure SetReflectionSpacing(Spacing: single); override; + function GetReflectionSpacing(): single; override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + + public + {** + * Creates a wrapper to make the base-font Font scalable. + * If UseMipmaps is set to true smaller fonts are created so that a + * resized (Height property changed) font looks nicer. + * The font passed is managed and freed by TScalableFont. + *} + constructor Create(Font: TFont; UseMipmaps: boolean); overload; + + {** + * Frees memory. The fonts passed on Create() and mipmap creation + * are freed too. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Font height } + property Height: single read GetHeight write SetHeight; + {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } + property Aspect: single read GetAspect write SetAspect; + end; + + {** + * Table for storage of max. 256 glyphs. + * Used for the second cache level. Indexed by the LSB of the WideChar + * char-code. + *} + PGlyphTable = ^TGlyphTable; + TGlyphTable = array[0..255] of TGlyph; + + {** + * Cache for glyphs of a single font. + * The cached glyphs are stored inside a hash-list. + * Hashing is performed in two steps: + * 1. the least significant byte (LSB) of the WideChar character code + * is removed (shr 8) and the result (we call it BaseCode here) looked up in + * the hash-list. + * 2. Each entry of the hash-list contains a table with max. 256 entries. + * The LSB of the char-code of a glyph is the table-offset of that glyph. + *} + TGlyphCache = class + private + fHash: TList; + + {** + * Finds a glyph-table storing cached glyphs with base-code BaseCode + * (= upper char-code bytes) in the hash-list and returns the table and + * its index. + * @param(InsertPos the position of the tyble in the list if it was found, + * otherwise the position the table should be inserted) + *} + function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Add glyph Glyph with char-code ch to the cache. + * @returns @true on success, @false otherwise + *} + function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + + {** + * Removes the glyph with char-code ch from the cache. + *} + procedure DeleteGlyph(ch: WideChar); + + {** + * Removes the glyph with char-code ch from the cache. + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Checks if a glyph with char-code ch is cached. + *} + function HasGlyph(ch: WideChar): boolean; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, cached characters in the range 0..255 will not be flushed. + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + {** + * Entry of a glyph-cache's (TGlyphCache) hash. + * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table + * with all glyphs cached at the moment with that BaseCode. + *} + TGlyphCacheHashEntry = class + private + fBaseCode: cardinal; + public + GlyphTable: TGlyphTable; + + constructor Create(BaseCode: cardinal); + + {** Base-code (upper-bytes) of the glyphs stored in this entry's table } + property BaseCode: cardinal read fBaseCode; + end; + + TCachedFont = class(TFont) + protected + fCache: TGlyphCache; + + {** + * Retrieves a cached glyph with char-code ch from cache. + * If the glyph is not already cached, it is loaded with LoadGlyph(). + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Callback to create (load) a glyph with char-code ch. + * Implemented by subclasses. + *} + function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, the base glyphs are not be flushed. + * @seealso TGlyphCache.FlushCache + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + TFTFont = class; + + {** + * Freetype glyph. + * Each glyph stores a texture with the glyph's image. + *} + TFTGlyph = class(TGlyph) + private + fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) + fDisplayList: GLuint; //**< Display-list ID + fTexture: GLuint; //**< Texture ID + fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) + fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding + fTexSize: TTextureSize; //**< Texture size in pixels + + fFont: TFTFont; //**< Font associated with this glyph + fAdvance: TPositionDbl; //**< Advance width of this glyph + fBounds: TBoundsDbl; //**< Glyph bounds + fOutset: single; //**< Extrusion outset + + {** + * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size + * fTexSize by Outset pixels. + * This is useful to create bold or outlined fonts. + * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the + * original glyph bitmap, otherwise the glyph borders cannot be extruded + * correctly. + * The bitmap must be 2* pixels wider and higher than the + * original glyph's bitmap with the latter centered in it. + *} + procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + {** + * Creates an OpenGL texture (and display list) for the glyph. + * The glyph's and bitmap's metrics are set correspondingly. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the glyph could not be initialized + *} + procedure CreateTexture(LoadFlags: FT_Int32); + + protected + function GetAdvance(): TPositionDbl; override; + function GetBounds(): TBoundsDbl; override; + + public + {** + * Creates a glyph with char-code ch from font Font. + * @param LoadFlags flags passed to FT_Load_Glyph() + *} + constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); + destructor Destroy(); override; + + {** Renders the glyph (normal render pass) } + procedure Render(UseDisplayLists: boolean); override; + {** Renders the glyph's reflection } + procedure RenderReflection(); override; + + {** Freetype specific char-index (<> char-code) } + property CharIndex: FT_UInt read fCharIndex; + end; + + {** + * Freetype font class. + *} + TFTFont = class(TCachedFont) + private + procedure ResetIntern(); + + protected + fFilename: string; //**< filename of the font-file + fSize: integer; //**< Font base size (in pixels) + fOutset: single; //**< size of outset extrusion (in pixels) + fFace: FT_Face; //**< Holds the height of the font + fLoadFlags: FT_Int32; //**< FT glpyh load-flags + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + + {** @seealso TCachedFont.LoadGlyph } + function LoadGlyph(ch: WideChar): TGlyph; override; + + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + property Face: FT_Face read fFace; + + public + {** + * Creates a font of size Size (in pixels) from the file Filename. + * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded + * at their borders. Use it for e.g. a bold effect. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the font-file could not be loaded + *} + constructor Create(const Filename: string; + Size: integer; Outset: single = 0.0; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + + {** + * Frees all resources associated with the font. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + TFTScalableFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + {** + * Creates a scalable font of size Size (in pixels) from the file Filename. + * OutsetAmount is the ratio of the glyph extrusion. + * The extrusion in pixels is Size*OutsetAmount + * (0.0 -> no extrusion, 0.1 -> 10%). + *} + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single = 0.0; + UseMipmaps: boolean = true); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size (in pixels) of the scaled font } + property Outset: single read GetOutset; + end; + + + {** + * Represents a freetype font with an additional outline around its glyphs. + * The outline size is passed on creation and cannot be changed later. + *} + TFTOutlineFont = class(TFont) + private + fFilename: string; + fSize: integer; + fOutset: single; + fInnerFont, fOutlineFont: TFTFont; + fOutlineColor: TGLColor; + + procedure ResetIntern(); + + protected + procedure DrawUnderline(const Text: WideString); override; + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + procedure SetGlyphSpacing(Spacing: single); override; + procedure SetReflectionSpacing(Spacing: single); override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + procedure SetReflectionPass(Enable: boolean); override; + + public + constructor Create(const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + destructor Destroy; override; + + {** Sets the color of the outline } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + {** + * Wrapper around TOutlineFont to allow font resizing. + * @seealso TScalableFont + *} + TFTScalableOutlineFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean = true); + + {** Sets the color of the outline } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size } + property Outset: single read GetOutset; + end; + +{$IFDEF BITMAP_FONT} + + {** + * A bitmapped font loads it's glyphs from a bitmap and stores them in a + * texture. Unicode characters are not supported (but could be by supporting + * multiple textures each storing a subset of unicode glyphs). + * For backward compatibility only. + *} + TBitmapFont = class(TFont) + private + fTex: TTexture; + fTexSize: integer; + fBaseline: integer; + fAscender: integer; + fDescender: integer; + fWidths: array[0..255] of byte; //**< half widths + fOutline: integer; + fTempColor: TGLColor; //**< colours for the reflection + + procedure ResetIntern(); + + procedure RenderChar(ch: WideChar; var AdvanceX: real); + + {** + * Load font widths from an info file. + * @param InfoFile the name of the info (.dat) file + * @raises Exception if the file is corrupted + *} + procedure LoadFontInfo(const InfoFile: string); + + protected + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + public + {** + * Creates a bitmapped font from image Filename and font width info + * loaded from the corresponding file with ending .dat. + * @param(Baseline y-coord of the baseline given in cartesian coords + * (y-axis up) and from the lower edge of the glyphs bounding box) + * @param(Ascender pixels from baseline to top of highest glyph) + *} + constructor Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); + destructor Destroy(); override; + + {** + * Corrects font widths provided by the info file. + * NewWidth := Width * WidthMult + WidthAdd + *} + procedure CorrectWidths(WidthMult: real; WidthAdd: integer); + + {** @seealso TFont.Reset } + procedure Reset(); override; + end; + +{$ENDIF BITMAP_FONT} + + TFreeType = class + public + {** + * Returns a pointer to the freetype library singleton. + * If non exists, freetype will be initialized. + * @raises Exception if initialization failed + *} + class function GetLibrary(): FT_Library; + class procedure FreeLibrary(); + end; + + +implementation + +uses Types; + +const + //** shear factor used for the italic effect (bigger value -> more bending) + cShearFactor = 0.25; + cShearMatrix: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + cShearMatrixInv: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + -cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + +var + LibraryInst: FT_Library; + +function NewGLColor(r, g, b, a: GLfloat): TGLColor; +begin + Result.r := r; + Result.g := g; + Result.b := b; + Result.a := a; +end; + +{** + * Returns the first power of 2 >= Value. + *} +function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} +begin + Result := 1; + while (Result < Value) do + Result := Result shl 1; +end; + + +{* + * TFont + *} + +constructor TFont.Create(); +begin + inherited; + ResetIntern(); +end; + +destructor TFont.Destroy(); +begin + inherited; +end; + +procedure TFont.ResetIntern(); +begin + fStyle := []; + fUseKerning := true; + fGlyphSpacing := 0.0; + fReflectionPass := false; + + // must be set by subclasses + fLineSpacing := 0.0; + fReflectionSpacing := 0.0; +end; + +procedure TFont.Reset(); +begin + ResetIntern(); +end; + +procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +var + LineList: TStringList; + LineIndex: integer; +begin + // split lines on newline (there is no WideString version of ExtractStrings) + LineList := TStringList.Create(); + ExtractStrings([#13], [], PChar(Text), LineList); + + // create an array of WideStrins from the UTF-8 string-list + SetLength(Lines, LineList.Count); + for LineIndex := 0 to LineList.Count-1 do + Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); + LineList.Free(); +end; + +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Result := BBox(LineArray, Advance); + SetLength(LineArray, 0); +end; + +function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Encode(Text), Advance); +end; + +procedure TFont.Print(const Text: TWideStringArray); +var + LineIndex: integer; +begin + // recursively call this function to draw reflected text + if ((Reflect in Style) and not ReflectionPass) then + begin + ReflectionPass := true; + Print(Text); + ReflectionPass := false; + end; + + // store current color, enable-flags, matrix-mode + glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); + + // set OpenGL state + glMatrixMode(GL_MODELVIEW); + glDisable(GL_DEPTH_TEST); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + { + // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? + glAlphaFunc(GL_GREATER, 0); + glEnable(GL_ALPHA_TEST); + + //TODO: Do we need depth-testing? + if (ReflectionPass) then + begin + glDepthMask(0); + glEnable(GL_DEPTH_TEST); + end; + } + + {$IFDEF FLIP_YAXIS} + glPushMatrix(); + glScalef(1, -1, 1); + {$ENDIF} + + // display text + for LineIndex := 0 to High(Text) do + begin + glPushMatrix(); + + // move to baseline + glTranslatef(0, -LineSpacing*LineIndex, 0); + + if ((Underline in Style) and not ReflectionPass) then + begin + glDisable(GL_TEXTURE_2D); + DrawUnderline(Text[LineIndex]); + glEnable(GL_TEXTURE_2D); + end; + + // draw reflection + if (ReflectionPass) then + begin + // set reflection spacing + glTranslatef(0, -ReflectionSpacing, 0); + // flip y-axis + glScalef(1, -1, 1); + end; + + // shear for italic effect + if (Italic in Style) then + glMultMatrixf(@cShearMatrix); + + // render text line + Render(Text[LineIndex]); + + glPopMatrix(); + end; + + // restore settings + {$IFDEF FLIP_YAXIS} + glPopMatrix(); + {$ENDIF} + glPopAttrib(); +end; + +procedure TFont.Print(const Text: string); +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Print(LineArray); + SetLength(LineArray, 0); +end; + +procedure TFont.Print(const Text: WideString); +begin + Print(UTF8Encode(Text)); +end; + +procedure TFont.DrawUnderline(const Text: WideString); +var + UnderlineY1, UnderlineY2: single; + Bounds: TBoundsDbl; +begin + UnderlineY1 := GetUnderlinePosition(); + UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); + Bounds := BBox(Text); + glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); +end; + +procedure TFont.SetStyle(Style: TFontStyle); +begin + fStyle := Style; +end; + +function TFont.GetStyle(): TFontStyle; +begin + Result := fStyle; +end; + +procedure TFont.SetLineSpacing(Spacing: single); +begin + fLineSpacing := Spacing; +end; + +function TFont.GetLineSpacing(): single; +begin + Result := fLineSpacing; +end; + +procedure TFont.SetGlyphSpacing(Spacing: single); +begin + fGlyphSpacing := Spacing; +end; + +function TFont.GetGlyphSpacing(): single; +begin + Result := fGlyphSpacing; +end; + +procedure TFont.SetReflectionSpacing(Spacing: single); +begin + fReflectionSpacing := Spacing; +end; + +function TFont.GetReflectionSpacing(): single; +begin + Result := fReflectionSpacing; +end; + +procedure TFont.SetUseKerning(Enable: boolean); +begin + fUseKerning := Enable; +end; + +function TFont.GetUseKerning(): boolean; +begin + Result := fUseKerning; +end; + +procedure TFont.SetReflectionPass(Enable: boolean); +begin + fReflectionPass := Enable; +end; + + +{* + * TScalableFont + *} + +constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); +var + MipmapLevel: integer; +begin + inherited Create(); + + fBaseFont := Font; + fMipmapFonts[0] := Font; + fUseMipmaps := UseMipmaps; + ResetIntern(); + + // create mipmap fonts if requested + if (UseMipmaps) then + begin + for MipmapLevel := 1 to cMaxMipmapLevel do + begin + fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); + // stop if no smaller mipmap font is returned + if (fMipmapFonts[MipmapLevel] = nil) then + Break; + end; + end; +end; + +destructor TScalableFont.Destroy(); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + fMipmapFonts[Level].Free; + inherited; +end; + +procedure TScalableFont.ResetIntern(); +begin + fScale := 1.0; + fAspect := 1.0; +end; + +procedure TScalableFont.Reset(); +var + Level: integer; +begin + inherited; + ResetIntern(); + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].Reset(); +end; + +{** + * Returns the mipmap level to use with regard to the current projection + * and modelview matrix, font scale and aspect. + * + * Note: + * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise + * the glyph widths/heights ratios and advance widths of the mipmap fonts + * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has + * width 12px, but at size 6px width 8px). + * - returned mipmap-level is used for all glyphs of the current text to print. + * This is faster, much easier to handle, since we just need to create + * multiple sized fonts and select the one we need for the mipmap-level and + * it avoids that neighbored glyphs use different mipmap-level which might + * look odd because one glyph might look blurry and the other sharp. + * + * Motivation: + * We do not use OpenGL for mipmapping as the results are very bad. At least + * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather + * blurry. + * Defining our own mipmaps by creating multiple textures with + * for different mimap levels is a pain, as the font size passed to freetype + * is not the size of the bitmaps created and it does not guarantee that a + * glyph bitmap of a font with font-size s/2 is half the size of the font with + * font-size s. If the bitmap size is just a single pixel bigger than the half + * we might need a texture of the next power-of-2 and the texture would not be + * half of the size of the next bigger mipmap. In addition we use a fixed one + * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe + * an outset that is added to the font, so creating a glyph mipmap that is + * exactly half the size of the next bigger one is a very difficult task. + * + * Solution: + * Use mipmap textures that are not exactly half the size of the next mipmap + * level. OpenGL does not support this (at least not without extensions). + * The trickiest task is to determine the mipmap to use by calculating the + * amount of minification that is performed in this function. + *} +function TScalableFont.GetMipmapLevel(): integer; +var + ModelMatrix, ProjMatrix: T16dArray; + WinCoords: array[0..2, 0..2] of GLdouble; + ViewPortArray: TViewPortArray; + Dist, Dist2: double; + WidthScale, HeightScale: double; +const + // width/height of square used for determining the scale + cTestSize = 10.0; + // an offset to the mipmap-level to adjust the change-over of two consecutive + // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 + // the result level will be 2. A bias of 0.5 is equal to rounding. + // With bias=0.1 we prefer larger mipmaps over smaller ones. + cBias = 0.2; +begin + // 1. retrieve current transformation matrices for gluProject + glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); + glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); + glGetIntegerv(GL_VIEWPORT, @ViewPortArray); + + // 2. project three of the corner points of a square with size cTestSize + // to window coordinates (the square is just a dummy for a glyph) + + // project point (x1, y1) to window corrdinates + gluProject(0, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); + // project point (x2, y1) to window corrdinates + gluProject(cTestSize, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); + // project point (x1, y2) to window corrdinates + gluProject(0, cTestSize, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); + + // 3. Lets see how much the width and height of the square changed. + // Calculate the width and height as displayed on the screen in window + // coordinates and calculate the ratio to the original coordinates in + // modelview space so the ratio gives us the scale (minification here). + + // projected width ||(x1, y1) - (x2, y1)|| + Dist := (WinCoords[0][0] - WinCoords[1][0]); + Dist2 := (WinCoords[0][1] - WinCoords[1][1]); + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + // projected height ||(x1, y1) - (x1, y2)|| + Dist := (WinCoords[0][0] - WinCoords[2][0]); + Dist2 := (WinCoords[0][1] - WinCoords[2][1]); + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); + + // 4. Now that we have got the scale, take the bigger minification scale + // and get it to a logarithmic scale as each mipmap is 1/2 the size of its + // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). + // The result is our mipmap-level = the index of the mipmap to use. + + // Level > 0: Minification; < 0: Magnification + Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); + + // clamp to valid range + if (Result < 0) then + Result := 0; + if (Result > High(fMipmapFonts)) then + Result := High(fMipmapFonts); +end; + +function TScalableFont.GetMipmapScale(Level: integer): single; +begin + if (fMipmapFonts[Level] = nil) then + begin + Result := -1; + Exit; + end; + + Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; +end; + +{** + * Returns the correct mipmap font for the current scale and projection + * matrix. The modelview scale is adjusted to the mipmap level, so + * Result.Print() will display the font in the correct size. + *} +function TScalableFont.ChooseMipmapFont(): TFont; +var + DesiredLevel: integer; + Level: integer; + MipmapScale: single; +begin + Result := nil; + DesiredLevel := GetMipmapLevel(); + + // get the smallest mipmap available for the desired level + // as not all levels must be assigned to a font. + for Level := DesiredLevel downto 0 do + begin + if (fMipmapFonts[Level] <> nil) then + begin + Result := fMipmapFonts[Level]; + Break; + end; + end; + + // since the mipmap font (if level > 0) is smaller than the base-font + // we have to scale to get its size right. + MipmapScale := fMipmapFonts[0].Height/Result.Height; + glScalef(MipmapScale, MipmapScale, 0); +end; + +procedure TScalableFont.Print(const Text: TWideStringArray); +begin + glPushMatrix(); + + // set scale and stretching + glScalef(fScale * fAspect, fScale, 0); + + // print text + if (fUseMipmaps) then + ChooseMipmapFont().Print(Text) + else + fBaseFont.Print(Text); + + glPopMatrix(); +end; + +procedure TScalableFont.Render(const Text: WideString); +begin + Assert(false, 'Unused TScalableFont.Render() was called'); +end; + +function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fBaseFont.BBox(Text, Advance); + Result.Left := Result.Left * fScale * fAspect; + Result.Right := Result.Right * fScale * fAspect; + Result.Top := Result.Top * fScale; + Result.Bottom := Result.Bottom * fScale; +end; + +procedure TScalableFont.SetHeight(Height: single); +begin + fScale := Height / fBaseFont.GetHeight(); +end; + +function TScalableFont.GetHeight(): single; +begin + Result := fBaseFont.GetHeight() * fScale; +end; + +procedure TScalableFont.SetAspect(Aspect: single); +begin + fAspect := Aspect; +end; + +function TScalableFont.GetAspect(): single; +begin + Result := fAspect; +end; + +function TScalableFont.GetAscender(): single; +begin + Result := fBaseFont.GetAscender() * fScale; +end; + +function TScalableFont.GetDescender(): single; +begin + Result := fBaseFont.GetDescender() * fScale; +end; + +procedure TScalableFont.SetLineSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetLineSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetGlyphSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetGlyphSpacing(): single; +begin + Result := fBaseFont.GetGlyphSpacing() * fScale; +end; + +procedure TScalableFont.SetReflectionSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetReflectionSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetStyle(Style: TFontStyle); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetStyle(Style); +end; + +function TScalableFont.GetStyle(): TFontStyle; +begin + Result := fBaseFont.GetStyle(); +end; + +function TScalableFont.GetUnderlinePosition(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +function TScalableFont.GetUnderlineThickness(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +procedure TScalableFont.SetUseKerning(Enable: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetUseKerning(Enable); +end; + + +{* + * TCachedFont + *} + +constructor TCachedFont.Create(); +begin + inherited; + fCache := TGlyphCache.Create(); +end; + +destructor TCachedFont.Destroy(); +begin + fCache.Free; + inherited; +end; + +function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +begin + Result := fCache.GetGlyph(ch); + if (Result = nil) then + begin + Result := LoadGlyph(ch); + if (not fCache.AddGlyph(ch, Result)) then + Result.Free; + end; +end; + +procedure TCachedFont.FlushCache(KeepBaseSet: boolean); +begin + fCache.FlushCache(KeepBaseSet); +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + i: WideChar; +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + + // load font information + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + + // support scalable fonts only + if (not FT_IS_SCALABLE(fFace)) then + raise Exception.Create('Font is not scalable'); + + if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then + raise Exception.Create('FT_Set_Pixel_Sizes failes'); + + // get scale factor for font-unit to pixel-size transformation + fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; + fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; + + ResetIntern(); + + // pre-cache some commonly used glyphs (' ' - '~') + for i := #32 to #126 do + fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); +end; + +destructor TFTFont.Destroy(); +begin + // free face + FT_Done_Face(fFace); + inherited; +end; + +procedure TFTFont.ResetIntern(); +begin + // Note: outset and non outset fonts use same spacing + fLineSpacing := fFace.height * fFontUnitScale.Y; + fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; +end; + +procedure TFTFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +begin + Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); +end; + +function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + Glyph, PrevGlyph: TFTGlyph; + TextLine: WideString; + LineYOffset: single; + LineIndex, CharIndex: integer; + LineBounds: TBoundsDbl; + KernDelta: FT_Vector; + UnderlinePos: double; +begin + // Reset global bounds + Result.Left := Infinity; + Result.Right := 0; + Result.Bottom := Infinity; + Result.Top := 0; + + // reset last glyph + PrevGlyph := nil; + + // display text + for LineIndex := 0 to High(Text) do + begin + // get next text line + TextLine := Text[LineIndex]; + LineYOffset := -LineSpacing * LineIndex; + + // reset line bounds + LineBounds.Left := Infinity; + LineBounds.Right := 0; + LineBounds.Bottom := Infinity; + LineBounds.Top := 0; + + // for each glyph image, compute its bounding box + for CharIndex := 1 to Length(TextLine) do + begin + Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); + if (Glyph <> nil) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + end; + + // update left bound (must be done before right bound is updated) + if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then + LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; + + // update right bound + if (CharIndex < Length(TextLine)) or // not the last character + (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) + Advance then // or in advance mode + begin + // add advance and glyph spacing + LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing + end + else + begin + // add glyph's right bound + LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; + end; + + // update bottom and top bounds + if (Glyph.Bounds.Bottom < LineBounds.Bottom) then + LineBounds.Bottom := Glyph.Bounds.Bottom; + if (Glyph.Bounds.Top > LineBounds.Top) then + LineBounds.Top := Glyph.Bounds.Top; + end; + + PrevGlyph := Glyph; + end; + + // handle italic font style + if (Italic in Style) then + begin + LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; + LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; + end; + + // handle underlined font style + if (Underline in Style) then + begin + UnderlinePos := GetUnderlinePosition(); + if (UnderlinePos < LineBounds.Bottom) then + LineBounds.Bottom := UnderlinePos; + end; + + // add line offset + LineBounds.Bottom := LineBounds.Bottom + LineYOffset; + LineBounds.Top := LineBounds.Top + LineYOffset; + + // adjust global bounds + if (Result.Left > LineBounds.Left) then + Result.Left := LineBounds.Left; + if (Result.Right < LineBounds.Right) then + Result.Right := LineBounds.Right; + if (Result.Bottom > LineBounds.Bottom) then + Result.Bottom := LineBounds.Bottom; + if (Result.Top < LineBounds.Top) then + Result.Top := LineBounds.Top; + end; + + // if left or bottom bound was not set, set them to 0 + if (Result.Left = Infinity) then + Result.Left := 0.0; + if (Result.Bottom = Infinity) then + Result.Bottom := 0.0; +end; + +procedure TFTFont.Render(const Text: WideString); +var + CharIndex: integer; + Glyph, PrevGlyph: TFTGlyph; + KernDelta: FT_Vector; +begin + // reset last glyph + PrevGlyph := nil; + + // draw current line + for CharIndex := 1 to Length(Text) do + begin + Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); + if (Assigned(Glyph)) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + end; + + if (ReflectionPass) then + Glyph.RenderReflection() + else + Glyph.Render(fUseDisplayLists); + + glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); + end; + + PrevGlyph := Glyph; + end; +end; + +function TFTFont.GetHeight(): single; +begin + Result := Ascender - Descender; +end; + +function TFTFont.GetAscender(): single; +begin + Result := fFace.ascender * fFontUnitScale.Y + Outset*2; +end; + +function TFTFont.GetDescender(): single; +begin + // Note: outset is not part of the descender as the baseline is lifted + Result := fFace.descender * fFontUnitScale.Y; +end; + +function TFTFont.GetUnderlinePosition(): single; +begin + Result := fFace.underline_position * fFontUnitScale.Y - Outset; +end; + +function TFTFont.GetUnderlineThickness(): single; +begin + Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; +end; + + +{* + * TFTScalableFont + *} + +constructor TFTScalableFont.Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting to preserve font outlines at each font + // size, otherwise the font widths/heights do not match resulting in ugly + // text size changes during zooming. + // A drawback is a reduced quality with smaller font sizes but it is not that + // bad with gray-scaled rendering (at least it looks better than OpenGL's + // linear downscaling on minification). + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTFont; +begin + Result := nil; + BaseFont := TFTFont(fBaseFont); + ScaledSize := Round(BaseFont.Size * Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset * Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableFont.GetOutset(): single; +begin + Result := TFTFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TOutlineFont + *} + +constructor TFTOutlineFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + + fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + + ResetIntern(); +end; + +destructor TFTOutlineFont.Destroy; +begin + fOutlineFont.Free; + fInnerFont.Free; + inherited; +end; + +procedure TFTOutlineFont.ResetIntern(); +begin + // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing + // of the outline font? + //fInnerFont.GlyphSpacing := fOutset*2; + fOutlineFont.GlyphSpacing := -fOutset*2; + + fLineSpacing := fOutlineFont.LineSpacing; + fReflectionSpacing := fOutlineFont.ReflectionSpacing; + fOutlineColor := NewGLColor(0, 0, 0, 1); +end; + +procedure TFTOutlineFont.Reset(); +begin + inherited; + fInnerFont.Reset(); + fOutlineFont.Reset(); + ResetIntern(); +end; + +procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +begin + glPushAttrib(GL_CURRENT_BIT); + glColor4fv(@fOutlineColor.vals); + fOutlineFont.DrawUnderline(Text); + glPopAttrib(); + + glPushMatrix(); + glTranslatef(fOutset, 0, 0); + fInnerFont.DrawUnderline(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.Render(const Text: WideString); +begin + { setup and render outline font } + + // save old color + glPushAttrib(GL_CURRENT_BIT); + glColor4fv(@fOutlineColor.vals); + glPushMatrix(); + fOutlineFont.Render(Text); + glPopMatrix(); + glPopAttrib(); + + { setup and render inner font } + + glPushMatrix(); + glTranslatef(fOutset, fOutset, 0); + fInnerFont.Render(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +begin + fOutlineColor := NewGLColor(r, g, b, a); +end; + +procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); +begin + fOutlineFont.FlushCache(KeepBaseSet); + fInnerFont.FlushCache(KeepBaseSet); +end; + +function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fOutlineFont.BBox(Text, Advance); +end; + +function TFTOutlineFont.GetHeight(): single; +begin + Result := fOutlineFont.Height; +end; + +function TFTOutlineFont.GetAscender(): single; +begin + Result := fOutlineFont.Ascender; +end; + +function TFTOutlineFont.GetDescender(): single; +begin + Result := fOutlineFont.Descender; +end; + +procedure TFTOutlineFont.SetLineSpacing(Spacing: single); +begin + inherited SetLineSpacing(Spacing); + fInnerFont.LineSpacing := Spacing; + fOutlineFont.LineSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); +begin + inherited SetGlyphSpacing(Spacing); + fInnerFont.GlyphSpacing := Spacing; + fOutlineFont.GlyphSpacing := Spacing - Outset*2; +end; + +procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); +begin + inherited SetReflectionSpacing(Spacing); + fInnerFont.ReflectionSpacing := Spacing; + fOutlineFont.ReflectionSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetStyle(Style: TFontStyle); +begin + inherited SetStyle(Style); + fInnerFont.Style := Style; + fOutlineFont.Style := Style; +end; + +function TFTOutlineFont.GetStyle(): TFontStyle; +begin + Result := inherited GetStyle(); +end; + +function TFTOutlineFont.GetUnderlinePosition(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +function TFTOutlineFont.GetUnderlineThickness(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +procedure TFTOutlineFont.SetUseKerning(Enable: boolean); +begin + inherited SetUseKerning(Enable); + fInnerFont.fUseKerning := Enable; + fOutlineFont.fUseKerning := Enable; +end; + +procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); +begin + inherited SetReflectionPass(Enable); + fInnerFont.fReflectionPass := Enable; + fOutlineFont.fReflectionPass := Enable; +end; + +{** + * TScalableOutlineFont + *} + +constructor TFTScalableOutlineFont.Create( + const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting (see TFTScalableFont.Create) + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTOutlineFont; +begin + Result := nil; + BaseFont := TFTOutlineFont(fBaseFont); + ScaledSize := Round(BaseFont.Size*Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTOutlineFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset*Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableOutlineFont.GetOutset(): single; +begin + Result := TFTOutlineFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); +end; + +procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TFTGlyph + *} + +const + {** + * Size of the transparent border surrounding the glyph image in the texture. + * The border is necessary because OpenGL does not smooth texels at the + * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. + * Without the border, magnified glyph textures look very ugly at their edges. + * It looks edgy, as if some pixels are missing especially on the left edge + * (just set cTexSmoothBorder to 0 to see what is meant by this). + * With the border even the glyphs edges are blended to the border (transparent) + * color and everything looks nice. + * + * Note: + * OpenGL already supports texture border by setting the border parameter + * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the + * border pixels to the border color. In some forums it is discouraged to use + * the border parameter as only a few of the more modern graphics cards support + * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and + * the glyph's background got black. So instead of using this feature we + * handle it on our own. The only drawback is that textures might get bigger + * because the border might require a higher power of 2 size instead of just + * two additional pixels. + *} + cTexSmoothBorder = 1; + +procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + begin + if (Val1 < Val2) then + Val1 := Val2; + end; + +var + I, X, Y: integer; + SrcBuffer,TmpBuffer: TGLubyteDynArray; + TexLine, TexLinePrev, TexLineNext: PGLubyteArray; + SrcLine: PGLubyteArray; + AlphaScale: single; + Value, ValueNeigh, ValueDiag: GLubyte; +const + // square-root of 2 used for diagonal neighbor pixels + cSqrt2 = 1.4142; + // number of ignored pixels on each edge of the bitmap. Consists of: + // - border used for font smoothing and + // - outer (extruded) bitmap pixel (because it is just written but never read) + cBorder = cTexSmoothBorder + 1; +begin + // allocate memory for temporary buffer + SetLength(SrcBuffer, Length(TexBuffer)); + FillChar(SrcBuffer[0], Length(TexBuffer), 0); + + // extrude pixel by pixel + for I := 1 to Ceil(Outset) do + begin + // swap arrays + TmpBuffer := TexBuffer; + TexBuffer := SrcBuffer; + SrcBuffer := TmpBuffer; + + // as long as we add an entire pixel of outset, use a solid color. + // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid + // pixels and one blended with alpha=0.2. + // For the fractional part I = Ceil(Outset) is always true. + if (I <= Outset) then + AlphaScale := 1 + else + AlphaScale := Outset - Trunc(Outset); + + // copy data to the expanded bitmap. + for Y := cBorder to fTexSize.Height - 2*cBorder do + begin + TexLine := @TexBuffer[Y*fTexSize.Width]; + TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; + TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; + SrcLine := @SrcBuffer[Y*fTexSize.Width]; + + // expand current line's pixels + for X := cBorder to fTexSize.Width - 2*cBorder do + begin + Value := SrcLine[X]; + ValueNeigh := Round(Value * AlphaScale); + ValueDiag := Round(ValueNeigh / cSqrt2); + + SetToMax(TexLine[X], Value); + SetToMax(TexLine[X-1], ValueNeigh); + SetToMax(TexLine[X+1], ValueNeigh); + + SetToMax(TexLinePrev[X], ValueNeigh); + SetToMax(TexLinePrev[X-1], ValueDiag); + SetToMax(TexLinePrev[X+1], ValueDiag); + + SetToMax(TexLineNext[X], ValueNeigh); + SetToMax(TexLineNext[X-1], ValueDiag); + SetToMax(TexLineNext[X+1], ValueDiag); + end; + end; + end; + + TmpBuffer := nil; + SetLength(SrcBuffer, 0); +end; + +procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); +var + X, Y: integer; + Glyph: FT_Glyph; + BitmapGlyph: FT_BitmapGlyph; + Bitmap: PFT_Bitmap; + BitmapLine: PChar; + BitmapBuffer: PChar; + TexBuffer: TGLubyteDynArray; + TexLine: PGLubyteArray; + CBox: FT_BBox; +begin + // load the Glyph for our character + if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then + raise Exception.Create('FT_Load_Glyph failed'); + + // move the face's glyph into a Glyph object + if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then + raise Exception.Create('FT_Get_Glyph failed'); + + // store scaled advance width/height in glyph-object + fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + + // get the contour's bounding box (in 1/64th pixels, not font-units) + FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); + // convert 1/64th values to double values + fBounds.Left := CBox.xMin / 64; + fBounds.Right := CBox.xMax / 64 + fOutset*2; + fBounds.Bottom := CBox.yMin / 64; + fBounds.Top := CBox.yMax / 64 + fOutset*2; + + // convert the glyph to a bitmap (and destroy original glyph image) + FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + BitmapGlyph := FT_BitmapGlyph(Glyph); + + // get bitmap offsets + fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; + // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect + // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. + fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; + + // make accessing the bitmap easier + Bitmap := @BitmapGlyph^.bitmap; + // get bitmap dimensions + fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; + fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; + + // get power-of-2 bitmap widths + fTexSize.Width := + NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); + fTexSize.Height := + NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); + + // texture-widths ignoring empty (power-of-2) padding space + fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; + fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; + + // allocate memory for texture data + SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); + FillChar(TexBuffer[0], Length(TexBuffer), 0); + + // Freetype stores the bitmap with either upper (pitch is > 0) or lower + // (pitch < 0) glyphs line first. Set the buffer to the upper line. + // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html + if (Bitmap.pitch > 0) then + BitmapBuffer := @Bitmap.buffer[0] + else + BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; + + // copy data to texture bitmap (upper line first). + for Y := 0 to Bitmap.rows-1 do + begin + // set pointer to first pixel in line that holds bitmap data. + // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels + // that are added by Extrude() later. + TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + + cTexSmoothBorder + Ceil(fOutset)]; + // get next lower line offset, use pitch instead of width as it tells + // us the storage direction of the lines. In addition a line might be padded. + BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; + for X := 0 to Bitmap.width-1 do + TexLine[X] := GLubyte(BitmapLine[X]); + end; + + if (fOutset > 0) then + Extrude(TexBuffer, fOutset); + + // allocate resources for textures and display lists + glGenTextures(1, @fTexture); + + // setup texture parameters + glBindTexture(GL_TEXTURE_2D, fTexture); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + // create alpha-map (GL_ALPHA component only). + // TexCoord (0,0) corresponds to the top left pixel of the glyph, + // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses + // a cartesian (y-axis up) coordinate system for textures. + // See the cTexSmoothBorder comment for info on texture borders. + glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, + 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); + + // free expanded data + SetLength(TexBuffer, 0); + + // create the display list + fDisplayList := glGenLists(1); + + // render to display-list + glNewList(fDisplayList, GL_COMPILE); + Render(false); + glEndList(); + + // free glyph data (bitmap, etc.) + FT_Done_Glyph(Glyph); +end; + +constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFont := Font; + fOutset := Outset; + + // get the Freetype char-index (use default UNICODE charmap) + fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + + CreateTexture(LoadFlags); +end; + +destructor TFTGlyph.Destroy; +begin + if (fDisplayList <> 0) then + glDeleteLists(fDisplayList, 1); + if (fTexture <> 0) then + glDeleteTextures(1, @fTexture); + inherited; +end; + +procedure TFTGlyph.Render(UseDisplayLists: boolean); +begin + // use display-lists if enabled and exit + if (UseDisplayLists) then + begin + glCallList(fDisplayList); + Exit; + end; + + glBindTexture(GL_TEXTURE_2D, fTexture); + glPushMatrix(); + + // move to top left glyph position + glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glTexCoord2f(fTexOffset.X, 0); + glVertex2f(fBitmapCoords.Width, 0); + + // top left + glTexCoord2f(0, 0); + glVertex2f(0, 0); + + // bottom left + glTexCoord2f(0, fTexOffset.Y); + glVertex2f(0, -fBitmapCoords.Height); + + // bottom right + glTexCoord2f(fTexOffset.X, fTexOffset.Y); + glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); + glEnd(); + + glPopMatrix(); +end; + +procedure TFTGlyph.RenderReflection(); +var + Color: TGLColor; + TexUpperPos: single; + TexLowerPos: single; + UpperPos: single; +const + CutOff = 0.6; +begin + glPushMatrix(); + glBindTexture(GL_TEXTURE_2D, fTexture); + glGetFloatv(GL_CURRENT_COLOR, @Color.vals); + + // add extra space to the left of the glyph + glTranslatef(fBitmapCoords.Left, 0, 0); + + // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. + // If CutOff is set to 0.5 only half of the glyph height is displayed. + UpperPos := fFont.Descender + fFont.Height * CutOff; + + // the glyph texture's height is just the height of the glyph but not the font + // height. Setting a color for the upper and lower bounds of the glyph results + // in different color gradients. So we have to set the color values for the + // descender and ascender (as we have a cutoff, for the upper-pos here) as + // these positions are font but not glyph specific. + + // To get the texture positions we have to enhance the texture at the top and + // bottom by the amount from the top to ascender (rather upper-pos here) and + // from the bottom (Height-Top) to descender. Then we have to convert those + // heights to texture coordinates by dividing by the bitmap Height and + // removing the power-of-2 padding space by multiplying with fTexOffset.Y + // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). + TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; + TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / + fBitmapCoords.Height + 1) * fTexOffset.Y; + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glColor4f(Color.r, Color.g, Color.b, 0); + glTexCoord2f(fTexOffset.X, TexUpperPos); + glVertex2f(fBitmapCoords.Width, UpperPos); + + // top left + glTexCoord2f(0, TexUpperPos); + glVertex2f(0, UpperPos); + + // bottom left + glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); + glTexCoord2f(0, TexLowerPos); + glVertex2f(0, fFont.Descender); + + // bottom right + glTexCoord2f(fTexOffset.X, TexLowerPos); + glVertex2f(fBitmapCoords.Width, fFont.Descender); + glEnd(); + + glPopMatrix(); + + // restore old color + // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then + // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) + glColor4fv(@Color.vals); +end; + +function TFTGlyph.GetAdvance(): TPositionDbl; +begin + Result := fAdvance; +end; + +function TFTGlyph.GetBounds(): TBoundsDbl; +begin + Result := fBounds; +end; + + +{* + * TGlyphCache + *} + +constructor TGlyphCache.Create(); +begin + inherited; + fHash := TList.Create(); +end; + +destructor TGlyphCache.Destroy(); +begin + // free cached glyphs + FlushCache(false); + + // destroy TList + fHash.Free; + + inherited; +end; + +function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; +var + I: integer; + Entry: TGlyphCacheHashEntry; +begin + Result := nil; + + for I := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[I]); + + if (Entry.BaseCode > BaseCode) then + begin + InsertPos := I; + Exit; + end; + + if (Entry.BaseCode = BaseCode) then + begin + InsertPos := I; + Result := @Entry.GlyphTable; + Exit; + end; + end; + + InsertPos := fHash.Count; +end; + +function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +var + BaseCode: cardinal; + GlyphCode: integer; + InsertPos: integer; + GlyphTable: PGlyphTable; + Entry: TGlyphCacheHashEntry; +begin + Result := false; + + BaseCode := cardinal(ch) shr 8; + GlyphTable := FindGlyphTable(BaseCode, InsertPos); + if (GlyphTable = nil) then + begin + Entry := TGlyphCacheHashEntry.Create(BaseCode); + GlyphTable := @Entry.GlyphTable; + fHash.Insert(InsertPos, Entry); + end; + + // get glyph table offset + GlyphCode := cardinal(ch) and $FF; + // insert glyph into table if not present + if (GlyphTable[GlyphCode] = nil) then + begin + GlyphTable[GlyphCode] := Glyph; + Result := true; + end; +end; + +procedure TGlyphCache.DeleteGlyph(ch: WideChar); +var + Table: PGlyphTable; + TableIndex, GlyphIndex: integer; + TableEmpty: boolean; +begin + // find table + Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + if (Table = nil) then + Exit; + + // find glyph + GlyphIndex := cardinal(ch) and $FF; + if (Table[GlyphIndex] <> nil) then + begin + // destroy glyph + FreeAndNil(Table[GlyphIndex]); + + // check if table is empty + TableEmpty := true; + for GlyphIndex := 0 to High(Table^) do + begin + if (Table[GlyphIndex] <> nil) then + begin + TableEmpty := false; + Break; + end; + end; + + // free empty table + if (TableEmpty) then + begin + fHash.Delete(TableIndex); + end; + end; +end; + +function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +var + InsertPos: integer; + Table: PGlyphTable; +begin + Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + if (Table = nil) then + Result := nil + else + Result := Table[cardinal(ch) and $FF]; +end; + +function TGlyphCache.HasGlyph(ch: WideChar): boolean; +begin + Result := (GetGlyph(ch) <> nil); +end; + +procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); +var + EntryIndex, TableIndex: integer; + Entry: TGlyphCacheHashEntry; +begin + // destroy cached glyphs + for EntryIndex := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); + + // the base set (0-255) has BaseCode 0 as the upper bytes are 0. + if KeepBaseSet and (Entry.fBaseCode = 0) then + Continue; + + for TableIndex := 0 to High(Entry.GlyphTable) do + begin + if (Entry.GlyphTable[TableIndex] <> nil) then + FreeAndNil(Entry.GlyphTable[TableIndex]); + end; + FreeAndNil(Entry); + end; +end; + + +{* + * TGlyphCacheEntry + *} + +constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); +begin + inherited Create(); + fBaseCode := BaseCode; +end; + + +{* + * TFreeType + *} + +class function TFreeType.GetLibrary(): FT_Library; +begin + if (LibraryInst = nil) then + begin + // initialize freetype + if (FT_Init_FreeType(LibraryInst) <> 0) then + raise Exception.Create('FT_Init_FreeType failed'); + end; + Result := LibraryInst; +end; + +class procedure TFreeType.FreeLibrary(); +begin + if (LibraryInst <> nil) then + FT_Done_FreeType(LibraryInst); + LibraryInst := nil; +end; + + +{$IFDEF BITMAP_FONT} +{* + * TBitmapFont + *} + +constructor TBitmapFont.Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); +begin + inherited Create(); + + fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); + fTexSize := 1024; + fOutline := Outline; + fBaseline := Baseline; + fAscender := Ascender; + fDescender := Descender; + + LoadFontInfo(ChangeFileExt(Filename, '.dat')); + + ResetIntern(); +end; + +destructor TBitmapFont.Destroy(); +begin + glDeleteTextures(1, @fTex.TexNum); + inherited; +end; + +procedure TBitmapFont.ResetIntern(); +begin + fLineSpacing := Height; +end; + +procedure TBitmapFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); +var + Count: integer; +begin + for Count := 0 to 255 do + fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; +end; + +procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +var + Stream: TFileStream; +begin + FillChar(fWidths[0], Length(fWidths), 0); + + Stream := nil; + try + Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream.Read(fWidths, 256); + except + raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + end; + Stream.Free; +end; + +function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + LineIndex, CharIndex: integer; + CharCode: cardinal; + Line: WideString; + LineWidth: double; +begin + Result.Left := 0; + Result.Right := 0; + Result.Top := Height; + Result.Bottom := 0; + + for LineIndex := 0 to High(Text) do + begin + Line := Text[LineIndex]; + LineWidth := 0; + for CharIndex := 1 to Length(Line) do + begin + CharCode := Ord(Line[CharIndex]); + if (CharCode < Length(fWidths)) then + LineWidth := LineWidth + fWidths[CharCode]; + end; + if (LineWidth > Result.Right) then + Result.Right := LineWidth; + end; +end; + +procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +var + TexX, TexY: real; + TexR, TexB: real; + GlyphWidth: real; + PL, PT: real; + PR, PB: real; + CharCode: cardinal; +begin + CharCode := Ord(ch); + if (CharCode > High(fWidths)) then + CharCode := 0; + + GlyphWidth := fWidths[CharCode]; + + // set texture positions + TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; + TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; + TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; + TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; + + // set vector positions + PL := AdvanceX - fOutline; + PR := PL + GlyphWidth + fOutline*2; + PB := -fBaseline; + PT := PB + fTexSize div 16; + + (* + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + *) + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fTex.TexNum); + + if (not ReflectionPass) then + begin + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + end + else + begin + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + +(* + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); + glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); + glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); + + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); + glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); + glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); +*) + glEnd; + + //write the colour back + glColor4fv(@fTempColor); + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + (* + if (Font.Blend) then + glDisable(GL_BLEND); + *) + + AdvanceX := AdvanceX + GlyphWidth; +end; + +procedure TBitmapFont.Render(const Text: WideString); +var + CharIndex: integer; + AdvanceX: real; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + //Save the current color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @fTempColor); + + AdvanceX := 0; + for CharIndex := 1 to Length(Text) do + begin + RenderChar(Text[CharIndex], AdvanceX); + end; +end; + +function TBitmapFont.GetHeight(): single; +begin + Result := fAscender - fDescender; +end; + +function TBitmapFont.GetAscender(): single; +begin + Result := fAscender; +end; + +function TBitmapFont.GetDescender(): single; +begin + Result := fDescender; +end; + +function TBitmapFont.GetUnderlinePosition(): single; +begin + Result := -2.0; +end; + +function TBitmapFont.GetUnderlineThickness(): single; +begin + Result := 1.0; +end; + +{$ENDIF BITMAP_FONT} + + +initialization + +finalization + TFreeType.FreeLibrary(); + +end. -- cgit v1.2.3 From 57f6e8e49c35a1e43d73255edc8fb35308563319 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 10:19:28 +0000 Subject: MainThreadExec() can be used to delegate execution from e.g. a callback thread to the main thread. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1468 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 49 +++++++++++++++++++++++++++++++++++++++++++++---- 1 file changed, 45 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 6e6d2ad7..6c77ebc0 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -107,7 +107,6 @@ var PlayListPath: string; Done: Boolean; - Event: TSDL_event; // FIXME: ConversionFileName should not be global ConversionFileName: string; Restart: boolean; @@ -122,6 +121,7 @@ const MAX_SONG_SCORE = 10000; // max. achievable points per song MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; procedure InitializePaths; procedure AddSongPath(const Path: string); @@ -138,6 +138,24 @@ function GetMidBeat(Time: real): real; function GetTimeFromBeat(Beat: integer): real; procedure ClearScores(PlayerNum: integer); + +type + TMainThreadExecProc = procedure(Data: Pointer); + +const + MAINTHREAD_EXEC_EVENT = SDL_USEREVENT + 2; + +{* + * Delegates execution of procedure Proc to the main thread. + * The Data pointer is passed to the procedure when it is called. + * The main thread is notified by signaling a MAINTHREAD_EXEC_EVENT which + * is handled in CheckEvents. + * Note that Data must not be a pointer to local data. If you want to pass local + * data, use Getmem() or New() or create a temporary object. + *} +procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); + + implementation uses @@ -452,11 +470,13 @@ begin End; procedure CheckEvents; +var + Event: TSDL_event; begin if Assigned(Display.NextScreen) then Exit; - while SDL_PollEvent( @event ) = 1 do + while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of SDL_QUITEV: @@ -465,9 +485,10 @@ begin Display.NextScreenWithCheck := nil; Display.CheckOK := True; end; - { SDL_MOUSEBUTTONDOWN: - with Event.button Do + begin + { + with Event.button do begin if State = SDL_BUTTON_LEFT Then begin @@ -475,6 +496,7 @@ begin end; end; } + end; SDL_VIDEORESIZE: begin ScreenW := Event.resize.w; @@ -560,10 +582,29 @@ begin begin // not implemented end; + MAINTHREAD_EXEC_EVENT: + with Event.user do + begin + TMainThreadExecProc(data1)(data2); + end; end; // case end; // while end; +procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); +var + Event: TSDL_Event; +begin + with Event.user do + begin + type_ := MAINTHREAD_EXEC_EVENT; + code := 0; // not used at the moment + data1 := @Proc; + data2 := Data; + end; + SDL_PushEvent(@Event); +end; + function GetTimeForBeats(BPM, Beats: real): real; begin Result := 60 / BPM * Beats; -- cgit v1.2.3 From f0d2b5c1d1e91c70e7e9e0ffd5600bb90a0faf6a Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 10:21:42 +0000 Subject: Some threading questions cleared: - file handling is safe as long as only one thread owns the file descriptor - console is safe as long as the thread was created by FPC/Delphi git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1469 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommon.pas | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index 6195a680..a52349c0 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -504,22 +504,11 @@ begin end; {* - * With FPC console output is not thread-safe. + * FPC uses threadvars (TLS) managed by FPC for console output locking. * Using WriteLn() from external threads (like in SDL callbacks) - * will damage the heap and crash the program. - * Most probably FPC uses thread-local-data (TLS) to lock a mutex on - * the console-buffer. This does not work with external lib's threads - * because these do not have the TLS data and so it crashes while - * accessing unallocated memory. + * will crash the program as those threadvars have never been initialized. * The solution is to create an FPC-managed thread which has the TLS data - * and use it to handle the console-output (hence it is called Console-Handler) - * It should be safe to do so, but maybe FPC requires the main-thread to access - * the console-buffer only. In this case output should be delegated to it. - * - * TODO: - check if it is safe if an FPC-managed thread different than the - * main-thread accesses the console-buffer in FPC. - * - check if Delphi's WriteLn is thread-safe. - * - check if we need to synchronize file-output too + * and use it to handle the console-output (hence it is called Console-Handler) *} procedure ConsoleWriteLn(const msg: string); begin -- cgit v1.2.3 From 0030b564676f47b921593084ea952968eb74eaf7 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 25 Oct 2008 11:01:28 +0000 Subject: Software boost enabled again. TODO: boost per device, not for all. Note: do not use software boost if possible. Always adjust the the mixer options (volume, mic boost) there first. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1472 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 6 +----- 1 file changed, 1 insertion(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 3946c87c..132bafd5 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -275,7 +275,7 @@ var i: integer; begin // apply software boost - //BoostBuffer(Buffer, Size); + BoostBuffer(Buffer, BufferSize); // voice passthrough (send data to playback-device) if (assigned(VoiceStream)) then @@ -473,7 +473,6 @@ var Boost: byte; begin // TODO: set boost per device - { case Ini.MicBoost of 0: Boost := 1; 1: Boost := 2; @@ -481,8 +480,6 @@ begin 3: Boost := 8; else Boost := 1; end; - } - Boost := 1; // at the moment we will boost SInt16 data only if (AudioFormat.Format = asfS16) then @@ -496,7 +493,6 @@ begin 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); -- cgit v1.2.3 From d6770dd47dcb871f021868dec2b333527ffb8ee8 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 26 Oct 2008 11:54:33 +0000 Subject: git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1479 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 5328 ++++++++++++++++++++++++++-------------------------- 1 file changed, 2690 insertions(+), 2638 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 947a1c6f..30be4c3b 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1,2646 +1,2698 @@ -unit UFont; - -{$IFDEF FPC} - {$mode delphi}{$H+} -{$ENDIF} - -{$DEFINE HasInline} - -interface - -// Flip direction of y-axis. -// Default is a cartesian coordinate system with y-axis in upper direction -// but with USDX the y-axis is in lower direction. -{$DEFINE FLIP_YAXIS} -{$DEFINE BITMAP_FONT} - -uses - FreeType, - gl, - glext, - glu, - sdl, - {$IFDEF BITMAP_FONT} - UTexture, - {$ENDIF} - Math, - Classes, - SysUtils; - -type - - PGLubyteArray = ^TGLubyteArray; - TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; - TGLubyteDynArray = array of GLubyte; - - TWideStringArray = array of WideString; - - TGLColor = packed record - case byte of - 0: ( vals: array[0..3] of GLfloat; ); - 1: ( r, g, b, a: GLfloat; ); - end; - - TBoundsDbl = record - Left, Right: double; - Bottom, Top: double; - end; - - TPositionDbl = record - X, Y: double; - end; - - TTextureSize = record - Width, Height: integer; - end; - - TBitmapCoords = record - Left, Top: double; - Width, Height: integer; - end; - - {** - * Abstract base class representing a glyph. - *} - TGlyph = class - protected - function GetAdvance(): TPositionDbl; virtual; abstract; - function GetBounds(): TBoundsDbl; virtual; abstract; - public - procedure Render(UseDisplayLists: boolean); virtual; abstract; - procedure RenderReflection(); virtual; abstract; - - {** Distance to next glyph (in pixels) *} - property Advance: TPositionDbl read GetAdvance; - {** Glyph bounding box (in pixels) *} - property Bounds: TBoundsDbl read GetBounds; - end; - - {** - * Font styles used by TFont.Style - *} - TFontStyle = set of (Italic, Underline, Reflect); - - {** - * Base font class. - *} - TFont = class - private - {** Non-virtual reset-method used in Create() and Reset() } - procedure ResetIntern(); - - protected - fStyle: TFontStyle; - fUseKerning: boolean; - fLineSpacing: single; // must be inited by subclass - fReflectionSpacing: single; // must be inited by subclass to -2*Descender - fGlyphSpacing: single; - fReflectionPass: boolean; - - {** - * Splits lines in Text seperated by newline (char-code #13). - * @param Text UTF-8 encoded string - * @param Lines splitted WideString lines - *} - procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); - - {** - * Print an array of WideStrings. Each array-item is a line of text. - * Lines of text are seperated by the line-spacing. - * This is the base function for all text drawing. - *} - procedure Print(const Text: TWideStringArray); overload; virtual; - - {** +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UFont; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +interface + +{$IFNDEF FREETYPE_DEMO} + // Flip direction of y-axis. + // Default is a cartesian coordinate system with y-axis in upper direction + // but with USDX the y-axis is in lower direction. + {$DEFINE FLIP_YAXIS} + {$DEFINE BITMAP_FONT} +{$ENDIF} + +uses + FreeType, + gl, + glext, + glu, + sdl, + {$IFDEF BITMAP_FONT} + UTexture, + {$ENDIF} + Math, + Classes, + SysUtils; + +type + + PGLubyteArray = ^TGLubyteArray; + TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; + TGLubyteDynArray = array of GLubyte; + + TWideStringArray = array of WideString; + + TGLColor = packed record + case byte of + 0: ( vals: array[0..3] of GLfloat; ); + 1: ( r, g, b, a: GLfloat; ); + end; + + TBoundsDbl = record + Left, Right: double; + Bottom, Top: double; + end; + + TPositionDbl = record + X, Y: double; + end; + + TTextureSize = record + Width, Height: integer; + end; + + TBitmapCoords = record + Left, Top: double; + Width, Height: integer; + end; + + {** + * Abstract base class representing a glyph. + *} + TGlyph = class + protected + function GetAdvance(): TPositionDbl; virtual; abstract; + function GetBounds(): TBoundsDbl; virtual; abstract; + public + procedure Render(UseDisplayLists: boolean); virtual; abstract; + procedure RenderReflection(); virtual; abstract; + + {** Distance to next glyph (in pixels) *} + property Advance: TPositionDbl read GetAdvance; + {** Glyph bounding box (in pixels) *} + property Bounds: TBoundsDbl read GetBounds; + end; + + {** + * Font styles used by TFont.Style + *} + TFontStyle = set of (Italic, Underline, Reflect); + + {** + * Base font class. + *} + TFont = class + private + {** Non-virtual reset-method used in Create() and Reset() } + procedure ResetIntern(); + + protected + fStyle: TFontStyle; + fUseKerning: boolean; + fLineSpacing: single; // must be inited by subclass + fReflectionSpacing: single; // must be inited by subclass to -2*Descender + fGlyphSpacing: single; + fReflectionPass: boolean; + + {** + * Splits lines in Text seperated by newline (char-code #13). + * @param Text UTF-8 encoded string + * @param Lines splitted WideString lines + *} + procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + + {** + * Print an array of WideStrings. Each array-item is a line of text. + * Lines of text are seperated by the line-spacing. + * This is the base function for all text drawing. + *} + procedure Print(const Text: TWideStringArray); overload; virtual; + + {** * Draws an underline. *} - procedure DrawUnderline(const Text: WideString); virtual; - - {** - * Renders (one) line of text. - *} - procedure Render(const Text: WideString); virtual; abstract; - - {** - * Returns the bounds of text-lines contained in Text. - * @param(Advance if true the right bound is set to the advance instead - * of the minimal right bound.) - *} - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; - - {** - * Resets all user settings to default values. - * Override methods should always call the inherited version. - *} - procedure Reset(); virtual; - - function GetHeight(): single; virtual; abstract; - function GetAscender(): single; virtual; abstract; - function GetDescender(): single; virtual; abstract; - procedure SetLineSpacing(Spacing: single); virtual; - function GetLineSpacing(): single; virtual; - procedure SetGlyphSpacing(Spacing: single); virtual; - function GetGlyphSpacing(): single; virtual; - procedure SetReflectionSpacing(Spacing: single); virtual; - function GetReflectionSpacing(): single; virtual; - procedure SetStyle(Style: TFontStyle); virtual; - function GetStyle(): TFontStyle; virtual; - function GetUnderlinePosition(): single; virtual; abstract; - function GetUnderlineThickness(): single; virtual; abstract; - procedure SetUseKerning(Enable: boolean); virtual; - function GetUseKerning(): boolean; virtual; - procedure SetReflectionPass(Enable: boolean); virtual; - - {** Returns true if the current render-pass is used to draw the reflection } - property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Prints a text. - *} - procedure Print(const Text: WideString); overload; - {** UTF-8 version of @link(Print) } - procedure Print(const Text: string); overload; - - {** - * Calculates the bounding box (width and height) around Text. - * Works with Italic and Underline styles but reflections created - * with the Reflect style are not considered. - * Note that the width might differ due to kerning with appended text, - * e.g. Width('VA') <= Width('V') + Width('A'). - * @param Advance if set to true, Result.Right is set to the advance of - * the given text rather than the min. right border. The advance width is - * bigger than the text's width as it additionally contains the advance - * and glyph-spacing of the last character. - *} - function BBox(const Text: WideString; Advance: boolean = false): TBoundsDbl; overload; - {** UTF-8 version of @link(BBox) } - function BBox(const Text: UTF8String; Advance: boolean = false): TBoundsDbl; overload; - - {** Font height } - property Height: single read GetHeight; - {** Vertical distance from baseline to top of glyph } - property Ascender: single read GetAscender; - {** Vertical distance from baseline to bottom of glyph } - property Descender: single read GetDescender; - {** Vertical distance between two baselines } - property LineSpacing: single read GetLineSpacing write SetLineSpacing; - {** Space between end and start of next glyph added to the advance width } - property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; - {** Distance between normal baseline and baseline of the reflection } - property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; - {** Font style (italic/underline/...) } - property Style: TFontStyle read GetStyle write SetStyle; - {** If set to true (default) kerning will be used if available } - property UseKerning: boolean read GetUseKerning write SetUseKerning; - end; - -const - //** Max. number of mipmap levels that a TScalableFont can contain - cMaxMipmapLevel = 5; - -type - {** - * Wrapper around TFont to allow font size changes. - * The font is scaled to the requested size by a modelview matrix - * transformation (glScale) and not by rescaling the internal bitmap - * representation. This way changing the size is really fast but the result - * may lack quality on large or small scale factors. - *} - TScalableFont = class(TFont) - private - procedure ResetIntern(); - - protected - fScale: single; //**< current height to base-font height ratio - fAspect: single; //**< width to height aspect - fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] - fUseMipmaps: boolean; //**< true if mipmap fonts are generated - /// Mipmap fonts (size[level+1] = size[level]/2) - fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; - - procedure Render(const Text: WideString); override; - procedure Print(const Text: TWideStringArray); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - {** - * Callback called for creation of each mipmap font. - * Must be defined by the subclass. - * Mipmaps created by this method are managed and freed by TScalableFont. - *} - function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; - - {** - * Returns the mipmap level considering the current scale and projection - * matrix. - *} - function GetMipmapLevel(): integer; - - {** - * Returns the scale applied to the given mipmap font. - * fScale * fBaseFont.Height / fMipmapFont[Level].Height - *} - function GetMipmapScale(Level: integer): single; - - {** - * Chooses the mipmap that looks nicest with current scale and projection - * matrix. - *} - function ChooseMipmapFont(): TFont; - - procedure SetHeight(Height: single); virtual; - function GetHeight(): single; override; - procedure SetAspect(Aspect: single); virtual; - function GetAspect(): single; virtual; - function GetAscender(): single; override; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - function GetLineSpacing(): single; override; - procedure SetGlyphSpacing(Spacing: single); override; - function GetGlyphSpacing(): single; override; - procedure SetReflectionSpacing(Spacing: single); override; - function GetReflectionSpacing(): single; override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - - public - {** - * Creates a wrapper to make the base-font Font scalable. - * If UseMipmaps is set to true smaller fonts are created so that a - * resized (Height property changed) font looks nicer. - * The font passed is managed and freed by TScalableFont. - *} - constructor Create(Font: TFont; UseMipmaps: boolean); overload; - - {** - * Frees memory. The fonts passed on Create() and mipmap creation - * are freed too. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Font height } - property Height: single read GetHeight write SetHeight; - {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } - property Aspect: single read GetAspect write SetAspect; - end; - - {** - * Table for storage of max. 256 glyphs. - * Used for the second cache level. Indexed by the LSB of the WideChar - * char-code. - *} - PGlyphTable = ^TGlyphTable; - TGlyphTable = array[0..255] of TGlyph; - - {** - * Cache for glyphs of a single font. - * The cached glyphs are stored inside a hash-list. - * Hashing is performed in two steps: - * 1. the least significant byte (LSB) of the WideChar character code - * is removed (shr 8) and the result (we call it BaseCode here) looked up in - * the hash-list. - * 2. Each entry of the hash-list contains a table with max. 256 entries. - * The LSB of the char-code of a glyph is the table-offset of that glyph. - *} - TGlyphCache = class - private - fHash: TList; - - {** - * Finds a glyph-table storing cached glyphs with base-code BaseCode - * (= upper char-code bytes) in the hash-list and returns the table and - * its index. - * @param(InsertPos the position of the tyble in the list if it was found, - * otherwise the position the table should be inserted) - *} - function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Add glyph Glyph with char-code ch to the cache. - * @returns @true on success, @false otherwise - *} - function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; - - {** - * Removes the glyph with char-code ch from the cache. - *} - procedure DeleteGlyph(ch: WideChar); - - {** - * Removes the glyph with char-code ch from the cache. - *} - function GetGlyph(ch: WideChar): TGlyph; - - {** - * Checks if a glyph with char-code ch is cached. - *} - function HasGlyph(ch: WideChar): boolean; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, cached characters in the range 0..255 will not be flushed. - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - {** - * Entry of a glyph-cache's (TGlyphCache) hash. - * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table - * with all glyphs cached at the moment with that BaseCode. - *} - TGlyphCacheHashEntry = class - private - fBaseCode: cardinal; - public - GlyphTable: TGlyphTable; - - constructor Create(BaseCode: cardinal); - - {** Base-code (upper-bytes) of the glyphs stored in this entry's table } - property BaseCode: cardinal read fBaseCode; - end; - - TCachedFont = class(TFont) - protected - fCache: TGlyphCache; - - {** - * Retrieves a cached glyph with char-code ch from cache. - * If the glyph is not already cached, it is loaded with LoadGlyph(). - *} - function GetGlyph(ch: WideChar): TGlyph; - - {** - * Callback to create (load) a glyph with char-code ch. - * Implemented by subclasses. - *} - function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, the base glyphs are not be flushed. - * @seealso TGlyphCache.FlushCache - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - TFTFont = class; - - {** - * Freetype glyph. - * Each glyph stores a texture with the glyph's image. - *} - TFTGlyph = class(TGlyph) - private - fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) - fDisplayList: GLuint; //**< Display-list ID - fTexture: GLuint; //**< Texture ID - fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) - fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding - fTexSize: TTextureSize; //**< Texture size in pixels - - fFont: TFTFont; //**< Font associated with this glyph - fAdvance: TPositionDbl; //**< Advance width of this glyph - fBounds: TBoundsDbl; //**< Glyph bounds - fOutset: single; //**< Extrusion outset - - {** - * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size - * fTexSize by Outset pixels. - * This is useful to create bold or outlined fonts. - * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the - * original glyph bitmap, otherwise the glyph borders cannot be extruded - * correctly. - * The bitmap must be 2* pixels wider and higher than the - * original glyph's bitmap with the latter centered in it. - *} - procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); - - {** - * Creates an OpenGL texture (and display list) for the glyph. - * The glyph's and bitmap's metrics are set correspondingly. - * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the glyph could not be initialized - *} - procedure CreateTexture(LoadFlags: FT_Int32); - - protected - function GetAdvance(): TPositionDbl; override; - function GetBounds(): TBoundsDbl; override; - - public - {** - * Creates a glyph with char-code ch from font Font. - * @param LoadFlags flags passed to FT_Load_Glyph() - *} - constructor Create(Font: TFTFont; ch: WideChar; Outset: single; - LoadFlags: FT_Int32); - destructor Destroy(); override; - - {** Renders the glyph (normal render pass) } - procedure Render(UseDisplayLists: boolean); override; - {** Renders the glyph's reflection } - procedure RenderReflection(); override; - - {** Freetype specific char-index (<> char-code) } - property CharIndex: FT_UInt read fCharIndex; - end; - - {** - * Freetype font class. - *} - TFTFont = class(TCachedFont) - private - procedure ResetIntern(); - - protected - fFilename: string; //**< filename of the font-file - fSize: integer; //**< Font base size (in pixels) - fOutset: single; //**< size of outset extrusion (in pixels) - fFace: FT_Face; //**< Holds the height of the font - fLoadFlags: FT_Int32; //**< FT glpyh load-flags - fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio - fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing - - {** @seealso TCachedFont.LoadGlyph } - function LoadGlyph(ch: WideChar): TGlyph; override; - - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - - property Face: FT_Face read fFace; - - public - {** - * Creates a font of size Size (in pixels) from the file Filename. - * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded - * at their borders. Use it for e.g. a bold effect. - * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the font-file could not be loaded - *} - constructor Create(const Filename: string; - Size: integer; Outset: single = 0.0; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - - {** - * Frees all resources associated with the font. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - TFTScalableFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - {** - * Creates a scalable font of size Size (in pixels) from the file Filename. - * OutsetAmount is the ratio of the glyph extrusion. - * The extrusion in pixels is Size*OutsetAmount - * (0.0 -> no extrusion, 0.1 -> 10%). - *} - constructor Create(const Filename: string; - Size: integer; OutsetAmount: single = 0.0; - UseMipmaps: boolean = true); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size (in pixels) of the scaled font } - property Outset: single read GetOutset; - end; - - - {** - * Represents a freetype font with an additional outline around its glyphs. - * The outline size is passed on creation and cannot be changed later. - *} - TFTOutlineFont = class(TFont) - private - fFilename: string; - fSize: integer; - fOutset: single; - fInnerFont, fOutlineFont: TFTFont; - fOutlineColor: TGLColor; - - procedure ResetIntern(); - - protected - procedure DrawUnderline(const Text: WideString); override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - procedure SetGlyphSpacing(Spacing: single); override; - procedure SetReflectionSpacing(Spacing: single); override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - procedure SetReflectionPass(Enable: boolean); override; - - public - constructor Create(const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - destructor Destroy; override; - - {** Sets the color of the outline } - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - {** - * Wrapper around TOutlineFont to allow font resizing. - * @seealso TScalableFont - *} - TFTScalableOutlineFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - constructor Create(const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean = true); - - {** Sets the color of the outline } - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = 1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size } - property Outset: single read GetOutset; - end; - -{$IFDEF BITMAP_FONT} - - {** - * A bitmapped font loads it's glyphs from a bitmap and stores them in a - * texture. Unicode characters are not supported (but could be by supporting - * multiple textures each storing a subset of unicode glyphs). - * For backward compatibility only. - *} - TBitmapFont = class(TFont) - private - fTex: TTexture; - fTexSize: integer; - fBaseline: integer; - fAscender: integer; - fDescender: integer; - fWidths: array[0..255] of byte; //**< half widths - fOutline: integer; - fTempColor: TGLColor; //**< colours for the reflection - - procedure ResetIntern(); - - procedure RenderChar(ch: WideChar; var AdvanceX: real); - - {** - * Load font widths from an info file. - * @param InfoFile the name of the info (.dat) file - * @raises Exception if the file is corrupted - *} - procedure LoadFontInfo(const InfoFile: string); - - protected - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - - public - {** - * Creates a bitmapped font from image Filename and font width info - * loaded from the corresponding file with ending .dat. - * @param(Baseline y-coord of the baseline given in cartesian coords - * (y-axis up) and from the lower edge of the glyphs bounding box) - * @param(Ascender pixels from baseline to top of highest glyph) - *} - constructor Create(const Filename: string; Outline: integer; - Baseline, Ascender, Descender: integer); - destructor Destroy(); override; - - {** - * Corrects font widths provided by the info file. - * NewWidth := Width * WidthMult + WidthAdd - *} - procedure CorrectWidths(WidthMult: real; WidthAdd: integer); - - {** @seealso TFont.Reset } - procedure Reset(); override; - end; - -{$ENDIF BITMAP_FONT} - - TFreeType = class - public - {** - * Returns a pointer to the freetype library singleton. - * If non exists, freetype will be initialized. - * @raises Exception if initialization failed - *} - class function GetLibrary(): FT_Library; - class procedure FreeLibrary(); - end; - - -implementation - -uses Types; - -const - //** shear factor used for the italic effect (bigger value -> more bending) - cShearFactor = 0.25; - cShearMatrix: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - cShearMatrixInv: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - -cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - -var - LibraryInst: FT_Library; - -function NewGLColor(r, g, b, a: GLfloat): TGLColor; -begin - Result.r := r; - Result.g := g; - Result.b := b; - Result.a := a; -end; - -{** - * Returns the first power of 2 >= Value. - *} -function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} -begin - Result := 1; - while (Result < Value) do - Result := Result shl 1; -end; - - -{* - * TFont - *} - -constructor TFont.Create(); -begin - inherited; - ResetIntern(); -end; - -destructor TFont.Destroy(); -begin - inherited; -end; - -procedure TFont.ResetIntern(); -begin - fStyle := []; - fUseKerning := true; - fGlyphSpacing := 0.0; - fReflectionPass := false; - - // must be set by subclasses - fLineSpacing := 0.0; - fReflectionSpacing := 0.0; -end; - -procedure TFont.Reset(); -begin - ResetIntern(); -end; - -procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); -var - LineList: TStringList; - LineIndex: integer; -begin - // split lines on newline (there is no WideString version of ExtractStrings) - LineList := TStringList.Create(); - ExtractStrings([#13], [], PChar(Text), LineList); - - // create an array of WideStrins from the UTF-8 string-list - SetLength(Lines, LineList.Count); - for LineIndex := 0 to LineList.Count-1 do - Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); - LineList.Free(); -end; - -function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; -var - LineArray: TWideStringArray; -begin - SplitLines(Text, LineArray); - Result := BBox(LineArray, Advance); - SetLength(LineArray, 0); -end; - -function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; -begin - Result := BBox(UTF8Encode(Text), Advance); -end; - -procedure TFont.Print(const Text: TWideStringArray); -var - LineIndex: integer; -begin - // recursively call this function to draw reflected text - if ((Reflect in Style) and not ReflectionPass) then - begin - ReflectionPass := true; - Print(Text); - ReflectionPass := false; - end; - - // store current color, enable-flags, matrix-mode - glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); - - // set OpenGL state - glMatrixMode(GL_MODELVIEW); - glDisable(GL_DEPTH_TEST); - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - { - // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? - glAlphaFunc(GL_GREATER, 0); - glEnable(GL_ALPHA_TEST); - - //TODO: Do we need depth-testing? - if (ReflectionPass) then - begin - glDepthMask(0); - glEnable(GL_DEPTH_TEST); - end; - } - - {$IFDEF FLIP_YAXIS} - glPushMatrix(); - glScalef(1, -1, 1); - {$ENDIF} - - // display text - for LineIndex := 0 to High(Text) do - begin - glPushMatrix(); - - // move to baseline - glTranslatef(0, -LineSpacing*LineIndex, 0); - - if ((Underline in Style) and not ReflectionPass) then - begin - glDisable(GL_TEXTURE_2D); - DrawUnderline(Text[LineIndex]); - glEnable(GL_TEXTURE_2D); - end; - - // draw reflection - if (ReflectionPass) then - begin - // set reflection spacing - glTranslatef(0, -ReflectionSpacing, 0); - // flip y-axis - glScalef(1, -1, 1); - end; - - // shear for italic effect - if (Italic in Style) then - glMultMatrixf(@cShearMatrix); - + procedure DrawUnderline(const Text: WideString); virtual; + + {** + * Renders (one) line of text. + *} + procedure Render(const Text: WideString); virtual; abstract; + + {** + * Returns the bounds of text-lines contained in Text. + * @param(Advance if true the right bound is set to the advance instead + * of the minimal right bound.) + *} + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + + {** + * Resets all user settings to default values. + * Override methods should always call the inherited version. + *} + procedure Reset(); virtual; + + function GetHeight(): single; virtual; abstract; + function GetAscender(): single; virtual; abstract; + function GetDescender(): single; virtual; abstract; + procedure SetLineSpacing(Spacing: single); virtual; + function GetLineSpacing(): single; virtual; + procedure SetGlyphSpacing(Spacing: single); virtual; + function GetGlyphSpacing(): single; virtual; + procedure SetReflectionSpacing(Spacing: single); virtual; + function GetReflectionSpacing(): single; virtual; + procedure SetStyle(Style: TFontStyle); virtual; + function GetStyle(): TFontStyle; virtual; + function GetUnderlinePosition(): single; virtual; abstract; + function GetUnderlineThickness(): single; virtual; abstract; + procedure SetUseKerning(Enable: boolean); virtual; + function GetUseKerning(): boolean; virtual; + procedure SetReflectionPass(Enable: boolean); virtual; + + {** Returns true if the current render-pass is used to draw the reflection } + property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Prints a text. + *} + procedure Print(const Text: WideString); overload; + {** UTF-8 version of @link(Print) } + procedure Print(const Text: string); overload; + + {** + * Calculates the bounding box (width and height) around Text. + * Works with Italic and Underline styles but reflections created + * with the Reflect style are not considered. + * Note that the width might differ due to kerning with appended text, + * e.g. Width('VA') <= Width('V') + Width('A'). + * @param Advance if set to true, Result.Right is set to the advance of + * the given text rather than the min. right border. The advance width is + * bigger than the text's width as it additionally contains the advance + * and glyph-spacing of the last character. + *} + function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload; + {** UTF-8 version of @link(BBox) } + function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; + + {** Font height } + property Height: single read GetHeight; + {** Vertical distance from baseline to top of glyph } + property Ascender: single read GetAscender; + {** Vertical distance from baseline to bottom of glyph } + property Descender: single read GetDescender; + {** Vertical distance between two baselines } + property LineSpacing: single read GetLineSpacing write SetLineSpacing; + {** Space between end and start of next glyph added to the advance width } + property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; + {** Distance between normal baseline and baseline of the reflection } + property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; + {** Font style (italic/underline/...) } + property Style: TFontStyle read GetStyle write SetStyle; + {** If set to true (default) kerning will be used if available } + property UseKerning: boolean read GetUseKerning write SetUseKerning; + end; + +const + //** Max. number of mipmap levels that a TScalableFont can contain + cMaxMipmapLevel = 5; + +type + {** + * Wrapper around TFont to allow font size changes. + * The font is scaled to the requested size by a modelview matrix + * transformation (glScale) and not by rescaling the internal bitmap + * representation. This way changing the size is really fast but the result + * may lack quality on large or small scale factors. + *} + TScalableFont = class(TFont) + private + procedure ResetIntern(); + + protected + fScale: single; //**< current height to base-font height ratio + fAspect: single; //**< width to height aspect + fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] + fUseMipmaps: boolean; //**< true if mipmap fonts are generated + /// Mipmap fonts (size[level+1] = size[level]/2) + fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; + + procedure Render(const Text: WideString); override; + procedure Print(const Text: TWideStringArray); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + {** + * Callback called for creation of each mipmap font. + * Must be defined by the subclass. + * Mipmaps created by this method are managed and freed by TScalableFont. + *} + function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; + + {** + * Returns the mipmap level considering the current scale and projection + * matrix. + *} + function GetMipmapLevel(): integer; + + {** + * Returns the scale applied to the given mipmap font. + * fScale * fBaseFont.Height / fMipmapFont[Level].Height + *} + function GetMipmapScale(Level: integer): single; + + {** + * Chooses the mipmap that looks nicest with current scale and projection + * matrix. + *} + function ChooseMipmapFont(): TFont; + + procedure SetHeight(Height: single); virtual; + function GetHeight(): single; override; + procedure SetAspect(Aspect: single); virtual; + function GetAspect(): single; virtual; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + function GetLineSpacing(): single; override; + procedure SetGlyphSpacing(Spacing: single); override; + function GetGlyphSpacing(): single; override; + procedure SetReflectionSpacing(Spacing: single); override; + function GetReflectionSpacing(): single; override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + + public + {** + * Creates a wrapper to make the base-font Font scalable. + * If UseMipmaps is set to true smaller fonts are created so that a + * resized (Height property changed) font looks nicer. + * The font passed is managed and freed by TScalableFont. + *} + constructor Create(Font: TFont; UseMipmaps: boolean); overload; + + {** + * Frees memory. The fonts passed on Create() and mipmap creation + * are freed too. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Font height } + property Height: single read GetHeight write SetHeight; + {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } + property Aspect: single read GetAspect write SetAspect; + end; + + {** + * Table for storage of max. 256 glyphs. + * Used for the second cache level. Indexed by the LSB of the WideChar + * char-code. + *} + PGlyphTable = ^TGlyphTable; + TGlyphTable = array[0..255] of TGlyph; + + {** + * Cache for glyphs of a single font. + * The cached glyphs are stored inside a hash-list. + * Hashing is performed in two steps: + * 1. the least significant byte (LSB) of the WideChar character code + * is removed (shr 8) and the result (we call it BaseCode here) looked up in + * the hash-list. + * 2. Each entry of the hash-list contains a table with max. 256 entries. + * The LSB of the char-code of a glyph is the table-offset of that glyph. + *} + TGlyphCache = class + private + fHash: TList; + + {** + * Finds a glyph-table storing cached glyphs with base-code BaseCode + * (= upper char-code bytes) in the hash-list and returns the table and + * its index. + * @param(InsertPos the position of the tyble in the list if it was found, + * otherwise the position the table should be inserted) + *} + function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Add glyph Glyph with char-code ch to the cache. + * @returns @true on success, @false otherwise + *} + function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + + {** + * Removes the glyph with char-code ch from the cache. + *} + procedure DeleteGlyph(ch: WideChar); + + {** + * Removes the glyph with char-code ch from the cache. + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Checks if a glyph with char-code ch is cached. + *} + function HasGlyph(ch: WideChar): boolean; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, cached characters in the range 0..255 will not be flushed. + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + {** + * Entry of a glyph-cache's (TGlyphCache) hash. + * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table + * with all glyphs cached at the moment with that BaseCode. + *} + TGlyphCacheHashEntry = class + private + fBaseCode: cardinal; + public + GlyphTable: TGlyphTable; + + constructor Create(BaseCode: cardinal); + + {** Base-code (upper-bytes) of the glyphs stored in this entry's table } + property BaseCode: cardinal read fBaseCode; + end; + + TCachedFont = class(TFont) + protected + fCache: TGlyphCache; + + {** + * Retrieves a cached glyph with char-code ch from cache. + * If the glyph is not already cached, it is loaded with LoadGlyph(). + *} + function GetGlyph(ch: WideChar): TGlyph; + + {** + * Callback to create (load) a glyph with char-code ch. + * Implemented by subclasses. + *} + function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + + public + constructor Create(); + destructor Destroy(); override; + + {** + * Remove and free all cached glyphs. If KeepBaseSet is set to + * true, the base glyphs are not be flushed. + * @seealso TGlyphCache.FlushCache + *} + procedure FlushCache(KeepBaseSet: boolean); + end; + + TFTFont = class; + + {** + * Freetype glyph. + * Each glyph stores a texture with the glyph's image. + *} + TFTGlyph = class(TGlyph) + private + fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) + fDisplayList: GLuint; //**< Display-list ID + fTexture: GLuint; //**< Texture ID + fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) + fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding + fTexSize: TTextureSize; //**< Texture size in pixels + + fFont: TFTFont; //**< Font associated with this glyph + fAdvance: TPositionDbl; //**< Advance width of this glyph + fBounds: TBoundsDbl; //**< Glyph bounds + fOutset: single; //**< Extrusion outset + + {** + * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size + * fTexSize by Outset pixels. + * This is useful to create bold or outlined fonts. + * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the + * original glyph bitmap, otherwise the glyph borders cannot be extruded + * correctly. + * The bitmap must be 2* pixels wider and higher than the + * original glyph's bitmap with the latter centered in it. + *} + procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + {** + * Creates an OpenGL texture (and display list) for the glyph. + * The glyph's and bitmap's metrics are set correspondingly. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the glyph could not be initialized + *} + procedure CreateTexture(LoadFlags: FT_Int32); + + protected + function GetAdvance(): TPositionDbl; override; + function GetBounds(): TBoundsDbl; override; + + public + {** + * Creates a glyph with char-code ch from font Font. + * @param LoadFlags flags passed to FT_Load_Glyph() + *} + constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); + destructor Destroy(); override; + + {** Renders the glyph (normal render pass) } + procedure Render(UseDisplayLists: boolean); override; + {** Renders the glyph's reflection } + procedure RenderReflection(); override; + + {** Freetype specific char-index (<> char-code) } + property CharIndex: FT_UInt read fCharIndex; + end; + + {** + * Freetype font class. + *} + TFTFont = class(TCachedFont) + private + procedure ResetIntern(); + + protected + fFilename: string; //**< filename of the font-file + fSize: integer; //**< Font base size (in pixels) + fOutset: single; //**< size of outset extrusion (in pixels) + fFace: FT_Face; //**< Holds the height of the font + fLoadFlags: FT_Int32; //**< FT glpyh load-flags + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + + {** @seealso TCachedFont.LoadGlyph } + function LoadGlyph(ch: WideChar): TGlyph; override; + + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + property Face: FT_Face read fFace; + + public + {** + * Creates a font of size Size (in pixels) from the file Filename. + * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded + * at their borders. Use it for e.g. a bold effect. + * @param LoadFlags flags passed to FT_Load_Glyph() + * @raises Exception if the font-file could not be loaded + *} + constructor Create(const Filename: string; + Size: integer; Outset: single = 0.0; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + + {** + * Frees all resources associated with the font. + *} + destructor Destroy(); override; + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + TFTScalableFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + {** + * Creates a scalable font of size Size (in pixels) from the file Filename. + * OutsetAmount is the ratio of the glyph extrusion. + * The extrusion in pixels is Size*OutsetAmount + * (0.0 -> no extrusion, 0.1 -> 10%). + *} + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single = 0.0; + UseMipmaps: boolean = true); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size (in pixels) of the scaled font } + property Outset: single read GetOutset; + end; + + + {** + * Represents a freetype font with an additional outline around its glyphs. + * The outline size is passed on creation and cannot be changed later. + *} + TFTOutlineFont = class(TFont) + private + fFilename: string; + fSize: integer; + fOutset: single; + fInnerFont, fOutlineFont: TFTFont; + fOutlineColor: TGLColor; + + procedure ResetIntern(); + + protected + procedure DrawUnderline(const Text: WideString); override; + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + procedure SetLineSpacing(Spacing: single); override; + procedure SetGlyphSpacing(Spacing: single); override; + procedure SetReflectionSpacing(Spacing: single); override; + procedure SetStyle(Style: TFontStyle); override; + function GetStyle(): TFontStyle; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + procedure SetUseKerning(Enable: boolean); override; + procedure SetReflectionPass(Enable: boolean); override; + + public + constructor Create(const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); + destructor Destroy; override; + + {** + * Sets the color of the outline. + * If the alpha component is < 0, OpenGL's current alpha value will be + * used. + *} + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** @seealso TFont.Reset } + procedure Reset(); override; + + {** Size of the base font } + property Size: integer read fSize; + {** Outset size } + property Outset: single read fOutset; + end; + + {** + * Wrapper around TOutlineFont to allow font resizing. + * @seealso TScalableFont + *} + TFTScalableOutlineFont = class(TScalableFont) + protected + function GetOutset(): single; virtual; + function CreateMipmap(Level: integer; Scale: single): TFont; override; + + public + constructor Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean = true); + + {** @seealso TFTOutlineFont.SetOutlineColor } + procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); + + {** @seealso TGlyphCache.FlushCache } + procedure FlushCache(KeepBaseSet: boolean); + + {** Outset size } + property Outset: single read GetOutset; + end; + +{$IFDEF BITMAP_FONT} + + {** + * A bitmapped font loads it's glyphs from a bitmap and stores them in a + * texture. Unicode characters are not supported (but could be by supporting + * multiple textures each storing a subset of unicode glyphs). + * For backward compatibility only. + *} + TBitmapFont = class(TFont) + private + fTex: TTexture; + fTexSize: integer; + fBaseline: integer; + fAscender: integer; + fDescender: integer; + fWidths: array[0..255] of byte; //**< half widths + fOutline: integer; + fTempColor: TGLColor; //**< colours for the reflection + + procedure ResetIntern(); + + procedure RenderChar(ch: WideChar; var AdvanceX: real); + + {** + * Load font widths from an info file. + * @param InfoFile the name of the info (.dat) file + * @raises Exception if the file is corrupted + *} + procedure LoadFontInfo(const InfoFile: string); + + protected + procedure Render(const Text: WideString); override; + function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + + function GetHeight(): single; override; + function GetAscender(): single; override; + function GetDescender(): single; override; + function GetUnderlinePosition(): single; override; + function GetUnderlineThickness(): single; override; + + public + {** + * Creates a bitmapped font from image Filename and font width info + * loaded from the corresponding file with ending .dat. + * @param(Baseline y-coord of the baseline given in cartesian coords + * (y-axis up) and from the lower edge of the glyphs bounding box) + * @param(Ascender pixels from baseline to top of highest glyph) + *} + constructor Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); + destructor Destroy(); override; + + {** + * Corrects font widths provided by the info file. + * NewWidth := Width * WidthMult + WidthAdd + *} + procedure CorrectWidths(WidthMult: real; WidthAdd: integer); + + {** @seealso TFont.Reset } + procedure Reset(); override; + end; + +{$ENDIF BITMAP_FONT} + + TFreeType = class + public + {** + * Returns a pointer to the freetype library singleton. + * If non exists, freetype will be initialized. + * @raises Exception if initialization failed + *} + class function GetLibrary(): FT_Library; + class procedure FreeLibrary(); + end; + + +implementation + +uses Types; + +const + //** shear factor used for the italic effect (bigger value -> more bending) + cShearFactor = 0.25; + cShearMatrix: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + cShearMatrixInv: array[0..15] of GLfloat = ( + 1, 0, 0, 0, + -cShearFactor, 1, 0, 0, + 0, 0, 1, 0, + 0, 0, 0, 1 + ); + +var + LibraryInst: FT_Library; + +function NewGLColor(r, g, b, a: GLfloat): TGLColor; +begin + Result.r := r; + Result.g := g; + Result.b := b; + Result.a := a; +end; + +{** + * Returns the first power of 2 >= Value. + *} +function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} +begin + Result := 1; + while (Result < Value) do + Result := Result shl 1; +end; + + +{* + * TFont + *} + +constructor TFont.Create(); +begin + inherited; + ResetIntern(); +end; + +destructor TFont.Destroy(); +begin + inherited; +end; + +procedure TFont.ResetIntern(); +begin + fStyle := []; + fUseKerning := true; + fGlyphSpacing := 0.0; + fReflectionPass := false; + + // must be set by subclasses + fLineSpacing := 0.0; + fReflectionSpacing := 0.0; +end; + +procedure TFont.Reset(); +begin + ResetIntern(); +end; + +procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +var + LineList: TStringList; + LineIndex: integer; +begin + // split lines on newline (there is no WideString version of ExtractStrings) + LineList := TStringList.Create(); + ExtractStrings([#13], [], PChar(Text), LineList); + + // create an array of WideStrins from the UTF-8 string-list + SetLength(Lines, LineList.Count); + for LineIndex := 0 to LineList.Count-1 do + Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); + LineList.Free(); +end; + +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Result := BBox(LineArray, Advance); + SetLength(LineArray, 0); +end; + +function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Encode(Text), Advance); +end; + +procedure TFont.Print(const Text: TWideStringArray); +var + LineIndex: integer; +begin + // recursively call this function to draw reflected text + if ((Reflect in Style) and not ReflectionPass) then + begin + ReflectionPass := true; + Print(Text); + ReflectionPass := false; + end; + + // store current color, enable-flags, matrix-mode + glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); + + // set OpenGL state + glMatrixMode(GL_MODELVIEW); + glDisable(GL_DEPTH_TEST); + glEnable(GL_BLEND); + glEnable(GL_TEXTURE_2D); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + { + // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? + glAlphaFunc(GL_GREATER, 0); + glEnable(GL_ALPHA_TEST); + + //TODO: Do we need depth-testing? + if (ReflectionPass) then + begin + glDepthMask(0); + glEnable(GL_DEPTH_TEST); + end; + } + + {$IFDEF FLIP_YAXIS} + glPushMatrix(); + glScalef(1, -1, 1); + {$ENDIF} + + // display text + for LineIndex := 0 to High(Text) do + begin + glPushMatrix(); + + // move to baseline + glTranslatef(0, -LineSpacing*LineIndex, 0); + + if ((Underline in Style) and not ReflectionPass) then + begin + glDisable(GL_TEXTURE_2D); + DrawUnderline(Text[LineIndex]); + glEnable(GL_TEXTURE_2D); + end; + + // draw reflection + if (ReflectionPass) then + begin + // set reflection spacing + glTranslatef(0, -ReflectionSpacing, 0); + // flip y-axis + glScalef(1, -1, 1); + end; + + // shear for italic effect + if (Italic in Style) then + glMultMatrixf(@cShearMatrix); + // render text line - Render(Text[LineIndex]); - - glPopMatrix(); - end; - - // restore settings - {$IFDEF FLIP_YAXIS} - glPopMatrix(); - {$ENDIF} - glPopAttrib(); -end; - -procedure TFont.Print(const Text: string); -var - LineArray: TWideStringArray; -begin - SplitLines(Text, LineArray); - Print(LineArray); - SetLength(LineArray, 0); -end; - -procedure TFont.Print(const Text: WideString); -begin - Print(UTF8Encode(Text)); -end; - -procedure TFont.DrawUnderline(const Text: WideString); + Render(Text[LineIndex]); + + glPopMatrix(); + end; + + // restore settings + {$IFDEF FLIP_YAXIS} + glPopMatrix(); + {$ENDIF} + glPopAttrib(); +end; + +procedure TFont.Print(const Text: string); +var + LineArray: TWideStringArray; +begin + SplitLines(Text, LineArray); + Print(LineArray); + SetLength(LineArray, 0); +end; + +procedure TFont.Print(const Text: WideString); +begin + Print(UTF8Encode(Text)); +end; + +procedure TFont.DrawUnderline(const Text: WideString); var UnderlineY1, UnderlineY2: single; Bounds: TBoundsDbl; begin - UnderlineY1 := GetUnderlinePosition(); - UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); - Bounds := BBox(Text); - glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); -end; - -procedure TFont.SetStyle(Style: TFontStyle); -begin - fStyle := Style; -end; - -function TFont.GetStyle(): TFontStyle; -begin - Result := fStyle; -end; - -procedure TFont.SetLineSpacing(Spacing: single); -begin - fLineSpacing := Spacing; -end; - -function TFont.GetLineSpacing(): single; -begin - Result := fLineSpacing; -end; - -procedure TFont.SetGlyphSpacing(Spacing: single); -begin - fGlyphSpacing := Spacing; -end; - -function TFont.GetGlyphSpacing(): single; -begin - Result := fGlyphSpacing; -end; - -procedure TFont.SetReflectionSpacing(Spacing: single); -begin - fReflectionSpacing := Spacing; -end; - -function TFont.GetReflectionSpacing(): single; -begin - Result := fReflectionSpacing; -end; - -procedure TFont.SetUseKerning(Enable: boolean); -begin - fUseKerning := Enable; -end; - -function TFont.GetUseKerning(): boolean; -begin - Result := fUseKerning; -end; - -procedure TFont.SetReflectionPass(Enable: boolean); -begin - fReflectionPass := Enable; -end; - - -{* - * TScalableFont - *} - -constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); -var - MipmapLevel: integer; -begin - inherited Create(); - - fBaseFont := Font; - fMipmapFonts[0] := Font; - fUseMipmaps := UseMipmaps; - ResetIntern(); - - // create mipmap fonts if requested - if (UseMipmaps) then - begin - for MipmapLevel := 1 to cMaxMipmapLevel do - begin - fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); - // stop if no smaller mipmap font is returned - if (fMipmapFonts[MipmapLevel] = nil) then - Break; - end; - end; -end; - -destructor TScalableFont.Destroy(); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - fMipmapFonts[Level].Free; - inherited; -end; - -procedure TScalableFont.ResetIntern(); -begin - fScale := 1.0; - fAspect := 1.0; -end; - -procedure TScalableFont.Reset(); -var - Level: integer; -begin - inherited; - ResetIntern(); - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].Reset(); -end; - -{** - * Returns the mipmap level to use with regard to the current projection - * and modelview matrix, font scale and aspect. - * - * Note: - * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise - * the glyph widths/heights ratios and advance widths of the mipmap fonts - * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has - * width 12px, but at size 6px width 8px). - * - returned mipmap-level is used for all glyphs of the current text to print. - * This is faster, much easier to handle, since we just need to create - * multiple sized fonts and select the one we need for the mipmap-level and - * it avoids that neighbored glyphs use different mipmap-level which might - * look odd because one glyph might look blurry and the other sharp. - * - * Motivation: - * We do not use OpenGL for mipmapping as the results are very bad. At least - * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather - * blurry. - * Defining our own mipmaps by creating multiple textures with - * for different mimap levels is a pain, as the font size passed to freetype - * is not the size of the bitmaps created and it does not guarantee that a - * glyph bitmap of a font with font-size s/2 is half the size of the font with - * font-size s. If the bitmap size is just a single pixel bigger than the half - * we might need a texture of the next power-of-2 and the texture would not be - * half of the size of the next bigger mipmap. In addition we use a fixed one - * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe - * an outset that is added to the font, so creating a glyph mipmap that is - * exactly half the size of the next bigger one is a very difficult task. - * - * Solution: - * Use mipmap textures that are not exactly half the size of the next mipmap - * level. OpenGL does not support this (at least not without extensions). - * The trickiest task is to determine the mipmap to use by calculating the - * amount of minification that is performed in this function. - *} -function TScalableFont.GetMipmapLevel(): integer; -var - ModelMatrix, ProjMatrix: T16dArray; - WinCoords: array[0..2, 0..2] of GLdouble; - ViewPortArray: TViewPortArray; - Dist, Dist2: double; - WidthScale, HeightScale: double; -const - // width/height of square used for determining the scale - cTestSize = 10.0; - // an offset to the mipmap-level to adjust the change-over of two consecutive - // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 - // the result level will be 2. A bias of 0.5 is equal to rounding. - // With bias=0.1 we prefer larger mipmaps over smaller ones. - cBias = 0.2; -begin - // 1. retrieve current transformation matrices for gluProject - glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); - glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); - glGetIntegerv(GL_VIEWPORT, @ViewPortArray); - - // 2. project three of the corner points of a square with size cTestSize - // to window coordinates (the square is just a dummy for a glyph) - - // project point (x1, y1) to window corrdinates - gluProject(0, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); - // project point (x2, y1) to window corrdinates - gluProject(cTestSize, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); - // project point (x1, y2) to window corrdinates - gluProject(0, cTestSize, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); - - // 3. Lets see how much the width and height of the square changed. - // Calculate the width and height as displayed on the screen in window - // coordinates and calculate the ratio to the original coordinates in - // modelview space so the ratio gives us the scale (minification here). - - // projected width ||(x1, y1) - (x2, y1)|| - Dist := (WinCoords[0][0] - WinCoords[1][0]); - Dist2 := (WinCoords[0][1] - WinCoords[1][1]); - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - - // projected height ||(x1, y1) - (x1, y2)|| - Dist := (WinCoords[0][0] - WinCoords[2][0]); - Dist2 := (WinCoords[0][1] - WinCoords[2][1]); - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - - //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); - - // 4. Now that we have got the scale, take the bigger minification scale - // and get it to a logarithmic scale as each mipmap is 1/2 the size of its - // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). - // The result is our mipmap-level = the index of the mipmap to use. - - // Level > 0: Minification; < 0: Magnification - Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); - - // clamp to valid range - if (Result < 0) then - Result := 0; - if (Result > High(fMipmapFonts)) then - Result := High(fMipmapFonts); -end; - -function TScalableFont.GetMipmapScale(Level: integer): single; -begin - if (fMipmapFonts[Level] = nil) then - begin - Result := -1; - Exit; - end; - - Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; -end; - -{** - * Returns the correct mipmap font for the current scale and projection - * matrix. The modelview scale is adjusted to the mipmap level, so - * Result.Print() will display the font in the correct size. - *} -function TScalableFont.ChooseMipmapFont(): TFont; -var - DesiredLevel: integer; - Level: integer; - MipmapScale: single; -begin - Result := nil; - DesiredLevel := GetMipmapLevel(); - - // get the smallest mipmap available for the desired level - // as not all levels must be assigned to a font. - for Level := DesiredLevel downto 0 do - begin - if (fMipmapFonts[Level] <> nil) then - begin - Result := fMipmapFonts[Level]; - Break; - end; - end; - - // since the mipmap font (if level > 0) is smaller than the base-font - // we have to scale to get its size right. - MipmapScale := fMipmapFonts[0].Height/Result.Height; - glScalef(MipmapScale, MipmapScale, 0); -end; - -procedure TScalableFont.Print(const Text: TWideStringArray); -begin - glPushMatrix(); - - // set scale and stretching - glScalef(fScale * fAspect, fScale, 0); - - // print text - if (fUseMipmaps) then - ChooseMipmapFont().Print(Text) - else - fBaseFont.Print(Text); - - glPopMatrix(); -end; - -procedure TScalableFont.Render(const Text: WideString); -begin - Assert(false, 'Unused TScalableFont.Render() was called'); -end; - -function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -begin - Result := fBaseFont.BBox(Text, Advance); - Result.Left := Result.Left * fScale * fAspect; - Result.Right := Result.Right * fScale * fAspect; - Result.Top := Result.Top * fScale; - Result.Bottom := Result.Bottom * fScale; -end; - -procedure TScalableFont.SetHeight(Height: single); -begin - fScale := Height / fBaseFont.GetHeight(); -end; - -function TScalableFont.GetHeight(): single; -begin - Result := fBaseFont.GetHeight() * fScale; -end; - -procedure TScalableFont.SetAspect(Aspect: single); -begin - fAspect := Aspect; -end; - -function TScalableFont.GetAspect(): single; -begin - Result := fAspect; -end; - -function TScalableFont.GetAscender(): single; -begin - Result := fBaseFont.GetAscender() * fScale; -end; - -function TScalableFont.GetDescender(): single; -begin - Result := fBaseFont.GetDescender() * fScale; -end; - -procedure TScalableFont.SetLineSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetLineSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetGlyphSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetGlyphSpacing(): single; -begin - Result := fBaseFont.GetGlyphSpacing() * fScale; -end; - -procedure TScalableFont.SetReflectionSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetReflectionSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetStyle(Style: TFontStyle); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetStyle(Style); -end; - -function TScalableFont.GetStyle(): TFontStyle; -begin - Result := fBaseFont.GetStyle(); -end; - -function TScalableFont.GetUnderlinePosition(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -function TScalableFont.GetUnderlineThickness(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -procedure TScalableFont.SetUseKerning(Enable: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetUseKerning(Enable); -end; - - -{* - * TCachedFont - *} - -constructor TCachedFont.Create(); -begin - inherited; - fCache := TGlyphCache.Create(); -end; - -destructor TCachedFont.Destroy(); -begin - fCache.Free; - inherited; -end; - -function TCachedFont.GetGlyph(ch: WideChar): TGlyph; -begin - Result := fCache.GetGlyph(ch); - if (Result = nil) then - begin - Result := LoadGlyph(ch); - if (not fCache.AddGlyph(ch, Result)) then - Result.Free; - end; -end; - -procedure TCachedFont.FlushCache(KeepBaseSet: boolean); -begin - fCache.FlushCache(KeepBaseSet); -end; - - -{* - * TFTFont - *} - -constructor TFTFont.Create( - const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -var - i: WideChar; -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - fLoadFlags := LoadFlags; - fUseDisplayLists := true; - - // load font information - if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); - - // support scalable fonts only - if (not FT_IS_SCALABLE(fFace)) then - raise Exception.Create('Font is not scalable'); - - if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then - raise Exception.Create('FT_Set_Pixel_Sizes failes'); - - // get scale factor for font-unit to pixel-size transformation - fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; - fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; - - ResetIntern(); - - // pre-cache some commonly used glyphs (' ' - '~') - for i := #32 to #126 do - fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); -end; - -destructor TFTFont.Destroy(); -begin - // free face - FT_Done_Face(fFace); - inherited; -end; - -procedure TFTFont.ResetIntern(); -begin - // Note: outset and non outset fonts use same spacing - fLineSpacing := fFace.height * fFontUnitScale.Y; - fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; -end; - -procedure TFTFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -function TFTFont.LoadGlyph(ch: WideChar): TGlyph; -begin - Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); -end; - -function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -var - Glyph, PrevGlyph: TFTGlyph; - TextLine: WideString; - LineYOffset: single; - LineIndex, CharIndex: integer; - LineBounds: TBoundsDbl; - KernDelta: FT_Vector; - UnderlinePos: double; -begin - // Reset global bounds - Result.Left := Infinity; - Result.Right := 0; - Result.Bottom := Infinity; - Result.Top := 0; - - // reset last glyph - PrevGlyph := nil; - - // display text - for LineIndex := 0 to High(Text) do - begin - // get next text line - TextLine := Text[LineIndex]; - LineYOffset := -LineSpacing * LineIndex; - - // reset line bounds - LineBounds.Left := Infinity; - LineBounds.Right := 0; - LineBounds.Bottom := Infinity; - LineBounds.Top := 0; - - // for each glyph image, compute its bounding box - for CharIndex := 1 to Length(TextLine) do - begin - Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); - if (Glyph <> nil) then - begin - // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; - end; - - // update left bound (must be done before right bound is updated) - if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then - LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; - - // update right bound - if (CharIndex < Length(TextLine)) or // not the last character - (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) - Advance then // or in advance mode - begin - // add advance and glyph spacing - LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing - end - else - begin - // add glyph's right bound - LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; - end; - - // update bottom and top bounds - if (Glyph.Bounds.Bottom < LineBounds.Bottom) then - LineBounds.Bottom := Glyph.Bounds.Bottom; - if (Glyph.Bounds.Top > LineBounds.Top) then - LineBounds.Top := Glyph.Bounds.Top; - end; - - PrevGlyph := Glyph; - end; - - // handle italic font style - if (Italic in Style) then - begin - LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; - LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; - end; - - // handle underlined font style - if (Underline in Style) then - begin - UnderlinePos := GetUnderlinePosition(); - if (UnderlinePos < LineBounds.Bottom) then - LineBounds.Bottom := UnderlinePos; - end; - - // add line offset - LineBounds.Bottom := LineBounds.Bottom + LineYOffset; - LineBounds.Top := LineBounds.Top + LineYOffset; - - // adjust global bounds - if (Result.Left > LineBounds.Left) then - Result.Left := LineBounds.Left; - if (Result.Right < LineBounds.Right) then - Result.Right := LineBounds.Right; - if (Result.Bottom > LineBounds.Bottom) then - Result.Bottom := LineBounds.Bottom; - if (Result.Top < LineBounds.Top) then - Result.Top := LineBounds.Top; - end; - - // if left or bottom bound was not set, set them to 0 - if (Result.Left = Infinity) then - Result.Left := 0.0; - if (Result.Bottom = Infinity) then - Result.Bottom := 0.0; -end; - -procedure TFTFont.Render(const Text: WideString); + UnderlineY1 := GetUnderlinePosition(); + UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); + Bounds := BBox(Text, false); + glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); +end; + +procedure TFont.SetStyle(Style: TFontStyle); +begin + fStyle := Style; +end; + +function TFont.GetStyle(): TFontStyle; +begin + Result := fStyle; +end; + +procedure TFont.SetLineSpacing(Spacing: single); +begin + fLineSpacing := Spacing; +end; + +function TFont.GetLineSpacing(): single; +begin + Result := fLineSpacing; +end; + +procedure TFont.SetGlyphSpacing(Spacing: single); +begin + fGlyphSpacing := Spacing; +end; + +function TFont.GetGlyphSpacing(): single; +begin + Result := fGlyphSpacing; +end; + +procedure TFont.SetReflectionSpacing(Spacing: single); +begin + fReflectionSpacing := Spacing; +end; + +function TFont.GetReflectionSpacing(): single; +begin + Result := fReflectionSpacing; +end; + +procedure TFont.SetUseKerning(Enable: boolean); +begin + fUseKerning := Enable; +end; + +function TFont.GetUseKerning(): boolean; +begin + Result := fUseKerning; +end; + +procedure TFont.SetReflectionPass(Enable: boolean); +begin + fReflectionPass := Enable; +end; + + +{* + * TScalableFont + *} + +constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); +var + MipmapLevel: integer; +begin + inherited Create(); + + fBaseFont := Font; + fMipmapFonts[0] := Font; + fUseMipmaps := UseMipmaps; + ResetIntern(); + + // create mipmap fonts if requested + if (UseMipmaps) then + begin + for MipmapLevel := 1 to cMaxMipmapLevel do + begin + fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); + // stop if no smaller mipmap font is returned + if (fMipmapFonts[MipmapLevel] = nil) then + Break; + end; + end; +end; + +destructor TScalableFont.Destroy(); var - CharIndex: integer; - Glyph, PrevGlyph: TFTGlyph; - KernDelta: FT_Vector; -begin - // reset last glyph - PrevGlyph := nil; - - // draw current line - for CharIndex := 1 to Length(Text) do - begin - Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); - if (Assigned(Glyph)) then - begin - // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); - end; - - if (ReflectionPass) then - Glyph.RenderReflection() - else - Glyph.Render(fUseDisplayLists); - - glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); - end; - - PrevGlyph := Glyph; - end; -end; - -function TFTFont.GetHeight(): single; -begin - Result := Ascender - Descender; -end; - -function TFTFont.GetAscender(): single; -begin - Result := fFace.ascender * fFontUnitScale.Y + Outset*2; -end; - -function TFTFont.GetDescender(): single; -begin - // Note: outset is not part of the descender as the baseline is lifted - Result := fFace.descender * fFontUnitScale.Y; -end; - -function TFTFont.GetUnderlinePosition(): single; -begin - Result := fFace.underline_position * fFontUnitScale.Y - Outset; -end; - -function TFTFont.GetUnderlineThickness(): single; -begin - Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; -end; - - -{* - * TFTScalableFont - *} - -constructor TFTScalableFont.Create(const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting to preserve font outlines at each font - // size, otherwise the font widths/heights do not match resulting in ugly - // text size changes during zooming. - // A drawback is a reduced quality with smaller font sizes but it is not that - // bad with gray-scaled rendering (at least it looks better than OpenGL's - // linear downscaling on minification). - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTFont; -begin - Result := nil; - BaseFont := TFTFont(fBaseFont); - ScaledSize := Round(BaseFont.Size * Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset * Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableFont.GetOutset(): single; -begin - Result := TFTFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TOutlineFont - *} - -constructor TFTOutlineFont.Create( - const Filename: string; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - - fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); - fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); - - ResetIntern(); -end; - -destructor TFTOutlineFont.Destroy; -begin - fOutlineFont.Free; - fInnerFont.Free; - inherited; -end; - -procedure TFTOutlineFont.ResetIntern(); -begin - // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing - // of the outline font? - //fInnerFont.GlyphSpacing := fOutset*2; - fOutlineFont.GlyphSpacing := -fOutset*2; - - fLineSpacing := fOutlineFont.LineSpacing; - fReflectionSpacing := fOutlineFont.ReflectionSpacing; - fOutlineColor := NewGLColor(0, 0, 0, 1); -end; - -procedure TFTOutlineFont.Reset(); -begin - inherited; - fInnerFont.Reset(); - fOutlineFont.Reset(); - ResetIntern(); -end; - -procedure TFTOutlineFont.DrawUnderline(const Text: WideString); -begin - glPushAttrib(GL_CURRENT_BIT); - glColor4fv(@fOutlineColor.vals); - fOutlineFont.DrawUnderline(Text); - glPopAttrib(); - - glPushMatrix(); - glTranslatef(fOutset, 0, 0); - fInnerFont.DrawUnderline(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.Render(const Text: WideString); -begin - { setup and render outline font } - - // save old color - glPushAttrib(GL_CURRENT_BIT); - glColor4fv(@fOutlineColor.vals); - glPushMatrix(); - fOutlineFont.Render(Text); - glPopMatrix(); - glPopAttrib(); - - { setup and render inner font } - - glPushMatrix(); - glTranslatef(fOutset, fOutset, 0); - fInnerFont.Render(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -begin - fOutlineColor := NewGLColor(r, g, b, a); -end; - -procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); -begin - fOutlineFont.FlushCache(KeepBaseSet); - fInnerFont.FlushCache(KeepBaseSet); -end; - -function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -begin - Result := fOutlineFont.BBox(Text, Advance); -end; - -function TFTOutlineFont.GetHeight(): single; -begin - Result := fOutlineFont.Height; -end; - -function TFTOutlineFont.GetAscender(): single; -begin - Result := fOutlineFont.Ascender; -end; - -function TFTOutlineFont.GetDescender(): single; -begin - Result := fOutlineFont.Descender; -end; - -procedure TFTOutlineFont.SetLineSpacing(Spacing: single); -begin - inherited SetLineSpacing(Spacing); - fInnerFont.LineSpacing := Spacing; - fOutlineFont.LineSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); -begin - inherited SetGlyphSpacing(Spacing); - fInnerFont.GlyphSpacing := Spacing; - fOutlineFont.GlyphSpacing := Spacing - Outset*2; -end; - -procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); -begin - inherited SetReflectionSpacing(Spacing); - fInnerFont.ReflectionSpacing := Spacing; - fOutlineFont.ReflectionSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetStyle(Style: TFontStyle); -begin - inherited SetStyle(Style); - fInnerFont.Style := Style; - fOutlineFont.Style := Style; -end; - -function TFTOutlineFont.GetStyle(): TFontStyle; -begin - Result := inherited GetStyle(); -end; - -function TFTOutlineFont.GetUnderlinePosition(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -function TFTOutlineFont.GetUnderlineThickness(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -procedure TFTOutlineFont.SetUseKerning(Enable: boolean); -begin - inherited SetUseKerning(Enable); - fInnerFont.fUseKerning := Enable; - fOutlineFont.fUseKerning := Enable; -end; - -procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); -begin - inherited SetReflectionPass(Enable); - fInnerFont.fReflectionPass := Enable; - fOutlineFont.fReflectionPass := Enable; -end; - -{** - * TScalableOutlineFont - *} - -constructor TFTScalableOutlineFont.Create( - const Filename: string; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting (see TFTScalableFont.Create) - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTOutlineFont; -begin - Result := nil; - BaseFont := TFTOutlineFont(fBaseFont); - ScaledSize := Round(BaseFont.Size*Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTOutlineFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset*Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableOutlineFont.GetOutset(): single; -begin - Result := TFTOutlineFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); -end; - -procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TFTGlyph - *} - -const - {** - * Size of the transparent border surrounding the glyph image in the texture. - * The border is necessary because OpenGL does not smooth texels at the - * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. - * Without the border, magnified glyph textures look very ugly at their edges. - * It looks edgy, as if some pixels are missing especially on the left edge - * (just set cTexSmoothBorder to 0 to see what is meant by this). - * With the border even the glyphs edges are blended to the border (transparent) - * color and everything looks nice. - * - * Note: - * OpenGL already supports texture border by setting the border parameter - * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the - * border pixels to the border color. In some forums it is discouraged to use - * the border parameter as only a few of the more modern graphics cards support - * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and - * the glyph's background got black. So instead of using this feature we - * handle it on our own. The only drawback is that textures might get bigger - * because the border might require a higher power of 2 size instead of just - * two additional pixels. - *} - cTexSmoothBorder = 1; - -procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); - - procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} - begin - if (Val1 < Val2) then - Val1 := Val2; - end; - -var - I, X, Y: integer; - SrcBuffer,TmpBuffer: TGLubyteDynArray; - TexLine, TexLinePrev, TexLineNext: PGLubyteArray; - SrcLine: PGLubyteArray; - AlphaScale: single; - Value, ValueNeigh, ValueDiag: GLubyte; -const - // square-root of 2 used for diagonal neighbor pixels - cSqrt2 = 1.4142; - // number of ignored pixels on each edge of the bitmap. Consists of: - // - border used for font smoothing and - // - outer (extruded) bitmap pixel (because it is just written but never read) - cBorder = cTexSmoothBorder + 1; -begin - // allocate memory for temporary buffer - SetLength(SrcBuffer, Length(TexBuffer)); - FillChar(SrcBuffer[0], Length(TexBuffer), 0); - - // extrude pixel by pixel - for I := 1 to Ceil(Outset) do - begin - // swap arrays - TmpBuffer := TexBuffer; - TexBuffer := SrcBuffer; - SrcBuffer := TmpBuffer; - - // as long as we add an entire pixel of outset, use a solid color. - // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid - // pixels and one blended with alpha=0.2. - // For the fractional part I = Ceil(Outset) is always true. - if (I <= Outset) then - AlphaScale := 1 - else - AlphaScale := Outset - Trunc(Outset); - - // copy data to the expanded bitmap. - for Y := cBorder to fTexSize.Height - 2*cBorder do - begin - TexLine := @TexBuffer[Y*fTexSize.Width]; - TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; - TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; - SrcLine := @SrcBuffer[Y*fTexSize.Width]; - - // expand current line's pixels - for X := cBorder to fTexSize.Width - 2*cBorder do - begin - Value := SrcLine[X]; - ValueNeigh := Round(Value * AlphaScale); - ValueDiag := Round(ValueNeigh / cSqrt2); - - SetToMax(TexLine[X], Value); - SetToMax(TexLine[X-1], ValueNeigh); - SetToMax(TexLine[X+1], ValueNeigh); - - SetToMax(TexLinePrev[X], ValueNeigh); - SetToMax(TexLinePrev[X-1], ValueDiag); - SetToMax(TexLinePrev[X+1], ValueDiag); - - SetToMax(TexLineNext[X], ValueNeigh); - SetToMax(TexLineNext[X-1], ValueDiag); - SetToMax(TexLineNext[X+1], ValueDiag); - end; - end; - end; - - TmpBuffer := nil; - SetLength(SrcBuffer, 0); -end; - -procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); -var - X, Y: integer; - Glyph: FT_Glyph; - BitmapGlyph: FT_BitmapGlyph; - Bitmap: PFT_Bitmap; - BitmapLine: PChar; - BitmapBuffer: PChar; - TexBuffer: TGLubyteDynArray; - TexLine: PGLubyteArray; - CBox: FT_BBox; -begin - // load the Glyph for our character - if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then - raise Exception.Create('FT_Load_Glyph failed'); - - // move the face's glyph into a Glyph object - if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then - raise Exception.Create('FT_Get_Glyph failed'); - - // store scaled advance width/height in glyph-object - fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; - fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; - - // get the contour's bounding box (in 1/64th pixels, not font-units) - FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); - // convert 1/64th values to double values - fBounds.Left := CBox.xMin / 64; - fBounds.Right := CBox.xMax / 64 + fOutset*2; - fBounds.Bottom := CBox.yMin / 64; - fBounds.Top := CBox.yMax / 64 + fOutset*2; - - // convert the glyph to a bitmap (and destroy original glyph image) - FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); - BitmapGlyph := FT_BitmapGlyph(Glyph); - - // get bitmap offsets - fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; - // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect - // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. - fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; - - // make accessing the bitmap easier - Bitmap := @BitmapGlyph^.bitmap; - // get bitmap dimensions - fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; - fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; - - // get power-of-2 bitmap widths - fTexSize.Width := - NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); - fTexSize.Height := - NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); - - // texture-widths ignoring empty (power-of-2) padding space - fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; - fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; - - // allocate memory for texture data - SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); - FillChar(TexBuffer[0], Length(TexBuffer), 0); - - // Freetype stores the bitmap with either upper (pitch is > 0) or lower - // (pitch < 0) glyphs line first. Set the buffer to the upper line. - // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html - if (Bitmap.pitch > 0) then - BitmapBuffer := @Bitmap.buffer[0] - else - BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; - - // copy data to texture bitmap (upper line first). - for Y := 0 to Bitmap.rows-1 do - begin - // set pointer to first pixel in line that holds bitmap data. - // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels - // that are added by Extrude() later. - TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + - cTexSmoothBorder + Ceil(fOutset)]; - // get next lower line offset, use pitch instead of width as it tells - // us the storage direction of the lines. In addition a line might be padded. - BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; - for X := 0 to Bitmap.width-1 do - TexLine[X] := GLubyte(BitmapLine[X]); - end; - - if (fOutset > 0) then - Extrude(TexBuffer, fOutset); - - // allocate resources for textures and display lists - glGenTextures(1, @fTexture); - - // setup texture parameters - glBindTexture(GL_TEXTURE_2D, fTexture); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - // create alpha-map (GL_ALPHA component only). - // TexCoord (0,0) corresponds to the top left pixel of the glyph, - // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses - // a cartesian (y-axis up) coordinate system for textures. - // See the cTexSmoothBorder comment for info on texture borders. - glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, - 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); - - // free expanded data - SetLength(TexBuffer, 0); - - // create the display list - fDisplayList := glGenLists(1); - - // render to display-list - glNewList(fDisplayList, GL_COMPILE); - Render(false); - glEndList(); - - // free glyph data (bitmap, etc.) - FT_Done_Glyph(Glyph); -end; - -constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; - LoadFlags: FT_Int32); -begin - inherited Create(); - - fFont := Font; - fOutset := Outset; - - // get the Freetype char-index (use default UNICODE charmap) - fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); - - CreateTexture(LoadFlags); -end; - -destructor TFTGlyph.Destroy; -begin - if (fDisplayList <> 0) then - glDeleteLists(fDisplayList, 1); - if (fTexture <> 0) then - glDeleteTextures(1, @fTexture); - inherited; -end; - -procedure TFTGlyph.Render(UseDisplayLists: boolean); -begin - // use display-lists if enabled and exit - if (UseDisplayLists) then - begin - glCallList(fDisplayList); - Exit; - end; - - glBindTexture(GL_TEXTURE_2D, fTexture); - glPushMatrix(); - - // move to top left glyph position - glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glTexCoord2f(fTexOffset.X, 0); - glVertex2f(fBitmapCoords.Width, 0); - - // top left - glTexCoord2f(0, 0); - glVertex2f(0, 0); - - // bottom left - glTexCoord2f(0, fTexOffset.Y); - glVertex2f(0, -fBitmapCoords.Height); - - // bottom right - glTexCoord2f(fTexOffset.X, fTexOffset.Y); - glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); - glEnd(); - - glPopMatrix(); -end; - -procedure TFTGlyph.RenderReflection(); -var - Color: TGLColor; - TexUpperPos: single; - TexLowerPos: single; - UpperPos: single; -const - CutOff = 0.6; -begin - glPushMatrix(); - glBindTexture(GL_TEXTURE_2D, fTexture); - glGetFloatv(GL_CURRENT_COLOR, @Color.vals); - - // add extra space to the left of the glyph - glTranslatef(fBitmapCoords.Left, 0, 0); - - // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. - // If CutOff is set to 0.5 only half of the glyph height is displayed. - UpperPos := fFont.Descender + fFont.Height * CutOff; - - // the glyph texture's height is just the height of the glyph but not the font - // height. Setting a color for the upper and lower bounds of the glyph results - // in different color gradients. So we have to set the color values for the - // descender and ascender (as we have a cutoff, for the upper-pos here) as - // these positions are font but not glyph specific. - - // To get the texture positions we have to enhance the texture at the top and - // bottom by the amount from the top to ascender (rather upper-pos here) and - // from the bottom (Height-Top) to descender. Then we have to convert those - // heights to texture coordinates by dividing by the bitmap Height and - // removing the power-of-2 padding space by multiplying with fTexOffset.Y - // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). - TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; - TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / - fBitmapCoords.Height + 1) * fTexOffset.Y; - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glColor4f(Color.r, Color.g, Color.b, 0); - glTexCoord2f(fTexOffset.X, TexUpperPos); - glVertex2f(fBitmapCoords.Width, UpperPos); - - // top left - glTexCoord2f(0, TexUpperPos); - glVertex2f(0, UpperPos); - - // bottom left - glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); - glTexCoord2f(0, TexLowerPos); - glVertex2f(0, fFont.Descender); - - // bottom right - glTexCoord2f(fTexOffset.X, TexLowerPos); - glVertex2f(fBitmapCoords.Width, fFont.Descender); - glEnd(); - - glPopMatrix(); - - // restore old color - // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then - // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) - glColor4fv(@Color.vals); -end; - -function TFTGlyph.GetAdvance(): TPositionDbl; -begin - Result := fAdvance; -end; - -function TFTGlyph.GetBounds(): TBoundsDbl; -begin - Result := fBounds; -end; - - -{* - * TGlyphCache - *} - -constructor TGlyphCache.Create(); -begin - inherited; - fHash := TList.Create(); -end; - -destructor TGlyphCache.Destroy(); -begin - // free cached glyphs - FlushCache(false); - - // destroy TList - fHash.Free; - - inherited; -end; - -function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; -var - I: integer; - Entry: TGlyphCacheHashEntry; -begin - Result := nil; - - for I := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[I]); - - if (Entry.BaseCode > BaseCode) then - begin - InsertPos := I; - Exit; - end; - - if (Entry.BaseCode = BaseCode) then - begin - InsertPos := I; - Result := @Entry.GlyphTable; - Exit; - end; - end; - - InsertPos := fHash.Count; -end; - -function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; -var - BaseCode: cardinal; - GlyphCode: integer; - InsertPos: integer; - GlyphTable: PGlyphTable; - Entry: TGlyphCacheHashEntry; -begin - Result := false; - - BaseCode := cardinal(ch) shr 8; - GlyphTable := FindGlyphTable(BaseCode, InsertPos); - if (GlyphTable = nil) then - begin - Entry := TGlyphCacheHashEntry.Create(BaseCode); - GlyphTable := @Entry.GlyphTable; - fHash.Insert(InsertPos, Entry); - end; - - // get glyph table offset - GlyphCode := cardinal(ch) and $FF; - // insert glyph into table if not present - if (GlyphTable[GlyphCode] = nil) then - begin - GlyphTable[GlyphCode] := Glyph; - Result := true; - end; -end; - -procedure TGlyphCache.DeleteGlyph(ch: WideChar); -var - Table: PGlyphTable; - TableIndex, GlyphIndex: integer; - TableEmpty: boolean; -begin - // find table - Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); - if (Table = nil) then - Exit; - - // find glyph - GlyphIndex := cardinal(ch) and $FF; - if (Table[GlyphIndex] <> nil) then - begin - // destroy glyph - FreeAndNil(Table[GlyphIndex]); - - // check if table is empty - TableEmpty := true; - for GlyphIndex := 0 to High(Table^) do - begin - if (Table[GlyphIndex] <> nil) then - begin - TableEmpty := false; - Break; - end; - end; - - // free empty table - if (TableEmpty) then - begin - fHash.Delete(TableIndex); - end; - end; -end; - -function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; -var - InsertPos: integer; - Table: PGlyphTable; -begin - Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); - if (Table = nil) then - Result := nil - else - Result := Table[cardinal(ch) and $FF]; -end; - -function TGlyphCache.HasGlyph(ch: WideChar): boolean; -begin - Result := (GetGlyph(ch) <> nil); -end; - -procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); -var - EntryIndex, TableIndex: integer; - Entry: TGlyphCacheHashEntry; -begin - // destroy cached glyphs - for EntryIndex := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); - - // the base set (0-255) has BaseCode 0 as the upper bytes are 0. - if KeepBaseSet and (Entry.fBaseCode = 0) then - Continue; - - for TableIndex := 0 to High(Entry.GlyphTable) do - begin - if (Entry.GlyphTable[TableIndex] <> nil) then - FreeAndNil(Entry.GlyphTable[TableIndex]); - end; - FreeAndNil(Entry); - end; -end; - - -{* - * TGlyphCacheEntry - *} - -constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); -begin - inherited Create(); - fBaseCode := BaseCode; -end; - - -{* - * TFreeType - *} - -class function TFreeType.GetLibrary(): FT_Library; -begin - if (LibraryInst = nil) then - begin - // initialize freetype - if (FT_Init_FreeType(LibraryInst) <> 0) then - raise Exception.Create('FT_Init_FreeType failed'); - end; - Result := LibraryInst; -end; - -class procedure TFreeType.FreeLibrary(); -begin - if (LibraryInst <> nil) then - FT_Done_FreeType(LibraryInst); - LibraryInst := nil; -end; - - -{$IFDEF BITMAP_FONT} -{* - * TBitmapFont - *} - -constructor TBitmapFont.Create(const Filename: string; Outline: integer; - Baseline, Ascender, Descender: integer); -begin - inherited Create(); - - fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); - fTexSize := 1024; - fOutline := Outline; - fBaseline := Baseline; - fAscender := Ascender; - fDescender := Descender; - - LoadFontInfo(ChangeFileExt(Filename, '.dat')); - - ResetIntern(); -end; - -destructor TBitmapFont.Destroy(); -begin - glDeleteTextures(1, @fTex.TexNum); - inherited; -end; - -procedure TBitmapFont.ResetIntern(); -begin - fLineSpacing := Height; -end; - -procedure TBitmapFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); -var - Count: integer; -begin - for Count := 0 to 255 do - fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; -end; - -procedure TBitmapFont.LoadFontInfo(const InfoFile: string); -var - Stream: TFileStream; -begin - FillChar(fWidths[0], Length(fWidths), 0); - - Stream := nil; - try - Stream := TFileStream.Create(InfoFile, fmOpenRead); - Stream.Read(fWidths, 256); - except - raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); - end; - Stream.Free; -end; - -function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; -var - LineIndex, CharIndex: integer; - CharCode: cardinal; - Line: WideString; - LineWidth: double; -begin - Result.Left := 0; - Result.Right := 0; - Result.Top := Height; - Result.Bottom := 0; - - for LineIndex := 0 to High(Text) do - begin - Line := Text[LineIndex]; - LineWidth := 0; - for CharIndex := 1 to Length(Line) do - begin - CharCode := Ord(Line[CharIndex]); - if (CharCode < Length(fWidths)) then - LineWidth := LineWidth + fWidths[CharCode]; - end; - if (LineWidth > Result.Right) then - Result.Right := LineWidth; - end; -end; - -procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); -var - TexX, TexY: real; - TexR, TexB: real; - GlyphWidth: real; - PL, PT: real; - PR, PB: real; - CharCode: cardinal; -begin - CharCode := Ord(ch); - if (CharCode > High(fWidths)) then - CharCode := 0; - - GlyphWidth := fWidths[CharCode]; - - // set texture positions - TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; - TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; - TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; - TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; - - // set vector positions - PL := AdvanceX - fOutline; - PR := PL + GlyphWidth + fOutline*2; - PB := -fBaseline; - PT := PB + fTexSize div 16; - - (* - if (Font.Blend) then - begin - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end; - *) - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, fTex.TexNum); - - if (not ReflectionPass) then - begin - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - end - else - begin - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - -(* - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); - glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); - glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); - - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); - glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); - glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); -*) - glEnd; - - //write the colour back - glColor4fv(@fTempColor); - - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - (* - if (Font.Blend) then - glDisable(GL_BLEND); - *) - - AdvanceX := AdvanceX + GlyphWidth; -end; - -procedure TBitmapFont.Render(const Text: WideString); -var - CharIndex: integer; - AdvanceX: real; -begin - // if there is no text do nothing - if (Text = '') then - Exit; - - //Save the current color and alpha (for reflection) - glGetFloatv(GL_CURRENT_COLOR, @fTempColor); - - AdvanceX := 0; - for CharIndex := 1 to Length(Text) do - begin - RenderChar(Text[CharIndex], AdvanceX); - end; -end; - -function TBitmapFont.GetHeight(): single; -begin - Result := fAscender - fDescender; -end; - -function TBitmapFont.GetAscender(): single; -begin - Result := fAscender; -end; - -function TBitmapFont.GetDescender(): single; -begin - Result := fDescender; -end; - -function TBitmapFont.GetUnderlinePosition(): single; -begin - Result := -2.0; -end; - -function TBitmapFont.GetUnderlineThickness(): single; -begin - Result := 1.0; -end; - -{$ENDIF BITMAP_FONT} - - -initialization - -finalization - TFreeType.FreeLibrary(); - -end. + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + fMipmapFonts[Level].Free; + inherited; +end; + +procedure TScalableFont.ResetIntern(); +begin + fScale := 1.0; + fAspect := 1.0; +end; + +procedure TScalableFont.Reset(); +var + Level: integer; +begin + inherited; + ResetIntern(); + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].Reset(); +end; + +{** + * Returns the mipmap level to use with regard to the current projection + * and modelview matrix, font scale and aspect. + * + * Note: + * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise + * the glyph widths/heights ratios and advance widths of the mipmap fonts + * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has + * width 12px, but at size 6px width 8px). + * - returned mipmap-level is used for all glyphs of the current text to print. + * This is faster, much easier to handle, since we just need to create + * multiple sized fonts and select the one we need for the mipmap-level and + * it avoids that neighbored glyphs use different mipmap-level which might + * look odd because one glyph might look blurry and the other sharp. + * + * Motivation: + * We do not use OpenGL for mipmapping as the results are very bad. At least + * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather + * blurry. + * Defining our own mipmaps by creating multiple textures with + * for different mimap levels is a pain, as the font size passed to freetype + * is not the size of the bitmaps created and it does not guarantee that a + * glyph bitmap of a font with font-size s/2 is half the size of the font with + * font-size s. If the bitmap size is just a single pixel bigger than the half + * we might need a texture of the next power-of-2 and the texture would not be + * half of the size of the next bigger mipmap. In addition we use a fixed one + * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe + * an outset that is added to the font, so creating a glyph mipmap that is + * exactly half the size of the next bigger one is a very difficult task. + * + * Solution: + * Use mipmap textures that are not exactly half the size of the next mipmap + * level. OpenGL does not support this (at least not without extensions). + * The trickiest task is to determine the mipmap to use by calculating the + * amount of minification that is performed in this function. + *} +function TScalableFont.GetMipmapLevel(): integer; +var + ModelMatrix, ProjMatrix: T16dArray; + WinCoords: array[0..2, 0..2] of GLdouble; + ViewPortArray: TViewPortArray; + Dist, Dist2: double; + WidthScale, HeightScale: double; +const + // width/height of square used for determining the scale + cTestSize = 10.0; + // an offset to the mipmap-level to adjust the change-over of two consecutive + // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 + // the result level will be 2. A bias of 0.5 is equal to rounding. + // With bias=0.1 we prefer larger mipmaps over smaller ones. + cBias = 0.2; +begin + // 1. retrieve current transformation matrices for gluProject + glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); + glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); + glGetIntegerv(GL_VIEWPORT, @ViewPortArray); + + // 2. project three of the corner points of a square with size cTestSize + // to window coordinates (the square is just a dummy for a glyph) + + // project point (x1, y1) to window corrdinates + gluProject(0, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); + // project point (x2, y1) to window corrdinates + gluProject(cTestSize, 0, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); + // project point (x1, y2) to window corrdinates + gluProject(0, cTestSize, 0, + ModelMatrix, ProjMatrix, ViewPortArray, + @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); + + // 3. Lets see how much the width and height of the square changed. + // Calculate the width and height as displayed on the screen in window + // coordinates and calculate the ratio to the original coordinates in + // modelview space so the ratio gives us the scale (minification here). + + // projected width ||(x1, y1) - (x2, y1)|| + Dist := (WinCoords[0][0] - WinCoords[1][0]); + Dist2 := (WinCoords[0][1] - WinCoords[1][1]); + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + // projected height ||(x1, y1) - (x1, y2)|| + Dist := (WinCoords[0][0] - WinCoords[2][0]); + Dist2 := (WinCoords[0][1] - WinCoords[2][1]); + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); + + // 4. Now that we have got the scale, take the bigger minification scale + // and get it to a logarithmic scale as each mipmap is 1/2 the size of its + // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). + // The result is our mipmap-level = the index of the mipmap to use. + + // Level > 0: Minification; < 0: Magnification + Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); + + // clamp to valid range + if (Result < 0) then + Result := 0; + if (Result > High(fMipmapFonts)) then + Result := High(fMipmapFonts); +end; + +function TScalableFont.GetMipmapScale(Level: integer): single; +begin + if (fMipmapFonts[Level] = nil) then + begin + Result := -1; + Exit; + end; + + Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; +end; + +{** + * Returns the correct mipmap font for the current scale and projection + * matrix. The modelview scale is adjusted to the mipmap level, so + * Result.Print() will display the font in the correct size. + *} +function TScalableFont.ChooseMipmapFont(): TFont; +var + DesiredLevel: integer; + Level: integer; + MipmapScale: single; +begin + Result := nil; + DesiredLevel := GetMipmapLevel(); + + // get the smallest mipmap available for the desired level + // as not all levels must be assigned to a font. + for Level := DesiredLevel downto 0 do + begin + if (fMipmapFonts[Level] <> nil) then + begin + Result := fMipmapFonts[Level]; + Break; + end; + end; + + // since the mipmap font (if level > 0) is smaller than the base-font + // we have to scale to get its size right. + MipmapScale := fMipmapFonts[0].Height/Result.Height; + glScalef(MipmapScale, MipmapScale, 0); +end; + +procedure TScalableFont.Print(const Text: TWideStringArray); +begin + glPushMatrix(); + + // set scale and stretching + glScalef(fScale * fAspect, fScale, 0); + + // print text + if (fUseMipmaps) then + ChooseMipmapFont().Print(Text) + else + fBaseFont.Print(Text); + + glPopMatrix(); +end; + +procedure TScalableFont.Render(const Text: WideString); +begin + Assert(false, 'Unused TScalableFont.Render() was called'); +end; + +function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fBaseFont.BBox(Text, Advance); + Result.Left := Result.Left * fScale * fAspect; + Result.Right := Result.Right * fScale * fAspect; + Result.Top := Result.Top * fScale; + Result.Bottom := Result.Bottom * fScale; +end; + +procedure TScalableFont.SetHeight(Height: single); +begin + fScale := Height / fBaseFont.GetHeight(); +end; + +function TScalableFont.GetHeight(): single; +begin + Result := fBaseFont.GetHeight() * fScale; +end; + +procedure TScalableFont.SetAspect(Aspect: single); +begin + fAspect := Aspect; +end; + +function TScalableFont.GetAspect(): single; +begin + Result := fAspect; +end; + +function TScalableFont.GetAscender(): single; +begin + Result := fBaseFont.GetAscender() * fScale; +end; + +function TScalableFont.GetDescender(): single; +begin + Result := fBaseFont.GetDescender() * fScale; +end; + +procedure TScalableFont.SetLineSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetLineSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetGlyphSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetGlyphSpacing(): single; +begin + Result := fBaseFont.GetGlyphSpacing() * fScale; +end; + +procedure TScalableFont.SetReflectionSpacing(Spacing: single); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); +end; + +function TScalableFont.GetReflectionSpacing(): single; +begin + Result := fBaseFont.GetLineSpacing() * fScale; +end; + +procedure TScalableFont.SetStyle(Style: TFontStyle); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetStyle(Style); +end; + +function TScalableFont.GetStyle(): TFontStyle; +begin + Result := fBaseFont.GetStyle(); +end; + +function TScalableFont.GetUnderlinePosition(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +function TScalableFont.GetUnderlineThickness(): single; +begin + Result := fBaseFont.GetUnderlinePosition(); +end; + +procedure TScalableFont.SetUseKerning(Enable: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + fMipmapFonts[Level].SetUseKerning(Enable); +end; + + +{* + * TCachedFont + *} + +constructor TCachedFont.Create(); +begin + inherited; + fCache := TGlyphCache.Create(); +end; + +destructor TCachedFont.Destroy(); +begin + fCache.Free; + inherited; +end; + +function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +begin + Result := fCache.GetGlyph(ch); + if (Result = nil) then + begin + Result := LoadGlyph(ch); + if (not fCache.AddGlyph(ch, Result)) then + Result.Free; + end; +end; + +procedure TCachedFont.FlushCache(KeepBaseSet: boolean); +begin + fCache.FlushCache(KeepBaseSet); +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + i: WideChar; +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + + // load font information + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + + // support scalable fonts only + if (not FT_IS_SCALABLE(fFace)) then + raise Exception.Create('Font is not scalable'); + + if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then + raise Exception.Create('FT_Set_Pixel_Sizes failes'); + + // get scale factor for font-unit to pixel-size transformation + fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; + fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; + + ResetIntern(); + + // pre-cache some commonly used glyphs (' ' - '~') + for i := #32 to #126 do + fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); +end; + +destructor TFTFont.Destroy(); +begin + // free face + FT_Done_Face(fFace); + inherited; +end; + +procedure TFTFont.ResetIntern(); +begin + // Note: outset and non outset fonts use same spacing + fLineSpacing := fFace.height * fFontUnitScale.Y; + fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; +end; + +procedure TFTFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +begin + Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); +end; + +function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + Glyph, PrevGlyph: TFTGlyph; + TextLine: WideString; + LineYOffset: single; + LineIndex, CharIndex: integer; + LineBounds: TBoundsDbl; + KernDelta: FT_Vector; + UnderlinePos: double; +begin + // Reset global bounds + Result.Left := Infinity; + Result.Right := 0; + Result.Bottom := Infinity; + Result.Top := 0; + + // reset last glyph + PrevGlyph := nil; + + // display text + for LineIndex := 0 to High(Text) do + begin + // get next text line + TextLine := Text[LineIndex]; + LineYOffset := -LineSpacing * LineIndex; + + // reset line bounds + LineBounds.Left := Infinity; + LineBounds.Right := 0; + LineBounds.Bottom := Infinity; + LineBounds.Top := 0; + + // for each glyph image, compute its bounding box + for CharIndex := 1 to Length(TextLine) do + begin + Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); + if (Glyph <> nil) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + end; + + // update left bound (must be done before right bound is updated) + if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then + LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; + + // update right bound + if (CharIndex < Length(TextLine)) or // not the last character + (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) + Advance then // or in advance mode + begin + // add advance and glyph spacing + LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing + end + else + begin + // add glyph's right bound + LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; + end; + + // update bottom and top bounds + if (Glyph.Bounds.Bottom < LineBounds.Bottom) then + LineBounds.Bottom := Glyph.Bounds.Bottom; + if (Glyph.Bounds.Top > LineBounds.Top) then + LineBounds.Top := Glyph.Bounds.Top; + end; + + PrevGlyph := Glyph; + end; + + // handle italic font style + if (Italic in Style) then + begin + LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; + LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; + end; + + // handle underlined font style + if (Underline in Style) then + begin + UnderlinePos := GetUnderlinePosition(); + if (UnderlinePos < LineBounds.Bottom) then + LineBounds.Bottom := UnderlinePos; + end; + + // add line offset + LineBounds.Bottom := LineBounds.Bottom + LineYOffset; + LineBounds.Top := LineBounds.Top + LineYOffset; + + // adjust global bounds + if (Result.Left > LineBounds.Left) then + Result.Left := LineBounds.Left; + if (Result.Right < LineBounds.Right) then + Result.Right := LineBounds.Right; + if (Result.Bottom > LineBounds.Bottom) then + Result.Bottom := LineBounds.Bottom; + if (Result.Top < LineBounds.Top) then + Result.Top := LineBounds.Top; + end; + + // if left or bottom bound was not set, set them to 0 + if (Result.Left = Infinity) then + Result.Left := 0.0; + if (Result.Bottom = Infinity) then + Result.Bottom := 0.0; +end; + +procedure TFTFont.Render(const Text: WideString); +var + CharIndex: integer; + Glyph, PrevGlyph: TFTGlyph; + KernDelta: FT_Vector; +begin + // reset last glyph + PrevGlyph := nil; + + // draw current line + for CharIndex := 1 to Length(Text) do + begin + Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); + if (Assigned(Glyph)) then + begin + // get kerning + if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + begin + FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_KERNING_UNSCALED, KernDelta); + glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + end; + + if (ReflectionPass) then + Glyph.RenderReflection() + else + Glyph.Render(fUseDisplayLists); + + glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); + end; + + PrevGlyph := Glyph; + end; +end; + +function TFTFont.GetHeight(): single; +begin + Result := Ascender - Descender; +end; + +function TFTFont.GetAscender(): single; +begin + Result := fFace.ascender * fFontUnitScale.Y + Outset*2; +end; + +function TFTFont.GetDescender(): single; +begin + // Note: outset is not part of the descender as the baseline is lifted + Result := fFace.descender * fFontUnitScale.Y; +end; + +function TFTFont.GetUnderlinePosition(): single; +begin + Result := fFace.underline_position * fFontUnitScale.Y - Outset; +end; + +function TFTFont.GetUnderlineThickness(): single; +begin + Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; +end; + + +{* + * TFTScalableFont + *} + +constructor TFTScalableFont.Create(const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting to preserve font outlines at each font + // size, otherwise the font widths/heights do not match resulting in ugly + // text size changes during zooming. + // A drawback is a reduced quality with smaller font sizes but it is not that + // bad with gray-scaled rendering (at least it looks better than OpenGL's + // linear downscaling on minification). + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTFont; +begin + Result := nil; + BaseFont := TFTFont(fBaseFont); + ScaledSize := Round(BaseFont.Size * Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset * Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableFont.GetOutset(): single; +begin + Result := TFTFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TOutlineFont + *} + +constructor TFTOutlineFont.Create( + const Filename: string; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFilename := Filename; + fSize := Size; + fOutset := Outset; + + fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + + ResetIntern(); +end; + +destructor TFTOutlineFont.Destroy; +begin + fOutlineFont.Free; + fInnerFont.Free; + inherited; +end; + +procedure TFTOutlineFont.ResetIntern(); +begin + // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing + // of the outline font? + //fInnerFont.GlyphSpacing := fOutset*2; + fOutlineFont.GlyphSpacing := -fOutset*2; + + fLineSpacing := fOutlineFont.LineSpacing; + fReflectionSpacing := fOutlineFont.ReflectionSpacing; + fOutlineColor := NewGLColor(0, 0, 0, -1); +end; + +procedure TFTOutlineFont.Reset(); +begin + inherited; + fInnerFont.Reset(); + fOutlineFont.Reset(); + ResetIntern(); +end; + +procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +var + CurrentColor: TGLColor; + OutlineColor: TGLColor; +begin + // save current color + glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); + + // if the outline's alpha component is < 0 use the current alpha + OutlineColor := fOutlineColor; + if (OutlineColor.a < 0) then + OutlineColor.a := CurrentColor.a; + + // draw underline outline (in outline color) + glColor4fv(@OutlineColor.vals); + fOutlineFont.DrawUnderline(Text); + glColor4fv(@CurrentColor.vals); + + // draw underline inner part (in current color) + glPushMatrix(); + glTranslatef(fOutset, 0, 0); + fInnerFont.DrawUnderline(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.Render(const Text: WideString); +var + CurrentColor: TGLColor; + OutlineColor: TGLColor; +begin + // save current color + glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); + + // if the outline's alpha component is < 0 use the current alpha + OutlineColor := fOutlineColor; + if (OutlineColor.a < 0) then + OutlineColor.a := CurrentColor.a; + + { setup and render outline font } + + glColor4fv(@OutlineColor.vals); + glPushMatrix(); + fOutlineFont.Render(Text); + glPopMatrix(); + glColor4fv(@CurrentColor.vals); + + { setup and render inner font } + + glPushMatrix(); + glTranslatef(fOutset, fOutset, 0); + fInnerFont.Render(Text); + glPopMatrix(); +end; + +procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +begin + fOutlineColor := NewGLColor(r, g, b, a); +end; + +procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); +begin + fOutlineFont.FlushCache(KeepBaseSet); + fInnerFont.FlushCache(KeepBaseSet); +end; + +function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +begin + Result := fOutlineFont.BBox(Text, Advance); +end; + +function TFTOutlineFont.GetHeight(): single; +begin + Result := fOutlineFont.Height; +end; + +function TFTOutlineFont.GetAscender(): single; +begin + Result := fOutlineFont.Ascender; +end; + +function TFTOutlineFont.GetDescender(): single; +begin + Result := fOutlineFont.Descender; +end; + +procedure TFTOutlineFont.SetLineSpacing(Spacing: single); +begin + inherited SetLineSpacing(Spacing); + fInnerFont.LineSpacing := Spacing; + fOutlineFont.LineSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); +begin + inherited SetGlyphSpacing(Spacing); + fInnerFont.GlyphSpacing := Spacing; + fOutlineFont.GlyphSpacing := Spacing - Outset*2; +end; + +procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); +begin + inherited SetReflectionSpacing(Spacing); + fInnerFont.ReflectionSpacing := Spacing; + fOutlineFont.ReflectionSpacing := Spacing; +end; + +procedure TFTOutlineFont.SetStyle(Style: TFontStyle); +begin + inherited SetStyle(Style); + fInnerFont.Style := Style; + fOutlineFont.Style := Style; +end; + +function TFTOutlineFont.GetStyle(): TFontStyle; +begin + Result := inherited GetStyle(); +end; + +function TFTOutlineFont.GetUnderlinePosition(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +function TFTOutlineFont.GetUnderlineThickness(): single; +begin + Result := fOutlineFont.GetUnderlinePosition(); +end; + +procedure TFTOutlineFont.SetUseKerning(Enable: boolean); +begin + inherited SetUseKerning(Enable); + fInnerFont.fUseKerning := Enable; + fOutlineFont.fUseKerning := Enable; +end; + +procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); +begin + inherited SetReflectionPass(Enable); + fInnerFont.fReflectionPass := Enable; + fOutlineFont.fReflectionPass := Enable; +end; + +{** + * TScalableOutlineFont + *} + +constructor TFTScalableOutlineFont.Create( + const Filename: string; + Size: integer; OutsetAmount: single; + UseMipmaps: boolean); +var + LoadFlags: FT_Int32; +begin + LoadFlags := FT_LOAD_DEFAULT; + // Disable hinting and grid-fitting (see TFTScalableFont.Create) + if (UseMipmaps) then + LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; + inherited Create( + TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), + UseMipmaps); +end; + +function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; +var + ScaledSize: integer; + BaseFont: TFTOutlineFont; +begin + Result := nil; + BaseFont := TFTOutlineFont(fBaseFont); + ScaledSize := Round(BaseFont.Size*Scale); + // do not create mipmap fonts < 8 pixels + if (ScaledSize < 8) then + Exit; + Result := TFTOutlineFont.Create(BaseFont.fFilename, + ScaledSize, BaseFont.fOutset*Scale, + FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); +end; + +function TFTScalableOutlineFont.GetOutset(): single; +begin + Result := TFTOutlineFont(fBaseFont).Outset * fScale; +end; + +procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); +end; + +procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); +end; + + +{* + * TFTGlyph + *} + +const + {** + * Size of the transparent border surrounding the glyph image in the texture. + * The border is necessary because OpenGL does not smooth texels at the + * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. + * Without the border, magnified glyph textures look very ugly at their edges. + * It looks edgy, as if some pixels are missing especially on the left edge + * (just set cTexSmoothBorder to 0 to see what is meant by this). + * With the border even the glyphs edges are blended to the border (transparent) + * color and everything looks nice. + * + * Note: + * OpenGL already supports texture border by setting the border parameter + * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the + * border pixels to the border color. In some forums it is discouraged to use + * the border parameter as only a few of the more modern graphics cards support + * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and + * the glyph's background got black. So instead of using this feature we + * handle it on our own. The only drawback is that textures might get bigger + * because the border might require a higher power of 2 size instead of just + * two additional pixels. + *} + cTexSmoothBorder = 1; + +procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + + procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + begin + if (Val1 < Val2) then + Val1 := Val2; + end; + +var + I, X, Y: integer; + SrcBuffer,TmpBuffer: TGLubyteDynArray; + TexLine, TexLinePrev, TexLineNext: PGLubyteArray; + SrcLine: PGLubyteArray; + AlphaScale: single; + Value, ValueNeigh, ValueDiag: GLubyte; +const + // square-root of 2 used for diagonal neighbor pixels + cSqrt2 = 1.4142; + // number of ignored pixels on each edge of the bitmap. Consists of: + // - border used for font smoothing and + // - outer (extruded) bitmap pixel (because it is just written but never read) + cBorder = cTexSmoothBorder + 1; +begin + // allocate memory for temporary buffer + SetLength(SrcBuffer, Length(TexBuffer)); + FillChar(SrcBuffer[0], Length(TexBuffer), 0); + + // extrude pixel by pixel + for I := 1 to Ceil(Outset) do + begin + // swap arrays + TmpBuffer := TexBuffer; + TexBuffer := SrcBuffer; + SrcBuffer := TmpBuffer; + + // as long as we add an entire pixel of outset, use a solid color. + // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid + // pixels and one blended with alpha=0.2. + // For the fractional part I = Ceil(Outset) is always true. + if (I <= Outset) then + AlphaScale := 1 + else + AlphaScale := Outset - Trunc(Outset); + + // copy data to the expanded bitmap. + for Y := cBorder to fTexSize.Height - 2*cBorder do + begin + TexLine := @TexBuffer[Y*fTexSize.Width]; + TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; + TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; + SrcLine := @SrcBuffer[Y*fTexSize.Width]; + + // expand current line's pixels + for X := cBorder to fTexSize.Width - 2*cBorder do + begin + Value := SrcLine[X]; + ValueNeigh := Round(Value * AlphaScale); + ValueDiag := Round(ValueNeigh / cSqrt2); + + SetToMax(TexLine[X], Value); + SetToMax(TexLine[X-1], ValueNeigh); + SetToMax(TexLine[X+1], ValueNeigh); + + SetToMax(TexLinePrev[X], ValueNeigh); + SetToMax(TexLinePrev[X-1], ValueDiag); + SetToMax(TexLinePrev[X+1], ValueDiag); + + SetToMax(TexLineNext[X], ValueNeigh); + SetToMax(TexLineNext[X-1], ValueDiag); + SetToMax(TexLineNext[X+1], ValueDiag); + end; + end; + end; + + TmpBuffer := nil; + SetLength(SrcBuffer, 0); +end; + +procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); +var + X, Y: integer; + Glyph: FT_Glyph; + BitmapGlyph: FT_BitmapGlyph; + Bitmap: PFT_Bitmap; + BitmapLine: PChar; + BitmapBuffer: PChar; + TexBuffer: TGLubyteDynArray; + TexLine: PGLubyteArray; + CBox: FT_BBox; +begin + // load the Glyph for our character + if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then + raise Exception.Create('FT_Load_Glyph failed'); + + // move the face's glyph into a Glyph object + if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then + raise Exception.Create('FT_Get_Glyph failed'); + + // store scaled advance width/height in glyph-object + fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + + // get the contour's bounding box (in 1/64th pixels, not font-units) + FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); + // convert 1/64th values to double values + fBounds.Left := CBox.xMin / 64; + fBounds.Right := CBox.xMax / 64 + fOutset*2; + fBounds.Bottom := CBox.yMin / 64; + fBounds.Top := CBox.yMax / 64 + fOutset*2; + + // convert the glyph to a bitmap (and destroy original glyph image) + FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + BitmapGlyph := FT_BitmapGlyph(Glyph); + + // get bitmap offsets + fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; + // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect + // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. + fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; + + // make accessing the bitmap easier + Bitmap := @BitmapGlyph^.bitmap; + // get bitmap dimensions + fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; + fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; + + // get power-of-2 bitmap widths + fTexSize.Width := + NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); + fTexSize.Height := + NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); + + // texture-widths ignoring empty (power-of-2) padding space + fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; + fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; + + // allocate memory for texture data + SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); + FillChar(TexBuffer[0], Length(TexBuffer), 0); + + // Freetype stores the bitmap with either upper (pitch is > 0) or lower + // (pitch < 0) glyphs line first. Set the buffer to the upper line. + // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html + if (Bitmap.pitch > 0) then + BitmapBuffer := @Bitmap.buffer[0] + else + BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; + + // copy data to texture bitmap (upper line first). + for Y := 0 to Bitmap.rows-1 do + begin + // set pointer to first pixel in line that holds bitmap data. + // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels + // that are added by Extrude() later. + TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + + cTexSmoothBorder + Ceil(fOutset)]; + // get next lower line offset, use pitch instead of width as it tells + // us the storage direction of the lines. In addition a line might be padded. + BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; + for X := 0 to Bitmap.width-1 do + TexLine[X] := GLubyte(BitmapLine[X]); + end; + + if (fOutset > 0) then + Extrude(TexBuffer, fOutset); + + // allocate resources for textures and display lists + glGenTextures(1, @fTexture); + + // setup texture parameters + glBindTexture(GL_TEXTURE_2D, fTexture); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); + + glPixelStorei(GL_UNPACK_ALIGNMENT, 1); + // create alpha-map (GL_ALPHA component only). + // TexCoord (0,0) corresponds to the top left pixel of the glyph, + // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses + // a cartesian (y-axis up) coordinate system for textures. + // See the cTexSmoothBorder comment for info on texture borders. + glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, + 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); + + // free expanded data + SetLength(TexBuffer, 0); + + // create the display list + fDisplayList := glGenLists(1); + + // render to display-list + glNewList(fDisplayList, GL_COMPILE); + Render(false); + glEndList(); + + // free glyph data (bitmap, etc.) + FT_Done_Glyph(Glyph); +end; + +constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; + LoadFlags: FT_Int32); +begin + inherited Create(); + + fFont := Font; + fOutset := Outset; + + // get the Freetype char-index (use default UNICODE charmap) + fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + + CreateTexture(LoadFlags); +end; + +destructor TFTGlyph.Destroy; +begin + if (fDisplayList <> 0) then + glDeleteLists(fDisplayList, 1); + if (fTexture <> 0) then + glDeleteTextures(1, @fTexture); + inherited; +end; + +procedure TFTGlyph.Render(UseDisplayLists: boolean); +begin + // use display-lists if enabled and exit + if (UseDisplayLists) then + begin + glCallList(fDisplayList); + Exit; + end; + + glBindTexture(GL_TEXTURE_2D, fTexture); + glPushMatrix(); + + // move to top left glyph position + glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glTexCoord2f(fTexOffset.X, 0); + glVertex2f(fBitmapCoords.Width, 0); + + // top left + glTexCoord2f(0, 0); + glVertex2f(0, 0); + + // bottom left + glTexCoord2f(0, fTexOffset.Y); + glVertex2f(0, -fBitmapCoords.Height); + + // bottom right + glTexCoord2f(fTexOffset.X, fTexOffset.Y); + glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); + glEnd(); + + glPopMatrix(); +end; + +procedure TFTGlyph.RenderReflection(); +var + Color: TGLColor; + TexUpperPos: single; + TexLowerPos: single; + UpperPos: single; +const + CutOff = 0.6; +begin + glPushMatrix(); + glBindTexture(GL_TEXTURE_2D, fTexture); + glGetFloatv(GL_CURRENT_COLOR, @Color.vals); + + // add extra space to the left of the glyph + glTranslatef(fBitmapCoords.Left, 0, 0); + + // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. + // If CutOff is set to 0.5 only half of the glyph height is displayed. + UpperPos := fFont.Descender + fFont.Height * CutOff; + + // the glyph texture's height is just the height of the glyph but not the font + // height. Setting a color for the upper and lower bounds of the glyph results + // in different color gradients. So we have to set the color values for the + // descender and ascender (as we have a cutoff, for the upper-pos here) as + // these positions are font but not glyph specific. + + // To get the texture positions we have to enhance the texture at the top and + // bottom by the amount from the top to ascender (rather upper-pos here) and + // from the bottom (Height-Top) to descender. Then we have to convert those + // heights to texture coordinates by dividing by the bitmap Height and + // removing the power-of-2 padding space by multiplying with fTexOffset.Y + // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). + TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; + TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / + fBitmapCoords.Height + 1) * fTexOffset.Y; + + // draw glyph texture + glBegin(GL_QUADS); + // top right + glColor4f(Color.r, Color.g, Color.b, 0); + glTexCoord2f(fTexOffset.X, TexUpperPos); + glVertex2f(fBitmapCoords.Width, UpperPos); + + // top left + glTexCoord2f(0, TexUpperPos); + glVertex2f(0, UpperPos); + + // bottom left + glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); + glTexCoord2f(0, TexLowerPos); + glVertex2f(0, fFont.Descender); + + // bottom right + glTexCoord2f(fTexOffset.X, TexLowerPos); + glVertex2f(fBitmapCoords.Width, fFont.Descender); + glEnd(); + + glPopMatrix(); + + // restore old color + // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then + // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) + glColor4fv(@Color.vals); +end; + +function TFTGlyph.GetAdvance(): TPositionDbl; +begin + Result := fAdvance; +end; + +function TFTGlyph.GetBounds(): TBoundsDbl; +begin + Result := fBounds; +end; + + +{* + * TGlyphCache + *} + +constructor TGlyphCache.Create(); +begin + inherited; + fHash := TList.Create(); +end; + +destructor TGlyphCache.Destroy(); +begin + // free cached glyphs + FlushCache(false); + + // destroy TList + fHash.Free; + + inherited; +end; + +function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; +var + I: integer; + Entry: TGlyphCacheHashEntry; +begin + Result := nil; + + for I := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[I]); + + if (Entry.BaseCode > BaseCode) then + begin + InsertPos := I; + Exit; + end; + + if (Entry.BaseCode = BaseCode) then + begin + InsertPos := I; + Result := @Entry.GlyphTable; + Exit; + end; + end; + + InsertPos := fHash.Count; +end; + +function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +var + BaseCode: cardinal; + GlyphCode: integer; + InsertPos: integer; + GlyphTable: PGlyphTable; + Entry: TGlyphCacheHashEntry; +begin + Result := false; + + BaseCode := cardinal(ch) shr 8; + GlyphTable := FindGlyphTable(BaseCode, InsertPos); + if (GlyphTable = nil) then + begin + Entry := TGlyphCacheHashEntry.Create(BaseCode); + GlyphTable := @Entry.GlyphTable; + fHash.Insert(InsertPos, Entry); + end; + + // get glyph table offset + GlyphCode := cardinal(ch) and $FF; + // insert glyph into table if not present + if (GlyphTable[GlyphCode] = nil) then + begin + GlyphTable[GlyphCode] := Glyph; + Result := true; + end; +end; + +procedure TGlyphCache.DeleteGlyph(ch: WideChar); +var + Table: PGlyphTable; + TableIndex, GlyphIndex: integer; + TableEmpty: boolean; +begin + // find table + Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + if (Table = nil) then + Exit; + + // find glyph + GlyphIndex := cardinal(ch) and $FF; + if (Table[GlyphIndex] <> nil) then + begin + // destroy glyph + FreeAndNil(Table[GlyphIndex]); + + // check if table is empty + TableEmpty := true; + for GlyphIndex := 0 to High(Table^) do + begin + if (Table[GlyphIndex] <> nil) then + begin + TableEmpty := false; + Break; + end; + end; + + // free empty table + if (TableEmpty) then + begin + fHash.Delete(TableIndex); + end; + end; +end; + +function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +var + InsertPos: integer; + Table: PGlyphTable; +begin + Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + if (Table = nil) then + Result := nil + else + Result := Table[cardinal(ch) and $FF]; +end; + +function TGlyphCache.HasGlyph(ch: WideChar): boolean; +begin + Result := (GetGlyph(ch) <> nil); +end; + +procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); +var + EntryIndex, TableIndex: integer; + Entry: TGlyphCacheHashEntry; +begin + // destroy cached glyphs + for EntryIndex := 0 to fHash.Count-1 do + begin + Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); + + // the base set (0-255) has BaseCode 0 as the upper bytes are 0. + if KeepBaseSet and (Entry.fBaseCode = 0) then + Continue; + + for TableIndex := 0 to High(Entry.GlyphTable) do + begin + if (Entry.GlyphTable[TableIndex] <> nil) then + FreeAndNil(Entry.GlyphTable[TableIndex]); + end; + FreeAndNil(Entry); + end; +end; + + +{* + * TGlyphCacheEntry + *} + +constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); +begin + inherited Create(); + fBaseCode := BaseCode; +end; + + +{* + * TFreeType + *} + +class function TFreeType.GetLibrary(): FT_Library; +begin + if (LibraryInst = nil) then + begin + // initialize freetype + if (FT_Init_FreeType(LibraryInst) <> 0) then + raise Exception.Create('FT_Init_FreeType failed'); + end; + Result := LibraryInst; +end; + +class procedure TFreeType.FreeLibrary(); +begin + if (LibraryInst <> nil) then + FT_Done_FreeType(LibraryInst); + LibraryInst := nil; +end; + + +{$IFDEF BITMAP_FONT} +{* + * TBitmapFont + *} + +constructor TBitmapFont.Create(const Filename: string; Outline: integer; + Baseline, Ascender, Descender: integer); +begin + inherited Create(); + + fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); + fTexSize := 1024; + fOutline := Outline; + fBaseline := Baseline; + fAscender := Ascender; + fDescender := Descender; + + LoadFontInfo(ChangeFileExt(Filename, '.dat')); + + ResetIntern(); +end; + +destructor TBitmapFont.Destroy(); +begin + glDeleteTextures(1, @fTex.TexNum); + inherited; +end; + +procedure TBitmapFont.ResetIntern(); +begin + fLineSpacing := Height; +end; + +procedure TBitmapFont.Reset(); +begin + inherited; + ResetIntern(); +end; + +procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); +var + Count: integer; +begin + for Count := 0 to 255 do + fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; +end; + +procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +var + Stream: TFileStream; +begin + FillChar(fWidths[0], Length(fWidths), 0); + + Stream := nil; + try + Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream.Read(fWidths, 256); + except + raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + end; + Stream.Free; +end; + +function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +var + LineIndex, CharIndex: integer; + CharCode: cardinal; + Line: WideString; + LineWidth: double; +begin + Result.Left := 0; + Result.Right := 0; + Result.Top := Height; + Result.Bottom := 0; + + for LineIndex := 0 to High(Text) do + begin + Line := Text[LineIndex]; + LineWidth := 0; + for CharIndex := 1 to Length(Line) do + begin + CharCode := Ord(Line[CharIndex]); + if (CharCode < Length(fWidths)) then + LineWidth := LineWidth + fWidths[CharCode]; + end; + if (LineWidth > Result.Right) then + Result.Right := LineWidth; + end; +end; + +procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +var + TexX, TexY: real; + TexR, TexB: real; + GlyphWidth: real; + PL, PT: real; + PR, PB: real; + CharCode: cardinal; +begin + CharCode := Ord(ch); + if (CharCode > High(fWidths)) then + CharCode := 0; + + GlyphWidth := fWidths[CharCode]; + + // set texture positions + TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; + TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; + TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; + TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; + + // set vector positions + PL := AdvanceX - fOutline; + PR := PL + GlyphWidth + fOutline*2; + PB := -fBaseline; + PT := PB + fTexSize div 16; + + (* + if (Font.Blend) then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end; + *) + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, fTex.TexNum); + + if (not ReflectionPass) then + begin + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + end + else + begin + glDepthRange(0, 10); + glDepthFunc(GL_LEQUAL); + glEnable(GL_DEPTH_TEST); + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + glEnd; + + glBegin(GL_QUADS); + glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); + glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); + glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); + glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); + +(* + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); + glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); + glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); + + glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); + glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); + glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); +*) + glEnd; + + //write the colour back + glColor4fv(@fTempColor); + + glDisable(GL_DEPTH_TEST); + end; // reflection + + glDisable(GL_TEXTURE_2D); + (* + if (Font.Blend) then + glDisable(GL_BLEND); + *) + + AdvanceX := AdvanceX + GlyphWidth; +end; + +procedure TBitmapFont.Render(const Text: WideString); +var + CharIndex: integer; + AdvanceX: real; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + //Save the current color and alpha (for reflection) + glGetFloatv(GL_CURRENT_COLOR, @fTempColor); + + AdvanceX := 0; + for CharIndex := 1 to Length(Text) do + begin + RenderChar(Text[CharIndex], AdvanceX); + end; +end; + +function TBitmapFont.GetHeight(): single; +begin + Result := fAscender - fDescender; +end; + +function TBitmapFont.GetAscender(): single; +begin + Result := fAscender; +end; + +function TBitmapFont.GetDescender(): single; +begin + Result := fDescender; +end; + +function TBitmapFont.GetUnderlinePosition(): single; +begin + Result := -2.0; +end; + +function TBitmapFont.GetUnderlineThickness(): single; +begin + Result := 1.0; +end; + +{$ENDIF BITMAP_FONT} + + +initialization + +finalization + TFreeType.FreeLibrary(); + +end. -- cgit v1.2.3 From c01eba6a6494bb583b5bf43bea404b918b5c9c63 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 13:20:53 +0000 Subject: UTextClasses.pas removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1481 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTextClasses.pas | 89 ----------------------------------------------- 1 file changed, 89 deletions(-) delete mode 100644 src/base/UTextClasses.pas (limited to 'src/base') diff --git a/src/base/UTextClasses.pas b/src/base/UTextClasses.pas deleted file mode 100644 index ddc8906c..00000000 --- a/src/base/UTextClasses.pas +++ /dev/null @@ -1,89 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UTextClasses; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - SDL, - UTexture, - Classes, -// SDL_ttf, - ULog; - -{ -// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf -// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png -// thanks to Bob Pendelton and Koshmaar! -// (1) let's start with a glyph, this represents one character in a word - -type - TGlyph = record - character : Char; // unsigned char, uchar is something else in delphi - glyphsSolid[8] : GlyphTexture; // fast, but not that - glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty - -//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P) - deconstructor procedure ReleaseTextures(); -end; - -// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P - - GlyphTexture = record - textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one - width, - height : Cardinal; - charWidth, - charHeight : Integer; - advance : Integer; // don't know yet for what this one is -} - -{ -// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need - TGlyphsContainer = record - glyphs array of TGlyph; - FontName array of string; - refCount : uChar; // unsigned char, uchar is something else in delphi - font : PTTF_font; - size, - lineSkip : Cardinal; // vertical distance between multi line text output - descent : Integer; - - - -} - - -implementation - -end. -- cgit v1.2.3 From e8a388e32a4563ac9ea0895ca6c7cdf83cf9d3ec Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 18:57:02 +0000 Subject: - glPrint(Pchar) -> glPrint(string) - glPrintLetter removed - font engine handles FT_PIXEL_MODE_MONO as FT_Glyph_To_Bitmap(FT_RENDER_MODE_NORMAL) might return a 1bit/pixel black/white image instead of 8bit/pixel gray shaded one (happened with 16px japanese glyphs of simsun.ttf, latin ones were correct). git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1482 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 4 ++-- src/base/UEditorLyrics.pas | 4 ++-- src/base/UFont.pas | 28 ++++++++++++++++++++++------ src/base/ULyrics.pas | 11 ++++------- src/base/USingScores.pas | 6 +++--- src/base/USong.pas | 10 +++++----- 6 files changed, 38 insertions(+), 25 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 61335a53..a92d67d4 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -1226,7 +1226,7 @@ if Age < 5 then SetFontSize((Age + 1) * 3) else SetFontSize(18); SetFontItalic(False); //Check Font Size -Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^ +Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ //Text SetFontPos (X + 50 - (Length / 2), Y + 12); //Position @@ -1256,7 +1256,7 @@ if Age < 5 then Size := Age * 10 else Size := 50; glColor4f(1, 1, 1, Alpha); //Set Color //Draw Text - glPrint (PChar(Text)); + glPrint (Text); end; end; //PhrasenBonus - Line Bonus Mod} diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index e307ba2d..3c4ddb24 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -192,7 +192,7 @@ begin Word[WordNum].FontStyle := FontStyleI; SetFontStyle(FontStyleI); SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(pchar(Text)); + Word[WordNum].Width := glTextWidth(Text); Word[WordNum].Text := Text; Word[WordNum].ColR := ColR; Word[WordNum].ColG := ColG; @@ -247,7 +247,7 @@ begin SetFontSize(Word[W].Size); SetFontItalic(Word[W].Italic); glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(pchar(Word[W].Text)); + glPrint(Word[W].Text); end; end; diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 30be4c3b..a72bca21 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -2019,8 +2019,8 @@ var Glyph: FT_Glyph; BitmapGlyph: FT_BitmapGlyph; Bitmap: PFT_Bitmap; - BitmapLine: PChar; - BitmapBuffer: PChar; + BitmapLine: PByteArray; + BitmapBuffer: PByteArray; TexBuffer: TGLubyteDynArray; TexLine: PGLubyteArray; CBox: FT_BBox; @@ -2045,8 +2045,9 @@ begin fBounds.Bottom := CBox.yMin / 64; fBounds.Top := CBox.yMax / 64 + fOutset*2; - // convert the glyph to a bitmap (and destroy original glyph image) - FT_Glyph_To_Bitmap(Glyph, ft_render_mode_normal, nil, 1); + // convert the glyph to a bitmap (and destroy original glyph image). + // Request 8 bit gray level pixel mode. + FT_Glyph_To_Bitmap(Glyph, FT_RENDER_MODE_NORMAL, nil, 1); BitmapGlyph := FT_BitmapGlyph(Glyph); // get bitmap offsets @@ -2094,8 +2095,23 @@ begin // get next lower line offset, use pitch instead of width as it tells // us the storage direction of the lines. In addition a line might be padded. BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; - for X := 0 to Bitmap.width-1 do - TexLine[X] := GLubyte(BitmapLine[X]); + + // check for pixel mode and copy pixels + // Should be 8 bit gray, but even with FT_RENDER_MODE_NORMAL, freetype + // sometimes (e.g. 16px sized japanese fonts) fallbacks to 1 bit pixels. + case (Bitmap.pixel_mode) of + FT_PIXEL_MODE_GRAY: begin // 8 bit gray + for X := 0 to Bitmap.width-1 do + TexLine[X] := BitmapLine[X]; + end; + FT_PIXEL_MODE_MONO: begin // 1 bit mono + for X := 0 to Bitmap.width-1 do + TexLine[X] := High(GLubyte) * ((BitmapLine[X div 8] shr (7-(X mod 8))) and $1); + end; + else begin + // unhandled pixel format + end; + end; end; if (fOutset > 0) then diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index 5c5449b1..82982981 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -428,7 +428,7 @@ begin CurWord := @LyricLine.Words[I]; SetFontItalic(CurWord.Freestyle); SetFontPos(PosX, Y); - glPrint(PChar(CurWord.Text)); + glPrint(CurWord.Text); PosX := PosX + CurWord.Width; end; end; @@ -464,7 +464,7 @@ begin // set font size to a reasonable value LyricLine.Height := RequestHeight * 0.9; SetFontSize(LyricLine.Height); - LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + LyricLine.Width := glTextWidth(LyricLine.Text); // change font-size to fit into the lyric bar if (LyricLine.Width > RequestWidth) then @@ -475,7 +475,7 @@ begin LyricLine.Height := 1; SetFontSize(LyricLine.Height); - LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + LyricLine.Width := glTextWidth(LyricLine.Text); end; // calc word positions and widths @@ -496,7 +496,7 @@ begin end; CurWord.X := PosX; - CurWord.Width := glTextWidth(PChar(CurWord.Text)); + CurWord.Width := glTextWidth(CurWord.Text); PosX := PosX + CurWord.Width; SetFontItalic(false); end; @@ -540,7 +540,6 @@ begin SetFontStyle(FontStyle); ResetFont(); SetFontSize(Line.Height); - glColor4f(1, 1, 1, 1); // center lyrics LyricX := X + (W - Line.Width) / 2; @@ -670,8 +669,6 @@ begin // draw the ball onto the current word if (LyricsEffect = lfxBall) then begin - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); DrawBall(LyricX + CurWord.X + CurWord.Width * Progress, LyricY - 15 - 15*sin(Progress * Pi), Alpha); end; diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 8e2455e1..2d9b1e5e 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -817,14 +817,14 @@ begin SetFontSize(FontSize); //Draw Text - TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + TextLen := glTextWidth(Theme.Sing.LineBonusText[PopUp.Rating]); //Color and Pos SetFontPos (X + (W - TextLen) / 2, Y + FontOffset); glColor4f(1, 1, 1, Alpha); //Draw - glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating])); + glPrint(Theme.Sing.LineBonusText[PopUp.Rating]); end; //eo Alpha check end; //eo Right Screen end; //eo Player has Position @@ -877,7 +877,7 @@ begin While (Length(ScoreStr) < 5) do ScoreStr := '0' + ScoreStr; - glPrint(PChar(ScoreStr)); + glPrint(ScoreStr); end; //eo Right Screen end; //eo Player has Position diff --git a/src/base/USong.pas b/src/base/USong.pas index 6c81cecc..4793b7e9 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -326,7 +326,7 @@ begin 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)); + Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(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 @@ -344,7 +344,7 @@ 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)); + Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(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 @@ -500,7 +500,7 @@ begin 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)); + Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric); //Total Notes Patch Lines[CP].Line[Lines[CP].High].TotalNotes := 0; for NoteIndex := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do @@ -518,7 +518,7 @@ 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)); + Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric); //Total Notes Patch Lines[Count].Line[Lines[Count].High].TotalNotes := 0; for NoteIndex := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do @@ -987,7 +987,7 @@ begin begin //Update old Sentence if it has notes and create a new sentence // 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)); + Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric); //Total Notes Patch Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; -- cgit v1.2.3 From cf4e5393ccee3af7d592c680ecf7c22f7bc4a4be Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 19:01:20 +0000 Subject: - glPrint(Pchar) -> glPrint(string) - glPrintLetter removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1483 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 13 ++++++------- 1 file changed, 6 insertions(+), 7 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index ad4c0ee2..57f3d6f5 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -41,9 +41,8 @@ uses procedure BuildFont; // build our bitmap font procedure KillFont; // delete the font -function glTextWidth(text: PChar): real; // returns text width -procedure glPrintLetter(letter: char); -procedure glPrint(text: pchar); // custom GL "Print" routine +function glTextWidth(const text: string): real; // returns text width +procedure glPrint(const text: string); // custom GL "Print" routine procedure ResetFont(); // reset font settings of active font procedure SetFontPos(X, Y: real); // sets X and Y procedure SetFontZ(Z: real); // sets Z @@ -205,7 +204,7 @@ begin //glDeleteLists(..., 256); end; -function glTextWidth(text: pchar): real; +function glTextWidth(const text: string): real; var Letter: char; i: integer; @@ -321,18 +320,18 @@ begin end; // Custom GL "Print" Routine -procedure glPrint(Text: PChar); +procedure glPrint(const Text: string); var Pos: integer; begin // if there is no text do nothing - if ((Text = nil) or (Text = '')) then + if (Text = '') then Exit; //Save the actual color and alpha (for reflection) glGetFloatv(GL_CURRENT_COLOR, @TempColor); - for Pos := 0 to Length(Text) - 1 do + for Pos := 1 to Length(Text) do begin glPrintLetter(Text[Pos]); end; -- cgit v1.2.3 From 4025ea3e81b0d2ec4492f3a0b3e374ce1568bdf5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 19:31:17 +0000 Subject: switch UseFreetype added to toggle between bitmap-font and freetype font git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1484 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 29 +++--- src/base/TextGLFreetype.pas | 222 ++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 233 insertions(+), 18 deletions(-) create mode 100644 src/base/TextGLFreetype.pas (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 57f3d6f5..11bbd52b 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -33,6 +33,11 @@ interface {$I switches.inc} +// as long as the transition to freetype is not finished +// use the old implementation +{$IFDEF UseFreetype} + {$INCLUDE TextGLFreetype.pas} +{$ELSE} uses gl, SDL, @@ -51,7 +56,6 @@ procedure SetFontStyle(Style: integer); // sets active font style (normal, procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) procedure SetFontAspectW(Aspect: real); procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection -procedure SetFontBlend(Enable: boolean); // enables/disables blending //function NextPowerOfTwo(Value: integer): integer; // Checks if the ttf exists, if yes then a SDL_ttf is returned @@ -81,7 +85,6 @@ type Italic: boolean; Reflection: boolean; ReflectionSpacing: real; - Blend: boolean; end; @@ -191,10 +194,6 @@ begin // close ini-file FontIni.Free; - - // enable blending by default - for Count := 0 to High(Fonts) do - Fonts[Count].Blend := true; end; // Deletes the font @@ -262,11 +261,8 @@ begin else XItal := 12; - if (Font.Blend) then - begin - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end; + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable(GL_TEXTURE_2D); glBindTexture(GL_TEXTURE_2D, Tex.TexNum); @@ -310,8 +306,7 @@ begin end; // reflection glDisable(GL_TEXTURE_2D); - if (Font.Blend) then - glDisable(GL_BLEND); + glDisable(GL_BLEND); Tex.X := Tex.X + Tex.W; @@ -382,9 +377,7 @@ begin Fonts[ActFont].ReflectionSpacing := Spacing; end; -procedure SetFontBlend(Enable: boolean); -begin - Fonts[ActFont].Blend := Enable; -end; - end. + +{$ENDIF} + diff --git a/src/base/TextGLFreetype.pas b/src/base/TextGLFreetype.pas new file mode 100644 index 00000000..6a41b5de --- /dev/null +++ b/src/base/TextGLFreetype.pas @@ -0,0 +1,222 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/TextGL.pas $ + * $Id: TextGL.pas 1483 2008-10-28 19:01:20Z tobigun $ + *} + +(* +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} +*) + +uses + gl, + glext, + SDL, + UTexture, + UFont, + Classes, + ULog; + +type + PGLFont = ^TGLFont; + TGLFont = record + Font: TScalableFont; + X, Y, Z: real; + end; + +var + Fonts: array of TGLFont; + ActFont: integer; + +procedure BuildFont; // build our bitmap font +procedure KillFont; // delete the font +function glTextWidth(const text: string): real; // returns text width +procedure glPrint(const text: string); // custom GL "Print" routine +procedure ResetFont(); // reset font settings of active font +procedure SetFontPos(X, Y: real); // sets X and Y +procedure SetFontZ(Z: real); // sets Z +procedure SetFontSize(Size: real); +procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) +procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) +procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection + +implementation + +uses + UMain, + UCommon, + SysUtils, + IniFiles, + UGraphic; + +function FindFontFile(FontIni: TCustomIniFile; Font: string): string; +var + Filename: string; +begin + Filename := FontIni.ReadString(Font, 'File', ''); + Result := FontPath + Filename; + // if path does not exist, try as an absolute path + if (not FileExists(Result)) then + Result := Filename; +end; + +procedure BuildFont; +var + FontIni: TMemIniFile; + BitmapFont: TBitmapFont; + FontFile: string; +begin + ActFont := 0; + + SetLength(Fonts, 4); + FontIni := TMemIniFile.Create(FontPath + 'fontsTTF.ini'); + //FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); + + try + + // Normal + FontFile := FindFontFile(FontIni, 'Normal'); + Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); + //Fonts[0].Font.GlyphSpacing := 1.4; + //Fonts[0].Font.Aspect := 1.2; + + { + BitmapFont := TBitmapFont.Create(FontFile, 0, 19, 35, -10); + BitmapFont.CorrectWidths(2, 0); + Fonts[0].Font := TScalableFont.Create(BitmapFont, false); + } + + //Fonts[0].Font.Aspect := 0.9; + + // Bold + FontFile := FindFontFile(FontIni, 'Bold'); + Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); + + // Outline1 + FontFile := FindFontFile(FontIni, 'Outline1'); + Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); + //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); + + // Outline2 + FontFile := FindFontFile(FontIni, 'Outline2'); + Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); + + except on E: Exception do + Log.LogCritical(E.Message, 'BuildFont'); + end; + + // close ini-file + FontIni.Free; +end; + + +// Deletes the font +procedure KillFont; +begin + // delete all characters + //glDeleteLists(..., 256); +end; + +function glTextWidth(const text: string): real; +var + Bounds: TBoundsDbl; +begin + // FIXME: remove UTF-8 conversion + Bounds := Fonts[ActFont].Font.BBox(AnsiToUtf8(text), true); + Result := Bounds.Right - Bounds.Left; +end; + +// Custom GL "Print" Routine +procedure glPrint(const Text: string); +var + GLFont: PGLFont; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + GLFont := @Fonts[ActFont]; + + glPushMatrix(); + // set font position + glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z); + // draw string + // FIXME: remove UTF-8 conversion + GLFont.Font.Print(AnsiToUtf8(Text)); + glPopMatrix(); +end; + +procedure ResetFont(); +begin + SetFontPos(0, 0); + SetFontZ(0); + SetFontItalic(False); + SetFontReflection(False, 0); +end; + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].X := X; + Fonts[ActFont].Y := Y; +end; + +procedure SetFontZ(Z: real); +begin + Fonts[ActFont].Z := Z; +end; + +procedure SetFontSize(Size: real); +begin + Fonts[ActFont].Font.Height := Size; +end; + +procedure SetFontStyle(Style: integer); +begin + ActFont := Style; +end; + +procedure SetFontItalic(Enable: boolean); +begin + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic] +end; + +procedure SetFontReflection(Enable: boolean; Spacing: real); +begin + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect]; + Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender; +end; + +end. -- cgit v1.2.3 From 6585afce2ccd8e7c5ccb3bb3599d4723b00a0433 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 28 Oct 2008 20:16:05 +0000 Subject: some compiler warnings/hints removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1485 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGLFreetype.pas | 2 +- src/base/UCommandLine.pas | 6 ++++-- src/base/UCovers.pas | 2 +- src/base/UDLLManager.pas | 2 +- src/base/UDataBase.pas | 1 - src/base/UDraw.pas | 18 ++---------------- src/base/UEditorLyrics.pas | 2 -- src/base/UGraphic.pas | 1 - src/base/UJoystick.pas | 5 +++-- src/base/UMain.pas | 18 ------------------ src/base/USong.pas | 4 ++-- src/base/USongs.pas | 4 ++-- src/base/UTexture.pas | 17 +---------------- 13 files changed, 17 insertions(+), 65 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGLFreetype.pas b/src/base/TextGLFreetype.pas index 6a41b5de..4f8a5068 100644 --- a/src/base/TextGLFreetype.pas +++ b/src/base/TextGLFreetype.pas @@ -90,7 +90,7 @@ end; procedure BuildFont; var FontIni: TMemIniFile; - BitmapFont: TBitmapFont; + //BitmapFont: TBitmapFont; FontFile: string; begin ActFont := 0; diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas index 17ea1a19..281a480d 100644 --- a/src/base/UCommandLine.pas +++ b/src/base/UCommandLine.pas @@ -301,8 +301,9 @@ end; // GetLanguage - Get Language ID from saved String Information //------------- function TCMDParams.GetLanguage: integer; -var +{var I: integer; +} begin Result := -1; {* JB - 12sep07 to remove uINI dependency @@ -321,8 +322,9 @@ end; // GetResolution - Get Resolution ID from saved String Information //------------- function TCMDParams.GetResolution: integer; -var +{var I: integer; +} begin Result := -1; {* JB - 12sep07 to remove uINI dependency diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas index d4b4e471..a1705674 100644 --- a/src/base/UCovers.pas +++ b/src/base/UCovers.pas @@ -405,7 +405,7 @@ end; *) function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; var - TargetAspect, SourceAspect: double; + //TargetAspect, SourceAspect: double; //TargetWidth, TargetHeight: integer; Thumbnail: PSDL_Surface; MaxSize: integer; diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index 5e64f221..cd4b7991 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -162,7 +162,7 @@ function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; var hLibg: THandle; Info: pModi_PluginInfo; - I: Integer; + //I: Integer; begin Result := False; //Clear Plugin Info diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index 1b9e432c..0f9d88a7 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -531,7 +531,6 @@ end; function TDataBaseSystem.GetStatReset: TDateTime; var Query: string; - ResetTime: int64; begin Result := 0; diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index a92d67d4..d3f19019 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -254,7 +254,6 @@ var Rec: TRecR; Count: integer; TempR: real; - R,G,B: real; PlayerNumber: Integer; @@ -374,7 +373,7 @@ var TempR: real; Rec: TRecR; N: integer; - R, G, B, A: real; + //R, G, B, A: real; NotesH2: real; begin //Log.LogStatus('Player notes', 'SingDraw'); @@ -463,7 +462,7 @@ begin // Perfect note is stored if Perfect and (Ini.EffectSing=1) then begin - A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); + //A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); if not (Start+Length-1 = LyricsState.CurrentBeatD) then begin //Star animation counter @@ -489,7 +488,6 @@ var Rec: TRecR; Count: integer; TempR: real; - R,G,B: real; X1, X2, X3, X4: real; W, H: real; @@ -894,19 +892,7 @@ end; // q'n'd for using the game mode dll's procedure SingModiDraw (PlayerInfo: TPlayerInfo); var - Count: integer; - Pet2: integer; - TempR: real; - Rec: TRecR; - TexRec: TRecR; NR: TRecR; - FS: real; - BarFrom: integer; - BarAlpha: real; - BarWspol: real; - TempCol: real; - Tekst: string; - PetCz: integer; begin // positions if Ini.SingWindow = 0 then begin diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index 3c4ddb24..d06fc891 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -147,8 +147,6 @@ begin end; procedure TEditorLyrics.SetSelected(Value: integer); -var - W: integer; begin if (SelectedI > -1) and (SelectedI <= High(Word)) then begin diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 75c90134..b525c170 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -760,7 +760,6 @@ begin end; procedure UnLoadScreens; -var I: Integer; begin ScreenMain.Destroy; ScreenName.Destroy; diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas index 25d1d663..30808812 100644 --- a/src/base/UJoystick.pas +++ b/src/base/UJoystick.pas @@ -75,7 +75,8 @@ uses SysUtils, constructor TJoy.Create; var - B, N: integer; + B: integer; + //N: integer; begin inherited; @@ -137,7 +138,7 @@ begin Log.LogError('Could not Init Joystick'); exit; end; - N := SDL_JoystickNumButtons(SDL_Joy); + //N := SDL_JoystickNumButtons(SDL_Joy); //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create'); for B := 0 to 5 do begin diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 6c77ebc0..6300f18b 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -432,7 +432,6 @@ var const MAX_FPS = 100; begin - Delay := 0; SDL_EnableKeyRepeat(125, 125); CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. @@ -732,10 +731,7 @@ var Count: integer; CountGr: integer; CP: integer; - Done: real; N: integer; - CurLine: PLine; - CurNote: PLineFragment; begin LyricsState.UpdateBeats(); @@ -767,20 +763,6 @@ begin // make some operations when detecting new voice pitch if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then NewBeatDetect(Screen); - - CurLine := @Lines[0].Line[Lines[0].Current]; - - // remove moving text - Done := 1; - for N := 0 to CurLine.HighNote do - begin - CurNote := @CurLine.Note[N]; - if (CurNote.Start <= LyricsState.MidBeat) and - (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then - begin - Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length; - end; - end; end; procedure NewSentence(Screen: TScreenSing); diff --git a/src/base/USong.pas b/src/base/USong.pas index 4793b7e9..cff56c1d 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -583,8 +583,8 @@ end; function TSong.ReadXMLHeader(const aFileName : WideString): boolean; var - Line, Identifier, Value: string; - Temp : word; + //Line, Identifier, Value: string; + //Temp : word; Done : byte; Parser : TParser; diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 6f1f7c51..6f66bf3f 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -687,7 +687,7 @@ end; procedure TCatSongs.ClickCategoryButton(Index: integer); var - Num, S: integer; + Num: integer; begin Num := CatSongs.Song[Index].OrderNum; if Num <> CatNumShow then @@ -703,7 +703,7 @@ end; //Hide Categorys when in Category Hack procedure TCatSongs.ShowCategoryList; var - Num, S: integer; + S: integer; begin // Hide All Songs Show All Cats for S := 0 to high(CatSongs.Song) do diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 0f0117ff..4f33b78a 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -251,7 +251,6 @@ end; function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; var TexSurface: PSDL_Surface; - MipmapSurface: PSDL_Surface; newWidth, newHeight: Cardinal; oldWidth, oldHeight: Cardinal; ActTex: GLuint; @@ -299,7 +298,6 @@ begin FitImage(TexSurface, newWidth, newHeight); // at this point we have the image in memory... - // scaled to be at most 1024x1024 pixels large // scaled so that dimensions are powers of 2 // and converted to either RGB or RGBA @@ -375,7 +373,6 @@ end; function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; var TextureIndex: integer; - CoverIndex: integer; begin if (Name = '') then begin @@ -386,18 +383,6 @@ begin if (FromCache) then begin - (* - // use cache texture - CoverIndex := Covers.FindCover(Name); - - if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then - begin - // load texture - Covers.PrepareData(Name); - TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24); - end; - *) - // use texture TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); if (TextureIndex > -1) then @@ -432,7 +417,7 @@ end; function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; var - Error: integer; + //Error: integer; ActTex: GLuint; begin glGenTextures(1, @ActTex); // ActText = new texture number -- cgit v1.2.3 From 8f3b4a5e422bc583cbca1a798c8a765c84b724f9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 31 Oct 2008 15:31:56 +0000 Subject: - codepage converter (CP1252, CP1250) added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1488 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGLFreetype.pas | 444 ++++++++++++++++++++++---------------------- src/base/UTextEncoding.pas | 147 +++++++++++++++ 2 files changed, 369 insertions(+), 222 deletions(-) create mode 100644 src/base/UTextEncoding.pas (limited to 'src/base') diff --git a/src/base/TextGLFreetype.pas b/src/base/TextGLFreetype.pas index 4f8a5068..61b26693 100644 --- a/src/base/TextGLFreetype.pas +++ b/src/base/TextGLFreetype.pas @@ -1,222 +1,222 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/TextGL.pas $ - * $Id: TextGL.pas 1483 2008-10-28 19:01:20Z tobigun $ - *} - -(* -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} -*) - -uses - gl, - glext, - SDL, - UTexture, - UFont, - Classes, - ULog; - -type - PGLFont = ^TGLFont; - TGLFont = record - Font: TScalableFont; - X, Y, Z: real; - end; - -var - Fonts: array of TGLFont; - ActFont: integer; - -procedure BuildFont; // build our bitmap font -procedure KillFont; // delete the font -function glTextWidth(const text: string): real; // returns text width -procedure glPrint(const text: string); // custom GL "Print" routine -procedure ResetFont(); // reset font settings of active font -procedure SetFontPos(X, Y: real); // sets X and Y -procedure SetFontZ(Z: real); // sets Z -procedure SetFontSize(Size: real); -procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) -procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) -procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection - -implementation - -uses - UMain, - UCommon, - SysUtils, - IniFiles, - UGraphic; - -function FindFontFile(FontIni: TCustomIniFile; Font: string): string; -var - Filename: string; -begin - Filename := FontIni.ReadString(Font, 'File', ''); - Result := FontPath + Filename; - // if path does not exist, try as an absolute path - if (not FileExists(Result)) then - Result := Filename; -end; - -procedure BuildFont; -var - FontIni: TMemIniFile; - //BitmapFont: TBitmapFont; - FontFile: string; -begin - ActFont := 0; - - SetLength(Fonts, 4); - FontIni := TMemIniFile.Create(FontPath + 'fontsTTF.ini'); - //FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); - - try - - // Normal - FontFile := FindFontFile(FontIni, 'Normal'); - Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); - //Fonts[0].Font.GlyphSpacing := 1.4; - //Fonts[0].Font.Aspect := 1.2; - - { - BitmapFont := TBitmapFont.Create(FontFile, 0, 19, 35, -10); - BitmapFont.CorrectWidths(2, 0); - Fonts[0].Font := TScalableFont.Create(BitmapFont, false); - } - - //Fonts[0].Font.Aspect := 0.9; - - // Bold - FontFile := FindFontFile(FontIni, 'Bold'); - Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); - - // Outline1 - FontFile := FindFontFile(FontIni, 'Outline1'); - Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); - //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); - - // Outline2 - FontFile := FindFontFile(FontIni, 'Outline2'); - Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); - - except on E: Exception do - Log.LogCritical(E.Message, 'BuildFont'); - end; - - // close ini-file - FontIni.Free; -end; - - -// Deletes the font -procedure KillFont; -begin - // delete all characters - //glDeleteLists(..., 256); -end; - -function glTextWidth(const text: string): real; -var - Bounds: TBoundsDbl; -begin - // FIXME: remove UTF-8 conversion - Bounds := Fonts[ActFont].Font.BBox(AnsiToUtf8(text), true); - Result := Bounds.Right - Bounds.Left; -end; - -// Custom GL "Print" Routine -procedure glPrint(const Text: string); -var - GLFont: PGLFont; -begin - // if there is no text do nothing - if (Text = '') then - Exit; - - GLFont := @Fonts[ActFont]; - - glPushMatrix(); - // set font position - glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z); - // draw string - // FIXME: remove UTF-8 conversion - GLFont.Font.Print(AnsiToUtf8(Text)); - glPopMatrix(); -end; - -procedure ResetFont(); -begin - SetFontPos(0, 0); - SetFontZ(0); - SetFontItalic(False); - SetFontReflection(False, 0); -end; - -procedure SetFontPos(X, Y: real); -begin - Fonts[ActFont].X := X; - Fonts[ActFont].Y := Y; -end; - -procedure SetFontZ(Z: real); -begin - Fonts[ActFont].Z := Z; -end; - -procedure SetFontSize(Size: real); -begin - Fonts[ActFont].Font.Height := Size; -end; - -procedure SetFontStyle(Style: integer); -begin - ActFont := Style; -end; - -procedure SetFontItalic(Enable: boolean); -begin - if (Enable) then - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic] - else - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic] -end; - -procedure SetFontReflection(Enable: boolean; Spacing: real); -begin - if (Enable) then - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect] - else - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect]; - Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender; -end; - -end. +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/TextGL.pas $ + * $Id: TextGL.pas 1483 2008-10-28 19:01:20Z tobigun $ + *} + +(* +unit TextGL; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} +*) + +uses + gl, + glext, + SDL, + UTexture, + UFont, + Classes, + ULog; + +type + PGLFont = ^TGLFont; + TGLFont = record + Font: TScalableFont; + X, Y, Z: real; + end; + +var + Fonts: array of TGLFont; + ActFont: integer; + +procedure BuildFont; // build our bitmap font +procedure KillFont; // delete the font +function glTextWidth(const text: string): real; // returns text width +procedure glPrint(const text: string); // custom GL "Print" routine +procedure ResetFont(); // reset font settings of active font +procedure SetFontPos(X, Y: real); // sets X and Y +procedure SetFontZ(Z: real); // sets Z +procedure SetFontSize(Size: real); +procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) +procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) +procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection + +implementation + +uses + UMain, + UCommon, + UTextEncoding, + SysUtils, + IniFiles; + +function FindFontFile(FontIni: TCustomIniFile; Font: string): string; +var + Filename: string; +begin + Filename := FontIni.ReadString(Font, 'File', ''); + Result := FontPath + Filename; + // if path does not exist, try as an absolute path + if (not FileExists(Result)) then + Result := Filename; +end; + +procedure BuildFont; +var + FontIni: TMemIniFile; + //BitmapFont: TBitmapFont; + FontFile: string; +begin + ActFont := 0; + + SetLength(Fonts, 4); + FontIni := TMemIniFile.Create(FontPath + 'fontsTTF.ini'); + //FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); + + try + + // Normal + FontFile := FindFontFile(FontIni, 'Normal'); + Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); + //Fonts[0].Font.GlyphSpacing := 1.4; + //Fonts[0].Font.Aspect := 1.2; + + { + BitmapFont := TBitmapFont.Create(FontFile, 0, 19, 35, -10); + BitmapFont.CorrectWidths(2, 0); + Fonts[0].Font := TScalableFont.Create(BitmapFont, false); + } + + //Fonts[0].Font.Aspect := 0.9; + + // Bold + FontFile := FindFontFile(FontIni, 'Bold'); + Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); + + // Outline1 + FontFile := FindFontFile(FontIni, 'Outline1'); + Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); + //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); + + // Outline2 + FontFile := FindFontFile(FontIni, 'Outline2'); + Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); + + except on E: Exception do + Log.LogCritical(E.Message, 'BuildFont'); + end; + + // close ini-file + FontIni.Free; +end; + + +// Deletes the font +procedure KillFont; +begin + // delete all characters + //glDeleteLists(..., 256); +end; + +function glTextWidth(const text: string): real; +var + Bounds: TBoundsDbl; +begin + // FIXME: remove conversion + Bounds := Fonts[ActFont].Font.BBox(RecodeString(Text, encCP1252), true); + Result := Bounds.Right - Bounds.Left; +end; + +// Custom GL "Print" Routine +procedure glPrint(const Text: string); +var + GLFont: PGLFont; +begin + // if there is no text do nothing + if (Text = '') then + Exit; + + GLFont := @Fonts[ActFont]; + + glPushMatrix(); + // set font position + glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z); + // draw string + // FIXME: remove conversion + GLFont.Font.Print(RecodeString(Text, encCP1252)); + glPopMatrix(); +end; + +procedure ResetFont(); +begin + SetFontPos(0, 0); + SetFontZ(0); + SetFontItalic(False); + SetFontReflection(False, 0); +end; + +procedure SetFontPos(X, Y: real); +begin + Fonts[ActFont].X := X; + Fonts[ActFont].Y := Y; +end; + +procedure SetFontZ(Z: real); +begin + Fonts[ActFont].Z := Z; +end; + +procedure SetFontSize(Size: real); +begin + Fonts[ActFont].Font.Height := Size; +end; + +procedure SetFontStyle(Style: integer); +begin + ActFont := Style; +end; + +procedure SetFontItalic(Enable: boolean); +begin + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic] +end; + +procedure SetFontReflection(Enable: boolean; Spacing: real); +begin + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect]; + Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender; +end; + +end. diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas new file mode 100644 index 00000000..6eec8eec --- /dev/null +++ b/src/base/UTextEncoding.pas @@ -0,0 +1,147 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/menu/UMenuText.pas $ + * $Id: UMenuText.pas 1485 2008-10-28 20:16:05Z tobigun $ + *} + +unit UTextEncoding; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils; + +type + TEncoding = (encCP1250, encCP1252, encUTF8, encNative); + +function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString; + +implementation + +type + TConversionTable = array[0..127] of WideChar; + +const + // Windows-1250 Central/Eastern Europe (used by Ultrastar) + CP1250Table: TConversionTable = ( + { $80 } + #$20AC, #0, #$201A, #0, #$201E, #$2026, #$2020, #$2021, + #0, #$2030, #$0160, #$2039, #$015A, #$0164, #$017D, #$0179, + { $90 } + #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014, + #0, #$2122, #$0161, #$203A, #$015B, #$0165, #$017E, #$017A, + { $A0 } + #$00A0, #$02C7, #$02D8, #$0141, #$00A4, #$0104, #$00A6, #$00A7, + #$00A8, #$00A9, #$015E, #$00AB, #$00AC, #$00AD, #$00AE, #$017B, + { $B0 } + #$00B0, #$00B1, #$02DB, #$0142, #$00B4, #$00B5, #$00B6, #$00B7, + #$00B8, #$0105, #$015F, #$00BB, #$013D, #$02DD, #$013E, #$017C, + { $C0 } + #$0154, #$00C1, #$00C2, #$0102, #$00C4, #$0139, #$0106, #$00C7, + #$010C, #$00C9, #$0118, #$00CB, #$011A, #$00CD, #$00CE, #$010E, + { $D0 } + #$0110, #$0143, #$0147, #$00D3, #$00D4, #$0150, #$00D6, #$00D7, + #$0158, #$016E, #$00DA, #$0170, #$00DC, #$00DD, #$0162, #$00DF, + { $E0 } + #$0155, #$00E1, #$00E2, #$0103, #$00E4, #$013A, #$0107, #$00E7, + #$010D, #$00E9, #$0119, #$00EB, #$011B, #$00ED, #$00EE, #$010F, + { $F0 } + #$0111, #$0144, #$0148, #$00F3, #$00F4, #$0151, #$00F6, #$00F7, + #$0159, #$016F, #$00FA, #$0171, #$00FC, #$00FD, #$0163, #$02D9 + ); + + // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1) + CP1252Table: TConversionTable = ( + { $80 } + #$20AC, #0, #$201A, #$0192, #$201E, #$2026, #$2020, #$2021, + #$02C6, #$2030, #$0160, #$2039, #$0152, #0, #$017D, #0, + { $90 } + #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014, + #$02DC, #$2122, #$0161, #$203A, #$0153, #0, #$017E, #$0178, + { $A0 } + #$00A0, #$00A1, #$00A2, #$00A3, #$00A4, #$00A5, #$00A6, #$00A7, + #$00A8, #$00A9, #$00AA, #$00AB, #$00AC, #$00AD, #$00AE, #$00AF, + { $B0 } + #$00B0, #$00B1, #$00B2, #$00B3, #$00B4, #$00B5, #$00B6, #$00B7, + #$00B8, #$00B9, #$00BA, #$00BB, #$00BC, #$00BD, #$00BE, #$00BF, + { $C0 } + #$00C0, #$00C1, #$00C2, #$00C3, #$00C4, #$00C5, #$00C6, #$00C7, + #$00C8, #$00C9, #$00CA, #$00CB, #$00CC, #$00CD, #$00CE, #$00CF, + { $D0 } + #$00D0, #$00D1, #$00D2, #$00D3, #$00D4, #$00D5, #$00D6, #$00D7, + #$00D8, #$00D9, #$00DA, #$00DB, #$00DC, #$00DD, #$00DE, #$00DF, + { $E0 } + #$00E0, #$00E1, #$00E2, #$00E3, #$00E4, #$00E5, #$00E6, #$00E7, + #$00E8, #$00E9, #$00EA, #$00EB, #$00EC, #$00ED, #$00EE, #$00EF, + { $F0 } + #$00F0, #$00F1, #$00F2, #$00F3, #$00F4, #$00F5, #$00F6, #$00F7, + #$00F8, #$00F9, #$00FA, #$00FB, #$00FC, #$00FD, #$00FE, #$00FF + ); + + +function Convert(const Src: string; const Table: TConversionTable): WideString; +var + SrcPos, DstPos: integer; +begin + SetLength(Result, Length(Src)); + DstPos := 1; + for SrcPos := 1 to Length(Src) do + begin + if (Src[SrcPos] < #128) then + begin + // copy ASCII char + Result[DstPos] := Src[SrcPos]; + Inc(DstPos); + end + else + begin + // look-up char + Result[DstPos] := Table[Ord(Src[SrcPos]) - 128]; + // ignore invalid characters + if (Result[DstPos] <> #0) then + Inc(DstPos); + end; + end; + SetLength(Result, DstPos-1); +end; + +function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString; +begin + case SrcEncoding of + encCP1250: + Result := Convert(Src, CP1250Table); + encCP1252: + Result := Convert(Src, CP1252Table); + encUTF8: + Result := UTF8Decode(Src); + encNative: + Result := UTF8Decode(AnsiToUtf8(Src)); + end; +end; + +end. -- cgit v1.2.3 From d33f56a40d9e8325a2782f90bb253dece5127c5f Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 3 Nov 2008 14:53:17 +0000 Subject: All comments are English now (Polish ones have been translated) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1498 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 25 +++++++++++-------------- src/base/UGraphic.pas | 11 +++++++---- src/base/USkins.pas | 2 +- src/base/USong.pas | 4 ++-- 4 files changed, 21 insertions(+), 21 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index d3f19019..97b526c5 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -81,9 +81,6 @@ var TickOld: cardinal; TickOld2:cardinal; -const - Przedz = 32; - implementation uses @@ -307,8 +304,8 @@ begin end //Else all Notes same Color else glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - // Czesci == teil, element == piece, element | koniec == end / ending - // lewa czesc - left part + + // left part Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; @@ -327,7 +324,7 @@ begin // middle part Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); @@ -428,7 +425,7 @@ begin Rec.Left := Rec.Right; Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; - // (nowe) - dunno + // new if (Start+Length-1 = LyricsState.CurrentBeatD) then Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; // the left note is more right than the right note itself, sounds weird - so we fix that xD @@ -527,10 +524,10 @@ begin W := NotesW * 2 + 2; H := NotesH * 1.5 + 3.5; - X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; X1 := X2-W; - X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; X4 := X3+W; // left @@ -547,7 +544,7 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // srodkowa czesc + // middle part Rec.Left := X2; Rec.Right := X3; @@ -559,7 +556,7 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // prawa czesc + // right part Rec.Left := X3; Rec.Right := X4; @@ -1276,7 +1273,7 @@ begin - // lewa czesc - left part + // left part Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; @@ -1289,7 +1286,7 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // srodkowa czesc - middle part + // middle part Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; @@ -1301,7 +1298,7 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - // prawa czesc - right part + // right part Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index b525c170..c328d016 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -301,10 +301,13 @@ var Col: integer; begin Log.LogStatus('Loading Textures', 'LoadTextures'); - - Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? - Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch? - Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch? + + // FIXME: do we need this? (REMOVE otherwise) + Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); + // FIXME: do we need this? (REMOVE otherwise) + Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); + // FIXME: do we need this? (REMOVE otherwise) + Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); Log.LogStatus('Loading Textures - A', 'LoadTextures'); diff --git a/src/base/USkins.pas b/src/base/USkins.pas index df736684..59c590e5 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -78,7 +78,7 @@ constructor TSkin.Create; begin inherited; LoadList; -// LoadSkin('Lisek'); +// LoadSkin('...'); // SkinColor := Color; end; diff --git a/src/base/USong.pas b/src/base/USong.pas index cff56c1d..525f7bcc 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -985,7 +985,7 @@ begin If (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then begin //Update old Sentence if it has notes and create a new sentence - // stara czesc //Alter Satz //Update Old Part + // Update old part Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric); @@ -1002,7 +1002,7 @@ begin //Total Notes Patch End - // nowa czesc //Neuer Satz //Update New Part + // 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; -- cgit v1.2.3 From be8d1f265179826c6d189019298e88675b12210f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 9 Nov 2008 19:49:28 +0000 Subject: lyric fix git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1513 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 11bbd52b..bd505f51 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -212,7 +212,7 @@ begin Result := 0; Font := @Fonts[ActFont]; - for i := 0 to Length(text) -1 do + for i := 1 to Length(text) do begin Letter := Text[i]; Result := Result + Font.Width[Ord(Letter)] * Font.Tex.H / 30 * Font.AspectW; -- cgit v1.2.3 From c2416ccb64dc19cc4a690ba9cd6754fab59d709c Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 12 Nov 2008 21:18:43 +0000 Subject: some minor reformatting. no code change. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1518 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 60 +++++++++++++++++++++++--------------------- 1 file changed, 31 insertions(+), 29 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 1aa37cd4..0b44b76a 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -47,19 +47,21 @@ type * (Note for non-Maccies: "folder" is the Mac name for directory.) * * Note on the resource folders: - * 1. Installation of an application on the mac works as follows: Extract and copy an application - * and if you don't like or need the application anymore you move the folder - * to the trash - and you're done. - * 2. The use folders in the user's home directory is against Apple's guidelines - * and strange to an average user. + * 1. Installation of an application on the mac works as follows: Extract and + * copy an application and if you don't like or need the application + * anymore you move the folder to the trash - and you're done. + * 2. The use of folders in the user's home directory is against Apple's + * guidelines and strange to an average user. * 3. Even worse is using /usr/local/... since all lowercase folders in / are - * not visible to an average user in the Finder, at least not without some "tricks". + * not visible to an average user in the Finder, at least not without some + * "tricks". * - * The best way would be to store everything within the application bundle. However, this - * requires USDX to offer the handling of the resources. Until this is implemented, the - * second best solution is as follows: + * The best way would be to store everything within the application bundle. + * However, this requires USDX to offer the handling of the resources. Until + * this is implemented, the second best solution is as follows: * - * According to Aple guidelines handling of resources and folders should follow these lines: + * According to Aple guidelines handling of resources and folders should follow + * these lines: * * Acceptable places for files are folders named UltraStarDeluxe either in * /Library/Application Support/ @@ -75,8 +77,8 @@ type * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources * is used. So every user needs the complete set of files and folders. * Future versions may also use shared resources in - * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not - * treated yet in the code outside this unit. + * /Library/Application Support/UltraStarDeluxe/Resources. However, this is + * not treated yet in the code outside this unit. * * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. * The existence of needed files is then checked and if a file is missing @@ -88,7 +90,8 @@ type TPlatformMacOSX = class(TPlatform) private {** - * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app. + * GetBundlePath returns the path to the application bundle + * UltraStarDeluxe.app. *} function GetBundlePath: WideString; @@ -102,19 +105,19 @@ type * see the description of @link(Init). *} procedure CreateUserFolders(); - + public {** - * Init simply calls @link(CreateUserFolders), which in turn scans the folder - * UltraStarDeluxe.app/Contents/Resources for all files and folders. - * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked - * for their presence and missing ones are copied. + * Init simply calls @link(CreateUserFolders), which in turn scans the + * folder UltraStarDeluxe.app/Contents/Resources for all files and + * folders. $HOME/Library/Application Support/UltraStarDeluxe/Resources + * is then checked for their presence and missing ones are copied. *} procedure Init; override; {** - * DirectoryFindFiles returns all entries of a folder with names and booleans - * about their type, i.e. file or directory. + * DirectoryFindFiles returns all entries of a folder with names and + * booleans about their type, i.e. file or directory. *} function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; @@ -125,15 +128,15 @@ type function GetLogPath : WideString; override; {** - * GetGameSharedPath returns the path for shared resources. Currently it is set to - * /Library/Application Support/UltraStarDeluxe/Resources. + * GetGameSharedPath returns the path for shared resources. Currently it + * is set to /Library/Application Support/UltraStarDeluxe/Resources. * However it is not used. *} function GetGameSharedPath : WideString; override; {** - * GetGameUserPath returns the path for user resources. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * GetGameUserPath returns the path for user resources. Currently it is + * set to $HOME/Library/Application Support/UltraStarDeluxe/Resources. * This is where a user can add songs, themes, .... *} function GetGameUserPath : WideString; override; @@ -192,7 +195,7 @@ begin DirectoryList := TStringList.Create(); FileList := TStringList.Create(); DirectoryList.Add('.'); - + // create the folder and file lists repeat @@ -203,7 +206,7 @@ begin repeat if DirectoryExists(SearchInfo.Name) then begin - if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then + if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); end else @@ -241,8 +244,7 @@ var i, pos : integer; begin // Mac applications are packaged in folders. - // We have to cut the last two folders - // to get the application folder. + // Cutting the last two folders yields the application folder. Result := GetExecutionDir(); for i := 1 to 2 do @@ -287,7 +289,7 @@ begin i := 0; Filter := LowerCase(Filter); - TheDir := FPOpenDir(Dir); + TheDir := FPOpenDir(Dir); if Assigned(TheDir) then repeat ADirent := FPReadDir(TheDir); -- cgit v1.2.3 From d4075ab694515dbf0ead0181b0a9f1b21f113ae2 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 13 Nov 2008 20:13:55 +0000 Subject: Format adjustments. no code change. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1520 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 94 ++++++++++++++++++++++++++++-------------------------- 1 file changed, 49 insertions(+), 45 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 525f7bcc..c31f6df1 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -130,8 +130,8 @@ type MultBPM : integer; LastError: String; - Function GetErrorLineNo: Integer; - Property ErrorLineNo: Integer read GetErrorLineNo; + function GetErrorLineNo: integer; + property ErrorLineNo: integer read GetErrorLineNo; constructor Create (); overload; @@ -262,13 +262,13 @@ begin Lines[Count].Resolution := self.Resolution; Lines[Count].NotesGAP := self.NotesGAP; Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; + Lines[Count].Line[0].LastLine := false; end; //TempC := ':'; //TempC := Text[1]; // read from backup variable, don't use default ':' value - while (TempC <> 'E') AND (not EOF(SongFile)) do + while (TempC <> 'E') and (not EOF(SongFile)) do begin if (TempC = ':') or (TempC = '*') or (TempC = 'F') then @@ -280,13 +280,16 @@ begin Read(SongFile, ParamS); //Check for ZeroNote - if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else + if Param2 = 0 then + Log.LogError('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 + 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); @@ -294,24 +297,26 @@ begin end; //Zeronote check end // if - Else if TempC = '-' then + else if TempC = '-' then begin // reads sentence Read(SongFile, Param1); - if self.Relative then Read(SongFile, Param2); // read one more data for relative system + 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 + else + begin // P1 + P2 NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); end; end // if - Else if TempC = 'B' then + else if TempC = 'B' then begin SetLength(self.BPM, Length(self.BPM) + 1); Read(SongFile, self.BPM[High(self.BPM)].StartBeat); @@ -342,7 +347,7 @@ begin else begin for Count := 0 to High(Lines) do - begin + begin Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric); //Total Notes Patch @@ -365,18 +370,18 @@ begin CloseFile(SongFile); - For I := 0 to High(Lines) do + for I := 0 to High(Lines) do begin - If ((Both) or (I = 0)) then + if ((Both) or (I = 0)) then begin - If (Length(Lines[I].Line) < 2) then + if (Length(Lines[I].Line) < 2) then begin LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS'; Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); exit; end; - If (Lines[I].Line[Lines[I].High].HighNote < 0) then + if (Lines[I].Line[Lines[I].High].HighNote < 0) then begin SetLength(Lines[I].Line, Lines[I].Number - 1); Lines[I].High := Lines[I].High - 1; @@ -388,8 +393,8 @@ begin for Count := 0 to High(Lines) do begin - If (High(Lines[Count].Line) >= 0) then - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + if (High(Lines[Count].Line) >= 0) then + Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; end; except try @@ -460,7 +465,7 @@ begin Lines[Count].Resolution := self.Resolution; Lines[Count].NotesGAP := self.NotesGAP; Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := False; + Lines[Count].Line[0].LastLine := false; end; //Try to Parse the Song @@ -477,8 +482,8 @@ begin for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do begin case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of - NT_Normal: NoteType := ':'; - NT_Golden: NoteType := '*'; + NT_Normal: NoteType := ':'; + NT_Golden: NoteType := '*'; NT_Freestyle: NoteType := 'F'; end; @@ -544,8 +549,8 @@ begin //Calculate Time case Rest of 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; - 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; + 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; + 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; else if (Rest >= 4) then Time := SentenceEnd + 2 @@ -574,7 +579,7 @@ begin for Count := 0 to High(Lines) do begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := True; + Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; end; Result := true; @@ -660,7 +665,8 @@ begin //Language Sorting self.Language := Parser.SongInfo.Header.Language; - end else + end + else Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); Parser.Free; @@ -668,7 +674,7 @@ begin //Check if all Required Values are given if (Done <> 15) then begin - Result := False; + 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 @@ -686,7 +692,7 @@ end; function TSong.ReadTXTHeader(const aFileName : WideString): boolean; - function song_StrtoFloat( aValue : string ) : Extended; + function song_StrtoFloat( aValue : string ) : extended; var lValue : string; @@ -715,13 +721,12 @@ begin if (Length(Line) <= 0) then begin Log.LogError('File Starts with Empty Line: ' + aFileName); - Result := False; + Result := false; Exit; end; //Read Lines while Line starts with # or its empty - while (Length(Line) = 0) or - (Line[1] = '#') do + while (Length(Line) = 0) or (Line[1] = '#') do begin //Increase Line Number Inc (FileLineNo); @@ -765,8 +770,7 @@ begin end //MP3 File //Test if Exists - else if (Identifier = 'MP3') AND - (FileExists(self.Path + Value)) then + else if (Identifier = 'MP3') and (FileExists(self.Path + Value)) then begin self.Mp3 := Value; @@ -850,17 +854,17 @@ begin else if (Identifier = 'NOTESGAP') then TryStrtoInt(Value, self.NotesGAP) // Relative Notes - else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then - self.Relative := True; + else if (Identifier = 'RELATIVE') and (uppercase(Value) = 'YES') then + self.Relative := true; end; end; - if not EOf(SongFile) then + if not EOF(SongFile) then ReadLn (SongFile, Line) else begin - Result := False; + Result := false; Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); break; end; @@ -873,7 +877,7 @@ begin //Check if all Required Values are given if (Done <> 15) then begin - Result := False; + 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 @@ -888,11 +892,11 @@ begin end; -Function TSong.GetErrorLineNo: Integer; +function TSong.GetErrorLineNo: integer; begin - If (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then + if (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then Result := FileLineNo - Else + else Result := -1; end; @@ -967,7 +971,8 @@ begin Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; Note[HighNote].Tone := NoteP; - if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone; + if Note[HighNote].Tone < Base[LineNumber] then + Base[LineNumber] := Note[HighNote].Tone; Note[HighNote].Text := Copy(LyricS, 2, 100); Lyric := Lyric + Note[HighNote].Text; @@ -983,7 +988,7 @@ var begin - If (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then + if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then begin //Update old Sentence if it has notes and create a new sentence // Update old part Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; @@ -1022,7 +1027,7 @@ begin else Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False; + Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false; Base[LineNumberP] := 100; // high number end; @@ -1062,11 +1067,10 @@ begin end; - function TSong.Analyse(): boolean; begin - Result := False; + Result := false; //Reset LineNo FileLineNo := 0; @@ -1093,7 +1097,7 @@ end; function TSong.AnalyseXML(): boolean; begin - Result := False; + Result := false; //Reset LineNo FileLineNo := 0; -- cgit v1.2.3 From 0ed59f77bc20668ca5d0aae02d4ea076c18d853f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 15 Nov 2008 23:34:48 +0000 Subject: formatting and language. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1522 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 411 ++++++++++++++++++++++++++-------------------------- 1 file changed, 209 insertions(+), 202 deletions(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index cf19e46e..f86377f5 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -39,76 +39,82 @@ uses UPluginDefs; type - ARounds = Array [0..252] of Integer; //0..252 needed for + ARounds = array [0..252] of integer; //0..252 needed for PARounds = ^ARounds; TRoundInfo = record - Modi: Cardinal; - Winner: Byte; + Modi: cardinal; + Winner: byte; end; TeamOrderEntry = record - Teamnum: Byte; - Score: Byte; + Teamnum: byte; + Score: byte; end; - TeamOrderArray = Array[0..5] of Byte; + TeamOrderArray = array[0..5] of byte; TUS_ModiInfoEx = record - Info: TUS_ModiInfo; - Owner: Integer; - TimesPlayed: Byte; //Helper for setting Round Plugins + Info: TUS_ModiInfo; + Owner: integer; + TimesPlayed: byte; //Helper for setting round plugins end; TPartySession = class (TCoreModule) private - bPartyMode: Boolean; //Is this Party or Singleplayer - CurRound: Byte; + bPartyMode: boolean; //Is this party or single player + CurRound: byte; - Modis: Array of TUS_ModiInfoEx; + Modis: array of TUS_ModiInfoEx; Teams: TTeamInfo; - function IsWinner(Player, Winner: Byte): boolean; + function IsWinner(Player, Winner: byte): boolean; procedure GenScores; - function GetRandomPlugin(TeamMode: Boolean): Cardinal; - function GetRandomPlayer(Team: Byte): Byte; + function GetRandomPlugin(TeamMode: boolean): cardinal; + function GetRandomPlayer(Team: byte): byte; public //Teams: TTeamInfo; Rounds: array of TRoundInfo; //TCoreModule methods to inherit - Constructor Create; override; - Procedure Info(const pInfo: PModuleInfo); override; - Function Load: Boolean; override; - Function Init: Boolean; override; - Procedure DeInit; override; - Destructor Destroy; override; + constructor Create; override; + procedure Info(const pInfo: PModuleInfo); override; + function Load: boolean; override; + function Init: boolean; override; + procedure DeInit; override; + destructor Destroy; override; - //Register Modi Service - Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo + //Register modus service + function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new modus. wParam: Pointer to TUS_ModiInfo //Start new Party - Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success - Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen) - Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before. - Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played + function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new party mode. Returns non zero on success + function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns pointer to cur. Modis TUS_ModiInfo (to Use with Singscreen) + function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops party mode. Returns 1 if party mode was enabled before. + function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases curround by 1; Returns num of round or -1 if last round is already played - Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading - Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding + function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls curmodis init proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading + function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and ends the round - Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success - Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success + function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo record to pointer at lParam. Returns zero on success + function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo record from pointer at lParam. Returns zero on success - Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... - Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam + function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... + function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is roundnum. If (Pointer = nil) then return length of the string. Otherwise write the string to address at lParam end; const - StandardModi = 0; //Modi ID that will be played in non party Mode + StandardModi = 0; //Modus ID that will be played in non-party mode implementation -uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; +uses + UCore, + UGraphic, + UMain, + ULanguage, + ULog, + SysUtils; {********************* TPluginLoader @@ -116,19 +122,19 @@ uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils; *********************} //------------- -// Function that gives some Infos about the Module to the Core +// function that gives some infos about the module to the core //------------- -Procedure TPartySession.Info(const pInfo: PModuleInfo); +procedure TPartySession.Info(const pInfo: PModuleInfo); begin pInfo^.Name := 'TPartySession'; pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Manages Party Modi and Party Game'; + pInfo^.Description := 'Manages party modi and party game'; end; //------------- -// Just the Constructor +// Just the constructor //------------- -Constructor TPartySession.Create; +constructor TPartySession.Create; begin inherited; //UnSet PartyMode @@ -136,14 +142,14 @@ begin end; //------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit +//Is called on loading. +//In this method only events and services should be created +//to offer them to other modules or plugins during the init process +//If false is returned this will cause a forced exit //------------- -Function TPartySession.Load: Boolean; +function TPartySession.Load: boolean; begin - //Add Register Party Modi Service + //Add register party modus service Result := True; Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); Core.Services.AddService('Party/StartParty', nil, Self.StartParty); @@ -151,50 +157,49 @@ begin end; //------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit +//Is called on init process +//In this method you can hook some events and create + init +//your classes, variables etc. +//If false is returned this will cause a forced exit //------------- -Function TPartySession.Init: Boolean; +function TPartySession.Init: boolean; begin - //Just set Prvate Var to true. + //Just set private var to true. Result := true; end; //------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order +//Is called if this module has been inited and there is an exit. +//Deinit is in reverse initing order //------------- -Procedure TPartySession.DeInit; +procedure TPartySession.DeInit; begin //Force DeInit - end; //------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory +//Is called if this module will be unloaded and has been created +//Should be used to free memory //------------- -Destructor TPartySession.Destroy; +destructor TPartySession.Destroy; begin - //Just save some Memory if it wasn't done now.. + //Just save some memory if it wasn't done now.. SetLength(Modis, 0); inherited; end; //------------- -// Registers a new Modi. wParam: Pointer to TUS_ModiInfo -// Service for Plugins +// Registers a new modus. wParam: Pointer to TUS_ModiInfo +// Service for plugins //------------- -Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; +function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; var - Len: Integer; + Len: integer; Info: PUS_ModiInfo; begin Info := PModiInfo; //Copy Info if cbSize is correct - If (Info.cbSize = SizeOf(TUS_ModiInfo)) then + if (Info.cbSize = SizeOf(TUS_ModiInfo)) then begin Len := Length(Modis); SetLength(Modis, Len + 1); @@ -202,35 +207,35 @@ begin Modis[Len].Info := Info^; end else - Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession')); + Core.ReportError(integer(PChar('Plugins try to register modus with wrong pointer, or wrong TUS_ModiInfo record.')), PChar('TPartySession')); // FIXME: return a valid result Result := 0; end; //---------- -// Returns a Number of a Random Plugin +// Returns a number of a random plugin //---------- -Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal; +function TPartySession.GetRandomPlugin(TeamMode: boolean): cardinal; var - LowestTP: Byte; - NumPwithLTP: Word; - I: Integer; - R: Word; + LowestTP: byte; + NumPwithLTP: word; + I: integer; + R: word; begin - Result := StandardModi; //If there are no matching Modis, Play StandardModi - LowestTP := high(Byte); + Result := StandardModi; //If there are no matching modi, play standard modus + LowestTP := high(byte); NumPwithLTP := 0; //Search for Plugins not often played yet - For I := 0 to high(Modis) do + for I := 0 to high(Modis) do begin - if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin lowestTP := Modis[I].TimesPlayed; NumPwithLTP := 1; end - else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin Inc(NumPwithLTP); end; @@ -240,9 +245,9 @@ begin R := Random(NumPwithLTP); //Search for Random Plugin - For I := 0 to high(Modis) do + for I := 0 to high(Modis) do begin - if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then + if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin //Plugin Found if (R = 0) then @@ -258,76 +263,76 @@ begin end; //---------- -// Starts new Party Mode. Returns Non Zero on Success +// Starts new party mode. Returns non zero on success //---------- -Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; +function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; var - I: Integer; + I: integer; aiRounds: PARounds; - TeamMode: Boolean; + TeamMode: boolean; begin Result := 0; - If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then + if (Teams.NumTeams >= 1) and (NumRounds < High(byte)-1) then begin bPartyMode := false; aiRounds := PAofIRounds; - Try + try //Is this Teammode(More then one Player per Team) ? TeamMode := True; - For I := 0 to Teams.NumTeams-1 do - TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1); + for I := 0 to Teams.NumTeams-1 do + TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1); //Set Rounds SetLength(Rounds, NumRounds); - For I := 0 to High(Rounds) do + for I := 0 to High(Rounds) do begin //Set Plugins - If (aiRounds[I] = -1) then + if (aiRounds[I] = -1) then Rounds[I].Modi := GetRandomPlugin(TeamMode) - Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then + else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then Rounds[I].Modi := aiRounds[I] - Else + else Rounds[I].Modi := StandardModi; - Rounds[I].Winner := High(Byte); //Set Winner to Not Played + Rounds[I].Winner := High(byte); //Set Winner to Not Played end; - CurRound := High(Byte); //Set CurRound to not defined + CurRound := High(byte); //Set CurRound to not defined //Return teh true and Set PartyMode bPartyMode := True; Result := 1; - Except - Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); + except + Core.ReportError(integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); end; end; end; //---------- -// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen) +// Returns Pointer to Cur. ModiInfoEx (to use with sing screen) //---------- -Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; begin - If (bPartyMode) AND (CurRound <= High(Rounds)) then + if (bPartyMode) and (CurRound <= High(Rounds)) then begin //If PartyMode is enabled: //Return the Plugin of the Cur Round - Result := Integer(@Modis[Rounds[CurRound].Modi]); + Result := integer(@Modis[Rounds[CurRound].Modi]); end else begin //Return StandardModi - Result := Integer(@Modis[StandardModi]); + Result := integer(@Modis[StandardModi]); end; end; //---------- // Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible //---------- -Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; begin Result := -1; - If (bPartyMode) then + if (bPartyMode) then begin // to-do : Whitü: Check here if SingScreen is not Shown atm. bPartyMode := False; @@ -338,59 +343,60 @@ begin end; //---------- -//GetRandomPlayer - Gives back a Random Player to Play next Round +//GetRandomPlayer - gives back a random player to play next round //---------- -function TPartySession.GetRandomPlayer(Team: Byte): Byte; +function TPartySession.GetRandomPlayer(Team: byte): byte; var - I, R: Integer; - lowestTP: Byte; - NumPwithLTP: Byte; + I, R: integer; + lowestTP: byte; + NumPwithLTP: byte; begin - LowestTP := high(Byte); - NumPwithLTP := 0; - Result := 0; + LowestTP := high(byte); + NumPwithLTP := 0; + Result := 0; - //Search for Players that have not often played yet - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + //Search for Players that have not often played yet + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; + lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; + NumPwithLTP := 1; + end + else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + begin + Inc(NumPwithLTP); end; + end; - //Create Random No - R := Random(NumPwithLTP); + //Create random no + R := Random(NumPwithLTP); - //Search for Random Player - For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + //Search for random player + for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + begin + if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then + //Player found + if (R = 0) then begin - //Player Found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); + Result := I; + Break; end; + + Dec(R); end; + end; end; //---------- -// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played +// NextRound - Increases CurRound by 1; Returns num of round or -1 if last round is already played //---------- -Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; -var I: Integer; +function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; +var + I: integer; begin - If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then begin //everythings OK! -> Start the Round, maaaaan Inc(CurRound); @@ -406,23 +412,23 @@ begin end; //---------- -//IsWinner - Returns True if the Players Bit is set in the Winner Byte +//IsWinner - returns true if the players bit is set in the winner byte //---------- -function TPartySession.IsWinner(Player, Winner: Byte): boolean; +function TPartySession.IsWinner(Player, Winner: byte): boolean; var - Bit: Byte; + Bit: byte; begin Bit := 1 shl Player; - Result := ((Winner AND Bit) = Bit); + Result := ((Winner and Bit) = Bit); end; //---------- -//GenScores - Inc Scores for Cur. Round +//GenScores - inc scores for cur. round //---------- procedure TPartySession.GenScores; var - I: Byte; + I: byte; begin for I := 0 to Teams.NumTeams-1 do begin @@ -432,86 +438,86 @@ begin end; //---------- -// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading +// CallModiInit - calls CurModis Init Proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading //---------- -Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; begin - If (not bPartyMode) then - begin //Set Rounds if not in PartyMode + if (not bPartyMode) then + begin //Set rounds if not in party mode SetLength(Rounds, 1); Rounds[0].Modi := StandardModi; - Rounds[0].Winner := High(Byte); + Rounds[0].Winner := High(byte); CurRound := 0; end; - Try + try //Core. - Except + except on E : Exception do begin - Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); - If (Rounds[CurRound].Modi = StandardModi) then + Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); + if (Rounds[CurRound].Modi = StandardModi) then begin - Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession')); + Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession')); Halt; end - Else //Select StandardModi + else //Select StandardModi begin Rounds[CurRound].Modi := StandardModi end; end; - End; + end; // FIXME: return a valid result Result := 0; end; //---------- -// CallModiDeInit - Calls DeInitProc and does the RoundEnding +// CallModiDeInit - calls DeInitProc and ends the round //---------- -Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; var - I: Integer; - MaxScore: Word; + I: integer; + MaxScore: word; begin - If (bPartyMode) then + if (bPartyMode) then begin //Get Winner Byte! - if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin + if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get winners from plugin Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) else - begin //Create winners by Score :/ + begin //Create winners by score :/ Rounds[CurRound].Winner := 0; MaxScore := 0; for I := 0 to Teams.NumTeams-1 do begin - // to-do : recode Percentage stuff + // to-do : recode percentage stuff //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; if (Player[I].ScoreTotalInt > MaxScore) then begin MaxScore := Player[I].ScoreTotalInt; Rounds[CurRound].Winner := 1 shl I; end - else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then + else if (Player[I].ScoreTotalInt = MaxScore) and (Player[I].ScoreTotalInt <> 0) then begin Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); end; end; - //When nobody has Points -> Everybody loose + //When nobody has points -> everybody looses if (MaxScore = 0) then Rounds[CurRound].Winner := 0; end; - //Generate teh Scores + //Generate the scores GenScores; - //Inc Players TimesPlayed - If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then + //Inc players TimesPlayed + if ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings and MLS_IncTP) = MLS_IncTP) then begin - For I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams-1 do Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); end; end @@ -523,69 +529,70 @@ begin end; //---------- -// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success +// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success //---------- -Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; -var Info: ^TTeamInfo; +function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +var + Info: ^TTeamInfo; begin Result := -1; Info := pTeamInfo; - If (Info <> nil) then + if (Info <> nil) then begin - Try + try // to - do : Check Delphi memory management in this case //Not sure if i had to copy PChars to a new address or if delphi manages this o0 Info^ := Teams; Result := 0; - Except + except Result := -2; - End; + end; end; end; //---------- -// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success +// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success //---------- -Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; var TeamInfobackup: TTeamInfo; Info: ^TTeamInfo; begin Result := -1; Info := pTeamInfo; - If (Info <> nil) then + if (Info <> nil) then begin - Try + try TeamInfoBackup := Teams; // to - do : Check Delphi memory management in this case //Not sure if i had to copy PChars to a new address or if delphi manages this o0 Teams := Info^; Result := 0; - Except + except Teams := TeamInfoBackup; Result := -2; - End; + end; end; end; //---------- -// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ... +// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... //---------- -Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; var - I, J: Integer; + I, J: integer; ATeams: array [0..5] of TeamOrderEntry; TempTeam: TeamOrderEntry; begin - // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing - //Fill Team Array - For I := 0 to Teams.NumTeams-1 do + // to-do : PartyMode: Write this in another way, so that teams with the same score get the same place + //Fill Team array + for I := 0 to Teams.NumTeams-1 do begin ATeams[I].Teamnum := I; ATeams[I].Score := Teams.Teaminfo[I].Score; end; - //Sort Teams + //Sort teams for J := 0 to Teams.NumTeams-1 do for I := 1 to Teams.NumTeams-1 do if ATeams[I].Score > ATeams[I-1].Score then @@ -597,17 +604,17 @@ begin //Copy to Result Result := 0; - For I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams-1 do Result := Result or (ATeams[I].TeamNum Shl I*3); end; //---------- -// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam +// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam //---------- -Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; var - Winners: Array of String; - I: Integer; + Winners: array of String; + I: integer; ResultStr: String; S: ^String; begin @@ -637,21 +644,21 @@ begin end; end; - //Now Return what we have got - If (lParam = nil) then - begin //ReturnString Length + //Now return what we have got + if (lParam = nil) then + begin //Return string length Result := Length(ResultStr); end - Else + else begin //Return String - Try + try S := lParam; S^ := ResultStr; Result := 0; - Except + except Result := -1; - End; + end; end; end; -- cgit v1.2.3 From 8c480db528416d95aeb4e6cc070960b6ea1215bb Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 24 Nov 2008 23:26:10 +0000 Subject: some format changes and minor code rearrangements. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1524 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UEditorLyrics.pas | 89 ++++++++++++++++++++++++---------------------- 1 file changed, 47 insertions(+), 42 deletions(-) (limited to 'src/base') diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index d06fc891..0b16110f 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -41,28 +41,28 @@ uses type TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; end; TEditorLyrics = class private - AlignI: integer; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - FontStyleI: integer; // font number - Word: array of TWord; + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + FontStyleI: integer; // font number + Word: array of TWord; procedure SetX(Value: real); procedure SetY(Value: real); @@ -71,17 +71,17 @@ type function GetSize: real; procedure SetSize(Value: real); procedure SetSelected(Value: integer); - procedure SetFStyle(Value: integer); + procedure SetFontStyle(Value: integer); procedure AddWord(Text: string); procedure Refresh; public - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; constructor Create; destructor Destroy; override; @@ -97,13 +97,17 @@ type property Align: integer write SetAlign; property Size: real read GetSize write SetSize; property Selected: integer read SelectedI write SetSelected; - property FontStyle: integer write SetFStyle; + property FontStyle: integer write SetFontStyle; end; implementation uses - TextGL, UGraphic, UDrawTexture, Math, USkins; + TextGL, + UGraphic, + UDrawTexture, + Math, + USkins; constructor TEditorLyrics.Create; begin @@ -148,7 +152,7 @@ end; procedure TEditorLyrics.SetSelected(Value: integer); begin - if (SelectedI > -1) and (SelectedI <= High(Word)) then + if (-1 < SelectedI) and (SelectedI <= High(Word)) then begin Word[SelectedI].Selected := false; Word[SelectedI].ColR := ColR; @@ -157,7 +161,7 @@ begin end; SelectedI := Value; - if (Value > -1) and (Value <= High(Word)) then + if (-1 < Value) and (Value <= High(Word)) then begin Word[Value].Selected := true; Word[Value].ColR := ColSR; @@ -168,22 +172,21 @@ begin Refresh; end; -procedure TEditorLyrics.SetFStyle(Value: integer); +procedure TEditorLyrics.SetFontStyle(Value: integer); begin FontStyleI := Value; end; procedure TEditorLyrics.AddWord(Text: string); var - WordNum: integer; + WordNum: integer; begin WordNum := Length(Word); SetLength(Word, WordNum + 1); - if WordNum = 0 then begin - Word[WordNum].X := XR; - end else begin + if WordNum = 0 then + Word[WordNum].X := XR + else Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - end; Word[WordNum].Y := YR; Word[WordNum].Size := SizeR; @@ -202,10 +205,11 @@ end; procedure TEditorLyrics.AddLine(NrLine: integer); var - N: integer; + N: integer; begin Clear; - for N := 0 to Lines[0].Line[NrLine].HighNote do begin + for N := 0 to Lines[0].Line[NrLine].HighNote do + begin Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; AddWord(Lines[0].Line[NrLine].Note[N].Text); end; @@ -220,10 +224,11 @@ end; procedure TEditorLyrics.Refresh; var - W: integer; - TotWidth: real; + W: integer; + TotWidth: real; begin - if AlignI = 1 then begin + if AlignI = 1 then + begin TotWidth := 0; for W := 0 to High(Word) do TotWidth := TotWidth + Word[W].Width; @@ -236,7 +241,7 @@ end; procedure TEditorLyrics.Draw; var - W: integer; + W: integer; begin for W := 0 to High(Word) do begin -- cgit v1.2.3 From 65a64b2404ae4e7c4c5e75724e25a1189c29c3ad Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 26 Nov 2008 21:38:59 +0000 Subject: replace integer by enumeration type alignment git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1526 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UEditorLyrics.pas | 44 +++++++++++++++++++++++--------------------- 1 file changed, 23 insertions(+), 21 deletions(-) (limited to 'src/base') diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index 0b16110f..485fabe8 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -40,23 +40,25 @@ uses UTexture; type + alignment = (left, center, right); + TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; end; TEditorLyrics = class private - AlignI: integer; + AlignI: alignment; XR: real; YR: real; SizeR: real; @@ -67,7 +69,7 @@ type procedure SetX(Value: real); procedure SetY(Value: real); function GetClientX: real; - procedure SetAlign(Value: integer); + procedure SetAlign(Value: alignment); function GetSize: real; procedure SetSize(Value: real); procedure SetSelected(Value: integer); @@ -94,7 +96,7 @@ type property X: real write SetX; property Y: real write SetY; property ClientX: real read GetClientX; - property Align: integer write SetAlign; + property Align: alignment write SetAlign; property Size: real read GetSize write SetSize; property Selected: integer read SelectedI write SetSelected; property FontStyle: integer write SetFontStyle; @@ -103,10 +105,10 @@ type implementation uses - TextGL, - UGraphic, - UDrawTexture, - Math, + TextGL, + UGraphic, + UDrawTexture, + Math, USkins; constructor TEditorLyrics.Create; @@ -135,7 +137,7 @@ begin Result := Word[0].X; end; -procedure TEditorLyrics.SetAlign(Value: integer); +procedure TEditorLyrics.SetAlign(Value: alignment); begin AlignI := Value; end; @@ -183,7 +185,7 @@ var begin WordNum := Length(Word); SetLength(Word, WordNum + 1); - if WordNum = 0 then + if WordNum = 0 then Word[WordNum].X := XR else Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; @@ -227,7 +229,7 @@ var W: integer; TotWidth: real; begin - if AlignI = 1 then + if AlignI = center then begin TotWidth := 0; for W := 0 to High(Word) do -- cgit v1.2.3 From 680a6a4fe7ee80d513d45b09ffeecd509afc7696 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 26 Nov 2008 22:39:28 +0000 Subject: names of variables changed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1527 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UEditorLyrics.pas | 40 ++++++++++++++++++++-------------------- 1 file changed, 20 insertions(+), 20 deletions(-) (limited to 'src/base') diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index 485fabe8..fe8c3ee5 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -207,13 +207,13 @@ end; procedure TEditorLyrics.AddLine(NrLine: integer); var - N: integer; + NoteIndex: integer; begin Clear; - for N := 0 to Lines[0].Line[NrLine].HighNote do + for NoteIndex := 0 to Lines[0].Line[NrLine].HighNote do begin - Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle; - AddWord(Lines[0].Line[NrLine].Note[N].Text); + Italic := Lines[0].Line[NrLine].Note[NoteIndex].NoteType = ntFreestyle; + AddWord(Lines[0].Line[NrLine].Note[NoteIndex].Text); end; Selected := -1; end; @@ -226,33 +226,33 @@ end; procedure TEditorLyrics.Refresh; var - W: integer; - TotWidth: real; + WordIndex: integer; + TotalWidth: real; begin if AlignI = center then begin - TotWidth := 0; - for W := 0 to High(Word) do - TotWidth := TotWidth + Word[W].Width; + TotalWidth := 0; + for WordIndex := 0 to High(Word) do + TotalWidth := TotalWidth + Word[WordIndex].Width; - Word[0].X := XR - TotWidth / 2; - for W := 1 to High(Word) do - Word[W].X := Word[W - 1].X + Word[W - 1].Width; + Word[0].X := XR - TotalWidth / 2; + for WordIndex := 1 to High(Word) do + Word[WordIndex].X := Word[WordIndex - 1].X + Word[WordIndex - 1].Width; end; end; procedure TEditorLyrics.Draw; var - W: integer; + WordIndex: integer; begin - for W := 0 to High(Word) do + for WordIndex := 0 to High(Word) do begin - SetFontStyle(Word[W].FontStyle); - SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y); - SetFontSize(Word[W].Size); - SetFontItalic(Word[W].Italic); - glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); - glPrint(Word[W].Text); + SetFontStyle(Word[WordIndex].FontStyle); + SetFontPos(Word[WordIndex].X + 10*ScreenX, Word[WordIndex].Y); + SetFontSize(Word[WordIndex].Size); + SetFontItalic(Word[WordIndex].Italic); + glColor3f(Word[WordIndex].ColR, Word[WordIndex].ColG, Word[WordIndex].ColB); + glPrint(Word[WordIndex].Text); end; end; -- cgit v1.2.3 From 17cfff8c4f38f58b33038622a2fed261c9fa6088 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 26 Nov 2008 22:46:11 +0000 Subject: formatting and modi change to modus git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1528 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 54 ++++++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 27 deletions(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index f86377f5..18d15745 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -104,7 +104,7 @@ type end; const - StandardModi = 0; //Modus ID that will be played in non-party mode + StandardModus = 0; //Modus ID that will be played in non-party mode implementation @@ -138,7 +138,7 @@ constructor TPartySession.Create; begin inherited; //UnSet PartyMode - bPartyMode := False; + bPartyMode := false; end; //------------- @@ -150,7 +150,7 @@ end; function TPartySession.Load: boolean; begin //Add register party modus service - Result := True; + Result := true; Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); Core.Services.AddService('Party/StartParty', nil, Self.StartParty); Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); @@ -223,7 +223,7 @@ var I: integer; R: word; begin - Result := StandardModi; //If there are no matching modi, play standard modus + Result := StandardModus; //If there are no matching modi, play standard modus LowestTP := high(byte); NumPwithLTP := 0; @@ -241,15 +241,15 @@ begin end; end; - //Create Random No + //Create random no R := Random(NumPwithLTP); - //Search for Random Plugin + //Search for random plugin for I := 0 to high(Modis) do begin if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then begin - //Plugin Found + //Plugin found if (R = 0) then begin Result := I; @@ -278,8 +278,8 @@ begin aiRounds := PAofIRounds; try - //Is this Teammode(More then one Player per Team) ? - TeamMode := True; + //Is this team mode (More than one player per team) ? + TeamMode := true; for I := 0 to Teams.NumTeams-1 do TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1); @@ -287,31 +287,31 @@ begin SetLength(Rounds, NumRounds); for I := 0 to High(Rounds) do - begin //Set Plugins + begin //Set plugins if (aiRounds[I] = -1) then Rounds[I].Modi := GetRandomPlugin(TeamMode) else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then Rounds[I].Modi := aiRounds[I] else - Rounds[I].Modi := StandardModi; + Rounds[I].Modi := StandardModus; - Rounds[I].Winner := High(byte); //Set Winner to Not Played + Rounds[I].Winner := High(byte); //Set winner to not played end; CurRound := High(byte); //Set CurRound to not defined - //Return teh true and Set PartyMode - bPartyMode := True; + //Return true and set party mode + bPartyMode := true; Result := 1; except - Core.ReportError(integer(PChar('Can''t start PartyMode.')), PChar('TPartySession')); + Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession')); end; end; end; //---------- -// Returns Pointer to Cur. ModiInfoEx (to use with sing screen) +// Returns pointer to Cur. ModiInfoEx (to use with sing screen) //---------- function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; begin @@ -321,21 +321,21 @@ begin Result := integer(@Modis[Rounds[CurRound].Modi]); end else - begin //Return StandardModi - Result := integer(@Modis[StandardModi]); + begin //Return standard modus + Result := integer(@Modis[StandardModus]); end; end; //---------- -// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible +// Stops party mode. Returns 1 if party mode was enabled before and -1 if change was not possible //---------- function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; begin Result := -1; if (bPartyMode) then begin - // to-do : Whitü: Check here if SingScreen is not Shown atm. - bPartyMode := False; + // to-do : Whitü: Check here if sing screen is not shown atm. + bPartyMode := false; Result := 1; end else @@ -355,7 +355,7 @@ begin NumPwithLTP := 0; Result := 0; - //Search for Players that have not often played yet + //Search for players that have not often played yet for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do begin if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then @@ -445,7 +445,7 @@ begin if (not bPartyMode) then begin //Set rounds if not in party mode SetLength(Rounds, 1); - Rounds[0].Modi := StandardModi; + Rounds[0].Modi := StandardModus; Rounds[0].Winner := High(byte); CurRound := 0; end; @@ -456,14 +456,14 @@ begin on E : Exception do begin Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); - if (Rounds[CurRound].Modi = StandardModi) then + if (Rounds[CurRound].Modi = StandardModus) then begin Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession')); Halt; end - else //Select StandardModi + else //Select standard modus begin - Rounds[CurRound].Modi := StandardModi + Rounds[CurRound].Modi := StandardModus end; end; end; @@ -650,7 +650,7 @@ begin Result := Length(ResultStr); end else - begin //Return String + begin //Return string try S := lParam; S^ := ResultStr; -- cgit v1.2.3 From cb11733f11fd82d80b0bdae558444c5c78ac586f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 26 Nov 2008 22:47:05 +0000 Subject: some small format edits git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1529 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index c31f6df1..b1458e69 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -74,7 +74,7 @@ type end; TSong = class - FileLineNo : integer; //Line which is readed at Last, for error reporting + FileLineNo : integer; // line, which is read last, for error reporting procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); @@ -281,15 +281,15 @@ begin //Check for ZeroNote if Param2 = 0 then - Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') - else + Log.LogError('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 + 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); @@ -302,14 +302,14 @@ begin // reads sentence Read(SongFile, Param1); if self.Relative then - Read(SongFile, Param2); // read one more data for relative system + 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 + begin // P1 + P2 NewSentence(0, (Param1 + Rel[0]) * Mult, Param2); NewSentence(1, (Param1 + Rel[1]) * Mult, Param2); @@ -338,7 +338,7 @@ begin begin if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - + if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; end; @@ -347,7 +347,7 @@ begin else begin for Count := 0 to High(Lines) do - begin + begin Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count]; Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric); //Total Notes Patch @@ -362,7 +362,7 @@ begin //Total Notes Patch End end; end; - ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) + ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) Read(SongFile, TempC); Inc(FileLineNo); @@ -430,7 +430,7 @@ var NoteType: char; SentenceEnd, Rest, Time: integer; Parser: TParser; - + begin Result := false; LastError := ''; @@ -473,7 +473,7 @@ begin if Parser.ParseSong(Path + PathDelim + FileName) then begin //Writeln('XML Inputfile Parsed succesful'); - + //Start write parsed information to Song //Notes Part for I := 0 to High(Parser.SongInfo.Sentences) do @@ -946,7 +946,7 @@ begin begin SetLength(Note, Length(Note) + 1); HighNote := High(Note); - + Note[HighNote].Start := StartP; if HighNote = 0 then begin @@ -966,7 +966,7 @@ begin if (Note[HighNote].NoteType = ntGolden) then Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; - + if (Note[HighNote].NoteType <> ntFreestyle) then Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; -- cgit v1.2.3 From ccbf6ee893829ec067a629d7fa7771d3e73e4081 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 29 Nov 2008 20:37:46 +0000 Subject: folders in Library/Application\ Support/UltraStarDeluxe/Resources can also be symlinks. No aliases, however. Courtesy to Filipe Cabecinhas. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1531 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 19 ++++++++++++++----- 1 file changed, 14 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 0b44b76a..9085e337 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -154,6 +154,9 @@ begin end; procedure TPlatformMacOSX.CreateUserFolders(); +const + // used to construct the @link(UserPathName) + PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; var RelativePath: string; // BaseDir contains the path to the folder, where a search is performed. @@ -172,11 +175,12 @@ var // searched for additional files and folders. DirectoryIsFinished: longint; Counter: longint; + // These three are for creating directories, due to possible symlinks + CreatedDirectory: boolean; + FileAttrs: integer; + DirectoryPath: string; - UserPathName: string; -const - // used to construct the @link(UserPathName) - PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; + UserPathName: string; begin // Get the current folder and save it in OldBaseDir for returning to it, when // finished. @@ -221,7 +225,12 @@ begin ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created. for Counter := 0 to DirectoryList.Count-1 do begin - if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then + DirectoryPath := UserPathName + '/' + DirectoryList[Counter]; + CreatedDirectory := ForceDirectories(DirectoryPath); + FileAttrs := FileGetAttr(DirectoryPath); + // Don't know how to analyse the target of the link. + // Let's assume the symlink is pointing to an existing directory. + if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', 'TPlatformMacOSX.CreateUserFolders'); end; -- cgit v1.2.3 From 1423d21d13e4c5b925ac3e73764ae666ce3b4e60 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 30 Nov 2008 12:57:27 +0000 Subject: Deluxe theme for Editor menu. Part 2. This part may break Classic theme. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1533 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 29 +++++++++++++++++++++++++++++ 1 file changed, 29 insertions(+) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 361ed87d..9bf858ed 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -484,6 +484,16 @@ type ButtonExit: TThemeButton; end; + TThemeEdit = class(TThemeBasic) + ButtonConvert: TThemeButton; + ButtonExit: TThemeButton; + + TextDescription: TThemeText; + TextDescriptionLong: TThemeText; + Description: array[0..5] of string; + DescriptionLong: array[0..5] of string; + end; + //Error- and Check-Popup TThemeError = class(TThemeBasic) Button1: TThemeButton; @@ -723,6 +733,8 @@ type OptionsThemes: TThemeOptionsThemes; OptionsRecord: TThemeOptionsRecord; OptionsAdvanced: TThemeOptionsAdvanced; + //edit + Edit: TThemeEdit; //error and check popup ErrorPopup: TThemeError; CheckPopup: TThemeCheck; @@ -852,6 +864,8 @@ begin OptionsRecord := TThemeOptionsRecord.Create; OptionsAdvanced := TThemeOptionsAdvanced.Create; + Edit := TThemeEdit.Create; + ErrorPopup := TThemeError.Create; CheckPopup := TThemeCheck.Create; @@ -1246,6 +1260,18 @@ begin ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); + //Edit Menu + ThemeLoadBasic (Edit, 'Edit'); + + ThemeLoadButton(Edit.ButtonConvert, 'EditButtonConvert'); + ThemeLoadButton(Edit.ButtonExit, 'EditButtonExit'); + + Edit.Description[0] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_CONVERT'); + Edit.Description[1] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_EXIT'); + + ThemeLoadText(Edit.TextDescription, 'EditTextDescription'); + Edit.TextDescription.Text := Edit.Description[0]; + //error and check popup ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); @@ -2310,6 +2336,9 @@ begin freeandnil(OptionsAdvanced); OptionsAdvanced := TThemeOptionsAdvanced.Create; + freeandnil(Edit); + Edit := TThemeEdit.Create; + freeandnil(ErrorPopup); ErrorPopup := TThemeError.Create; -- cgit v1.2.3 From 6d9dc62a08dd1ee9efa9309eea71dba8f7a94b0c Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 2 Jan 2009 23:16:37 +0000 Subject: capture failure of file/dir access. Courtesy to Filipe Cabecinhas. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1545 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 12 ++++++++++-- 1 file changed, 10 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 6f66bf3f..7f5125a9 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -275,7 +275,11 @@ var lSong : TSong; begin - Files := Platform.DirectoryFindFiles( Dir, '.txt', true); + try + Files := Platform.DirectoryFindFiles( Dir, '.txt', true) + except + Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles') + end; for i := 0 to Length(Files)-1 do begin @@ -308,7 +312,11 @@ var lSong : TSong; begin - Files := Platform.DirectoryFindFiles( Dir, '.xml', true); + try + Files := Platform.DirectoryFindFiles( Dir, '.xml', true) + except + Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles') + end; for i := 0 to Length(Files)-1 do begin -- cgit v1.2.3 From 3f1356f667375268ba34d1217d8eff19379749e5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 19 Jan 2009 21:54:33 +0000 Subject: Mic settings saved again (broken in revision 912) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1572 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 19 ++++++++++++------- 1 file changed, 12 insertions(+), 7 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 3a4d6129..7f25a813 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -283,17 +283,22 @@ function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; var Value: string; Start: integer; + PrefixPos, SuffixPos: integer; begin Result := -1; - if Pos(Prefix, Key) > -1 then - begin - Start := Pos(Prefix, Key) + Length(Prefix); + PrefixPos := Pos(Prefix, Key); + if (PrefixPos <= 0) then + Exit; + SuffixPos := Pos(Suffix, Key); + if (SuffixPos <= 0) then + Exit; - // copy all between prefix and suffix - Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start); - Result := StrToIntDef(Value, -1); - end; + Start := PrefixPos + Length(Prefix); + + // copy all between prefix and suffix + Value := Copy(Key, Start, SuffixPos - Start); + Result := StrToIntDef(Value, -1); end; (** -- cgit v1.2.3 From 280f7947052e3212719042f01e9e77068d1c7f6a Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 19 Jan 2009 22:18:47 +0000 Subject: Threshold and boost saved again git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1574 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 7f25a813..920a1903 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -419,9 +419,9 @@ begin RecordKeys.Free(); // MicBoost - //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); + MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); // Threshold - // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); + ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); end; procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); @@ -447,9 +447,9 @@ begin end; // MicBoost - //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); + IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); // Threshold - //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); + IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); end; procedure TIni.LoadPaths(IniFile: TCustomIniFile); -- cgit v1.2.3 From fd7c8018177f1dc2b0ff6404e436e9c39acb9e67 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 3 Feb 2009 22:03:24 +0000 Subject: cosmetic changes, no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1578 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 391 +++++++++++++++++++++++++++++++---------------------- 1 file changed, 227 insertions(+), 164 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 97b526c5..d5891182 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -67,7 +67,6 @@ type WMid: real; Height: real; HMid: real; - Mid: real; end; @@ -75,11 +74,11 @@ var NotesW: real; NotesH: real; Starfr: integer; - StarfrG: integer; + StarfrG: integer; //SingBar - TickOld: cardinal; - TickOld2:cardinal; + TickOld: cardinal; + TickOld2: cardinal; implementation @@ -103,10 +102,11 @@ uses procedure SingDrawBackground; var - Rec: TRecR; - TexRec: TRecR; + Rec: TRecR; + TexRec: TRecR; begin - if (ScreenSing.Tex_Background.TexNum > 0) then begin + if (ScreenSing.Tex_Background.TexNum > 0) then + begin glClearColor (1, 1, 1, 1); glColor4f (1, 1, 1, 1); @@ -182,16 +182,17 @@ end; procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); var SampleIndex: integer; - Sound: TCaptureBuffer; - MaxX, MaxY: real; + Sound: TCaptureBuffer; + MaxX, MaxY: real; begin; Sound := AudioInputProcessor.Sound[NrSound]; // Log.LogStatus('Oscilloscope', 'SingDraw'); glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); - {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); } - +{ + if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then + glColor3f(1, 1, 1); +} MaxX := W-1; MaxY := (H-1) / 2; @@ -212,12 +213,13 @@ end; procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); var - Count: integer; + Count: integer; begin glEnable(GL_BLEND); glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); glBegin(GL_LINES); - for Count := 0 to 9 do begin + for Count := 0 to 9 do + begin glVertex2f(Left, Top + Count * Space); glVertex2f(Right, Top + Count * Space); end; @@ -227,13 +229,14 @@ end; procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); var - Count: integer; - TempR: real; + Count: integer; + TempR: real; begin TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); glEnable(GL_BLEND); glBegin(GL_LINES); - for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin + for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do + begin if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then glColor4f(0, 0, 0, 1) else @@ -248,16 +251,15 @@ end; // draw blank Notebars procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; - PlayerNumber: Integer; + PlayerNumber: integer; - GoldenStarPos : real; + GoldenStarPos: real; - lTmpA , - lTmpB : real; + lTmpA, lTmpB : real; begin // We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero // So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero @@ -277,8 +279,7 @@ begin lTmpA := (Right-Left); lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - if ( lTmpA > 0 ) AND - ( lTmpB > 0 ) THEN + if ( lTmpA > 0 ) and ( lTmpB > 0 ) then begin TempR := lTmpA / lTmpB; end @@ -288,12 +289,14 @@ begin end; - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - if NoteType <> ntFreestyle then begin - - + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + if NoteType <> ntFreestyle then + begin if Ini.EffectSing = 0 then // If Golden note Effect of then Change not Color begin @@ -370,14 +373,16 @@ var TempR: real; Rec: TRecR; N: integer; - //R, G, B, A: real; +// R, G, B, A: real; NotesH2: real; begin //Log.LogStatus('Player notes', 'SingDraw'); - - //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') - //else LoadColor(R, G, B, 'P2Light'); - +{ + if NrGracza = 0 then + LoadColor(R, G, B, 'P1Light') + else + LoadColor(R, G, B, 'P2Light'); +} //R := 71/255; //G := 175/255; //B := 247/255; @@ -482,14 +487,12 @@ end; //draw Note glow procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; X1, X2, X3, X4: real; - W, H: real; - - lTmpA , - lTmpB : real; + W, H: real; + lTmpA, lTmpB: real; begin if (Player[PlayerIndex].ScoreTotalInt >= 0) then begin @@ -501,8 +504,7 @@ begin lTmpA := (Right-Left); lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - if ( lTmpA > 0 ) and - ( lTmpB > 0 ) then + if ( lTmpA > 0 ) and ( lTmpB > 0 ) then begin TempR := lTmpA / lTmpB; end @@ -710,7 +712,8 @@ begin SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); end; - if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin + if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then + begin SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); @@ -721,39 +724,48 @@ begin SingDrawLyricHelper(NR.Left, NR.WMid); // oscilloscope - if Ini.Oscilloscope = 1 then begin + if Ini.Oscilloscope = 1 then + begin if PlayersPlay = 1 then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayersPlay = 2 then begin + if PlayersPlay = 2 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); end; end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 6 then + begin + if ScreenAct = 1 then + begin SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); @@ -782,13 +794,15 @@ begin end; // Draw the Notes - if PlayersPlay = 1 then begin + if PlayersPlay = 1 then + begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes end; - if (PlayersPlay = 2) then begin + if PlayersPlay = 2 then + begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); @@ -799,7 +813,8 @@ begin SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; @@ -816,67 +831,81 @@ begin SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); end; end; - if PlayersPlay = 6 then begin + if PlayersPlay = 6 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); end; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); @@ -892,9 +921,12 @@ var NR: TRecR; begin // positions - if Ini.SingWindow = 0 then begin + if Ini.SingWindow = 0 then + begin NR.Left := 120; - end else begin + end + else + begin NR.Left := 20; end; @@ -910,12 +942,14 @@ begin begin if PlayersPlay = 1 then SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); - if (PlayersPlay = 2) or (PlayersPlay = 4) then begin + if (PlayersPlay = 2) or (PlayersPlay = 4) then + begin SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); end; - if (PlayersPlay = 3) or (PlayersPlay = 6) then begin + if (PlayersPlay = 3) or (PlayersPlay = 6) then + begin SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); @@ -927,26 +961,31 @@ begin // TODO: Lyrics helper // oscilloscope | the thing that moves when you yell into your mic (imho) - if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin + if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then + begin if PlayersPlay = 1 then if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayersPlay = 2 then begin + if PlayersPlay = 2 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin if PlayerInfo.Playerinfo[2].Enabled then SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); if PlayerInfo.Playerinfo[3].Enabled then @@ -954,7 +993,8 @@ begin end; end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); if PlayerInfo.Playerinfo[1].Enabled then @@ -963,8 +1003,10 @@ begin SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if PlayersPlay = 6 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 6 then + begin + if ScreenAct = 1 then + begin if PlayerInfo.Playerinfo[0].Enabled then SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); if PlayerInfo.Playerinfo[1].Enabled then @@ -972,7 +1014,8 @@ begin if PlayerInfo.Playerinfo[2].Enabled then SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin if PlayerInfo.Playerinfo[3].Enabled then SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); if PlayerInfo.Playerinfo[4].Enabled then @@ -1003,15 +1046,17 @@ begin end; end; - if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then + if (DLLMAn.Selected.ShowNotes and DLLMan.Selected.LoadSong) then begin - if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin + if (PlayersPlay = 1) and PlayerInfo.Playerinfo[0].Enabled then + begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); end; - if (PlayersPlay = 2) then begin + if PlayersPlay = 2 then + begin if PlayerInfo.Playerinfo[0].Enabled then begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); @@ -1027,7 +1072,8 @@ begin end; - if PlayersPlay = 3 then begin + if PlayersPlay = 3 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; @@ -1053,12 +1099,15 @@ begin end; end; - if PlayersPlay = 4 then begin - if ScreenAct = 1 then begin + if PlayersPlay = 4 then + begin + if ScreenAct = 1 then + begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); end; @@ -1066,26 +1115,31 @@ begin SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); end; end; - if PlayersPlay = 6 then begin + if PlayersPlay = 6 then + begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); @@ -1095,12 +1149,14 @@ begin SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - if ScreenAct = 1 then begin + if ScreenAct = 1 then + begin SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); end; - if ScreenAct = 2 then begin + if ScreenAct = 2 then + begin SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); @@ -1116,11 +1172,11 @@ end; {//SingBar Mod procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); var - R: Real; - G: Real; - B: Real; - A: cardinal; - I: Integer; + R: real; + G: real; + B: real; + A: cardinal; + I: integer; begin; @@ -1195,98 +1251,105 @@ end; //end Singbar Mod //PhrasenBonus - Line Bonus Pop Up -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer); +procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer); var -Length, X2: Real; //Length of Text -Size: Integer; //Size of Popup -begin -if Alpha <> 0 then + Length, X2: real; //Length of Text + Size: integer; //Size of Popup begin + if Alpha <> 0 then + begin //Set Font Propertys -SetFontStyle(2); //Font: Outlined1 -if Age < 5 then SetFontSize((Age + 1) * 3) else SetFontSize(18); -SetFontItalic(False); + SetFontStyle(2); //Font: Outlined1 + if Age < 5 then + SetFontSize((Age + 1) * 3) + else + SetFontSize(18); + SetFontItalic(False); //Check Font Size -Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ + Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ //Text -SetFontPos (X + 50 - (Length / 2), Y + 12); //Position + SetFontPos (X + 50 - (Length / 2), Y + 12); //Position -if Age < 5 then Size := Age * 10 else Size := 50; + if Age < 5 then + Size := Age * 10 + else + Size := 50; - //Draw Background - //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color - glColor4f(1, 1, 1, Alpha); +//Draw Background +// glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color + glColor4f(1, 1, 1, Alpha); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); +// glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - //New Method, Not Variable - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); - glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); - glEnd; +//New Method, Not Variable + glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); - glColor4f(1, 1, 1, Alpha); //Set Color - //Draw Text - glPrint (Text); -end; + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); + glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); + glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); + glEnd; + + glColor4f(1, 1, 1, Alpha); //Set Color +//Draw Text + glPrint (Text); + end; end; //PhrasenBonus - Line Bonus Mod} // Draw Note Bars for Editor -//There are 11 Resons for a new Procdedure: (nice binary :D ) +// There are 11 Resons for a new Procdedure: (nice binary :D ) // 1. It don't look good when you Draw the Golden Note Star Effect in the Editor // 2. You can see the Freestyle Notes in the Editor SemiTransparent // 3. Its easier and Faster then changing the old Procedure procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); var - Rec: TRecR; - Count: integer; - TempR: real; + Rec: TRecR; + Count: integer; + TempR: real; begin glColor3f(1, 1, 1); glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - with Lines[NrLines].Line[Lines[NrLines].Current] do begin - for Count := 0 to HighNote do begin - with Note[Count] do begin - - // Golden Note Patch - case NoteType of - ntFreestyle: glColor4f(1, 1, 1, 0.35); - ntNormal: glColor4f(1, 1, 1, 0.85); - ntGolden: Glcolor4f(1, 1, 0.3, 0.85); - end; // case - + with Lines[NrLines].Line[Lines[NrLines].Current] do + begin + for Count := 0 to HighNote do + begin + with Note[Count] do + begin + // Golden Note Patch + case NoteType of + ntFreestyle: glColor4f(1, 1, 1, 0.35); + ntNormal: glColor4f(1, 1, 1, 0.85); + ntGolden: Glcolor4f(1, 1, 0.3, 0.85); + end; // case - // left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; + // left part + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; + Rec.Bottom := Rec.Top + 2 * NotesH; + glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; - // middle part + // middle part Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; @@ -1320,7 +1383,7 @@ end; procedure SingDrawTimeBar(); var - x,y: real; + x, y: real; width, height: real; LyricsProgress: real; CurLyricsTime: real; -- cgit v1.2.3 From 76a763f4430eec10a6c9fa30c58a32a27aa9db66 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 3 Feb 2009 22:47:51 +0000 Subject: more cosmetic changes, no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1579 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 233 +++++++++++++++++++++++++---------------------------- 1 file changed, 108 insertions(+), 125 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index d5891182..6cef5d6b 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -55,7 +55,6 @@ procedure SingDrawTimeBar(); //Draw Editor NoteLines procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); - type TRecR = record Top: real; @@ -116,7 +115,7 @@ begin (* half screen + gradient *) Rec.Top := 110; // 80 Rec.Bottom := Rec.Top + 20; - Rec.Left := 0; + Rec.Left := 0; Rec.Right := 800; TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; @@ -209,8 +208,6 @@ begin; Sound.UnlockAnalysisBuffer(); end; - - procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); var Count: integer; @@ -258,10 +255,10 @@ var PlayerNumber: integer; GoldenStarPos: real; - + lTmpA, lTmpB : real; begin -// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero +// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it is always set to zero // So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero // This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then // BUT this is not implemented yet, all notes are drawn! :D @@ -280,15 +277,10 @@ begin lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); if ( lTmpA > 0 ) and ( lTmpB > 0 ) then - begin - TempR := lTmpA / lTmpB; - end + TempR := lTmpA / lTmpB else - begin TempR := 0; - end; - with Lines[NrLines].Line[Lines[NrLines].Current] do begin for Count := 0 to HighNote do @@ -309,7 +301,7 @@ begin glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself // left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; Rec.Bottom := Rec.Top + 2 * NotesH; @@ -326,7 +318,7 @@ begin //done // middle part - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); @@ -340,7 +332,7 @@ begin glEnd; // right part - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); @@ -352,7 +344,7 @@ begin glEnd; // Golden Star Patch - if (NoteType = ntGolden) AND (Ini.EffectSing=1) then + if (NoteType = ntGolden) and (Ini.EffectSing=1) then begin GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); end; @@ -366,7 +358,6 @@ begin glDisable(GL_TEXTURE_2D); end; - // draw sung notes procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); var @@ -380,10 +371,10 @@ begin { if NrGracza = 0 then LoadColor(R, G, B, 'P1Light') - else + else LoadColor(R, G, B, 'P2Light'); } - //R := 71/255; + //R := 71/255; //G := 175/255; //B := 247/255; @@ -400,7 +391,7 @@ begin with Player[PlayerIndex].Note[N] do begin // Left part of note - Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; + Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; // Draw it in half size, if not hit @@ -414,7 +405,7 @@ begin end; Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 *NotesH2; + Rec.Bottom := Rec.Top + 2 * NotesH2; // draw the left part glColor3f(1, 1, 1); @@ -427,7 +418,7 @@ begin glEnd; // Middle part of the note - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; // new @@ -450,7 +441,7 @@ begin glColor3f(1, 1, 1); // the right part of the note - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); @@ -505,13 +496,9 @@ begin lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); if ( lTmpA > 0 ) and ( lTmpB > 0 ) then - begin - TempR := lTmpA / lTmpB; - end + TempR := lTmpA / lTmpB else - begin TempR := 0; - end; with Lines[NrLines].Line[Lines[NrLines].Current] do begin @@ -533,7 +520,7 @@ begin X4 := X3+W; // left - Rec.Left := X1; + Rec.Left := X1; Rec.Right := X2; Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; Rec.Bottom := Rec.Top + 2 * H; @@ -547,7 +534,7 @@ begin glEnd; // middle part - Rec.Left := X2; + Rec.Left := X2; Rec.Right := X3; glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); @@ -559,7 +546,7 @@ begin glEnd; // right part - Rec.Left := X3; + Rec.Left := X3; Rec.Right := X4; glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); @@ -607,7 +594,7 @@ begin // FIXME: accessing ScreenSing is not that generic LyricEngine := ScreenSing.Lyrics; - + // do not draw the lyrics helper if the current line does not contain any note if (Length(CurLine.Note) > 0) then begin @@ -704,19 +691,19 @@ begin // draw note-lines if (PlayersPlay = 1) and (Ini.NoteLines = 1) then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); end; if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); end; // draw Lyrics @@ -751,7 +738,7 @@ begin if PlayersPlay = 3 then begin - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); end; @@ -798,19 +785,19 @@ begin begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); // imho the sung notes end; if PlayersPlay = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; if PlayersPlay = 3 then @@ -818,30 +805,30 @@ begin NotesW := NotesW * 0.8; NotesH := NotesH * 0.8; - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; if PlayersPlay = 4 then begin if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); end; if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); end; if ScreenAct = 1 then @@ -857,13 +844,13 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); end; end; @@ -874,15 +861,15 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); end; if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); end; if ScreenAct = 1 then @@ -900,15 +887,15 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); end; end; glDisable(GL_BLEND); @@ -918,14 +905,14 @@ end; // q'n'd for using the game mode dll's procedure SingModiDraw (PlayerInfo: TPlayerInfo); var - NR: TRecR; + NR: TRecR; begin // positions if Ini.SingWindow = 0 then begin NR.Left := 120; end - else + else begin NR.Left := 20; end; @@ -941,18 +928,18 @@ begin if DLLMan.Selected.ShowNotes then begin if PlayersPlay = 1 then - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); if (PlayersPlay = 2) or (PlayersPlay = 4) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); - SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); + SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); end; if (PlayersPlay = 3) or (PlayersPlay = 6) then begin - SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); - SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); + SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); end; end; @@ -961,7 +948,7 @@ begin // TODO: Lyrics helper // oscilloscope | the thing that moves when you yell into your mic (imho) - if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then + if (((Ini.Oscilloscope = 1) and (DLLMan.Selected.ShowRateBar_O)) and (not DLLMan.Selected.ShowRateBar)) then begin if PlayersPlay = 1 then if PlayerInfo.Playerinfo[0].Enabled then @@ -996,7 +983,7 @@ begin if PlayersPlay = 3 then begin if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0); + SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); if PlayerInfo.Playerinfo[1].Enabled then SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); if PlayerInfo.Playerinfo[2].Enabled then @@ -1052,22 +1039,22 @@ begin begin SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); end; if PlayersPlay = 2 then begin if PlayerInfo.Playerinfo[0].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); end; if PlayerInfo.Playerinfo[1].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; end; @@ -1079,23 +1066,23 @@ begin if PlayerInfo.Playerinfo[0].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); end; if PlayerInfo.Playerinfo[1].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); end; if PlayerInfo.Playerinfo[2].Enabled then begin - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; end; @@ -1103,13 +1090,13 @@ begin begin if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); end; if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); + SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); end; SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); @@ -1117,13 +1104,13 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); end; if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); - SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); + SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); end; end; @@ -1134,15 +1121,15 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); end; if ScreenAct = 2 then begin - SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); + SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); + SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); end; SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); @@ -1151,15 +1138,15 @@ begin if ScreenAct = 1 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); end; if ScreenAct = 2 then begin - SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); - SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); - SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12); + SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); + SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); + SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); end; end; end; @@ -1168,7 +1155,6 @@ begin glDisable(GL_TEXTURE_2D); end; - {//SingBar Mod procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); var @@ -1194,7 +1180,7 @@ begin; glEnd; //SingBar coloured Bar - Case Percent of + case Percent of 0..22: begin R := 1; G := 0; @@ -1220,7 +1206,7 @@ begin; G := 1; B := 0; end; - End; //Case + end; //case glColor4f(R, G, B, 1); glEnable(GL_TEXTURE_2D); @@ -1251,7 +1237,7 @@ end; //end Singbar Mod //PhrasenBonus - Line Bonus Pop Up -procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer); +procedure SingDrawLineBonus(const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer); var Length, X2: real; //Length of Text Size: integer; //Size of Popup @@ -1273,7 +1259,6 @@ begin //Text SetFontPos (X + 50 - (Length / 2), Y + 12); //Position - if Age < 5 then Size := Age * 10 else @@ -1283,12 +1268,10 @@ begin // glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color glColor4f(1, 1, 1, Alpha); - glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); // glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - //New Method, Not Variable glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); @@ -1307,10 +1290,10 @@ end; //PhrasenBonus - Line Bonus Mod} // Draw Note Bars for Editor -// There are 11 Resons for a new Procdedure: (nice binary :D ) -// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor -// 2. You can see the Freestyle Notes in the Editor SemiTransparent -// 3. Its easier and Faster then changing the old Procedure +// There are 11 reasons for a new procedure: (nice binary :D ) +// 1. It does not look good when you draw the golden note star effect in the editor +// 2. You can see the freestyle notes in the editor semitransparent +// 3. It is easier and faster then changing the old procedure procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); var Rec: TRecR; @@ -1337,7 +1320,7 @@ begin end; // case // left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; Rec.Right := Rec.Left + NotesW; Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; Rec.Bottom := Rec.Top + 2 * NotesH; @@ -1350,7 +1333,7 @@ begin glEnd; // middle part - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); @@ -1362,7 +1345,7 @@ begin glEnd; // right part - Rec.Left := Rec.Right; + Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); -- cgit v1.2.3 From 29aa8dbd912837a16529f33605e7136cfffeacd1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 3 Feb 2009 23:28:22 +0000 Subject: implementing the use of the default texture in ParseTextureType git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1580 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTexture.pas | 48 +++++++++++++++++++++++------------------------- 1 file changed, 23 insertions(+), 25 deletions(-) (limited to 'src/base') diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 4f33b78a..8fb03bde 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -93,7 +93,7 @@ type TTextureEntry = record Name: string; Typ: TTextureType; - Color: Cardinal; + Color: cardinal; // we use normal TTexture, it's easier to implement and if needed - we copy ready data Texture: TTexture; // Full-size texture @@ -104,8 +104,8 @@ type private Texture: array of TTextureEntry; public - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); - function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); + function FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; end; TTextureUnit = class @@ -115,7 +115,7 @@ type Limit: integer; procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload; + procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload; function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; @@ -123,7 +123,7 @@ type function LoadTexture(const Identifier: string): TTexture; overload; function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; - procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload; + procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload; //procedure FlushTextureDatabase(); constructor Create; @@ -164,10 +164,10 @@ begin SDL_FreeSurface(TempSurface); end; end; - + { TTextureDatabase } -procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); var TextureIndex: integer; begin @@ -188,7 +188,7 @@ begin Texture[TextureIndex].Texture := Tex; end; -function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer; +function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; var TextureIndex: integer; CurrentTexture: PTextureEntry; @@ -211,7 +211,6 @@ begin end; end; - { TTextureUnit } constructor TTextureUnit.Create; @@ -226,13 +225,12 @@ begin inherited Destroy; end; - procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); begin TextureDatabase.AddTexture(Tex, Typ, 0, Cache); end; -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean); +procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); begin TextureDatabase.AddTexture(Tex, Typ, Color, Cache); end; @@ -251,8 +249,8 @@ end; function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; var TexSurface: PSDL_Surface; - newWidth, newHeight: Cardinal; - oldWidth, oldHeight: Cardinal; + newWidth, newHeight: cardinal; + oldWidth, oldHeight: cardinal; ActTex: GLuint; begin // zero texture data @@ -431,8 +429,8 @@ begin {$ELSE} glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); {$ENDIF} - - { + +{ if Mipmapping then begin Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); @@ -440,8 +438,8 @@ begin if Error > 0 then Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); end; - } - +} + Result.X := 0; Result.Y := 0; Result.Z := 0; @@ -474,14 +472,14 @@ begin UnloadTexture(Name, Typ, 0, FromCache); end; -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); +procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); var T: integer; TexNum: GLuint; begin T := TextureDatabase.FindTexture(Name, Typ, Col); - if not FromCache then + if not FromCache then begin TexNum := TextureDatabase.Texture[T].Texture.TexNum; if TexNum > 0 then @@ -529,20 +527,20 @@ end; function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; var - TexType: TTextureType; + TextureType: TTextureType; UpCaseStr: string; begin UpCaseStr := UpperCase(TypeStr); - for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do + for TextureType := Low(TextureTypeStr) to High(TextureTypeStr) do begin - if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then + if (UpCaseStr = UpperCase(TextureTypeStr[TextureType])) then begin - Result := TexType; + Result := TextureType; Exit; end; end; - Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType'); - Result := TEXTURE_TYPE_PLAIN; + Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType'); + Result := Default; end; end. -- cgit v1.2.3 From 4bfd179d6903b623b446b17db42c1454aa0b56a0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 4 Feb 2009 17:35:38 +0000 Subject: Tabs_at_startup -> TabsAtStartup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1582 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 4 ++-- src/base/USongs.pas | 2 +- 2 files changed, 3 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 920a1903..7068bfb3 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -98,7 +98,7 @@ type Difficulty: integer; Language: integer; Tabs: integer; - Tabs_at_startup:integer; //Tabs at Startup fix + TabsAtStartup:integer; //Tabs at Startup fix Sorting: integer; Debug: integer; @@ -668,7 +668,7 @@ begin // Tabs Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); - Tabs_at_startup := Tabs; //Tabs at Startup fix + TabsAtStartup := Tabs; //Tabs at Startup fix // Song Sorting Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 7f5125a9..4d702163 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -652,7 +652,7 @@ begin end; // set CatNumber of last category - if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then + if (Ini.TabsAtStartup = 1) and (High(Song) >= 1) then begin // set number of songs in previous category SongIndex := CatIndex - CatNumber; -- cgit v1.2.3 From 8fad36f79e14d58fd44ea5146943a2f8019d7a13 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 4 Feb 2009 17:45:38 +0000 Subject: - PChar replaced by PByteArray (for byte buffers) or PAnsiString (for zero-terminated strings) - TRingBuffer.Size()/.Available() added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1584 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 18 +++++++++--------- src/base/URecord.pas | 18 +++++++++--------- src/base/URingBuffer.pas | 24 ++++++++++++++++++------ 3 files changed, 36 insertions(+), 24 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 792d5e3f..10f789d7 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -35,6 +35,7 @@ interface uses UTime, + SysUtils, Classes; type @@ -212,12 +213,12 @@ type TSoundEffect = class public EngineData: Pointer; // can be used for engine-specific data - procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract; + procedure Callback(Buffer: PByteArray; BufSize: integer); virtual; abstract; end; TVoiceRemoval = class(TSoundEffect) public - procedure Callback(Buffer: PChar; BufSize: integer); override; + procedure Callback(Buffer: PByteArray; BufSize: integer); override; end; type @@ -262,7 +263,7 @@ type function IsEOF(): boolean; virtual; abstract; function IsError(): boolean; virtual; abstract; public - function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract; + function ReadData(Buffer: PByteArray; BufferSize: integer): integer; virtual; abstract; property EOF: boolean read IsEOF; property Error: boolean read IsError; @@ -292,7 +293,7 @@ type function GetVolume(): single; virtual; abstract; procedure SetVolume(Volume: single); virtual; abstract; function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; - procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); + procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); public (** * Opens a SourceStream for playback. @@ -335,7 +336,7 @@ type function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; procedure Close(); override; - procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract; + procedure WriteData(Buffer: PByteArray; BufferSize: integer); virtual; abstract; function GetAudioFormatInfo(): TAudioFormatInfo; override; function GetLength(): real; override; @@ -468,7 +469,7 @@ type * input-buffer bytes used. * Returns the number of bytes written to the output-buffer or -1 if an error occured. *) - function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract; + function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; virtual; abstract; (** * Destination/Source size ratio @@ -561,7 +562,6 @@ procedure DumpMediaInterfaces(); implementation uses - sysutils, math, UIni, UMain, @@ -942,7 +942,7 @@ end; { TVoiceRemoval } -procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer); +procedure TVoiceRemoval.Callback(Buffer: PByteArray; BufSize: integer); var FrameIndex, FrameSize: integer; Value: integer; @@ -1180,7 +1180,7 @@ end; (* * Fills a buffer with copies of the given frame or with 0 if frame. *) -procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer); +procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); var i: integer; FrameCopyCount: integer; diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 132bafd5..00d82abb 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -36,8 +36,8 @@ interface uses Classes, Math, - SysUtils, sdl, + SysUtils, UCommon, UMusic, UIni; @@ -54,8 +54,8 @@ type function GetToneString: string; // converts a tone to its string represenatation; - procedure BoostBuffer(Buffer: PChar; Size: Cardinal); - procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer); + procedure BoostBuffer(Buffer: PByteArray; Size: Cardinal); + procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); // we call it to analyze sound by checking Autocorrelation procedure AnalyzeByAutocorrelation; @@ -135,7 +135,7 @@ type procedure UpdateInputDeviceConfig; // handle microphone input - procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal; + procedure HandleMicrophoneData(Buffer: PByteArray; Size: Cardinal; InputDevice: TAudioInputDevice); end; @@ -268,7 +268,7 @@ begin UnlockAnalysisBuffer(); end; -procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer); +procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); var BufferOffset: integer; SampleCount: integer; @@ -464,7 +464,7 @@ begin Result := '-'; end; -procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal); +procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: Cardinal); var i: integer; Value: Longint; @@ -608,10 +608,10 @@ end; * Length - number of bytes in Buffer * Input - Soundcard-Input used for capture *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice); +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: Cardinal; InputDevice: TAudioInputDevice); var - MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel) - SingleChannelBuffer: PChar; // temporary buffer for new samples per channel + MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) + SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel SingleChannelBufferSize: integer; ChannelIndex: integer; CaptureChannel: TCaptureBuffer; diff --git a/src/base/URingBuffer.pas b/src/base/URingBuffer.pas index 515d0efb..684c13ee 100644 --- a/src/base/URingBuffer.pas +++ b/src/base/URingBuffer.pas @@ -39,7 +39,7 @@ uses type TRingBuffer = class private - RingBuffer: PChar; + RingBuffer: PByteArray; BufferCount: integer; BufferSize: integer; WritePos: integer; @@ -47,8 +47,10 @@ type public constructor Create(Size: integer); destructor Destroy; override; - function Read(Buffer: PChar; Count: integer): integer; - function Write(Buffer: PChar; Count: integer): integer; + function Read(Buffer: PByteArray; Count: integer): integer; + function Write(Buffer: PByteArray; Count: integer): integer; + function Size(): integer; + function Available(): integer; procedure Flush(); end; @@ -71,7 +73,7 @@ begin FreeMem(RingBuffer); end; -function TRingBuffer.Read(Buffer: PChar; Count: integer): integer; +function TRingBuffer.Read(Buffer: PByteArray; Count: integer): integer; var PartCount: integer; begin @@ -106,7 +108,7 @@ begin Result := Count; end; -function TRingBuffer.Write(Buffer: PChar; Count: integer): integer; +function TRingBuffer.Write(Buffer: PByteArray; Count: integer): integer; var PartCount: integer; begin @@ -143,6 +145,16 @@ begin Result := Count; end; +function TRingBuffer.Available(): integer; +begin + Result := BufferCount; +end; + +function TRingBuffer.Size(): integer; +begin + Result := BufferSize; +end; + procedure TRingBuffer.Flush(); begin ReadPos := 0; @@ -150,4 +162,4 @@ begin BufferCount := 0; end; -end. \ No newline at end of file +end. -- cgit v1.2.3 From 8474b7135054b8da29e8e95f6764fbcd53689e02 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 10 Feb 2009 00:16:36 +0000 Subject: types unified to longword, algo optimized, but no succes regarding endian related issue with icons git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1588 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 31 ++++++++++++++++--------------- 1 file changed, 16 insertions(+), 15 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 18b0035c..dfd47d12 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -892,17 +892,18 @@ begin end; *) -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); - //returns hue within range [0.0-6.0) - function col2hue(Color:Cardinal): double; + // returns hue within the range [0.0-6.0) + function col2hue(Color: longword): double; var clr: array[0..2] of double; hue, max, delta: double; begin - clr[0] := ((Color and $ff0000) shr 16)/255; // R - clr[1] := ((Color and $ff00) shr 8)/255; // G - clr[2] := (Color and $ff) /255; // B + // division by 255 is omitted, since it is implicitly done when deviding by delta + clr[0] := ((Color and $ff0000) shr 16); // R + clr[1] := ((Color and $ff00) shr 8); // G + clr[2] := (Color and $ff) ; // B max := maxvalue(clr); delta := max - minvalue(clr); // calc hue @@ -916,16 +917,16 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); end; var - DestinationHue: Double; - PixelIndex: Cardinal; + DestinationHue: double; + PixelIndex: longword; Pixel: PByte; PixelColors: PByteArray; - clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B] - hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)] - dhue: UInt32; - h_int: Cardinal; - delta, f, p, q, t: Longint; - max: Uint32; + clr: array[0..2] of longword; // [0: R, 1: G, 2: B] + hsv: array[0..2] of longword; // [0: H(ue), 1: S(aturation), 2: V(alue)] + dhue: longword; + delta, max: longword; + h_int: longword; + f, p, q, t: longword; begin DestinationHue := col2hue(NewColor); @@ -953,7 +954,7 @@ begin if clr[2] < delta then delta := clr[2]; delta := max-delta; hsv[0] := dhue; // shl 8 - hsv[2] := max; // shl 8 + hsv[2] := max; // shl 8 if (max = 0) then hsv[1] := 0 else -- cgit v1.2.3 From b89c524d4d7996f7984d698b68fb75b0ec253267 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 12 Feb 2009 18:43:13 +0000 Subject: more simplification and optimization of ColorizeImage. Removal of unneeded shl 10 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1589 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 159 ++++++++++++++++++++++++++++++++-------------------- 1 file changed, 99 insertions(+), 60 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index dfd47d12..01dfe9ea 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -798,7 +798,7 @@ end; * Image manipulation *******************************************************) - + function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; begin if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and @@ -828,7 +828,7 @@ end; procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); var TempSurface: PSDL_Surface; - ImgFmt: PSDL_PixelFormat; + ImgFmt: PSDL_PixelFormat; begin TempSurface := ImgSurface; @@ -894,89 +894,128 @@ end; procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); - // returns hue within the range [0.0-6.0) - function col2hue(Color: longword): double; + // for the conversion of colors from rgb to hsv space and back + // simply check the wikipedia. + + function col2hue(const Color: longword): longword; + // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 var - clr: array[0..2] of double; - hue, max, delta: double; + red, green, blue: longword; + min, max, delta: longword; + hue: double; begin - // division by 255 is omitted, since it is implicitly done when deviding by delta - clr[0] := ((Color and $ff0000) shr 16); // R - clr[1] := ((Color and $ff00) shr 8); // G - clr[2] := (Color and $ff) ; // B - max := maxvalue(clr); - delta := max - minvalue(clr); + // extract the colors + // division by 255 is omitted, since it is implicitly done + // when deviding by delta + red := ((Color and $ff0000) shr 16); // R + green := ((Color and $ff00) shr 8); // G + blue := (Color and $ff) ; // B + + min := red; + if green < min then min := green; + if blue < min then min := blue; + + max := red; + if green > max then max := green; + if blue > max then max := blue; + // calc hue - if (delta = 0.0) then hue := 0 - else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta - else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta - else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta; - if (hue < 0.0) then - hue := hue + 6.0; - Result := hue; + delta := max - min; + if (delta = 0) then + Result := 0 + else + begin + if (max = red ) then hue := (green - blue )/delta + else if (max = green) then hue := 2.0 + (blue - red )/delta + else if (max = blue ) then hue := 4.0 + (red - green)/delta; + if (hue < 0.0) then + hue := hue + 6.0; + Result := trunc(hue*1024); // '*1024' is shl 10 + end; end; var - DestinationHue: double; PixelIndex: longword; Pixel: PByte; PixelColors: PByteArray; - clr: array[0..2] of longword; // [0: R, 1: G, 2: B] - hsv: array[0..2] of longword; // [0: H(ue), 1: S(aturation), 2: V(alue)] - dhue: longword; - delta, max: longword; - h_int: longword; + red, green, blue: longword; + hue, sat: longword; + min, max, delta: longword; + HueInteger: longword; f, p, q, t: longword; begin - DestinationHue := col2hue(NewColor); - - dhue := Trunc(DestinationHue*1024); Pixel := ImgSurface^.Pixels; + hue := col2hue(NewColor); // hue is shl 10 + f := hue and $3ff; + HueInteger := hue shr 10; + for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do begin PixelColors := PByteArray(Pixel); // inlined colorize per pixel // uses fixed point math + // shl 10 is used for divisions + // get color values - clr[0] := PixelColors[0] shl 10; - clr[1] := PixelColors[1] shl 10; - clr[2] := PixelColors[2] shl 10; + + red := PixelColors[0]; + green := PixelColors[1]; + blue := PixelColors[2]; + //calculate luminance and saturation from rgb - max := clr[0]; - if clr[1] > max then max := clr[1]; - if clr[2] > max then max := clr[2]; - delta := clr[0]; - if clr[1] < delta then delta := clr[1]; - if clr[2] < delta then delta := clr[2]; - delta := max-delta; - hsv[0] := dhue; // shl 8 - hsv[2] := max; // shl 8 - if (max = 0) then - hsv[1] := 0 + max := red; + if green > max then max := green; + if blue > max then max := blue ; + + if (max = 0) then // the color is black + begin + PixelColors[0] := 0; + PixelColors[1] := 0; + PixelColors[2] := 0; + end else - hsv[1] := (delta shl 10) div max; // shl 8 - h_int := hsv[0] and $fffffC00; - f := hsv[0]-h_int; //shl 10 - p := (hsv[2]*(1024-hsv[1])) shr 10; - q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10; - t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10; - h_int := h_int shr 10; - case h_int of - 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p) - 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p) - 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t) - 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v) - 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v) - 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q) - end; + begin + min := red; + if green < min then min := green; + if blue < min then min := blue ; + + if (min = 255) then // the color is white + begin + PixelColors[0] := 255; + PixelColors[1] := 255; + PixelColors[2] := 255; + end + else // all colors except black and white + begin + delta := max - min; + sat := (delta shl 10) div max; // shl 10 - PixelColors[0] := clr[0] shr 10; - PixelColors[1] := clr[1] shr 10; - PixelColors[2] := clr[2] shr 10; + // take into account that sat and f are shl 10 + // the final p, q and t are unshifted + + p := (max*(1024-sat)) shr 10; + q := (max*(1024-(sat*f) shr 10)) shr 10; + t := (max*(1024-(sat*(1024-f)) shr 10)) shr 10; + + case HueInteger of + 0: begin red := max; green := t; blue := p; end; // (v,t,p) + 1: begin red := q; green := max; blue := p; end; // (q,v,p) + 2: begin red := p; green := max; blue := t; end; // (p,v,t) + 3: begin red := p; green := q; blue := max; end; // (p,q,v) + 4: begin red := t; green := p; blue := max; end; // (t,p,v) + 5: begin red := max; green := p; blue := q; end; // (v,p,q) + end; + + PixelColors[0] := red ; + PixelColors[1] := green ; + PixelColors[2] := blue ; + + end; + end; Inc(Pixel, ImgSurface^.format.BytesPerPixel); end; -- cgit v1.2.3 From 23c87e0c4020c47a14d6e7fc3ae29d31f0bef387 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 13 Feb 2009 00:06:59 +0000 Subject: endian related glitch with icons resolved (Bug 2363571). Courtesy to sven for an essential hint. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1590 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 25 +++++++++++++++++++++++++ 1 file changed, 25 insertions(+) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 01dfe9ea..d9d02a58 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -903,6 +903,7 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); red, green, blue: longword; min, max, delta: longword; hue: double; + test: longword; begin // extract the colors // division by 255 is omitted, since it is implicitly done @@ -961,9 +962,15 @@ begin // get color values + {$IFDEF FPC_BIG_ENDIAN} + red := PixelColors[3]; + green := PixelColors[2]; + blue := PixelColors[1]; + {$ELSE} red := PixelColors[0]; green := PixelColors[1]; blue := PixelColors[2]; + {$ENDIF} //calculate luminance and saturation from rgb @@ -973,9 +980,15 @@ begin if (max = 0) then // the color is black begin + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := 0; + PixelColors[2] := 0; + PixelColors[1] := 0; + {$ELSE} PixelColors[0] := 0; PixelColors[1] := 0; PixelColors[2] := 0; + {$ENDIF} end else begin @@ -985,9 +998,15 @@ begin if (min = 255) then // the color is white begin + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := 255; + PixelColors[2] := 255; + PixelColors[1] := 255; + {$ELSE} PixelColors[0] := 255; PixelColors[1] := 255; PixelColors[2] := 255; + {$ENDIF} end else // all colors except black and white begin @@ -1010,9 +1029,15 @@ begin 5: begin red := max; green := p; blue := q; end; // (v,p,q) end; + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := red ; + PixelColors[2] := green ; + PixelColors[1] := blue ; + {$ELSE} PixelColors[0] := red ; PixelColors[1] := green ; PixelColors[2] := blue ; + {$ENDIF} end; end; -- cgit v1.2.3 From cf71c461e3099bb8db9ccbc09b55797733f4632c Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 13 Feb 2009 21:27:42 +0000 Subject: Additional safe guard for pixel size in ColorizeImage git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1591 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 9 +++++++++ 1 file changed, 9 insertions(+) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index d9d02a58..db4cde09 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -947,6 +947,15 @@ var begin Pixel := ImgSurface^.Pixels; + + // check of the size of a pixel in bytes. + // It should be always 4, but this + // additional safeguard will show, + // whether something went wrong up to here. + + if ImgSurface^.format.BytesPerPixel <> 4 then + Log.LogError ('ColorizeImage: The pixel size should be 4, but it is ' + + IntToStr(ImgSurface^.format.BytesPerPixel)); hue := col2hue(NewColor); // hue is shl 10 f := hue and $3ff; -- cgit v1.2.3 From dc6d440ebb640d3639f6ea80c00e7ee985ec8279 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 14 Feb 2009 12:07:45 +0000 Subject: cleanup. no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1592 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 158 +++++++++++++++++++++++++--------------------------- 1 file changed, 76 insertions(+), 82 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index db4cde09..93d84c54 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -151,10 +151,9 @@ function LoadImage(const Filename: string): PSDL_Surface; *******************************************************) function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal); - +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); implementation @@ -185,7 +184,6 @@ uses UCommon, ULog; - function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean; begin Result := (pixelFmt.BitsPerPixel = 24) and @@ -266,7 +264,6 @@ begin end; end; - (******************************************************* * Image saving *******************************************************) @@ -759,12 +756,10 @@ end; {$ENDIF} - (******************************************************* * Image loading *******************************************************) - (* * Loads an image from the given file *) @@ -793,12 +788,10 @@ begin end; end; - (******************************************************* * Image manipulation *******************************************************) - function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; begin if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and @@ -814,7 +807,7 @@ begin Result := false; end; -procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); var TempSurface: PSDL_Surface; begin @@ -825,7 +818,7 @@ begin SDL_FreeSurface(TempSurface); end; -procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal); +procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); var TempSurface: PSDL_Surface; ImgFmt: PSDL_PixelFormat; @@ -849,12 +842,12 @@ end; (* // Old slow floating point version of ColorizeTexture. // For an easier understanding of the faster fixed point version below. -procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); +procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: cardinal); var - clr: array[0..2] of Double; // [0: R, 1: G, 2: B] - hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)] - delta, f, p, q, t: Double; - max: Double; + clr: array[0..2] of double; // [0: R, 1: G, 2: B] + hsv: array[0..2] of double; // [0: H(ue), 1: S(aturation), 2: V(alue)] + delta, f, p, q, t: double; + max: double; begin clr[0] := PixelColors[0]/255; clr[1] := PixelColors[1]/255; @@ -897,41 +890,40 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); // for the conversion of colors from rgb to hsv space and back // simply check the wikipedia. - function col2hue(const Color: longword): longword; + function ColorToHue(const Color: longword): longword; // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 var - red, green, blue: longword; - min, max, delta: longword; - hue: double; - test: longword; + Red, Green, Blue: longword; + Min, Max, Delta: longword; + Hue: double; begin // extract the colors // division by 255 is omitted, since it is implicitly done // when deviding by delta - red := ((Color and $ff0000) shr 16); // R - green := ((Color and $ff00) shr 8); // G - blue := (Color and $ff) ; // B + Red := ((Color and $ff0000) shr 16); // R + Green := ((Color and $ff00) shr 8); // G + Blue := (Color and $ff) ; // B - min := red; - if green < min then min := green; - if blue < min then min := blue; + Min := Red; + if Green < Min then Min := Green; + if Blue < Min then Min := Blue; - max := red; - if green > max then max := green; - if blue > max then max := blue; + Max := Red; + if Green > Max then Max := Green; + if Blue > Max then Max := Blue; // calc hue - delta := max - min; - if (delta = 0) then + Delta := Max - Min; + if (Delta = 0) then Result := 0 else begin - if (max = red ) then hue := (green - blue )/delta - else if (max = green) then hue := 2.0 + (blue - red )/delta - else if (max = blue ) then hue := 4.0 + (red - green)/delta; - if (hue < 0.0) then - hue := hue + 6.0; - Result := trunc(hue*1024); // '*1024' is shl 10 + if (Max = Red ) then Hue := (Green - Blue )/Delta + else if (Max = Green) then Hue := 2.0 + (Blue - Red )/Delta + else if (Max = Blue ) then Hue := 4.0 + (Red - Green)/Delta; + if (Hue < 0.0) then + Hue := Hue + 6.0; + Result := trunc(Hue*1024); // '*1024' is shl 10 end; end; @@ -939,27 +931,27 @@ var PixelIndex: longword; Pixel: PByte; PixelColors: PByteArray; - red, green, blue: longword; - hue, sat: longword; - min, max, delta: longword; + Red, Green, Blue: longword; + Hue, Sat: longword; + Min, Max, Delta: longword; HueInteger: longword; f, p, q, t: longword; begin Pixel := ImgSurface^.Pixels; - + // check of the size of a pixel in bytes. - // It should be always 4, but this - // additional safeguard will show, + // It should be always 4, but this + // additional safeguard will show, // whether something went wrong up to here. if ImgSurface^.format.BytesPerPixel <> 4 then - Log.LogError ('ColorizeImage: The pixel size should be 4, but it is ' + Log.LogError ('ColorizeImage: The pixel size should be 4, but it is ' + IntToStr(ImgSurface^.format.BytesPerPixel)); - hue := col2hue(NewColor); // hue is shl 10 - f := hue and $3ff; - HueInteger := hue shr 10; + Hue := ColorToHue(NewColor); // Hue is shl 10 + f := Hue and $3ff; + HueInteger := Hue shr 10; for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do begin @@ -972,22 +964,24 @@ begin // get color values {$IFDEF FPC_BIG_ENDIAN} - red := PixelColors[3]; - green := PixelColors[2]; - blue := PixelColors[1]; + Red := PixelColors[3]; + Green := PixelColors[2]; + Blue := PixelColors[1]; + // PixelColors[0] is alpha and remains untouched {$ELSE} - red := PixelColors[0]; - green := PixelColors[1]; - blue := PixelColors[2]; + Red := PixelColors[0]; + Green := PixelColors[1]; + Blue := PixelColors[2]; + // PixelColors[3] is alpha and remains untouched {$ENDIF} //calculate luminance and saturation from rgb - max := red; - if green > max then max := green; - if blue > max then max := blue ; + Max := Red; + if Green > Max then Max := Green; + if Blue > Max then Max := Blue ; - if (max = 0) then // the color is black + if (Max = 0) then // the color is black begin {$IFDEF FPC_BIG_ENDIAN} PixelColors[3] := 0; @@ -1001,11 +995,11 @@ begin end else begin - min := red; - if green < min then min := green; - if blue < min then min := blue ; + Min := Red; + if Green < Min then Min := Green; + if Blue < Min then Min := Blue ; - if (min = 255) then // the color is white + if (Min = 255) then // the color is white begin {$IFDEF FPC_BIG_ENDIAN} PixelColors[3] := 255; @@ -1019,33 +1013,33 @@ begin end else // all colors except black and white begin - delta := max - min; - sat := (delta shl 10) div max; // shl 10 + Delta := Max - Min; + Sat := (Delta shl 10) div Max; // shl 10 - // take into account that sat and f are shl 10 - // the final p, q and t are unshifted + // shr 10 corrects that sat and f are shl 10 + // the resulting p, q and t are unshifted - p := (max*(1024-sat)) shr 10; - q := (max*(1024-(sat*f) shr 10)) shr 10; - t := (max*(1024-(sat*(1024-f)) shr 10)) shr 10; + p := (Max*(1024-Sat)) shr 10; + q := (Max*(1024-(Sat*f) shr 10)) shr 10; + t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10; case HueInteger of - 0: begin red := max; green := t; blue := p; end; // (v,t,p) - 1: begin red := q; green := max; blue := p; end; // (q,v,p) - 2: begin red := p; green := max; blue := t; end; // (p,v,t) - 3: begin red := p; green := q; blue := max; end; // (p,q,v) - 4: begin red := t; green := p; blue := max; end; // (t,p,v) - 5: begin red := max; green := p; blue := q; end; // (v,p,q) + 0: begin Red := Max; Green := t; Blue := p; end; // (v,t,p) + 1: begin Red := q; Green := Max; Blue := p; end; // (q,v,p) + 2: begin Red := p; Green := Max; Blue := t; end; // (p,v,t) + 3: begin Red := p; Green := q; Blue := Max; end; // (p,q,v) + 4: begin Red := t; Green := p; Blue := Max; end; // (t,p,v) + 5: begin Red := Max; Green := p; Blue := q; end; // (v,p,q) end; {$IFDEF FPC_BIG_ENDIAN} - PixelColors[3] := red ; - PixelColors[2] := green ; - PixelColors[1] := blue ; + PixelColors[3] := Red ; + PixelColors[2] := Green ; + PixelColors[1] := Blue ; {$ELSE} - PixelColors[0] := red ; - PixelColors[1] := green ; - PixelColors[2] := blue ; + PixelColors[0] := Red ; + PixelColors[1] := Green ; + PixelColors[2] := Blue ; {$ENDIF} end; -- cgit v1.2.3 From 3c9bb87abc14be7b655179752d709ac4dba106c4 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 21 Feb 2009 23:08:42 +0000 Subject: some editing, no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1595 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USkins.pas | 84 +++++++++++++++++++++++++++++------------------------ 1 file changed, 46 insertions(+), 38 deletions(-) (limited to 'src/base') diff --git a/src/base/USkins.pas b/src/base/USkins.pas index 59c590e5..30d7cbcf 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -35,23 +35,23 @@ interface type TSkinTexture = record - Name: string; - FileName: string; + Name: string; + FileName: string; end; TSkinEntry = record - Theme: string; - Name: string; - Path: string; - FileName: string; - Creator: string; // not used yet + Theme: string; + Name: string; + Path: string; + FileName: string; + Creator: string; // not used yet end; TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: string; - Color: integer; + Skin: array of TSkinEntry; + SkinTexture: array of TSkinTexture; + SkinPath: string; + Color: integer; constructor Create; procedure LoadList; procedure ParseDir(Dir: string); @@ -63,16 +63,17 @@ type end; var - Skin: TSkin; + Skin: TSkin; implementation -uses IniFiles, - Classes, - SysUtils, - UMain, - ULog, - UIni; +uses + IniFiles, + Classes, + SysUtils, + UMain, + ULog, + UIni; constructor TSkin.Create; begin @@ -84,9 +85,10 @@ end; procedure TSkin.LoadList; var - SR: TSearchRec; + SR: TSearchRec; begin - if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin + if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then + begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then ParseDir(SkinsPath + SR.Name + PathDelim); @@ -97,9 +99,10 @@ end; procedure TSkin.ParseDir(Dir: string); var - SR: TSearchRec; + SR: TSearchRec; begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin + if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then + begin repeat if (SR.Name <> '.') and (SR.Name <> '..') then @@ -111,8 +114,8 @@ end; procedure TSkin.LoadHeader(FileName: string); var - SkinIni: TMemIniFile; - S: integer; + SkinIni: TMemIniFile; + S: integer; begin SkinIni := TMemIniFile.Create(FileName); @@ -130,10 +133,10 @@ end; procedure TSkin.LoadSkin(Name: string); var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; + SkinIni: TMemIniFile; + SL: TStringList; + T: integer; + S: integer; begin S := GetSkinNumber(Name); SkinPath := Skin[S].Path; @@ -156,39 +159,43 @@ end; function TSkin.GetTextureFileName(TextureName: string): string; var - T: integer; + T: integer; begin Result := ''; for T := 0 to High(SkinTexture) do begin - if ( SkinTexture[T].Name = TextureName ) AND + if ( SkinTexture[T].Name = TextureName ) and ( SkinTexture[T].FileName <> '' ) then begin Result := SkinPath + SkinTexture[T].FileName; end; end; - if ( TextureName <> '' ) AND - ( Result <> '' ) THEN + if ( TextureName <> '' ) and + ( Result <> '' ) then begin //Log.LogError('', '-----------------------------------------'); //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); end; { Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';} + if TextureName = 'Ball' then + Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 4) = 'Gray' then + Result := SkinPath + 'Ball.bmp'; + if Copy(TextureName, 1, 6) = 'NoteBG' then + Result := SkinPath + 'Ball.bmp';} end; function TSkin.GetSkinNumber(Name: string): integer; var - S: integer; + S: integer; begin Result := 0; // set default to the first available skin for S := 0 to High(Skin) do - if Skin[S].Name = Name then Result := S; + if Skin[S].Name = Name then + Result := S; end; procedure TSkin.onThemeChange; @@ -200,7 +207,8 @@ begin SetLength(ISkin, 0); Name := Uppercase(ITheme[Ini.Theme]); for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then begin + if Name = Uppercase(Skin[S].Theme) then + begin SetLength(ISkin, Length(ISkin)+1); ISkin[High(ISkin)] := Skin[S].Name; end; -- cgit v1.2.3 From cf876ea7c40d5c5b937b5708497b1c1cfa73f58c Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 21 Feb 2009 23:35:13 +0000 Subject: typo correction and editing git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1596 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCore.pas | 190 ++++++++++++++++++++++++++--------------------------- 1 file changed, 95 insertions(+), 95 deletions(-) (limited to 'src/base') diff --git a/src/base/UCore.pas b/src/base/UCore.pas index 901f2f96..a7f9e56e 100644 --- a/src/base/UCore.pas +++ b/src/base/UCore.pas @@ -42,20 +42,20 @@ uses {********************* TCore - Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process - Also it does some Error Handling, and maybe sometime multithreaded Loading ;) + Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process + Also, it does some error handling, and maybe sometime multithreaded loading ;) *********************} type TModuleListItem = record - Module: TCoreModule; //Instance of the Modules Class - Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc - NeedsDeInit: Boolean; //True if Module was succesful inited + Module: TCoreModule; // Instance of the modules class + Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc + NeedsDeInit: boolean; // True if module was succesful inited end; TCore = class private - //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos + // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos hLoadingFinished: THandle; hMainLoop: THandle; hTranslate: THandle; @@ -72,71 +72,71 @@ type sGetModuleInfo: THandle; sGetApplicationHandle: THandle; - Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; + Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; - //Cur + Last Executed Setting and Getting ;) - iCurExecuted: Integer; - iLastExecuted: Integer; + // Cur + Last Executed Setting and Getting ;) + iCurExecuted: integer; + iLastExecuted: integer; - procedure SetCurExecuted(Value: Integer); + procedure SetCurExecuted(Value: integer); - //Function Get all Modules and Creates them - function GetModules: Boolean; + // Function Get all Modules and Creates them + function GetModules: boolean; - //Loads Core and all Modules - function Load: Boolean; + // Loads Core and all Modules + function Load: boolean; - //Inits Core and all Modules - function Init: Boolean; + // Inits Core and all Modules + function Init: boolean; - //DeInits Core and all Modules - function DeInit: Boolean; + // DeInits Core and all Modules + function DeInit: boolean; - //Load the Core - function LoadCore: Boolean; + // Load the Core + function LoadCore: boolean; - //Init the Core - function InitCore: Boolean; + // Init the Core + function InitCore: boolean; - //DeInit the Core - function DeInitCore: Boolean; + // DeInit the Core + function DeInitCore: boolean; - //Called one Time per Frame - function MainLoop: Boolean; + // Called one time per frame + function MainLoop: boolean; public - Hooks: THookManager; //Teh Hook Manager ;) - Services: TServiceManager;//The Service Manager + Hooks: THookManager; // The Hook Manager ;) + Services: TServiceManager; // The Service Manager - Name: String; //Name of this Application - Version: LongWord; //Version of this ". For Info Look PluginDefs Functions + Name: string; // Name of this application + Version: LongWord; // Version of this ". For info look plugindefs functions - LastErrorReporter:String; //Who Reported the Last Error String - LastErrorString: String; //Last Error String reported + LastErrorReporter: string; // Who reported the last error string + LastErrorString: string; // Last error string reported - property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed - property LastExecuted: Integer read iLastExecuted; + property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed + property LastExecuted: integer read iLastExecuted; //--------------- - //Main Methods to control the Core: + // Main methods to control the core: //--------------- - constructor Create(const cName: String; const cVersion: LongWord); + constructor Create(const cName: string; const cVersion: LongWord); - //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown + // Starts loading and init process. Then runs MainLoop. DeInits on shutdown procedure Run; - //Method for other Classes to get Pointer to a specific Module - function GetModulebyName(const Name: String): PCoreModule; + // Method for other classes to get pointer to a specific module + function GetModulebyName(const Name: string): PCoreModule; //-------------- - // Hook and Service Procs: + // Hook and service procs: //-------------- function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook - function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam + function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle end; @@ -154,7 +154,7 @@ uses //------------- // Create - Creates Class + Hook and Service Manager //------------- -constructor TCore.Create(const cName: String; const cVersion: LongWord); +constructor TCore.Create(const cName: string; const cVersion: LongWord); begin inherited Create; @@ -171,11 +171,11 @@ begin end; //------------- -//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown +// Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown //------------- procedure TCore.Run; var - Success: Boolean; + Success: boolean; procedure HandleError(const ErrorMsg: string); begin @@ -184,16 +184,16 @@ var else Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); - //DeInit + // DeInit DeInit; end; begin - //Get Modules + // Get modules try Success := GetModules(); except - Success := False; + Success := false; end; if (not Success) then @@ -202,11 +202,11 @@ begin Exit; end; - //Loading + // Loading try Success := Load(); except - Success := False; + Success := false; end; if (not Success) then @@ -215,11 +215,11 @@ begin Exit; end; - //Init + // Init try Success := Init(); except - Success := False; + Success := false; end; if (not Success) then @@ -228,28 +228,28 @@ begin Exit; end; - //Call Translate Hook + // Call Translate Hook if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then begin HandleError('Error translating'); Exit; end; - //Calls LoadTextures Hook + // Calls LoadTextures Hook if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then begin HandleError('Error loading textures'); Exit; end; - //Calls Loading Finished Hook + // Calls Loading Finished Hook if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then begin HandleError('Error calling LoadingFinished Hook'); Exit; end; - //Start MainLoop + // Start MainLoop while Success do begin Success := MainLoop(); @@ -258,41 +258,41 @@ begin end; //------------- -//Called one Time per Frame +// Called one time per frame //------------- -function TCore.MainLoop: Boolean; +function TCore.MainLoop: boolean; begin - Result := False; + Result := false; end; //------------- -//Function Get all Modules and Creates them +// Function get all modules and creates them //------------- -function TCore.GetModules: Boolean; +function TCore.GetModules: boolean; var - i: Integer; + i: integer; begin - Result := False; + Result := false; for i := 0 to high(Modules) do begin try - Modules[i].NeedsDeInit := False; + Modules[i].NeedsDeInit := false; Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; Modules[i].Module.Info(@Modules[i].Info); except - ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); Exit; end; end; - Result := True; + Result := true; end; //------------- -//Loads Core and all Modules +// Loads core and all modules //------------- -function TCore.Load: Boolean; +function TCore.Load: boolean; var - i: Integer; + i: integer; begin Result := LoadCore; @@ -301,23 +301,23 @@ begin try Result := Modules[i].Module.Load; except - Result := False; + Result := false; end; if (not Result) then begin - ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; end; end; //------------- -//Inits Core and all Modules +// Inits core and all modules //------------- -function TCore.Init: Boolean; +function TCore.Init: boolean; var - i: Integer; + i: integer; begin Result := InitCore; @@ -326,12 +326,12 @@ begin try Result := Modules[i].Module.Init; except - Result := False; + Result := false; end; if (not Result) then begin - ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); + ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); break; end; @@ -340,7 +340,7 @@ begin end; //------------- -//DeInits Core and all Modules +// DeInits core and all modules //------------- function TCore.DeInit: boolean; var @@ -362,9 +362,9 @@ begin end; //------------- -//Load the Core +// Load the Core //------------- -function TCore.LoadCore: Boolean; +function TCore.LoadCore: boolean; begin hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); hMainLoop := Hooks.AddEvent('Core/MainLoop'); @@ -383,35 +383,35 @@ begin sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); - //A little Test + // A little Test Hooks.AddSubscriber('Core/NewError', HookTest); result := true; end; //------------- -//Init the Core +// Init the Core //------------- -function TCore.InitCore: Boolean; +function TCore.InitCore: boolean; begin //Don not init something atm. result := true; end; //------------- -//DeInit the Core +// DeInit the Core //------------- -function TCore.DeInitCore: Boolean; +function TCore.DeInitCore: boolean; begin - // TODO: write TService-/HookManager.Free and call it here + // TODO: write TService-/HookManager. Free and call it here Result := true; end; //------------- -//Method for other classes to get pointer to a specific module +// Method for other classes to get pointer to a specific module //------------- -function TCore.GetModuleByName(const Name: String): PCoreModule; -var i: Integer; +function TCore.GetModuleByName(const Name: string): PCoreModule; +var i: integer; begin Result := nil; for i := 0 to High(Modules) do @@ -444,7 +444,7 @@ begin CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; end; - //Show: + // Show: Result := Messagebox(0, lParam, PChar(Name), Params); end; {$ENDIF} @@ -458,8 +458,8 @@ end; function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; begin //Update LastErrorReporter and LastErrorString - LastErrorReporter := String(PChar(lParam)); - LastErrorString := String(PChar(Pointer(wParam))); + LastErrorReporter := string(PChar(lParam)); + LastErrorString := string(PChar(Pointer(wParam))); Hooks.CallEventChain(hError, wParam, lParam); @@ -501,7 +501,7 @@ begin end; //------------- -// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam +// If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam //------------- function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; var @@ -538,12 +538,12 @@ end; //------------- // Called when setting CurExecuted //------------- -procedure TCore.SetCurExecuted(Value: Integer); +procedure TCore.SetCurExecuted(Value: integer); begin - //Set Last Executed + // Set Last Executed iLastExecuted := iCurExecuted; - //Set Cur Executed + // Set Cur Executed iCurExecuted := Value; end; -- cgit v1.2.3 From 368bd77efc348fbfa4bdf5babd514543a71726d6 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 22 Feb 2009 00:36:39 +0000 Subject: type adjustment git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1598 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTexture.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 8fb03bde..962bd2b0 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -249,8 +249,8 @@ end; function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; var TexSurface: PSDL_Surface; - newWidth, newHeight: cardinal; - oldWidth, oldHeight: cardinal; + newWidth, newHeight: integer; + oldWidth, oldHeight: integer; ActTex: GLuint; begin // zero texture data -- cgit v1.2.3 From c12b017d4d4184a804c5f092dbad4fd7a3a97d40 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 22 Feb 2009 01:02:47 +0000 Subject: formatting git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1599 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 127 ++++++++++++++++++++++++--------------------------- 1 file changed, 59 insertions(+), 68 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 00d82abb..ec6935bd 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -44,17 +44,17 @@ uses const BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) - NumHalftones = 36; // C2-B4 (for Whitney and my high voice) + NumHalftones = 36; // C2-B4 (for Whitney and my high voice) type TCaptureBuffer = class private - VoiceStream: TAudioVoiceStream; // stream for voice passthrough + VoiceStream: TAudioVoiceStream; // stream for voice passthrough AnalysisBufferLock: PSDL_Mutex; function GetToneString: string; // converts a tone to its string represenatation; - procedure BoostBuffer(Buffer: PByteArray; Size: Cardinal); + procedure BoostBuffer(Buffer: PByteArray; Size: cardinal); procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); // we call it to analyze sound by checking Autocorrelation @@ -86,7 +86,7 @@ type procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - function MaxSampleVolume: Single; + function MaxSampleVolume: single; property ToneString: string READ GetToneString; end; @@ -95,17 +95,17 @@ const type TAudioInputSource = record - Name: string; + Name: string; end; // soundcard input-devices information TAudioInputDevice = class public - CfgIndex: integer; // index of this device in Ini.InputDeviceConfig - Name: string; // soundcard name - Source: array of TAudioInputSource; // soundcard input-sources - SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) - MicSource: integer; // source-index of mic (-1: none detected) + CfgIndex: integer; // index of this device in Ini.InputDeviceConfig + Name: string; // soundcard name + Source: array of TAudioInputSource; // soundcard input-sources + SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) + MicSource: integer; // source-index of mic (-1: none detected) 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 @@ -115,10 +115,10 @@ type procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); // TODO: add Open/Close functions so Start/Stop becomes faster - //function Open(): boolean; virtual; abstract; - //function Close(): boolean; virtual; abstract; - function Start(): boolean; virtual; abstract; - function Stop(): boolean; virtual; abstract; + //function Open(): boolean; virtual; abstract; + //function Close(): boolean; virtual; abstract; + function Start(): boolean; virtual; abstract; + function Stop(): boolean; virtual; abstract; function GetVolume(): single; virtual; abstract; procedure SetVolume(Volume: single); virtual; abstract; @@ -135,7 +135,7 @@ type procedure UpdateInputDeviceConfig; // handle microphone input - procedure HandleMicrophoneData(Buffer: PByteArray; Size: Cardinal; + procedure HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice); end; @@ -153,7 +153,6 @@ type procedure CaptureStop; end; - TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; PSmallIntArray = ^TSmallIntArray; @@ -168,7 +167,6 @@ uses var singleton_AudioInputProcessor : TAudioInputProcessor = nil; - { Global } function AudioInputProcessor(): TAudioInputProcessor; @@ -179,7 +177,6 @@ begin result := singleton_AudioInputProcessor; end; - { TAudioInputDevice } destructor TAudioInputDevice.Destroy; @@ -271,8 +268,8 @@ end; procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); var BufferOffset: integer; - SampleCount: integer; - i: integer; + SampleCount: integer; + i: integer; begin // apply software boost BoostBuffer(Buffer, BufferSize); @@ -299,7 +296,6 @@ begin SampleCount := Length(AnalysisBuffer); end; - LockAnalysisBuffer(); try @@ -315,7 +311,6 @@ begin UnlockAnalysisBuffer(); end; - // save capture-data to BufferLong if enabled if (Ini.SavePlayback = 1) then begin @@ -329,10 +324,10 @@ end; procedure TCaptureBuffer.AnalyzeBuffer; var - Volume: single; - MaxVolume: single; + Volume: single; + MaxVolume: single; SampleIndex: integer; - Threshold: single; + Threshold: single; begin ToneValid := false; ToneAbs := -1; @@ -431,10 +426,10 @@ begin Result := 1 - AccumDist / AnalysisBufferSize; end; -function TCaptureBuffer.MaxSampleVolume: Single; +function TCaptureBuffer.MaxSampleVolume: single; var - lSampleIndex: Integer; - lMaxVol : Longint; + lSampleIndex: integer; + lMaxVol: longint; begin; LockAnalysisBuffer(); try @@ -464,13 +459,13 @@ begin Result := '-'; end; -procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: Cardinal); +procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: cardinal); var - i: integer; - Value: Longint; - SampleCount: integer; + i: integer; + Value: longint; + SampleCount: integer; SampleBuffer: PSmallIntArray; // buffer handled as array of samples - Boost: byte; + Boost: byte; begin // TODO: set boost per device case Ini.MicBoost of @@ -504,7 +499,6 @@ begin end; end; - { TAudioInputProcessor } constructor TAudioInputProcessor.Create; @@ -531,14 +525,14 @@ end; // See: TIni.LoadInputDeviceCfg() procedure TAudioInputProcessor.UpdateInputDeviceConfig; var - deviceIndex: integer; - newDevice: boolean; + deviceIndex: integer; + newDevice: boolean; deviceIniIndex: integer; - deviceCfg: PInputDeviceConfig; - device: TAudioInputDevice; - channelCount: integer; - channelIndex: integer; - i: integer; + deviceCfg: PInputDeviceConfig; + device: TAudioInputDevice; + channelCount: integer; + channelIndex: integer; + i: integer; begin // Input devices - append detected soundcards for deviceIndex := 0 to High(DeviceList) do @@ -608,18 +602,18 @@ end; * Length - number of bytes in Buffer * Input - Soundcard-Input used for capture *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: Cardinal; InputDevice: TAudioInputDevice); +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice); var - MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) - SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel + MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) + SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel SingleChannelBufferSize: integer; - ChannelIndex: integer; - CaptureChannel: TCaptureBuffer; - AudioFormat: TAudioFormatInfo; - SampleSize: integer; - SampleCount: integer; - SamplesPerChannel: integer; - i: integer; + ChannelIndex: integer; + CaptureChannel: TCaptureBuffer; + AudioFormat: TAudioFormatInfo; + SampleSize: integer; + SampleCount: integer; + SamplesPerChannel: integer; + i: integer; begin AudioFormat := InputDevice.AudioFormat; SampleSize := AudioSampleSize[AudioFormat.Format]; @@ -638,7 +632,7 @@ begin begin // set offset according to channel index MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; - // seperate channel-data from interleaved multi-channel (e.g. stereo) data + // separate channel-data from interleaved multi-channel (e.g. stereo) data for i := 0 to SamplesPerChannel-1 do begin Move(MultiChannelBuffer[i*AudioFormat.FrameSize], @@ -652,7 +646,6 @@ begin FreeMem(SingleChannelBuffer); end; - { TAudioInputBase } function TAudioInputBase.FinalizeRecord: boolean; @@ -670,13 +663,13 @@ end; *} procedure TAudioInputBase.CaptureStart; var - S: integer; - DeviceIndex: integer; + S: integer; + DeviceIndex: integer; ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; - DeviceUsed: boolean; - Player: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + DeviceUsed: boolean; + Player: integer; begin if (Started) then CaptureStop(); @@ -728,10 +721,10 @@ end; *} procedure TAudioInputBase.CaptureStop; var - DeviceIndex: integer; + DeviceIndex: integer; ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; begin for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do begin @@ -758,17 +751,18 @@ var var i: integer; begin - Result := False; + Result := false; // search devices with same description - For i := 0 to deviceIndex-1 do + for i := 0 to deviceIndex-1 do begin if (AudioInputProcessor.DeviceList[i].Name = name) then begin - Result := True; + Result := true; Break; end; end; end; + begin count := 1; result := name; @@ -783,6 +777,3 @@ begin end; end. - - - -- cgit v1.2.3 From df7cf482ae0c739e3439b22cc4cdb0bb0c1d97bd Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 22 Feb 2009 01:03:55 +0000 Subject: index changed from cardinal to integer. prevents 64 bit integers and warning git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1600 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPluginLoader.pas | 137 ++++++++++++++++++++++----------------------- 1 file changed, 66 insertions(+), 71 deletions(-) (limited to 'src/base') diff --git a/src/base/UPluginLoader.pas b/src/base/UPluginLoader.pas index 5e581c23..bb8a9aa5 100644 --- a/src/base/UPluginLoader.pas +++ b/src/base/UPluginLoader.pas @@ -46,9 +46,9 @@ uses type TPluginListItem = record Info: TUS_PluginInfo; - State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error - Path: String; // path to this plugin - NeedsDeInit: Boolean; // if this is inited correctly this should be true + State: byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error + Path: string; // path to this plugin + NeedsDeInit: boolean; // if this is inited correctly this should be true hLib: THandle; // handle of loaded libary Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader Load: Func_Load; @@ -63,13 +63,13 @@ type PPluginLoader = ^TPluginLoader; TPluginLoader = class (TCoreModule) private - LoadingProcessFinished: Boolean; + LoadingProcessFinished: boolean; sUnloadPlugin: THandle; sLoadPlugin: THandle; sGetPluginInfo: THandle; sGetPluginState: THandle; - procedure FreePlugin(Index: Cardinal); + procedure FreePlugin(Index: integer); public PluginInterface: TUS_PluginInterface; Plugins: array of TPluginListItem; @@ -77,19 +77,19 @@ type // TCoreModule methods to inherit constructor Create; override; procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; + function Load: boolean; override; + function Init: boolean; override; procedure DeInit; override; Destructor Destroy; override; // New methods - procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins - function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1 - procedure AddPlugin(Filename: String); // adds plugin to the array + procedure BrowseDir(Path: string); // browses the path at _Path_ for plugins + function PluginExists(Name: string): integer; // if plugin exists: Index of plugin, else -1 + procedure AddPlugin(Filename: string); // adds plugin to the array - function CallLoad(Index: Cardinal): integer; - function CallInit(Index: Cardinal): integer; - procedure CallDeInit(Index: Cardinal); + function CallLoad(Index: integer): integer; + function CallInit(Index: integer): integer; + procedure CallDeInit(Index: integer); //Services offered function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin @@ -110,10 +110,10 @@ type public // TCoreModule methods to inherit constructor Create; override; - + procedure Info(const pInfo: PModuleInfo); override; - function Load: Boolean; override; - function Init: Boolean; override; + function Load: boolean; override; + function Init: boolean; override; procedure DeInit; override; end; @@ -176,7 +176,7 @@ begin PluginInterface.ServiceExists := ServiceExists; // UnSet private var - LoadingProcessFinished := False; + LoadingProcessFinished := false; end; //------------- @@ -185,15 +185,15 @@ end; // to offer them to other modules or plugins during the init process // if false is returned this will cause a forced exit //------------- -function TPluginLoader.Load: Boolean; +function TPluginLoader.Load: boolean; begin - Result := True; + Result := true; try // Start searching for plugins BrowseDir(PluginPath); except - Result := False; + Result := false; Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); end; end; @@ -204,11 +204,11 @@ end; // your classes, variables etc. // If false is returned this will cause a forced exit //------------- -function TPluginLoader.Init: Boolean; +function TPluginLoader.Init: boolean; begin // Just set private var to true. - LoadingProcessFinished := True; - Result := True; + LoadingProcessFinished := true; + Result := true; end; //------------- @@ -244,7 +244,7 @@ end; //-------------- // Browses the path at _Path_ for plugins //-------------- -procedure TPluginLoader.BrowseDir(Path: String); +procedure TPluginLoader.BrowseDir(Path: string); var SR: TSearchRec; begin @@ -256,7 +256,7 @@ begin until FindNext(SR) <> 0; end; FindClose(SR); - + // Search for plugins at path if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then begin @@ -266,11 +266,11 @@ begin end; FindClose(SR); end; - + //-------------- // If plugin exists: Index of plugin, else -1 //-------------- -function TPluginLoader.PluginExists(Name: String): integer; +function TPluginLoader.PluginExists(Name: string): integer; var I: integer; begin @@ -286,11 +286,11 @@ begin end; end; end; - + //-------------- // Adds plugin to the array //-------------- -procedure TPluginLoader.AddPlugin(Filename: String); +procedure TPluginLoader.AddPlugin(Filename: string); var hLib: THandle; PInfo: Proc_PluginInfo; @@ -332,7 +332,7 @@ begin Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].NeedsDeInit := false; Plugins[PluginID].hLib := hLib; // Try to get procs @@ -340,7 +340,7 @@ begin Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then begin Plugins[PluginID].State := 255; FreeLibrary(hLib); @@ -354,11 +354,11 @@ begin CallInit(PluginID); end; end - else if (LoadingProcessFinished = False) then + else if (LoadingProcessFinished = false) then begin if (Plugins[PluginID].Info.Version < Info.Version) then begin // Found newer version of this plugin - Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader')); + Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + string(Info.Name))), PChar('TPluginLoader')); // Unload old plugin UnloadPlugin(PluginID, nil); @@ -367,7 +367,7 @@ begin Plugins[PluginID].Info := Info; Plugins[PluginID].State := 0; Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := False; + Plugins[PluginID].NeedsDeInit := false; Plugins[PluginID].hLib := hLib; // Try to get procs @@ -375,7 +375,7 @@ begin Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then + if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then begin FreeLibrary(hLib); Plugins[PluginID].State := 255; @@ -390,7 +390,7 @@ begin else begin FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Plugin with this name already exists: ' + string(Info.Name))), PChar('TPluginLoader')); end; end else @@ -413,7 +413,7 @@ end; //-------------- // Calls load func of plugin with the given index //-------------- -function TPluginLoader.CallLoad(Index: Cardinal): integer; +function TPluginLoader.CallLoad(Index: integer): integer; begin Result := -2; if(Index < Length(Plugins)) then @@ -424,7 +424,7 @@ begin Result := Plugins[Index].Procs.Load(@PluginInterface); except Result := -3; - End; + end; if (Result = 0) then Plugins[Index].State := 1 @@ -432,7 +432,7 @@ begin begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling load function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -441,7 +441,7 @@ end; //-------------- // Calls init func of plugin with the given index //-------------- -function TPluginLoader.CallInit(Index: Cardinal): integer; +function TPluginLoader.CallInit(Index: integer): integer; begin Result := -2; if(Index < Length(Plugins)) then @@ -452,18 +452,18 @@ begin Result := Plugins[Index].Procs.Init(@PluginInterface); except Result := -3; - End; - + end; + if (Result = 0) then begin Plugins[Index].State := 2; - Plugins[Index].NeedsDeInit := True; + Plugins[Index].NeedsDeInit := true; end else begin FreePlugin(Index); Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader')); + Core.ReportError(integer(PChar('Error calling init function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); end; end; end; @@ -472,7 +472,7 @@ end; //-------------- // Calls deinit proc of plugin with the given index //-------------- -procedure TPluginLoader.CallDeInit(Index: Cardinal); +procedure TPluginLoader.CallDeInit(Index: integer); begin if(Index < Length(Plugins)) then begin @@ -483,7 +483,7 @@ begin Plugins[Index].Procs.DeInit(@PluginInterface); except - End; + end; // Don't forget to remove services and subscriptions by this plugin Core.Hooks.DelbyOwner(-1 - Index); @@ -496,7 +496,7 @@ end; //-------------- // Frees all plugin sources (procs and handles) - helper for deiniting functions //-------------- -procedure TPluginLoader.FreePlugin(Index: Cardinal); +procedure TPluginLoader.FreePlugin(Index: integer); begin Plugins[Index].State := 4; Plugins[Index].Procs.Load := nil; @@ -507,15 +507,13 @@ begin FreeLibrary(Plugins[Index].hLib); end; - - //-------------- // wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin //-------------- function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: integer; - sFile: String; + sFile: string; begin Result := -1; sFile := ''; @@ -527,9 +525,9 @@ begin else begin //lParam is PChar try - sFile := String(PChar(lParam)); + sFile := string(PChar(lParam)); Index := PluginExists(sFile); - if (Index < 0) And FileExists(sFile) then + if (Index < 0) and FileExists(sFile) then begin // Is filename AddPlugin(sFile); Result := Plugins[High(Plugins)].State; @@ -539,7 +537,6 @@ begin end; end; - if (Index >= 0) and (Index < Length(Plugins)) then begin AddPlugin(Plugins[Index].Path); @@ -553,7 +550,7 @@ end; function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; var Index: integer; - sName: String; + sName: string; begin Result := -1; // lParam is ID @@ -564,14 +561,13 @@ begin else begin // wParam is PChar try - sName := String(PChar(lParam)); + sName := string(PChar(lParam)); Index := PluginExists(sName); except Index := -2; end; end; - if (Index >= 0) and (Index < Length(Plugins)) then CallDeInit(Index) end; @@ -592,7 +588,7 @@ begin PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; except - End; + end; end; end else if (lParam = nil) then @@ -607,13 +603,13 @@ begin Result := Length(Plugins); except Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); - End; + end; end; end; //-------------- -// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam)) +// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of byte to address at lparam) else (return state of plugin with index(wParam)) //-------------- function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; var I: integer; @@ -634,15 +630,14 @@ begin begin try for I := 0 to high(Plugins) do - Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; + byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; Result := Length(Plugins); except Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); - End; + end; end; end; - {********************* TtehPlugins Implementation @@ -673,7 +668,7 @@ end; // to offer them to other modules or plugins during the init process // if false is returned this will cause a forced exit //------------- -function TtehPlugins.Load: Boolean; +function TtehPlugins.Load: boolean; var i: integer; // Counter CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute @@ -703,11 +698,11 @@ begin begin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 254; // Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else begin - Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; except // Plugin could not be loaded. @@ -721,7 +716,7 @@ begin end; end; - // Reset CurExecuted + // Reset CurExecuted Core.CurExecuted := CurExecutedBackup; end; end; @@ -732,7 +727,7 @@ end; // your classes, variables etc. // if false is returned this will cause a forced exit //------------- -function TtehPlugins.Init: Boolean; +function TtehPlugins.Init: boolean; var i: integer; // Counter CurExecutedBackup: integer; // backup of Core.CurExecuted attribute @@ -752,16 +747,16 @@ begin begin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end else - Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); except // Plugin could not be loaded. // => Show error message, then shut down plugin PluginLoader.CallDeInit(i); PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); + Core.ReportError(integer(PChar('Plugin causes error during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); end; // Reset CurExecuted @@ -781,7 +776,7 @@ begin CurExecutedBackup := Core.CurExecuted; // Start loop - + for i := 0 to High(PluginLoader.Plugins) do begin try -- cgit v1.2.3 From 6b3781e4323e1568c5f86ecaeb244a32995dc330 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 23 Feb 2009 22:12:13 +0000 Subject: Formatting as a start :-) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1601 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 155 +++++++++++++++++++++++++---------------------------- 1 file changed, 74 insertions(+), 81 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 6300f18b..d2f523e4 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -51,12 +51,12 @@ uses type PPLayerNote = ^TPlayerNote; TPlayerNote = record - Start: integer; - Length: integer; - Detect: real; // accurate place, detected in the note - Tone: real; - Perfect: boolean; // true if the note matches the original one, lit the star - Hit: boolean; // true if the note Hits the Line + Start: integer; + Length: integer; + Detect: real; // accurate place, detected in the note + Tone: real; + Perfect: boolean; // true if the note matches the original one, lit the star + Hit: boolean; // true if the note Hits the Line end; PPLayer = ^TPlayer; @@ -64,8 +64,8 @@ type Name: string; // Index in Teaminfo record - TeamID: Byte; - PlayerID: Byte; + TeamID: byte; + PlayerID: byte; // Scores Score: real; @@ -78,17 +78,16 @@ type ScoreTotalInt: integer; // LineBonus - ScoreLast: Real;//Last Line Score + ScoreLast: real; / /Last Line Score // PerfectLineTwinkle (effect) - LastSentencePerfect: Boolean; + LastSentencePerfect: boolean; HighNote: integer; // index of last note (= High(Note)?) LengthNote: integer; // number of notes (= Length(Note)?). Note: array of TPlayerNote; end; - var // Absolute Paths GamePath: string; @@ -106,22 +105,21 @@ var ResourcesPath: string; PlayListPath: string; - Done: Boolean; + Done: boolean; // FIXME: ConversionFileName should not be global ConversionFileName: string; Restart: boolean; // player and music info - Player: array of TPlayer; - PlayersPlay: integer; + Player: array of TPlayer; + PlayersPlay: integer; - CurrentSong : TSong; + CurrentSong: TSong; const MAX_SONG_SCORE = 10000; // max. achievable points per song MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song - function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; procedure InitializePaths; procedure AddSongPath(const Path: string); @@ -131,14 +129,13 @@ procedure MainLoop; procedure CheckEvents; procedure Sing(Screen: TScreenSing); procedure NewSentence(Screen: TScreenSing); -procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click +procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection -procedure NewNote(Screen: TScreenSing); // detect note +procedure NewNote(Screen: TScreenSing); // detect note function GetMidBeat(Time: real): real; function GetTimeFromBeat(Beat: integer): real; procedure ClearScores(PlayerNum: integer); - type TMainThreadExecProc = procedure(Data: Pointer); @@ -155,7 +152,6 @@ const *} procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); - implementation uses @@ -182,9 +178,6 @@ uses UPlatform, UThemes; - - - procedure Main; var WndTitle: string; @@ -370,7 +363,7 @@ begin Log.LogBenchmark('Loading Particle System', 1); // Joypad - if (Ini.Joypad = 1) OR (Params.Joypad) then + if (Ini.Joypad = 1) or (Params.Joypad) then begin Log.BenchmarkStart(1); Log.LogStatus('Initialize Joystick', 'Initialization'); @@ -428,7 +421,7 @@ end; procedure MainLoop; var - Delay: integer; + Delay: integer; const MAX_FPS = 100; begin @@ -466,7 +459,7 @@ begin end; end; -End; +end; procedure CheckEvents; var @@ -474,7 +467,7 @@ var begin if Assigned(Display.NextScreen) then Exit; - + while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -482,7 +475,7 @@ begin begin Display.Fade := 0; Display.NextScreenWithCheck := nil; - Display.CheckOK := True; + Display.CheckOK := true; end; SDL_MOUSEBUTTONDOWN: begin @@ -547,13 +540,13 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True) + done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) else begin // check if screen wants to exit - done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True); + done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true); // if screen wants to exit if done then @@ -567,7 +560,7 @@ begin begin Display.Fade := 0; Display.NextScreenWithCheck := nil; - Display.CheckOK := True; + Display.CheckOK := true; end; end; @@ -616,7 +609,7 @@ end; procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); var - NewTime: real; + NewTime: real; begin if High(CurrentSong.BPM) = BPMNum then begin @@ -648,8 +641,8 @@ end; function GetMidBeat(Time: real): real; var - CurBeat: real; - CurBPM: integer; + CurBeat: real; + CurBPM: integer; begin // static BPM if Length(CurrentSong.BPM) = 1 then @@ -678,7 +671,7 @@ end; function GetTimeFromBeat(Beat: integer): real; var - CurBPM: integer; + CurBPM: integer; begin // static BPM if Length(CurrentSong.BPM) = 1 then @@ -728,10 +721,10 @@ end; procedure Sing(Screen: TScreenSing); var - Count: integer; - CountGr: integer; - CP: integer; - N: integer; + Count: integer; + CountGr: integer; + CP: integer; + N: integer; begin LyricsState.UpdateBeats(); @@ -749,7 +742,7 @@ begin Lines[CP].Current := Count; end; - // clean player note if there is a new line + // clean player note if there is a new line // (optimization on halfbeat time) if Lines[CP].Current <> LyricsState.OldLine then NewSentence(Screen); @@ -767,7 +760,7 @@ end; procedure NewSentence(Screen: TScreenSing); var - i: Integer; + i: integer; begin // clean note of player for i := 0 to High(Player) do @@ -783,7 +776,7 @@ end; procedure NewBeatClick; var - Count: integer; + Count: integer; begin // beat click if ((Ini.BeatClick = 1) and @@ -802,7 +795,7 @@ begin // drum machine (* - TempBeat := LyricsState.CurrentBeat;// + 2; + TempBeat := LyricsState.CurrentBeat; // + 2; if (TempBeat mod 8 = 0) then Music.PlayDrum; if (TempBeat mod 8 = 4) then Music.PlayClap; //if (TempBeat mod 4 = 2) then Music.PlayHihat; @@ -819,23 +812,23 @@ end; procedure NewNote(Screen: TScreenSing); var - LineFragmentIndex: integer; + LineFragmentIndex: integer; CurrentLineFragment: PLineFragment; - PlayerIndex: integer; - CurrentSound: TCaptureBuffer; - CurrentPlayer: PPlayer; - LastPlayerNote: PPlayerNote; - Line: PLine; - SentenceIndex: integer; - SentenceMin: integer; - SentenceMax: integer; - SentenceDetected: integer; // sentence of detected note - NoteAvailable: boolean; - NewNote: boolean; - Range: integer; - NoteHit: boolean; - MaxSongPoints: integer; // max. points for the song (without line bonus) - MaxLinePoints: Real; // max. points for the current line + PlayerIndex: integer; + CurrentSound: TCaptureBuffer; + CurrentPlayer: PPlayer; + LastPlayerNote: PPlayerNote; + Line: PLine; + SentenceIndex: integer; + SentenceMin: integer; + SentenceMax: integer; + SentenceDetected: integer; // sentence of detected note + NoteAvailable: boolean; + NewNote: boolean; + Range: integer; + NoteHit: boolean; + MaxSongPoints: integer; // max. points for the song (without line bonus) + MaxLinePoints: real; // max. points for the current line begin // TODO: add duet mode support // use Lines[LineSetIndex] with LineSetIndex depending on the current player @@ -858,8 +851,8 @@ begin // check if line is active if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 begin SentenceDetected := SentenceIndex; NoteAvailable := true; @@ -869,7 +862,7 @@ begin // TODO: break here, if NoteAvailable is true? We would then use the first instead // of the last note matching the current beat if notes overlap. But notes // should not overlap at all. - //if (NoteAvailable) then + // if (NoteAvailable) then // Break; end; @@ -896,7 +889,7 @@ begin if (CurrentSound.ToneValid and NoteAvailable) then begin Line := @Lines[0].Line[SentenceDetected]; - + // process until last note for LineFragmentIndex := 0 to Line.HighNote do begin @@ -916,9 +909,9 @@ begin // half size notes patch NoteHit := false; - //if Ini.Difficulty = 0 then Range := 2; - //if Ini.Difficulty = 1 then Range := 1; - //if Ini.Difficulty = 2 then Range := 0; + // if Ini.Difficulty = 0 then Range := 2; + // if Ini.Difficulty = 1 then Range := 1; + // if Ini.Difficulty = 2 then Range := 0; Range := 2 - Ini.Difficulty; // check if the player hit the correct tone within the tolerated range @@ -942,8 +935,8 @@ begin // FIXME: is this correct? Why do we add the points for a whole line // if just one note is correct? case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; end; CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; @@ -1009,9 +1002,9 @@ begin for LineFragmentIndex := 0 to Line.HighNote do begin CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start = LastPlayerNote.Start) and + if (CurrentLineFragment.Start = LastPlayerNote.Start) and (CurrentLineFragment.Length = LastPlayerNote.Length) and - (CurrentLineFragment.Tone = LastPlayerNote.Tone) then + (CurrentLineFragment.Tone = LastPlayerNote.Tone) then begin LastPlayerNote.Perfect := true; end; @@ -1042,18 +1035,18 @@ procedure ClearScores(PlayerNum: integer); begin with Player[PlayerNum] do begin - Score := 0; - ScoreLine := 0; - ScoreGolden := 0; + Score := 0; + ScoreLine := 0; + ScoreGolden := 0; - ScoreInt := 0; - ScoreLineInt := 0; - ScoreGoldenInt:= 0; - ScoreTotalInt := 0; + ScoreInt := 0; + ScoreLineInt := 0; + ScoreGoldenInt := 0; + ScoreTotalInt := 0; - ScoreLast := 0; + ScoreLast := 0; - LastSentencePerfect := False; + LastSentencePerfect := false; end; end; @@ -1156,7 +1149,7 @@ begin // Playlists are not shared as we need one directory to write too FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); - + // Screenshot directory (must be writable) if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then begin -- cgit v1.2.3 From 8c9a846e766d4eeb85c8cab4f51dd602fca5ae66 Mon Sep 17 00:00:00 2001 From: canni0 Date: Mon, 23 Feb 2009 23:21:03 +0000 Subject: - fixed compilation error from r1601 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1602 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index d2f523e4..95e696fa 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -78,7 +78,7 @@ type ScoreTotalInt: integer; // LineBonus - ScoreLast: real; / /Last Line Score + ScoreLast: real; //Last Line Score // PerfectLineTwinkle (effect) LastSentencePerfect: boolean; -- cgit v1.2.3 From d8065f7bbda6bf97b6bca621b8cba39663c4fcd7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 23 Feb 2009 23:38:14 +0000 Subject: more formatting git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1603 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 37 +++++++++++++++++++------------------ 1 file changed, 19 insertions(+), 18 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 95e696fa..66a0823b 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -61,16 +61,16 @@ type PPLayer = ^TPlayer; TPlayer = record - Name: string; + Name: string; // Index in Teaminfo record - TeamID: byte; - PlayerID: byte; + TeamID: byte; + PlayerID: byte; // Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; + Score: real; + ScoreLine: real; + ScoreGolden: real; ScoreInt: integer; ScoreLineInt: integer; @@ -78,14 +78,14 @@ type ScoreTotalInt: integer; // LineBonus - ScoreLast: real; //Last Line Score + ScoreLast: real; // Last Line Score // PerfectLineTwinkle (effect) LastSentencePerfect: boolean; - HighNote: integer; // index of last note (= High(Note)?) - LengthNote: integer; // number of notes (= Length(Note)?). - Note: array of TPlayerNote; + HighNote: integer; // index of last note (= High(Note)?) + LengthNote: integer; // number of notes (= Length(Note)?). + Note: array of TPlayerNote; end; var @@ -105,10 +105,10 @@ var ResourcesPath: string; PlayListPath: string; - Done: boolean; + Done: boolean; // FIXME: ConversionFileName should not be global ConversionFileName: string; - Restart: boolean; + Restart: boolean; // player and music info Player: array of TPlayer; @@ -833,7 +833,8 @@ begin // TODO: add duet mode support // use Lines[LineSetIndex] with LineSetIndex depending on the current player - // count min and max sentence range for checking (detection is delayed to the notes we see on the screen) + // count min and max sentence range for checking + // (detection is delayed to the notes we see on the screen) SentenceMin := Lines[0].Current-1; if (SentenceMin < 0) then SentenceMin := 0; @@ -851,8 +852,8 @@ begin // check if line is active if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1 + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1 begin SentenceDetected := SentenceIndex; NoteAvailable := true; @@ -935,7 +936,7 @@ begin // FIXME: is this correct? Why do we add the points for a whole line // if just one note is correct? case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; end; @@ -956,7 +957,7 @@ begin // we will add a new note NewNote := true; - // if previous note (if any) was the same, extend prrevious note + // if previous note (if any) was the same, extend previous note if ((CurrentPlayer.LengthNote > 0) and (LastPlayerNote <> nil) and (LastPlayerNote.Tone = CurrentSound.Tone) and @@ -998,7 +999,7 @@ begin Inc(LastPlayerNote.Length); end; - // check for perfect note and then lit the star (on Draw) + // check for perfect note and then light the star (on Draw) for LineFragmentIndex := 0 to Line.HighNote do begin CurrentLineFragment := @Line.Note[LineFragmentIndex]; -- cgit v1.2.3 From 56d8cca83d92cfbfde7c6c295027d254610329bb Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 23 Feb 2009 23:40:22 +0000 Subject: serious code change. First trial to fix the score calculations. Please test git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1604 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 66a0823b..5e346456 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -829,7 +829,11 @@ var NoteHit: boolean; MaxSongPoints: integer; // max. points for the song (without line bonus) MaxLinePoints: real; // max. points for the current line + ScoreFactor: array[TNoteType] of integer; begin + ScoreFactor[ntFreestyle] := 0; + ScoreFactor[ntNormal] := 1; + ScoreFactor[ntGolden] := 2; // TODO: add duet mode support // use Lines[LineSetIndex] with LineSetIndex depending on the current player @@ -931,7 +935,7 @@ begin MaxSongPoints := MAX_SONG_SCORE; // Note: ScoreValue is the sum of all note values of the song - MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue; + MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue * ScoreFactor[CurrentLineFragment.NoteType]; // FIXME: is this correct? Why do we add the points for a whole line // if just one note is correct? -- cgit v1.2.3 From c0659c805a2af7af7689ba90ccc264b3d5c681a3 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 25 Feb 2009 23:52:50 +0000 Subject: formatting only git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1605 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 5e346456..c96ffac0 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -55,8 +55,8 @@ type Length: integer; Detect: real; // accurate place, detected in the note Tone: real; - Perfect: boolean; // true if the note matches the original one, lit the star - Hit: boolean; // true if the note Hits the Line + Perfect: boolean; // true if the note matches the original one, light the star + Hit: boolean; // true if the note hits the line end; PPLayer = ^TPlayer; @@ -203,11 +203,11 @@ begin DecimalSeparator := '.'; //------------------------------ - //StartUp - Create Classes and Load Files + // StartUp - Create Classes and Load Files //------------------------------ - // Initialize SDL - // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values + // initialize SDL + // without SDL_INIT_TIMER SDL_GetTicks() might return strange values SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); SDL_EnableUnicode(1); @@ -230,7 +230,7 @@ begin Log.LogStatus('Load Language', 'Initialization'); Language := TLanguage.Create; - // Add Const Values: + // add const values: Language.AddConst('US_VERSION', USDXVersionStr); Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Language', 1); @@ -388,7 +388,7 @@ begin //Core.Run; //------------------------------ - //Start- Mainloop + // Start Mainloop //------------------------------ Log.LogStatus('Main Loop', 'Initialization'); MainLoop; @@ -397,12 +397,12 @@ begin finally {$ENDIF} //------------------------------ - //Finish Application + // Finish Application //------------------------------ // TODO: // call an uninitialize routine for every initialize step - // or at least use the corresponding Free-Methods + // or at least use the corresponding Free methods FinalizeMedia(); @@ -877,7 +877,7 @@ begin CurrentPlayer := @Player[PlayerIndex]; CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - // At the beginning of the song there is no previous note + // at the beginning of the song there is no previous note if (Length(CurrentPlayer.Note) > 0) then LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] else -- cgit v1.2.3 From df33af2458e7fb7e42707e432d8ecacc4e2511df Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 28 Feb 2009 17:38:56 +0000 Subject: Cosmetics: rename WndTitle to WindowTitle git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1607 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index c96ffac0..65e55c1d 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -180,16 +180,16 @@ uses procedure Main; var - WndTitle: string; + WindowTitle: string; begin {$IFNDEF Debug} try {$ENDIF} - WndTitle := USDXVersionStr; + WindowTitle := USDXVersionStr; Platform.Init; - if Platform.TerminateIfAlreadyRunning(WndTitle) then + if Platform.TerminateIfAlreadyRunning(WindowTitle) then Exit; // fix floating-point exceptions (FPE) @@ -219,7 +219,7 @@ begin // Log + Benchmark Log := TLog.Create; - Log.Title := WndTitle; + Log.Title := WindowTitle; Log.FileOutputEnabled := not Params.NoLog; Log.BenchmarkStart(0); @@ -331,7 +331,7 @@ begin // Graphics Log.BenchmarkStart(1); Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WndTitle); + Initialize3D(WindowTitle); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing 3D', 1); -- cgit v1.2.3 From 982da25ce4d4a214b76d442f323cc6d484da5f43 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 28 Feb 2009 20:11:54 +0000 Subject: cardinal to integer clears warning + some cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1608 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UHooks.pas | 55 ++++++++++++++++++++++++++--------------------------- 1 file changed, 27 insertions(+), 28 deletions(-) (limited to 'src/base') diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas index ab830090..acf2bba7 100644 --- a/src/base/UHooks.pas +++ b/src/base/UHooks.pas @@ -46,23 +46,23 @@ type //Record that saves info from Subscriber PSubscriberInfo = ^TSubscriberInfo; TSubscriberInfo = record - Self: THandle; //ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) - Next: PSubscriberInfo; //Pointer to next Item in HookChain + Self: THandle; // ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) + Next: PSubscriberInfo; // Pointer to next Item in HookChain Owner: integer; //For Error Handling and Plugin Unloading. - //Here is s/t tricky - //To avoid writing of Wrapping Functions to Hook an Event with a Class - //We save a Normal Proc or a Method of a Class + // Here is s/t tricky + // To avoid writing of Wrapping Functions to Hook an Event with a Class + // We save a Normal Proc or a Method of a Class case isClass: boolean of - False: (Proc: TUS_Hook); //Proc that will be called on Event - True: (ProcOfClass: TUS_Hook_of_Object); + false: (Proc: TUS_Hook); //Proc that will be called on Event + true: (ProcOfClass: TUS_Hook_of_Object); end; TEventInfo = record - Name: string[60]; //Name of Event - FirstSubscriber: PSubscriberInfo; //First subscriber in chain - LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding + Name: string[60]; // Name of Event + FirstSubscriber: PSubscriberInfo; // First subscriber in chain + LastSubscriber: PSubscriberInfo; // Last " (for easier subscriber adding) end; THookManager = class @@ -101,7 +101,8 @@ uses // Create - Creates Class and Set Standard Values //------------ constructor THookManager.Create(const SpacetoAllocate: word); -var I: integer; +var + I: integer; begin inherited Create(); @@ -121,7 +122,8 @@ end; // AddEvent - Adds an Event and return the Events Handle or 0 on Failure //------------ function THookManager.AddEvent (const EventName: Pchar): THandle; -var I: integer; +var + I: integer; begin Result := 0; @@ -177,7 +179,6 @@ begin hEvent := hEvent - 1; //Arrayindex is Handle - 1 Result := -1; - if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then begin //Event exists //Free the Space for all Subscribers @@ -212,8 +213,8 @@ end; function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; var EventHandle: THandle; - EventIndex: Cardinal; - Cur: PSubscriberInfo; + EventIndex: integer; + Cur: PSubscriberInfo; begin Result := 0; @@ -224,7 +225,7 @@ begin if (EventHandle <> 0) then begin EventIndex := EventHandle - 1; - + //Get Memory GetMem(Cur, SizeOf(TSubscriberInfo)); @@ -236,12 +237,12 @@ begin if (@Proc = nil) then begin //Use the ProcofClass Method - Cur.isClass := True; + Cur.isClass := true; Cur.ProcOfClass := ProcofClass; end else //Use the normal Proc begin - Cur.isClass := False; + Cur.isClass := false; Cur.Proc := Proc; end; @@ -306,8 +307,8 @@ end; //------------ function THookManager.DelSubscriber (const hSubscriber: THandle): integer; var - EventIndex: Cardinal; - Cur, Last: PSubscriberInfo; + EventIndex: integer; + Cur, Last: PSubscriberInfo; begin Result := -1; EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1; @@ -344,16 +345,15 @@ begin end; end; - //------------ // CallEventChain - Calls the Chain of a specified EventHandle // Returns: -1: Handle doesn't Exist, 0 Chain is called until the End //------------ function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; var - EventIndex: Cardinal; - Cur: PSubscriberInfo; - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute + EventIndex: integer; + Cur: PSubscriberInfo; + CurExecutedBackup: integer; // backup of Core.CurExecuted Attribute begin Result := -1; EventIndex := hEvent - 1; @@ -393,7 +393,7 @@ end; //------------ function THookManager.EventExists (const EventName: Pchar): integer; var - I: integer; + I: integer; Name: string[60]; begin Result := 0; @@ -418,7 +418,7 @@ end; //------------ procedure THookManager.DelbyOwner(const Owner: integer); var - I: integer; + I: integer; Cur, Last: PSubscriberInfo; begin //Search for Owner in all Hooks Chains @@ -426,7 +426,7 @@ begin begin if (Events[I].Name[1] <> chr(0)) then begin - + Last := nil; Cur := Events[I].FirstSubscriber; //Went Through Chain @@ -451,7 +451,6 @@ begin end; end; - function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; begin Result := 0; //Don't break the chain -- cgit v1.2.3 From 10181f2a4db7b9f6a27e6343ac33c69562684623 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 28 Feb 2009 20:55:40 +0000 Subject: Cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1609 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 149 ++++++++++++++++++++++++++---------------------------- 1 file changed, 72 insertions(+), 77 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 7068bfb3..a1fa7ac9 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -73,7 +73,7 @@ type function RemoveFileExt(FullName: string): string; function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer; + function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: boolean = false): integer; function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; @@ -98,7 +98,7 @@ type Difficulty: integer; Language: integer; Tabs: integer; - TabsAtStartup:integer; //Tabs at Startup fix + TabsAtStartup: integer; //Tabs at Startup fix Sorting: integer; Debug: integer; @@ -106,7 +106,7 @@ type Screens: integer; Resolution: integer; Depth: integer; - VisualizerOption:integer; + VisualizerOption: integer; FullScreen: integer; TextureSize: integer; SingWindow: integer; @@ -121,8 +121,8 @@ type BeatClick: integer; SavePlayback: integer; ThresholdIndex: integer; - AudioOutputBufferSizeIndex:integer; - VoicePassthrough:integer; + AudioOutputBufferSizeIndex: integer; + VoicePassthrough: integer; //Song Preview PreviewVolume: integer; @@ -138,8 +138,8 @@ type Theme: integer; SkinNo: integer; Color: integer; - BackgroundMusicOption:integer; - + BackgroundMusicOption: integer; + // Record InputDeviceConfig: array of TInputDeviceConfig; @@ -162,22 +162,20 @@ type end; var - Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; - - + Ini: TIni; + IResolution: array of string; + ILanguage: array of string; + ITheme: array of string; + ISkin: array of string; const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); + IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); + IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); + IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of string = ('Off', 'On'); - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); sEdition = 0; sGenre = 1; sLanguage = 2; @@ -187,51 +185,49 @@ const sTitle2 = 6; sArtist2 = 7; - IDebug: array[0..1] of string = ('Off', 'On'); - - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + IDebug: array[0..1] of string = ('Off', 'On'); - IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + IScreens: array[0..1] of string = ('1', '2'); + IFullScreen: array[0..1] of string = ('Off', 'On'); + IDepth: array[0..1] of string = ('16 bit', '32 bit'); + IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + IBackgroundMusic: array[0..1] of string = ('Off', 'On'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); + ITextureSize: array[0..2] of string = ('128', '256', '512'); + ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); - ISingWindow: array[0..1] of string = ('Small', 'Big'); + ISingWindow: array[0..1] of string = ('Small', 'Big'); //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); -//IOscilloscope: array[0..1] of string = ('Off', 'On'); + IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); +//IOscilloscope: array[0..1] of string = ('Off', 'On'); - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + ISpectrum: array[0..1] of string = ('Off', 'On'); + ISpectrograph: array[0..1] of string = ('Off', 'On'); + IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); + IClickAssist: array[0..1] of string = ('Off', 'On'); + IBeatClick: array[0..1] of string = ('Off', 'On'); + ISavePlayback: array[0..1] of string = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); - IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); + IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); - IVoicePassthrough: array[0..1] of string = ('Off', 'On'); + IVoicePassthrough: array[0..1] of string = ('Off', 'On'); IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); - IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); - - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); + IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); + IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); @@ -243,7 +239,7 @@ const // Advanced ILoadAnimation: array[0..1] of string = ('Off', 'On'); IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array[0..1] of string =('Off', 'On'); + IScreenFade: array[0..1] of string = ('Off', 'On'); IAskbeforeDel: array[0..1] of string = ('Off', 'On'); IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); @@ -308,7 +304,7 @@ end; *) function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; var - i: integer; + i: integer; KeyIndex: integer; begin Result := -1; @@ -326,7 +322,7 @@ end; * or -1 if Value is not in SearchArray. *) function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; - CaseInsensitiv: Boolean = False): integer; + CaseInsensitiv: boolean = false): integer; var i: integer; begin @@ -362,15 +358,14 @@ begin end; end; - procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); var - DeviceCfg: PInputDeviceConfig; - DeviceIndex: integer; + DeviceCfg: PInputDeviceConfig; + DeviceIndex: integer; ChannelCount: integer; ChannelIndex: integer; - RecordKeys: TStringList; - i: integer; + RecordKeys: TStringList; + i: integer; begin RecordKeys := TStringList.Create(); @@ -426,8 +421,8 @@ end; procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); var - DeviceIndex: integer; - ChannelIndex: integer; + DeviceIndex: integer; + ChannelIndex: integer; begin for DeviceIndex := 0 to High(InputDeviceConfig) do begin @@ -436,7 +431,7 @@ begin InputDeviceConfig[DeviceIndex].Name); IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), InputDeviceConfig[DeviceIndex].Input); - + // Channel-to-Player Mapping for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do begin @@ -455,7 +450,7 @@ end; procedure TIni.LoadPaths(IniFile: TCustomIniFile); var PathStrings: TStringList; - I: integer; + I: integer; begin PathStrings := TStringList.Create; IniFile.ReadSection('Directories', PathStrings); @@ -513,7 +508,7 @@ begin Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); if (Theme = -1) then - Theme := 0; + Theme := 0; // Skin Skin.onThemeChange; @@ -535,25 +530,25 @@ procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); var Modes: PPSDL_Rect; - I: integer; + I: integer; begin // Screens Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); - + // FullScreen FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); // Resolution SetLength(IResolution, 0); - + // Check if there are any modes available // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not // possible to select a reasonable fullscreen mode when in windowed mode if IFullScreen[FullScreen] = 'On' then Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN) - else + else Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; - + if (Modes = nil) then begin Log.LogStatus( 'No resolutions Found' , 'Video'); @@ -572,7 +567,7 @@ begin IResolution[7] := '1440x900'; IResolution[8] := '1600x1200'; IResolution[9] := '1680x1050'; - + Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); if Resolution = -1 then begin @@ -628,7 +623,7 @@ end; procedure TIni.Load(); var IniFile: TMemIniFile; - I: integer; + I: integer; begin GamePath := Platform.GetGameUserPath; @@ -655,24 +650,24 @@ begin NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); for I := 0 to 11 do NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - + // Players Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); - + // Difficulty Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); - + // Language Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); //Language.ChangeLanguage(ILanguage[Language]); - + // Tabs Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); TabsAtStartup := Tabs; //Tabs at Startup fix - + // Song Sorting Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); - + // Debug Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); @@ -710,7 +705,7 @@ begin //Preview Volume PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); - + //Preview Fading PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); @@ -774,13 +769,13 @@ begin Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); LoadPaths(IniFile); - + IniFile.Free; end; procedure TIni.Save; var - IniFile: TIniFile; + IniFile: TIniFile; begin if (FileExists(Filename) and FileIsReadOnly(Filename)) then begin @@ -855,7 +850,7 @@ begin // Song Preview IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); - + // PreviewFading IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); -- cgit v1.2.3 From 8f2fc12d58f248a7b548c4919c640500c7a4524d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 28 Feb 2009 20:56:12 +0000 Subject: Some cleanup done moved ScoreFactor to UMusic removed unused field TLines.LyricWidth removed unused field TSong.Category removed some weird and useless code from songloading procedures songloading simplified, commented parts that are difficult to understand some changes to score calculation that assure not more nor less than 10000 Points are gainable. after many tests I could not find any bug in score calculation, at least after these changes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1610 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFiles.pas | 1 - src/base/UMain.pas | 43 +++++++++---- src/base/UMusic.pas | 11 +++- src/base/USong.pas | 178 ++++++++++++++++++---------------------------------- 4 files changed, 99 insertions(+), 134 deletions(-) (limited to 'src/base') diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index add81f23..d639c304 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -73,7 +73,6 @@ begin SetLength(Lines[Count].Line, 1); SetLength(Lines[Count].Line[0].Note, 0); Lines[Count].Line[0].Lyric := ''; - Lines[Count].Line[0].LyricWidth := 0; Player[Count].Score := 0; Player[Count].LengthNote := 0; Player[Count].HighNote := -1; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 65e55c1d..ededb6e5 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -828,12 +828,8 @@ var Range: integer; NoteHit: boolean; MaxSongPoints: integer; // max. points for the song (without line bonus) - MaxLinePoints: real; // max. points for the current line - ScoreFactor: array[TNoteType] of integer; + CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote]) begin - ScoreFactor[ntFreestyle] := 0; - ScoreFactor[ntNormal] := 1; - ScoreFactor[ntGolden] := 2; // TODO: add duet mode support // use Lines[LineSetIndex] with LineSetIndex depending on the current player @@ -924,6 +920,9 @@ begin begin // adjust the players tone to the correct one // TODO: do we need to do this? + // Philipp: I think we do, at least when we draw the notes. + // Otherwise the notehit thing would be shifted to the + // correct unhit note. I think this will look kind of strange. CurrentSound.Tone := CurrentLineFragment.Tone; // half size notes patch @@ -935,17 +934,35 @@ begin MaxSongPoints := MAX_SONG_SCORE; // Note: ScoreValue is the sum of all note values of the song - MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue * ScoreFactor[CurrentLineFragment.NoteType]; - - // FIXME: is this correct? Why do we add the points for a whole line - // if just one note is correct? + // (MaxSongPoints / ScoreValue) is the points that a player + // gets for a hit of one beat of a normal note + // CurNotePoints is the amount of points that is meassured + // for a hit of the note per full beat + CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType]; + case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints; + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints; end; - CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10; - CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10; + // a problem if we use floor instead of round is that a score of + // 10000 points is only possible if the last digit of the total points + // for golden and normal notes is 0. + // if we use round, the max score is 10000 for most songs + // but a score of 10010 is possible if the last digit of the total + // points for golden and normal notes is 5 + // the best solution is to use round for one of these scores + // and round the other score in the opposite direction + // so we assure that the highest possible score is 10000 in every case. + CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10; + + if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then + //normal score is floored so we have to ceil golden notes score + CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10 + else + //normal score is ceiled so we have to floor golden notes score + CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10; + CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + CurrentPlayer.ScoreGoldenInt + diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 10f789d7..09d73331 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -39,8 +39,13 @@ uses Classes; type - TNoteType = (ntFreestyle, ntNormal, ntGolden); + TNoteType = (ntFreestyle = 0, ntNormal = 1, ntGolden = 2); +const + //Score Factor + ScoreFactor: array[TNoteType] of integer = (0, 1, 2); + +type (** * TLineFragment represents a fragment of a lyrics line. * This is a text-fragment (e.g. a syllable) assigned to a note pitch, @@ -64,7 +69,7 @@ type TLine = record Start: integer; // the start beat of this line (<> start beat of the first note of this line) Lyric: string; - LyricWidth: real; // @deprecated: width of the line in pixels. + //LyricWidth: real; // @deprecated: width of the line in pixels. // Do not use this as the width is not correct. // Use TLyricsEngine.GetUpperLine().Width instead. End_: integer; @@ -82,7 +87,7 @@ type *) TLines = record Current: integer; // for drawing of current line - High: integer; // (= High(Line)?) + High: integer; // = High(Line)! Number: integer; Resolution: integer; NotesGAP: integer; diff --git a/src/base/USong.pas b/src/base/USong.pas index b1458e69..ef0768c5 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -88,7 +88,7 @@ type FileName: WideString; // sorting methods - Category: array of WideString; // TODO: do we need this? + //Category: array of WideString; // TODO: do we need this? Genre: WideString; Edition: WideString; Language: WideString; @@ -185,6 +185,11 @@ begin end; end; +{function TSong.LoadSong(): boolean; +begin + +end; } + //Load TXT Song function TSong.LoadSong(): boolean; @@ -213,8 +218,6 @@ begin MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number - Lines[0].ScoreValue := 0; self.Relative := false; Rel[0] := 0; CP := 0; @@ -255,19 +258,23 @@ begin 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].ScoreValue := 0; + + //Add first line and set some standard values to fields + //see procedure NewSentence for further explantation + //concerning most of these values + SetLength(Lines[Count].Line, 1); Lines[Count].Line[0].HighNote := -1; Lines[Count].Line[0].LastLine := false; + Lines[Count].Line[0].BaseNote := High(Integer); + Lines[Count].Line[0].TotalNotes := 0; end; - //TempC := ':'; - //TempC := Text[1]; // read from backup variable, don't use default ':' value - while (TempC <> 'E') and (not EOF(SongFile)) do begin @@ -327,41 +334,6 @@ begin 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(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 - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length; - 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(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 - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length; - end; - //Total Notes Patch End - end; - end; ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) Read(SongFile, TempC); @@ -443,7 +415,6 @@ begin MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note - Base[0] := 100; // high number Lines[0].ScoreValue := 0; self.Relative := false; Rel[0] := 0; @@ -458,14 +429,21 @@ begin 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].HighNote := -1; - Lines[Count].Line[0].LastLine := false; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].ScoreValue := 0; + + //Add first line and set some standard values to fields + //see procedure NewSentence for further explantation + //concerning most of these values + SetLength(Lines[Count].Line, 1); + Lines[Count].Line[0].HighNote := -1; + Lines[Count].Line[0].LastLine := false; + Lines[Count].Line[0].BaseNote := High(Integer); + Lines[Count].Line[0].TotalNotes := 0; end; //Try to Parse the Song @@ -502,42 +480,6 @@ begin ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); end; - if not Both then - begin - Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP]; - Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric); - //Total Notes Patch - Lines[CP].Line[Lines[CP].High].TotalNotes := 0; - for NoteIndex := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do - begin - if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType = ntGolden) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; - - if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType <> ntFreestyle) then - Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length; - 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(Lines[Count].Line[Lines[Count].High].Lyric); - //Total Notes Patch - Lines[Count].Line[Lines[Count].High].TotalNotes := 0; - for NoteIndex := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do - begin - if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType = ntGolden) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; - if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType <> ntFreestyle) then - Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length; - - end; - //Total Notes Patch End - end; - end; { end of for loop } - end; //J Forloop //Add Sentence break @@ -964,17 +906,28 @@ begin '*': Note[HighNote].NoteType := ntGolden; end; - if (Note[HighNote].NoteType = ntGolden) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; + //add this notes value ("notes length" * "notes scorefactor") to the current songs entire value + Inc(Lines[LineNumber].ScoreValue, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); + + //and to the current lines entire value + Inc(TotalNotes, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); - if (Note[HighNote].NoteType <> ntFreestyle) then - Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length; Note[HighNote].Tone := NoteP; - if Note[HighNote].Tone < Base[LineNumber] then - Base[LineNumber] := Note[HighNote].Tone; - Note[HighNote].Text := Copy(LyricS, 2, 100); + //if a note w/ a deeper pitch then the current basenote is found + //we replace the basenote w/ the current notes pitch + if Note[HighNote].Tone < BaseNote then + BaseNote := Note[HighNote].Tone; + + //delete the space that seperates the notes pitch from its lyrics + //it is left in the LyricS string because Read("some ordinal type") will + //set the files pointer to the first whitespace character after the + //ordinal string. Trim is no solution because it would cut the spaces + //that seperate the words of the lyrics, too. + Delete(LyricS, 1, 1); + + Note[HighNote].Text := LyricS; Lyric := Lyric + Note[HighNote].Text; End_ := Note[HighNote].Start + Note[HighNote].Length; @@ -989,36 +942,29 @@ var begin if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then - begin //Update old Sentence if it has notes and create a new sentence - // Update old part - Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP]; - Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(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 - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length; - end; - //Total Notes Patch End - - - // Update new part + begin //create a new line SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); - Lines[LineNumberP].High := Lines[LineNumberP].High + 1; - Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1; + Inc(Lines[LineNumberP].High); + Inc(Lines[LineNumberP].Number); end else - begin //Use old Sentence if it has no notes + begin //use old line if it there were no notes added since last call of NewSentence Log.LogError('Error loading Song, sentence w/o note found in line ' + InttoStr(FileLineNo) + ': ' + Filename); end; Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; + //set the current lines value to zero + //it will be incremented w/ the value of every added note + Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; + + //basenote is the pitch of the deepest note, it is used for note drawing. + //if a note with a less value than the current sentences basenote is found, + //basenote will be set to this notes pitch. Therefore the initial value of + //this field has to be very high. + Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := High(Integer); + + if self.Relative then begin Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; @@ -1028,8 +974,6 @@ begin Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false; - - Base[LineNumberP] := 100; // high number end; procedure TSong.clear(); -- cgit v1.2.3 From cb2a7d2226338a26b4b77a1b08041d2bf7770fa4 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 28 Feb 2009 21:41:23 +0000 Subject: loading of songs with relative: yes fixed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1611 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index ef0768c5..4dd6be0f 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -218,7 +218,6 @@ begin MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note - self.Relative := false; Rel[0] := 0; CP := 0; Both := false; @@ -1009,6 +1008,7 @@ begin Resolution := 4; Creator := ''; + Relative := false; end; function TSong.Analyse(): boolean; -- cgit v1.2.3 From f96f2467acced6ac12e328c940a818edd74a718b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 28 Feb 2009 22:24:59 +0000 Subject: some cosmetic changes git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1612 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 09d73331..eee271a8 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -39,10 +39,14 @@ uses Classes; type - TNoteType = (ntFreestyle = 0, ntNormal = 1, ntGolden = 2); + TNoteType = (ntFreestyle, ntNormal, ntGolden); const - //Score Factor + // ScoreFactor defines how a notehit of a specified notetype is + // measured in comparison to the other types + // 0 means this notetype is not rated at all + // 2 means a hit of this notetype will be rated w/ twice as much + // points as a hit of a notetype w/ ScoreFactor 1 ScoreFactor: array[TNoteType] of integer = (0, 1, 2); type -- cgit v1.2.3 From f57b5a260d4d98a910f62316efe653a1a7e704b7 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 1 Mar 2009 12:53:55 +0000 Subject: fixed first screen was cleared when second screen was drawn. #76 should be fixed now commented some weird stuff in TScreenSing.Draw git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1613 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 7 ------- 1 file changed, 7 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 6cef5d6b..5de521cd 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -106,10 +106,6 @@ var begin if (ScreenSing.Tex_Background.TexNum > 0) then begin - - glClearColor (1, 1, 1, 1); - glColor4f (1, 1, 1, 1); - if (Ini.MovieSize <= 1) then //HalfSize BG begin (* half screen + gradient *) @@ -682,9 +678,6 @@ begin // FIXME: accessing ScreenSing is not that generic LyricEngine := ScreenSing.Lyrics; - // background //BG Fullsize Mod - //SingDrawBackground; - // draw time-bar SingDrawTimeBar(); -- cgit v1.2.3 From 13c4e100a0faff5a7f78ea8bde5995e28852c377 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 3 Mar 2009 10:42:28 +0000 Subject: Color bug on Windows resolved. Type conversion problem git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1616 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 93d84c54..6bdad920 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -918,9 +918,13 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); Result := 0 else begin - if (Max = Red ) then Hue := (Green - Blue )/Delta - else if (Max = Green) then Hue := 2.0 + (Blue - Red )/Delta - else if (Max = Blue ) then Hue := 4.0 + (Red - Green)/Delta; + // The division by Delta is done separately afterwards. + // Necessary because Delphi did not do the type conversion from + // longword to double as expected. + if (Max = Red ) then Hue := Green - Blue + else if (Max = Green) then Hue := 2.0*Delta + Blue - Red + else if (Max = Blue ) then Hue := 4.0*Delta + Red - Green; + Hue := Hue / Delta; if (Hue < 0.0) then Hue := Hue + 6.0; Result := trunc(Hue*1024); // '*1024' is shl 10 -- cgit v1.2.3 From 7ff32f8fb43868b06805a6a83550d87b41a07b8d Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 3 Mar 2009 12:42:46 +0000 Subject: cosmetics and comments git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1617 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 6bdad920..8dc38495 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -887,8 +887,14 @@ end; procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); - // for the conversion of colors from rgb to hsv space and back - // simply check the wikipedia. + // First, the rgb colors are converted to hsv, second hue is replaced by + // the NewColor, saturation and value remain unchanged, finally this + // hsv color is converted back to rgb space. + // For the conversion algorithms of colors from rgb to hsv space + // and back simply check the wikipedia. + // In order to speed up starting time of USDX the division of reals is + // replaced by division of longwords, shifted by 10 bits to keep + // digits. function ColorToHue(const Color: longword): longword; // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 @@ -954,7 +960,7 @@ begin + IntToStr(ImgSurface^.format.BytesPerPixel)); Hue := ColorToHue(NewColor); // Hue is shl 10 - f := Hue and $3ff; + f := Hue and $3ff; // f is the dezimal part of hue HueInteger := Hue shr 10; for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do @@ -1037,13 +1043,13 @@ begin end; {$IFDEF FPC_BIG_ENDIAN} - PixelColors[3] := Red ; - PixelColors[2] := Green ; - PixelColors[1] := Blue ; + PixelColors[3] := Red; + PixelColors[2] := Green; + PixelColors[1] := Blue {$ELSE} - PixelColors[0] := Red ; - PixelColors[1] := Green ; - PixelColors[2] := Blue ; + PixelColors[0] := Red; + PixelColors[1] := Green; + PixelColors[2] := Blue; {$ENDIF} end; -- cgit v1.2.3 From 65eed3b389761e9e5b9cf09c7c7456540ca10ce7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 4 Mar 2009 18:06:26 +0000 Subject: Mac OS X only: change folder hierarchy in Application Support: delete Resources. Requires a new ./configure Attention: This requires manually moving all songs and anything else installed manually. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1618 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 32 ++++++++++++++++---------------- 1 file changed, 16 insertions(+), 16 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 9085e337..96e4bc63 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -70,19 +70,19 @@ type * * So * GetGameSharedPath could return - * /Library/Application Support/UltraStarDeluxe/Resources/. + * /Library/Application Support/UltraStarDeluxe/. * GetGameUserPath could return - * ~/Library/Application Support/UltraStarDeluxe/Resources/. + * ~/Library/Application Support/UltraStarDeluxe/. * - * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + * Right now, only $HOME/Library/Application Support/UltraStarDeluxe * is used. So every user needs the complete set of files and folders. * Future versions may also use shared resources in - * /Library/Application Support/UltraStarDeluxe/Resources. However, this is + * /Library/Application Support/UltraStarDeluxe. However, this is * not treated yet in the code outside this unit. * * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. * The existence of needed files is then checked and if a file is missing - * it is copied to there from within the Resources folder in the Application + * it is copied to there from within the folder Contents in the Application * bundle, which contains the default files. USDX should not delete files or * folders in Application Support/UltraStarDeluxe automatically or without * user confirmation. @@ -97,7 +97,7 @@ type {** * GetApplicationSupportPath returns the path to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * $HOME/Library/Application Support/UltraStarDeluxe. *} function GetApplicationSupportPath: WideString; @@ -109,8 +109,8 @@ type public {** * Init simply calls @link(CreateUserFolders), which in turn scans the - * folder UltraStarDeluxe.app/Contents/Resources for all files and - * folders. $HOME/Library/Application Support/UltraStarDeluxe/Resources + * folder UltraStarDeluxe.app/Contents for all files and + * folders. $HOME/Library/Application Support/UltraStarDeluxe * is then checked for their presence and missing ones are copied. *} procedure Init; override; @@ -123,20 +123,20 @@ type {** * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log. + * $HOME/Library/Application Support/UltraStarDeluxe/Log. *} function GetLogPath : WideString; override; {** * GetGameSharedPath returns the path for shared resources. Currently it - * is set to /Library/Application Support/UltraStarDeluxe/Resources. + * is set to /Library/Application Support/UltraStarDeluxe. * However it is not used. *} function GetGameSharedPath : WideString; override; {** * GetGameUserPath returns the path for user resources. Currently it is - * set to $HOME/Library/Application Support/UltraStarDeluxe/Resources. + * set to $HOME/Library/Application Support/UltraStarDeluxe. * This is where a user can add songs, themes, .... *} function GetGameUserPath : WideString; override; @@ -156,7 +156,7 @@ end; procedure TPlatformMacOSX.CreateUserFolders(); const // used to construct the @link(UserPathName) - PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources'; + PathName: string = '/Library/Application Support/UltraStarDeluxe'; var RelativePath: string; // BaseDir contains the path to the folder, where a search is performed. @@ -186,12 +186,12 @@ begin // finished. GetDir(0, OldBaseDir); - // UltraStarDeluxe.app/Contents/Resources contains all the default files and + // UltraStarDeluxe.app/Contents contains all the default files and // folders. - BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources'; + BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents'; ChDir(BaseDir); - // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources + // Right now, only $HOME/Library/Application Support/UltraStarDeluxe // is used. UserPathName := GetEnvironmentVariable('HOME') + PathName; @@ -268,7 +268,7 @@ end; function TPlatformMacOSX.GetApplicationSupportPath: WideString; const - PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources'; + PathName : string = '/Library/Application Support/UltraStarDeluxe'; begin Result := GetEnvironmentVariable('HOME') + PathName + '/'; end; -- cgit v1.2.3 From 9be9439fce30028c619a401523793ec101dccaed Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 6 Mar 2009 23:45:10 +0000 Subject: Clear Scores moved to UScreenSing and inlined. Reduce clutter in UMain git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1624 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 20 -------------------- 1 file changed, 20 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index ededb6e5..7e935c70 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -134,7 +134,6 @@ procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat procedure NewNote(Screen: TScreenSing); // detect note function GetMidBeat(Time: real): real; function GetTimeFromBeat(Beat: integer): real; -procedure ClearScores(PlayerNum: integer); type TMainThreadExecProc = procedure(Data: Pointer); @@ -1053,25 +1052,6 @@ begin end; -procedure ClearScores(PlayerNum: integer); -begin - with Player[PlayerNum] do - begin - Score := 0; - ScoreLine := 0; - ScoreGolden := 0; - - ScoreInt := 0; - ScoreLineInt := 0; - ScoreGoldenInt := 0; - ScoreTotalInt := 0; - - ScoreLast := 0; - - LastSentencePerfect := false; - end; -end; - procedure AddSpecialPath(var PathList: TStringList; const Path: string); var I: integer; -- cgit v1.2.3 From 458111738476004a914af6fd3e117eb84a35ab6a Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 7 Mar 2009 01:06:07 +0000 Subject: unclutter UMain.pas. Create UPath.pas. Tests on all platformssvn statussvn status git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1625 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 9 ++- src/base/UCatCovers.pas | 3 +- src/base/UGraphic.pas | 10 +-- src/base/UIni.pas | 3 +- src/base/ULanguage.pas | 5 +- src/base/ULog.pas | 3 +- src/base/UMain.pas | 136 +------------------------------- src/base/UMusic.pas | 3 +- src/base/UPath.pas | 188 +++++++++++++++++++++++++++++++++++++++++++++ src/base/UPlaylist.pas | 3 +- src/base/UPluginLoader.pas | 3 +- src/base/USkins.pas | 5 +- src/base/USongs.pas | 14 ++-- 13 files changed, 225 insertions(+), 160 deletions(-) create mode 100644 src/base/UPath.pas (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index bd505f51..c8de4e28 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -96,12 +96,13 @@ var implementation uses - UMain, - UCommon, + Classes, SysUtils, IniFiles, - Classes, - UGraphic; + UCommon, + UGraphic, + UMain, + UPath; var // Colours for the reflection diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index 4fc54199..6ef81b68 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -64,8 +64,9 @@ uses SysUtils, Classes, // UFiles, + ULog, UMain, - ULog; + UPath; constructor TCatCovers.Create; begin diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index c328d016..17175d02 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -280,11 +280,12 @@ function LoadingThreadFunction: integer; implementation uses + Classes, UMain, UIni, UDisplay, UCommandLine, - Classes; + UPath; procedure LoadFontTextures; begin @@ -294,11 +295,10 @@ end; procedure LoadTextures; - var - P: integer; - R, G, B: real; - Col: integer; + P: integer; + R, G, B: real; + Col: integer; begin Log.LogStatus('Loading Textures', 'LoadTextures'); diff --git a/src/base/UIni.pas b/src/base/UIni.pas index a1fa7ac9..78229f53 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -261,7 +261,8 @@ uses UPlatform, USkins, URecord, - UCommandLine; + UCommandLine, + UPath; (** * Returns the filename without its fileextension diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index 31840f5f..02cd7712 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -75,9 +75,10 @@ uses Classes, SysUtils, {$IFDEF win32} - windows, + Windows, {$ENDIF} - ULog; + ULog, + UPath; //---------- //Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues diff --git a/src/base/ULog.pas b/src/base/ULog.pas index 582120bc..a872729a 100644 --- a/src/base/ULog.pas +++ b/src/base/ULog.pas @@ -132,7 +132,8 @@ uses UMain, UTime, UCommon, - UCommandLine; + UCommandLine, + UPath; (* * Write to console if in debug mode (Thread-safe). diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 7e935c70..bc1cc7cc 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -89,21 +89,6 @@ type end; var - // Absolute Paths - GamePath: string; - SoundPath: string; - SongPaths: TStringList; - LogPath: string; - ThemePath: string; - SkinsPath: string; - ScreenshotsPath: string; - CoverPaths: TStringList; - LanguagesPath: string; - PluginPath: string; - VisualsPath: string; - FontPath: string; - ResourcesPath: string; - PlayListPath: string; Done: boolean; // FIXME: ConversionFileName should not be global @@ -120,10 +105,6 @@ const MAX_SONG_SCORE = 10000; // max. achievable points per song MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -procedure InitializePaths; -procedure AddSongPath(const Path: string); - procedure Main; procedure MainLoop; procedure CheckEvents; @@ -173,6 +154,7 @@ uses UCommon, UGraphic, UGraphicClasses, + UPath, UPluginDefs, UPlatform, UThemes; @@ -1052,120 +1034,4 @@ begin end; -procedure AddSpecialPath(var PathList: TStringList; const Path: string); -var - I: integer; - PathAbs, OldPathAbs: string; -begin - if (PathList = nil) then - PathList := TStringList.Create; - - if (Path = '') or not ForceDirectories(Path) then - Exit; - - PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); - - // check if path or a part of the path was already added - for I := 0 to PathList.Count-1 do - begin - OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I])); - // check if the new directory is a sub-directory of a previously added one. - // This is also true, if both paths point to the same directories. - if (AnsiStartsText(OldPathAbs, PathAbs)) then - begin - // ignore the new path - Exit; - end; - - // check if a previously added directory is a sub-directory of the new one. - if (AnsiStartsText(PathAbs, OldPathAbs)) then - begin - // replace the old with the new one. - PathList[I] := PathAbs; - Exit; - end; - end; - - PathList.Add(PathAbs); -end; - -procedure AddSongPath(const Path: string); -begin - AddSpecialPath(SongPaths, Path); -end; - -procedure AddCoverPath(const Path: string); -begin - AddSpecialPath(CoverPaths, Path); -end; - -(** - * Initialize a path variable - * After setting paths, make sure that paths exist - *) -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -begin - Result := false; - - if (RequestedPath = '') then - Exit; - - // Make sure the directory exists - if (not ForceDirectories(RequestedPath)) then - begin - PathResult := ''; - Exit; - end; - - PathResult := IncludeTrailingPathDelimiter(RequestedPath); - - if (NeedsWritePermission) and - (FileIsReadOnly(RequestedPath)) then - begin - Exit; - end; - - Result := true; -end; - -(** - * Function sets all absolute paths e.g. song path and makes sure the directorys exist - *) -procedure InitializePaths; -begin - // Log directory (must be writable) - if (not FindPath(LogPath, Platform.GetLogPath, true)) then - begin - Log.FileOutputEnabled := false; - Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); - end; - - FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); - FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); - FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); - FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); - FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); - FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); - FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); - FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); - - // Playlists are not shared as we need one directory to write too - FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); - - // Screenshot directory (must be writable) - if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then - begin - Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); - end; - - // Add song paths - AddSongPath(Params.SongPath); - AddSongPath(Platform.GetGameSharedPath + 'songs'); - AddSongPath(Platform.GetGameUserPath + 'songs'); - - // Add category cover paths - AddCoverPath(Platform.GetGameSharedPath + 'covers'); - AddCoverPath(Platform.GetGameUserPath + 'covers'); -end; - end. diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index eee271a8..727088c8 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -576,7 +576,8 @@ uses UMain, UCommandLine, URecord, - ULog; + ULog, + UPath; var DefaultVideoPlayback : IVideoPlayback; diff --git a/src/base/UPath.pas b/src/base/UPath.pas new file mode 100644 index 00000000..2316ac02 --- /dev/null +++ b/src/base/UPath.pas @@ -0,0 +1,188 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UPath.pas $ + * $Id: UPath.pas 1624 2009-03-06 23:45:10Z k-m_schindler $ + *} + +unit UPath; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes; + +var + // Absolute Paths + GamePath: string; + SoundPath: string; + SongPaths: TStringList; + LogPath: string; + ThemePath: string; + SkinsPath: string; + ScreenshotsPath: string; + CoverPaths: TStringList; + LanguagesPath: string; + PluginPath: string; + VisualsPath: string; + FontPath: string; + ResourcesPath: string; + PlayListPath: string; + +function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; +procedure InitializePaths; +procedure AddSongPath(const Path: string); + +implementation + +uses + StrUtils, + UPlatform, + UCommandLine, + ULog; + +procedure AddSpecialPath(var PathList: TStringList; const Path: string); +var + Index: integer; + PathAbs, OldPathAbs: string; +begin + if (PathList = nil) then + PathList := TStringList.Create; + + if (Path = '') or not ForceDirectories(Path) then + Exit; + + PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); + + // check if path or a part of the path was already added + for Index := 0 to PathList.Count-1 do + begin + OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[Index])); + // check if the new directory is a sub-directory of a previously added one. + // This is also true, if both paths point to the same directories. + if (AnsiStartsText(OldPathAbs, PathAbs)) then + begin + // ignore the new path + Exit; + end; + + // check if a previously added directory is a sub-directory of the new one. + if (AnsiStartsText(PathAbs, OldPathAbs)) then + begin + // replace the old with the new one. + PathList[Index] := PathAbs; + Exit; + end; + end; + + PathList.Add(PathAbs); +end; + +procedure AddSongPath(const Path: string); +begin + AddSpecialPath(SongPaths, Path); +end; + +procedure AddCoverPath(const Path: string); +begin + AddSpecialPath(CoverPaths, Path); +end; + +(** + * Initialize a path variable + * After setting paths, make sure that paths exist + *) +function FindPath(out PathResult: string; + const RequestedPath: string; + NeedsWritePermission: boolean) + : boolean; +begin + Result := false; + + if (RequestedPath = '') then + Exit; + + // Make sure the directory exists + if (not ForceDirectories(RequestedPath)) then + begin + PathResult := ''; + Exit; + end; + + PathResult := IncludeTrailingPathDelimiter(RequestedPath); + + if (NeedsWritePermission) and + (FileIsReadOnly(RequestedPath)) then + begin + Exit; + end; + + Result := true; +end; + +(** + * Function sets all absolute paths e.g. song path and makes sure the directorys exist + *) +procedure InitializePaths; +begin + // Log directory (must be writable) + if (not FindPath(LogPath, Platform.GetLogPath, true)) then + begin + Log.FileOutputEnabled := false; + Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); + end; + + FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); + FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); + FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); + FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); + FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); + FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); + FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); + FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); + + // Playlists are not shared as we need one directory to write too + FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); + + // Screenshot directory (must be writable) + if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then + begin + Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); + end; + + // Add song paths + AddSongPath(Params.SongPath); + AddSongPath(Platform.GetGameSharedPath + 'songs'); + AddSongPath(Platform.GetGameUserPath + 'songs'); + + // Add category cover paths + AddCoverPath(Platform.GetGameSharedPath + 'covers'); + AddCoverPath(Platform.GetGameUserPath + 'covers'); +end; + +end. diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 11ed84de..419ce687 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -34,7 +34,8 @@ interface {$I switches.inc} uses - USong; + USong, + UPath; type TPlaylistItem = record diff --git a/src/base/UPluginLoader.pas b/src/base/UPluginLoader.pas index bb8a9aa5..8836cb78 100644 --- a/src/base/UPluginLoader.pas +++ b/src/base/UPluginLoader.pas @@ -41,7 +41,8 @@ interface uses UPluginDefs, - UCoreModule; + UCoreModule, + UPath; type TPluginListItem = record diff --git a/src/base/USkins.pas b/src/base/USkins.pas index 30d7cbcf..a4722d95 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -71,9 +71,10 @@ uses IniFiles, Classes, SysUtils, - UMain, + UIni, ULog, - UIni; + UMain, + UPath; constructor TSkin.Create; begin diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 4d702163..79e1eb59 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -151,12 +151,14 @@ const implementation -uses StrUtils, - UGraphic, - UCovers, - UFiles, - UMain, - UIni; +uses + StrUtils, + UCovers, + UFiles, + UGraphic, + UIni, + UPath, + UMain; constructor TSongs.Create(); begin -- cgit v1.2.3 From b38fa5a07ab1f5604372176c8e84ddfb075133ee Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 7 Mar 2009 19:53:00 +0000 Subject: unclutter Umain: ConversionFileName moved to UScreenEditConvert git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1626 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 -- 1 file changed, 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index bc1cc7cc..7cd69c24 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -91,8 +91,6 @@ type var Done: boolean; - // FIXME: ConversionFileName should not be global - ConversionFileName: string; Restart: boolean; // player and music info -- cgit v1.2.3 From f469075a0335399c753ae5d2d362047dedf116b1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 7 Mar 2009 21:14:14 +0000 Subject: final cleanup of Umain. Creation of UNote git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1627 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 20 +- src/base/UFiles.pas | 4 +- src/base/UGraphicClasses.pas | 14 +- src/base/UMain.pas | 527 +------------------------------------- src/base/UMusic.pas | 2 +- src/base/UNote.pas | 593 +++++++++++++++++++++++++++++++++++++++++++ src/base/UParty.pas | 2 +- src/base/URecord.pas | 2 +- src/base/USong.pas | 2 +- src/base/USongs.pas | 2 +- 10 files changed, 624 insertions(+), 544 deletions(-) create mode 100644 src/base/UNote.pas (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 5de521cd..8a66d271 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -82,22 +82,22 @@ var implementation uses + SysUtils, + Math, gl, + TextGL, + UDLLManager, + UDrawTexture, UGraphic, - SysUtils, + UIni, + ULog, + ULyrics, + UNote, UMusic, URecord, - ULog, UScreenSing, UScreenSingModi, - ULyrics, - UMain, - TextGL, - UTexture, - UDrawTexture, - UIni, - Math, - UDLLManager; + UTexture; procedure SingDrawBackground; var diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index d639c304..0495dfbb 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -58,8 +58,8 @@ implementation uses TextGL, UIni, - UPlatform, - UMain; + UNote, + UPlatform; //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas index 3fbe262f..cdaa238e 100644 --- a/src/base/UGraphicClasses.pas +++ b/src/base/UGraphicClasses.pas @@ -124,16 +124,16 @@ var implementation uses - sysutils, + SysUtils, + Math, gl, + UCommon, + UDrawTexture, + UGraphic, UIni, - UMain, - UThemes, + UNote, USkins, - UGraphic, - UDrawTexture, - UCommon, - math; + UThemes; //TParticle constructor TParticle.Create(cX, cY : real; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 7cd69c24..f7dc6ef3 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -48,71 +48,14 @@ uses USong, gl; -type - PPLayerNote = ^TPlayerNote; - TPlayerNote = record - Start: integer; - Length: integer; - Detect: real; // accurate place, detected in the note - Tone: real; - Perfect: boolean; // true if the note matches the original one, light the star - Hit: boolean; // true if the note hits the line - end; - - PPLayer = ^TPlayer; - TPlayer = record - Name: string; - - // Index in Teaminfo record - TeamID: byte; - PlayerID: byte; - - // Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreInt: integer; - ScoreLineInt: integer; - ScoreGoldenInt: integer; - ScoreTotalInt: integer; - - // LineBonus - ScoreLast: real; // Last Line Score - - // PerfectLineTwinkle (effect) - LastSentencePerfect: boolean; - - HighNote: integer; // index of last note (= High(Note)?) - LengthNote: integer; // number of notes (= Length(Note)?). - Note: array of TPlayerNote; - end; - var - Done: boolean; - Restart: boolean; - - // player and music info - Player: array of TPlayer; - PlayersPlay: integer; - - CurrentSong: TSong; - -const - MAX_SONG_SCORE = 10000; // max. achievable points per song - MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + Done: boolean; + Restart: boolean; procedure Main; procedure MainLoop; procedure CheckEvents; -procedure Sing(Screen: TScreenSing); -procedure NewSentence(Screen: TScreenSing); -procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click -procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection -procedure NewNote(Screen: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; type TMainThreadExecProc = procedure(Data: Pointer); @@ -417,7 +360,7 @@ begin CheckEvents; // display - done := not Display.Draw; + Done := not Display.Draw; SwapBuffers; // delay @@ -519,16 +462,16 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) + Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) + Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) else begin // check if screen wants to exit - done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true); + Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true); // if screen wants to exit - if done then + if Done then begin // if question option is enabled then show exit popup if (Ini.AskbeforeDel = 1) then @@ -576,460 +519,4 @@ begin SDL_PushEvent(@Event); end; -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(CurrentSong.BPM) = BPMNum then - begin - // last BPM - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end - else - begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then - begin - // there is still remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end - else - begin - // there is no remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := Time * CurrentSong.BPM[0].BPM / 60; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - Result := CurrentSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(CurrentSong.BPM)) and - (Beat > CurrentSong.BPM[CurBPM].StartBeat) do - begin - if (CurBPM < High(CurrentSong.BPM)) and - (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // full range - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(CurrentSong.BPM)) or - (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // in the middle - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (Beat - CurrentSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - - { - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - } - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -procedure Sing(Screen: TScreenSing); -var - Count: integer; - CountGr: integer; - CP: integer; - N: integer; -begin - LyricsState.UpdateBeats(); - - // sentences routines - for CountGr := 0 to 0 do //High(Lines) - begin; - CP := CountGr; - // old parts - LyricsState.OldLine := Lines[CP].Current; - - // choose current parts - for Count := 0 to Lines[CP].High do - begin - if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then - Lines[CP].Current := Count; - end; - - // clean player note if there is a new line - // (optimization on halfbeat time) - if Lines[CP].Current <> LyricsState.OldLine then - NewSentence(Screen); - - end; // for CountGr - - // make some operations on clicks - if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then - NewBeatClick(Screen); - - // make some operations when detecting new voice pitch - if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then - NewBeatDetect(Screen); -end; - -procedure NewSentence(Screen: TScreenSing); -var - i: integer; -begin - // clean note of player - for i := 0 to High(Player) do - begin - Player[i].LengthNote := 0; - Player[i].HighNote := -1; - SetLength(Player[i].Note, 0); - end; - - // on sentence change... - Screen.onSentenceChange(Lines[0].Current); -end; - -procedure NewBeatClick; -var - Count: integer; -begin - // beat click - if ((Ini.BeatClick = 1) and - ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then - begin - AudioPlayback.PlaySound(SoundLib.Click); - end; - - for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do - begin - if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then - begin - // click assist - if Ini.ClickAssist = 1 then - AudioPlayback.PlaySound(SoundLib.Click); - - // drum machine - (* - TempBeat := LyricsState.CurrentBeat; // + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; - //if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat; - *) - end; - end; -end; - -procedure NewBeatDetect(Screen: TScreenSing); -begin - NewNote(Screen); -end; - -procedure NewNote(Screen: TScreenSing); -var - LineFragmentIndex: integer; - CurrentLineFragment: PLineFragment; - PlayerIndex: integer; - CurrentSound: TCaptureBuffer; - CurrentPlayer: PPlayer; - LastPlayerNote: PPlayerNote; - Line: PLine; - SentenceIndex: integer; - SentenceMin: integer; - SentenceMax: integer; - SentenceDetected: integer; // sentence of detected note - NoteAvailable: boolean; - NewNote: boolean; - Range: integer; - NoteHit: boolean; - MaxSongPoints: integer; // max. points for the song (without line bonus) - CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote]) -begin - // TODO: add duet mode support - // use Lines[LineSetIndex] with LineSetIndex depending on the current player - - // count min and max sentence range for checking - // (detection is delayed to the notes we see on the screen) - SentenceMin := Lines[0].Current-1; - if (SentenceMin < 0) then - SentenceMin := 0; - SentenceMax := Lines[0].Current; - - // check for an active note at the current time defined in the lyrics - NoteAvailable := false; - SentenceDetected := SentenceMin; - for SentenceIndex := SentenceMin to SentenceMax do - begin - Line := @Lines[0].Line[SentenceIndex]; - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - // check if line is active - if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and - (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1 - begin - SentenceDetected := SentenceIndex; - NoteAvailable := true; - Break; - end; - end; - // TODO: break here, if NoteAvailable is true? We would then use the first instead - // of the last note matching the current beat if notes overlap. But notes - // should not overlap at all. - // if (NoteAvailable) then - // Break; - end; - - // analyze player signals - for PlayerIndex := 0 to PlayersPlay-1 do - begin - CurrentPlayer := @Player[PlayerIndex]; - CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - - // at the beginning of the song there is no previous note - if (Length(CurrentPlayer.Note) > 0) then - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] - else - LastPlayerNote := nil; - - // analyze buffer - CurrentSound.AnalyzeBuffer; - - // add some noise - // TODO: do we need this? - //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; - - // add note if possible - if (CurrentSound.ToneValid and NoteAvailable) then - begin - Line := @Lines[0].Line[SentenceDetected]; - - // process until last note - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and - (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then - begin - // compare notes (from song-file and from player) - - // move players tone to proper octave - while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do - CurrentSound.Tone := CurrentSound.Tone - 12; - - while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do - CurrentSound.Tone := CurrentSound.Tone + 12; - - // half size notes patch - NoteHit := false; - - // if Ini.Difficulty = 0 then Range := 2; - // if Ini.Difficulty = 1 then Range := 1; - // if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - // check if the player hit the correct tone within the tolerated range - if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then - begin - // adjust the players tone to the correct one - // TODO: do we need to do this? - // Philipp: I think we do, at least when we draw the notes. - // Otherwise the notehit thing would be shifted to the - // correct unhit note. I think this will look kind of strange. - CurrentSound.Tone := CurrentLineFragment.Tone; - - // half size notes patch - NoteHit := true; - - if (Ini.LineBonus > 0) then - MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS - else - MaxSongPoints := MAX_SONG_SCORE; - - // Note: ScoreValue is the sum of all note values of the song - // (MaxSongPoints / ScoreValue) is the points that a player - // gets for a hit of one beat of a normal note - // CurNotePoints is the amount of points that is meassured - // for a hit of the note per full beat - CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType]; - - case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints; - end; - - // a problem if we use floor instead of round is that a score of - // 10000 points is only possible if the last digit of the total points - // for golden and normal notes is 0. - // if we use round, the max score is 10000 for most songs - // but a score of 10010 is possible if the last digit of the total - // points for golden and normal notes is 5 - // the best solution is to use round for one of these scores - // and round the other score in the opposite direction - // so we assure that the highest possible score is 10000 in every case. - CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10; - - if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then - //normal score is floored so we have to ceil golden notes score - CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10 - else - //normal score is ceiled so we have to floor golden notes score - CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10; - - - CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + - CurrentPlayer.ScoreGoldenInt + - CurrentPlayer.ScoreLineInt; - end; - - end; // operation - end; // for - - // check if we have to add a new note or extend the note's length - if (SentenceDetected = SentenceMax) then - begin - // we will add a new note - NewNote := true; - - // if previous note (if any) was the same, extend previous note - if ((CurrentPlayer.LengthNote > 0) and - (LastPlayerNote <> nil) and - (LastPlayerNote.Tone = CurrentSound.Tone) and - ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then - begin - NewNote := false; - end; - - // if is not as new note to control - for LineFragmentIndex := 0 to Line.HighNote do - begin - if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then - NewNote := true; - end; - - // add new note - if NewNote then - begin - // new note - Inc(CurrentPlayer.LengthNote); - Inc(CurrentPlayer.HighNote); - SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); - - // update player's last note - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; - with LastPlayerNote^ do - begin - Start := LyricsState.CurrentBeatD; - Length := 1; - Tone := CurrentSound.Tone; // Tone || ToneAbs - Detect := LyricsState.MidBeat; - Hit := NoteHit; // half note patch - end; - end - else - begin - // extend note length - if (LastPlayerNote <> nil) then - Inc(LastPlayerNote.Length); - end; - - // check for perfect note and then light the star (on Draw) - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start = LastPlayerNote.Start) and - (CurrentLineFragment.Length = LastPlayerNote.Length) and - (CurrentLineFragment.Tone = LastPlayerNote.Tone) then - begin - LastPlayerNote.Perfect := true; - end; - end; - end; // if SentenceDetected = SentenceMax - - end; // if Detected - end; // for PlayerIndex - - //Log.LogStatus('EndBeat', 'NewBeat'); - - // on sentence end -> for LineBonus and display of SingBar (rating pop-up) - if (SentenceDetected >= Low(Lines[0].Line)) and - (SentenceDetected <= High(Lines[0].Line)) then - begin - Line := @Lines[0].Line[SentenceDetected]; - CurrentLineFragment := @Line.Note[Line.HighNote]; - if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then - begin - if assigned(Screen) then - Screen.OnSentenceEnd(SentenceDetected); - end; - end; - -end; - end. diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 727088c8..b86f3aad 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -573,7 +573,7 @@ implementation uses math, UIni, - UMain, + UNote, UCommandLine, URecord, ULog, diff --git a/src/base/UNote.pas b/src/base/UNote.pas new file mode 100644 index 00000000..5e70bfe1 --- /dev/null +++ b/src/base/UNote.pas @@ -0,0 +1,593 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UNote.pas $ + * $Id: UNote.pas 1626 2009-03-07 19:53:00Z k-m_schindler $ + *} + +unit UNote; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + SDL, + UMusic, + URecord, + UTime, + UDisplay, + UIni, + ULog, + ULyrics, + UScreenSing, + USong, + gl; + +type + PPLayerNote = ^TPlayerNote; + TPlayerNote = record + Start: integer; + Length: integer; + Detect: real; // accurate place, detected in the note + Tone: real; + Perfect: boolean; // true if the note matches the original one, light the star + Hit: boolean; // true if the note hits the line + end; + + PPLayer = ^TPlayer; + TPlayer = record + Name: string; + + // Index in Teaminfo record + TeamID: byte; + PlayerID: byte; + + // Scores + Score: real; + ScoreLine: real; + ScoreGolden: real; + + ScoreInt: integer; + ScoreLineInt: integer; + ScoreGoldenInt: integer; + ScoreTotalInt: integer; + + // LineBonus + ScoreLast: real; // Last Line Score + + // PerfectLineTwinkle (effect) + LastSentencePerfect: boolean; + + HighNote: integer; // index of last note (= High(Note)?) + LengthNote: integer; // number of notes (= Length(Note)?). + Note: array of TPlayerNote; + end; + +var + + // player and music info + Player: array of TPlayer; + PlayersPlay: integer; + + CurrentSong: TSong; + +const + MAX_SONG_SCORE = 10000; // max. achievable points per song + MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song + +procedure Sing(Screen: TScreenSing); +procedure NewSentence(Screen: TScreenSing); +procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click +procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection +procedure NewNote(Screen: TScreenSing); // detect note +function GetMidBeat(Time: real): real; +function GetTimeFromBeat(Beat: integer): real; + +implementation + +uses + Math, + StrUtils, + USongs, + UJoystick, + UCommandLine, + ULanguage, + //SDL_ttf, + USkins, + UCovers, + UCatCovers, + UDataBase, + UPlaylist, + UDLLManager, + UParty, + UConfig, + UCore, + UCommon, + UGraphic, + UGraphicClasses, + UPath, + UPluginDefs, + UPlatform, + UThemes; + +function GetTimeForBeats(BPM, Beats: real): real; +begin + Result := 60 / BPM * Beats; +end; + +function GetBeats(BPM, msTime: real): real; +begin + Result := BPM * msTime / 60; +end; + +procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); +var + NewTime: real; +begin + if High(CurrentSong.BPM) = BPMNum then + begin + // last BPM + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end + else + begin + // not last BPM + // count how much time is it for start of the new BPM and store it in NewTime + NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); + + // compare it to remaining time + if (Time - NewTime) > 0 then + begin + // there is still remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat; + Time := Time - NewTime; + end + else + begin + // there is no remaining time + CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); + Time := 0; + end; // if + end; // if +end; + +function GetMidBeat(Time: real): real; +var + CurBeat: real; + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := Time * CurrentSong.BPM[0].BPM / 60; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + CurBeat := 0; + CurBPM := 0; + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + + Result := CurBeat; + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +function GetTimeFromBeat(Beat: integer): real; +var + CurBPM: integer; +begin + // static BPM + if Length(CurrentSong.BPM) = 1 then + begin + Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; + end + // variable BPM + else if Length(CurrentSong.BPM) > 1 then + begin + Result := CurrentSong.GAP / 1000; + CurBPM := 0; + while (CurBPM <= High(CurrentSong.BPM)) and + (Beat > CurrentSong.BPM[CurBPM].StartBeat) do + begin + if (CurBPM < High(CurrentSong.BPM)) and + (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // full range + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); + end; + + if (CurBPM = High(CurrentSong.BPM)) or + (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then + begin + // in the middle + Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * + (Beat - CurrentSong.BPM[CurBPM].StartBeat); + end; + Inc(CurBPM); + end; + + { + while (Time > 0) do + begin + GetMidBeatSub(CurBPM, Time, CurBeat); + Inc(CurBPM); + end; + } + end + // invalid BPM + else + begin + Result := 0; + end; +end; + +procedure Sing(Screen: TScreenSing); +var + Count: integer; + CountGr: integer; + CP: integer; +begin + LyricsState.UpdateBeats(); + + // sentences routines + for CountGr := 0 to 0 do //High(Lines) + begin; + CP := CountGr; + // old parts + LyricsState.OldLine := Lines[CP].Current; + + // choose current parts + for Count := 0 to Lines[CP].High do + begin + if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then + Lines[CP].Current := Count; + end; + + // clean player note if there is a new line + // (optimization on halfbeat time) + if Lines[CP].Current <> LyricsState.OldLine then + NewSentence(Screen); + + end; // for CountGr + + // make some operations on clicks + if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then + NewBeatClick(Screen); + + // make some operations when detecting new voice pitch + if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then + NewBeatDetect(Screen); +end; + +procedure NewSentence(Screen: TScreenSing); +var + i: integer; +begin + // clean note of player + for i := 0 to High(Player) do + begin + Player[i].LengthNote := 0; + Player[i].HighNote := -1; + SetLength(Player[i].Note, 0); + end; + + // on sentence change... + Screen.onSentenceChange(Lines[0].Current); +end; + +procedure NewBeatClick; +var + Count: integer; +begin + // beat click + if ((Ini.BeatClick = 1) and + ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then + begin + AudioPlayback.PlaySound(SoundLib.Click); + end; + + for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do + begin + if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then + begin + // click assist + if Ini.ClickAssist = 1 then + AudioPlayback.PlaySound(SoundLib.Click); + + // drum machine + (* + TempBeat := LyricsState.CurrentBeat; // + 2; + if (TempBeat mod 8 = 0) then Music.PlayDrum; + if (TempBeat mod 8 = 4) then Music.PlayClap; + //if (TempBeat mod 4 = 2) then Music.PlayHihat; + if (TempBeat mod 4 <> 0) then Music.PlayHihat; + *) + end; + end; +end; + +procedure NewBeatDetect(Screen: TScreenSing); +begin + NewNote(Screen); +end; + +procedure NewNote(Screen: TScreenSing); +var + LineFragmentIndex: integer; + CurrentLineFragment: PLineFragment; + PlayerIndex: integer; + CurrentSound: TCaptureBuffer; + CurrentPlayer: PPlayer; + LastPlayerNote: PPlayerNote; + Line: PLine; + SentenceIndex: integer; + SentenceMin: integer; + SentenceMax: integer; + SentenceDetected: integer; // sentence of detected note + NoteAvailable: boolean; + NewNote: boolean; + Range: integer; + NoteHit: boolean; + MaxSongPoints: integer; // max. points for the song (without line bonus) + CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote]) +begin + // TODO: add duet mode support + // use Lines[LineSetIndex] with LineSetIndex depending on the current player + + // count min and max sentence range for checking + // (detection is delayed to the notes we see on the screen) + SentenceMin := Lines[0].Current-1; + if (SentenceMin < 0) then + SentenceMin := 0; + SentenceMax := Lines[0].Current; + + // check for an active note at the current time defined in the lyrics + NoteAvailable := false; + SentenceDetected := SentenceMin; + for SentenceIndex := SentenceMin to SentenceMax do + begin + Line := @Lines[0].Line[SentenceIndex]; + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + // check if line is active + if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and + (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and + (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes + (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1 + begin + SentenceDetected := SentenceIndex; + NoteAvailable := true; + Break; + end; + end; + // TODO: break here, if NoteAvailable is true? We would then use the first instead + // of the last note matching the current beat if notes overlap. But notes + // should not overlap at all. + // if (NoteAvailable) then + // Break; + end; + + // analyze player signals + for PlayerIndex := 0 to PlayersPlay-1 do + begin + CurrentPlayer := @Player[PlayerIndex]; + CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; + + // at the beginning of the song there is no previous note + if (Length(CurrentPlayer.Note) > 0) then + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] + else + LastPlayerNote := nil; + + // analyze buffer + CurrentSound.AnalyzeBuffer; + + // add some noise + // TODO: do we need this? + //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; + + // add note if possible + if (CurrentSound.ToneValid and NoteAvailable) then + begin + Line := @Lines[0].Line[SentenceDetected]; + + // process until last note + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and + (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then + begin + // compare notes (from song-file and from player) + + // move players tone to proper octave + while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do + CurrentSound.Tone := CurrentSound.Tone - 12; + + while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do + CurrentSound.Tone := CurrentSound.Tone + 12; + + // half size notes patch + NoteHit := false; + + // if Ini.Difficulty = 0 then Range := 2; + // if Ini.Difficulty = 1 then Range := 1; + // if Ini.Difficulty = 2 then Range := 0; + Range := 2 - Ini.Difficulty; + + // check if the player hit the correct tone within the tolerated range + if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then + begin + // adjust the players tone to the correct one + // TODO: do we need to do this? + // Philipp: I think we do, at least when we draw the notes. + // Otherwise the notehit thing would be shifted to the + // correct unhit note. I think this will look kind of strange. + CurrentSound.Tone := CurrentLineFragment.Tone; + + // half size notes patch + NoteHit := true; + + if (Ini.LineBonus > 0) then + MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS + else + MaxSongPoints := MAX_SONG_SCORE; + + // Note: ScoreValue is the sum of all note values of the song + // (MaxSongPoints / ScoreValue) is the points that a player + // gets for a hit of one beat of a normal note + // CurNotePoints is the amount of points that is meassured + // for a hit of the note per full beat + CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType]; + + case CurrentLineFragment.NoteType of + ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints; + ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints; + end; + + // a problem if we use floor instead of round is that a score of + // 10000 points is only possible if the last digit of the total points + // for golden and normal notes is 0. + // if we use round, the max score is 10000 for most songs + // but a score of 10010 is possible if the last digit of the total + // points for golden and normal notes is 5 + // the best solution is to use round for one of these scores + // and round the other score in the opposite direction + // so we assure that the highest possible score is 10000 in every case. + CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10; + + if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then + //normal score is floored so we have to ceil golden notes score + CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10 + else + //normal score is ceiled so we have to floor golden notes score + CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10; + + + CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + + CurrentPlayer.ScoreGoldenInt + + CurrentPlayer.ScoreLineInt; + end; + + end; // operation + end; // for + + // check if we have to add a new note or extend the note's length + if (SentenceDetected = SentenceMax) then + begin + // we will add a new note + NewNote := true; + + // if previous note (if any) was the same, extend previous note + if ((CurrentPlayer.LengthNote > 0) and + (LastPlayerNote <> nil) and + (LastPlayerNote.Tone = CurrentSound.Tone) and + ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then + begin + NewNote := false; + end; + + // if is not as new note to control + for LineFragmentIndex := 0 to Line.HighNote do + begin + if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then + NewNote := true; + end; + + // add new note + if NewNote then + begin + // new note + Inc(CurrentPlayer.LengthNote); + Inc(CurrentPlayer.HighNote); + SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); + + // update player's last note + LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; + with LastPlayerNote^ do + begin + Start := LyricsState.CurrentBeatD; + Length := 1; + Tone := CurrentSound.Tone; // Tone || ToneAbs + Detect := LyricsState.MidBeat; + Hit := NoteHit; // half note patch + end; + end + else + begin + // extend note length + if (LastPlayerNote <> nil) then + Inc(LastPlayerNote.Length); + end; + + // check for perfect note and then light the star (on Draw) + for LineFragmentIndex := 0 to Line.HighNote do + begin + CurrentLineFragment := @Line.Note[LineFragmentIndex]; + if (CurrentLineFragment.Start = LastPlayerNote.Start) and + (CurrentLineFragment.Length = LastPlayerNote.Length) and + (CurrentLineFragment.Tone = LastPlayerNote.Tone) then + begin + LastPlayerNote.Perfect := true; + end; + end; + end; // if SentenceDetected = SentenceMax + + end; // if Detected + end; // for PlayerIndex + + //Log.LogStatus('EndBeat', 'NewBeat'); + + // on sentence end -> for LineBonus and display of SingBar (rating pop-up) + if (SentenceDetected >= Low(Lines[0].Line)) and + (SentenceDetected <= High(Lines[0].Line)) then + begin + Line := @Lines[0].Line[SentenceDetected]; + CurrentLineFragment := @Line.Note[Line.HighNote]; + if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then + begin + if assigned(Screen) then + Screen.OnSentenceEnd(SentenceDetected); + end; + end; + +end; + +end. diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 18d15745..23012dfe 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -111,9 +111,9 @@ implementation uses UCore, UGraphic, - UMain, ULanguage, ULog, + UNote, SysUtils; {********************* diff --git a/src/base/URecord.pas b/src/base/URecord.pas index ec6935bd..8f37262d 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -162,7 +162,7 @@ implementation uses ULog, - UMain; + UNote; var singleton_AudioInputProcessor : TAudioInputProcessor = nil; diff --git a/src/base/USong.pas b/src/base/USong.pas index 4dd6be0f..1197f3be 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -149,7 +149,7 @@ uses TextGL, UIni, UMusic, //needed for Lines - UMain; //needed for Player + UNote; //needed for Player constructor TSong.Create(); begin diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 79e1eb59..6c356d06 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -158,7 +158,7 @@ uses UGraphic, UIni, UPath, - UMain; + UNote; constructor TSongs.Create(); begin -- cgit v1.2.3 From 18b6be2497bd26a3fc14dcec65a1dc38776b35be Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 7 Mar 2009 22:30:04 +0000 Subject: removed some unused units. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1629 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 52 +++++++++++++++++++++++----------------------------- 1 file changed, 23 insertions(+), 29 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index f7dc6ef3..d2f5f5b9 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -35,23 +35,11 @@ interface uses SysUtils, - Classes, - SDL, - UMusic, - URecord, - UTime, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - USong, - gl; + SDL; var - - Done: boolean; - Restart: boolean; + Done: boolean; + Restart: boolean; procedure Main; procedure MainLoop; @@ -77,28 +65,34 @@ implementation uses Math, - StrUtils, - USongs, - UJoystick, + gl, +{ + SDL_ttf, + UParty, + UCore, +} + UCatCovers, UCommandLine, - ULanguage, - //SDL_ttf, - USkins, + UCommon, + UConfig, UCovers, - UCatCovers, UDataBase, - UPlaylist, + UDisplay, UDLLManager, - UParty, - UConfig, - UCore, - UCommon, UGraphic, UGraphicClasses, + UIni, + UJoystick, + ULanguage, + ULog, UPath, - UPluginDefs, + UPlaylist, + UMusic, UPlatform, - UThemes; + USkins, + USongs, + UThemes, + UTime; procedure Main; var -- cgit v1.2.3 From 1f8df8ece71d733129886f0ee3f695c2c1db4c26 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 8 Mar 2009 13:01:32 +0000 Subject: Cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1630 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index d2f5f5b9..fec1903f 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -119,7 +119,7 @@ begin DecimalSeparator := '.'; //------------------------------ - // StartUp - Create Classes and Load Files + // StartUp - create classes and load files //------------------------------ // initialize SDL @@ -151,14 +151,14 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Language', 1); - { +{ // SDL_ttf (Not used yet, maybe in version 1.5) Log.BenchmarkStart(1); Log.LogStatus('Initialize SDL_ttf', 'Initialization'); TTF_Init(); Log.BenchmarkEnd(1); Log.LogBenchmark('Initializing SDL_ttf', 1); - } +} // Skin Log.BenchmarkStart(1); @@ -173,7 +173,7 @@ begin Ini := TIni.Create; Ini.Load; - //it's possible that this is the first run, create a .ini file if neccessary + // it is possible that this is the first run, create a .ini file if neccessary Log.LogStatus('Write Ini', 'Initialization'); Ini.Save; @@ -236,13 +236,14 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); - {// Party Mode Manager +{ + // Party Mode Manager Log.BenchmarkStart(1); Log.LogStatus('PartySession Manager', 'Initialization'); PartySession := TPartySession.Create; //Load PartySession - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); } + Log.LogBenchmark('Loading PartySession Manager', 1); +} // Graphics Log.BenchmarkStart(1); @@ -292,13 +293,15 @@ begin Log.LogBenchmark('Loading Time', 0); Log.LogStatus('Creating Core', 'Initialization'); - {Core := TCore.Create( +{ + Core := TCore.Create( USDXShortVersionStr, MakeVersion(USDX_VERSION_MAJOR, USDX_VERSION_MINOR, USDX_VERSION_RELEASE, chr(0)) - ); } + ); +} Log.LogStatus('Running Core', 'Initialization'); //Core.Run; @@ -395,15 +398,15 @@ begin end; SDL_MOUSEBUTTONDOWN: begin - { +{ with Event.button do begin - if State = SDL_BUTTON_LEFT Then + if State = SDL_BUTTON_LEFT then begin // end; end; - } +} end; SDL_VIDEORESIZE: begin @@ -412,7 +415,7 @@ begin // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. // This would create a new OpenGL render-context and all texture data // would be invalidated. - // On Linux the mode MUST be resetted, otherwise graphics will be corrupted. + // On Linux the mode MUST be reset, otherwise graphics will be corrupted. {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) @@ -434,7 +437,7 @@ begin // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to // reload all texture data (-> whitescreen bug). - // Only Linux (and FreeBSD) is able to handle screen-switching this way. + // Only Linux and FreeBSD are able to handle screen-switching this way. {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then begin -- cgit v1.2.3 From 786adb9a238a6e8a4e49b16f691a926c265da232 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 10 Mar 2009 20:50:23 +0000 Subject: folder sorting w/ cats on fixed (ticket #84) it works good for the moment, but it should be changed when we support nested categories. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1631 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 41 +++++++++++++++++++++++++++++++++++++++-- 1 file changed, 39 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 1197f3be..57f78a27 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -146,8 +146,10 @@ type implementation uses + StrUtils, TextGL, UIni, + UPath, UMusic, //needed for Lines UNote; //needed for Player @@ -156,7 +158,42 @@ begin inherited; end; -constructor TSong.Create( const aFileName : WideString ); +constructor TSong.Create( const aFileName: WideString ); + // This may be changed, when we rewrite song select code. + // it is some kind of dirty, but imho the best possible + // solution as we do atm not support nested categorys. + // it works like the folder sorting in 1.0.1a + // folder is set to the first folder under the songdir + // so songs ~/.ultrastardx/songs/punk is in the same + // category as songs in shared/ultrastardx/songs are. + // note: folder is just the name of a category it has + // nothing to do with the path used for file loading + function GetFolderCategory: WideString; + var + I: Integer; + P: Integer; //position of next path delimiter + begin + Result := 'Unknown'; //default folder category, if we can't locate the song dir + + for I := 0 to SongPaths.Count-1 do + if (AnsiStartsText(SongPaths.Strings[I], aFilename)) then + begin + P := PosEx(PathDelim, aFilename, Length(SongPaths.Strings[I]) + 1); + + If (P > 0) then + begin + // we have found the category name => get it + Result := copy(self.Path, Length(SongPaths.Strings[I]) + 1, P - Length(SongPaths.Strings[I]) - 1); + end + else + begin + // songs are in the "root" of the songdir => use songdir for the categorys name + Result := SongPaths.Strings[I]; + end; + + Exit; + end; + end; begin inherited Create(); @@ -169,7 +206,7 @@ begin if fileexists( aFileName ) then begin self.Path := ExtractFilePath( aFileName ); - self.Folder := ExtractFilePath( aFileName ); + self.Folder := GetFolderCategory; self.FileName := ExtractFileName( aFileName ); (* if ReadTXTHeader( aFileName ) then -- cgit v1.2.3 From 31b5e9286f721b7cc81f620a28d8de5d0087c63c Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 21 Mar 2009 19:11:54 +0000 Subject: New plugin mode reverted (will be moved to a branch afterwards). Party mode might work again (untested). This might break linux compatibility. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1641 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCore.pas | 550 ----------------------------- src/base/UCoreModule.pas | 154 -------- src/base/UHooks.pas | 460 ------------------------ src/base/UMain.pas | 8 +- src/base/UModules.pas | 55 --- src/base/UNote.pas | 2 - src/base/UParty.pas | 562 ++++++++---------------------- src/base/UPluginInterface.pas | 186 ---------- src/base/UPluginLoader.pas | 794 ------------------------------------------ src/base/UServices.pas | 384 -------------------- 10 files changed, 141 insertions(+), 3014 deletions(-) delete mode 100644 src/base/UCore.pas delete mode 100644 src/base/UCoreModule.pas delete mode 100644 src/base/UHooks.pas delete mode 100644 src/base/UModules.pas delete mode 100644 src/base/UPluginInterface.pas delete mode 100644 src/base/UPluginLoader.pas delete mode 100644 src/base/UServices.pas (limited to 'src/base') diff --git a/src/base/UCore.pas b/src/base/UCore.pas deleted file mode 100644 index a7f9e56e..00000000 --- a/src/base/UCore.pas +++ /dev/null @@ -1,550 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UCore; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - uPluginDefs, - uCoreModule, - UHooks, - UServices, - UModules; - -{********************* - TCore - Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process - Also, it does some error handling, and maybe sometime multithreaded loading ;) -*********************} - -type - TModuleListItem = record - Module: TCoreModule; // Instance of the modules class - Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc - NeedsDeInit: boolean; // True if module was succesful inited - end; - - TCore = class - private - // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos - hLoadingFinished: THandle; - hMainLoop: THandle; - hTranslate: THandle; - hLoadTextures: THandle; - hExitQuery: THandle; - hExit: THandle; - hDebug: THandle; - hError: THandle; - sReportError: THandle; - sReportDebug: THandle; - sShowMessage: THandle; - sRetranslate: THandle; - sReloadTextures: THandle; - sGetModuleInfo: THandle; - sGetApplicationHandle: THandle; - - Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem; - - // Cur + Last Executed Setting and Getting ;) - iCurExecuted: integer; - iLastExecuted: integer; - - procedure SetCurExecuted(Value: integer); - - // Function Get all Modules and Creates them - function GetModules: boolean; - - // Loads Core and all Modules - function Load: boolean; - - // Inits Core and all Modules - function Init: boolean; - - // DeInits Core and all Modules - function DeInit: boolean; - - // Load the Core - function LoadCore: boolean; - - // Init the Core - function InitCore: boolean; - - // DeInit the Core - function DeInitCore: boolean; - - // Called one time per frame - function MainLoop: boolean; - - public - Hooks: THookManager; // The Hook Manager ;) - Services: TServiceManager; // The Service Manager - - Name: string; // Name of this application - Version: LongWord; // Version of this ". For info look plugindefs functions - - LastErrorReporter: string; // Who reported the last error string - LastErrorString: string; // Last error string reported - - property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed - property LastExecuted: integer read iLastExecuted; - - //--------------- - // Main methods to control the core: - //--------------- - constructor Create(const cName: string; const cVersion: LongWord); - - // Starts loading and init process. Then runs MainLoop. DeInits on shutdown - procedure Run; - - // Method for other classes to get pointer to a specific module - function GetModulebyName(const Name: string): PCoreModule; - - //-------------- - // Hook and service procs: - //-------------- - function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol) - function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername)) - function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook - function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook - function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam - function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle - end; - -var - Core: TCore; - -implementation - -uses - {$IFDEF win32} - Windows, - {$ENDIF} - SysUtils; - -//------------- -// Create - Creates Class + Hook and Service Manager -//------------- -constructor TCore.Create(const cName: string; const cVersion: LongWord); -begin - inherited Create; - - Name := cName; - Version := cVersion; - iLastExecuted := 0; - iCurExecuted := 0; - - LastErrorReporter := ''; - LastErrorString := ''; - - Hooks := THookManager.Create(50); - Services := TServiceManager.Create; -end; - -//------------- -// Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown -//------------- -procedure TCore.Run; -var - Success: boolean; - - procedure HandleError(const ErrorMsg: string); - begin - if (LastErrorString <> '') then - Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString)) - else - Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg)); - - // DeInit - DeInit; - end; - -begin - // Get modules - try - Success := GetModules(); - except - Success := false; - end; - - if (not Success) then - begin - HandleError('Error Getting Modules'); - Exit; - end; - - // Loading - try - Success := Load(); - except - Success := false; - end; - - if (not Success) then - begin - HandleError('Error loading Modules'); - Exit; - end; - - // Init - try - Success := Init(); - except - Success := false; - end; - - if (not Success) then - begin - HandleError('Error initing Modules'); - Exit; - end; - - // Call Translate Hook - if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then - begin - HandleError('Error translating'); - Exit; - end; - - // Calls LoadTextures Hook - if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then - begin - HandleError('Error loading textures'); - Exit; - end; - - // Calls Loading Finished Hook - if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then - begin - HandleError('Error calling LoadingFinished Hook'); - Exit; - end; - - // Start MainLoop - while Success do - begin - Success := MainLoop(); - // to-do : Call Display Draw here - end; -end; - -//------------- -// Called one time per frame -//------------- -function TCore.MainLoop: boolean; -begin - Result := false; -end; - -//------------- -// Function get all modules and creates them -//------------- -function TCore.GetModules: boolean; -var - i: integer; -begin - Result := false; - for i := 0 to high(Modules) do - begin - try - Modules[i].NeedsDeInit := false; - Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create; - Modules[i].Module.Info(@Modules[i].Info); - except - ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - Exit; - end; - end; - Result := true; -end; - -//------------- -// Loads core and all modules -//------------- -function TCore.Load: boolean; -var - i: integer; -begin - Result := LoadCore; - - for i := 0 to High(CORE_MODULES_TO_LOAD) do - begin - try - Result := Modules[i].Module.Load; - except - Result := false; - end; - - if (not Result) then - begin - ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - break; - end; - end; -end; - -//------------- -// Inits core and all modules -//------------- -function TCore.Init: boolean; -var - i: integer; -begin - Result := InitCore; - - for i := 0 to High(CORE_MODULES_TO_LOAD) do - begin - try - Result := Modules[i].Module.Init; - except - Result := false; - end; - - if (not Result) then - begin - ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core')); - break; - end; - - Modules[i].NeedsDeInit := Result; - end; -end; - -//------------- -// DeInits core and all modules -//------------- -function TCore.DeInit: boolean; -var - i: integer; -begin - - for i := High(CORE_MODULES_TO_LOAD) downto 0 do - begin - try - if (Modules[i].NeedsDeInit) then - Modules[i].Module.DeInit; - except - end; - end; - - DeInitCore; - - Result := true; -end; - -//------------- -// Load the Core -//------------- -function TCore.LoadCore: boolean; -begin - hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished'); - hMainLoop := Hooks.AddEvent('Core/MainLoop'); - hTranslate := Hooks.AddEvent('Core/Translate'); - hLoadTextures := Hooks.AddEvent('Core/LoadTextures'); - hExitQuery := Hooks.AddEvent('Core/ExitQuery'); - hExit := Hooks.AddEvent('Core/Exit'); - hDebug := Hooks.AddEvent('Core/NewDebugInfo'); - hError := Hooks.AddEvent('Core/NewError'); - - sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError); - sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug); - sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage); - sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate); - sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures); - sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo); - sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle); - - // A little Test - Hooks.AddSubscriber('Core/NewError', HookTest); - - result := true; -end; - -//------------- -// Init the Core -//------------- -function TCore.InitCore: boolean; -begin - //Don not init something atm. - result := true; -end; - -//------------- -// DeInit the Core -//------------- -function TCore.DeInitCore: boolean; -begin - // TODO: write TService-/HookManager. Free and call it here - Result := true; -end; - -//------------- -// Method for other classes to get pointer to a specific module -//------------- -function TCore.GetModuleByName(const Name: string): PCoreModule; -var i: integer; -begin - Result := nil; - for i := 0 to High(Modules) do - begin - if (Modules[i].Info.Name = Name) then - begin - Result := @Modules[i].Module; - Break; - end; - end; -end; - -//------------- -// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol) -//------------- -function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer; -{$IFDEF MSWINDOWS} -var Params: Cardinal; -{$ENDIF} -begin - Result := -1; - - {$IFDEF MSWINDOWS} - if (lParam <> nil) then - begin - Params := MB_OK; - case wParam of - CORE_SM_ERROR: Params := Params or MB_ICONERROR; - CORE_SM_WARNING: Params := Params or MB_ICONWARNING; - CORE_SM_INFO: Params := Params or MB_ICONINFORMATION; - end; - - // Show: - Result := Messagebox(0, lParam, PChar(Name), Params); - end; - {$ENDIF} - - // TODO: write ShowMessage for other OSes -end; - -//------------- -// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer; -begin - //Update LastErrorReporter and LastErrorString - LastErrorReporter := string(PChar(lParam)); - LastErrorString := string(PChar(Pointer(wParam))); - - Hooks.CallEventChain(hError, wParam, lParam); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername)) -//------------- -function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hDebug, wParam, lParam); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls Translate hook -//------------- -function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hTranslate, 1, nil); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// Calls LoadTextures hook -//------------- -function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer; -begin - Hooks.CallEventChain(hLoadTextures, 1, nil); - - // FIXME: return a correct result - Result := 0; -end; - -//------------- -// If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam -//------------- -function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; -var - I: integer; -begin - if (Pointer(lParam) = nil) then - begin - Result := Length(Modules); - end - else - begin - try - for I := 0 to High(Modules) do - begin - AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name; - AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version; - AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description; - end; - Result := Length(Modules); - except - Result := -1; - end; - end; -end; - -//------------- -// Returns Application Handle -//------------- -function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; -begin - Result := hInstance; -end; - -//------------- -// Called when setting CurExecuted -//------------- -procedure TCore.SetCurExecuted(Value: integer); -begin - // Set Last Executed - iLastExecuted := iCurExecuted; - - // Set Cur Executed - iCurExecuted := Value; -end; - -end. diff --git a/src/base/UCoreModule.pas b/src/base/UCoreModule.pas deleted file mode 100644 index b87fec85..00000000 --- a/src/base/UCoreModule.pas +++ /dev/null @@ -1,154 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UCoreModule; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{********************* - TCoreModule - Dummy class that has methods that will be called from core - In the best case every piece of this software is a module -*********************} -uses - UPluginDefs; - -type - PCoreModule = ^TCoreModule; - TCoreModule = class - public - Constructor Create; virtual; - - //Function that gives some Infos about the Module to the Core - Procedure Info(const pInfo: PModuleInfo); virtual; - - //Is Called on Loading. - //In this Method only Events and Services should be created - //to offer them to other Modules or Plugins during the Init process - //If False is Returned this will cause a Forced Exit - Function Load: Boolean; virtual; - - //Is Called on Init Process - //In this Method you can Hook some Events and Create + Init - //your Classes, Variables etc. - //If False is Returned this will cause a Forced Exit - Function Init: Boolean; virtual; - - //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing - //If False is Returned this will cause a Forced Exit - Function MainLoop: Boolean; virtual; - - //Is Called if this Module has been Inited and there is a Exit. - //Deinit is in backwards Initing Order - //If False is Returned this will cause a Forced Exit - Procedure DeInit; virtual; - - //Is Called if this Module will be unloaded and has been created - //Should be used to Free Memory - Destructor Destroy; override; - end; - cCoreModule = class of TCoreModule; - -implementation - -//------------- -// Just the Constructor -//------------- -Constructor TCoreModule.Create; -begin - //Dummy maaaan ;) - inherited; -end; - -//------------- -// Function that gives some Infos about the Module to the Core -//------------- -Procedure TCoreModule.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'Not Set'; - pInfo^.Version := 0; - pInfo^.Description := 'Not Set'; -end; - -//------------- -//Is Called on Loading. -//In this Method only Events and Services should be created -//to offer them to other Modules or Plugins during the Init process -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Load: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called on Init Process -//In this Method you can Hook some Events and Create + Init -//your Classes, Variables etc. -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.Init: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing -//If False is Returned this will cause a Forced Exit -//------------- -Function TCoreModule.MainLoop: Boolean; -begin - //Dummy ftw!! - Result := True; -end; - -//------------- -//Is Called if this Module has been Inited and there is a Exit. -//Deinit is in backwards Initing Order -//------------- -Procedure TCoreModule.DeInit; -begin - //Dummy ftw!! -end; - -//------------- -//Is Called if this Module will be unloaded and has been created -//Should be used to Free Memory -//------------- -Destructor TCoreModule.Destroy; -begin - //Dummy ftw!! - inherited; -end; - -end. diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas deleted file mode 100644 index acf2bba7..00000000 --- a/src/base/UHooks.pas +++ /dev/null @@ -1,460 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UHooks; - -{********************* - THookManager - Class for saving, managing and calling of hooks. - Saves all hookable events and their subscribers -*********************} -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - uPluginDefs, - SysUtils; - -type - //Record that saves info from Subscriber - PSubscriberInfo = ^TSubscriberInfo; - TSubscriberInfo = record - Self: THandle; // ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook) - Next: PSubscriberInfo; // Pointer to next Item in HookChain - - Owner: integer; //For Error Handling and Plugin Unloading. - - // Here is s/t tricky - // To avoid writing of Wrapping Functions to Hook an Event with a Class - // We save a Normal Proc or a Method of a Class - case isClass: boolean of - false: (Proc: TUS_Hook); //Proc that will be called on Event - true: (ProcOfClass: TUS_Hook_of_Object); - end; - - TEventInfo = record - Name: string[60]; // Name of Event - FirstSubscriber: PSubscriberInfo; // First subscriber in chain - LastSubscriber: PSubscriberInfo; // Last " (for easier subscriber adding) - end; - - THookManager = class - private - Events: array of TEventInfo; - SpaceinEvents: word; //Number of empty Items in Events Array. (e.g. Deleted Items) - - procedure FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); - public - constructor Create(const SpacetoAllocate: word); - - function AddEvent (const EventName: Pchar): THandle; - function DelEvent (hEvent: THandle): integer; - - function AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle; - function DelSubscriber (const hSubscriber: THandle): integer; - - function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; - function EventExists (const EventName: Pchar): integer; - - procedure DelbyOwner(const Owner: integer); - end; - -function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; - -var - HookManager: THookManager; - -implementation - -uses - ULog, - UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -constructor THookManager.Create(const SpacetoAllocate: word); -var - I: integer; -begin - inherited Create(); - - //Get the Space and "Zero" it - SetLength (Events, SpacetoAllocate); - for I := 0 to SpacetoAllocate-1 do - Events[I].Name[1] := chr(0); - - SpaceinEvents := SpacetoAllocate; - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Succesful Created.'); - {$ENDIF} -end; - -//------------ -// AddEvent - Adds an Event and return the Events Handle or 0 on Failure -//------------ -function THookManager.AddEvent (const EventName: Pchar): THandle; -var - I: integer; -begin - Result := 0; - - if (EventExists(EventName) = 0) then - begin - if (SpaceinEvents > 0) then - begin - //There is already Space available - //Go Search it! - for I := 0 to High(Events) do - if (Events[I].Name[1] = chr(0)) then - begin //Found Space - Result := I; - Dec(SpaceinEvents); - Break; - end; - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + ''); - {$ENDIF} - end - else - begin //There is no Space => Go make some! - Result := Length(Events); - SetLength(Events, Result + 1); - end; - - //Set Events Data - Events[Result].Name := EventName; - Events[Result].FirstSubscriber := nil; - Events[Result].LastSubscriber := nil; - - //Handle is Index + 1 - Inc(Result); - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Add Event succesful: ''' + EventName + ''); - {$ENDIF} - end - {$IFDEF DEBUG} - else - debugWriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + ''); - {$ENDIF} -end; - -//------------ -// DelEvent - Deletes an Event by Handle Returns False on Failure -//------------ -function THookManager.DelEvent (hEvent: THandle): integer; -var - Cur, Last: PSubscriberInfo; -begin - hEvent := hEvent - 1; //Arrayindex is Handle - 1 - Result := -1; - - if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then - begin //Event exists - //Free the Space for all Subscribers - Cur := Events[hEvent].FirstSubscriber; - - while (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TSubscriberInfo)); - end; - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + ''); - {$ENDIF} - - //Free the Event - Events[hEvent].Name[1] := chr(0); - Inc(SpaceinEvents); //There is one more space for new events - end - - {$IFDEF DEBUG} - else - debugWriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + ''); - {$ENDIF} -end; - -//------------ -// AddSubscriber - Adds an Subscriber to the Event by Name -// Returns Handle of the Subscribtion or 0 on Failure -//------------ -function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle; -var - EventHandle: THandle; - EventIndex: integer; - Cur: PSubscriberInfo; -begin - Result := 0; - - if (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - EventHandle := EventExists(EventName); - - if (EventHandle <> 0) then - begin - EventIndex := EventHandle - 1; - - //Get Memory - GetMem(Cur, SizeOf(TSubscriberInfo)); - - //Fill it with Data - Cur.Next := nil; - - //Add Owner - Cur.Owner := Core.CurExecuted; - - if (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := true; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := false; - Cur.Proc := Proc; - end; - - //Create Handle (1st word: Handle of Event; 2nd word: unique ID - if (Events[EventIndex].LastSubscriber = nil) then - begin - if (Events[EventIndex].FirstSubscriber = nil) then - begin - Result := (EventHandle SHL 16); - Events[EventIndex].FirstSubscriber := Cur; - end - else - begin - Result := Events[EventIndex].FirstSubscriber.Self + 1; - end; - end - else - begin - Result := Events[EventIndex].LastSubscriber.Self + 1; - Events[EventIndex].LastSubscriber.Next := Cur; - end; - - Cur.Self := Result; - - //Add to Chain - Events[EventIndex].LastSubscriber := Cur; - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner)); - {$ENDIF} - end; - end; -end; - -//------------ -// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory. -//------------ -procedure THookManager.FreeSubscriber(const EventIndex: word; const Last, Cur: PSubscriberInfo); -begin - //Delete from Chain - if (Last <> nil) then - begin - Last.Next := Cur.Next; - end - else //Was first Popup - begin - Events[EventIndex].FirstSubscriber := Cur.Next; - end; - - //Was this Last subscription ? - if (Cur = Events[EventIndex].LastSubscriber) then - begin //Change Last Subscriber - Events[EventIndex].LastSubscriber := Last; - end; - - //Free Space: - FreeMem(Cur, SizeOf(TSubscriberInfo)); -end; - -//------------ -// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure -//------------ -function THookManager.DelSubscriber (const hSubscriber: THandle): integer; -var - EventIndex: integer; - Cur, Last: PSubscriberInfo; -begin - Result := -1; - EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1; - - //Existing Event ? - if (EventIndex < Length(Events)) and (Events[EventIndex].Name[1] <> chr(0)) then - begin - Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription - - //Search for Subscription - Cur := Events[EventIndex].FirstSubscriber; - Last := nil; - - //go through the chain ... - while (Cur <> nil) do - begin - if (Cur.Self = hSubscriber) then - begin //Found Subscription we searched for - FreeSubscriber(EventIndex, Last, Cur); - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + ''); - {$ENDIF} - - //Set Result and Break the Loop - Result := 0; - Break; - end; - - Last := Cur; - Cur := Cur.Next; - end; - - end; -end; - -//------------ -// CallEventChain - Calls the Chain of a specified EventHandle -// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End -//------------ -function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer; -var - EventIndex: integer; - Cur: PSubscriberInfo; - CurExecutedBackup: integer; // backup of Core.CurExecuted Attribute -begin - Result := -1; - EventIndex := hEvent - 1; - - if ((EventIndex <= High(Events)) and (Events[EventIndex].Name[1] <> chr(0))) then - begin //Existing Event - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - //Start calling the Chain !!!11 - Cur := Events[EventIndex].FirstSubscriber; - Result := 0; - //Call Hooks until the Chain is at the End or breaked - while ((Cur <> nil) and (Result = 0)) do - begin - //Set CurExecuted - Core.CurExecuted := Cur.Owner; - if (Cur.isClass) then - Result := Cur.ProcOfClass(wParam, lParam) - else - Result := Cur.Proc(wParam, lParam); - - Cur := Cur.Next; - end; - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - debugWriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + ''); - {$ENDIF} -end; - -//------------ -// EventExists - Returns non Zero if an Event with the given Name exists -//------------ -function THookManager.EventExists (const EventName: Pchar): integer; -var - I: integer; - Name: string[60]; -begin - Result := 0; - //if (Length(EventName) < - Name := string(EventName); - - //Sure not to search for empty space - if (Name[1] <> chr(0)) then - begin - //Search for Event - for I := 0 to High(Events) do - if (Events[I].Name = Name) then - begin //Event found - Result := I + 1; - Break; - end; - end; -end; - -//------------ -// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading) -//------------ -procedure THookManager.DelbyOwner(const Owner: integer); -var - I: integer; - Cur, Last: PSubscriberInfo; -begin - //Search for Owner in all Hooks Chains - for I := 0 to High(Events) do - begin - if (Events[I].Name[1] <> chr(0)) then - begin - - Last := nil; - Cur := Events[I].FirstSubscriber; - //Went Through Chain - while (Cur <> nil) do - begin - if (Cur.Owner = Owner) then - begin //Found Subscription by Owner -> Delete - FreeSubscriber(I, Last, Cur); - if (Last <> nil) then - Cur := Last.Next - else - Cur := Events[I].FirstSubscriber; - end - else - begin - //Next Item: - Last := Cur; - Cur := Cur.Next; - end; - end; - end; - end; -end; - -function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := 0; //Don't break the chain - Core.ShowMessage(CORE_SM_INFO, Pchar(string(Pchar(Pointer(lParam))) + ': ' + string(Pchar(Pointer(wParam))))); -end; - -end. diff --git a/src/base/UMain.pas b/src/base/UMain.pas index fec1903f..469a658b 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -66,11 +66,6 @@ implementation uses Math, gl, -{ - SDL_ttf, - UParty, - UCore, -} UCatCovers, UCommandLine, UCommon, @@ -92,6 +87,7 @@ uses USkins, USongs, UThemes, + UParty, UTime; procedure Main; @@ -236,14 +232,12 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); -{ // Party Mode Manager Log.BenchmarkStart(1); Log.LogStatus('PartySession Manager', 'Initialization'); PartySession := TPartySession.Create; //Load PartySession Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PartySession Manager', 1); -} // Graphics Log.BenchmarkStart(1); diff --git a/src/base/UModules.pas b/src/base/UModules.pas deleted file mode 100644 index 97494180..00000000 --- a/src/base/UModules.pas +++ /dev/null @@ -1,55 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UModules; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{********************* - UModules - Unit Contains all used Modules in its uses clausel - and a const with an array of all Modules to load -*********************} - -uses - UCoreModule, - UPluginLoader; - -const - CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = ( - TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future) - TCoreModule, //Remove this later, just a dummy - TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc. - ); - -implementation - -end. \ No newline at end of file diff --git a/src/base/UNote.pas b/src/base/UNote.pas index 5e70bfe1..6da4cf07 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -126,12 +126,10 @@ uses UDLLManager, UParty, UConfig, - UCore, UCommon, UGraphic, UGraphicClasses, UPath, - UPluginDefs, UPlatform, UThemes; diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 23012dfe..9d70e2be 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -34,208 +34,85 @@ interface {$I switches.inc} uses - UPartyDefs, - UCoreModule, - UPluginDefs; + ModiSDK; type - ARounds = array [0..252] of integer; //0..252 needed for - PARounds = ^ARounds; - TRoundInfo = record - Modi: cardinal; + Plugin: word; Winner: byte; end; TeamOrderEntry = record - Teamnum: byte; + TeamNum: byte; Score: byte; end; TeamOrderArray = array[0..5] of byte; - TUS_ModiInfoEx = record - Info: TUS_ModiInfo; - Owner: integer; - TimesPlayed: byte; //Helper for setting round plugins + TPartyPlugin = record + ID: byte; + TimesPlayed: byte; end; - TPartySession = class (TCoreModule) + TPartySession = class private - bPartyMode: boolean; //Is this party or single player - CurRound: byte; - - Modis: array of TUS_ModiInfoEx; - Teams: TTeamInfo; - - function IsWinner(Player, Winner: byte): boolean; + function GetRandomPlayer(Team: Byte): Byte; + function GetRandomPlugin(Plugins: array of TPartyPlugin): byte; + function IsWinner(Player, Winner: Byte): boolean; procedure GenScores; - function GetRandomPlugin(TeamMode: boolean): cardinal; - function GetRandomPlayer(Team: byte): byte; public - //Teams: TTeamInfo; + Teams: TTeamInfo; Rounds: array of TRoundInfo; + CurRound: Byte; - //TCoreModule methods to inherit - constructor Create; override; - procedure Info(const pInfo: PModuleInfo); override; - function Load: boolean; override; - function Init: boolean; override; - procedure DeInit; override; - destructor Destroy; override; + constructor Create; - //Register modus service - function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new modus. wParam: Pointer to TUS_ModiInfo - - //Start new Party - function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new party mode. Returns non zero on success - function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns pointer to cur. Modis TUS_ModiInfo (to Use with Singscreen) - function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops party mode. Returns 1 if party mode was enabled before. - function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases curround by 1; Returns num of round or -1 if last round is already played - - function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls curmodis init proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading - function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and ends the round - - function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo record to pointer at lParam. Returns zero on success - function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo record from pointer at lParam. Returns zero on success - - function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... - function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is roundnum. If (Pointer = nil) then return length of the string. Otherwise write the string to address at lParam + procedure StartNewParty(NumRounds: Byte); + procedure StartRound; + procedure EndRound; + function GetTeamOrder: TeamOrderArray; + function GetWinnerString(Round: Byte): String; end; -const - StandardModus = 0; //Modus ID that will be played in non-party mode +var + PartySession: TPartySession; implementation uses - UCore, + UDLLManager, UGraphic, - ULanguage, - ULog, UNote, - SysUtils; - -{********************* - TPluginLoader - Implentation -*********************} - -//------------- -// function that gives some infos about the module to the core -//------------- -procedure TPartySession.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TPartySession'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Manages party modi and party game'; -end; + ULanguage, + ULog; -//------------- -// Just the constructor -//------------- constructor TPartySession.Create; begin inherited; - //UnSet PartyMode - bPartyMode := false; -end; - -//------------- -//Is called on loading. -//In this method only events and services should be created -//to offer them to other modules or plugins during the init process -//If false is returned this will cause a forced exit -//------------- -function TPartySession.Load: boolean; -begin - //Add register party modus service - Result := true; - Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi); - Core.Services.AddService('Party/StartParty', nil, Self.StartParty); - Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi); -end; - -//------------- -//Is called on init process -//In this method you can hook some events and create + init -//your classes, variables etc. -//If false is returned this will cause a forced exit -//------------- -function TPartySession.Init: boolean; -begin - //Just set private var to true. - Result := true; -end; - -//------------- -//Is called if this module has been inited and there is an exit. -//Deinit is in reverse initing order -//------------- -procedure TPartySession.DeInit; -begin - //Force DeInit -end; - -//------------- -//Is called if this module will be unloaded and has been created -//Should be used to free memory -//------------- -destructor TPartySession.Destroy; -begin - //Just save some memory if it wasn't done now.. - SetLength(Modis, 0); - inherited; -end; - -//------------- -// Registers a new modus. wParam: Pointer to TUS_ModiInfo -// Service for plugins -//------------- -function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; -var - Len: integer; - Info: PUS_ModiInfo; -begin - Info := PModiInfo; - //Copy Info if cbSize is correct - if (Info.cbSize = SizeOf(TUS_ModiInfo)) then - begin - Len := Length(Modis); - SetLength(Modis, Len + 1); - - Modis[Len].Info := Info^; - end - else - Core.ReportError(integer(PChar('Plugins try to register modus with wrong pointer, or wrong TUS_ModiInfo record.')), PChar('TPartySession')); - - // FIXME: return a valid result - Result := 0; end; //---------- // Returns a number of a random plugin //---------- -function TPartySession.GetRandomPlugin(TeamMode: boolean): cardinal; +function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte; var LowestTP: byte; NumPwithLTP: word; I: integer; R: word; begin - Result := StandardModus; //If there are no matching modi, play standard modus LowestTP := high(byte); NumPwithLTP := 0; //Search for Plugins not often played yet - for I := 0 to high(Modis) do + for I := 0 to high(Plugins) do begin - if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then + if (Plugins[I].TimesPlayed < lowestTP) then begin - lowestTP := Modis[I].TimesPlayed; + lowestTP := Plugins[I].TimesPlayed; NumPwithLTP := 1; end - else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then + else if (Plugins[I].TimesPlayed = lowestTP) then begin Inc(NumPwithLTP); end; @@ -245,110 +122,89 @@ begin R := Random(NumPwithLTP); //Search for random plugin - for I := 0 to high(Modis) do + for I := 0 to high(Plugins) do begin - if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then + if Plugins[I].TimesPlayed = LowestTP then begin //Plugin found if (R = 0) then begin - Result := I; - Inc(Modis[I].TimesPlayed); + Result := Plugins[I].ID; + Inc(Plugins[I].TimesPlayed); Break; end; - Dec(R); end; end; end; //---------- -// Starts new party mode. Returns non zero on success +//StartNewParty - Reset and prepares for new party //---------- -function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; +procedure TPartySession.StartNewParty(NumRounds: Byte); var - I: integer; - aiRounds: PARounds; + Plugins: array of TPartyPlugin; TeamMode: boolean; + Len: integer; + I, J: integer; begin - Result := 0; - if (Teams.NumTeams >= 1) and (NumRounds < High(byte)-1) then - begin - bPartyMode := false; - aiRounds := PAofIRounds; - - try - //Is this team mode (More than one player per team) ? - TeamMode := true; - for I := 0 to Teams.NumTeams-1 do - TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1); - - //Set Rounds - SetLength(Rounds, NumRounds); - - for I := 0 to High(Rounds) do - begin //Set plugins - if (aiRounds[I] = -1) then - Rounds[I].Modi := GetRandomPlugin(TeamMode) - else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then - Rounds[I].Modi := aiRounds[I] - else - Rounds[I].Modi := StandardModus; - - Rounds[I].Winner := High(byte); //Set winner to not played - end; - - CurRound := High(byte); //Set CurRound to not defined + //Set current round to 1 + CurRound := 255; - //Return true and set party mode - bPartyMode := true; - Result := 1; + PlayersPlay := Teams.NumTeams; - except - Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession')); + //Get team-mode and set joker, also set TimesPlayed + TeamMode := true; + for I := 0 to Teams.NumTeams-1 do + begin + if Teams.Teaminfo[I].NumPlayers < 2 then + begin + TeamMode := false; + end; + //Set player attributes + for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do + begin + Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; end; + Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + Teams.Teaminfo[I].Score := 0; end; -end; -//---------- -// Returns pointer to Cur. ModiInfoEx (to use with sing screen) -//---------- -function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer; -begin - if (bPartyMode) and (CurRound <= High(Rounds)) then - begin //If PartyMode is enabled: - //Return the Plugin of the Cur Round - Result := integer(@Modis[Rounds[CurRound].Modi]); - end - else - begin //Return standard modus - Result := integer(@Modis[StandardModus]); + //Fill plugin array + SetLength(Plugins, 0); + for I := 0 to high(DLLMan.Plugins) do + begin + if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then + begin + //Add only those plugins playable with current PlayerConfiguration + Len := Length(Plugins); + SetLength(Plugins, Len + 1); + Plugins[Len].ID := I; + Plugins[Len].TimesPlayed := 0; + end; end; -end; -//---------- -// Stops party mode. Returns 1 if party mode was enabled before and -1 if change was not possible -//---------- -function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer; -begin - Result := -1; - if (bPartyMode) then + //Set rounds + if (Length(Plugins) >= 1) then begin - // to-do : Whitü: Check here if sing screen is not shown atm. - bPartyMode := false; - Result := 1; + SetLength (Rounds, NumRounds); + for I := 0 to NumRounds-1 do + begin + PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins); + PartySession.Rounds[I].Winner := 255; + end; end else - Result := 0; + SetLength (Rounds, 0); end; -//---------- -//GetRandomPlayer - gives back a random player to play next round -//---------- +{** + * Returns a random player to play next round + *} function TPartySession.GetRandomPlayer(Team: byte): byte; var I, R: integer; - lowestTP: byte; + LowestTP: byte; NumPwithLTP: byte; begin LowestTP := high(byte); @@ -369,7 +225,7 @@ begin end; end; - //Create random no + //Create random number R := Random(NumPwithLTP); //Search for random player @@ -389,202 +245,83 @@ begin end; end; -//---------- -// NextRound - Increases CurRound by 1; Returns num of round or -1 if last round is already played -//---------- -function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer; +{** + * Prepares ScreenSingModi for next round and loads plugin + *} +procedure TPartySession.StartRound; var I: integer; begin - if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then - begin //everythings OK! -> Start the Round, maaaaan + if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + begin + //Increase Current Round Inc(CurRound); - //Set Players to play this Round + Rounds[CurRound].Winner := 255; + DllMan.LoadPlugin(Rounds[CurRound].Plugin); + + //Select Players for I := 0 to Teams.NumTeams-1 do Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - // FIXME: return a valid result - Result := 0; - end - else - Result := -1; -end; - -//---------- -//IsWinner - returns true if the players bit is set in the winner byte -//---------- -function TPartySession.IsWinner(Player, Winner: byte): boolean; -var - Bit: byte; -begin - Bit := 1 shl Player; - Result := ((Winner and Bit) = Bit); -end; - -//---------- -//GenScores - inc scores for cur. round -//---------- -procedure TPartySession.GenScores; -var - I: byte; -begin - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); - end; -end; - -//---------- -// CallModiInit - calls CurModis Init Proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading -//---------- -function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer; -begin - if (not bPartyMode) then - begin //Set rounds if not in party mode - SetLength(Rounds, 1); - Rounds[0].Modi := StandardModus; - Rounds[0].Winner := High(byte); - CurRound := 0; + //Set ScreenSingModie Variables + ScreenSingModi.TeamInfo := Teams; end; - - try - //Core. - except - on E : Exception do - begin - Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession')); - if (Rounds[CurRound].Modi = StandardModus) then - begin - Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession')); - Halt; - end - else //Select standard modus - begin - Rounds[CurRound].Modi := StandardModus - end; - end; - end; - - // FIXME: return a valid result - Result := 0; end; //---------- -// CallModiDeInit - calls DeInitProc and ends the round +//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray //---------- -function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; +procedure TPartySession.EndRound; var - I: integer; - MaxScore: word; + I: Integer; begin - if (bPartyMode) then - begin - //Get Winner Byte! - if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get winners from plugin - Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID) - else - begin //Create winners by score :/ - Rounds[CurRound].Winner := 0; - MaxScore := 0; - for I := 0 to Teams.NumTeams-1 do - begin - // to-do : recode percentage stuff - //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999; - if (Player[I].ScoreTotalInt > MaxScore) then - begin - MaxScore := Player[I].ScoreTotalInt; - Rounds[CurRound].Winner := 1 shl I; - end - else if (Player[I].ScoreTotalInt = MaxScore) and (Player[I].ScoreTotalInt <> 0) then - begin - Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I); - end; - end; - + //Copy Winner + Rounds[CurRound].Winner := ScreenSingModi.Winner; + //Set Scores + GenScores; - //When nobody has points -> everybody looses - if (MaxScore = 0) then - Rounds[CurRound].Winner := 0; + //Increase TimesPlayed 4 all Players + For I := 0 to Teams.NumTeams-1 do + Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); - end; - - //Generate the scores - GenScores; - - //Inc players TimesPlayed - if ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings and MLS_IncTP) = MLS_IncTP) then - begin - for I := 0 to Teams.NumTeams-1 do - Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed); - end; - end - else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then - Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID); - - // FIXME: return a valid result - Result := 0; end; //---------- -// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success +//IsWinner - returns true if the player's bit is set in the winner byte //---------- -function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +function TPartySession.IsWinner(Player, Winner: byte): boolean; var - Info: ^TTeamInfo; + Mask: byte; begin - Result := -1; - Info := pTeamInfo; - if (Info <> nil) then - begin - try - // to - do : Check Delphi memory management in this case - //Not sure if i had to copy PChars to a new address or if delphi manages this o0 - Info^ := Teams; - Result := 0; - except - Result := -2; - end; - end; + Mask := 1 shl Player; + Result := (Winner and Mask) <> 0; end; //---------- -// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success +//GenScores - increase scores for current round //---------- -function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; +procedure TPartySession.GenScores; var - TeamInfobackup: TTeamInfo; - Info: ^TTeamInfo; + I: byte; begin - Result := -1; - Info := pTeamInfo; - if (Info <> nil) then + for I := 0 to Teams.NumTeams-1 do begin - try - TeamInfoBackup := Teams; - // to - do : Check Delphi memory management in this case - //Not sure if i had to copy PChars to a new address or if delphi manages this o0 - Teams := Info^; - Result := 0; - except - Teams := TeamInfoBackup; - Result := -2; - end; + if isWinner(I, Rounds[CurRound].Winner) then + Inc(Teams.Teaminfo[I].Score); end; end; //---------- -// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ... +//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...] //---------- -function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetTeamOrder: TeamOrderArray; var I, J: integer; ATeams: array [0..5] of TeamOrderEntry; TempTeam: TeamOrderEntry; begin - // to-do : PartyMode: Write this in another way, so that teams with the same score get the same place + // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place //Fill Team array for I := 0 to Teams.NumTeams-1 do begin @@ -603,63 +340,44 @@ begin end; //Copy to Result - Result := 0; for I := 0 to Teams.NumTeams-1 do - Result := Result or (ATeams[I].TeamNum Shl I*3); + Result[I] := ATeams[I].TeamNum; end; //---------- -// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam +//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , //---------- -function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer; +function TPartySession.GetWinnerString(Round: byte): string; var - Winners: array of String; + Winners: array of string; I: integer; - ResultStr: String; - S: ^String; begin - ResultStr := Language.Translate('PARTY_NOBODY'); + Result := Language.Translate('PARTY_NOBODY'); + + if (Round > High(Rounds)) then + exit; - if (wParam <= High(Rounds)) then + if (Rounds[Round].Winner = 0) then begin - if (Rounds[wParam].Winner <> 0) then - begin - if (Rounds[wParam].Winner = 255) then - begin - ResultStr := Language.Translate('PARTY_NOTPLAYEDYET'); - end - else - begin - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do - begin - if isWinner(I, Rounds[wParam].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - ResultStr := Language.Implode(Winners); - end; - end; + exit; end; - //Now return what we have got - if (lParam = nil) then - begin //Return string length - Result := Length(ResultStr); - end - else - begin //Return string - try - S := lParam; - S^ := ResultStr; - Result := 0; - except - Result := -1; + if (Rounds[Round].Winner = 255) then + begin + Result := Language.Translate('PARTY_NOTPLAYEDYET'); + exit; + end; + SetLength(Winners, 0); + for I := 0 to Teams.NumTeams-1 do + begin + if isWinner(I, Rounds[Round].Winner) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := Teams.TeamInfo[I].Name; end; end; + Result := Language.Implode(Winners); end; end. diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas deleted file mode 100644 index f299796f..00000000 --- a/src/base/UPluginInterface.pas +++ /dev/null @@ -1,186 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit uPluginInterface; -{********************* - uPluginInterface - Unit fills a TPluginInterface structure with method pointers - Unit contains all functions called directly by plugins -*********************} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - uPluginDefs; - -//--------------- -// Methods for Plugin -//--------------- - {******** Hook specific Methods ********} - {Function Creates a new Hookable Event and Returns the Handle - or 0 on Failure. (Name already exists)} - Function CreateHookableEvent (EventName: PChar): THandle; stdcall; - - {Function Destroys an Event and Unhooks all Hooks to this Event. - 0 on success, not 0 on Failure} - Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; - - {Function start calling the Hook Chain - 0 if Chain is called until the End, -1 if Event Handle is not valid - otherwise Return Value of the Hook that breaks the Chain} - Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; - - {Function Hooks an Event by Name. - Returns Hook Handle on Success, otherwise 0} - Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; - - {Function Removes the Hook from the Chain - Returns 0 on Success} - Function UnHookEvent (hHook: THandle): Integer; stdcall; - - {Function Returns Non Zero if a Event with the given Name Exists, - otherwise 0} - Function EventExists (EventName: PChar): Integer; stdcall; - - {******** Service specific Methods ********} - {Function Creates a new Service and Returns the Services Handle - or 0 on Failure. (Name already exists)} - Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; - - {Function Destroys a Service. - 0 on success, not 0 on Failure} - Function DestroyService (hService: THandle): integer; stdcall; - - {Function Calls a Services Proc - Returns Services Return Value or SERVICE_NOT_FOUND on Failure} - Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; - - {Function Returns Non Zero if a Service with the given Name Exists, - otherwise 0} - Function ServiceExists (ServiceName: PChar): Integer; stdcall; - -implementation -uses UCore; - -{******** Hook specific Methods ********} -//--------------- -// Function Creates a new Hookable Event and Returns the Handle -// or 0 on Failure. (Name already exists) -//--------------- -Function CreateHookableEvent (EventName: PChar): THandle; stdcall; -begin - Result := Core.Hooks.AddEvent(EventName); -end; - -//--------------- -// Function Destroys an Event and Unhooks all Hooks to this Event. -// 0 on success, not 0 on Failure -//--------------- -Function DestroyHookableEvent (hEvent: THandle): integer; stdcall; -begin - Result := Core.Hooks.DelEvent(hEvent); -end; - -//--------------- -// Function start calling the Hook Chain -// 0 if Chain is called until the End, -1 if Event Handle is not valid -// otherwise Return Value of the Hook that breaks the Chain -//--------------- -Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam); -end; - -//--------------- -// Function Hooks an Event by Name. -// Returns Hook Handle on Success, otherwise 0 -//--------------- -Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall; -begin - Result := Core.Hooks.AddSubscriber(EventName, HookProc); -end; - -//--------------- -// Function Removes the Hook from the Chain -// Returns 0 on Success -//--------------- -Function UnHookEvent (hHook: THandle): Integer; stdcall; -begin - Result := Core.Hooks.DelSubscriber(hHook); -end; - -//--------------- -// Function Returns Non Zero if a Event with the given Name Exists, -// otherwise 0 -//--------------- -Function EventExists (EventName: PChar): Integer; stdcall; -begin - Result := Core.Hooks.EventExists(EventName); -end; - - {******** Service specific Methods ********} -//--------------- -// Function Creates a new Service and Returns the Services Handle -// or 0 on Failure. (Name already exists) -//--------------- -Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall; -begin - Result := Core.Services.AddService(ServiceName, ServiceProc); -end; - -//--------------- -// Function Destroys a Service. -// 0 on success, not 0 on Failure -//--------------- -Function DestroyService (hService: THandle): integer; stdcall; -begin - Result := Core.Services.DelService(hService); -end; - -//--------------- -// Function Calls a Services Proc -// Returns Services Return Value or SERVICE_NOT_FOUND on Failure -//--------------- -Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall; -begin - Result := Core.Services.CallService(ServiceName, wParam, lParam); -end; - -//--------------- -// Function Returns Non Zero if a Service with the given Name Exists, -// otherwise 0 -//--------------- -Function ServiceExists (ServiceName: PChar): Integer; stdcall; -begin - Result := Core.Services.ServiceExists(ServiceName); -end; - -end. diff --git a/src/base/UPluginLoader.pas b/src/base/UPluginLoader.pas deleted file mode 100644 index 8836cb78..00000000 --- a/src/base/UPluginLoader.pas +++ /dev/null @@ -1,794 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/uPluginLoader.pas $ - * $Id: uPluginLoader.pas 1403 2008-09-23 21:17:22Z k-m_schindler $ - *} - -unit UPluginLoader; -{********************* - UPluginLoader - Unit contains two classes - TPluginLoader: Class searching for and loading the plugins - TtehPlugins: Class representing the plugins in modules chain -*********************} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UPluginDefs, - UCoreModule, - UPath; - -type - TPluginListItem = record - Info: TUS_PluginInfo; - State: byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error - Path: string; // path to this plugin - NeedsDeInit: boolean; // if this is inited correctly this should be true - hLib: THandle; // handle of loaded libary - Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader - Load: Func_Load; - Init: Func_Init; - DeInit: Proc_DeInit; - end; - end; - {********************* - TPluginLoader - Class searches for plugins and manages loading and unloading - *********************} - PPluginLoader = ^TPluginLoader; - TPluginLoader = class (TCoreModule) - private - LoadingProcessFinished: boolean; - sUnloadPlugin: THandle; - sLoadPlugin: THandle; - sGetPluginInfo: THandle; - sGetPluginState: THandle; - - procedure FreePlugin(Index: integer); - public - PluginInterface: TUS_PluginInterface; - Plugins: array of TPluginListItem; - - // TCoreModule methods to inherit - constructor Create; override; - procedure Info(const pInfo: PModuleInfo); override; - function Load: boolean; override; - function Init: boolean; override; - procedure DeInit; override; - Destructor Destroy; override; - - // New methods - procedure BrowseDir(Path: string); // browses the path at _Path_ for plugins - function PluginExists(Name: string): integer; // if plugin exists: Index of plugin, else -1 - procedure AddPlugin(Filename: string); // adds plugin to the array - - function CallLoad(Index: integer): integer; - function CallInit(Index: integer): integer; - procedure CallDeInit(Index: integer); - - //Services offered - function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin - function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam) - function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam)) - - end; - - {********************* - TtehPlugins - Class represents the plugins in module chain. - It calls the plugins procs and funcs - *********************} - TtehPlugins = class (TCoreModule) - private - PluginLoader: PPluginLoader; - public - // TCoreModule methods to inherit - constructor Create; override; - - procedure Info(const pInfo: PModuleInfo); override; - function Load: boolean; override; - function Init: boolean; override; - procedure DeInit; override; - end; - -const -{$IF Defined(MSWINDOWS)} - PluginFileExtension = '.dll'; -{$ELSEIF Defined(DARWIN)} - PluginFileExtension = '.dylib'; -{$ELSEIF Defined(UNIX)} - PluginFileExtension = '.so'; -{$IFEND} - -implementation - -uses - UCore, - UPluginInterface, -{$IFDEF MSWINDOWS} - windows, -{$ELSE} - dynlibs, -{$ENDIF} - UMain, - SysUtils; - -{********************* - TPluginLoader - Implementation -*********************} - -//------------- -// function that gives some infos about the module to the core -//------------- -procedure TPluginLoader.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TPluginLoader'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Searches for plugins, loads and unloads them'; -end; - -//------------- -// Just the constructor -//------------- -constructor TPluginLoader.Create; -begin - inherited; - - // Init PluginInterface - // Using methods from UPluginInterface - PluginInterface.CreateHookableEvent := CreateHookableEvent; - PluginInterface.DestroyHookableEvent := DestroyHookableEvent; - PluginInterface.NotivyEventHooks := NotivyEventHooks; - PluginInterface.HookEvent := HookEvent; - PluginInterface.UnHookEvent := UnHookEvent; - PluginInterface.EventExists := EventExists; - - PluginInterface.CreateService := @CreateService; - PluginInterface.DestroyService := DestroyService; - PluginInterface.CallService := CallService; - PluginInterface.ServiceExists := ServiceExists; - - // UnSet private var - LoadingProcessFinished := false; -end; - -//------------- -// Is called on loading. -// In this method only events and services should be created -// to offer them to other modules or plugins during the init process -// if false is returned this will cause a forced exit -//------------- -function TPluginLoader.Load: boolean; -begin - Result := true; - - try - // Start searching for plugins - BrowseDir(PluginPath); - except - Result := false; - Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader')); - end; -end; - -//------------- -// Is called on init process -// In this method you can hook some events and create + init -// your classes, variables etc. -// If false is returned this will cause a forced exit -//------------- -function TPluginLoader.Init: boolean; -begin - // Just set private var to true. - LoadingProcessFinished := true; - Result := true; -end; - -//------------- -// Is called if this module has been inited and there is a exit. -// Deinit is in backwards initing order -//------------- -procedure TPluginLoader.DeInit; -var - I: integer; -begin - // Force deinit - // if some plugins aren't deinited for some reason o0 - for I := 0 to High(Plugins) do - begin - if (Plugins[I].State < 4) then - FreePlugin(I); - end; - - // Nothing to do here. Core will remove the hooks -end; - -//------------- -// Is called if this module will be unloaded and has been created -// Should be used to free memory -//------------- -Destructor TPluginLoader.Destroy; -begin - // Just save some memory if it wasn't done now.. - SetLength(Plugins, 0); - inherited; -end; - -//-------------- -// Browses the path at _Path_ for plugins -//-------------- -procedure TPluginLoader.BrowseDir(Path: string); -var - SR: TSearchRec; -begin - // Search for other dirs to browse - if FindFirst(Path + '*', faDirectory, SR) = 0 then begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - BrowseDir(Path + Sr.Name + PathDelim); - until FindNext(SR) <> 0; - end; - FindClose(SR); - - // Search for plugins at path - if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then - begin - repeat - AddPlugin(Path + SR.Name); - until FindNext(SR) <> 0; - end; - FindClose(SR); -end; - -//-------------- -// If plugin exists: Index of plugin, else -1 -//-------------- -function TPluginLoader.PluginExists(Name: string): integer; -var - I: integer; -begin - Result := -1; - - if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then - begin - for I := 0 to High(Plugins) do - if (Plugins[I].Info.Name = Name) then - begin //Found the Plugin - Result := I; - Break; - end; - end; -end; - -//-------------- -// Adds plugin to the array -//-------------- -procedure TPluginLoader.AddPlugin(Filename: string); -var - hLib: THandle; - PInfo: Proc_PluginInfo; - Info: TUS_PluginInfo; - PluginID: integer; -begin - if (FileExists(Filename)) then - begin //Load Libary - hLib := LoadLibrary(PChar(Filename)); - if (hLib <> 0) then - begin // Try to get address of the info proc - PInfo := GetProcAddress (hLib, PChar('USPlugin_Info')); - if (@PInfo <> nil) then - begin - Info.cbSize := SizeOf(TUS_PluginInfo); - - try // Call info proc - PInfo(@Info); - except - Info.Name := ''; - Core.ReportError(integer(PChar('Error getting plugin info: ' + Filename)), PChar('TPluginLoader')); - end; - - // Is name set ? - if (Trim(Info.Name) <> '') then - begin - PluginID := PluginExists(Info.Name); - - if (PluginID > 0) and (Plugins[PluginID].State >=4) then - PluginID := -1; - - if (PluginID = -1) then - begin - // Add new item to array - PluginID := Length(Plugins); - SetLength(Plugins, PluginID + 1); - - // Fill with info: - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := false; - Plugins[PluginID].hLib := hLib; - - // Try to get procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then - begin - Plugins[PluginID].State := 255; - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - - // Emulate loading process if this plugin is loaded too late - if (LoadingProcessFinished) then - begin - CallLoad(PluginID); - CallInit(PluginID); - end; - end - else if (LoadingProcessFinished = false) then - begin - if (Plugins[PluginID].Info.Version < Info.Version) then - begin // Found newer version of this plugin - Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + string(Info.Name))), PChar('TPluginLoader')); - - // Unload old plugin - UnloadPlugin(PluginID, nil); - - // Fill with new info - Plugins[PluginID].Info := Info; - Plugins[PluginID].State := 0; - Plugins[PluginID].Path := Filename; - Plugins[PluginID].NeedsDeInit := false; - Plugins[PluginID].hLib := hLib; - - // Try to get procs - Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load')); - Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init')); - Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit')); - - if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then - begin - FreeLibrary(hLib); - Plugins[PluginID].State := 255; - Core.ReportError(integer(PChar('Can''t get plugin procs from libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin // Newer Version already loaded - FreeLibrary(hLib); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Plugin with this name already exists: ' + string(Info.Name))), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - begin - FreeLibrary(hLib); - Core.ReportError(integer(PChar('Can''t find info procedure: ' + Filename)), PChar('TPluginLoader')); - end; - end - else - Core.ReportError(integer(PChar('Can''t load plugin libary: ' + Filename)), PChar('TPluginLoader')); - end; -end; - -//-------------- -// Calls load func of plugin with the given index -//-------------- -function TPluginLoader.CallLoad(Index: integer): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then - begin - try - Result := Plugins[Index].Procs.Load(@PluginInterface); - except - Result := -3; - end; - - if (Result = 0) then - Plugins[Index].State := 1 - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling load function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls init func of plugin with the given index -//-------------- -function TPluginLoader.CallInit(Index: integer): integer; -begin - Result := -2; - if(Index < Length(Plugins)) then - begin - if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then - begin - try - Result := Plugins[Index].Procs.Init(@PluginInterface); - except - Result := -3; - end; - - if (Result = 0) then - begin - Plugins[Index].State := 2; - Plugins[Index].NeedsDeInit := true; - end - else - begin - FreePlugin(Index); - Plugins[Index].State := 255; - Core.ReportError(integer(PChar('Error calling init function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader')); - end; - end; - end; -end; - -//-------------- -// Calls deinit proc of plugin with the given index -//-------------- -procedure TPluginLoader.CallDeInit(Index: integer); -begin - if(Index < Length(Plugins)) then - begin - if (Plugins[Index].State < 4) then - begin - if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then - try - Plugins[Index].Procs.DeInit(@PluginInterface); - except - - end; - - // Don't forget to remove services and subscriptions by this plugin - Core.Hooks.DelbyOwner(-1 - Index); - - FreePlugin(Index); - end; - end; -end; - -//-------------- -// Frees all plugin sources (procs and handles) - helper for deiniting functions -//-------------- -procedure TPluginLoader.FreePlugin(Index: integer); -begin - Plugins[Index].State := 4; - Plugins[Index].Procs.Load := nil; - Plugins[Index].Procs.Init := nil; - Plugins[Index].Procs.DeInit := nil; - - if (Plugins[Index].hLib <> 0) then - FreeLibrary(Plugins[Index].hLib); -end; - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin -//-------------- -function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sFile: string; -begin - Result := -1; - sFile := ''; - // lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin //lParam is PChar - try - sFile := string(PChar(lParam)); - Index := PluginExists(sFile); - if (Index < 0) and FileExists(sFile) then - begin // Is filename - AddPlugin(sFile); - Result := Plugins[High(Plugins)].State; - end; - except - Index := -2; - end; - end; - - if (Index >= 0) and (Index < Length(Plugins)) then - begin - AddPlugin(Plugins[Index].Path); - Result := Plugins[Index].State; - end; -end; - -//-------------- -// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin -//-------------- -function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; -var - Index: integer; - sName: string; -begin - Result := -1; - // lParam is ID - if (lParam = nil) then - begin - Index := wParam; - end - else - begin // wParam is PChar - try - sName := string(PChar(lParam)); - Index := PluginExists(sName); - except - Index := -2; - end; - end; - - if (Index >= 0) and (Index < Length(Plugins)) then - CallDeInit(Index) -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of moduleinfo array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of plugin with Index(wParam) to address at lParam) -//-------------- -function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := 0; - if (wParam > 0) then - begin // Get info of 1 plugin - if (lParam <> nil) and (wParam < Length(Plugins)) then - begin - try - Result := 1; - PUS_PluginInfo(lParam)^ := Plugins[wParam].Info; - except - - end; - end; - end - else if (lParam = nil) then - begin // Get length of plugin (info) array - Result := Length(Plugins); - end - else //Write PluginInfo Array to Address in lParam - begin - try - for I := 0 to high(Plugins) do - PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader')); - end; - end; - -end; - -//-------------- -// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of byte to address at lparam) else (return state of plugin with index(wParam)) -//-------------- -function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer; -var I: integer; -begin - Result := -1; - if (wParam > 0) then - begin // Get state of 1 plugin - if (wParam < Length(Plugins)) then - begin - Result := Plugins[wParam].State; - end; - end - else if (lParam = nil) then - begin // Get length of plugin (info) array - Result := Length(Plugins); - end - else // Write plugininfo array to address in lParam - begin - try - for I := 0 to high(Plugins) do - byte(Pointer(integer(lParam) + I)^) := Plugins[I].State; - Result := Length(Plugins); - except - Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader')); - end; - end; -end; - -{********************* - TtehPlugins - Implementation -*********************} - -//------------- -// function that gives some infos about the module to the core -//------------- -procedure TtehPlugins.Info(const pInfo: PModuleInfo); -begin - pInfo^.Name := 'TtehPlugins'; - pInfo^.Version := MakeVersion(1,0,0,chr(0)); - pInfo^.Description := 'Module executing the Plugins!'; -end; - -//------------- -// Just the constructor -//------------- -constructor TtehPlugins.Create; -begin - inherited; - PluginLoader := nil; -end; - -//------------- -// Is called on loading. -// In this method only events and services should be created -// to offer them to other modules or plugins during the init process -// if false is returned this will cause a forced exit -//------------- -function TtehPlugins.Load: boolean; -var - i: integer; // Counter - CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute -begin - // Get pointer to pluginloader - PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader')); - if (PluginLoader = nil) then - begin - Result := false; - Core.ReportError(integer(PChar('Could not get pointer to pluginLoader')), PChar('TtehPlugins')); - end - else - begin - Result := true; - - // Backup curexecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loading the plugins - for i := 0 to High(PluginLoader.Plugins) do - begin - Core.CurExecuted := -1 - i; - - try - // Unload plugin if not correctly executed - if (PluginLoader.CallLoad(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; // Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - begin - Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - except - // Plugin could not be loaded. - // => Show error message, then shutdown plugin - on E: Exception do - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; // Plugin causes error - Core.ReportError(integer(PChar('Plugin causes error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins')); - end; - end; - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; -end; - -//------------- -// Is called on init process -// in this method you can hook some events and create + init -// your classes, variables etc. -// if false is returned this will cause a forced exit -//------------- -function TtehPlugins.Init: boolean; -var - i: integer; // Counter - CurExecutedBackup: integer; // backup of Core.CurExecuted attribute -begin - Result := true; - - // Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loading the plugins - for i := 0 to High(PluginLoader.Plugins) do - try - Core.CurExecuted := -1 - i; - - // Unload plugin if not correctly executed - if (PluginLoader.CallInit(i) <> 0) then - begin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 254; //Plugin asks for unload - Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end - else - Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - except - // Plugin could not be loaded. - // => Show error message, then shut down plugin - PluginLoader.CallDeInit(i); - PluginLoader.Plugins[i].State := 255; //Plugin causes Error - Core.ReportError(integer(PChar('Plugin causes error during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins')); - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -//------------- -// Is called if this module has been inited and there is a exit. -// Deinit is in backwards initing order -//------------- -procedure TtehPlugins.DeInit; -var - i: integer; // Counter - CurExecutedBackup: integer; // backup of Core.CurExecuted attribute -begin - // Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - // Start loop - - for i := 0 to High(PluginLoader.Plugins) do - begin - try - // DeInit plugin - PluginLoader.CallDeInit(i); - except - end; - end; - - // Reset CurExecuted - Core.CurExecuted := CurExecutedBackup; -end; - -end. diff --git a/src/base/UServices.pas b/src/base/UServices.pas deleted file mode 100644 index 3783c543..00000000 --- a/src/base/UServices.pas +++ /dev/null @@ -1,384 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UServices; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - uPluginDefs, - SysUtils; -{********************* - TServiceManager - Class for saving, managing and calling of Services. - Saves all Services and their Procs -*********************} - -type - TServiceName = String[60]; - PServiceInfo = ^TServiceInfo; - TServiceInfo = record - Self: THandle; //Handle of this Service - Hash: Integer; //4 Bit Hash of the Services Name - Name: TServiceName; //Name of this Service - - Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1] - - Next: PServiceInfo; //Pointer to the Next Service in teh list - - //Here is s/t tricky - //To avoid writing of Wrapping Functions to offer a Service from a Class - //We save a Normal Proc or a Method of a Class - Case isClass: boolean of - False: (Proc: TUS_Service); //Proc that will be called on Event - True: (ProcOfClass: TUS_Service_of_Object); - end; - - TServiceManager = class - private - //Managing Service List - FirstService: PServiceInfo; - LastService: PServiceInfo; - - //Some Speed improvement by caching the last 4 called Services - //Most of the time a Service is called multiple times - ServiceCache: Array[0..3] of PServiceInfo; - NextCacheItem: Byte; - - //Next Service added gets this Handle: - NextHandle: THandle; - public - Constructor Create; - - Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle; - Function DelService(const hService: THandle): integer; - - Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; - - Function NametoHash(const ServiceName: TServiceName): Integer; - Function ServiceExists(const ServiceName: PChar): Integer; - end; - -var - ServiceManager: TServiceManager; - -implementation -uses - ULog, - UCore; - -//------------ -// Create - Creates Class and Set Standard Values -//------------ -Constructor TServiceManager.Create; -begin - inherited; - - FirstService := nil; - LastService := nil; - - ServiceCache[0] := nil; - ServiceCache[1] := nil; - ServiceCache[2] := nil; - ServiceCache[3] := nil; - - NextCacheItem := 0; - - NextHandle := 1; - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Succesful created!'); - {$ENDIF} -end; - -//------------ -// Function Creates a new Service and Returns the Services Handle, -// 0 on Failure. (Name already exists) -//------------ -Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle; -var - Cur: PServiceInfo; -begin - Result := 0; - - If (@Proc <> nil) or (@ProcOfClass <> nil) then - begin - If (ServiceExists(ServiceName) = 0) then - begin //There is a Proc and the Service does not already exist - //Ok Add it! - - //Get Memory - GetMem(Cur, SizeOf(TServiceInfo)); - - //Fill it with Data - Cur.Next := nil; - - If (@Proc = nil) then - begin //Use the ProcofClass Method - Cur.isClass := True; - Cur.ProcOfClass := ProcofClass; - end - else //Use the normal Proc - begin - Cur.isClass := False; - Cur.Proc := Proc; - end; - - Cur.Self := NextHandle; - //Zero Name - Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - Cur.Name := String(ServiceName); - Cur.Hash := NametoHash(Cur.Name); - - //Add Owner to Service - Cur.Owner := Core.CurExecuted; - - //Add Service to the List - If (FirstService = nil) then - FirstService := Cur; - - If (LastService <> nil) then - LastService.Next := Cur; - - LastService := Cur; - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); - {$ENDIF} - - //Inc Next Handle - Inc(NextHandle); - end - {$IFDEF DEBUG} - else debugWriteln('ServiceManager: Try to readd Service: ' + ServiceName); - {$ENDIF} - end; -end; - -//------------ -// Function Destroys a Service, 0 on success, not 0 on Failure -//------------ -Function TServiceManager.DelService(const hService: THandle): integer; -var - Last, Cur: PServiceInfo; - I: Integer; -begin - Result := -1; - - Last := nil; - Cur := FirstService; - - //Search for Service to Delete - While (Cur <> nil) do - begin - If (Cur.Self = hService) then - begin //Found Service => Delete it - - //Delete from List - If (Last = nil) then //Found first Service - FirstService := Cur.Next - Else //Service behind the first - Last.Next := Cur.Next; - - //IF this is the LastService, correct LastService - If (Cur = LastService) then - LastService := Last; - - //Search for Service in Cache and delete it if found - For I := 0 to High(ServiceCache) do - If (ServiceCache[I] = Cur) then - begin - ServiceCache[I] := nil; - end; - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Removed Service succesful: ' + Cur.Name); - {$ENDIF} - - //Free Memory - Freemem(Cur, SizeOf(TServiceInfo)); - - //Break the Loop - Break; - end; - - //Go to Next Service - Last := Cur; - Cur := Cur.Next; - end; -end; - -//------------ -// Function Calls a Services Proc -// Returns Services Return Value or SERVICE_NOT_FOUND on Failure -//------------ -Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer; -var - SExists: Integer; - Service: PServiceInfo; - CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute -begin - Result := SERVICE_NOT_FOUND; - SExists := ServiceExists(ServiceName); - If (SExists <> 0) then - begin - //Backup CurExecuted - CurExecutedBackup := Core.CurExecuted; - - Service := Pointer(SExists); - - If (Service.isClass) then - //Use Proc of Class - Result := Service.ProcOfClass(wParam, lParam) - Else - //Use normal Proc - Result := Service.Proc(wParam, lParam); - - //Restore CurExecuted - Core.CurExecuted := CurExecutedBackup; - end; - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); - {$ENDIF} -end; - -//------------ -// Generates the Hash for the given Name -//------------ -Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; -// FIXME: check if the non-asm version is fast enough and use it by default if so -{$IF Defined(CPUX86_64)} -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} -asm - { CL: Counter; RAX: Result; RDX: Current Memory Address } - Mov RCX, 14 - Mov RDX, ServiceName {Save Address of String that should be "Hashed"} - Mov RAX, [RDX] - @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile } - ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash} - LOOP @FoldLoop {Fold again if there are Chars Left} -end; -{$ELSEIF Defined(CPU386) or Defined(CPUI386)} -{$IFDEF FPC} - {$ASMMODE Intel} -{$ENDIF} -asm - { CL: Counter; EAX: Result; EDX: Current Memory Address } - Mov ECX, 14 {Init Counter, Fold 14 Times to get 4 Bytes out of 60} - Mov EDX, ServiceName {Save Address of String that should be "Hashed"} - Mov EAX, [EDX] - @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile } - ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash} - LOOP @FoldLoop {Fold again if there are Chars Left} -end; -{$ELSE} -var - i: integer; - ptr: ^integer; -begin - ptr := @ServiceName; - Result := 0; - for i := 1 to 14 do - begin - Result := Result + ptr^; - Inc(ptr); - end; -end; -{$IFEND} - - -//------------ -// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0 -//------------ -Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer; -var - Name: TServiceName; - Hash: Integer; - Cur: PServiceInfo; - I: Byte; -begin - Result := 0; - // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;) - //Zero Name: - Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0; - //Add Service Name - Name := String(ServiceName); - Hash := NametoHash(Name); - - //First of all Look for the Service in Cache - For I := 0 to High(ServiceCache) do - begin - If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then - begin - If (ServiceCache[I].Name = Name) then - begin //Found Service in Cache - Result := Integer(ServiceCache[I]); - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Found Service in Cache: ''' + ServiceName + ''''); - {$ENDIF} - - Break; - end; - end; - end; - - If (Result = 0) then - begin - Cur := FirstService; - While (Cur <> nil) do - begin - If (Cur.Hash = Hash) then - begin - If (Cur.Name = Name) then - begin //Found the Service - Result := Integer(Cur); - - {$IFDEF DEBUG} - debugWriteln('ServiceManager: Found Service in List: ''' + ServiceName + ''''); - {$ENDIF} - - //Add to Cache - ServiceCache[NextCacheItem] := Cur; - NextCacheItem := (NextCacheItem + 1) AND 3; - Break; - end; - end; - - Cur := Cur.Next; - end; - end; -end; - -end. -- cgit v1.2.3 From da59aa15bc4f42de0268d389a8d7dca1bbf19ee7 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 21 Mar 2009 23:51:48 +0000 Subject: party fix for linux: - plugin-path from UPath used - calling convention must be cdecl for a non-windows os git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1646 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDLLManager.pas | 23 +++++++++++------------ 1 file changed, 11 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index cd4b7991..9ecee34a 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -69,8 +69,6 @@ var DLLMan: TDLLMan; const - DLLPath = 'Plugins'; - {$IF Defined(MSWINDOWS)} DLLExt = '.dll'; {$ELSEIF Defined(DARWIN)} @@ -87,6 +85,7 @@ uses {$ELSE} dynlibs, {$ENDIF} + UPath, ULog, SysUtils; @@ -104,7 +103,7 @@ var SR: TSearchRec; begin - if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then + if FindFirst(PluginPath + '*' + DLLExt, faAnyFile , SR) = 0 then begin repeat SetLength(Plugins, Length(Plugins)+1); @@ -174,18 +173,18 @@ begin exit; } //Load Libary - hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename)); + hLibg := LoadLibrary(PChar(PluginPath + Filename)); //If Loaded if (hLibg <> 0) then begin //Load Info Procedure - @Info := GetProcAddress (hLibg, PChar('PluginInfo')); + @Info := GetProcAddress(hLibg, PChar('PluginInfo')); //If Loaded if (@Info <> nil) then begin //Load PluginInfo - Info (Plugins[No]); + Info(Plugins[No]); Result := True; end else @@ -193,22 +192,22 @@ begin FreeLibrary (hLibg); end - else - Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); + else + Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); end; function TDLLMan.LoadPlugin(No: Cardinal): boolean; begin Result := False; //Load Libary - hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No])); + hLib := LoadLibrary(PChar(PluginPath + PluginPaths[No])); //If Loaded if (hLib <> 0) then begin //Load Info Procedure - @P_Init := GetProcAddress (hLib, PChar('Init')); - @P_Draw := GetProcAddress (hLib, PChar('Draw')); - @P_Finish := GetProcAddress (hLib, PChar('Finish')); + @P_Init := GetProcAddress (hLib, 'Init'); + @P_Draw := GetProcAddress (hLib, 'Draw'); + @P_Finish := GetProcAddress (hLib, 'Finish'); //If Loaded if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then -- cgit v1.2.3 From 53ffb1c4bfc26bf65fdca79a8e6d20a1e2ba846d Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 23 Mar 2009 07:24:25 +0000 Subject: cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1649 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatform.pas | 24 ++++++++++++------------ 1 file changed, 12 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index e4cb6f0c..6f13481c 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -43,9 +43,9 @@ uses type TDirectoryEntry = record - Name : WideString; - IsDirectory : boolean; - IsFile : boolean; + Name: WideString; + IsDirectory: boolean; + IsFile: boolean; end; TDirectoryEntryArray = array of TDirectoryEntry; @@ -54,12 +54,12 @@ type function GetExecutionDir(): string; procedure Init; virtual; function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract; - function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual; + function TerminateIfAlreadyRunning(var WndTitle: string): boolean; virtual; function FindSongFile(Dir, Mask: WideString): WideString; virtual; procedure Halt; virtual; - function GetLogPath : WideString; virtual; abstract; - function GetGameSharedPath : WideString; virtual; abstract; - function GetGameUserPath : WideString; virtual; abstract; + function GetLogPath: WideString; virtual; abstract; + function GetGameSharedPath: WideString; virtual; abstract; + function GetGameUserPath: WideString; virtual; abstract; function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual; end; @@ -79,13 +79,13 @@ uses ULog; -// I have modified it to use the Platform_singleton in this location ( in the implementaiton ) +// I modified it to use the Platform_singleton in this location (in the implementation) // so that this variable can NOT be overwritten from anywhere else in the application. // the accessor function platform, emulates all previous calls to work the same way. var - Platform_singleton : TPlatform; + Platform_singleton: TPlatform; -function Platform : TPlatform; +function Platform: TPlatform; begin Result := Platform_singleton; end; @@ -117,7 +117,7 @@ end; (** * Default TerminateIfAlreadyRunning() implementation *) -function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean; +function TPlatform.TerminateIfAlreadyRunning(var WndTitle: string): boolean; begin Result := false; end; @@ -143,7 +143,7 @@ const var SourceFile, TargetFile: TFileStream; FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. - NumberOfBytes: integer; // number of bytes read from SourceFile + NumberOfBytes: integer; // number of bytes read from SourceFile begin Result := false; SourceFile := nil; -- cgit v1.2.3 From 2e7b7c8ec95c52044df4317aaab6d7789c868e57 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 23 Mar 2009 12:34:50 +0000 Subject: cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1652 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 6c356d06..3f3c06cc 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -266,8 +266,8 @@ end; procedure TSongs.BrowseDir(Dir: widestring); begin - BrowseTXTFiles(Dir); - BrowseXMLFiles(Dir); + BrowseTXTFiles(Dir); + BrowseXMLFiles(Dir); end; procedure TSongs.BrowseTXTFiles(Dir: widestring); -- cgit v1.2.3 From e357b3bc3929bb38ed0184ced57ed8f861123dfd Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 23 Mar 2009 20:59:06 +0000 Subject: cover-size of 64px added, default changed to 128px instead of 256px git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1656 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 78229f53..1d07f5bc 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -194,8 +194,8 @@ const IBackgroundMusic: array[0..1] of string = ('Off', 'On'); - ITextureSize: array[0..2] of string = ('128', '256', '512'); - ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512); + ITextureSize: array[0..3] of string = ('64', '128', '256', '512'); + ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512); ISingWindow: array[0..1] of string = ('Small', 'Big'); -- cgit v1.2.3 From 442fe6a73506979404f2d1f7bb2c2cffa4b69054 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 6 Apr 2009 22:17:39 +0000 Subject: bring the type align to our coding standards git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1658 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UEditorLyrics.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index fe8c3ee5..ef9d8dd6 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -40,7 +40,7 @@ uses UTexture; type - alignment = (left, center, right); + TAlignmentType = (atLeft, atCenter, atRight); TWord = record X: real; @@ -58,7 +58,7 @@ type TEditorLyrics = class private - AlignI: alignment; + AlignI: TAlignmentType; XR: real; YR: real; SizeR: real; @@ -69,7 +69,7 @@ type procedure SetX(Value: real); procedure SetY(Value: real); function GetClientX: real; - procedure SetAlign(Value: alignment); + procedure SetAlign(Value: TAlignmentType); function GetSize: real; procedure SetSize(Value: real); procedure SetSelected(Value: integer); @@ -96,7 +96,7 @@ type property X: real write SetX; property Y: real write SetY; property ClientX: real read GetClientX; - property Align: alignment write SetAlign; + property Align: TAlignmentType write SetAlign; property Size: real read GetSize write SetSize; property Selected: integer read SelectedI write SetSelected; property FontStyle: integer write SetFontStyle; @@ -137,7 +137,7 @@ begin Result := Word[0].X; end; -procedure TEditorLyrics.SetAlign(Value: alignment); +procedure TEditorLyrics.SetAlign(Value: TAlignmentType); begin AlignI := Value; end; @@ -229,7 +229,7 @@ var WordIndex: integer; TotalWidth: real; begin - if AlignI = center then + if AlignI = atCenter then begin TotalWidth := 0; for WordIndex := 0 to High(Word) do -- cgit v1.2.3 From d3aec0c8562b5f073b6c96bf9c7871789f2ceb67 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 9 Apr 2009 17:29:34 +0000 Subject: Cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1660 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDLLManager.pas | 175 +++++++++++++++++++++++++---------------------- 1 file changed, 95 insertions(+), 80 deletions(-) (limited to 'src/base') diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index 9ecee34a..3faa15bf 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -40,29 +40,36 @@ uses type TDLLMan = class private - hLib: THandle; + hLib: THandle; P_Init: fModi_Init; P_Draw: fModi_Draw; P_Finish: fModi_Finish; P_RData: pModi_RData; public Plugins: array of TPluginInfo; - PluginPaths: array of String; + PluginPaths: array of string; Selected: ^TPluginInfo; constructor Create; procedure GetPluginList; - procedure ClearPluginInfo(No: Cardinal); - function LoadPluginInfo(Filename: String; No: Cardinal): boolean; + procedure ClearPluginInfo(No: cardinal); + function LoadPluginInfo(Filename: string; No: cardinal): boolean; - function LoadPlugin(No: Cardinal): boolean; + function LoadPlugin(No: cardinal): boolean; procedure UnLoadPlugin; - function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; - function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; + function PluginInit (const TeamInfo: TTeamInfo; + var Playerinfo: TPlayerinfo; + const Sentences: TSentences; + const LoadTex: fModi_LoadTex; + const Print: fModi_Print; + LoadSound: fModi_LoadSound; + PlaySound: pModi_PlaySound) + : boolean; + function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean; function PluginFinish (var Playerinfo: TPlayerinfo): byte; - procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); + procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: dword; user: dword); end; var @@ -100,33 +107,33 @@ end; procedure TDLLMan.GetPluginList; var - SR: TSearchRec; + SearchRecord: TSearchRec; begin - if FindFirst(PluginPath + '*' + DLLExt, faAnyFile , SR) = 0 then + if FindFirst(PluginPath + '*' + DLLExt, faAnyFile, SearchRecord) = 0 then begin repeat SetLength(Plugins, Length(Plugins)+1); SetLength(PluginPaths, Length(Plugins)); - if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful + if LoadPluginInfo(SearchRecord.Name, High(Plugins)) then // loaded succesful begin - PluginPaths[High(PluginPaths)] := SR.Name; + PluginPaths[High(PluginPaths)] := SearchRecord.Name; end - else //Error Loading + else // error loading begin SetLength(Plugins, Length(Plugins)-1); SetLength(PluginPaths, Length(Plugins)); end; - until FindNext(SR) <> 0; - FindClose(SR); + until FindNext(SearchRecord) <> 0; + FindClose(SearchRecord); end; end; -procedure TDLLMan.ClearPluginInfo(No: Cardinal); +procedure TDLLMan.ClearPluginInfo(No: cardinal); begin - //Set to Party Modi Plugin +// set to party modi plugin Plugins[No].Typ := 8; Plugins[No].Name := 'unknown'; @@ -135,109 +142,117 @@ begin Plugins[No].Creator := 'Nobody'; Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; - Plugins[No].LoadSong := True; - Plugins[No].ShowScore := True; - Plugins[No].ShowBars := False; - Plugins[No].ShowNotes := True; - Plugins[No].LoadVideo := True; - Plugins[No].LoadBack := True; + Plugins[No].LoadSong := true; + Plugins[No].ShowScore := true; + Plugins[No].ShowBars := true; + Plugins[No].ShowNotes := true; + Plugins[No].LoadVideo := true; + Plugins[No].LoadBack := true; - Plugins[No].TeamModeOnly := False; - Plugins[No].GetSoundData := False; - Plugins[No].Dummy := False; + Plugins[No].TeamModeOnly := true; + Plugins[No].GetSoundData := true; + Plugins[No].Dummy := true; - Plugins[No].BGShowFull := False; - Plugins[No].BGShowFull_O := True; + Plugins[No].BGShowFull := true; + Plugins[No].BGShowFull_O := true; - Plugins[No].ShowRateBar:= False; - Plugins[No].ShowRateBar_O := True; + Plugins[No].ShowRateBar := true; + Plugins[No].ShowRateBar_O := true; - Plugins[No].EnLineBonus := False; - Plugins[No].EnLineBonus_O := True; + Plugins[No].EnLineBonus := true; + Plugins[No].EnLineBonus_O := true; end; -function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean; +function TDLLMan.LoadPluginInfo(Filename: string; No: cardinal): boolean; var hLibg: THandle; Info: pModi_PluginInfo; - //I: Integer; +// I: integer; begin - Result := False; - //Clear Plugin Info + Result := true; +// clear plugin info ClearPluginInfo(No); - {//Workaround Plugins Loaded 2 Times - For I := low(PluginPaths) to high(PluginPaths) do - if (PluginPaths[I] = Filename) then - exit; } +{ +// workaround plugins loaded 2 times + for i := low(pluginpaths) to high(pluginpaths) do + if (pluginpaths[i] = filename) then + exit; +} - //Load Libary +// load libary hLibg := LoadLibrary(PChar(PluginPath + Filename)); - //If Loaded +// if loaded if (hLibg <> 0) then begin - //Load Info Procedure +// load info procedure @Info := GetProcAddress(hLibg, PChar('PluginInfo')); - //If Loaded +// if loaded if (@Info <> nil) then begin - //Load PluginInfo +// load plugininfo Info(Plugins[No]); - Result := True; + Result := true; end else - Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found'); + Log.LogError('Could not load plugin "' + Filename + '": Info procedure not found'); FreeLibrary (hLibg); end else - Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded'); + Log.LogError('Could not load plugin "' + Filename + '": Libary not loaded'); end; -function TDLLMan.LoadPlugin(No: Cardinal): boolean; +function TDLLMan.LoadPlugin(No: cardinal): boolean; begin - Result := False; - //Load Libary + Result := true; +// load libary hLib := LoadLibrary(PChar(PluginPath + PluginPaths[No])); - //If Loaded +// if loaded if (hLib <> 0) then begin - //Load Info Procedure +// load info procedure @P_Init := GetProcAddress (hLib, 'Init'); @P_Draw := GetProcAddress (hLib, 'Draw'); @P_Finish := GetProcAddress (hLib, 'Finish'); - //If Loaded - if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then +// if loaded + if (@P_Init <> nil) and (@P_Draw <> nil) and (@P_Finish <> nil) then begin Selected := @Plugins[No]; - Result := True; + Result := true; end else begin - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found'); - + Log.LogError('Could not load plugin "' + PluginPaths[No] + '": Procedures not found'); end; end - else - Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded'); + else + Log.LogError('Could not load plugin "' + PluginPaths[No] + '": Libary not loaded'); end; procedure TDLLMan.UnLoadPlugin; begin -if (hLib <> 0) then - FreeLibrary (hLib); - -//Selected := nil; -@P_Init := nil; -@P_Draw := nil; -@P_Finish := nil; -@P_RData := nil; + if (hLib <> 0) then + FreeLibrary (hLib); + +// Selected := nil; + @P_Init := nil; + @P_Draw := nil; + @P_Finish := nil; + @P_RData := nil; end; -function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean; +function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; + var Playerinfo: TPlayerinfo; + const Sentences: TSentences; + const LoadTex: fModi_LoadTex; + const Print: fModi_Print; + LoadSound: fModi_LoadSound; + PlaySound: pModi_PlaySound) + : boolean; var Methods: TMethodRec; begin @@ -249,26 +264,26 @@ begin if (@P_Init <> nil) then Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) else - Result := False + Result := true end; -function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean; +function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean; begin -if (@P_Draw <> nil) then - Result := P_Draw (PlayerInfo, CurSentence) -else - Result := False + if (@P_Draw <> nil) then + Result := P_Draw (PlayerInfo, CurSentence) + else + Result := true end; function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; begin -if (@P_Finish <> nil) then - Result := P_Finish (PlayerInfo) -else - Result := 0; + if (@P_Finish <> nil) then + Result := P_Finish (PlayerInfo) + else + Result := 0; end; -procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD); +procedure TDLLMan.PluginRData (handle: HStream; buffer: Pointer; len: dword; user: dword); begin if (@P_RData <> nil) then P_RData (handle, buffer, len, user); -- cgit v1.2.3 From 1f6d632264411399a142393da0cbc2fb478159b2 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 9 Apr 2009 23:52:22 +0000 Subject: Warnings and Notes cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1663 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 10 ++++------ 1 file changed, 4 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 8f37262d..2c2093a0 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -54,7 +54,7 @@ type function GetToneString: string; // converts a tone to its string represenatation; - procedure BoostBuffer(Buffer: PByteArray; Size: cardinal); + procedure BoostBuffer(Buffer: PByteArray; Size: integer); procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); // we call it to analyze sound by checking Autocorrelation @@ -135,7 +135,7 @@ type procedure UpdateInputDeviceConfig; // handle microphone input - procedure HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; + procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice); end; @@ -459,7 +459,7 @@ begin Result := '-'; end; -procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: cardinal); +procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: integer); var i: integer; Value: longint; @@ -602,7 +602,7 @@ end; * Length - number of bytes in Buffer * Input - Soundcard-Input used for capture *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice); +procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice); var MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel @@ -611,13 +611,11 @@ var CaptureChannel: TCaptureBuffer; AudioFormat: TAudioFormatInfo; SampleSize: integer; - SampleCount: integer; SamplesPerChannel: integer; i: integer; begin AudioFormat := InputDevice.AudioFormat; SampleSize := AudioSampleSize[AudioFormat.Format]; - SampleCount := Size div SampleSize; SamplesPerChannel := Size div AudioFormat.FrameSize; SingleChannelBufferSize := SamplesPerChannel * SampleSize; -- cgit v1.2.3 From d6cf58a5e4288d3796cbd0a6a7071a4c036616bb Mon Sep 17 00:00:00 2001 From: canni0 Date: Sat, 18 Apr 2009 15:29:30 +0000 Subject: - fixed assembla ticket #49 - fixed uninstall routine (forgot to delete cached covers) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1681 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 1d07f5bc..2c1029f6 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -708,16 +708,16 @@ begin PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); //Preview Fading - PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1])); + PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[3])); //AudioRepeat aka VoicePassthrough VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0])); // Lyrics Font - LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1])); + LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[0])); // Lyrics Effect - LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1])); + LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[2])); // Solmization Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0])); -- cgit v1.2.3 From c7f5d683c1eae49e30ee42a76557661f57311b9e Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 25 Apr 2009 10:09:59 +0000 Subject: Cosmetics. No code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1694 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 203 ++++++++++++++++++++++++++-------------------------- 1 file changed, 102 insertions(+), 101 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 3f3c06cc..9d44a086 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -68,35 +68,35 @@ uses type TBPM = record - BPM: real; - StartBeat: real; + BPM: real; + StartBeat: real; end; TScore = record - Name: widestring; - Score: integer; - Length: string; + Name: widestring; + Score: integer; + Length: string; end; {$IFDEF USE_PSEUDO_THREAD} - TSongs = class( TPseudoThread ) + TSongs = class(TPseudoThread) {$ELSE} - TSongs = class( TThread ) + TSongs = class(TThread) {$ENDIF} private - fNotify, fWatch : longint; - fParseSongDirectory : boolean; - fProcessing : boolean; + fNotify, fWatch: longint; + fParseSongDirectory: boolean; + fProcessing: boolean; {$ifdef MSWINDOWS} - fDirWatch : TDirectoryWatch; + fDirWatch: TDirectoryWatch; {$endif} procedure int_LoadSongList; procedure DoDirChanged(Sender: TObject); protected procedure Execute; override; public - SongList : TList; // array of songs - Selected : integer; // selected song index + SongList: TList; // array of songs + Selected: integer; // selected song index constructor Create(); destructor Destroy(); override; @@ -107,7 +107,7 @@ type procedure BrowseXMLFiles(Dir: widestring); procedure Sort(Order: integer); function FindSongFile(Dir, Mask: widestring): widestring; - property Processing : boolean read fProcessing; + property Processing boolean read fProcessing; end; @@ -116,24 +116,24 @@ type Selected: integer; // selected song index Order: integer; // order type (0=title) CatNumShow: integer; // Category Number being seen - CatCount: integer; //Number of Categorys + CatCount: integer; // Number of Categorys procedure SortSongs(); - procedure Refresh; // refreshes arrays by recreating them from Songs array - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: string; const fType: Byte): Cardinal; + procedure Refresh; // refreshes arrays by recreating them from Songs array + procedure ShowCategory(Index: integer); // expands all songs in category + procedure HideCategory(Index: integer); // hides all songs in category + procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed + procedure ShowCategoryList; // Hides all Songs And Show the List of all Categorys + function FindNextVisible(SearchFrom: integer): integer; // Find Next visible Song + function VisibleSongs: integer; // returns number of visible songs (for tabs) + function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) + + function SetFilter(FilterStr: string; const fType: byte): cardinal; end; var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs + Songs: TSongs; // all songs + CatSongs: TCatSongs; // categorized songs const IN_ACCESS = $00000001; //* File was accessed */ @@ -170,7 +170,7 @@ begin // FIXME: threaded loading does not work this way. // It will just cause crashes but nothing else at the moment. - (* +(* {$ifdef MSWINDOWS} fDirWatch := TDirectoryWatch.create(nil); fDirWatch.OnChange := DoDirChanged; @@ -181,7 +181,7 @@ begin // now we can start the thread Resume(); - *) +*) // until it is fixed, simply load the song-list int_LoadSongList(); @@ -189,7 +189,7 @@ end; destructor TSongs.Destroy(); begin - FreeAndNil( SongList ); + FreeAndNil(SongList); inherited; end; @@ -200,7 +200,7 @@ end; procedure TSongs.Execute(); var - fChangeNotify : THandle; + fChangeNotify: THandle; begin {$IFDEF USE_PSEUDO_THREAD} int_LoadSongList(); @@ -234,13 +234,13 @@ begin for I := 0 to SongPaths.Count-1 do BrowseDir(SongPaths[I]); - if assigned( CatSongs ) then + if assigned(CatSongs) then CatSongs.Refresh; - if assigned( CatCovers ) then + if assigned(CatCovers) then CatCovers.Load; - //if assigned( Covers ) then + //if assigned(Covers) then // Covers.Load; if assigned(ScreenSong) then @@ -272,75 +272,75 @@ end; procedure TSongs.BrowseTXTFiles(Dir: widestring); var - i : integer; - Files : TDirectoryEntryArray; - lSong : TSong; + i: integer; + Files: TDirectoryEntryArray; + lSong: TSong; begin try - Files := Platform.DirectoryFindFiles( Dir, '.txt', true) + Files := Platform.DirectoryFindFiles(Dir, '.txt', true) except Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles') end; - for i := 0 to Length(Files)-1 do + for i := 0 to Length(Files) - 1 do begin if Files[i].IsDirectory then begin - BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + BrowseTXTFiles(Dir + Files[i].Name + PathDelim); //Recursive Call end else begin - lSong := TSong.create( Dir + Files[i].Name ); + lSong := TSong.create(Dir + Files[i].Name); if lSong.Analyse then - SongList.add( lSong ) + SongList.add(lSong) else begin Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); + freeandnil(lSong); end; end; end; - SetLength( Files, 0); + SetLength(Files, 0); end; procedure TSongs.BrowseXMLFiles(Dir: widestring); var - i : integer; - Files : TDirectoryEntryArray; - lSong : TSong; + i: integer; + Files: TDirectoryEntryArray; + lSong: TSong; begin try - Files := Platform.DirectoryFindFiles( Dir, '.xml', true) + Files := Platform.DirectoryFindFiles(Dir, '.xml', true) except Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles') end; - for i := 0 to Length(Files)-1 do + for i := 0 to Length(Files) - 1 do begin if Files[i].IsDirectory then begin - BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call + BrowseXMLFiles(Dir + Files[i].Name + PathDelim); // Recursive Call end else begin - lSong := TSong.create( Dir + Files[i].Name ); + lSong := TSong.create(Dir + Files[i].Name); if lSong.AnalyseXML then - SongList.add( lSong ) + SongList.add(lSong) else begin Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil( lSong ); + freeandnil(lSong); end; end; end; - SetLength( Files, 0); + SetLength(Files, 0); end; @@ -414,7 +414,7 @@ end; function TSongs.FindSongFile(Dir, Mask: widestring): widestring; var - SR: TSearchRec; // for parsing song directory + SR: TSearchRec; // for parsing song directory begin Result := ''; if FindFirst(Dir + Mask, faDirectory, SR) = 0 then @@ -483,13 +483,13 @@ var Inc(Order); CatIndex := Length(Song); SetLength(Song, CatIndex+1); - Song[CatIndex] := TSong.Create(); - Song[CatIndex].Artist := '[' + CategoryName + ']'; - Song[CatIndex].Main := true; + Song[CatIndex] := TSong.Create(); + Song[CatIndex].Artist := '[' + CategoryName + ']'; + Song[CatIndex].Main := true; Song[CatIndex].OrderTyp := 0; Song[CatIndex].OrderNum := Order; - Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); - Song[CatIndex].Visible := true; + Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); + Song[CatIndex].Visible := true; // set number of songs in previous category PrevCatBtnIndex := CatIndex - CatNumber - 1; @@ -500,21 +500,21 @@ var end; begin - CatNumShow := -1; + CatNumShow := -1; SortSongs(); CurCategory := ''; - Order := 0; - CatNumber := 0; + Order := 0; + CatNumber := 0; // Note: do NOT set Letter to ' ', otherwise no category-button will be // created for songs beginning with ' ' if songs of this category exist. // TODO: trim song-properties so ' ' will not occur as first chararcter. - Letter := #0; + Letter := #0; // clear song-list - for SongIndex := 0 to Songs.SongList.Count-1 do + for SongIndex := 0 to Songs.SongList.Count - 1 do begin // free category buttons // Note: do NOT delete songs, they are just references to Songs.SongList entries @@ -524,7 +524,7 @@ begin end; SetLength(Song, 0); - for SongIndex := 0 to Songs.SongList.Count-1 do + for SongIndex := 0 to Songs.SongList.Count - 1 do begin CurSong := TSong(Songs.SongList[SongIndex]); // if tabs are on, add section buttons for each new section @@ -537,11 +537,11 @@ begin // TODO: remove this block if it is not needed anymore { - if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; - if CurSection = 'Singstar German' then CoverName := 'Singstar'; - if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; - if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; - if CurSection = 'Singstar French' then CoverName := 'Singstar'; + if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; + if CurSection = 'Singstar German' then CoverName := 'Singstar'; + if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; + if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; + if CurSection = 'Singstar French' then CoverName := 'Singstar'; if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s'; } @@ -642,15 +642,14 @@ begin CurSong.Visible := true else if (Ini.Tabs = 1) then CurSong.Visible := false; - - { +{ if (Ini.Tabs = 1) and (Order = 1) then begin //open first tab CurSong.Visible := true; end; CurSong.Visible := true; - } +} end; // set CatNumber of last category @@ -668,7 +667,7 @@ end; procedure TCatSongs.ShowCategory(Index: integer); var - S: integer; // song + S: integer; // song begin CatNumShow := Index; for S := 0 to high(CatSongs.Song) do @@ -680,13 +679,13 @@ begin CatSongs.Song[S].Visible := false; } // KMS: This should be the same, but who knows :-) - CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) ); + CatSongs.Song[S].Visible := ((CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main)); end; end; procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category var - S: integer; // song + S: integer; // song begin for S := 0 to high(CatSongs.Song) do begin @@ -697,7 +696,7 @@ end; procedure TCatSongs.ClickCategoryButton(Index: integer); var - Num: integer; + Num: integer; begin Num := CatSongs.Song[Index].OrderNum; if Num <> CatNumShow then @@ -713,7 +712,7 @@ end; //Hide Categorys when in Category Hack procedure TCatSongs.ShowCategoryList; var - S: integer; + S: integer; begin // Hide All Songs Show All Cats for S := 0 to high(CatSongs.Song) do @@ -723,8 +722,8 @@ begin end; //Hide Categorys when in Category Hack End -//Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song +// Wrong song selected when tabs on bug +function TCatSongs.FindNextVisible(SearchFrom:integer): integer;// Find next Visible Song var I: integer; begin @@ -735,11 +734,11 @@ begin Inc (I); if (I>high(CatSongs.Song)) then I := low(CatSongs.Song); - if (I = SearchFrom) then //Make One Round and no song found->quit + if (I = SearchFrom) then // Make One Round and no song found->quit break; end; end; -//Wrong song selected when tabs on bug End +// Wrong song selected when tabs on bug End (** * Returns the number of visible songs. @@ -765,44 +764,46 @@ var SongIndex: integer; begin Result := 0; - for SongIndex := 0 to Index-1 do + for SongIndex := 0 to Index - 1 do begin if (CatSongs.Song[SongIndex].Visible) then Inc(Result); end; end; -function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal; +function TCatSongs.SetFilter(FilterStr: string; const fType: byte): cardinal; var - I, J: integer; - cString: string; + I, J: integer; + cString: string; SearchStr: array of string; begin - {fType: 0: All - 1: Title - 2: Artist} +{ + fType: 0: All + 1: Title + 2: Artist +} FilterStr := Trim(FilterStr); if FilterStr<>'' then begin Result := 0; - //Create Search Array + // Create Search Array SetLength(SearchStr, 1); - I := Pos (' ', FilterStr); + I := Pos(' ', FilterStr); while (I <> 0) do begin - SetLength (SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I-1); + SetLength(SearchStr, Length(SearchStr) + 1); + cString := Copy(FilterStr, 1, I - 1); if (cString <> ' ') and (cString <> '') then - SearchStr[High(SearchStr)-1] := cString; + SearchStr[High(SearchStr) - 1] := cString; Delete (FilterStr, 1, I); I := Pos (' ', FilterStr); end; - //Copy last Word + // Copy last Word if (FilterStr <> ' ') and (FilterStr <> '') then SearchStr[High(SearchStr)] := FilterStr; - for I:=0 to High(Song) do + for I := 0 to High(Song) do begin if not Song[i].Main then begin @@ -811,8 +812,8 @@ begin 1: cString := Song[I].Title; 2: cString := Song[I].Artist; end; - Song[i].Visible:=True; - //Look for every Searched Word + Song[i].Visible:=true; + // Look for every Searched Word for J := 0 to High(SearchStr) do begin Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J]) @@ -821,13 +822,13 @@ begin Inc(Result); end else - Song[i].Visible:=False; + Song[i].Visible:=false; end; CatNumShow := -2; end else begin - for i:=0 to High(Song) do + for i := 0 to High(Song) do begin Song[i].Visible := (Ini.Tabs=1) = Song[i].Main; CatNumShow := -1; -- cgit v1.2.3 From 7cf14a865954a7208f76421a396ea33c3cc87ab9 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 25 Apr 2009 18:18:53 +0000 Subject: correcting typos from cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1699 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 9d44a086..a7231cb3 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -73,9 +73,9 @@ type end; TScore = record - Name: widestring; - Score: integer; - Length: string; + Name: widestring; + Score: integer; + Length: string; end; {$IFDEF USE_PSEUDO_THREAD} @@ -107,7 +107,7 @@ type procedure BrowseXMLFiles(Dir: widestring); procedure Sort(Order: integer); function FindSongFile(Dir, Mask: widestring): widestring; - property Processing boolean read fProcessing; + property Processing: boolean read fProcessing; end; -- cgit v1.2.3 From b551fcdcdd11c178e224caf5c2c3c33c7a2cf4ad Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 26 Apr 2009 16:07:50 +0000 Subject: Cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1700 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 74 ++++++++++++++++++++++++++--------------------------- 1 file changed, 37 insertions(+), 37 deletions(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 9d70e2be..e29b977c 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -44,34 +44,34 @@ type TeamOrderEntry = record TeamNum: byte; - Score: byte; + Score: byte; end; TeamOrderArray = array[0..5] of byte; TPartyPlugin = record - ID: byte; + ID: byte; TimesPlayed: byte; end; TPartySession = class private - function GetRandomPlayer(Team: Byte): Byte; + function GetRandomPlayer(Team: byte): byte; function GetRandomPlugin(Plugins: array of TPartyPlugin): byte; - function IsWinner(Player, Winner: Byte): boolean; + function IsWinner(Player, Winner: byte): boolean; procedure GenScores; public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: Byte; + Teams: TTeamInfo; + Rounds: array of TRoundInfo; + CurRound: byte; constructor Create; - procedure StartNewParty(NumRounds: Byte); + procedure StartNewParty(NumRounds: byte); procedure StartRound; procedure EndRound; function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: Byte): String; + function GetWinnerString(Round: byte): string; end; var @@ -96,10 +96,10 @@ end; //---------- function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte; var - LowestTP: byte; + LowestTP: byte; NumPwithLTP: word; - I: integer; - R: word; + I: integer; + R: word; begin LowestTP := high(byte); NumPwithLTP := 0; @@ -141,12 +141,12 @@ end; //---------- //StartNewParty - Reset and prepares for new party //---------- -procedure TPartySession.StartNewParty(NumRounds: Byte); +procedure TPartySession.StartNewParty(NumRounds: byte); var - Plugins: array of TPartyPlugin; + Plugins: array of TPartyPlugin; TeamMode: boolean; - Len: integer; - I, J: integer; + Len: integer; + I, J: integer; begin //Set current round to 1 CurRound := 255; @@ -155,7 +155,7 @@ begin //Get team-mode and set joker, also set TimesPlayed TeamMode := true; - for I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams - 1 do begin if Teams.Teaminfo[I].NumPlayers < 2 then begin @@ -166,7 +166,7 @@ begin begin Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; end; - Teams.Teaminfo[I].Joker := Round(NumRounds*0.7); + Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7); Teams.Teaminfo[I].Score := 0; end; @@ -174,7 +174,7 @@ begin SetLength(Plugins, 0); for I := 0 to high(DLLMan.Plugins) do begin - if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then + if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then begin //Add only those plugins playable with current PlayerConfiguration Len := Length(Plugins); @@ -188,7 +188,7 @@ begin if (Length(Plugins) >= 1) then begin SetLength (Rounds, NumRounds); - for I := 0 to NumRounds-1 do + for I := 0 to NumRounds - 1 do begin PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins); PartySession.Rounds[I].Winner := 255; @@ -203,16 +203,16 @@ end; *} function TPartySession.GetRandomPlayer(Team: byte): byte; var - I, R: integer; - LowestTP: byte; + I, R: integer; + LowestTP: byte; NumPwithLTP: byte; begin - LowestTP := high(byte); + LowestTP := high(byte); NumPwithLTP := 0; - Result := 0; + Result := 0; //Search for players that have not often played yet - for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do begin if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then begin @@ -229,7 +229,7 @@ begin R := Random(NumPwithLTP); //Search for random player - for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do + for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do begin if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then begin @@ -252,7 +252,7 @@ procedure TPartySession.StartRound; var I: integer; begin - if ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then + if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then begin //Increase Current Round Inc(CurRound); @@ -261,7 +261,7 @@ begin DllMan.LoadPlugin(Rounds[CurRound].Plugin); //Select Players - for I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams - 1 do Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); //Set ScreenSingModie Variables @@ -305,7 +305,7 @@ procedure TPartySession.GenScores; var I: byte; begin - for I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams - 1 do begin if isWinner(I, Rounds[CurRound].Winner) then Inc(Teams.Teaminfo[I].Score); @@ -317,21 +317,21 @@ end; //---------- function TPartySession.GetTeamOrder: TeamOrderArray; var - I, J: integer; - ATeams: array [0..5] of TeamOrderEntry; + I, J: integer; + ATeams: array [0..5] of TeamOrderEntry; TempTeam: TeamOrderEntry; begin // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place //Fill Team array - for I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams - 1 do begin ATeams[I].Teamnum := I; ATeams[I].Score := Teams.Teaminfo[I].Score; end; //Sort teams - for J := 0 to Teams.NumTeams-1 do - for I := 1 to Teams.NumTeams-1 do + for J := 0 to Teams.NumTeams - 1 do + for I := 1 to Teams.NumTeams - 1 do if ATeams[I].Score > ATeams[I-1].Score then begin TempTeam := ATeams[I-1]; @@ -345,12 +345,12 @@ begin end; //---------- -//GetWinnerString - Get String with WinnerTeam Name, when there is more than one Winner than Connect with and or , +//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or , //---------- function TPartySession.GetWinnerString(Round: byte): string; var Winners: array of string; - I: integer; + I: integer; begin Result := Language.Translate('PARTY_NOBODY'); @@ -369,7 +369,7 @@ begin end; SetLength(Winners, 0); - for I := 0 to Teams.NumTeams-1 do + for I := 0 to Teams.NumTeams - 1 do begin if isWinner(I, Rounds[Round].Winner) then begin -- cgit v1.2.3 From ea281d602be3a3767b906504f14722f087a9eb6f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 15 May 2009 15:00:39 +0000 Subject: resolve some type size mismatch warnings. changes are considered cosmetics only git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1726 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 41 +++++++++++++++++++++++++---------------- 1 file changed, 25 insertions(+), 16 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 8dc38495..60b0a3a2 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -311,13 +311,13 @@ var hour, minute, second, msecond: word; begin DecodeDate(time, year, month, day); - pngTime.year := year; - pngTime.month := month; - pngTime.day := day; + pngTime.year := png_uint_16(year); + pngTime.month := png_byte(month); + pngTime.day := png_byte(day); DecodeTime(time, hour, minute, second, msecond); - pngTime.hour := hour; - pngTime.minute := minute; - pngTime.second := second; + pngTime.hour := png_byte(hour); + pngTime.minute := png_byte(minute); + pngTime.second := png_byte(second); end; (* @@ -896,8 +896,13 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); // replaced by division of longwords, shifted by 10 bits to keep // digits. + // The use of longwards leeds to some type size mismatch warnings + // whenever differences are formed. + // This should not be a problem, since the results should all be positive. + // replacing longword by longint would probably resolve this cosmetic fault :-) + function ColorToHue(const Color: longword): longword; - // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 + // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 var Red, Green, Blue: longword; Min, Max, Delta: longword; @@ -919,7 +924,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); if Blue > Max then Max := Blue; // calc hue - Delta := Max - Min; + Delta := Max - Min; // This gives a type size mismatch warning, because Delta is longword, ie. >= 0 + // But the assignments above are easy enough to be sure, that Max - Min is >= 0. if (Delta = 0) then Result := 0 else @@ -1023,16 +1029,19 @@ begin end else // all colors except black and white begin - Delta := Max - Min; + Delta := Max - Min; // This gives a type size mismatch warning, because Delta is longword, ie. >= 0 + // But the assignments above are easy enough to be sure, that Max - Min is >= 0. Sat := (Delta shl 10) div Max; // shl 10 - // shr 10 corrects that sat and f are shl 10 + // shr 10 corrects that Sat and f are shl 10 // the resulting p, q and t are unshifted p := (Max*(1024-Sat)) shr 10; q := (Max*(1024-(Sat*f) shr 10)) shr 10; t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10; + // The above 3 lines give type size mismatch warning, but all variables are longword and the ranges should be ok. + case HueInteger of 0: begin Red := Max; Green := t; Blue := p; end; // (v,t,p) 1: begin Red := q; Green := Max; Blue := p; end; // (q,v,p) @@ -1043,13 +1052,13 @@ begin end; {$IFDEF FPC_BIG_ENDIAN} - PixelColors[3] := Red; - PixelColors[2] := Green; - PixelColors[1] := Blue + PixelColors[3] := byte(Red); + PixelColors[2] := byte(Green); + PixelColors[1] := byte(Blue); {$ELSE} - PixelColors[0] := Red; - PixelColors[1] := Green; - PixelColors[2] := Blue; + PixelColors[0] := byte(Red); + PixelColors[1] := byte(Green); + PixelColors[2] := byte(Blue); {$ENDIF} end; -- cgit v1.2.3 From 4f8afae1ce76884c54d4b2de9de2186e29115c57 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 16 May 2009 22:04:15 +0000 Subject: add lyric-bar bounds to theme thx to Krueger git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1746 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 2 +- src/base/UGraphic.pas | 11 ----------- src/base/UThemes.pas | 18 +++++++++++++++++- 3 files changed, 18 insertions(+), 13 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 8a66d271..1783986f 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -638,7 +638,7 @@ begin // determine lyric help bar position and size Bounds.Left := MoveStartX + BarProgress * MoveDist; Bounds.Right := Bounds.Left + BarWidth; - Bounds.Top := Skin_LyricsT + 3; + Bounds.Top := Theme.LyricBar.IndicatorYOffset + Theme.LyricBar.UpperY ; Bounds.Bottom := Bounds.Top + BarHeight + 3; // draw lyric help bar diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 17175d02..e7b3d695 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -232,17 +232,6 @@ const Skin_OscG = 0; Skin_OscB = 0; - // TODO: add to theme ini file - Skin_LyricsT = 493; - Skin_LyricsUpperX = 80; - Skin_LyricsUpperW = 640; - Skin_LyricsUpperY = Skin_LyricsT; - Skin_LyricsUpperH = 41; - Skin_LyricsLowerX = 80; - Skin_LyricsLowerW = 640; - Skin_LyricsLowerY = Skin_LyricsT + Skin_LyricsUpperH + 1; - Skin_LyricsLowerH = 41; - Skin_SpectrumT = 470; Skin_SpectrumBot = 570; Skin_SpectrumH = 100; diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 9bf858ed..4c5434f8 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -359,6 +359,11 @@ type PausePopUp: TThemeStatic; end; + TThemeLyricBar = record + IndicatorYOffset, UpperX, UpperW, UpperY, UpperH, + LowerX, LowerW, LowerY, LowerH : integer; + end; + TThemeScore = class(TThemeBasic) TextArtist: TThemeText; TextTitle: TThemeText; @@ -723,6 +728,7 @@ type Level: TThemeLevel; Song: TThemeSong; Sing: TThemeSing; + LyricBar: TThemeLyricBar; Score: TThemeScore; Top5: TThemeTop5; Options: TThemeOptions; @@ -1031,9 +1037,19 @@ begin ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); + //LyricBar asd + LyricBar.UpperX := ThemeIni.ReadInteger('SingLyricsUpperBar', 'X', 0); + LyricBar.UpperW := ThemeIni.ReadInteger('SingLyricsUpperBar', 'W', 0); + LyricBar.UpperY := ThemeIni.ReadInteger('SingLyricsUpperBar', 'Y', 0); + LyricBar.UpperH := ThemeIni.ReadInteger('SingLyricsUpperBar', 'H', 0); + LyricBar.IndicatorYOffset := ThemeIni.ReadInteger('SingLyricsUpperBar', 'IndicatorYOffset', 0); + LyricBar.LowerX := ThemeIni.ReadInteger('SingLyricsLowerBar', 'X', 0); + LyricBar.LowerW := ThemeIni.ReadInteger('SingLyricsLowerBar', 'W', 0); + LyricBar.LowerY := ThemeIni.ReadInteger('SingLyricsLowerBar', 'Y', 0); + LyricBar.LowerH := ThemeIni.ReadInteger('SingLyricsLowerBar', 'H', 0); + // Sing ThemeLoadBasic(Sing, 'Sing'); - //TimeBar mod ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); ThemeLoadText(Sing.TextTimeText, 'SingTimeText'); -- cgit v1.2.3 From 50ab5b83516699bb7a80123eb7c0f0c0edf40d90 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 21 May 2009 15:35:54 +0000 Subject: moved TLyricsState from UMusic to UBeatTimer git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1752 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UBeatTimer.pas | 168 ++++++++++++++++++++++++++++++++++++++++++++++++ src/base/UMain.pas | 1 + src/base/UMusic.pas | 134 +------------------------------------- 3 files changed, 171 insertions(+), 132 deletions(-) create mode 100644 src/base/UBeatTimer.pas (limited to 'src/base') diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas new file mode 100644 index 00000000..1f5481fa --- /dev/null +++ b/src/base/UBeatTimer.pas @@ -0,0 +1,168 @@ + {* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/USingNotes.pas $ + * $Id: USingNotes.pas 1406 2008-09-23 21:43:52Z k-m_schindler $ + *} + +unit UBeatTimer; + +interface +uses UTime; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +type + (** + * TLyricsState contains all information concerning the + * state of the lyrics, e.g. the current beat or duration of the lyrics. + *) + TLyricsState = class + private + Timer: TRelativeTimer; // keeps track of the current time + public + OldBeat: integer; // previous discovered beat + CurrentBeat: integer; // current beat (rounded) + MidBeat: real; // current beat (float) + + // now we use this for super synchronization! + // only used when analyzing voice + // TODO: change ...D to ...Detect(ed) + OldBeatD: integer; // previous discovered beat + CurrentBeatD: integer; // current discovered beat (rounded) + MidBeatD: real; // current discovered beat (float) + + // we use this for audible clicks + // TODO: Change ...C to ...Click + OldBeatC: integer; // previous discovered beat + CurrentBeatC: integer; + MidBeatC: real; // like CurrentBeatC + + OldLine: integer; // previous displayed sentence + + StartTime: real; // time till start of lyrics (= Gap) + TotalTime: real; // total song time + + constructor Create(); + procedure Pause(); + procedure Resume(); + + procedure Reset(); + procedure UpdateBeats(); + + (** + * current song time (in seconds) used as base-timer for lyrics etc. + *) + function GetCurrentTime(): real; + procedure SetCurrentTime(Time: real); + end; + +implementation +uses UNote, Math; + + +constructor TLyricsState.Create(); +begin + // create a triggered timer, so we can Pause() it, set the time + // and Resume() it afterwards for better synching. + Timer := TRelativeTimer.Create(true); + + // reset state + Reset(); +end; + +procedure TLyricsState.Pause(); +begin + Timer.Pause(); +end; + +procedure TLyricsState.Resume(); +begin + Timer.Resume(); +end; + +procedure TLyricsState.SetCurrentTime(Time: real); +begin + // do not start the timer (if not started already), + // after setting the current time + Timer.SetTime(Time, false); +end; + +function TLyricsState.GetCurrentTime(): real; +begin + Result := Timer.GetTime(); +end; + +(** + * Resets the timer and state of the lyrics. + * The timer will be stopped afterwards so you have to call Resume() + * to start the lyrics timer. + *) +procedure TLyricsState.Reset(); +begin + Pause(); + SetCurrentTime(0); + + StartTime := 0; + TotalTime := 0; + + OldBeat := -1; + MidBeat := -1; + CurrentBeat := -1; + + OldBeatC := -1; + MidBeatC := -1; + CurrentBeatC := -1; + + OldBeatD := -1; + MidBeatD := -1; + CurrentBeatD := -1; +end; + +(** + * Updates the beat information (CurrentBeat/MidBeat/...) according to the + * current lyric time. + *) +procedure TLyricsState.UpdateBeats(); +var + CurLyricsTime: real; +begin + CurLyricsTime := GetCurrentTime(); + + OldBeat := CurrentBeat; + MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeat := Floor(MidBeat); + + OldBeatC := CurrentBeatC; + MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeatC := Floor(MidBeatC); + + OldBeatD := CurrentBeatD; + // MidBeatD = MidBeat with additional GAP + MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); + CurrentBeatD := Floor(MidBeatD); +end; + +end. \ No newline at end of file diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 469a658b..28ba5afc 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -83,6 +83,7 @@ uses UPath, UPlaylist, UMusic, + UBeatTimer, UPlatform, USkins, USongs, diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index b86f3aad..19c54bee 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -36,7 +36,8 @@ interface uses UTime, SysUtils, - Classes; + Classes, + UBeatTimer; type TNoteType = (ntFreestyle, ntNormal, ntGolden); @@ -99,51 +100,6 @@ type Line: array of TLine; end; - (** - * TLyricsState contains all information concerning the - * state of the lyrics, e.g. the current beat or duration of the lyrics. - *) - TLyricsState = class - private - Timer: TRelativeTimer; // keeps track of the current time - public - OldBeat: integer; // previous discovered beat - CurrentBeat: integer; // current beat (rounded) - MidBeat: real; // current beat (float) - - // now we use this for super synchronization! - // only used when analyzing voice - // TODO: change ...D to ...Detect(ed) - OldBeatD: integer; // previous discovered beat - CurrentBeatD: integer; // current discovered beat (rounded) - MidBeatD: real; // current discovered beat (float) - - // we use this for audible clicks - // TODO: Change ...C to ...Click - OldBeatC: integer; // previous discovered beat - CurrentBeatC: integer; - MidBeatC: real; // like CurrentBeatC - - OldLine: integer; // previous displayed sentence - - StartTime: real; // time till start of lyrics (= Gap) - TotalTime: real; // total song time - - constructor Create(); - procedure Pause(); - procedure Resume(); - - procedure Reset(); - procedure UpdateBeats(); - - (** - * current song time (in seconds) used as base-timer for lyrics etc. - *) - function GetCurrentTime(): real; - procedure SetCurrentTime(Time: real); - end; - - const FFTSize = 512; // size of FFT data (output: FFTSize/2 values) type @@ -977,92 +933,6 @@ begin end; end; - -{ TVoiceRemoval } - -constructor TLyricsState.Create(); -begin - // create a triggered timer, so we can Pause() it, set the time - // and Resume() it afterwards for better synching. - Timer := TRelativeTimer.Create(true); - - // reset state - Reset(); -end; - -procedure TLyricsState.Pause(); -begin - Timer.Pause(); -end; - -procedure TLyricsState.Resume(); -begin - Timer.Resume(); -end; - -procedure TLyricsState.SetCurrentTime(Time: real); -begin - // do not start the timer (if not started already), - // after setting the current time - Timer.SetTime(Time, false); -end; - -function TLyricsState.GetCurrentTime(): real; -begin - Result := Timer.GetTime(); -end; - -(** - * Resets the timer and state of the lyrics. - * The timer will be stopped afterwards so you have to call Resume() - * to start the lyrics timer. - *) -procedure TLyricsState.Reset(); -begin - Pause(); - SetCurrentTime(0); - - StartTime := 0; - TotalTime := 0; - - OldBeat := -1; - MidBeat := -1; - CurrentBeat := -1; - - OldBeatC := -1; - MidBeatC := -1; - CurrentBeatC := -1; - - OldBeatD := -1; - MidBeatD := -1; - CurrentBeatD := -1; -end; - -(** - * Updates the beat information (CurrentBeat/MidBeat/...) according to the - * current lyric time. - *) -procedure TLyricsState.UpdateBeats(); -var - CurLyricsTime: real; -begin - CurLyricsTime := GetCurrentTime(); - - OldBeat := CurrentBeat; - MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeat := Floor(MidBeat); - - OldBeatC := CurrentBeatC; - MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeatC := Floor(MidBeatC); - - OldBeatD := CurrentBeatD; - // MidBeatD = MidBeat with additional GAP - MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); - CurrentBeatD := Floor(MidBeatD); -end; - - { TAudioConverter } function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -- cgit v1.2.3 From e63e5c12b3cbe516f042c7f3547254acafa887ba Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 21 May 2009 18:37:06 +0000 Subject: cosmetics? git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1753 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UBeatTimer.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas index 1f5481fa..a47a06f9 100644 --- a/src/base/UBeatTimer.pas +++ b/src/base/UBeatTimer.pas @@ -26,7 +26,6 @@ unit UBeatTimer; interface -uses UTime; {$IFDEF FPC} {$MODE Delphi} @@ -34,6 +33,9 @@ uses UTime; {$I switches.inc} +uses + UTime; + type (** * TLyricsState contains all information concerning the -- cgit v1.2.3 From 43b940c4d2b6c2109c2523286cc2bb14d85684db Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 22 May 2009 19:27:14 +0000 Subject: change folder separator to \ for windows and config-win.inc git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1767 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UConfig.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index cb663e2d..1214f36f 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -107,7 +107,7 @@ const // include config-file (defines + constants) {$IF Defined(MSWindows)} - {$I ../config-win.inc} + {$I ..\config-win.inc} {$ELSEIF Defined(Linux)} {$I ../config-linux.inc} {$ELSEIF Defined(FreeBSD)} -- cgit v1.2.3 From 69d651dd5933520713ac0ecb4875f0e6702ba002 Mon Sep 17 00:00:00 2001 From: mogguh Date: Tue, 26 May 2009 23:01:19 +0000 Subject: Statics defined in theme don't necessarily need a width or height set, if omitted the the values from the texture itself will be used SelectSlides may now have arrows and only one item set, default is off - view UScreenOptionsGame.pas as example on how to set this git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1783 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 8 +++++++- src/base/UTexture.pas | 4 ++-- src/base/UThemes.pas | 7 ++++--- 3 files changed, 13 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index e7b3d695..82cb3c50 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -198,7 +198,11 @@ var Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; Tex_Score_Ratings : array [0..7] of TTexture; - + + //Arrows for SelectSlide + Tex_SelectS_ArrowL: TTexture; + Tex_SelectS_ArrowR: TTexture; + const Skin_BGColorR = 1; Skin_BGColorG = 1; @@ -328,6 +332,8 @@ begin Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); + Tex_SelectS_ArrowL := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowLeft'), TEXTURE_TYPE_TRANSPARENT, 0); + Tex_SelectS_ArrowR := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowRight'), TEXTURE_TYPE_TRANSPARENT, 0); //TimeBar mod Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 962bd2b0..97f244fe 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -336,8 +336,8 @@ begin X := 0; Y := 0; Z := 0; - W := 0; - H := 0; + W := oldWidth; + H := oldHeight; ScaleW := 1; ScaleH := 1; Rot := 0; diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 4c5434f8..832e17d9 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -175,11 +175,12 @@ type W: integer; H: integer; Z: real; + SBGW: integer; TextSize: integer; - //SBGW Mod - SBGW: integer; + showArrows:boolean; + oneItemOnly:boolean; Text: string; ColR, ColG, ColB, Int: real; @@ -1785,7 +1786,7 @@ begin ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); - ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450); + ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 400); LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', '')); ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1); -- cgit v1.2.3 From 257854c587f0876a912cfbeb4fe0a30970d25a9b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 31 May 2009 14:10:42 +0000 Subject: merged (experimental) mouse support patch by d0ccrazy some changes to patch - implemented software cursor (texturable) - option to turn of mouse support or switch between hardware and software cursor - hide software cursor if there is no mouse activity for 5 seconds - soft fade in and out for software cursor - some test cursor-textures for deluxe theme (mog pls change these horible looking images) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1789 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 19 ++++++++++--- src/base/UIni.pas | 8 ++++++ src/base/UMain.pas | 76 +++++++++++++++++++++++++++++++++++++-------------- 3 files changed, 78 insertions(+), 25 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 82cb3c50..818e49aa 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -199,10 +199,13 @@ var Tex_Score_Ratings : array [0..7] of TTexture; - //Arrows for SelectSlide + // arrows for SelectSlide Tex_SelectS_ArrowL: TTexture; Tex_SelectS_ArrowR: TTexture; - + + // textures for software mouse cursor + Tex_Cursor_Unpressed: TTexture; + Tex_Cursor_Pressed: TTexture; const Skin_BGColorR = 1; Skin_BGColorG = 1; @@ -335,6 +338,13 @@ begin Tex_SelectS_ArrowL := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowLeft'), TEXTURE_TYPE_TRANSPARENT, 0); Tex_SelectS_ArrowR := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowRight'), TEXTURE_TYPE_TRANSPARENT, 0); + Tex_Cursor_Unpressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor'), TEXTURE_TYPE_TRANSPARENT, 0); + + if (Skin.GetTextureFileName('Cursor_Pressed') <> '') then + Tex_Cursor_Pressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor_Pressed'), TEXTURE_TYPE_TRANSPARENT, 0) + else + Tex_Cursor_Pressed.TexNum := 0; + //TimeBar mod Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); //eoa TimeBar mod @@ -492,6 +502,7 @@ begin Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); Display := TDisplay.Create; + //Display.SetCursor; //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); @@ -624,15 +635,15 @@ begin 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 else begin Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); screen := SDL_SetVideoMode(W, H, 0, SDL_OPENGL or SDL_RESIZABLE); - SDL_ShowCursor(1); end; + SDL_ShowCursor(0); + if (screen = nil) then begin Log.LogCritical('SDL_SetVideoMode Failed', 'Initialize3D'); diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 2c1029f6..a016753e 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -154,6 +154,7 @@ type // Controller Joypad: integer; + Mouse: integer; procedure Load(); procedure Save(); @@ -246,6 +247,7 @@ const IPartyPopup: array[0..1] of string = ('Off', 'On'); IJoypad: array[0..1] of string = ('Off', 'On'); + IMouse: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor'); // Recording options IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); @@ -769,6 +771,9 @@ begin // Joypad Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); + // Mouse + Mouse := GetArrayIndex(IMouse, IniFile.ReadString('Controller', 'Mouse', IMouse[2])); + LoadPaths(IniFile); IniFile.Free; @@ -908,6 +913,9 @@ begin // Joypad IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); + // Mouse + IniFile.WriteString('Controller', 'Mouse', IMouse[Mouse]); + // Directories (add a template if section is missing) // Note: Value must be ' ' and not '', otherwise no key is generated on Linux if (not IniFile.SectionExists('Directories')) then diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 28ba5afc..3900c877 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -375,9 +375,26 @@ begin end; end; +procedure DoQuit; +begin + // if question option is enabled then show exit popup + if (Ini.AskbeforeDel = 1) then + begin + Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); + end + else // if ask-for-exit is disabled then simply exit + begin + Display.Fade := 0; + Display.NextScreenWithCheck := nil; + Display.CheckOK := True; + end; +end; + procedure CheckEvents; var Event: TSDL_event; + mouseDown: Boolean; + mouseBtn: Integer; begin if Assigned(Display.NextScreen) then Exit; @@ -391,17 +408,46 @@ begin Display.NextScreenWithCheck := nil; Display.CheckOK := true; end; - SDL_MOUSEBUTTONDOWN: + + SDL_MOUSEMOTION, SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: begin -{ - with Event.button do + if (Ini.Mouse > 0) then begin - if State = SDL_BUTTON_LEFT then + case Event.type_ of + SDL_MOUSEMOTION: + begin + mouseDown := False; + mouseBtn := 0; + end; + SDL_MOUSEBUTTONDOWN: + begin + mouseDown := True; + mouseBtn := Event.button.button; + end; + SDL_MOUSEBUTTONUP: + begin + mouseDown := False; + mouseBtn := Event.button.button; + end; + end; + + Display.MoveCursor(Event.button.X * 800 / Screen.w, + Event.button.Y * 600 / Screen.h, + mouseDown and ((mouseBtn <> SDL_BUTTON_WHEELDOWN) or (mouseBtn <> SDL_BUTTON_WHEELUP))); + + if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else begin - // + done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); + + // if screen wants to exit + if done then + DoQuit; end; end; -} end; SDL_VIDEORESIZE: begin @@ -437,14 +483,14 @@ begin if boolean( Ini.FullScreen ) then begin SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); - SDL_ShowCursor(0); end else begin SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - SDL_ShowCursor(1); end; + Display.SetCursor; + glViewPort(0, 0, ScreenW, ScreenH); {$IFEND} end @@ -464,19 +510,7 @@ begin // if screen wants to exit if Done then - begin - // if question option is enabled then show exit popup - if (Ini.AskbeforeDel = 1) then - begin - Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); - end - else // if ask-for-exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := true; - end; - end; + DoQuit; end; end; -- cgit v1.2.3 From e62e309c4d66eea5def40cb8bf81fd1d0ce16900 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 1 Jun 2009 09:27:45 +0000 Subject: fix reflections at score display git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1792 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 2d9b1e5e..64fa86dd 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -815,6 +815,7 @@ begin SetFontStyle(Positions[PIndex].PUFont); SetFontItalic(False); SetFontSize(FontSize); + SetFontReflection(False, 0); //Draw Text TextLen := glTextWidth(Theme.Sing.LineBonusText[PopUp.Rating]); @@ -872,6 +873,7 @@ begin SetFontItalic(False); SetFontSize(Position.TextSize); SetFontPos(Position.TextX, Position.TextY); + SetFontReflection(False, 0); ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; While (Length(ScoreStr) < 5) do -- cgit v1.2.3 From 9cdd567e719062d42a328fad84e6fbaf8effd4ef Mon Sep 17 00:00:00 2001 From: canni0 Date: Mon, 1 Jun 2009 14:50:42 +0000 Subject: - fixed assembla ticket #86 - fixed extended assembla ticket #49 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1795 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index a016753e..5447869b 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -201,8 +201,7 @@ const ISingWindow: array[0..1] of string = ('Small', 'Big'); //SingBar Mod - IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar'); -//IOscilloscope: array[0..1] of string = ('Off', 'On'); + IOscilloscope: array[0..1] of string = ('Off', 'On'); ISpectrum: array[0..1] of string = ('Off', 'On'); ISpectrograph: array[0..1] of string = ('Off', 'On'); @@ -683,7 +682,7 @@ begin SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); // Oscilloscope - Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar')); + Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', IOscilloscope[0])); // Spectrum Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off')); @@ -763,7 +762,7 @@ begin OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); // Linebonus - LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score')); + LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', ILineBonus[2])); // PartyPopup PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); -- cgit v1.2.3 From 258f7abea4a98ccfb21e3b77f90349e6c358cfaf Mon Sep 17 00:00:00 2001 From: canni0 Date: Mon, 1 Jun 2009 15:18:20 +0000 Subject: - R.I.P. "At Notes" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1796 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 5447869b..0654f516 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -242,7 +242,7 @@ const IScreenFade: array[0..1] of string = ('Off', 'On'); IAskbeforeDel: array[0..1] of string = ('Off', 'On'); IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes'); + ILineBonus: array[0..1] of string = ('Off', 'On'); IPartyPopup: array[0..1] of string = ('Off', 'On'); IJoypad: array[0..1] of string = ('Off', 'On'); @@ -762,7 +762,7 @@ begin OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); // Linebonus - LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', ILineBonus[2])); + LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', ILineBonus[1])); // PartyPopup PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); -- cgit v1.2.3 From a83259dd2fe8ef271f550c4d48fe62eeb5802641 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 3 Jun 2009 21:56:19 +0000 Subject: cosmetics. no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1798 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 640 ++++++++++++++++++++++++----------------------- 1 file changed, 321 insertions(+), 319 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 64fa86dd..32b63197 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -34,211 +34,211 @@ interface {$I switches.inc} uses - UThemes, gl, + UThemes, UTexture; ////////////////////////////////////////////////////////////// // ATTENTION: // -// Enabled Flag does not Work atm. This should cause Popups // -// Not to Move and Scores to stay until Renenabling. // -// To use e.g. in Pause Mode // -// Also InVisible Flag causes Attributes not to change. // -// This should be fixed after next Draw when Visible = True,// -// but not testet yet // +// Enabled flag does not work atm. This should cause popups // +// not to move and scores to stay until re-enabling. // +// To use e.g. in pause mode // +// also invisible flag causes attributes not to change. // +// This should be fixed after next draw when visible = true,// +// but not tested yet // ////////////////////////////////////////////////////////////// -//Some constants containing options that could change by time +// some constants containing options that could change by time const - MaxPlayers = 6; //Maximum of Players that could be added - MaxPositions = 6; //Maximum of Score Positions that could be added + MaxPlayers = 6; // maximum of players that could be added + MaxPositions = 6; // maximum of score positions that could be added type //----------- - // TScorePlayer - Record Containing Information about a Players Score + // TScorePlayer - record containing information about a players score //----------- TScorePlayer = record - Position: Byte; //Index of the Position where the Player should be Drawn - Enabled: Boolean; //Is the Score Display Enabled - Visible: Boolean; //Is the Score Display Visible - Score: Word; //Current Score of the Player - ScoreDisplayed: Word; //Score cur. Displayed(for counting up) - ScoreBG: TTexture;//Texture of the Players Scores BG - Color: TRGB; //Teh Players Color - RBPos: Real; //Cur. Percentille of the Rating Bar - RBTarget: Real; //Target Position of Rating Bar - RBVisible:Boolean; //Is Rating bar Drawn + Position: byte; // index of the position where the player should be drawn + Enabled: boolean; // is the score display enabled + Visible: boolean; // is the score display visible + Score: word; // current score of the player + ScoreDisplayed: word; // score cur. displayed (for counting up) + ScoreBG: TTexture; // texture of the players scores bg + Color: TRGB; // the players color + RBPos: real; // cur. percentille of the rating bar + RBTarget: real; // target position of rating bar + RBVisible: boolean; // is rating bar drawn end; - aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer; + aScorePlayer = array [0..MaxPlayers-1] of TScorePlayer; //----------- - // TScorePosition - Record Containing Information about a Score Position, that can be used + // TScorePosition - record containing information about a score position, that can be used //----------- PScorePosition = ^TScorePosition; TScorePosition = record - //The Position is Used for Which Playercount - PlayerCount: Byte; - // 1 - One Player per Screen - // 2 - 2 Players per Screen - // 4 - 3 Players per Screen - // 6 would be 2 and 3 Players per Screen - - BGX: Real; //X Position of the Score BG - BGY: Real; //Y Position of the Score BG - BGW: Real; //Width of the Score BG - BGH: Real; //Height of the Score BG - - RBX: Real; //X Position of the Rating Bar - RBY: Real; //Y Position of the Rating Bar - RBW: Real; //Width of the Rating Bar - RBH: Real; //Height of the Rating Bar - - TextX: Real; //X Position of the Score Text - TextY: Real; //Y Position of the Score Text - TextFont: Byte; //Font of the Score Text - TextSize: integer; //Size of the Score Text - - PUW: Real; //Width of the LineBonus Popup - PUH: Real; //Height of the LineBonus Popup - PUFont: Byte; //Font for the PopUps - PUFontSize: integer; //FontSize for the PopUps - PUStartX: Real; //X Start Position of the LineBonus Popup - PUStartY: Real; //Y Start Position of the LineBonus Popup - PUTargetX: Real; //X Target Position of the LineBonus Popup - PUTargetY: Real; //Y Target Position of the LineBonus Popup + // the position is used for which playercount + PlayerCount: byte; + // 1 - 1 player per screen + // 2 - 2 players per screen + // 4 - 3 players per screen + // 6 would be 2 and 3 players per screen + + BGX: real; // x position of the score bg + BGY: real; // y position of the score bg + BGW: real; // width of the score bg + BGH: real; // height of the score bg + + RBX: real; // x position of the rating bar + RBY: real; // y position of the rating bar + RBW: real; // width of the rating bar + RBH: real; // height of the rating bar + + TextX: real; // x position of the score text + TextY: real; // y position of the score text + TextFont: byte; // font of the score text + TextSize: integer; // size of the score text + + PUW: real; // width of the line bonus popup + PUH: real; // height of the line bonus popup + PUFont: byte; // font for the popups + PUFontSize: integer; // font size for the popups + PUStartX: real; // x start position of the line bonus popup + PUStartY: real; // y start position of the line bonus popup + PUTargetX: real; // x target position of the line bonus popup + PUTargetY: real; // y target position of the line bonus popup end; - aScorePosition = array[0..MaxPositions-1] of TScorePosition; + aScorePosition = array [0..MaxPositions-1] of TScorePosition; //----------- - // TScorePopUp - Record Containing Information about a LineBonus Popup - // List, Next Item is Saved in Next attribute + // TScorePopUp - record containing information about a line bonus popup + // list, next item is saved in next attribute //----------- PScorePopUp = ^TScorePopUp; TScorePopUp = record - Player: Byte; //Index of the PopUps Player - TimeStamp: Cardinal; //Timestamp of Popups Spawn - Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.) - ScoreGiven:Word; //Score that has already been given to the Player - ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score - Next: PScorePopUp; //Next Item in List + Player: byte; // index of the popups player + TimeStamp: cardinal; // timestamp of popups spawn + Rating: byte; // 0 to 8, type of rating (cool, bad, etc.) + ScoreGiven: word; // score that has already been given to the player + ScoreDiff: word; // difference between cur score at spawn and old score + Next: PScorePopUp; // next item in list end; aScorePopUp = array of TScorePopUp; //----------- - // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups + // TSingScores - class containing scores positions and drawing scores, rating bar + popups //----------- TSingScores = class private Positions: aScorePosition; - aPlayers: aScorePlayer; - oPositionCount: Byte; - oPlayerCount: Byte; + aPlayers: aScorePlayer; + oPositionCount: byte; + oPlayerCount: byte; - //Saves the First and Last Popup of the List + // saves the first and last popup of the list FirstPopUp: PScorePopUp; LastPopUp: PScorePopUp; - // Draws a Popup by Pointer + // draws a popup by pointer procedure DrawPopUp(const PopUp: PScorePopUp); - // Draws a Score by Playerindex - procedure DrawScore(const Index: Integer); + // draws a score by playerindex + procedure DrawScore(const Index: integer); - // Draws the RatingBar by Playerindex - procedure DrawRatingBar(const Index: Integer); + // draws the rating bar by playerindex + procedure DrawRatingBar(const Index: integer); - // Removes a PopUp w/o destroying the List + // removes a popup w/o destroying the list procedure KillPopUp(const last, cur: PScorePopUp); public - Settings: record //Record containing some Displaying Options - Phase1Time: Real; //time for Phase 1 to complete (in msecs) - //The Plop Up of the PopUp - Phase2Time: Real; //time for Phase 2 to complete (in msecs) - //The Moving (mainly Upwards) of the Popup - Phase3Time: Real; //time for Phase 3 to complete (in msecs) - //The Fade out and Score adding + Settings: record // Record containing some Displaying Options + Phase1Time: real; // time for phase 1 to complete (in msecs) + // the plop up of the popup + Phase2Time: real; // time for phase 2 to complete (in msecs) + // the moving (mainly upwards) of the popup + Phase3Time: real; // time for phase 3 to complete (in msecs) + // the fade out and score adding - PopUpTex: array [0..8] of TTexture; //Textures for every Popup Rating + PopUpTex: array [0..8] of TTexture; // textures for every popup rating - RatingBar_BG_Tex: TTexture; //Rating Bar Texs - RatingBar_FG_Tex: TTexture; - RatingBar_Bar_Tex: TTexture; + RatingBar_BG_Tex: TTexture; // rating bar texs + RatingBar_FG_Tex: TTexture; + RatingBar_Bar_Tex: TTexture; end; - Visible: Boolean; //Visibility of all Scores - Enabled: Boolean; //Scores are changed, PopUps are Moved etc. - RBVisible: Boolean; //Visibility of all Rating Bars + Visible: boolean; // visibility of all scores + Enabled: boolean; // scores are changed, popups are moved etc. + RBVisible: boolean; // visibility of all rating bars - //Propertys for Reading Position and Playercount - property PositionCount: Byte read oPositionCount; - property PlayerCount: Byte read oPlayerCount; - property Players: aScorePlayer read aPlayers; + // properties for reading position and playercount + property PositionCount: byte read oPositionCount; + property PlayerCount: byte read oPlayerCount; + property Players: aScorePlayer read aPlayers; - //Constructor just sets some standard Settings + // constructor just sets some standard settings constructor Create; - // Adds a Position to Array and Increases Position Count + // adds a position to array and increases position count procedure AddPosition(const pPosition: PScorePosition); - // Adds a Player to Array and Increases Player Count - procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True); + // adds a player to array and increases player count + procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word = 0; const Enabled: boolean = true; const Visible: boolean = true); - //Change a Players Visibility, Enable - procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); - procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); + // change a players visibility, enable + procedure ChangePlayerVisibility(const Index: byte; const pVisible: boolean); + procedure ChangePlayerEnabled(const Index: byte; const pEnabled: boolean); - // Deletes all Player Information + // deletes all player information procedure ClearPlayers; - // Deletes Positions and Playerinformation + // deletes positions and playerinformation procedure Clear; - // Loads some Settings and the Positions from Theme + // loads some settings and the positions from theme procedure LoadfromTheme; - // has to be called after Positions and Players have been added, before first call of Draw - //It gives every Player a Score Position + // has to be called after positions and players have been added, before first call of draw + // it gives every player a score position procedure Init; - //Spawns a new Line Bonus PopUp for the Player - procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); + // spawns a new line bonus popup for the player + procedure SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word); - //Removes all PopUps from Mem + // removes all popups from mem procedure KillAllPopUps; - // Draws Scores and Linebonus PopUps + // draws scores and line bonus popups procedure Draw; end; - implementation -uses SDL, - SysUtils, - ULog, - UGraphic, - TextGL; +uses + SysUtils, + SDL, + TextGL, + ULog, + UGraphic; {** - * Sets some standard Settings + * sets some standard settings *} -Constructor TSingScores.Create; +constructor TSingScores.Create; begin inherited; - //Clear PopupList Pointers + // clear popuplist pointers FirstPopUp := nil; LastPopUp := nil; - //Clear Variables - Visible := True; - Enabled := True; - RBVisible := True; + // clear variables + Visible := true; + Enabled := true; + RBVisible := true; - //Clear Position Index - oPositionCount := 0; - oPlayerCount := 0; + // clear position index + oPositionCount := 0; + oPlayerCount := 0; Settings.Phase1Time := 350; // plop it up . -> [ ] Settings.Phase2Time := 550; // shift it up ^[ ]^ @@ -260,22 +260,21 @@ begin end; {** - * Adds a Position to Array and Increases Position Count + * adds a position to array and increases position count *} -Procedure TSingScores.AddPosition(const pPosition: PScorePosition); +procedure TSingScores.AddPosition(const pPosition: PScorePosition); begin if (PositionCount < MaxPositions) then begin Positions[PositionCount] := pPosition^; - Inc(oPositionCount); end; end; {** - * Adds a Player to Array and Increases Player Count + * adds a player to array and increases player count *} -Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean); +procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word; const Enabled: boolean; const Visible: boolean); begin if (PlayerCount < MaxPlayers) then begin @@ -283,48 +282,48 @@ begin aPlayers[PlayerCount].Enabled := Enabled; aPlayers[PlayerCount].Visible := Visible; aPlayers[PlayerCount].Score := Score; - aPlayers[PlayerCount].ScoreDisplayed := Score; + aPlayers[PlayerCount].ScoreDisplayed := Score; aPlayers[PlayerCount].ScoreBG := ScoreBG; aPlayers[PlayerCount].Color := Color; aPlayers[PlayerCount].RBPos := 0.5; aPlayers[PlayerCount].RBTarget := 0.5; - aPlayers[PlayerCount].RBVisible := True; + aPlayers[PlayerCount].RBVisible := true; Inc(oPlayerCount); end; end; {** - * Change a Players Visibility + * change a players visibility *} -Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean); +procedure TSingScores.ChangePlayerVisibility(const Index: byte; const pVisible: boolean); begin if (Index < MaxPlayers) then aPlayers[Index].Visible := pVisible; end; {** - * Change Player Enabled + * change player enabled *} -Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean); +procedure TSingScores.ChangePlayerEnabled(const Index: byte; const pEnabled: boolean); begin if (Index < MaxPlayers) then aPlayers[Index].Enabled := pEnabled; end; {** - * Procedure Deletes all Player Information + * procedure deletes all player information *} -Procedure TSingScores.ClearPlayers; +procedure TSingScores.ClearPlayers; begin KillAllPopUps; oPlayerCount := 0; end; {** - * Procedure Deletes Positions and Playerinformation + * procedure deletes positions and playerinformation *} -Procedure TSingScores.Clear; +procedure TSingScores.Clear; begin KillAllPopUps; oPlayerCount := 0; @@ -332,14 +331,16 @@ begin end; {** - * Procedure Loads some Settings and the Positions from Theme + * procedure loads some settings and the positions from theme *} -Procedure TSingScores.LoadfromTheme; -var I: Integer; - Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); - var nPosition: TScorePosition; +procedure TSingScores.LoadfromTheme; +var + I: integer; + procedure AddbyStatics(const PC: byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); + var + nPosition: TScorePosition; begin - nPosition.PlayerCount := PC; //Only for one Player Playing + nPosition.PlayerCount := PC; // only for one player playing nPosition.BGX := ScoreStatic.X; nPosition.BGY := ScoreStatic.Y; @@ -373,54 +374,55 @@ var I: Integer; begin Clear; - //Set Textures - //Popup Tex - For I := 0 to 8 do + // set textures + // popup tex + for I := 0 to 8 do Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; - //Rating Bar Tex + // rating bar tex Settings.RatingBar_BG_Tex := Tex_SingBar_Back; Settings.RatingBar_FG_Tex := Tex_SingBar_Front; Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; - //Load Positions from Theme + // load positions from theme - // Player1: + // player 1: AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); - // Player2: + // player 2: AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); - // Player3: + // player 3: AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore); end; {** - * Spawns a new Line Bonus PopUp for the Player + * spawns a new line bonus popup for the player *} -Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word); -var Cur: PScorePopUp; +procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word); +var + Cur: PScorePopUp; begin if (PlayerIndex < PlayerCount) then begin - //Get Memory and Add Data + // get memory and add data GetMem(Cur, SizeOf(TScorePopUp)); - Cur.Player := PlayerIndex; + Cur.Player := PlayerIndex; Cur.TimeStamp := SDL_GetTicks; - //limit rating value to 8 - //a higher value would cause a crash when selecting the bg textur + // limit rating value to 8 + // a higher value would cause a crash when selecting the bg texture if (Rating > 8) then Cur.Rating := 8 else Cur.Rating := Rating; Cur.ScoreGiven:= 0; - If (Players[PlayerIndex].Score < Score) then + if (Players[PlayerIndex].Score < Score) then begin Cur.ScoreDiff := Score - Players[PlayerIndex].Score; aPlayers[PlayerIndex].Score := Score; @@ -429,77 +431,77 @@ begin Cur.ScoreDiff := 0; Cur.Next := nil; - //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); + // Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); - //Add it to the Chain + // add it to the chain if (FirstPopUp = nil) then - //the first PopUp in the List + // the first popup in the list FirstPopUp := Cur else - //second or earlier popup + // second or earlier popup LastPopUp.Next := Cur; - //Set new Popup to Last PopUp in the List + // set new popup to last popup in the list LastPopUp := Cur; end else - Log.LogError('TSingScores: Try to add PopUp for not existing player'); + Log.LogError('TSingScores: Try to add popup for non-existing player'); end; {** - * Removes a PopUp w/o destroying the List + * removes a popup w/o destroying the list *} -Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); +procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); begin - //Give Player the Last Points that missing till now + // give player the last points that missing till now aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; - //Change Bars Position + // change bars position if (Cur.ScoreDiff > 0) THEN - begin //Popup w/ scorechange -> give missing Percentille + begin // popup w/ scorechange -> give missing percentille aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) / Cur.ScoreDiff * (Cur.Rating / 20 - 0.26); end else - begin //Popup w/o scorechange -> give complete Percentille + begin // popup w/o scorechange -> give complete percentille aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + (Cur.Rating / 20 - 0.26); end; - If (aPlayers[Cur.Player].RBTarget > 1) then + if (aPlayers[Cur.Player].RBTarget > 1) then aPlayers[Cur.Player].RBTarget := 1 else - If (aPlayers[Cur.Player].RBTarget < 0) then + if (aPlayers[Cur.Player].RBTarget < 0) then aPlayers[Cur.Player].RBTarget := 0; - //If this is the First PopUp => Make Next PopUp the First - If (Cur = FirstPopUp) then + // if this is the first popup => make next popup the first + if (Cur = FirstPopUp) then FirstPopUp := Cur.Next - //Else => Remove Curent Popup from Chain + // else => remove curent popup from chain else Last.Next := Cur.Next; - //If this is the Last PopUp, Make PopUp before the Last - If (Cur = LastPopUp) then + // if this is the last popup, make popup before the last + if (Cur = LastPopUp) then LastPopUp := Last; - //Free the Memory + // free the memory FreeMem(Cur, SizeOf(TScorePopUp)); end; {** - * Removes all PopUps from Mem + * removes all popups from mem *} -Procedure TSingScores.KillAllPopUps; +procedure TSingScores.KillAllPopUps; var Cur: PScorePopUp; Last: PScorePopUp; begin Cur := FirstPopUp; - //Remove all PopUps: - While (Cur <> nil) do + // remove all popups: + while (Cur <> nil) do begin Last := Cur; Cur := Cur.Next; @@ -511,40 +513,42 @@ begin end; {** - * Has to be called after Positions and Players have been added, before first call of Draw - * It gives every Player a Score Position + * has to be called after positions and players have been added, before first call of draw + * it gives each player a score position *} -Procedure TSingScores.Init; +procedure TSingScores.Init; var - PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen - I, J: Integer; - MaxPlayersperScreen: Byte; - CurPlayer: Byte; - - Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte; - var I: Integer; + PlC: array [0..1] of byte; // playercount first screen and second screen + I, J: integer; + MaxPlayersperScreen: byte; + CurPlayer: byte; + + function GetPositionCountbyPlayerCount(bPlayerCount: byte): byte; + var + I: integer; begin Result := 0; bPlayerCount := 1 shl (bPlayerCount - 1); - For I := 0 to PositionCount-1 do + for I := 0 to PositionCount-1 do begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then Inc(Result); end; end; - Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte; - var I: Integer; + function GetPositionbyPlayernum(bPlayerCount, bPlayer: byte): byte; + var + I: integer; begin bPlayerCount := 1 shl (bPlayerCount - 1); - Result := High(Byte); + Result := High(byte); - For I := 0 to PositionCount-1 do + for I := 0 to PositionCount - 1 do begin - If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then + if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then begin - If (bPlayer = 0) then + if (bPlayer = 0) then begin Result := I; Break; @@ -558,17 +562,16 @@ var begin MaxPlayersPerScreen := 0; - For I := 1 to 6 do + for I := 1 to 6 do begin - //If there are enough Positions -> Write to MaxPlayers - If (GetPositionCountbyPlayerCount(I) = I) then + // if there are enough positions -> write to maxplayers + if (GetPositionCountbyPlayerCount(I) = I) then MaxPlayersPerScreen := I else Break; end; - - //Split Players to both Screen or Display on One Screen + // split players to both screens or display on one screen if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then begin PlC[0] := PlayerCount div 2 + PlayerCount mod 2; @@ -580,9 +583,8 @@ begin PlC[1] := 0; end; - - //Check if there are enough Positions for all Players - For I := 0 to Screens - 1 do + // check if there are enough positions for all players + for I := 0 to Screens - 1 do begin if (PlC[I] > MaxPlayersperScreen) then begin @@ -592,34 +594,34 @@ begin end; CurPlayer := 0; - //Give every Player a Position - For I := 0 to Screens - 1 do - For J := 0 to PlC[I]-1 do + // give every player a position + for I := 0 to Screens - 1 do + for J := 0 to PlC[I]-1 do begin - aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7); - //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); + aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) or (I shl 7); + // Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); Inc(CurPlayer); end; end; {** - * Draws Scores and Linebonus PopUps + * draws scores and linebonus popups *} -Procedure TSingScores.Draw; +procedure TSingScores.Draw; var - I: Integer; - CurTime: Cardinal; + I: integer; + CurTime: cardinal; CurPopUp, LastPopUp: PScorePopUp; begin CurTime := SDL_GetTicks; - If Visible then + if Visible then begin - //Draw Popups + // draw popups LastPopUp := nil; CurPopUp := FirstPopUp; - While (CurPopUp <> nil) do + while (CurPopUp <> nil) do begin if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then begin @@ -638,64 +640,64 @@ begin end; - IF (RBVisible) then - //Draw Players w/ Rating Bar - For I := 0 to PlayerCount-1 do + if (RBVisible) then + // draw players w/ rating bar + for I := 0 to PlayerCount-1 do begin DrawScore(I); DrawRatingBar(I); end else - //Draw Players w/o Rating Bar - For I := 0 to PlayerCount-1 do + // draw players w/o rating bar + for I := 0 to PlayerCount-1 do begin DrawScore(I); end; - end; //eo Visible + end; // eo visible end; {** - * Draws a Popup by Pointer + * draws a popup by pointer *} -Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); +procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); var - Progress: Real; - CurTime: Cardinal; - X, Y, W, H, Alpha: Real; - FontSize: integer; - FontOffset: Real; - TimeDiff: Cardinal; - PIndex: Byte; - TextLen: Real; - ScoretoAdd: Word; - PosDiff: Real; + Progress: real; + CurTime: cardinal; + X, Y, W, H, Alpha: real; + FontSize: integer; + FontOffset: real; + TimeDiff: cardinal; + PIndex: byte; + TextLen: real; + ScoretoAdd: word; + PosDiff: real; begin if (PopUp <> nil) then begin - //Only Draw if Player has a Position + // only draw if player has a position PIndex := Players[PopUp.Player].Position; - If PIndex <> high(byte) then + if PIndex <> High(byte) then begin - //Only Draw if Player is on Cur Screen - If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then + // only draw if player is on cur screen + if ((Players[PopUp.Player].Position and 128) = 0) = (ScreenAct = 1) then begin CurTime := SDL_GetTicks; - If Not (Enabled AND Players[PopUp.Player].Enabled) then - //Increase Timestamp with TIem where there is no Movement ... + if not (Enabled and Players[PopUp.Player].Enabled) then + // increase timestamp with tiem where there is no movement ... begin - //Inc(PopUp.TimeStamp, LastRender); + // Inc(PopUp.TimeStamp, LastRender); end; TimeDiff := CurTime - PopUp.TimeStamp; - //Get Position of PopUp - PIndex := PIndex AND 127; + // get position of popup + PIndex := PIndex and 127; - //Check for Phase ... - If (TimeDiff <= Settings.Phase1Time) then + // check for phase ... + if (TimeDiff <= Settings.Phase1Time) then begin - //Phase 1 - The Ploping up + // phase 1 - the ploping up Progress := TimeDiff / Settings.Phase1Time; @@ -706,25 +708,25 @@ begin Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; FontSize := Round(Progress * Positions[PIndex].PUFontSize); - FontOffset := (H - FontSize) / 2; + FontOffset := (H - FontSize) / 2; Alpha := 1; end - Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then + else if (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then begin - //Phase 2 - The Moving + // phase 2 - the moving Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; W := Positions[PIndex].PUW; H := Positions[PIndex].PUH; PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If PosDiff > 0 then + if PosDiff > 0 then PosDiff := PosDiff + W; X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If PosDiff < 0 then + if PosDiff < 0 then PosDiff := PosDiff + Positions[PIndex].BGH; Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); @@ -735,65 +737,65 @@ begin else begin - //Phase 3 - The Fading out + Score adding + // phase 3 - the fading out + score adding Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; - If (PopUp.Rating > 0) then + if (PopUp.Rating > 0) then begin - //Add Scores if Player Enabled - If (Enabled AND Players[PopUp.Player].Enabled) then + // add scores if player enabled + if (Enabled and Players[PopUp.Player].Enabled) then begin ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; Inc(PopUp.ScoreGiven, ScoreToAdd); aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; - //Change Bars Position + // change bar positions aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); - If (aPlayers[PopUp.Player].RBTarget > 1) then + if (aPlayers[PopUp.Player].RBTarget > 1) then aPlayers[PopUp.Player].RBTarget := 1 - else If (aPlayers[PopUp.Player].RBTarget < 0) then + else if (aPlayers[PopUp.Player].RBTarget < 0) then aPlayers[PopUp.Player].RBTarget := 0; end; - //Set Positions etc. - Alpha := 0.7 - 0.7 * Progress; + // set positions etc. + Alpha := 0.7 - 0.7 * Progress; W := Positions[PIndex].PUW; H := Positions[PIndex].PUH; PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - If (PosDiff > 0) then + if (PosDiff > 0) then PosDiff := W else PosDiff := 0; X := Positions[PIndex].PUTargetX + PosDiff * Progress; PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - If (PosDiff < 0) then + if (PosDiff < 0) then PosDiff := -Positions[PIndex].BGH else PosDiff := 0; - Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress); + Y := Positions[PIndex].PUTargetY - PosDiff * (1 - Progress); FontSize := Positions[PIndex].PUFontSize; FontOffset := (H - FontSize) / 2; end else begin - //Here the Effect that Should be shown if a PopUp without Score is Drawn - //And or Spawn with the GraphicObjects etc. - //Some Work for Blindy to do :P + // here the effect that should be shown if a popup without score is drawn + // and or spawn with the graphicobjects etc. + // some work for blindy to do :p - //ATM: Just Let it Slide in the Scores just like the Normal PopUp + // atm: just let it slide in the scores just like the normal popup Alpha := 0; end; end; - //Draw PopUp + // draw popup - if (Alpha > 0) AND (Players[PopUp.Player].Visible) then + if (Alpha > 0) and (Players[PopUp.Player].Visible) then begin - //Draw BG: + // draw bg: glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); @@ -811,46 +813,46 @@ begin glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); - //Set FontStyle and Size + // set font style and size SetFontStyle(Positions[PIndex].PUFont); - SetFontItalic(False); + SetFontItalic(false); SetFontSize(FontSize); - SetFontReflection(False, 0); + SetFontReflection(false, 0); - //Draw Text + // draw text TextLen := glTextWidth(Theme.Sing.LineBonusText[PopUp.Rating]); - //Color and Pos + // color and pos SetFontPos (X + (W - TextLen) / 2, Y + FontOffset); glColor4f(1, 1, 1, Alpha); - //Draw + // draw glPrint(Theme.Sing.LineBonusText[PopUp.Rating]); - end; //eo Alpha check - end; //eo Right Screen - end; //eo Player has Position + end; // eo alpha check + end; // eo right screen + end; // eo player has position end else - Log.LogError('TSingScores: Try to Draw a not existing PopUp'); + Log.LogError('TSingScores: Try to draw a non-existing popup'); end; {** - * Draws a Score by Playerindex + * draws a score by playerindex *} -Procedure TSingScores.DrawScore(const Index: Integer); +procedure TSingScores.DrawScore(const Index: integer); var Position: PScorePosition; ScoreStr: String; begin - //Only Draw if Player has a Position - If Players[Index].Position <> high(byte) then + // only draw if player has a position + if Players[Index].Position <> High(byte) then begin - //Only Draw if Player is on Cur Screen - If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then + // only draw if player is on cur screen + if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1)) and Players[Index].Visible then begin Position := @Positions[Players[Index].Position and 127]; - //Draw ScoreBG + // draw scorebg glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); @@ -868,51 +870,51 @@ begin glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); - //Draw Score Text + // draw score text SetFontStyle(Position.TextFont); - SetFontItalic(False); + SetFontItalic(false); SetFontSize(Position.TextSize); SetFontPos(Position.TextX, Position.TextY); - SetFontReflection(False, 0); + SetFontReflection(false, 0); ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; - While (Length(ScoreStr) < 5) do + while (Length(ScoreStr) < 5) do ScoreStr := '0' + ScoreStr; glPrint(ScoreStr); - end; //eo Right Screen - end; //eo Player has Position + end; // eo right screen + end; // eo player has position end; -Procedure TSingScores.DrawRatingBar(const Index: Integer); +procedure TSingScores.DrawRatingBar(const Index: integer); var - Position: PScorePosition; - R,G,B, Size: Real; - Diff: Real; + Position: PScorePosition; + R, G, B: real; + Size, Diff: real; begin - //Only Draw if Player has a Position - if Players[Index].Position <> high(byte) then + // only draw if player has a position + if Players[Index].Position <> High(byte) then begin - //Only Draw if Player is on Cur Screen + // only draw if player is on cur screen if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and Players[index].RBVisible and Players[index].Visible) then begin Position := @Positions[Players[Index].Position and 127]; - if (Enabled AND Players[Index].Enabled) then + if (Enabled and Players[Index].Enabled) then begin - //Move Position if Enabled + // move position if enabled Diff := Players[Index].RBTarget - Players[Index].RBPos; - If(Abs(Diff) < 0.02) then + if (Abs(Diff) < 0.02) then aPlayers[Index].RBPos := aPlayers[Index].RBTarget else aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; end; - //Get Colors for RatingBar + // get colors for rating bar if (Players[index].RBPos <= 0.22) then begin R := 1; @@ -922,7 +924,7 @@ begin else if (Players[index].RBPos <= 0.42) then begin R := 1; - G := Players[index].RBPos*5; + G := Players[index].RBPos * 5; B := 0; end else if (Players[index].RBPos <= 0.57) then @@ -933,7 +935,7 @@ begin end else if (Players[index].RBPos <= 0.77) then begin - R := 1-(Players[index].RBPos-0.57)*5; + R := 1 - (Players[index].RBPos - 0.57) * 5; G := 1; B := 0; end @@ -944,12 +946,12 @@ begin B := 0; end; - //Enable all glFuncs Needed + // enable all glfuncs needed glEnable(GL_TEXTURE_2D); glEnable(GL_BLEND); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - //Draw RatingBar BG + // draw rating bar bg glColor4f(1, 1, 1, 0.8); glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); @@ -967,7 +969,7 @@ begin glVertex2f(Position.RBX+Position.RBW, Position.RBY); glEnd; - //Draw Rating bar itself + // draw rating bar itself Size := Position.RBX + Position.RBW * Players[Index].RBPos; glColor4f(R, G, B, 1); glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); @@ -985,7 +987,7 @@ begin glVertex2f(Size, Position.RBY); glEnd; - //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability) + // draw rating bar fg (the thing with the 3 lines to get better readability) glColor4f(1, 1, 1, 0.6); glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); glBegin(GL_QUADS); @@ -1002,11 +1004,11 @@ begin glVertex2f(Position.RBX + Position.RBW, Position.RBY); glEnd; - //Disable all Enabled glFuncs + // disable all enabled glfuncs glDisable(GL_TEXTURE_2D); glDisable(GL_BLEND); - end; //eo Right Screen - end; //eo Player has Position + end; // eo Right Screen + end; // eo Player has Position end; end. -- cgit v1.2.3 From d57509c0c5cbd154bde26be993bd2bb9324d89d6 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 3 Jun 2009 22:26:24 +0000 Subject: cosmetics. no code change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1799 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommon.pas | 98 +++++++++++++++++++++++++--------------------------- 1 file changed, 48 insertions(+), 50 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index a52349c0..d729b6dd 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -44,28 +44,28 @@ uses ULog; type - TMessageType = ( mtInfo, mtError ); + TMessageType = (mtInfo, mtError); -procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo ); +procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo); procedure ConsoleWriteLn(const msg: string); function RWopsFromStream(Stream: TStream): PSDL_RWops; {$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; +function RandomRange(aMin: integer; aMax: integer): integer; {$ENDIF} -function StringReplaceW(text : WideString; search, rep: WideChar):WideString; -function AdaptFilePaths( const aPath : widestring ): widestring; +function StringReplaceW(text: WideString; search, rep: WideChar): WideString; +function AdaptFilePaths(const aPath: WideString): WideString; procedure DisableFloatingPointExceptions(); procedure SetDefaultNumericLocale(); procedure RestoreNumericLocale(); {$IFNDEF MSWINDOWS} - procedure ZeroMemory( Destination: Pointer; Length: DWORD ); - function MakeLong(a, b: Word): Longint; + procedure ZeroMemory(Destination: pointer; Length: dword); + function MakeLong(a, b: word): longint; (* #define LOBYTE(a) (BYTE)(a) #define HIBYTE(a) (BYTE)((a)>>8) @@ -90,8 +90,8 @@ function IsControlChar(ch: WideChar): boolean; // A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) procedure MergeSort(List: TList; CompareFunc: TListSortCompare); -function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; -procedure FreeAlignedMem(P: Pointer); +function GetAlignedMem(Size: cardinal; Alignment: integer): pointer; +procedure FreeAlignedMem(P: pointer); implementation @@ -224,10 +224,10 @@ begin exOverflow, exUnderflow, exPrecision]); end; -function StringReplaceW(text : WideString; search, rep: WideChar) : WideString; +function StringReplaceW(text: WideString; search, rep: WideChar): WideString; var - iPos : integer; -// sTemp : WideString; + iPos: integer; +// sTemp: WideString; begin (* result := text; @@ -251,25 +251,25 @@ begin end; end; -function AdaptFilePaths( const aPath : widestring ): widestring; +function AdaptFilePaths(const aPath: WideString): WideString; begin - result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] ); + result := StringReplaceW(aPath, '\', PathDelim);//, [rfReplaceAll]); end; {$IFNDEF MSWINDOWS} -procedure ZeroMemory( Destination: Pointer; Length: DWORD ); +procedure ZeroMemory(Destination: pointer; Length: dword); begin - FillChar( Destination^, Length, 0 ); + FillChar(Destination^, Length, 0); end; -function MakeLong(A, B: Word): Longint; +function MakeLong(A, B: word): longint; begin Result := (LongInt(B) shl 16) + A; end; (* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool; +function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER): Bool; // From http://en.wikipedia.org/wiki/RDTSC function RDTSC: Int64; register; @@ -310,7 +310,7 @@ begin Result := false; FilePath := ExtractFilePath(FileName); - if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then + if (FindFirst(FilePath + '*', faAnyFile, SearchInfo) = 0) then begin LocalFileName := ExtractFileName(FileName); repeat @@ -330,14 +330,14 @@ begin end; // +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ -function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl; +function SdlStreamSeek(context: PSDL_RWops; offset: integer; whence: integer): integer; cdecl; var - stream : TStream; - origin : Word; + stream: TStream; + origin: word; begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamSeek on nil' ); + stream := TStream(context.unknown); + if (stream = nil) then + raise EInvalidContainer.Create('SDLStreamSeek on nil'); case whence of 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. @@ -345,30 +345,30 @@ begin else origin := soFromBeginning; // just in case end; - Result := stream.Seek( offset, origin ); + Result := stream.Seek(offset, origin); end; -function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl; +function SdlStreamRead(context: PSDL_RWops; Ptr: pointer; size: integer; maxnum: integer): integer; cdecl; var - stream : TStream; + stream: TStream; begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamRead on nil' ); + stream := TStream(context.unknown); + if (stream = nil) then + raise EInvalidContainer.Create('SDLStreamRead on nil'); try - Result := stream.read( Ptr^, Size * maxnum ) div size; + Result := stream.read(Ptr^, Size * maxnum) div size; except Result := -1; end; end; -function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl; +function SDLStreamClose(context: PSDL_RWops): integer; cdecl; var - stream : TStream; + stream: TStream; begin - stream := TStream( context.unknown ); - if ( stream = nil ) then - raise EInvalidContainer.Create( 'SDLStreamClose on nil' ); + stream := TStream(context.unknown); + if (stream = nil) then + raise EInvalidContainer.Create('SDLStreamClose on nil'); stream.Free; Result := 1; end; @@ -397,12 +397,10 @@ begin end; end; - - {$IFDEF FPC} -function RandomRange(aMin: Integer; aMax: Integer) : Integer; +function RandomRange(aMin: integer; aMax: integer): integer; begin - RandomRange := Random(aMax-aMin) + aMin ; + RandomRange := Random(aMax - aMin) + aMin ; end; {$ENDIF} @@ -455,7 +453,7 @@ begin System.EnterCriticalSection(ConsoleCriticalSection); // output pending messages - for i := 0 to MessageList.Count-1 do + for i := 0 to MessageList.Count - 1 do begin _ConsoleWriteLn(MessageList[i]); end; @@ -528,7 +526,7 @@ end; procedure ShowMessage(const msg: String; msgType: TMessageType); {$IFDEF MSWINDOWS} -var Flags: Cardinal; +var Flags: cardinal; {$ENDIF} begin {$IF Defined(MSWINDOWS)} @@ -607,7 +605,7 @@ procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: inte CompareFunc: TListSortCompare); var LeftSize, RightSize: integer; // number of elements in left/right block - LeftEnd, RightEnd: integer; // Index after last element in left/right block + LeftEnd, RightEnd: integer; // Index after last element in left/right block MidPos: integer; // index of first element in right block Pos: integer; // position in output list begin @@ -683,7 +681,7 @@ end; type // stores the unaligned pointer of data allocated by GetAlignedMem() PMemAlignHeader = ^TMemAlignHeader; - TMemAlignHeader = Pointer; + TMemAlignHeader = pointer; (** * Use this function to assure that allocated memory is aligned on a specific @@ -699,9 +697,9 @@ type * alignments on 16 and 32 byte boundaries too. *) {$WARNINGS OFF} -function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer; +function GetAlignedMem(Size: cardinal; Alignment: integer): pointer; var - OrigPtr: Pointer; + OrigPtr: pointer; const MIN_ALIGNMENT = 16; begin @@ -722,9 +720,9 @@ begin end; // reserve space for the header - Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); + Result := pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); // align memory - Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); + Result := pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); // set header with info on old pointer for FreeMem PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr; @@ -732,7 +730,7 @@ end; {$WARNINGS ON} {$WARNINGS OFF} -procedure FreeAlignedMem(P: Pointer); +procedure FreeAlignedMem(P: pointer); begin if (P <> nil) then FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^); -- cgit v1.2.3 From 133f0b4ebcc3b731e680a72ced52d00638791bf7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Thu, 4 Jun 2009 21:31:23 +0000 Subject: cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1800 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 22 ++++++++++++---------- src/base/USingScores.pas | 2 +- src/base/UThemes.pas | 8 ++++---- src/base/UTime.pas | 28 ++++++++++++++-------------- 4 files changed, 31 insertions(+), 29 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 3900c877..275510fc 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -359,9 +359,11 @@ begin CountMidTime; Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); + Log.LogError ('MainLoop', 'Delay: ' + intToStr(Delay)); if Delay >= 1 then SDL_Delay(Delay); // dynamic, maximum is 100 fps + Log.LogError ('MainLoop', 'Delay: ok ' + intToStr(Delay)); CountSkipTime; @@ -386,15 +388,15 @@ begin begin Display.Fade := 0; Display.NextScreenWithCheck := nil; - Display.CheckOK := True; + Display.CheckOK := true; end; end; procedure CheckEvents; var - Event: TSDL_event; - mouseDown: Boolean; - mouseBtn: Integer; + Event: TSDL_event; + mouseDown: boolean; + mouseBtn: integer; begin if Assigned(Display.NextScreen) then Exit; @@ -416,18 +418,18 @@ begin case Event.type_ of SDL_MOUSEMOTION: begin - mouseDown := False; - mouseBtn := 0; + mouseDown := false; + mouseBtn := 0; end; SDL_MOUSEBUTTONDOWN: begin - mouseDown := True; - mouseBtn := Event.button.button; + mouseDown := true; + mouseBtn := Event.button.button; end; SDL_MOUSEBUTTONUP: begin - mouseDown := False; - mouseBtn := Event.button.button; + mouseDown := false; + mouseBtn := Event.button.button; end; end; diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 32b63197..499e1188 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -530,7 +530,7 @@ var Result := 0; bPlayerCount := 1 shl (bPlayerCount - 1); - for I := 0 to PositionCount-1 do + for I := 0 to PositionCount - 1 do begin if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then Inc(Result); diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 832e17d9..3fd77853 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -42,13 +42,13 @@ uses type TRGB = record - R: single; - G: single; - B: single; + R: single; + G: single; + B: single; end; TRGBA = record - R, G, B, A: Double; + R, G, B, A: double; end; type diff --git a/src/base/UTime.pas b/src/base/UTime.pas index 3f35dffd..83844cb5 100644 --- a/src/base/UTime.pas +++ b/src/base/UTime.pas @@ -61,20 +61,20 @@ procedure CountSkipTime; procedure CountMidTime; var - USTime : TTime; + USTime: TTime; VideoBGTimer: TRelativeTimer; - TimeNew : int64; - TimeOld : int64; - TimeSkip : real; - TimeMid : real; - TimeMidTemp : int64; + TimeNew: int64; + TimeOld: int64; + TimeSkip: real; + TimeMid: real; + TimeMidTemp: int64; implementation uses sdl, - ucommon; + UCommon; const cSDLCorrectionRatio = 1000; @@ -91,14 +91,14 @@ http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE procedure CountSkipTimeSet; begin - TimeNew := SDL_GetTicks(); + TimeNew := SDL_GetTicks(); end; procedure CountSkipTime; begin - TimeOld := TimeNew; - TimeNew := SDL_GetTicks(); - TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; + TimeOld := TimeNew; + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; end; procedure CountMidTime; @@ -127,10 +127,10 @@ end; **} (* - * Creates a new timer. - * If TriggerMode is false (default), the timer + * creates a new timer. + * if triggermode is false (default), the timer * will immediately begin with counting. - * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called + * if triggermode is true, it will wait until get/settime() or pause() is called * for the first time. *) constructor TRelativeTimer.Create(TriggerMode: boolean); -- cgit v1.2.3 From c7e4891c2528317170b92a0a39c02a37c5907ac6 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 6 Jun 2009 21:41:40 +0000 Subject: work around to prevent division by zero by PopUp.ScoreDiff. may need review, why it happens at all. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1801 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 499e1188..89896d2d 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -750,7 +750,10 @@ begin aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; // change bar positions - aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); + if PopUp.ScoreDiff = 0 then + Log.LogError('TSingScores.DrawPopUp', 'PopUp.ScoreDiff is 0 and we want to divide by it. No idea how this happens.') + else + aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); if (aPlayers[PopUp.Player].RBTarget > 1) then aPlayers[PopUp.Player].RBTarget := 1 else if (aPlayers[PopUp.Player].RBTarget < 0) then -- cgit v1.2.3 From 3604611392c49da4cb0330fde7ec1c14bda32ce1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 27 Jun 2009 20:00:24 +0000 Subject: Translation of option values. part 1 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1828 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 245 ++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 245 insertions(+) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 0654f516..2bcc7305 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -77,6 +77,7 @@ type function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; + procedure TranslateOptionValues; procedure LoadInputDeviceCfg(IniFile: TMemIniFile); procedure SaveInputDeviceCfg(IniFile: TIniFile); procedure LoadThemes(IniFile: TCustomIniFile); @@ -252,6 +253,65 @@ const IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); +var + IDifficultyTranslated: array[0..2] of string = ('Easy', 'Medium', 'Hard'); + ITabsTranslated: array[0..1] of string = ('Off', 'On'); + + ISortingTranslated: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + + IDebugTranslated: array[0..1] of string = ('Off', 'On'); + + IFullScreenTranslated: array[0..1] of string = ('Off', 'On'); + IVisualizerTranslated: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + + IBackgroundMusicTranslated: array[0..1] of string = ('Off', 'On'); + ISingWindowTranslated: array[0..1] of string = ('Small', 'Big'); + + //SingBar Mod + IOscilloscopeTranslated: array[0..1] of string = ('Off', 'On'); + + ISpectrumTranslated: array[0..1] of string = ('Off', 'On'); + ISpectrographTranslated: array[0..1] of string = ('Off', 'On'); + IMovieSizeTranslated: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + + IClickAssistTranslated: array[0..1] of string = ('Off', 'On'); + IBeatClickTranslated: array[0..1] of string = ('Off', 'On'); + ISavePlaybackTranslated: array[0..1] of string = ('Off', 'On'); + + IVoicePassthroughTranslated: array[0..1] of string = ('Off', 'On'); + + //Song Preview + IPreviewVolumeTranslated: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + + IAudioOutputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + + IAudioInputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + + IPreviewFadingTranslated: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + + ILyricsFontTranslated: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffectTranslated: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); + ISolmizationTranslated: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); + INoteLinesTranslated: array[0..1] of string = ('Off', 'On'); + + IColorTranslated: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + + // Advanced + ILoadAnimationTranslated: array[0..1] of string = ('Off', 'On'); + IEffectSingTranslated: array[0..1] of string = ('Off', 'On'); + IScreenFadeTranslated: array[0..1] of string = ('Off', 'On'); + IAskbeforeDelTranslated: array[0..1] of string = ('Off', 'On'); + IOnSongClickTranslated: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); + ILineBonusTranslated: array[0..1] of string = ('Off', 'On'); + IPartyPopupTranslated: array[0..1] of string = ('Off', 'On'); + + IJoypadTranslated: array[0..1] of string = ('Off', 'On'); + IMouseTranslated: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor'); + + // Recording options + IChannelPlayerTranslated: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); + IMicBoostTranslated: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + implementation uses @@ -265,6 +325,188 @@ uses UCommandLine, UPath; +(** + * Translate and set the values of options, which need translation. + *) +procedure TIni.TranslateOptionValues; +begin + ULanguage.Language.ChangeLanguage(ILanguage[Language]); + + IDifficultyTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EASY'); + IDifficultyTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_MEDIUM'); + IDifficultyTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_HARD'); + + ITabsTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ITabsTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ISortingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EDITION'); + ISortingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GENRE'); + ISortingTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_LANGUAGE'); + ISortingTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_FOLDER'); + ISortingTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_TITLE'); + ISortingTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST'); + ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_TITLE2'); + ISortingTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2'); + + IDebugTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IDebugTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IFullScreenTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IFullScreenTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IVisualizerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IVisualizerTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_WHENNOVIDEO'); + IVisualizerTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IBackgroundMusicTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IBackgroundMusicTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ISingWindowTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SMALL'); + ISingWindowTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_BIG'); + + IOscilloscopeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IOscilloscopeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ISpectrumTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ISpectrumTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ISpectrographTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ISpectrographTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IMovieSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_HALF'); + IMovieSizeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID'); + IMovieSizeTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID_BG'); + + IClickAssistTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IClickAssistTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IBeatClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IBeatClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ISavePlaybackTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ISavePlaybackTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IVoicePassthroughTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IVoicePassthroughTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN'); + ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1'); + ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2'); + + ILyricsEffectTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SIMPLE'); + ILyricsEffectTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ZOOM'); + ILyricsEffectTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SLIDE'); + ILyricsEffectTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_BALL'); + ILyricsEffectTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_SHIFT'); + + ISolmizationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ISolmizationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_EURO'); + ISolmizationTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_JAPAN'); + ISolmizationTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_AMERICAN'); + + INoteLinesTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + INoteLinesTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IColorTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_BLUE'); + IColorTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GREEN'); + IColorTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_PINK'); + IColorTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_RED'); + IColorTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_VIOLET'); + IColorTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ORANGE'); + IColorTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_YELLOW'); + IColorTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_BROWN'); + IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BALCK'); + + // Advanced + ILoadAnimationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ILoadAnimationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IEffectSingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IEffectSingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IScreenFadeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IScreenFadeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IAskbeforeDelTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IAskbeforeDelTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IOnSongClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SING'); + IOnSongClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_SELECT_PLAYERS'); + IOnSongClickTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OPEN_MENU'); + + ILineBonusTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ILineBonusTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IPartyPopupTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IPartyPopupTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IJoypadTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IJoypadTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IMouseTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IMouseTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_HARDWARE_CURSOR'); + IMouseTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SOFTWARE_CURSOR'); + + IAudioOutputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO'); + IAudioOutputBufferSizeTranslated[1] := '256'; + IAudioOutputBufferSizeTranslated[2] := '512'; + IAudioOutputBufferSizeTranslated[3] := '1024'; + IAudioOutputBufferSizeTranslated[4] := '2048'; + IAudioOutputBufferSizeTranslated[5] := '4096'; + IAudioOutputBufferSizeTranslated[6] := '8192'; + IAudioOutputBufferSizeTranslated[7] := '16384'; + IAudioOutputBufferSizeTranslated[8] := '32768'; + IAudioOutputBufferSizeTranslated[9] := '65536'; + + + IAudioInputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO'); + IAudioInputBufferSizeTranslated[1] := '256'; + IAudioInputBufferSizeTranslated[2] := '512'; + IAudioInputBufferSizeTranslated[3] := '1024'; + IAudioInputBufferSizeTranslated[4] := '2048'; + IAudioInputBufferSizeTranslated[5] := '4096'; + IAudioInputBufferSizeTranslated[6] := '8192'; + IAudioInputBufferSizeTranslated[7] := '16384'; + IAudioInputBufferSizeTranslated[8] := '32768'; + IAudioInputBufferSizeTranslated[9] := '65536'; + + //Song Preview + IPreviewVolumeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IPreviewVolumeTranslated[1] := '10%'; + IPreviewVolumeTranslated[2] := '20%'; + IPreviewVolumeTranslated[3] := '30%'; + IPreviewVolumeTranslated[4] := '40%'; + IPreviewVolumeTranslated[5] := '50%'; + IPreviewVolumeTranslated[6] := '60%'; + IPreviewVolumeTranslated[7] := '70%'; + IPreviewVolumeTranslated[8] := '80%'; + IPreviewVolumeTranslated[9] := '90%'; + IPreviewVolumeTranslated[10] := '100%'; + + + IPreviewFadingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IPreviewFadingTranslated[1] := '1 ' + ULanguage.Language.Translate('OPTION_VALUE_SEC'); + IPreviewFadingTranslated[2] := '2 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); + IPreviewFadingTranslated[3] := '3 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); + IPreviewFadingTranslated[4] := '4 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); + IPreviewFadingTranslated[5] := '5 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); + + // Recording options + IChannelPlayerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IChannelPlayerTranslated[1] := '1'; + IChannelPlayerTranslated[2] := '2'; + IChannelPlayerTranslated[3] := '3'; + IChannelPlayerTranslated[4] := '4'; + IChannelPlayerTranslated[5] := '5'; + IChannelPlayerTranslated[6] := '6'; + + IMicBoostTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IMicBoostTranslated[1] := '+6dB'; + IMicBoostTranslated[2] := '+12dB'; + IMicBoostTranslated[3] := '+18dB'; + +end; + (** * Returns the filename without its fileextension *) @@ -589,6 +831,7 @@ begin end; // reverse order + Log.LogStatus( 'Log size of resolution: ' + IntToStr(Length(IResolution)), 'Video'); for I := 0 to (Length(IResolution) div 2) - 1 do begin swap(IResolution[I], IResolution[High(IResolution)-I]); @@ -775,6 +1018,8 @@ begin LoadPaths(IniFile); + TranslateOptionValues; + IniFile.Free; end; -- cgit v1.2.3 From ecee22f9b86c52fabee852449e4071e1e03403d1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 28 Jun 2009 12:36:26 +0000 Subject: cosmetics. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1832 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/ULanguage.pas | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index 02cd7712..c2b44ffa 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -133,7 +133,8 @@ begin SetLength(List, 0); SetLength(ILanguage, 0); - if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin + if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then + begin repeat SetLength(List, Length(List)+1); SetLength(ILanguage, Length(ILanguage)+1); @@ -143,7 +144,7 @@ begin ILanguage[High(ILanguage)] := SR.Name; until FindNext(SR) <> 0; - SysUtils.FindClose(SR); + SysUtils.FindClose(SR); end; // if FindFirst end; -- cgit v1.2.3 From 208595ac674dfaeb586e07c8c11020298f5c6ddd Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 28 Jun 2009 12:41:20 +0000 Subject: Translation of the language settings. Part 1 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1834 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 49 +++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 43 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 2bcc7305..8cf01081 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -36,8 +36,8 @@ interface uses Classes, IniFiles, - ULog, - SysUtils; + SysUtils, + ULog; type // TInputDeviceConfig stores the configuration for an input device. @@ -254,6 +254,8 @@ const IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); var + ILanguageTranslated: array of string; + IDifficultyTranslated: array[0..2] of string = ('Easy', 'Medium', 'Hard'); ITabsTranslated: array[0..1] of string = ('Off', 'On'); @@ -316,22 +318,57 @@ implementation uses StrUtils, - UMain, SDL, + UCommandLine, ULanguage, UPlatform, - USkins, + UMain, + UPath, URecord, - UCommandLine, - UPath; + USkins; (** * Translate and set the values of options, which need translation. *) procedure TIni.TranslateOptionValues; +const + NumberOfLanguages = 14; +var + ErrorStringStart: string; begin ULanguage.Language.ChangeLanguage(ILanguage[Language]); + + ErrorStringStart := 'The number of language files (' + + IntToStr(Length(ILanguage)) + ') is '; + + if Length(ILanguage) > NumberOfLanguages then + begin + Log.LogError(ErrorStringStart + 'larger than expected (' + IntToStr(NumberOfLanguages) + ').', + 'Ini.TranslateOptionValues'); + Halt; + end; + if Length(ILanguage) < NumberOfLanguages then + Log.LogWarn(ErrorStringStart + 'smaller than expected (' + IntToStr(NumberOfLanguages) + ').', + 'Ini.TranslateOptionValues'); + + SetLength(ILanguageTranslated, NumberOfLanguages); + + ILanguageTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_CATALAN'); + ILanguageTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_CROATIAN'); + ILanguageTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_DUTCH'); + ILanguageTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_ENGLISH'); + ILanguageTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_EUSKARA'); + ILanguageTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_FINNISH'); + ILanguageTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_FRENCH'); + ILanguageTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_GERMAN'); + ILanguageTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_GREEK'); + ILanguageTranslated[9] := ULanguage.Language.Translate('OPTION_VALUE_ITALIAN'); + ILanguageTranslated[10] := ULanguage.Language.Translate('OPTION_VALUE_JAPANESE'); + ILanguageTranslated[11] := ULanguage.Language.Translate('OPTION_VALUE_PORTUGUESE'); + ILanguageTranslated[12] := ULanguage.Language.Translate('OPTION_VALUE_SPANISH'); + ILanguageTranslated[13] := ULanguage.Language.Translate('OPTION_VALUE_SWEDISH'); + IDifficultyTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EASY'); IDifficultyTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_MEDIUM'); IDifficultyTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_HARD'); -- cgit v1.2.3 From 757ad7e4f0668334e33df82e0bb3bad6a8933bff Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 29 Jun 2009 15:26:33 +0000 Subject: cosmetics git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1840 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 10 ---------- 1 file changed, 10 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index a7231cb3..c4871f18 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -535,16 +535,6 @@ begin begin CurCategory := CurSong.Edition; - // TODO: remove this block if it is not needed anymore - { - if CurSection = 'Singstar Part 2' then CoverName := 'Singstar'; - if CurSection = 'Singstar German' then CoverName := 'Singstar'; - if CurSection = 'Singstar Spanish' then CoverName := 'Singstar'; - if CurSection = 'Singstar Italian' then CoverName := 'Singstar'; - if CurSection = 'Singstar French' then CoverName := 'Singstar'; - if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s'; - } - // add Category Button AddCategoryButton(CurCategory); end -- cgit v1.2.3 From 38add90a8759e85d66f2dabecde2236b141d51d5 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 29 Jun 2009 22:05:47 +0000 Subject: resolve wrong colors with Delphi resulting from questionable use of longwords. Thanks to zup3rvock git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1842 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 60b0a3a2..f8fd8a05 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -885,7 +885,7 @@ begin end; *) -procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); +procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword); // First, the rgb colors are converted to hsv, second hue is replaced by // the NewColor, saturation and value remain unchanged, finally this @@ -904,8 +904,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); function ColorToHue(const Color: longword): longword; // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024 var - Red, Green, Blue: longword; - Min, Max, Delta: longword; + Red, Green, Blue: longint; + Min, Max, Delta: longint; Hue: double; begin // extract the colors @@ -933,6 +933,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal); // The division by Delta is done separately afterwards. // Necessary because Delphi did not do the type conversion from // longword to double as expected. + // After the change to longint, we may not need it, but left for now + // Something to check if (Max = Red ) then Hue := Green - Blue else if (Max = Green) then Hue := 2.0*Delta + Blue - Red else if (Max = Blue ) then Hue := 4.0*Delta + Red - Green; -- cgit v1.2.3 From b37c19762372b185724779a59769e0e08c8f9030 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 1 Jul 2009 19:40:46 +0000 Subject: Implement greyscales in ColorizeImage and some cosmetics. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1843 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UImage.pas | 88 ++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 64 insertions(+), 24 deletions(-) (limited to 'src/base') diff --git a/src/base/UImage.pas b/src/base/UImage.pas index f8fd8a05..6b0c509e 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -600,17 +600,17 @@ end; function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; var {$IFDEF Delphi} - Bitmap: TBitmap; + Bitmap: TBitmap; BitmapInfo: TBitmapInfo; - Jpeg: TJpegImage; - row: integer; + Jpeg: TJpegImage; + row: integer; {$ELSE} - cinfo: jpeg_compress_struct; - jerr : jpeg_error_mgr; - jpgFile: TFileStream; - rowPtr: array[0..0] of JSAMPROW; + cinfo: jpeg_compress_struct; + jerr : jpeg_error_mgr; + jpgFile: TFileStream; + rowPtr: array[0..0] of JSAMPROW; {$ENDIF} - converted: boolean; + converted: boolean; begin Result := false; @@ -794,17 +794,13 @@ end; function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean; begin - if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and - (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and - (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and - (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and - (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and - (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and - (fmt1^.Bshift = fmt2^.Bshift) - then - Result := true - else - Result := false; + Result := + (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and + (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and + (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and (fmt1^.Bloss = fmt2^.Bloss) and + (fmt1^.Rmask = fmt2^.Rmask) and (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and + (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and (fmt1^.Bshift = fmt2^.Bshift) + ; end; procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal); @@ -893,7 +889,7 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword); // For the conversion algorithms of colors from rgb to hsv space // and back simply check the wikipedia. // In order to speed up starting time of USDX the division of reals is - // replaced by division of longwords, shifted by 10 bits to keep + // replaced by division of longints, shifted by 10 bits to keep // digits. // The use of longwards leeds to some type size mismatch warnings @@ -942,6 +938,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword); if (Hue < 0.0) then Hue := Hue + 6.0; Result := trunc(Hue*1024); // '*1024' is shl 10 + // if NewColor = $000000 then + // Log.LogError ('Hue: ' + FloatToStr(Hue), 'ColorToHue'); end; end; @@ -954,6 +952,8 @@ var Min, Max, Delta: longword; HueInteger: longword; f, p, q, t: longword; + GreyReal: real; + Grey: byte; begin Pixel := ImgSurface^.Pixels; @@ -967,8 +967,48 @@ begin Log.LogError ('ColorizeImage: The pixel size should be 4, but it is ' + IntToStr(ImgSurface^.format.BytesPerPixel)); + // Check whether the new color is white, grey or black, + // because a greyscale must be created in a different + // way. + + Red := ((NewColor and $ff0000) shr 16); // R + Green := ((NewColor and $ff00) shr 8); // G + Blue := (NewColor and $ff) ; // B + + if (Red = Green) and (Green = Blue) then // greyscale image + begin + // According to these recommendations (ITU-R BT.709-5) + // the conversion parameters for rgb to greyscale are + // 0.299, 0.587, 0.114 + for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do + begin + PixelColors := PByteArray(Pixel); + {$IFDEF FPC_BIG_ENDIAN} + GreyReal := 0.299*PixelColors[3] + 0.587*PixelColors[2] + 0.114*PixelColors[1]; + // PixelColors[0] is alpha and remains untouched + {$ELSE} + GreyReal := 0.299*PixelColors[0] + 0.587*PixelColors[1] + 0.114*PixelColors[2]; + // PixelColors[3] is alpha and remains untouched + {$ENDIF} + Grey := round(GreyReal); + {$IFDEF FPC_BIG_ENDIAN} + PixelColors[3] := Grey; + PixelColors[2] := Grey; + PixelColors[1] := Grey; + // PixelColors[0] is alpha and remains untouched + {$ELSE} + PixelColors[0] := Grey; + PixelColors[1] := Grey; + PixelColors[2] := Grey; + // PixelColors[3] is alpha and remains untouched + {$ENDIF} + Inc(Pixel, ImgSurface^.format.BytesPerPixel); + end; + exit; // we are done with a greyscale image. + end; + Hue := ColorToHue(NewColor); // Hue is shl 10 - f := Hue and $3ff; // f is the dezimal part of hue + f := Hue and $3ff; // f is the dezimal part of hue HueInteger := Hue shr 10; for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do @@ -1038,9 +1078,9 @@ begin // shr 10 corrects that Sat and f are shl 10 // the resulting p, q and t are unshifted - p := (Max*(1024-Sat)) shr 10; - q := (Max*(1024-(Sat*f) shr 10)) shr 10; - t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10; + p := (Max * (1024 - Sat )) shr 10; + q := (Max * (1024 - (Sat * f ) shr 10)) shr 10; + t := (Max * (1024 - (Sat * (1024 - f)) shr 10)) shr 10; // The above 3 lines give type size mismatch warning, but all variables are longword and the ranges should be ok. -- cgit v1.2.3 From 2a4ac753add63ad2dedba6aa7c58c6afaa13f502 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 1 Jul 2009 21:49:20 +0000 Subject: typo correction: BALCK -> BLACK; thanks to zup3rvock git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1844 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 8cf01081..fb200f3c 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -452,7 +452,7 @@ begin IColorTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ORANGE'); IColorTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_YELLOW'); IColorTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_BROWN'); - IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BALCK'); + IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BLACK'); // Advanced ILoadAnimationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); -- cgit v1.2.3 From 92336ab5d99d185d9316330d39a3bb8f881eb9f3 Mon Sep 17 00:00:00 2001 From: b_krueger Date: Sat, 18 Jul 2009 10:52:29 +0000 Subject: - Commented delay of error.log in mainloop (error-log is no longer generated without any error) - If an old 1.01 Ultrastar.db exists, it will no longer deleted on startup, it will be converted into the new 1.1 schema --> added new column in us_songs: rating. This will allow to rate songs in upcoming versions git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1847 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 50 +++++++++++++++++++++++++++++--------------------- src/base/UMain.pas | 4 ++-- 2 files changed, 31 insertions(+), 23 deletions(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index 0f9d88a7..6691e475 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -131,6 +131,7 @@ const procedure TDataBaseSystem.Init(const Filename: string); var Version: integer; + finalizeConvertion : boolean; begin if Assigned(ScoreDB) then Exit; @@ -143,24 +144,30 @@ begin ScoreDB := TSQLiteDatabase.Create(Filename); fFilename := Filename; - // Close and delete outdated file Version := GetVersion(); - if ((Version <> 0) and (Version <> cDBVersion)) then + + if not ScoreDB.TableExists(cUS_Statistics_Info) then begin - Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init'); - // Close and delete outdated file - ScoreDB.Free; - if (not DeleteFile(Filename)) then - raise Exception.Create('Could not delete ' + Filename); - // Reopen - ScoreDB := TSQLiteDatabase.Create(Filename); + Log.LogInfo('Outdated song-database file found', 'TDataBaseSystem.Init'); Version := 0; - end; - + //following just works with convertion of usdx1.01 to usdx1.1! + //Rename old Tables - to be able to insert new table-structures + ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;'); + ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;'); + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + + '[ResetTime] INTEGER' + + ');'); + // insert creation timestamp + ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + + '([ResetTime]) VALUES(%d);', + [DateTimeToUnix(Now())])); + finalizeConvertion := true; //means: convertion has to be done! + end else finalizeConvertion := false; + // Set version number after creation if (Version = 0) then SetVersion(cDBVersion); - // SQLite does not handle VARCHAR(n) or INT(n) as expected. // Texts do not have a restricted length, no matter which type is used, @@ -181,20 +188,21 @@ begin '[ID] INTEGER PRIMARY KEY, ' + '[Artist] TEXT NOT NULL, ' + '[Title] TEXT NOT NULL, ' + - '[TimesPlayed] INTEGER NOT NULL' + + '[TimesPlayed] INTEGER NOT NULL, ' + + '[Rating] INTEGER NULL' + ');'); - if not ScoreDB.TableExists(cUS_Statistics_Info) then + if finalizeConvertion then begin - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + - '[ResetTime] INTEGER' + - ');'); - // insert creation timestamp - ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + - '([ResetTime]) VALUES(%d);', - [DateTimeToUnix(Now())])); + //insert old values in new db-schemes (/tables) + ScoreDB.ExecSQL('INSERT INTO '+cUS_Scores+' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); + ScoreDB.ExecSQL('INSERT INTO '+cUS_Songs+' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); + //now drop old tables + ScoreDB.ExecSQL('DROP TABLE us_scores_101;'); + ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); end; + except on E: Exception do begin diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 275510fc..187318a6 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -359,11 +359,11 @@ begin CountMidTime; Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); - Log.LogError ('MainLoop', 'Delay: ' + intToStr(Delay)); + //Log.LogError ('MainLoop', 'Delay: ' + intToStr(Delay)); if Delay >= 1 then SDL_Delay(Delay); // dynamic, maximum is 100 fps - Log.LogError ('MainLoop', 'Delay: ok ' + intToStr(Delay)); + //Log.LogError ('MainLoop', 'Delay: ok ' + intToStr(Delay)); CountSkipTime; -- cgit v1.2.3 From b7603dfa151bbc40c5d3b8be4725daafd75a3efd Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 18 Jul 2009 11:21:12 +0000 Subject: cosmetics. no code change. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1848 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 65 +++++++++++++++++++++++++------------------------- 1 file changed, 33 insertions(+), 32 deletions(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index 6691e475..ae9f2532 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -34,10 +34,10 @@ interface {$I switches.inc} uses - USongs, - USong, Classes, - SQLiteTable3; + SQLiteTable3, + USong, + USongs; //-------------------- //DataBaseSystem - Class including all DB Methods @@ -59,8 +59,8 @@ type TStatResultBestScores = class(TStatResult) public Singer: WideString; - Score: Word; - Difficulty: Byte; + Score: word; + Difficulty: byte; SongArtist: WideString; SongTitle: WideString; end; @@ -68,27 +68,27 @@ type TStatResultBestSingers = class(TStatResult) public Player: WideString; - AverageScore: Word; + AverageScore: word; end; TStatResultMostSungSong = class(TStatResult) public Artist: WideString; Title: WideString; - TimesSung: Word; + TimesSung: word; end; TStatResultMostPopBand = class(TStatResult) public ArtistName: WideString; - TimesSungTot: Word; + TimesSungTot: word; end; TDataBaseSystem = class private - ScoreDB: TSQLiteDatabase; - fFilename: string; + ScoreDB: TSQLiteDatabase; + fFilename: string; function GetVersion(): integer; procedure SetVersion(Version: integer); @@ -102,9 +102,9 @@ type procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); procedure WriteScore(Song: TSong); - function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; + function GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList; procedure FreeStats(StatList: TList); - function GetTotalEntrys(Typ: TStatType): Cardinal; + function GetTotalEntrys(Typ: TStatType): cardinal; function GetStatReset: TDateTime; end; @@ -114,24 +114,24 @@ var implementation uses - ULog, DateUtils, StrUtils, - SysUtils; + SysUtils, + ULog; const cDBVersion = 01; // 0.1 cUS_Scores = 'us_scores'; cUS_Songs = 'us_songs'; - cUS_Statistics_Info = 'us_statistics_info'; + cUS_Statistics_Info = 'us_statistics_info'; (** * Opens Database and Create Tables if not Exist *) procedure TDataBaseSystem.Init(const Filename: string); var - Version: integer; - finalizeConvertion : boolean; + Version: integer; + finalizeConvertion: boolean; begin if Assigned(ScoreDB) then Exit; @@ -146,6 +146,7 @@ begin Version := GetVersion(); + finalizeConvertion := false; if not ScoreDB.TableExists(cUS_Statistics_Info) then begin Log.LogInfo('Outdated song-database file found', 'TDataBaseSystem.Init'); @@ -156,14 +157,14 @@ begin ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;'); ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + - '[ResetTime] INTEGER' + + '[ResetTime] INTEGER' + ');'); // insert creation timestamp ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + - '([ResetTime]) VALUES(%d);', - [DateTimeToUnix(Now())])); + '([ResetTime]) VALUES(%d);', + [DateTimeToUnix(Now())])); finalizeConvertion := true; //means: convertion has to be done! - end else finalizeConvertion := false; + end; // Set version number after creation if (Version = 0) then @@ -228,8 +229,8 @@ end; *) procedure TDataBaseSystem.ReadScore(Song: TSong); var - TableData: TSQLiteUniTable; - Difficulty: Integer; + TableData: TSQLiteUniTable; + Difficulty: integer; begin if not Assigned(ScoreDB) then Exit; @@ -287,7 +288,7 @@ end; *) procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); var - ID: Integer; + ID: integer; TableData: TSQLiteTable; begin if not Assigned(ScoreDB) then @@ -384,11 +385,11 @@ end; * entries. * Free the result-list with FreeStats() after usage to avoid memory leaks. *) -function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList; +function TDataBaseSystem.GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList; var - Query: String; + Query: string; TableData: TSQLiteUniTable; - Stat: TStatResult; + Stat: TStatResult; begin Result := nil; @@ -492,21 +493,21 @@ end; procedure TDataBaseSystem.FreeStats(StatList: TList); var - I: integer; + Index: integer; begin if (StatList = nil) then Exit; - for I := 0 to StatList.Count-1 do - TStatResult(StatList[I]).Free; + for Index := 0 to StatList.Count-1 do + TStatResult(StatList[Index]).Free; StatList.Free; end; (** * Gets total number of entrys for a stats query *) -function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal; +function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): cardinal; var - Query: String; + Query: string; begin Result := 0; -- cgit v1.2.3 From 1ce18fc38205cc21752579b3cb5dd4c083730ba2 Mon Sep 17 00:00:00 2001 From: b_krueger Date: Sat, 18 Jul 2009 13:36:34 +0000 Subject: some modifications on the DataBaseLoading - now ALL databases in table "us_songs" gets the column "Rating" - nicer Structure and some useful comments -> should work now with all DB-loading-combinations! git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1851 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 37 ++++++++++++++++++++++++++++--------- 1 file changed, 28 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index ae9f2532..227db653 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -119,6 +119,11 @@ uses SysUtils, ULog; +{ + cDBVersion - history + 0 = USDX 1.01 or no Database + 01 = USDX 1.1 +} const cDBVersion = 01; // 0.1 cUS_Scores = 'us_scores'; @@ -146,16 +151,11 @@ begin Version := GetVersion(); - finalizeConvertion := false; + //Adds Table cUS_Statistics_Info + //Happens from Convertion 1.01 -> 1.1 if not ScoreDB.TableExists(cUS_Statistics_Info) then begin - Log.LogInfo('Outdated song-database file found', 'TDataBaseSystem.Init'); - Version := 0; - //following just works with convertion of usdx1.01 to usdx1.1! - //Rename old Tables - to be able to insert new table-structures - ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;'); - ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;'); - + Log.LogInfo('Outdated song-database file found - Missing Table"'+cUS_Statistics_Info+'"', 'TDataBaseSystem.Init'); ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + '[ResetTime] INTEGER' + ');'); @@ -163,6 +163,16 @@ begin ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + '([ResetTime]) VALUES(%d);', [DateTimeToUnix(Now())])); + end; + + //Converts data of 1.01 -> 1.1 + //Part #1 - prearrangement + finalizeConvertion := false; + if (Version = 0) AND ScoreDB.TableExists('US_Scores') then + begin + //Rename old Tables - to be able to insert new table-structures + ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;'); + ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;'); finalizeConvertion := true; //means: convertion has to be done! end; @@ -177,7 +187,6 @@ begin // types are used (especially FieldAsInteger). Also take care to write the // types in upper-case letters although SQLite does not care about this - // SQLiteTable3 is very sensitive in this regard. - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' + '[SongID] INTEGER NOT NULL, ' + '[Difficulty] INTEGER NOT NULL, ' + @@ -193,8 +202,11 @@ begin '[Rating] INTEGER NULL' + ');'); + //Converts data of 1.01 -> 1.1 + //Part #2 - accomplishment if finalizeConvertion then begin + Log.LogInfo('Outdated song-database file found - Began Converting from V1.01 to V1.1', 'TDataBaseSystem.Init'); //insert old values in new db-schemes (/tables) ScoreDB.ExecSQL('INSERT INTO '+cUS_Scores+' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); ScoreDB.ExecSQL('INSERT INTO '+cUS_Songs+' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); @@ -203,6 +215,13 @@ begin ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); end; + //Adds Column Rating to cUS_Songs + //Just for the users of Nightly-Builds and all Developers! + if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then + begin + Log.LogInfo('Outdated song-database file found - Adding Column Rating to "'+cUS_Songs+'"', 'TDataBaseSystem.Init'); + ScoreDB.ExecSQL('ALTER TABLE '+cUS_Songs+' ADD COLUMN Rating INTEGER NULL'); + end; except on E: Exception do -- cgit v1.2.3 From 384aa7c5adbaec638277e9caf0840dad77540b58 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 19 Jul 2009 17:06:29 +0000 Subject: Do not use range overflow for CurRound. Could probably be done nicer. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1853 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index e29b977c..615418f1 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -254,8 +254,13 @@ var begin if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then begin - //Increase Current Round - Inc(CurRound); + // Increase Current Round but not beyond its limit + // CurRound is set to 255 to begin with! + // Ugly solution if you ask me. + if CurRound < high(CurRound) then + Inc(CurRound) + else + CurRound := 0; Rounds[CurRound].Winner := 255; DllMan.LoadPlugin(Rounds[CurRound].Plugin); -- cgit v1.2.3 From c2139f0a4ab0e86f9632881f4954b7e3b41e10d5 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 26 Jul 2009 13:08:47 +0000 Subject: Language option fix: - Never assume an order of the files returned by FindFirst/Next(). This will not work on linux as the order is random. - That is also the reason why the default theme on linux is random (usdx uses the first theme returned by FindFirst(). This is not fixed yet. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1923 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 44 +++++++++++--------------------------------- src/base/ULanguage.pas | 34 +++++++++++++++++----------------- src/base/UMain.pas | 6 ------ 3 files changed, 28 insertions(+), 56 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index fb200f3c..f92ea7c3 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -331,43 +331,22 @@ uses * Translate and set the values of options, which need translation. *) procedure TIni.TranslateOptionValues; -const - NumberOfLanguages = 14; var - ErrorStringStart: string; + I: integer; begin - ULanguage.Language.ChangeLanguage(ILanguage[Language]); - - ErrorStringStart := 'The number of language files (' - + IntToStr(Length(ILanguage)) + ') is '; + // Load Languagefile + if (Params.Language <> -1) then + ULanguage.Language.ChangeLanguage(ILanguage[Params.Language]) + else + ULanguage.Language.ChangeLanguage(ILanguage[Ini.Language]); - if Length(ILanguage) > NumberOfLanguages then + SetLength(ILanguageTranslated, Length(ILanguage)); + for I := 0 to High(ILanguage) do begin - Log.LogError(ErrorStringStart + 'larger than expected (' + IntToStr(NumberOfLanguages) + ').', - 'Ini.TranslateOptionValues'); - Halt; + ILanguageTranslated[I] := ULanguage.Language.Translate( + 'OPTION_VALUE_' + UpperCase(ILanguage[I]) + ); end; - - if Length(ILanguage) < NumberOfLanguages then - Log.LogWarn(ErrorStringStart + 'smaller than expected (' + IntToStr(NumberOfLanguages) + ').', - 'Ini.TranslateOptionValues'); - - SetLength(ILanguageTranslated, NumberOfLanguages); - - ILanguageTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_CATALAN'); - ILanguageTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_CROATIAN'); - ILanguageTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_DUTCH'); - ILanguageTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_ENGLISH'); - ILanguageTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_EUSKARA'); - ILanguageTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_FINNISH'); - ILanguageTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_FRENCH'); - ILanguageTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_GERMAN'); - ILanguageTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_GREEK'); - ILanguageTranslated[9] := ULanguage.Language.Translate('OPTION_VALUE_ITALIAN'); - ILanguageTranslated[10] := ULanguage.Language.Translate('OPTION_VALUE_JAPANESE'); - ILanguageTranslated[11] := ULanguage.Language.Translate('OPTION_VALUE_PORTUGUESE'); - ILanguageTranslated[12] := ULanguage.Language.Translate('OPTION_VALUE_SPANISH'); - ILanguageTranslated[13] := ULanguage.Language.Translate('OPTION_VALUE_SWEDISH'); IDifficultyTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EASY'); IDifficultyTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_MEDIUM'); @@ -941,7 +920,6 @@ begin // Language Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); - //Language.ChangeLanguage(ILanguage[Language]); // Tabs Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0])); diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index c2b44ffa..80926774 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -46,9 +46,9 @@ type TLanguage = class public - Entry: array of TLanguageEntry; //Entrys of Chosen Language - SEntry: array of TLanguageEntry; //Entrys of Standard Language - CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version + Entry: array of TLanguageEntry; //Entrys of Chosen Language + EntryDefault: array of TLanguageEntry; //Entrys of Standard Language + EntryConst: array of TLanguageEntry; //Constant Entrys e.g. Version Implode_Glue1, Implode_Glue2: String; public List: array of TLanguageList; @@ -107,9 +107,9 @@ begin begin ChangeLanguage('English'); - SetLength(SEntry, Length(Entry)); + SetLength(EntryDefault, Length(Entry)); for J := low(Entry) to high(Entry) do - SEntry[J] := Entry[J]; + EntryDefault[J] := Entry[J]; SetLength(Entry, 0); @@ -189,10 +189,10 @@ begin Text := Uppercase(Result); //Const Mod - for E := 0 to high(CEntry) do - if Text = CEntry[E].ID then + for E := 0 to high(EntryConst) do + if Text = EntryConst[E].ID then begin - Result := CEntry[E].Text; + Result := EntryConst[E].Text; exit; end; //Const Mod End @@ -206,10 +206,10 @@ begin //Standard Language (If a Language File is Incomplete) //Then use Standard Language - for E := low(SEntry) to high(SEntry) do - if Text = SEntry[E].ID then + for E := low(EntryDefault) to high(EntryDefault) do + if Text = EntryDefault[E].ID then begin - Result := SEntry[E].Text; + Result := EntryDefault[E].Text; Break; end; //Standard Language END @@ -220,9 +220,9 @@ end; //---------- procedure TLanguage.AddConst (ID, Text: String); begin - SetLength (CEntry, Length(CEntry) + 1); - CEntry[high(CEntry)].ID := ID; - CEntry[high(CEntry)].Text := Text; + SetLength (EntryConst, Length(EntryConst) + 1); + EntryConst[high(EntryConst)].ID := ID; + EntryConst[high(EntryConst)].Text := Text; end; //---------- @@ -232,11 +232,11 @@ procedure TLanguage.ChangeConst(ID, Text: String); var I: Integer; begin - for I := 0 to high(CEntry) do + for I := 0 to high(EntryConst) do begin - if CEntry[I].ID = ID then + if EntryConst[I].ID = ID then begin - CEntry[I].Text := Text; + EntryConst[I].Text := Text; Break; end; end; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 187318a6..33eca888 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -174,12 +174,6 @@ begin Log.LogStatus('Write Ini', 'Initialization'); Ini.Save; - // Load Languagefile - if (Params.Language <> -1) then - Language.ChangeLanguage(ILanguage[Params.Language]) - else - Language.ChangeLanguage(ILanguage[Ini.Language]); - Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Ini', 1); -- cgit v1.2.3 From 55c03e4fc90bd365c26d3d59b1a6ac72a5658246 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 26 Jul 2009 14:08:59 +0000 Subject: GPL header fixed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1929 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UBeatTimer.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas index a47a06f9..2983fdee 100644 --- a/src/base/UBeatTimer.pas +++ b/src/base/UBeatTimer.pas @@ -1,4 +1,4 @@ - {* UltraStar Deluxe - Karaoke Game +{* UltraStar Deluxe - Karaoke Game * * UltraStar Deluxe is the legal property of its developers, whose names * are too numerous to list here. Please refer to the COPYRIGHT -- cgit v1.2.3 From a77cf53f7f71a525a33c7617d74d57b4fd84e357 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 16 Aug 2009 13:17:01 +0000 Subject: some changes to prevent integer size conversions attempt to fix weird score bugs git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1932 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 14 ++++++++------ 1 file changed, 8 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 89896d2d..ed99e2c5 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -117,9 +117,9 @@ type TScorePopUp = record Player: byte; // index of the popups player TimeStamp: cardinal; // timestamp of popups spawn - Rating: byte; // 0 to 8, type of rating (cool, bad, etc.) - ScoreGiven: word; // score that has already been given to the player - ScoreDiff: word; // difference between cur score at spawn and old score + Rating: integer; // 0 to 8, type of rating (cool, bad, etc.) + ScoreGiven: integer; // score that has already been given to the player + ScoreDiff: integer; // difference between cur score at spawn and old score Next: PScorePopUp; // next item in list end; aScorePopUp = array of TScorePopUp; @@ -202,7 +202,7 @@ type procedure Init; // spawns a new line bonus popup for the player - procedure SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word); + procedure SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer); // removes all popups from mem procedure KillAllPopUps; @@ -402,7 +402,7 @@ end; {** * spawns a new line bonus popup for the player *} -procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word); +procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer); var Cur: PScorePopUp; begin @@ -414,10 +414,12 @@ begin Cur.Player := PlayerIndex; Cur.TimeStamp := SDL_GetTicks; - // limit rating value to 8 + // limit rating value to 0..8 // a higher value would cause a crash when selecting the bg texture if (Rating > 8) then Cur.Rating := 8 + else if (Rating < 0) then + Cur.Rating := 0 else Cur.Rating := Rating; -- cgit v1.2.3 From ad35c4c93cb2c937201f3b4e3dc15463cf9c6bba Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 7 Nov 2009 21:29:27 +0000 Subject: add some colors for tests git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1937 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 26 ++++++++++++++++++++++++-- 1 file changed, 24 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 818e49aa..a2456a13 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -306,7 +306,7 @@ begin Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); 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 !? @@ -314,7 +314,29 @@ begin begin LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - + + { some colors for tests + Col := $10000 * Round(0.02*255) + $100 * Round(0.6 *255) + Round(0.8 *255); //blue + Col := $10000 * Round(0.8 *255) ; //red + Col := $100 * Round(0.85*255) ; //green + Col := $10000 * 255 + $100 * Round(0.52*255) ; //orange + Col := $10000 * 255 + $100 * 255 ; //yellow + Col := $10000 * Round(0.82*255) + 255 ; //purple + Col := $10000 * Round(0.22*255) + $100 * Round(0.39*255) + Round(0.64*255); //dark blue + Col := $10000 * Round(0 *255) + $100 * Round(0 *255) + Round(0 *255); //black + Col := $10000 * Round(1.0 *255) + $100 * Round(0.43*255) + Round(0.70*255); //pink + Col := 0; //black + Col := $FFFFFF; //white + Col := $FF0000; //red + Col := $00FF00; //green + Col := $002200; //light green + Col := $002222; //light greenblue + Col := $222200; //light yellow + Col := $340000; //red + Col := $FF6EB4; //pink + Col := $333333; //grey + } + Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col); Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col); Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col); -- cgit v1.2.3 From 917901e8e33438c425aef50a0a7417f32d77b760 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 9 Nov 2009 00:27:55 +0000 Subject: merged unicode branch (r1931) into trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1939 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 323 +++------- src/base/TextGLFreetype.pas | 222 ------- src/base/UBeatTimer.pas | 338 +++++----- src/base/UCatCovers.pas | 116 ++-- src/base/UCommandLine.pas | 25 +- src/base/UCommon.pas | 321 +++------ src/base/UConfig.pas | 8 +- src/base/UCovers.pas | 56 +- src/base/UDLLManager.pas | 59 +- src/base/UDataBase.pas | 163 ++--- src/base/UEditorLyrics.pas | 4 +- src/base/UFiles.pas | 202 +++--- src/base/UFilesystem.pas | 692 ++++++++++++++++++++ src/base/UFont.pas | 440 +++++++------ src/base/UGraphic.pas | 34 +- src/base/UImage.pas | 112 ++-- src/base/UIni.pas | 279 ++++---- src/base/ULanguage.pas | 203 +++--- src/base/ULog.pas | 44 +- src/base/ULyrics.pas | 4 +- src/base/UMain.pas | 32 +- src/base/UMusic.pas | 63 +- src/base/UNote.pas | 8 +- src/base/UParty.pas | 6 +- src/base/UPath.pas | 1427 ++++++++++++++++++++++++++++++++++++++--- src/base/UPathUtils.pas | 196 ++++++ src/base/UPlatform.pas | 95 +-- src/base/UPlatformLinux.pas | 102 +-- src/base/UPlatformMacOSX.pas | 194 ++---- src/base/UPlatformWindows.pas | 159 +---- src/base/UPlaylist.pas | 258 ++++---- src/base/USkins.pas | 77 +-- src/base/USong.pas | 1050 +++++++++++++++++------------- src/base/USongs.pas | 419 ++++++------ src/base/UTextEncoding.pas | 270 +++++--- src/base/UTexture.pas | 47 +- src/base/UThemes.pas | 67 +- src/base/UUnicodeUtils.pas | 670 +++++++++++++++++++ src/base/UXMLSong.pas | 97 +-- 39 files changed, 5649 insertions(+), 3233 deletions(-) delete mode 100644 src/base/TextGLFreetype.pas create mode 100644 src/base/UFilesystem.pas create mode 100644 src/base/UPathUtils.pas create mode 100644 src/base/UUnicodeUtils.pas (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index c8de4e28..7fe98d29 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -33,170 +33,101 @@ interface {$I switches.inc} -// as long as the transition to freetype is not finished -// use the old implementation -{$IFDEF UseFreetype} - {$INCLUDE TextGLFreetype.pas} -{$ELSE} uses gl, + glext, SDL, + Classes, UTexture, + UFont, + UPath, ULog; +type + PGLFont = ^TGLFont; + TGLFont = record + Font: TScalableFont; + X, Y, Z: real; + end; + +var + Fonts: array of TGLFont; + ActFont: integer; + procedure BuildFont; // build our bitmap font procedure KillFont; // delete the font -function glTextWidth(const text: string): real; // returns text width -procedure glPrint(const text: string); // custom GL "Print" routine +function glTextWidth(const text: UTF8String): real; // returns text width +procedure glPrint(const text: UTF8String); // custom GL "Print" routine procedure ResetFont(); // reset font settings of active font procedure SetFontPos(X, Y: real); // sets X and Y procedure SetFontZ(Z: real); // sets Z procedure SetFontSize(Size: real); procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) -procedure SetFontAspectW(Aspect: real); procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection -//function NextPowerOfTwo(Value: integer): integer; -// Checks if the ttf exists, if yes then a SDL_ttf is returned -//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font; -// Does the renderstuff, color is in $ffeecc style -//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface; - -type - TTextGL = record - X: real; - Y: real; - Z: real; - Text: string; - Size: real; - ColR: real; - ColG: real; - ColB: real; - end; - - PFont = ^TFont; - TFont = record - Tex: TTexture; - Width: array[0..255] of byte; - AspectW: real; - Centered: boolean; - Outline: real; - Italic: boolean; - Reflection: boolean; - ReflectionSpacing: real; - end; - - -var - Fonts: array of TFont; - ActFont: integer; - - implementation uses - Classes, + UTextEncoding, SysUtils, IniFiles, UCommon, - UGraphic, UMain, - UPath; - -var - // Colours for the reflection - TempColor: array[0..3] of GLfloat; + UPathUtils; -{** - * Load font info. - * FontFile is the name of the image (.png) not the data (.dat) file - *} -procedure LoadFontInfo(FontID: integer; const FontFile: string); +function FindFontFile(FontIni: TCustomIniFile; Font: string): IPath; var - Stream: TFileStream; - DatFile: string; + Filename: IPath; begin - DatFile := ChangeFileExt(FontFile, '.dat'); - FillChar(Fonts[FontID].Width[0], Length(Fonts[FontID].Width), 0); - - Stream := nil; - try - Stream := TFileStream.Create(DatFile, fmOpenRead); - Stream.Read(Fonts[FontID].Width, 256); - except - Log.LogError('Error while reading font['+ inttostr(FontID) +']', 'LoadFontInfo'); - end; - Stream.Free; + Filename := Path(FontIni.ReadString(Font, 'File', '')); + Result := FontPath.Append(Filename); + // if path does not exist, try as an absolute path + if (not Result.IsFile) then + Result := Filename; end; -// Builds bitmap fonts procedure BuildFont; var - Count: integer; FontIni: TMemIniFile; - FontFile: string; // filename of the image (with .png/... ending) + FontFile: IPath; begin ActFont := 0; SetLength(Fonts, 4); - FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); - - // Normal - - FontFile := FontPath + FontIni.ReadString('Normal', 'File', ''); - - Fonts[0].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[0].Tex.H := 30; - Fonts[0].AspectW := 0.9; - Fonts[0].Outline := 0; - - LoadFontInfo(0, FontFile); - - // Bold - - FontFile := FontPath + FontIni.ReadString('Bold', 'File', ''); - - Fonts[1].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[1].Tex.H := 30; - Fonts[1].AspectW := 1; - Fonts[1].Outline := 0; + FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative); - LoadFontInfo(1, FontFile); - for Count := 0 to 255 do - Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2; - - // Outline1 - - FontFile := FontPath + FontIni.ReadString('Outline1', 'File', ''); - - Fonts[2].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[2].Tex.H := 30; - Fonts[2].AspectW := 0.95; - Fonts[2].Outline := 5; - - LoadFontInfo(2, FontFile); - for Count := 0 to 255 do - Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2; + try - // Outline2 + // Normal + FontFile := FindFontFile(FontIni, 'Normal'); + Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); + //Fonts[0].Font.GlyphSpacing := 1.4; + //Fonts[0].Font.Aspect := 1.2; - FontFile := FontPath + FontIni.ReadString('Outline2', 'File', ''); + // Bold + FontFile := FindFontFile(FontIni, 'Bold'); + Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); - Fonts[3].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0); - Fonts[3].Tex.H := 30; - Fonts[3].AspectW := 0.95; - Fonts[3].Outline := 4; + // Outline1 + FontFile := FindFontFile(FontIni, 'Outline1'); + Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); + //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); - LoadFontInfo(3, FontFile); - for Count := 0 to 255 do - Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1; + // Outline2 + FontFile := FindFontFile(FontIni, 'Outline2'); + Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); + except + on E: Exception do + Log.LogCritical(E.Message, 'BuildFont'); + end; // close ini-file FontIni.Free; end; + // Deletes the font procedure KillFont; begin @@ -204,133 +135,31 @@ begin //glDeleteLists(..., 256); end; -function glTextWidth(const text: string): real; +function glTextWidth(const text: UTF8String): real; var - Letter: char; - i: integer; - Font: PFont; + Bounds: TBoundsDbl; begin - Result := 0; - Font := @Fonts[ActFont]; - - for i := 1 to Length(text) do - begin - Letter := Text[i]; - Result := Result + Font.Width[Ord(Letter)] * Font.Tex.H / 30 * Font.AspectW; - end; - - if ((Result > 0) and Font.Italic) then - Result := Result + 12 * Font.Tex.H / 60 * Font.AspectW; -end; - -procedure glPrintLetter(Letter: char); -var - TexX, TexY: real; - TexR, TexB: real; - TexHeight: real; - FWidth: real; - PL, PT: real; - PR, PB: real; - XItal: real; // X shift for italic type letter - ReflectionSpacing: real; // Distance of the reflection - Font: PFont; - Tex: PTexture; -begin - Font := @Fonts[ActFont]; - Tex := @Font.Tex; - - FWidth := Font.Width[Ord(Letter)]; - - Tex.W := FWidth * (Tex.H/30) * Font.AspectW; - - // set texture positions - TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024; - TexY := (ord(Letter) div 16) * 1/16 + 2/1024; - TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024; - TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024; - - TexHeight := TexB - TexY; - - // set vector positions - PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2; - PT := Tex.Y; - PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW; - PB := PT + Tex.H; - - if (not Font.Italic) then - XItal := 0 - else - XItal := 12; - - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, Tex.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT); - glEnd; - - // Reflection - // Yes it would make sense to put this in an extra procedure, - // but this works, doesn't take much lines, and is almost lightweight - if Font.Reflection then - begin - ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2; - - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexX, TexY + TexHeight/2); - glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3); - glTexCoord2f(TexX, TexB ); - glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z); - - glTexCoord2f(TexR, TexB ); - glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z); - - glColor4f(TempColor[0], TempColor[1], TempColor[2], 0); - glTexCoord2f(TexR, TexY + TexHeight/2); - glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z); - glEnd; - - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - Tex.X := Tex.X + Tex.W; - - //write the colour back - glColor4fv(@TempColor); + Bounds := Fonts[ActFont].Font.BBox(Text, true); + Result := Bounds.Right - Bounds.Left; end; // Custom GL "Print" Routine -procedure glPrint(const Text: string); +procedure glPrint(const Text: UTF8String); var - Pos: integer; + GLFont: PGLFont; begin // if there is no text do nothing if (Text = '') then Exit; - //Save the actual color and alpha (for reflection) - glGetFloatv(GL_CURRENT_COLOR, @TempColor); + GLFont := @Fonts[ActFont]; - for Pos := 1 to Length(Text) do - begin - glPrintLetter(Text[Pos]); - end; + glPushMatrix(); + // set font position + glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z); + // draw string + GLFont.Font.Print(Text); + glPopMatrix(); end; procedure ResetFont(); @@ -343,18 +172,18 @@ end; procedure SetFontPos(X, Y: real); begin - Fonts[ActFont].Tex.X := X; - Fonts[ActFont].Tex.Y := Y; + Fonts[ActFont].X := X; + Fonts[ActFont].Y := Y; end; procedure SetFontZ(Z: real); begin - Fonts[ActFont].Tex.Z := Z; + Fonts[ActFont].Z := Z; end; procedure SetFontSize(Size: real); begin - Fonts[ActFont].Tex.H := Size; + Fonts[ActFont].Font.Height := Size; end; procedure SetFontStyle(Style: integer); @@ -364,21 +193,19 @@ end; procedure SetFontItalic(Enable: boolean); begin - Fonts[ActFont].Italic := Enable; -end; - -procedure SetFontAspectW(Aspect: real); -begin - Fonts[ActFont].AspectW := Aspect; + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic] end; procedure SetFontReflection(Enable: boolean; Spacing: real); begin - Fonts[ActFont].Reflection := Enable; - Fonts[ActFont].ReflectionSpacing := Spacing; + if (Enable) then + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect] + else + Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect]; + Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender; end; end. - -{$ENDIF} - diff --git a/src/base/TextGLFreetype.pas b/src/base/TextGLFreetype.pas deleted file mode 100644 index 61b26693..00000000 --- a/src/base/TextGLFreetype.pas +++ /dev/null @@ -1,222 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/TextGL.pas $ - * $Id: TextGL.pas 1483 2008-10-28 19:01:20Z tobigun $ - *} - -(* -unit TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} -*) - -uses - gl, - glext, - SDL, - UTexture, - UFont, - Classes, - ULog; - -type - PGLFont = ^TGLFont; - TGLFont = record - Font: TScalableFont; - X, Y, Z: real; - end; - -var - Fonts: array of TGLFont; - ActFont: integer; - -procedure BuildFont; // build our bitmap font -procedure KillFont; // delete the font -function glTextWidth(const text: string): real; // returns text width -procedure glPrint(const text: string); // custom GL "Print" routine -procedure ResetFont(); // reset font settings of active font -procedure SetFontPos(X, Y: real); // sets X and Y -procedure SetFontZ(Z: real); // sets Z -procedure SetFontSize(Size: real); -procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc) -procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts) -procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection - -implementation - -uses - UMain, - UCommon, - UTextEncoding, - SysUtils, - IniFiles; - -function FindFontFile(FontIni: TCustomIniFile; Font: string): string; -var - Filename: string; -begin - Filename := FontIni.ReadString(Font, 'File', ''); - Result := FontPath + Filename; - // if path does not exist, try as an absolute path - if (not FileExists(Result)) then - Result := Filename; -end; - -procedure BuildFont; -var - FontIni: TMemIniFile; - //BitmapFont: TBitmapFont; - FontFile: string; -begin - ActFont := 0; - - SetLength(Fonts, 4); - FontIni := TMemIniFile.Create(FontPath + 'fontsTTF.ini'); - //FontIni := TMemIniFile.Create(FontPath + 'fonts.ini'); - - try - - // Normal - FontFile := FindFontFile(FontIni, 'Normal'); - Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); - //Fonts[0].Font.GlyphSpacing := 1.4; - //Fonts[0].Font.Aspect := 1.2; - - { - BitmapFont := TBitmapFont.Create(FontFile, 0, 19, 35, -10); - BitmapFont.CorrectWidths(2, 0); - Fonts[0].Font := TScalableFont.Create(BitmapFont, false); - } - - //Fonts[0].Font.Aspect := 0.9; - - // Bold - FontFile := FindFontFile(FontIni, 'Bold'); - Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); - - // Outline1 - FontFile := FindFontFile(FontIni, 'Outline1'); - Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); - //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); - - // Outline2 - FontFile := FindFontFile(FontIni, 'Outline2'); - Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); - - except on E: Exception do - Log.LogCritical(E.Message, 'BuildFont'); - end; - - // close ini-file - FontIni.Free; -end; - - -// Deletes the font -procedure KillFont; -begin - // delete all characters - //glDeleteLists(..., 256); -end; - -function glTextWidth(const text: string): real; -var - Bounds: TBoundsDbl; -begin - // FIXME: remove conversion - Bounds := Fonts[ActFont].Font.BBox(RecodeString(Text, encCP1252), true); - Result := Bounds.Right - Bounds.Left; -end; - -// Custom GL "Print" Routine -procedure glPrint(const Text: string); -var - GLFont: PGLFont; -begin - // if there is no text do nothing - if (Text = '') then - Exit; - - GLFont := @Fonts[ActFont]; - - glPushMatrix(); - // set font position - glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z); - // draw string - // FIXME: remove conversion - GLFont.Font.Print(RecodeString(Text, encCP1252)); - glPopMatrix(); -end; - -procedure ResetFont(); -begin - SetFontPos(0, 0); - SetFontZ(0); - SetFontItalic(False); - SetFontReflection(False, 0); -end; - -procedure SetFontPos(X, Y: real); -begin - Fonts[ActFont].X := X; - Fonts[ActFont].Y := Y; -end; - -procedure SetFontZ(Z: real); -begin - Fonts[ActFont].Z := Z; -end; - -procedure SetFontSize(Size: real); -begin - Fonts[ActFont].Font.Height := Size; -end; - -procedure SetFontStyle(Style: integer); -begin - ActFont := Style; -end; - -procedure SetFontItalic(Enable: boolean); -begin - if (Enable) then - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic] - else - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic] -end; - -procedure SetFontReflection(Enable: boolean; Spacing: real); -begin - if (Enable) then - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect] - else - Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect]; - Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender; -end; - -end. diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas index 2983fdee..310a49cd 100644 --- a/src/base/UBeatTimer.pas +++ b/src/base/UBeatTimer.pas @@ -1,170 +1,170 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/USingNotes.pas $ - * $Id: USingNotes.pas 1406 2008-09-23 21:43:52Z k-m_schindler $ - *} - -unit UBeatTimer; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UTime; - -type - (** - * TLyricsState contains all information concerning the - * state of the lyrics, e.g. the current beat or duration of the lyrics. - *) - TLyricsState = class - private - Timer: TRelativeTimer; // keeps track of the current time - public - OldBeat: integer; // previous discovered beat - CurrentBeat: integer; // current beat (rounded) - MidBeat: real; // current beat (float) - - // now we use this for super synchronization! - // only used when analyzing voice - // TODO: change ...D to ...Detect(ed) - OldBeatD: integer; // previous discovered beat - CurrentBeatD: integer; // current discovered beat (rounded) - MidBeatD: real; // current discovered beat (float) - - // we use this for audible clicks - // TODO: Change ...C to ...Click - OldBeatC: integer; // previous discovered beat - CurrentBeatC: integer; - MidBeatC: real; // like CurrentBeatC - - OldLine: integer; // previous displayed sentence - - StartTime: real; // time till start of lyrics (= Gap) - TotalTime: real; // total song time - - constructor Create(); - procedure Pause(); - procedure Resume(); - - procedure Reset(); - procedure UpdateBeats(); - - (** - * current song time (in seconds) used as base-timer for lyrics etc. - *) - function GetCurrentTime(): real; - procedure SetCurrentTime(Time: real); - end; - -implementation -uses UNote, Math; - - -constructor TLyricsState.Create(); -begin - // create a triggered timer, so we can Pause() it, set the time - // and Resume() it afterwards for better synching. - Timer := TRelativeTimer.Create(true); - - // reset state - Reset(); -end; - -procedure TLyricsState.Pause(); -begin - Timer.Pause(); -end; - -procedure TLyricsState.Resume(); -begin - Timer.Resume(); -end; - -procedure TLyricsState.SetCurrentTime(Time: real); -begin - // do not start the timer (if not started already), - // after setting the current time - Timer.SetTime(Time, false); -end; - -function TLyricsState.GetCurrentTime(): real; -begin - Result := Timer.GetTime(); -end; - -(** - * Resets the timer and state of the lyrics. - * The timer will be stopped afterwards so you have to call Resume() - * to start the lyrics timer. - *) -procedure TLyricsState.Reset(); -begin - Pause(); - SetCurrentTime(0); - - StartTime := 0; - TotalTime := 0; - - OldBeat := -1; - MidBeat := -1; - CurrentBeat := -1; - - OldBeatC := -1; - MidBeatC := -1; - CurrentBeatC := -1; - - OldBeatD := -1; - MidBeatD := -1; - CurrentBeatD := -1; -end; - -(** - * Updates the beat information (CurrentBeat/MidBeat/...) according to the - * current lyric time. - *) -procedure TLyricsState.UpdateBeats(); -var - CurLyricsTime: real; -begin - CurLyricsTime := GetCurrentTime(); - - OldBeat := CurrentBeat; - MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeat := Floor(MidBeat); - - OldBeatC := CurrentBeatC; - MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); - CurrentBeatC := Floor(MidBeatC); - - OldBeatD := CurrentBeatD; - // MidBeatD = MidBeat with additional GAP - MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); - CurrentBeatD := Floor(MidBeatD); -end; - +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UBeatTimer; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + UTime; + +type + (** + * TLyricsState contains all information concerning the + * state of the lyrics, e.g. the current beat or duration of the lyrics. + *) + TLyricsState = class + private + Timer: TRelativeTimer; // keeps track of the current time + public + OldBeat: integer; // previous discovered beat + CurrentBeat: integer; // current beat (rounded) + MidBeat: real; // current beat (float) + + // now we use this for super synchronization! + // only used when analyzing voice + // TODO: change ...D to ...Detect(ed) + OldBeatD: integer; // previous discovered beat + CurrentBeatD: integer; // current discovered beat (rounded) + MidBeatD: real; // current discovered beat (float) + + // we use this for audible clicks + // TODO: Change ...C to ...Click + OldBeatC: integer; // previous discovered beat + CurrentBeatC: integer; + MidBeatC: real; // like CurrentBeatC + + OldLine: integer; // previous displayed sentence + + StartTime: real; // time till start of lyrics (= Gap) + TotalTime: real; // total song time + + constructor Create(); + procedure Pause(); + procedure Resume(); + + procedure Reset(); + procedure UpdateBeats(); + + (** + * current song time (in seconds) used as base-timer for lyrics etc. + *) + function GetCurrentTime(): real; + procedure SetCurrentTime(Time: real); + end; + +implementation +uses UNote, Math; + + +constructor TLyricsState.Create(); +begin + // create a triggered timer, so we can Pause() it, set the time + // and Resume() it afterwards for better synching. + Timer := TRelativeTimer.Create(true); + + // reset state + Reset(); +end; + +procedure TLyricsState.Pause(); +begin + Timer.Pause(); +end; + +procedure TLyricsState.Resume(); +begin + Timer.Resume(); +end; + +procedure TLyricsState.SetCurrentTime(Time: real); +begin + // do not start the timer (if not started already), + // after setting the current time + Timer.SetTime(Time, false); +end; + +function TLyricsState.GetCurrentTime(): real; +begin + Result := Timer.GetTime(); +end; + +(** + * Resets the timer and state of the lyrics. + * The timer will be stopped afterwards so you have to call Resume() + * to start the lyrics timer. + *) +procedure TLyricsState.Reset(); +begin + Pause(); + SetCurrentTime(0); + + StartTime := 0; + TotalTime := 0; + + OldBeat := -1; + MidBeat := -1; + CurrentBeat := -1; + + OldBeatC := -1; + MidBeatC := -1; + CurrentBeatC := -1; + + OldBeatD := -1; + MidBeatD := -1; + CurrentBeatD := -1; +end; + +(** + * Updates the beat information (CurrentBeat/MidBeat/...) according to the + * current lyric time. + *) +procedure TLyricsState.UpdateBeats(); +var + CurLyricsTime: real; +begin + CurLyricsTime := GetCurrentTime(); + + OldBeat := CurrentBeat; + MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeat := Floor(MidBeat); + + OldBeatC := CurrentBeatC; + MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000); + CurrentBeatC := Floor(MidBeatC); + + OldBeatD := CurrentBeatD; + // MidBeatD = MidBeat with additional GAP + MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000); + CurrentBeatD := Floor(MidBeatD); +end; + end. \ No newline at end of file diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index 6ef81b68..6e004b22 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -38,20 +38,21 @@ interface {$I switches.inc} uses - UIni; + UIni, + UPath; type TCatCovers = class protected - cNames: array [0..high(ISorting)] of array of string; - cFiles: array [0..high(ISorting)] of array of string; + cNames: array [0..high(ISorting)] of array of UTF8String; + cFiles: array [0..high(ISorting)] of array of IPath; public constructor Create; procedure Load; //Load Cover aus Cover.ini and Cover Folder - procedure LoadPath(const CoversPath: string); - procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover - function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists - function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover + procedure LoadPath(const CoversPath: IPath); + procedure Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); //Add a Cover + function CoverExists(Sorting: integer; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists + function GetCover(Sorting: integer; const Name: UTF8String): IPath; //Returns the Filename of a Cover end; var @@ -63,10 +64,11 @@ uses IniFiles, SysUtils, Classes, - // UFiles, + UFilesystem, ULog, UMain, - UPath; + UUnicodeUtils, + UPathUtils; constructor TCatCovers.Create; begin @@ -79,25 +81,28 @@ var I: integer; begin for I := 0 to CoverPaths.Count-1 do - LoadPath(CoverPaths[I]); + LoadPath(CoverPaths[I] as IPath); end; (** * Load Cover from Cover.ini and Cover Folder *) -procedure TCatCovers.LoadPath(const CoversPath: string); +procedure TCatCovers.LoadPath(const CoversPath: IPath); var Ini: TMemIniFile; - SR: TSearchRec; List: TStringlist; I, J: Integer; - Name, Filename, Temp: string; + Filename: IPath; + Name, TmpName: UTF8String; + CatCover: IPath; + Iter: IFileIterator; + FileInfo: TFileInfo; begin Ini := nil; List := nil; try - Ini := TMemIniFile.Create(CoversPath + 'covers.ini'); + Ini := TMemIniFile.Create(CoversPath.Append('covers.ini').ToNative); List := TStringlist.Create; //Add every Cover in Covers Ini for Every Sorting option @@ -106,63 +111,65 @@ begin Ini.ReadSection(ISorting[I], List); for J := 0 to List.Count - 1 do - Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); + begin + CatCover := Path(Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); + Add(I, List.Strings[J], CoversPath.Append(CatCover)); + end; end; finally Ini.Free; List.Free; end; - try - //Add Covers from Folder - if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then - repeat - //Add Cover if it doesn't exist for every Section - Name := SR.Name; - Filename := CoversPath + Name; - Delete (Name, length(Name) - 3, 4); - - for I := 0 to high(ISorting) do - begin - Temp := Name; - if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then - Delete (Temp, Pos ('Title', Temp), 5) - else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then - Delete (Temp, Pos ('Artist', Temp), 6); - - if not CoverExists(I, Temp) then - Add (I, Temp, Filename); - end; - until FindNext (SR) <> 0; - finally - FindClose (SR); + //Add Covers from Folder + Iter := FileSystem.FileFind(CoversPath.Append('*.jpg'), 0); + while Iter.HasNext do + begin + FileInfo := Iter.Next; + + //Add Cover if it doesn't exist for every Section + Filename := CoversPath.Append(FileInfo.Name); + Name := FileInfo.Name.SetExtension('').ToUTF8; + + for I := 0 to high(ISorting) do + begin + TmpName := Name; + if ((I = sTitle) or (I = sTitle2)) and (UTF8Pos('Title', TmpName) <> 0) then + UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5) + else if (I = sArtist) or (I = sArtist2) and (UTF8Pos('Artist', TmpName) <> 0) then + UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6); + + if not CoverExists(I, TmpName) then + Add(I, TmpName, Filename); + end; end; end; //Add a Cover -procedure TCatCovers.Add(Sorting: integer; Name, Filename: string); +procedure TCatCovers.Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); begin - if FileExists (Filename) then //If Exists -> Add + if Filename.IsFile then //If Exists -> Add begin - SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1); - SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1); + SetLength(CNames[Sorting], Length(CNames[Sorting]) + 1); + SetLength(CFiles[Sorting], Length(CNames[Sorting]) + 1); - CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name); + CNames[Sorting][high(cNames[Sorting])] := UTF8Uppercase(Name); CFiles[Sorting][high(cNames[Sorting])] := FileName; end; end; //Returns True when a cover with the given Name exists -function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean; +function TCatCovers.CoverExists(Sorting: integer; const Name: UTF8String): boolean; var I: Integer; + UpperName: UTF8String; begin Result := False; - Name := Uppercase(Name); //Case Insensitiv + UpperName := UTF8Uppercase(Name); //Case Insensitiv for I := 0 to high(cNames[Sorting]) do begin - if (cNames[Sorting][I] = Name) then //Found Name + if (cNames[Sorting][I] = UpperName) then //Found Name begin Result := true; break; //Break For Loop @@ -171,16 +178,18 @@ begin end; //Returns the Filename of a Cover -function TCatCovers.GetCover(Sorting: integer; Name: string): string; +function TCatCovers.GetCover(Sorting: integer; const Name: UTF8String): IPath; var I: Integer; + UpperName: UTF8String; + NoCoverPath: IPath; begin - Result := ''; - Name := Uppercase(Name); + Result := PATH_NONE; + UpperName := UTF8Uppercase(Name); for I := 0 to high(cNames[Sorting]) do begin - if cNames[Sorting][I] = Name then + if cNames[Sorting][I] = UpperName then begin Result := cFiles[Sorting][I]; Break; @@ -188,13 +197,14 @@ begin end; //No Cover - if (Result = '') then + if (Result.IsUnset) then begin for I := 0 to CoverPaths.Count-1 do begin - if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then + NoCoverPath := (CoverPaths[I] as IPath).Append('NoCover.jpg'); + if (NoCoverPath.IsFile) then begin - Result := CoverPaths[I] + 'NoCover.jpg'; + Result := NoCoverPath; Break; end; end; diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas index 281a480d..ac0db2c2 100644 --- a/src/base/UCommandLine.pas +++ b/src/base/UCommandLine.pas @@ -33,6 +33,9 @@ interface {$I switches.inc} +uses + UPath; + type TScreenMode = (scmDefault, scmFullscreen, scmWindowed); @@ -64,9 +67,9 @@ type Screens: integer; // some strings set when reading infos {Length=0: Not Set} - SongPath: string; - ConfigFile: string; - ScoreFile: string; + SongPath: IPath; + ConfigFile: IPath; + ScoreFile: IPath; // pseudo integer values property Language: integer read GetLanguage; @@ -144,9 +147,9 @@ begin Screens := -1; // some strings set when reading infos {Length=0 Not Set} - SongPath := ''; - ConfigFile := ''; - ScoreFile := ''; + SongPath := PATH_NONE; + ConfigFile := PATH_NONE; + ScoreFile := PATH_NONE; end; {** @@ -248,7 +251,7 @@ begin if (PCount > I) then begin // write value to string - SongPath := ParamStr(I + 1); + SongPath := Path(ParamStr(I + 1)); end; end @@ -258,11 +261,11 @@ begin if (PCount > I) then begin // write value to string - ConfigFile := ParamStr(I + 1); + ConfigFile := Path(ParamStr(I + 1)); // is this a relative path -> then add gamepath - if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then - ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile; + if (not ConfigFile.IsAbsolute) then + ConfigFile := Platform.GetExecutionDir().Append(ConfigFile); end; end @@ -272,7 +275,7 @@ begin if (PCount > I) then begin // write value to string - ScoreFile := ParamStr(I + 1); + ScoreFile := Path(ParamStr(I + 1)); end; end; diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index d729b6dd..fa0faf3c 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -39,9 +39,28 @@ uses {$IFDEF MSWINDOWS} Windows, {$ENDIF} - sdl, UConfig, - ULog; + ULog, + UPath; + +type + TStringDynArray = array of string; + +const + SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space + +{** + * Splits a string into pieces separated by Separators. + * MaxCount specifies the max. number of pieces. If it is <= 0 the number is + * not limited. If > 0 the last array element will hold the rest of the string + * (with leading separators removed). + * + * Examples: + * SplitString(' split me now ', 0) -> ['split', 'me', 'now'] + * SplitString(' split me now ', 1) -> ['split', 'me now'] + *} +function SplitString(const Str: string; MaxCount: integer = 0; Separators: TSysCharSet = SepWhitespace): TStringDynArray; + type TMessageType = (mtInfo, mtError); @@ -50,43 +69,19 @@ procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo); procedure ConsoleWriteLn(const msg: string); -function RWopsFromStream(Stream: TStream): PSDL_RWops; - {$IFDEF FPC} function RandomRange(aMin: integer; aMax: integer): integer; {$ENDIF} -function StringReplaceW(text: WideString; search, rep: WideChar): WideString; -function AdaptFilePaths(const aPath: WideString): WideString; - procedure DisableFloatingPointExceptions(); procedure SetDefaultNumericLocale(); procedure RestoreNumericLocale(); {$IFNDEF MSWINDOWS} - procedure ZeroMemory(Destination: pointer; Length: dword); - function MakeLong(a, b: word): longint; - (* - #define LOBYTE(a) (BYTE)(a) - #define HIBYTE(a) (BYTE)((a)>>8) - #define LOWORD(a) (WORD)(a) - #define HIWORD(a) (WORD)((a)>>16) - #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8)) - *) +procedure ZeroMemory(Destination: pointer; Length: dword); +function MakeLong(a, b: word): longint; {$ENDIF} -function FileExistsInsensitive(var FileName: string): boolean; - -(* - * Character classes - *) - -function IsAlphaChar(ch: WideChar): boolean; -function IsNumericChar(ch: WideChar): boolean; -function IsAlphaNumericChar(ch: WideChar): boolean; -function IsPunctuationChar(ch: WideChar): boolean; -function IsControlChar(ch: WideChar): boolean; - // A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) procedure MergeSort(List: TList; CompareFunc: TListSortCompare); @@ -101,8 +96,63 @@ uses {$IFDEF Delphi} Dialogs, {$ENDIF} - UMain; + sdl, + UFilesystem, + UMain, + UUnicodeUtils; + +function SplitString(const Str: string; MaxCount: integer; Separators: TSysCharSet): TStringDynArray; + + {* + * Adds Str[StartPos..Endpos-1] to the result array. + *} + procedure AddSplit(StartPos, EndPos: integer); + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := Copy(Str, StartPos, EndPos-StartPos); + end; +var + I: integer; + Start: integer; + Last: integer; +begin + Start := 0; + SetLength(Result, 0); + + for I := 1 to Length(Str) do + begin + if (Str[I] in Separators) then + begin + // end of component found + if (Start > 0) then + begin + AddSplit(Start, I); + Start := 0; + end; + end + else if (Start = 0) then + begin + // mark beginning of component + Start := I; + // check if this is the last component + if (Length(Result) = MaxCount-1) then + begin + // find last non-separator char + Last := Length(Str); + while (Str[Last] in Separators) do + Dec(Last); + // add component up to last non-separator + AddSplit(Start, Last); + Exit; + end; + end; + end; + + // last component + if (Start > 0) then + AddSplit(Start, Length(Str)+1); +end; // data used by the ...Locale() functions {$IF Defined(Linux) or Defined(FreeBSD)} @@ -224,39 +274,6 @@ begin exOverflow, exUnderflow, exPrecision]); end; -function StringReplaceW(text: WideString; search, rep: WideChar): WideString; -var - iPos: integer; -// sTemp: WideString; -begin -(* - result := text; - iPos := Pos(search, result); - while (iPos > 0) do - begin - sTemp := copy(result, iPos + length(search), length(result)); - result := copy(result, 1, iPos - 1) + rep + sTEmp; - iPos := Pos(search, result); - end; -*) - result := text; - - if search = rep then - exit; - - for iPos := 1 to length(result) do - begin - if result[iPos] = search then - result[iPos] := rep; - end; -end; - -function AdaptFilePaths(const aPath: WideString): WideString; -begin - result := StringReplaceW(aPath, '\', PathDelim);//, [rfReplaceAll]); -end; - - {$IFNDEF MSWINDOWS} procedure ZeroMemory(Destination: pointer; Length: dword); begin @@ -268,135 +285,8 @@ begin Result := (LongInt(B) shl 16) + A; end; -(* -function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER): Bool; - - // From http://en.wikipedia.org/wiki/RDTSC - function RDTSC: Int64; register; - asm - rdtsc - end; - -begin - // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit) - lpPerformanceCount := RDTSC(); - result := true; -end; - -function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool; -begin - // clock_getres(CLOCK_REALTIME, ...) - lpFrequency := 0; - result := true; -end; -*) {$ENDIF} -// Checks if a regular files or directory with the given name exists. -// The comparison is case insensitive. -function FileExistsInsensitive(var FileName: string): boolean; -var - FilePath, LocalFileName: string; - SearchInfo: TSearchRec; -begin -{$IF Defined(Linux) or Defined(FreeBSD)} - // speed up standard case - if FileExists(FileName) then - begin - Result := true; - exit; - end; - - Result := false; - - FilePath := ExtractFilePath(FileName); - if (FindFirst(FilePath + '*', faAnyFile, SearchInfo) = 0) then - begin - LocalFileName := ExtractFileName(FileName); - repeat - if (AnsiSameText(LocalFileName, SearchInfo.Name)) then - begin - FileName := FilePath + SearchInfo.Name; - Result := true; - break; - end; - until (FindNext(SearchInfo) <> 0); - end; - FindClose(SearchInfo); -{$ELSE} - // Windows and Mac OS X do not have case sensitive file systems - Result := FileExists(FileName); -{$IFEND} -end; - -// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++ -function SdlStreamSeek(context: PSDL_RWops; offset: integer; whence: integer): integer; cdecl; -var - stream: TStream; - origin: word; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamSeek on nil'); - case whence of - 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0. - 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset. - 2 : origin := soFromEnd; - else - origin := soFromBeginning; // just in case - end; - Result := stream.Seek(offset, origin); -end; - -function SdlStreamRead(context: PSDL_RWops; Ptr: pointer; size: integer; maxnum: integer): integer; cdecl; -var - stream: TStream; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamRead on nil'); - try - Result := stream.read(Ptr^, Size * maxnum) div size; - except - Result := -1; - end; -end; - -function SDLStreamClose(context: PSDL_RWops): integer; cdecl; -var - stream: TStream; -begin - stream := TStream(context.unknown); - if (stream = nil) then - raise EInvalidContainer.Create('SDLStreamClose on nil'); - stream.Free; - Result := 1; -end; -// ----------------------------------------------- - -(* - * Creates an SDL_RWops handle from a TStream. - * The stream and RWops must be freed by the user after usage. - * Use SDL_FreeRW(...) to free the RWops data-struct. - *) -function RWopsFromStream(Stream: TStream): PSDL_RWops; -begin - Result := SDL_AllocRW(); - if (Result = nil) then - Exit; - - // set RW-callbacks - with Result^ do - begin - unknown := TUnknown(Stream); - seek := SDLStreamSeek; - read := SDLStreamRead; - write := nil; - close := SDLStreamClose; - type_ := 2; - end; -end; - {$IFDEF FPC} function RandomRange(aMin: integer; aMax: integer): integer; begin @@ -541,59 +431,6 @@ begin {$IFEND} end; -function IsAlphaChar(ch: WideChar): boolean; -begin - // TODO: add chars > 255 when unicode-fonts work? - case ch of - 'A'..'Z', // A-Z - 'a'..'z', // a-z - #170,#181,#186, - #192..#214, - #216..#246, - #248..#255: - Result := true; - else - Result := false; - end; -end; - -function IsNumericChar(ch: WideChar): boolean; -begin - case ch of - '0'..'9': - Result := true; - else - Result := false; - end; -end; - -function IsAlphaNumericChar(ch: WideChar): boolean; -begin - Result := (IsAlphaChar(ch) or IsNumericChar(ch)); -end; - -function IsPunctuationChar(ch: WideChar): boolean; -begin - // TODO: add chars outside of Latin1 basic (0..127)? - case ch of - ' '..'/',':'..'@','['..'`','{'..'~': - Result := true; - else - Result := false; - end; -end; - -function IsControlChar(ch: WideChar): boolean; -begin - case ch of - #0..#31, - #127..#159: - Result := true; - else - Result := false; - end; -end; - (* * Recursive part of the MergeSort algorithm. * OutList will be either InList or TempList and will be swapped in each diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index 1214f36f..f6dc69a5 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -90,7 +90,7 @@ interface {$I switches.inc} uses - Sysutils; + SysUtils; const // IMPORTANT: @@ -156,6 +156,12 @@ const (FPC_RELEASE * VERSION_MINOR) + (FPC_PATCH * VERSION_RELEASE); + // FPC 2.2.0 unicode support is very buggy. The cwstring unit for example + // always crashes whenever UTF8ToAnsi() is called on a non UTF8 encoded string + // what is fixed in 2.2.2. + {$IF Defined(FPC) and (FPC_VERSION_INT < 2002002)} // < 2.2.2 + {$MESSAGE FATAL 'FPC >= 2.2.2 required!'} + {$IFEND} {$IFDEF HaveFFmpeg} diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas index a1705674..6c7c9e48 100644 --- a/src/base/UCovers.pas +++ b/src/base/UCovers.pas @@ -50,7 +50,8 @@ uses SysUtils, Classes, UImage, - UTexture; + UTexture, + UPath; type ECoverDBException = class(Exception) @@ -59,9 +60,9 @@ type TCover = class private ID: int64; - Filename: WideString; + Filename: IPath; public - constructor Create(ID: int64; Filename: WideString); + constructor Create(ID: int64; Filename: IPath); function GetPreviewTexture(): TTexture; function GetTexture(): TTexture; end; @@ -76,19 +77,19 @@ type private DB: TSQLiteDatabase; procedure InitCoverDatabase(); - function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; + function CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface; function LoadCover(CoverID: int64): TTexture; procedure DeleteCover(CoverID: int64); - function FindCoverIntern(const Filename: WideString): int64; + function FindCoverIntern(const Filename: IPath): int64; procedure Open(); function GetVersion(): integer; procedure SetVersion(Version: integer); public constructor Create(); destructor Destroy; override; - function AddCover(const Filename: WideString): TCover; - function FindCover(const Filename: WideString): TCover; - function CoverExists(const Filename: WideString): boolean; + function AddCover(const Filename: IPath): TCover; + function FindCover(const Filename: IPath): TCover; + function CoverExists(const Filename: IPath): boolean; function GetMaxCoverSize(): integer; procedure SetMaxCoverSize(Size: integer); end; @@ -111,7 +112,7 @@ uses DateUtils; const - COVERDB_FILENAME = 'cover.db'; + COVERDB_FILENAME: UTF8String = 'cover.db'; COVERDB_VERSION = 01; // 0.1 COVER_TBL = 'Cover'; COVER_THUMBNAIL_TBL = 'CoverThumbnail'; @@ -141,7 +142,7 @@ end; { TCover } -constructor TCover.Create(ID: int64; Filename: WideString); +constructor TCover.Create(ID: int64; Filename: IPath); begin Self.ID := ID; Self.Filename := Filename; @@ -210,11 +211,11 @@ end; procedure TCoverDatabase.Open(); var Version: integer; - Filename: string; + Filename: IPath; begin - Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME); + Filename := Platform.GetGameUserPath().Append(COVERDB_FILENAME); - DB := TSQLiteDatabase.Create(Filename); + DB := TSQLiteDatabase.Create(Filename.ToUTF8()); Version := GetVersion(); // check version, if version is too old/new, delete database file @@ -223,10 +224,10 @@ begin Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open'); // close and delete outdated file DB.Free; - if (not DeleteFile(Filename)) then - raise ECoverDBException.Create('Could not delete ' + Filename); + if (not Filename.DeleteFile()) then + raise ECoverDBException.Create('Could not delete ' + Filename.ToNative); // reopen - DB := TSQLiteDatabase.Create(Filename); + DB := TSQLiteDatabase.Create(Filename.ToUTF8()); Version := 0; end; @@ -266,14 +267,14 @@ begin ')'); end; -function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64; +function TCoverDatabase.FindCoverIntern(const Filename: IPath): int64; begin Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' + 'WHERE [Filename] = ?', - [UTF8Encode(Filename)]); + [Filename.ToUTF8]); end; -function TCoverDatabase.FindCover(const Filename: WideString): TCover; +function TCoverDatabase.FindCover(const Filename: IPath): TCover; var CoverID: int64; begin @@ -287,7 +288,7 @@ begin end; end; -function TCoverDatabase.CoverExists(const Filename: WideString): boolean; +function TCoverDatabase.CoverExists(const Filename: IPath): boolean; begin Result := false; try @@ -297,7 +298,7 @@ begin end; end; -function TCoverDatabase.AddCover(const Filename: WideString): TCover; +function TCoverDatabase.AddCover(const Filename: IPath): TCover; var CoverID: int64; Thumbnail: PSDL_Surface; @@ -329,7 +330,7 @@ begin DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' + '([Filename], [Date], [Width], [Height]) VALUES' + '(?, ?, ?, ?)', - [UTF8Encode(Filename), DateTimeToUnixTime(FileDate), + [Filename.ToUTF8, DateTimeToUnixTime(FileDate), Info.CoverWidth, Info.CoverHeight]); // get auto-generated cover ID @@ -358,7 +359,7 @@ var PixelFmt: TImagePixelFmt; Data: PChar; DataSize: integer; - Filename: WideString; + Filename: IPath; Table: TSQLiteUniTable; begin Table := nil; @@ -371,7 +372,7 @@ begin 'USING(ID) ' + 'WHERE [ID] = %d', [CoverID])); - Filename := UTF8Decode(Table.FieldAsString(0)); + Filename := Path(Table.FieldAsString(0)); PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1)); Width := Table.FieldAsInteger(2); Height := Table.FieldAsInteger(3); @@ -384,6 +385,9 @@ begin end else begin + // FillChar() does not decrement the ref-count of ref-counted fields + // -> reset Name field manually + Result.Name := nil; FillChar(Result, SizeOf(TTexture), 0); end; except on E: Exception do @@ -403,7 +407,7 @@ end; * Returns a pointer to an array of bytes containing the texture data in the * requested size *) -function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface; +function TCoverDatabase.CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface; var //TargetAspect, SourceAspect: double; //TargetWidth, TargetHeight: integer; @@ -417,7 +421,7 @@ begin Thumbnail := LoadImage(Filename); if (not assigned(Thumbnail)) then begin - Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover'); + Log.LogError('Could not load cover: "'+ Filename.ToNative +'"', 'TCoverDatabase.AddCover'); Exit; end; diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas index 3faa15bf..d5bb1480 100644 --- a/src/base/UDLLManager.pas +++ b/src/base/UDLLManager.pas @@ -35,7 +35,9 @@ interface uses ModiSDK, - UFiles; + UFiles, + UPath, + UFilesystem; type TDLLMan = class @@ -47,14 +49,14 @@ type P_RData: pModi_RData; public Plugins: array of TPluginInfo; - PluginPaths: array of string; + PluginPaths: array of IPath; Selected: ^TPluginInfo; constructor Create; procedure GetPluginList; procedure ClearPluginInfo(No: cardinal); - function LoadPluginInfo(Filename: string; No: cardinal): boolean; + function LoadPluginInfo(const Filename: IPath; No: cardinal): boolean; function LoadPlugin(No: cardinal): boolean; procedure UnLoadPlugin; @@ -92,7 +94,7 @@ uses {$ELSE} dynlibs, {$ENDIF} - UPath, + UPathUtils, ULog, SysUtils; @@ -107,27 +109,26 @@ end; procedure TDLLMan.GetPluginList; var - SearchRecord: TSearchRec; + Iter: IFileIterator; + FileInfo: TFileInfo; begin - - if FindFirst(PluginPath + '*' + DLLExt, faAnyFile, SearchRecord) = 0 then + Iter := FileSystem.FileFind(PluginPath.Append('*' + DLLExt), 0); + while (Iter.HasNext) do begin - repeat - SetLength(Plugins, Length(Plugins)+1); - SetLength(PluginPaths, Length(Plugins)); + SetLength(Plugins, Length(Plugins)+1); + SetLength(PluginPaths, Length(Plugins)); + + FileInfo := Iter.Next; - if LoadPluginInfo(SearchRecord.Name, High(Plugins)) then // loaded succesful - begin - PluginPaths[High(PluginPaths)] := SearchRecord.Name; - end - else // error loading - begin - SetLength(Plugins, Length(Plugins)-1); - SetLength(PluginPaths, Length(Plugins)); - end; - - until FindNext(SearchRecord) <> 0; - FindClose(SearchRecord); + if LoadPluginInfo(FileInfo.Name, High(Plugins)) then // loaded succesful + begin + PluginPaths[High(PluginPaths)] := FileInfo.Name; + end + else // error loading + begin + SetLength(Plugins, Length(Plugins)-1); + SetLength(PluginPaths, Length(Plugins)); + end; end; end; @@ -164,7 +165,7 @@ begin Plugins[No].EnLineBonus_O := true; end; -function TDLLMan.LoadPluginInfo(Filename: string; No: cardinal): boolean; +function TDLLMan.LoadPluginInfo(const Filename: IPath; No: cardinal): boolean; var hLibg: THandle; Info: pModi_PluginInfo; @@ -182,7 +183,7 @@ begin } // load libary - hLibg := LoadLibrary(PChar(PluginPath + Filename)); + hLibg := LoadLibrary(PChar(PluginPath.Append(Filename).ToNative)); // if loaded if (hLibg <> 0) then begin @@ -197,19 +198,19 @@ begin Result := true; end else - Log.LogError('Could not load plugin "' + Filename + '": Info procedure not found'); + Log.LogError('Could not load plugin "' + Filename.ToNative + '": Info procedure not found'); FreeLibrary (hLibg); end else - Log.LogError('Could not load plugin "' + Filename + '": Libary not loaded'); + Log.LogError('Could not load plugin "' + Filename.ToNative + '": Libary not loaded'); end; function TDLLMan.LoadPlugin(No: cardinal): boolean; begin Result := true; // load libary - hLib := LoadLibrary(PChar(PluginPath + PluginPaths[No])); + hLib := LoadLibrary(PChar(PluginPath.Append(PluginPaths[No]).ToNative)); // if loaded if (hLib <> 0) then begin @@ -226,11 +227,11 @@ begin end else begin - Log.LogError('Could not load plugin "' + PluginPaths[No] + '": Procedures not found'); + Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Procedures not found'); end; end else - Log.LogError('Could not load plugin "' + PluginPaths[No] + '": Libary not loaded'); + Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Libary not loaded'); end; procedure TDLLMan.UnLoadPlugin; diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index 227db653..bdcbd30f 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -36,18 +36,19 @@ interface uses Classes, SQLiteTable3, + UPath, USong, USongs; //-------------------- -//DataBaseSystem - Class including all DB Methods +//DataBaseSystem - Class including all DB methods //-------------------- type TStatType = ( - stBestScores, // Best Scores - stBestSingers, // Best Singers - stMostSungSong, // Most sung Songs - stMostPopBand // Most popular Band + stBestScores, // Best scores + stBestSingers, // Best singers + stMostSungSong, // Most sung songs + stMostPopBand // Most popular band ); // abstract super-class for statistic results @@ -58,29 +59,29 @@ type TStatResultBestScores = class(TStatResult) public - Singer: WideString; + Singer: UTF8String; Score: word; Difficulty: byte; - SongArtist: WideString; - SongTitle: WideString; + SongArtist: UTF8String; + SongTitle: UTF8String; end; TStatResultBestSingers = class(TStatResult) public - Player: WideString; + Player: UTF8String; AverageScore: word; end; TStatResultMostSungSong = class(TStatResult) public - Artist: WideString; - Title: WideString; + Artist: UTF8String; + Title: UTF8String; TimesSung: word; end; TStatResultMostPopBand = class(TStatResult) public - ArtistName: WideString; + ArtistName: UTF8String; TimesSungTot: word; end; @@ -88,18 +89,18 @@ type TDataBaseSystem = class private ScoreDB: TSQLiteDatabase; - fFilename: string; + fFilename: IPath; function GetVersion(): integer; procedure SetVersion(Version: integer); public - property Filename: string read fFilename; + property Filename: IPath read fFilename; destructor Destroy; override; - procedure Init(const Filename: string); + procedure Init(const Filename: IPath); procedure ReadScore(Song: TSong); - procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); + procedure AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer); procedure WriteScore(Song: TSong); function GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList; @@ -131,49 +132,49 @@ const cUS_Statistics_Info = 'us_statistics_info'; (** - * Opens Database and Create Tables if not Exist + * Open database and create tables if they do not exist *) -procedure TDataBaseSystem.Init(const Filename: string); +procedure TDataBaseSystem.Init(const Filename: IPath); var Version: integer; - finalizeConvertion: boolean; + finalizeConversion: boolean; begin if Assigned(ScoreDB) then Exit; - Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init'); + Log.LogStatus('Initializing database: "' + Filename.ToNative + '"', 'TDataBaseSystem.Init'); try - // Open Database - ScoreDB := TSQLiteDatabase.Create(Filename); + // open database + ScoreDB := TSQLiteDatabase.Create(Filename.ToUTF8); fFilename := Filename; Version := GetVersion(); - //Adds Table cUS_Statistics_Info - //Happens from Convertion 1.01 -> 1.1 + // add Table cUS_Statistics_Info + // needed in the conversion from 1.01 to 1.1 if not ScoreDB.TableExists(cUS_Statistics_Info) then begin - Log.LogInfo('Outdated song-database file found - Missing Table"'+cUS_Statistics_Info+'"', 'TDataBaseSystem.Init'); - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' + + Log.LogInfo('Outdated song database found - missing table"' + cUS_Statistics_Info + '"', 'TDataBaseSystem.Init'); + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Statistics_Info + '] (' + '[ResetTime] INTEGER' + ');'); // insert creation timestamp - ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' + + ScoreDB.ExecSQL(Format('INSERT INTO [' + cUS_Statistics_Info + '] ' + '([ResetTime]) VALUES(%d);', [DateTimeToUnix(Now())])); end; - //Converts data of 1.01 -> 1.1 - //Part #1 - prearrangement - finalizeConvertion := false; + // convert data from 1.01 to 1.1 + // part #1 - prearrangement + finalizeConversion := false; if (Version = 0) AND ScoreDB.TableExists('US_Scores') then begin - //Rename old Tables - to be able to insert new table-structures + // rename old tables - to be able to insert new table structures ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;'); ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;'); - finalizeConvertion := true; //means: convertion has to be done! + finalizeConversion := true; // means: conversion has to be done! end; // Set version number after creation @@ -187,14 +188,14 @@ begin // types are used (especially FieldAsInteger). Also take care to write the // types in upper-case letters although SQLite does not care about this - // SQLiteTable3 is very sensitive in this regard. - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Scores + '] (' + '[SongID] INTEGER NOT NULL, ' + '[Difficulty] INTEGER NOT NULL, ' + '[Player] TEXT NOT NULL, ' + '[Score] INTEGER NOT NULL' + ');'); - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' + + ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Songs + '] (' + '[ID] INTEGER PRIMARY KEY, ' + '[Artist] TEXT NOT NULL, ' + '[Title] TEXT NOT NULL, ' + @@ -202,25 +203,25 @@ begin '[Rating] INTEGER NULL' + ');'); - //Converts data of 1.01 -> 1.1 - //Part #2 - accomplishment - if finalizeConvertion then + // convert data from 1.01 to 1.1 + // part #2 - accomplishment + if finalizeConversion then begin - Log.LogInfo('Outdated song-database file found - Began Converting from V1.01 to V1.1', 'TDataBaseSystem.Init'); - //insert old values in new db-schemes (/tables) - ScoreDB.ExecSQL('INSERT INTO '+cUS_Scores+' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); - ScoreDB.ExecSQL('INSERT INTO '+cUS_Songs+' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); + Log.LogInfo('Outdated song database found - begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Init'); + // insert old values into new db-schemes (/tables) + ScoreDB.ExecSQL('INSERT INTO ' + cUS_Scores + ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); + ScoreDB.ExecSQL('INSERT INTO ' + cUS_Songs + ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); //now drop old tables ScoreDB.ExecSQL('DROP TABLE us_scores_101;'); ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); end; - //Adds Column Rating to cUS_Songs - //Just for the users of Nightly-Builds and all Developers! + // add column rating to cUS_Songs + // just for users of nightly builds and developers! if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then begin - Log.LogInfo('Outdated song-database file found - Adding Column Rating to "'+cUS_Songs+'"', 'TDataBaseSystem.Init'); - ScoreDB.ExecSQL('ALTER TABLE '+cUS_Songs+' ADD COLUMN Rating INTEGER NULL'); + Log.LogInfo('Outdated song database found - adding column rating to "' + cUS_Songs + '"', 'TDataBaseSystem.Init'); + ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN Rating INTEGER NULL'); end; except @@ -259,13 +260,13 @@ begin try // Search Song in DB TableData := ScoreDB.GetUniTable( - 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'SELECT [Difficulty], [Player], [Score] FROM [' + cUS_Scores + '] ' + 'WHERE [SongID] = (' + - 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'SELECT [ID] FROM [' + cUS_Songs + '] ' + 'WHERE [Artist] = ? AND [Title] = ? ' + 'LIMIT 1) ' + 'ORDER BY [Score] DESC LIMIT 15', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + [Song.Artist, Song.Title]); // Empty Old Scores SetLength(Song.Score[0], 0); @@ -283,7 +284,7 @@ begin SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := - UTF8Decode(TableData.FieldByName['Player']); + TableData.FieldByName['Player']; Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := TableData.FieldAsInteger(TableData.FieldIndex['Score']); end; @@ -305,7 +306,7 @@ end; (** * Adds one new score to DB *) -procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer); +procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer); var ID: integer; TableData: TSQLiteTable; @@ -322,35 +323,35 @@ begin try ID := ScoreDB.GetTableValue( - 'SELECT [ID] FROM ['+cUS_Songs+'] ' + + 'SELECT [ID] FROM [' + cUS_Songs + '] ' + 'WHERE [Artist] = ? AND [Title] = ?', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + [Song.Artist, Song.Title]); if (ID = 0) then begin // Create song if it does not exist ScoreDB.ExecSQL( - 'INSERT INTO ['+cUS_Songs+'] ' + + 'INSERT INTO [' + cUS_Songs + '] ' + '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' + '(NULL, ?, ?, 0);', - [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]); + [Song.Artist, Song.Title]); // Get song-ID ID := ScoreDB.GetLastInsertRowID(); end; // Create new entry ScoreDB.ExecSQL( - 'INSERT INTO ['+cUS_Scores+'] ' + + 'INSERT INTO [' + cUS_Scores + '] ' + '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' + '(?, ?, ?, ?);', - [ID, Level, UTF8Encode(Name), Score]); + [ID, Level, Name, Score]); // Delete last position when there are more than 5 entrys. // Fixes crash when there are > 5 ScoreEntrys // Note: GetUniTable is not applicable here, as the results are used while // table entries are deleted. TableData := ScoreDB.GetTable( - 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' + + 'SELECT [Player], [Score] FROM [' + cUS_Scores + '] ' + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + - '[Difficulty] = ' + InttoStr(Level) +' ' + + '[Difficulty] = ' + InttoStr(Level) + ' ' + 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5'); while (not TableData.EOF) do @@ -360,7 +361,7 @@ begin // an automatic cast of this field to the TEXT type (although it might even // work that way). ScoreDB.ExecSQL( - 'DELETE FROM ['+cUS_Scores+'] ' + + 'DELETE FROM [' + cUS_Scores + '] ' + 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + '[Difficulty] = ' + InttoStr(Level) +' AND ' + '[Player] = ? AND ' + @@ -378,8 +379,8 @@ begin end; (** - * Not needed with new System. - * Used for increment played count + * Not needed with new system. + * Used to increment played count *) procedure TDataBaseSystem.WriteScore(Song: TSong); begin @@ -389,10 +390,10 @@ begin try // Increase TimesPlayed ScoreDB.ExecSQL( - 'UPDATE ['+cUS_Songs+'] ' + + 'UPDATE [' + cUS_Songs + '] ' + 'SET [TimesPlayed] = [TimesPlayed] + 1 ' + 'WHERE [Title] = ? AND [Artist] = ?;', - [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]); + [Song.Title, Song.Artist]); except on E: Exception do Log.LogError(E.Message, 'TDataBaseSystem.WriteScore'); end; @@ -420,19 +421,19 @@ begin // Create query case Typ of stBestScores: begin - Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' + - 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]'; + Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM [' + cUS_Scores + '] ' + + 'INNER JOIN [' + cUS_Songs + '] ON ([SongID] = [ID]) ORDER BY [Score]'; end; stBestSingers: begin - Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' + + Query := 'SELECT [Player], ROUND(AVG([Score])) FROM [' + cUS_Scores + '] ' + 'GROUP BY [Player] ORDER BY AVG([Score])'; end; stMostSungSong: begin - Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' + + Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM [' + cUS_Songs + '] ' + 'ORDER BY [TimesPlayed]'; end; stMostPopBand: begin - Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' + + Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM [' + cUS_Songs + '] ' + 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])'; end; end; @@ -465,18 +466,18 @@ begin Stat := TStatResultBestScores.Create; with TStatResultBestScores(Stat) do begin - Singer := UTF8Decode(TableData.Fields[0]); + Singer := TableData.Fields[0]; Difficulty := TableData.FieldAsInteger(1); Score := TableData.FieldAsInteger(2); - SongArtist := UTF8Decode(TableData.Fields[3]); - SongTitle := UTF8Decode(TableData.Fields[4]); + SongArtist := TableData.Fields[3]; + SongTitle := TableData.Fields[4]; end; end; stBestSingers: begin Stat := TStatResultBestSingers.Create; with TStatResultBestSingers(Stat) do begin - Player := UTF8Decode(TableData.Fields[0]); + Player := TableData.Fields[0]; AverageScore := TableData.FieldAsInteger(1); end; end; @@ -484,8 +485,8 @@ begin Stat := TStatResultMostSungSong.Create; with TStatResultMostSungSong(Stat) do begin - Artist := UTF8Decode(TableData.Fields[0]); - Title := UTF8Decode(TableData.Fields[1]); + Artist := TableData.Fields[0]; + Title := TableData.Fields[1]; TimesSung := TableData.FieldAsInteger(2); end; end; @@ -493,7 +494,7 @@ begin Stat := TStatResultMostPopBand.Create; with TStatResultMostPopBand(Stat) do begin - ArtistName := UTF8Decode(TableData.Fields[0]); + ArtistName := TableData.Fields[0]; TimesSungTot := TableData.FieldAsInteger(1); end; end @@ -524,7 +525,7 @@ end; (** * Gets total number of entrys for a stats query *) -function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): cardinal; +function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): cardinal; var Query: string; begin @@ -537,13 +538,13 @@ begin // Create query case Typ of stBestScores: - Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];'; + Query := 'SELECT COUNT([SongID]) FROM [' + cUS_Scores + '];'; stBestSingers: - Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];'; + Query := 'SELECT COUNT(DISTINCT [Player]) FROM [' + cUS_Scores + '];'; stMostSungSong: - Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];'; + Query := 'SELECT COUNT([ID]) FROM [' + cUS_Songs + '];'; stMostPopBand: - Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];'; + Query := 'SELECT COUNT(DISTINCT [Artist]) FROM [' + cUS_Songs + '];'; end; Result := ScoreDB.GetTableValue(Query); @@ -566,7 +567,7 @@ begin Exit; try - Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];'; + Query := 'SELECT [ResetTime] FROM [' + cUS_Statistics_Info + '];'; Result := UnixToDateTime(ScoreDB.GetTableValue(Query)); except on E: Exception do Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset'); diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index ef9d8dd6..0eacd1f9 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -74,7 +74,7 @@ type procedure SetSize(Value: real); procedure SetSelected(Value: integer); procedure SetFontStyle(Value: integer); - procedure AddWord(Text: string); + procedure AddWord(Text: UTF8String); procedure Refresh; public ColR: real; @@ -179,7 +179,7 @@ begin FontStyleI := Value; end; -procedure TEditorLyrics.AddWord(Text: string); +procedure TEditorLyrics.AddWord(Text: UTF8String); var WordNum: integer; begin diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index 0495dfbb..a46d4e0d 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -34,24 +34,23 @@ interface uses SysUtils, + Classes, ULog, UMusic, USongs, - USong; + USong, + UPath; procedure ResetSingTemp; -function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; +type + TSaveSongResult = (ssrOK, ssrFileError, ssrEncodingError); -var - SongFile: TextFile; // all procedures in this unit operates on this file - FileLineNo: integer; //Line which is readed at Last, for error reporting - - // variables available for all procedures - Base : array[0..1] of integer; - Rel : array[0..1] of integer; - Mult : integer = 1; - MultBPM : integer = 4; +{** + * Throws a TEncodingException if the song's fields cannot be encoded in the + * requested encoding. + *} +function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult; implementation @@ -59,7 +58,9 @@ uses TextGL, UIni, UNote, - UPlatform; + UPlatform, + UUnicodeUtils, + UTextEncoding; //-------------------- // Resets the temporary Sentence Arrays for each Player and some other Variables @@ -77,101 +78,112 @@ begin Player[Count].LengthNote := 0; Player[Count].HighNote := -1; end; - - (* FIXME - //Reset Path and Filename Values to Prevent Errors in Editor - if assigned( CurrentSong ) then - begin - SetLength(CurrentSong.BPM, 0); - CurrentSong.Path := ''; - CurrentSong.FileName := ''; - end; - *) - -// CurrentSong := nil; end; - //-------------------- // Saves a Song //-------------------- -function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean; +function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult; var C: integer; N: integer; - S: string; + S: AnsiString; B: integer; - RelativeSubTime: integer; - NoteState: String; + RelativeSubTime: integer; + NoteState: AnsiString; + SongFile: TTextFileStream; + + function EncodeToken(const Str: UTF8String): RawByteString; + var + Success: boolean; + begin + Success := EncodeStringUTF8(Str, Result, Song.Encoding); + if (not Success) then + SaveSong := ssrEncodingError; + end; begin -// Relative := true; // override (idea - use shift+S to save with relative) - AssignFile(SongFile, Name); - Rewrite(SongFile); - - Writeln(SongFile, '#TITLE:' + Song.Title + ''); - Writeln(SongFile, '#ARTIST:' + Song.Artist); - - if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator); - if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition); - if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre); - if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language); - - Writeln(SongFile, '#MP3:' + Song.Mp3); - - if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover); - if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background); - if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video); - if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); - if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution)); - if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP)); - if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start)); - if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish)); - if Relative then Writeln(SongFile, '#RELATIVE:yes'); - - Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); - Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP)); - - RelativeSubTime := 0; - for B := 1 to High(CurrentSong.BPM) do - Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4)); - - for C := 0 to Lines.High do begin - for N := 0 to Lines.Line[C].HighNote do begin - with Lines.Line[C].Note[N] do begin - - - //Golden + Freestyle Note Patch - case Lines.Line[C].Note[N].NoteType of - ntFreestyle: NoteState := 'F '; - ntNormal: NoteState := ': '; - ntGolden: NoteState := '* '; - end; // case - S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text; - - - Writeln(SongFile, S); - end; // with - end; // N - - if C < Lines.High then begin // don't write end of last sentence - if not Relative then - S := '- ' + IntToStr(Lines.Line[C+1].Start) - else begin - S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) + - ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime); - RelativeSubTime := Lines.Line[C+1].Start; - end; - Writeln(SongFile, S); + // Relative := true; // override (idea - use shift+S to save with relative) + Result := ssrOK; + + try + SongFile := TMemTextFileStream.Create(Name, fmCreate); + try + if (Song.Encoding = encUTF8) then + SongFile.WriteString(UTF8_BOM); + + SongFile.WriteLine('#ENCODING:' + EncodingName(Song.Encoding)); + SongFile.WriteLine('#TITLE:' + EncodeToken(Song.Title)); + SongFile.WriteLine('#ARTIST:' + EncodeToken(Song.Artist)); + + if Song.Creator <> '' then SongFile.WriteLine('#CREATOR:' + EncodeToken(Song.Creator)); + if Song.Edition <> 'Unknown' then SongFile.WriteLine('#EDITION:' + EncodeToken(Song.Edition)); + if Song.Genre <> 'Unknown' then SongFile.WriteLine('#GENRE:' + EncodeToken(Song.Genre)); + if Song.Language <> 'Unknown' then SongFile.WriteLine('#LANGUAGE:' + EncodeToken(Song.Language)); + + SongFile.WriteLine('#MP3:' + EncodeToken(Song.Mp3.ToUTF8)); + if Song.Cover.IsSet then SongFile.WriteLine('#COVER:' + EncodeToken(Song.Cover.ToUTF8)); + if Song.Background.IsSet then SongFile.WriteLine('#BACKGROUND:' + EncodeToken(Song.Background.ToUTF8)); + if Song.Video.IsSet then SongFile.WriteLine('#VIDEO:' + EncodeToken(Song.Video.ToUTF8)); + + if Song.VideoGAP <> 0 then SongFile.WriteLine('#VIDEOGAP:' + FloatToStr(Song.VideoGAP)); + if Song.Resolution <> 4 then SongFile.WriteLine('#RESOLUTION:' + IntToStr(Song.Resolution)); + if Song.NotesGAP <> 0 then SongFile.WriteLine('#NOTESGAP:' + IntToStr(Song.NotesGAP)); + if Song.Start <> 0 then SongFile.WriteLine('#START:' + FloatToStr(Song.Start)); + if Song.Finish <> 0 then SongFile.WriteLine('#END:' + IntToStr(Song.Finish)); + if Relative then SongFile.WriteLine('#RELATIVE:yes'); + + SongFile.WriteLine('#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); + SongFile.WriteLine('#GAP:' + FloatToStr(Song.GAP)); + + RelativeSubTime := 0; + for B := 1 to High(Song.BPM) do + SongFile.WriteLine('B ' + FloatToStr(Song.BPM[B].StartBeat) + ' ' + + FloatToStr(Song.BPM[B].BPM/4)); + + for C := 0 to Lines.High do + begin + for N := 0 to Lines.Line[C].HighNote do + begin + with Lines.Line[C].Note[N] do + begin + //Golden + Freestyle Note Patch + case Lines.Line[C].Note[N].NoteType of + ntFreestyle: NoteState := 'F '; + ntNormal: NoteState := ': '; + ntGolden: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + + IntToStr(Length) + ' ' + + IntToStr(Tone) + ' ' + + EncodeToken(Text); + + SongFile.WriteLine(S); + end; // with + end; // N + + if C < Lines.High then // don't write end of last sentence + begin + if not Relative then + S := '- ' + IntToStr(Lines.Line[C+1].Start) + else + begin + S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime); + RelativeSubTime := Lines.Line[C+1].Start; + end; + SongFile.WriteLine(S); + end; + end; // C + + SongFile.WriteLine('E'); + finally + SongFile.Free; end; - - end; // C - - - Writeln(SongFile, 'E'); - CloseFile(SongFile); - - Result := true; + except + Result := ssrFileError; + end; end; end. + diff --git a/src/base/UFilesystem.pas b/src/base/UFilesystem.pas new file mode 100644 index 00000000..d4972df5 --- /dev/null +++ b/src/base/UFilesystem.pas @@ -0,0 +1,692 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UFilesystem; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + {$IFDEF MSWINDOWS} + Windows, + TntSysUtils, + {$ENDIF} + UPath; + +type + {$IFDEF MSWINDOWS} + TSytemSearchRec = TSearchRecW; + {$ELSE} + TSytemSearchRec = TSearchRec; + {$ENDIF} + + TFileInfo = record + Time: integer; // timestamp + Size: int64; // file size (byte) + Attr: integer; // file attributes + Name: IPath; // basename with extension + end; + + {** + * Iterates through the search results retrieved by FileFind(). + * Example usage: + * while(Iter.HasNext()) do + * SearchRec := Iter.Next(); + *} + IFileIterator = interface + function HasNext(): boolean; + function Next(): TFileInfo; + end; + + {** + * Wrapper for SysUtils file functions. + * For documentation and examples, check the SysUtils equivalent. + *} + IFileSystem = interface + function ExpandFileName(const FileName: IPath): IPath; + function FileCreate(const FileName: IPath): THandle; + function DirectoryCreate(const Dir: IPath): boolean; + function FileOpen(const FileName: IPath; Mode: longword): THandle; + function FileAge(const FileName: IPath): integer; overload; + function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload; + + function DirectoryExists(const Name: IPath): boolean; + + {** + * On Windows: returns true only for files (not directories) + * On Apple/Unix: returns true for all kind of files (even directories) + * @seealso SysUtils.FileExists() + *} + function FileExists(const Name: IPath): boolean; + + function FileGetAttr(const FileName: IPath): Cardinal; + function FileSetAttr(const FileName: IPath; Attr: integer): boolean; + function FileIsReadOnly(const FileName: IPath): boolean; + function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean; + function FileIsAbsolute(const FileName: IPath): boolean; + function ForceDirectories(const Dir: IPath): boolean; + function RenameFile(const OldName, NewName: IPath): boolean; + function DeleteFile(const FileName: IPath): boolean; + function RemoveDir(const Dir: IPath): boolean; + + {** + * Copies file Source to Target. If FailIfExists is true, the file is not + * copied if it already exists. + * Returns true if the file was successfully copied. + *} + function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean; + + function ExtractFileDrive(const FileName: IPath): IPath; + function ExtractFilePath(const FileName: IPath): IPath; + function ExtractFileDir(const FileName: IPath): IPath; + function ExtractFileName(const FileName: IPath): IPath; + function ExtractFileExt(const FileName: IPath): IPath; + function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath; + + function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath; + + function IncludeTrailingPathDelimiter(const FileName: IPath): IPath; + function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath; + + {** + * Searches for a file with filename Name in the directories given in DirList. + *} + function FileSearch(const Name: IPath; DirList: array of IPath): IPath; + + {** + * More convenient version of FindFirst/Next/Close with iterator support. + *} + function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator; + + {** + * Old style search functions. Use FileFind() instead. + *} + function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer; + function FindNext(var F: TSytemSearchRec): integer; + procedure FindClose(var F: TSytemSearchRec); + + function GetCurrentDir: IPath; + function SetCurrentDir(const Dir: IPath): boolean; + + {** + * Returns true if the filesystem is case-sensitive. + *} + function IsCaseSensitive(): boolean; + end; + + function FileSystem(): IFileSystem; + +implementation + +type + TFileSystemImpl = class(TInterfacedObject, IFileSystem) + public + function ExpandFileName(const FileName: IPath): IPath; + function FileCreate(const FileName: IPath): THandle; + function DirectoryCreate(const Dir: IPath): boolean; + function FileOpen(const FileName: IPath; Mode: longword): THandle; + function FileAge(const FileName: IPath): integer; overload; + function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload; + function DirectoryExists(const Name: IPath): boolean; + function FileExists(const Name: IPath): boolean; + function FileGetAttr(const FileName: IPath): Cardinal; + function FileSetAttr(const FileName: IPath; Attr: integer): boolean; + function FileIsReadOnly(const FileName: IPath): boolean; + function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean; + function FileIsAbsolute(const FileName: IPath): boolean; + function ForceDirectories(const Dir: IPath): boolean; + function RenameFile(const OldName, NewName: IPath): boolean; + function DeleteFile(const FileName: IPath): boolean; + function RemoveDir(const Dir: IPath): boolean; + function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean; + + function ExtractFileDrive(const FileName: IPath): IPath; + function ExtractFilePath(const FileName: IPath): IPath; + function ExtractFileDir(const FileName: IPath): IPath; + function ExtractFileName(const FileName: IPath): IPath; + function ExtractFileExt(const FileName: IPath): IPath; + function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath; + function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath; + function IncludeTrailingPathDelimiter(const FileName: IPath): IPath; + function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath; + + function FileSearch(const Name: IPath; DirList: array of IPath): IPath; + function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator; + + function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer; + function FindNext(var F: TSytemSearchRec): integer; + procedure FindClose(var F: TSytemSearchRec); + + function GetCurrentDir: IPath; + function SetCurrentDir(const Dir: IPath): boolean; + + function IsCaseSensitive(): boolean; + end; + + TFileIterator = class(TInterfacedObject, IFileIterator) + private + fHasNext: boolean; + fSearchRec: TSytemSearchRec; + public + constructor Create(const FilePattern: IPath; Attr: integer); + destructor Destroy(); override; + + function HasNext(): boolean; + function Next(): TFileInfo; + end; + + +var + FileSystem_Singleton: IFileSystem; + +function FileSystem(): IFileSystem; +begin + Result := FileSystem_Singleton; +end; + +function TFileSystemImpl.FileFind(const FilePattern: IPath; Attr: integer): IFileIterator; +begin + Result := TFileIterator.Create(FilePattern, Attr); +end; + +function TFileSystemImpl.IsCaseSensitive(): boolean; +begin + // Windows and Mac OS X do not have case sensitive file systems + {$IF Defined(MSWINDOWS) or Defined(DARWIN)} + Result := false; + {$ELSE} + Result := true; + {$IFEND} +end; + +function TFileSystemImpl.FileIsAbsolute(const FileName: IPath): boolean; +var + NameStr: UTF8String; +begin + Result := true; + NameStr := FileName.ToUTF8(); + + {$IFDEF MSWINDOWS} + // check if drive is given 'C:...' + if (FileName.GetDrive().ToUTF8 <> '') then + Exit; + // check if path starts with '\\' + if (Length(NameStr) >= 2) and + (NameStr[1] = PathDelim) and (NameStr[2] = PathDelim) then + Exit; + {$ELSE} // Unix based systems + // check if root dir given '/...' + if (Length(NameStr) >= 1) and (NameStr[1] = PathDelim) then + Exit; + {$ENDIF} + + Result := false; +end; + +{$IFDEF MSWINDOWS} + +function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath; +begin + Result := Path(WideExpandFileName(FileName.ToWide())); +end; + +function TFileSystemImpl.FileCreate(const FileName: IPath): THandle; +begin + Result := WideFileCreate(FileName.ToWide()); +end; + +function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean; +begin + Result := WideCreateDir(Dir.ToWide()); +end; + +function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle; +begin + Result := WideFileOpen(FileName.ToWide(), Mode); +end; + +function TFileSystemImpl.FileAge(const FileName: IPath): integer; +begin + Result := WideFileAge(FileName.ToWide()); +end; + +function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; +begin + Result := WideFileAge(FileName.ToWide(), FileDateTime); +end; + +function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean; +begin + Result := WideDirectoryExists(Name.ToWide()); +end; + +function TFileSystemImpl.FileExists(const Name: IPath): boolean; +begin + Result := WideFileExists(Name.ToWide()); +end; + +function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal; +begin + Result := WideFileGetAttr(FileName.ToWide()); +end; + +function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean; +begin + Result := WideFileSetAttr(FileName.ToWide(), Attr); +end; + +function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean; +begin + Result := WideFileIsReadOnly(FileName.ToWide()); +end; + +function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean; +begin + Result := WideFileSetReadOnly(FileName.ToWide(), ReadOnly); +end; + +function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean; +begin + Result := WideForceDirectories(Dir.ToWide()); +end; + +function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath; +var + I: integer; + DirListStr: WideString; +begin + DirListStr := ''; + for I := 0 to High(DirList) do + begin + if (I > 0) then + DirListStr := DirListStr + PathSep; + DirListStr := DirListStr + DirList[I].ToWide(); + end; + Result := Path(WideFileSearch(Name.ToWide(), DirListStr)); +end; + +function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean; +begin + Result := WideRenameFile(OldName.ToWide(), NewName.ToWide()); +end; + +function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean; +begin + Result := WideDeleteFile(FileName.ToWide()); +end; + +function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean; +begin + Result := WideRemoveDir(Dir.ToWide()); +end; + +function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean; +begin + Result := WideCopyFile(Source.ToWide(), Target.ToWide(), FailIfExists); +end; + +function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath; +begin + Result := Path(WideExtractFileDrive(FileName.ToWide())); +end; + +function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath; +begin + Result := Path(WideExtractFilePath(FileName.ToWide())); +end; + +function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath; +begin + Result := Path(WideExtractFileDir(FileName.ToWide())); +end; + +function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath; +begin + Result := Path(WideExtractFileName(FileName.ToWide())); +end; + +function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath; +begin + Result := Path(WideExtractFileExt(FileName.ToWide())); +end; + +function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath; +begin + Result := Path(WideExtractRelativePath(BaseName.ToWide(), FileName.ToWide())); +end; + +function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath; +begin + Result := Path(WideChangeFileExt(FileName.ToWide(), Extension.ToWide())); +end; + +function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath; +begin + Result := Path(WideIncludeTrailingPathDelimiter(FileName.ToWide())); +end; + +function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath; +begin + Result := Path(WideExcludeTrailingPathDelimiter(FileName.ToWide())); +end; + +function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer; +begin + Result := WideFindFirst(FilePattern.ToWide(), Attr, F); +end; + +function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer; +begin + Result := WideFindNext(F); +end; + +procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec); +begin + WideFindClose(F); +end; + +function TFileSystemImpl.GetCurrentDir: IPath; +begin + Result := Path(WideGetCurrentDir()); +end; + +function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean; +begin + Result := WideSetCurrentDir(Dir.ToWide()); +end; + +{$ELSE} // UNIX + +function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExpandFileName(FileName.ToNative())); +end; + +function TFileSystemImpl.FileCreate(const FileName: IPath): THandle; +begin + Result := SysUtils.FileCreate(FileName.ToNative()); +end; + +function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean; +begin + Result := SysUtils.CreateDir(Dir.ToNative()); +end; + +function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle; +begin + Result := SysUtils.FileOpen(FileName.ToNative(), Mode); +end; + +function TFileSystemImpl.FileAge(const FileName: IPath): integer; +begin + Result := SysUtils.FileAge(FileName.ToNative()); +end; + +function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; +var + FileDate: integer; +begin + FileDate := SysUtils.FileAge(FileName.ToNative()); + Result := (FileDate <> -1); + if (Result) then + FileDateTime := FileDateToDateTime(FileDate); +end; + +function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean; +begin + Result := SysUtils.DirectoryExists(Name.ToNative()); +end; + +function TFileSystemImpl.FileExists(const Name: IPath): boolean; +begin + Result := SysUtils.FileExists(Name.ToNative()); +end; + +function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal; +begin + Result := SysUtils.FileGetAttr(FileName.ToNative()); +end; + +function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean; +begin + Result := (SysUtils.FileSetAttr(FileName.ToNative(), Attr) = 0); +end; + +function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean; +begin + Result := SysUtils.FileIsReadOnly(FileName.ToNative()); +end; + +function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean; +begin + Result := (SysUtils.FileSetAttr(FileName.ToNative(), faReadOnly) = 0); +end; + +function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean; +begin + Result := SysUtils.ForceDirectories(Dir.ToNative()); +end; + +function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath; +var + I: integer; + DirListStr: AnsiString; +begin + DirListStr := ''; + for I := 0 to High(DirList) do + begin + if (I > 0) then + DirListStr := DirListStr + PathSep; + DirListStr := DirListStr + DirList[I].ToNative(); + end; + Result := Path(SysUtils.FileSearch(Name.ToNative(), DirListStr)); +end; + +function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean; +begin + Result := SysUtils.RenameFile(OldName.ToNative(), NewName.ToNative()); +end; + +function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean; +begin + Result := SysUtils.DeleteFile(FileName.ToNative()); +end; + +function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean; +begin + Result := SysUtils.RemoveDir(Dir.ToNative()); +end; + +function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean; +const + COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption +var + SourceFile, TargetFile: TFileStream; + FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. + NumberOfBytes: integer; // number of bytes read from SourceFile +begin + Result := false; + SourceFile := nil; + TargetFile := nil; + + // if overwrite is disabled return if the target file already exists + if (FailIfExists and FileExists(Target)) then + Exit; + + try + try + // open source and target file (might throw an exception on error) + SourceFile := TFileStream.Create(Source.ToNative(), fmOpenRead); + TargetFile := TFileStream.Create(Target.ToNative(), fmCreate or fmOpenWrite); + + while true do + begin + // read a block from the source file and check for errors or EOF + NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer)); + if (NumberOfBytes <= 0) then + Break; + // write block to target file and check if everything was written + if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then + Exit; + end; + except + Exit; + end; + finally + SourceFile.Free; + TargetFile.Free; + end; + + Result := true; +end; + +function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractFileDrive(FileName.ToNative())); +end; + +function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractFilePath(FileName.ToNative())); +end; + +function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractFileDir(FileName.ToNative())); +end; + +function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractFileName(FileName.ToNative())); +end; + +function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractFileExt(FileName.ToNative())); +end; + +function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExtractRelativePath(BaseName.ToNative(), FileName.ToNative())); +end; + +function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath; +begin + Result := Path(SysUtils.ChangeFileExt(FileName.ToNative(), Extension.ToNative())); +end; + +function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.IncludeTrailingPathDelimiter(FileName.ToNative())); +end; + +function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath; +begin + Result := Path(SysUtils.ExcludeTrailingPathDelimiter(FileName.ToNative())); +end; + +function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer; +begin + Result := SysUtils.FindFirst(FilePattern.ToNative(), Attr, F); +end; + +function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer; +begin + Result := SysUtils.FindNext(F); +end; + +procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec); +begin + SysUtils.FindClose(F); +end; + +function TFileSystemImpl.GetCurrentDir: IPath; +begin + Result := Path(SysUtils.GetCurrentDir()); +end; + +function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean; +begin + Result := SysUtils.SetCurrentDir(Dir.ToNative()); +end; + +{$ENDIF} + + +{ TFileIterator } + +constructor TFileIterator.Create(const FilePattern: IPath; Attr: integer); +begin + inherited Create(); + fHasNext := (FileSystem.FindFirst(FilePattern, Attr, fSearchRec) = 0); +end; + +destructor TFileIterator.Destroy(); +begin + FileSystem.FindClose(fSearchRec); + inherited; +end; + +function TFileIterator.HasNext(): boolean; +begin + Result := fHasNext; +end; + +function TFileIterator.Next(): TFileInfo; +begin + if (not fHasNext) then + begin + // Note: do not use FillChar() on records with ref-counted fields + Result.Time := 0; + Result.Size := 0; + Result.Attr := 0; + Result.Name := nil; + Exit; + end; + + Result.Time := fSearchRec.Time; + Result.Size := fSearchRec.Size; + Result.Attr := fSearchRec.Attr; + Result.Name := Path(fSearchRec.Name); + + // fetch next entry + fHasNext := (FileSystem.FindNext(fSearchRec) = 0); +end; + + +initialization + FileSystem_Singleton := TFileSystemImpl.Create; + +finalization + FileSystem_Singleton := nil; + +end. diff --git a/src/base/UFont.pas b/src/base/UFont.pas index a72bca21..72409ac1 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -47,12 +47,14 @@ uses glext, glu, sdl, + Math, + Classes, + SysUtils, + UUnicodeUtils, {$IFDEF BITMAP_FONT} UTexture, {$ENDIF} - Math, - Classes, - SysUtils; + UPath; type @@ -60,7 +62,7 @@ type TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; TGLubyteDynArray = array of GLubyte; - TWideStringArray = array of WideString; + TUCS4StringArray = array of UCS4String; TGLColor = packed record case byte of @@ -126,34 +128,34 @@ type {** * Splits lines in Text seperated by newline (char-code #13). - * @param Text UTF-8 encoded string - * @param Lines splitted WideString lines + * @param Text UCS-4 encoded string + * @param Lines splitted UCS4String lines *} - procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray); + procedure SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); {** - * Print an array of WideStrings. Each array-item is a line of text. + * Print an array of UCS4Strings. Each array-item is a line of text. * Lines of text are seperated by the line-spacing. * This is the base function for all text drawing. *} - procedure Print(const Text: TWideStringArray); overload; virtual; + procedure Print(const Text: TUCS4StringArray); overload; virtual; {** * Draws an underline. *} - procedure DrawUnderline(const Text: WideString); virtual; + procedure DrawUnderline(const Text: UCS4String); virtual; {** * Renders (one) line of text. *} - procedure Render(const Text: WideString); virtual; abstract; + procedure Render(const Text: UCS4String); virtual; abstract; {** * Returns the bounds of text-lines contained in Text. * @param(Advance if true the right bound is set to the advance instead * of the minimal right bound.) *} - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; {** * Resets all user settings to default values. @@ -188,9 +190,11 @@ type {** * Prints a text. *} + procedure Print(const Text: UCS4String); overload; + {** UTF-16 version of @link(Print) } procedure Print(const Text: WideString); overload; {** UTF-8 version of @link(Print) } - procedure Print(const Text: string); overload; + procedure Print(const Text: UTF8String); overload; {** * Calculates the bounding box (width and height) around Text. @@ -203,6 +207,8 @@ type * bigger than the text's width as it additionally contains the advance * and glyph-spacing of the last character. *} + function BBox(const Text: UCS4String; Advance: boolean = true): TBoundsDbl; overload; + {** UTF-16 version of @link(BBox) } function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload; {** UTF-8 version of @link(BBox) } function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; @@ -249,9 +255,9 @@ type /// Mipmap fonts (size[level+1] = size[level]/2) fMipmapFonts: array[0..cMaxMipmapLevel] of TFont; - procedure Render(const Text: WideString); override; - procedure Print(const Text: TWideStringArray); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + procedure Print(const Text: TUCS4StringArray); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; {** * Callback called for creation of each mipmap font. @@ -322,7 +328,7 @@ type {** * Table for storage of max. 256 glyphs. - * Used for the second cache level. Indexed by the LSB of the WideChar + * Used for the second cache level. Indexed by the LSB of the UCS4Char * char-code. *} PGlyphTable = ^TGlyphTable; @@ -332,7 +338,7 @@ type * Cache for glyphs of a single font. * The cached glyphs are stored inside a hash-list. * Hashing is performed in two steps: - * 1. the least significant byte (LSB) of the WideChar character code + * 1. the least significant byte (LSB) of the UCS4Char character code * is removed (shr 8) and the result (we call it BaseCode here) looked up in * the hash-list. * 2. Each entry of the hash-list contains a table with max. 256 entries. @@ -359,22 +365,22 @@ type * Add glyph Glyph with char-code ch to the cache. * @returns @true on success, @false otherwise *} - function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; + function AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; {** * Removes the glyph with char-code ch from the cache. *} - procedure DeleteGlyph(ch: WideChar); + procedure DeleteGlyph(ch: UCS4Char); {** * Removes the glyph with char-code ch from the cache. *} - function GetGlyph(ch: WideChar): TGlyph; + function GetGlyph(ch: UCS4Char): TGlyph; {** * Checks if a glyph with char-code ch is cached. *} - function HasGlyph(ch: WideChar): boolean; + function HasGlyph(ch: UCS4Char): boolean; {** * Remove and free all cached glyphs. If KeepBaseSet is set to @@ -408,13 +414,13 @@ type * Retrieves a cached glyph with char-code ch from cache. * If the glyph is not already cached, it is loaded with LoadGlyph(). *} - function GetGlyph(ch: WideChar): TGlyph; + function GetGlyph(ch: UCS4Char): TGlyph; {** * Callback to create (load) a glyph with char-code ch. * Implemented by subclasses. *} - function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract; + function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract; public constructor Create(); @@ -436,6 +442,7 @@ type *} TFTGlyph = class(TGlyph) private + fCharCode: UCS4Char; //**< Char code fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) fDisplayList: GLuint; //**< Display-list ID fTexture: GLuint; //**< Texture ID @@ -458,7 +465,7 @@ type * The bitmap must be 2* pixels wider and higher than the * original glyph's bitmap with the latter centered in it. *} - procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); + procedure StrokeBorder(var Glyph: FT_Glyph); {** * Creates an OpenGL texture (and display list) for the glyph. @@ -477,7 +484,7 @@ type * Creates a glyph with char-code ch from font Font. * @param LoadFlags flags passed to FT_Load_Glyph() *} - constructor Create(Font: TFTFont; ch: WideChar; Outset: single; + constructor Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); destructor Destroy(); override; @@ -490,6 +497,8 @@ type property CharIndex: FT_UInt read fCharIndex; end; + TFontPart = ( fpNone, fpInner, fpOutline ); + {** * Freetype font class. *} @@ -498,19 +507,20 @@ type procedure ResetIntern(); protected - fFilename: string; //**< filename of the font-file + fFilename: IPath; //**< filename of the font-file fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) fFace: FT_Face; //**< Holds the height of the font fLoadFlags: FT_Int32; //**< FT glpyh load-flags fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing + fPart: TFontPart; //**< indicates the part of an outline font {** @seealso TCachedFont.LoadGlyph } - function LoadGlyph(ch: WideChar): TGlyph; override; + function LoadGlyph(ch: UCS4Char): TGlyph; override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -528,7 +538,7 @@ type * @param LoadFlags flags passed to FT_Load_Glyph() * @raises Exception if the font-file could not be loaded *} - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; Outset: single = 0.0; LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); @@ -558,7 +568,7 @@ type * The extrusion in pixels is Size*OutsetAmount * (0.0 -> no extrusion, 0.1 -> 10%). *} - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single = 0.0; UseMipmaps: boolean = true); @@ -576,7 +586,7 @@ type *} TFTOutlineFont = class(TFont) private - fFilename: string; + fFilename: IPath; fSize: integer; fOutset: single; fInnerFont, fOutlineFont: TFTFont; @@ -585,9 +595,9 @@ type procedure ResetIntern(); protected - procedure DrawUnderline(const Text: WideString); override; - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure DrawUnderline(const Text: UCS4String); override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -603,7 +613,7 @@ type procedure SetReflectionPass(Enable: boolean); override; public - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); destructor Destroy; override; @@ -637,7 +647,7 @@ type function CreateMipmap(Level: integer; Scale: single): TFont; override; public - constructor Create(const Filename: string; + constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean = true); @@ -672,18 +682,18 @@ type procedure ResetIntern(); - procedure RenderChar(ch: WideChar; var AdvanceX: real); + procedure RenderChar(ch: UCS4Char; var AdvanceX: real); {** * Load font widths from an info file. * @param InfoFile the name of the info (.dat) file * @raises Exception if the file is corrupted *} - procedure LoadFontInfo(const InfoFile: string); + procedure LoadFontInfo(const InfoFile: IPath); protected - procedure Render(const Text: WideString); override; - function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override; + procedure Render(const Text: UCS4String); override; + function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; function GetHeight(): single; override; function GetAscender(): single; override; @@ -699,7 +709,7 @@ type * (y-axis up) and from the lower edge of the glyphs bounding box) * @param(Ascender pixels from baseline to top of highest glyph) *} - constructor Create(const Filename: string; Outline: integer; + constructor Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); destructor Destroy(); override; @@ -801,37 +811,61 @@ begin ResetIntern(); end; -procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray); +procedure TFont.SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); var - LineList: TStringList; - LineIndex: integer; + CharIndex: integer; + LineStart: integer; + LineLength: integer; + EOT: boolean; // End-Of-Text begin - // split lines on newline (there is no WideString version of ExtractStrings) - LineList := TStringList.Create(); - ExtractStrings([#13], [], PChar(Text), LineList); + // split lines on newline + SetLength(Lines, 0); + EOT := false; + LineStart := 0; + + for CharIndex := 0 to High(Text) do + begin + // check for end of text (UCS4Strings are zero-terminated) + if (CharIndex = High(Text)) then + EOT := true; + + // check for newline (carriage return (#13)) or end of text + if (Text[CharIndex] = 13) or EOT then + begin + LineLength := CharIndex - LineStart; + // check if last character was a newline + if (EOT and (LineLength = 0)) then + Break; - // create an array of WideStrins from the UTF-8 string-list - SetLength(Lines, LineList.Count); - for LineIndex := 0 to LineList.Count-1 do - Lines[LineIndex] := UTF8Decode(LineList[LineIndex]); - LineList.Free(); + // copy line (even if LineLength is 0) + SetLength(Lines, Length(Lines)+1); + Lines[High(Lines)] := UCS4Copy(Text, LineStart, LineLength); + + LineStart := CharIndex+1; + end; + end; end; -function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +function TFont.BBox(const Text: UCS4String; Advance: boolean): TBoundsDbl; var - LineArray: TWideStringArray; + LineArray: TUCS4StringArray; begin SplitLines(Text, LineArray); Result := BBox(LineArray, Advance); SetLength(LineArray, 0); end; +function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl; +begin + Result := BBox(UTF8Decode(Text), Advance); +end; + function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl; begin - Result := BBox(UTF8Encode(Text), Advance); + Result := BBox(WideStringToUCS4String(Text), Advance); end; -procedure TFont.Print(const Text: TWideStringArray); +procedure TFont.Print(const Text: TUCS4StringArray); var LineIndex: integer; begin @@ -912,21 +946,26 @@ begin glPopAttrib(); end; -procedure TFont.Print(const Text: string); +procedure TFont.Print(const Text: UCS4String); var - LineArray: TWideStringArray; + LineArray: TUCS4StringArray; begin SplitLines(Text, LineArray); Print(LineArray); SetLength(LineArray, 0); end; +procedure TFont.Print(const Text: UTF8String); +begin + Print(UTF8Decode(Text)); +end; + procedure TFont.Print(const Text: WideString); begin - Print(UTF8Encode(Text)); + Print(WideStringToUCS4String(Text)); end; -procedure TFont.DrawUnderline(const Text: WideString); +procedure TFont.DrawUnderline(const Text: UCS4String); var UnderlineY1, UnderlineY2: single; Bounds: TBoundsDbl; @@ -1194,7 +1233,7 @@ begin glScalef(MipmapScale, MipmapScale, 0); end; -procedure TScalableFont.Print(const Text: TWideStringArray); +procedure TScalableFont.Print(const Text: TUCS4StringArray); begin glPushMatrix(); @@ -1210,12 +1249,12 @@ begin glPopMatrix(); end; -procedure TScalableFont.Render(const Text: WideString); +procedure TScalableFont.Render(const Text: UCS4String); begin Assert(false, 'Unused TScalableFont.Render() was called'); end; -function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fBaseFont.BBox(Text, Advance); Result.Left := Result.Left * fScale * fAspect; @@ -1346,7 +1385,7 @@ begin inherited; end; -function TCachedFont.GetGlyph(ch: WideChar): TGlyph; +function TCachedFont.GetGlyph(ch: UCS4Char): TGlyph; begin Result := fCache.GetGlyph(ch); if (Result = nil) then @@ -1368,11 +1407,11 @@ end; *} constructor TFTFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32); var - i: WideChar; + ch: UCS4Char; begin inherited Create(); @@ -1381,10 +1420,11 @@ begin fOutset := Outset; fLoadFlags := LoadFlags; fUseDisplayLists := true; + fPart := fpNone; // load font information - if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + ''''); + if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then + raise Exception.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); // support scalable fonts only if (not FT_IS_SCALABLE(fFace)) then @@ -1400,8 +1440,8 @@ begin ResetIntern(); // pre-cache some commonly used glyphs (' ' - '~') - for i := #32 to #126 do - fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags)); + for ch := 32 to 126 do + fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags)); end; destructor TFTFont.Destroy(); @@ -1424,15 +1464,15 @@ begin ResetIntern(); end; -function TFTFont.LoadGlyph(ch: WideChar): TGlyph; +function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph; begin Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); end; -function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TFTFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; var Glyph, PrevGlyph: TFTGlyph; - TextLine: WideString; + TextLine: UCS4String; LineYOffset: single; LineIndex, CharIndex: integer; LineBounds: TBoundsDbl; @@ -1462,7 +1502,7 @@ begin LineBounds.Top := 0; // for each glyph image, compute its bounding box - for CharIndex := 1 to Length(TextLine) do + for CharIndex := 0 to LengthUCS4(TextLine)-1 do begin Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex])); if (Glyph <> nil) then @@ -1480,9 +1520,9 @@ begin LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; // update right bound - if (CharIndex < Length(TextLine)) or // not the last character - (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0) - Advance then // or in advance mode + if (CharIndex < LengthUCS4(TextLine)-1) or // not the last character + (TextLine[CharIndex] = Ord(' ')) or // on space char (Bounds.Right = 0) + Advance then // or in advance mode begin // add advance and glyph spacing LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing @@ -1534,13 +1574,13 @@ begin end; // if left or bottom bound was not set, set them to 0 - if (Result.Left = Infinity) then + if (IsInfinite(Result.Left)) then Result.Left := 0.0; - if (Result.Bottom = Infinity) then + if (IsInfinite(Result.Bottom)) then Result.Bottom := 0.0; end; -procedure TFTFont.Render(const Text: WideString); +procedure TFTFont.Render(const Text: UCS4String); var CharIndex: integer; Glyph, PrevGlyph: TFTGlyph; @@ -1550,7 +1590,7 @@ begin PrevGlyph := nil; // draw current line - for CharIndex := 1 to Length(Text) do + for CharIndex := 0 to LengthUCS4(Text)-1 do begin Glyph := TFTGlyph(GetGlyph(Text[CharIndex])); if (Assigned(Glyph)) then @@ -1606,7 +1646,7 @@ end; * TFTScalableFont *} -constructor TFTScalableFont.Create(const Filename: string; +constructor TFTScalableFont.Create(const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean); var @@ -1662,7 +1702,7 @@ end; *} constructor TFTOutlineFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; Outset: single; LoadFlags: FT_Int32); begin @@ -1673,7 +1713,9 @@ begin fOutset := Outset; fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); + fInnerFont.fPart := fpInner; fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); + fOutlineFont.fPart := fpOutline; ResetIntern(); end; @@ -1705,7 +1747,7 @@ begin ResetIntern(); end; -procedure TFTOutlineFont.DrawUnderline(const Text: WideString); +procedure TFTOutlineFont.DrawUnderline(const Text: UCS4String); var CurrentColor: TGLColor; OutlineColor: TGLColor; @@ -1730,7 +1772,7 @@ begin glPopMatrix(); end; -procedure TFTOutlineFont.Render(const Text: WideString); +procedure TFTOutlineFont.Render(const Text: UCS4String); var CurrentColor: TGLColor; OutlineColor: TGLColor; @@ -1770,7 +1812,7 @@ begin fInnerFont.FlushCache(KeepBaseSet); end; -function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fOutlineFont.BBox(Text, Advance); end; @@ -1852,7 +1894,7 @@ end; *} constructor TFTScalableOutlineFont.Create( - const Filename: string; + const Filename: IPath; Size: integer; OutsetAmount: single; UseMipmaps: boolean); var @@ -1935,82 +1977,113 @@ const *} cTexSmoothBorder = 1; -procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single); +procedure TFTGlyph.StrokeBorder(var Glyph: FT_Glyph); +var + Outline: PFT_Outline; + OuterStroker, InnerStroker: FT_Stroker; + OuterNumPoints, InnerNumPoints, GlyphNumPoints: FT_UInt; + OuterNumContours, InnerNumContours, GlyphNumContours: FT_UInt; + OuterBorder, InnerBorder: FT_StrokerBorder; + OutlineFlags: FT_Int; + UseStencil: boolean; +begin + // It is possible to extrude the borders of a glyph with FT_Glyph_Stroke + // but it will extrude the border to the outside and the inside of a glyph + // although we just want to extrude to the outside. + // FT_Glyph_StrokeBorder extrudes to the outside but also fills the interior + // (this is what we need for bold fonts). + // In both cases the inner font and outline font (border) will overlap. + // Normally this does not matter but it does if alpha blending is active. + // In this case if e.g. the inner color is set to white, the outline to red + // and alpha to 0.5 the inner part will not be white it will be pink. + + InnerStroker := nil; + OuterStroker := nil; + + // If we are to create the interior of an outlined font (fInner = true) + // we have to create two borders: + // - one extruded to the outside by fOutset pixels and + // - one extruded to the inside by almost 0 zero pixels. + // The second one is used as a stencil for the first one, clearing the + // interiour of the glyph. + // The stencil is not needed to create bold fonts. + UseStencil := (fFont.fPart = fpInner); + + Outline := @FT_OutlineGlyph(Glyph).outline; + + OuterBorder := FT_Outline_GetOutsideBorder(Outline); + if (OuterBorder = FT_STROKER_BORDER_LEFT) then + InnerBorder := FT_STROKER_BORDER_RIGHT + else + InnerBorder := FT_STROKER_BORDER_LEFT; + + { extrude outer border } + + if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then + raise Exception.Create('FT_Stroker_New failed!'); + FT_Stroker_Set( + OuterStroker, + Round(fOutset * 64), + FT_STROKER_LINECAP_ROUND, + FT_STROKER_LINEJOIN_BEVEL, + 0); + + // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to + // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders + if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then + raise Exception.Create('FT_Stroker_ParseOutline failed!'); - procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF} + FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours); + + { extrude inner border (= stencil) } + + if (UseStencil) then begin - if (Val1 < Val2) then - Val1 := Val2; + if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then + raise Exception.Create('FT_Stroker_New failed!'); + FT_Stroker_Set( + InnerStroker, + 63, // extrude at most one pixel to avoid a black border + FT_STROKER_LINECAP_ROUND, + FT_STROKER_LINEJOIN_BEVEL, + 0); + + if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then + raise Exception.Create('FT_Stroker_ParseOutline failed!'); + + FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours); + end else begin + InnerNumPoints := 0; + InnerNumContours := 0; end; -var - I, X, Y: integer; - SrcBuffer,TmpBuffer: TGLubyteDynArray; - TexLine, TexLinePrev, TexLineNext: PGLubyteArray; - SrcLine: PGLubyteArray; - AlphaScale: single; - Value, ValueNeigh, ValueDiag: GLubyte; -const - // square-root of 2 used for diagonal neighbor pixels - cSqrt2 = 1.4142; - // number of ignored pixels on each edge of the bitmap. Consists of: - // - border used for font smoothing and - // - outer (extruded) bitmap pixel (because it is just written but never read) - cBorder = cTexSmoothBorder + 1; -begin - // allocate memory for temporary buffer - SetLength(SrcBuffer, Length(TexBuffer)); - FillChar(SrcBuffer[0], Length(TexBuffer), 0); - - // extrude pixel by pixel - for I := 1 to Ceil(Outset) do - begin - // swap arrays - TmpBuffer := TexBuffer; - TexBuffer := SrcBuffer; - SrcBuffer := TmpBuffer; - - // as long as we add an entire pixel of outset, use a solid color. - // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid - // pixels and one blended with alpha=0.2. - // For the fractional part I = Ceil(Outset) is always true. - if (I <= Outset) then - AlphaScale := 1 - else - AlphaScale := Outset - Trunc(Outset); - - // copy data to the expanded bitmap. - for Y := cBorder to fTexSize.Height - 2*cBorder do - begin - TexLine := @TexBuffer[Y*fTexSize.Width]; - TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width]; - TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width]; - SrcLine := @SrcBuffer[Y*fTexSize.Width]; + { combine borders (subtract: OuterBorder - InnerBorder) } - // expand current line's pixels - for X := cBorder to fTexSize.Width - 2*cBorder do - begin - Value := SrcLine[X]; - ValueNeigh := Round(Value * AlphaScale); - ValueDiag := Round(ValueNeigh / cSqrt2); + GlyphNumPoints := InnerNumPoints + OuterNumPoints; + GlyphNumContours := InnerNumContours + OuterNumContours; - SetToMax(TexLine[X], Value); - SetToMax(TexLine[X-1], ValueNeigh); - SetToMax(TexLine[X+1], ValueNeigh); + // save flags before deletion (TODO: set them on the resulting outline) + OutlineFlags := Outline.flags; - SetToMax(TexLinePrev[X], ValueNeigh); - SetToMax(TexLinePrev[X-1], ValueDiag); - SetToMax(TexLinePrev[X+1], ValueDiag); + // resize glyph outline to hold inner and outer border + FT_Outline_Done(Glyph.Library_, Outline); + if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then + raise Exception.Create('FT_Outline_New failed!'); - SetToMax(TexLineNext[X], ValueNeigh); - SetToMax(TexLineNext[X-1], ValueDiag); - SetToMax(TexLineNext[X+1], ValueDiag); - end; - end; - end; + Outline.n_points := 0; + Outline.n_contours := 0; - TmpBuffer := nil; - SetLength(SrcBuffer, 0); + // add points to outline. The inner-border is used as a stencil. + FT_Stroker_ExportBorder(OuterStroker, OuterBorder, Outline); + if (UseStencil) then + FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline); + if (FT_Outline_Check(outline) <> 0) then + raise Exception.Create('FT_Stroker_ExportBorder failed!'); + + if (InnerStroker <> nil) then + FT_Stroker_Done(InnerStroker); + if (OuterStroker <> nil) then + FT_Stroker_Done(OuterStroker); end; procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32); @@ -2033,6 +2106,9 @@ begin if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then raise Exception.Create('FT_Get_Glyph failed'); + if (fOutset > 0) then + StrokeBorder(Glyph); + // store scaled advance width/height in glyph-object fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; @@ -2114,9 +2190,6 @@ begin end; end; - if (fOutset > 0) then - Extrude(TexBuffer, fOutset); - // allocate resources for textures and display lists glGenTextures(1, @fTexture); @@ -2151,13 +2224,14 @@ begin FT_Done_Glyph(Glyph); end; -constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single; +constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); begin inherited Create(); fFont := Font; fOutset := Outset; + fCharCode := ch; // get the Freetype char-index (use default UNICODE charmap) fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); @@ -2336,7 +2410,7 @@ begin InsertPos := fHash.Count; end; -function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean; +function TGlyphCache.AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; var BaseCode: cardinal; GlyphCode: integer; @@ -2346,7 +2420,7 @@ var begin Result := false; - BaseCode := cardinal(ch) shr 8; + BaseCode := Ord(ch) shr 8; GlyphTable := FindGlyphTable(BaseCode, InsertPos); if (GlyphTable = nil) then begin @@ -2356,7 +2430,7 @@ begin end; // get glyph table offset - GlyphCode := cardinal(ch) and $FF; + GlyphCode := Ord(ch) and $FF; // insert glyph into table if not present if (GlyphTable[GlyphCode] = nil) then begin @@ -2365,19 +2439,19 @@ begin end; end; -procedure TGlyphCache.DeleteGlyph(ch: WideChar); +procedure TGlyphCache.DeleteGlyph(ch: UCS4Char); var Table: PGlyphTable; TableIndex, GlyphIndex: integer; TableEmpty: boolean; begin // find table - Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex); + Table := FindGlyphTable(Ord(ch) shr 8, TableIndex); if (Table = nil) then Exit; // find glyph - GlyphIndex := cardinal(ch) and $FF; + GlyphIndex := Ord(ch) and $FF; if (Table[GlyphIndex] <> nil) then begin // destroy glyph @@ -2402,19 +2476,19 @@ begin end; end; -function TGlyphCache.GetGlyph(ch: WideChar): TGlyph; +function TGlyphCache.GetGlyph(ch: UCS4Char): TGlyph; var InsertPos: integer; Table: PGlyphTable; begin - Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos); + Table := FindGlyphTable(Ord(ch) shr 8, InsertPos); if (Table = nil) then Result := nil else - Result := Table[cardinal(ch) and $FF]; + Result := Table[Ord(ch) and $FF]; end; -function TGlyphCache.HasGlyph(ch: WideChar): boolean; +function TGlyphCache.HasGlyph(ch: UCS4Char): boolean; begin Result := (GetGlyph(ch) <> nil); end; @@ -2482,7 +2556,7 @@ end; * TBitmapFont *} -constructor TBitmapFont.Create(const Filename: string; Outline: integer; +constructor TBitmapFont.Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); begin inherited Create(); @@ -2494,7 +2568,7 @@ begin fAscender := Ascender; fDescender := Descender; - LoadFontInfo(ChangeFileExt(Filename, '.dat')); + LoadFontInfo(Filename.SetExtension('.dat')); ResetIntern(); end; @@ -2524,27 +2598,27 @@ begin fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; end; -procedure TBitmapFont.LoadFontInfo(const InfoFile: string); +procedure TBitmapFont.LoadFontInfo(const InfoFile: IPath); var - Stream: TFileStream; + Stream: TStream; begin FillChar(fWidths[0], Length(fWidths), 0); Stream := nil; try - Stream := TFileStream.Create(InfoFile, fmOpenRead); + Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead); Stream.Read(fWidths, 256); except - raise Exception.Create('Could not read font info file ''' + InfoFile + ''''); + raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); end; Stream.Free; end; -function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; +function TBitmapFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; var LineIndex, CharIndex: integer; CharCode: cardinal; - Line: WideString; + Line: UCS4String; LineWidth: double; begin Result.Left := 0; @@ -2556,7 +2630,7 @@ begin begin Line := Text[LineIndex]; LineWidth := 0; - for CharIndex := 1 to Length(Line) do + for CharIndex := 0 to LengthUCS4(Line)-1 do begin CharCode := Ord(Line[CharIndex]); if (CharCode < Length(fWidths)) then @@ -2567,7 +2641,7 @@ begin end; end; -procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real); +procedure TBitmapFont.RenderChar(ch: UCS4Char; var AdvanceX: real); var TexX, TexY: real; TexR, TexB: real; @@ -2659,20 +2733,20 @@ begin AdvanceX := AdvanceX + GlyphWidth; end; -procedure TBitmapFont.Render(const Text: WideString); +procedure TBitmapFont.Render(const Text: UCS4String); var CharIndex: integer; AdvanceX: real; begin // if there is no text do nothing - if (Text = '') then + if (Text = nil) or (Text[0] = 0) then Exit; //Save the current color and alpha (for reflection) glGetFloatv(GL_CURRENT_COLOR, @fTempColor); AdvanceX := 0; - for CharIndex := 1 to Length(Text) do + for CharIndex := 0 to LengthUCS4(Text)-1 do begin RenderChar(Text[CharIndex], AdvanceX); end; diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index a2456a13..7738e010 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -150,6 +150,7 @@ var //popup mod ScreenPopupCheck: TScreenPopupCheck; ScreenPopupError: TScreenPopupError; + ScreenPopupInfo: TScreenPopupInfo; //Notes Tex_Left: array[0..6] of TTexture; //rename to tex_note_left @@ -281,7 +282,7 @@ uses UIni, UDisplay, UCommandLine, - UPath; + UPathUtils; procedure LoadFontTextures; begin @@ -362,7 +363,7 @@ begin Tex_Cursor_Unpressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor'), TEXTURE_TYPE_TRANSPARENT, 0); - if (Skin.GetTextureFileName('Cursor_Pressed') <> '') then + if (Skin.GetTextureFileName('Cursor_Pressed').IsSet) then Tex_Cursor_Pressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor_Pressed'), TEXTURE_TYPE_TRANSPARENT, 0) else Tex_Cursor_Pressed.TexNum := 0; @@ -411,14 +412,14 @@ begin End; Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), TEXTURE_TYPE_COLORIZED, Col); + Tex_SingLineBonusBack[P] := Texture.LoadTexture(Skin.GetTextureFileName('LineBonusBack'), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); + Tex_ScoreBG[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreBG'), TEXTURE_TYPE_COLORIZED, Col); end; @@ -433,23 +434,23 @@ 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')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Dark'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Dark_Round'), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Light'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Light_Round'), TEXTURE_TYPE_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')), TEXTURE_TYPE_COLORIZED, Col); - Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Lightest'), TEXTURE_TYPE_COLORIZED, Col); + Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Lightest_Round'), TEXTURE_TYPE_COLORIZED, Col); end; //## rating pictures that show a picture according to your rate ## for P := 0 to 7 do begin - Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0); + Tex_Score_Ratings[P] := Texture.LoadTexture(Skin.GetTextureFileName('Rating_'+IntToStr(P)), TEXTURE_TYPE_TRANSPARENT, 0); end; Log.LogStatus('Loading Textures - Done', 'LoadTextures'); @@ -486,9 +487,9 @@ begin end; // load icon image (must be 32x32 for win32) - Icon := LoadImage(ResourcesPath + WINDOW_ICON); + Icon := LoadImage(ResourcesPath.Append(WINDOW_ICON)); if (Icon <> nil) then - SDL_WM_SetIcon(Icon, 0); + SDL_WM_SetIcon(Icon, nil); SDL_WM_SetCaption(PChar(Title), nil); @@ -689,7 +690,7 @@ end; procedure LoadLoadingScreen; begin ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; + ScreenLoading.OnShow; Display.CurrentScreen := @ScreenLoading; @@ -704,7 +705,7 @@ end; procedure LoadScreens; begin { ScreenLoading := TScreenLoading.Create; - ScreenLoading.onShow; + ScreenLoading.OnShow; Display.CurrentScreen := @ScreenLoading; ScreenLoading.Draw; Display.Draw; @@ -765,6 +766,8 @@ begin 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); + ScreenPopupInfo := TScreenPopupInfo.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Info)', 3); Log.BenchmarkStart(3); ScreenPartyNewRound := TScreenPartyNewRound.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3); ScreenPartyScore := TScreenPartyScore.Create; @@ -816,6 +819,7 @@ begin ScreenSongJumpto.Destroy; ScreenPopupCheck.Destroy; ScreenPopupError.Destroy; + ScreenPopupInfo.Destroy; ScreenPartyNewRound.Destroy; ScreenPartyScore.Destroy; ScreenPartyWin.Destroy; diff --git a/src/base/UImage.pas b/src/base/UImage.pas index 6b0c509e..1866316e 100644 --- a/src/base/UImage.pas +++ b/src/base/UImage.pas @@ -34,7 +34,8 @@ interface {$I switches.inc} uses - SDL; + SDL, + UPath; {$DEFINE HavePNG} {$DEFINE HaveBMP} @@ -131,20 +132,20 @@ type *******************************************************) {$IFDEF HavePNG} -function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean; {$ENDIF} {$IFDEF HaveBMP} -function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean; {$ENDIF} {$IFDEF HaveJPG} -function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean; {$ENDIF} (******************************************************* * Image loading *******************************************************) -function LoadImage(const Filename: string): PSDL_Surface; +function LoadImage(const Filename: IPath): PSDL_Surface; (******************************************************* * Image manipulation @@ -181,6 +182,7 @@ uses zlib, sdl_image, sdlutils, + sdlstreams, UCommon, ULog; @@ -282,26 +284,26 @@ end; procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; var - inFile: TFileStream; + inFile: TStream; begin - inFile := TFileStream(png_get_io_ptr(png_ptr)); + inFile := TStream(png_get_io_ptr(png_ptr)); inFile.Read(data^, length); end; procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl; var - outFile: TFileStream; + outFile: TStream; begin - outFile := TFileStream(png_get_io_ptr(png_ptr)); + outFile := TStream(png_get_io_ptr(png_ptr)); outFile.Write(data^, length); end; procedure user_flush_data(png_ptr: png_structp); cdecl; //var -// outFile: TFileStream; +// outFile: TStream; begin // binary files are flushed automatically, Flush() works with Text-files only - //outFile := TFileStream(png_get_io_ptr(png_ptr)); + //outFile := TStream(png_get_io_ptr(png_ptr)); //outFile.Flush(); end; @@ -323,11 +325,11 @@ end; (* * ImageData must be in RGB-format *) -function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean; +function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean; var png_ptr: png_structp; info_ptr: png_infop; - pngFile: TFileStream; + pngFile: TStream; row: integer; rowData: array of png_bytep; // rowStride: integer; @@ -339,9 +341,9 @@ begin // open file for writing try - pngFile := TFileStream.Create(FileName, fmCreate); + pngFile := TBinaryFileStream.Create(FileName, fmCreate); except - Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage'); + Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WritePngImage'); Exit; end; @@ -500,9 +502,9 @@ type (* * ImageData must be in BGR-format *) -function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean; +function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean; var - bmpFile: TFileStream; + bmpFile: TStream; FileInfo: BITMAPINFOHEADER; FileHeader: BITMAPFILEHEADER; Converted: boolean; @@ -513,9 +515,9 @@ begin // open file for writing try - bmpFile := TFileStream.Create(FileName, fmCreate); + bmpFile := TBinaryFileStream.Create(FileName, fmCreate); except - Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage'); + Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteBMPImage'); Exit; end; @@ -579,7 +581,7 @@ begin Result := true; finally - Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage'); + Log.LogError('Could not write file: "' + FileName.ToNative + '"', 'WriteBMPImage'); end; if (Converted) then @@ -597,18 +599,19 @@ end; {$IFDEF HaveJPG} -function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean; +function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean; var {$IFDEF Delphi} Bitmap: TBitmap; BitmapInfo: TBitmapInfo; Jpeg: TJpegImage; row: integer; + FileStream: TBinaryFileStream; {$ELSE} - cinfo: jpeg_compress_struct; - jerr : jpeg_error_mgr; - jpgFile: TFileStream; - rowPtr: array[0..0] of JSAMPROW; + cinfo: jpeg_compress_struct; + jerr : jpeg_error_mgr; + jpgFile: TBinaryFileStream; + rowPtr: array[0..0] of JSAMPROW; {$ENDIF} converted: boolean; begin @@ -669,19 +672,32 @@ begin SDL_UnlockSurface(Surface); // assign Bitmap to JPEG and store the latter - Jpeg := TJPEGImage.Create; - Jpeg.Assign(Bitmap); - Bitmap.Free; - Jpeg.CompressionQuality := Quality; try - // compress image (don't forget this line, otherwise it won't be compressed) - Jpeg.Compress(); - Jpeg.SaveToFile(FileName); + // init with nil so Free() will not fail if an exception occurs + Jpeg := nil; + Bitmap := nil; + FileStream := nil; + + try + Jpeg := TJPEGImage.Create; + Jpeg.Assign(Bitmap); + + // compress image (don't forget this line, otherwise it won't be compressed) + Jpeg.CompressionQuality := Quality; + Jpeg.Compress(); + + // Note: FileStream needed for unicode filename support + FileStream := TBinaryFileStream.Create(Filename, fmCreate); + Jpeg.SaveToStream(FileStream); + finally + FileStream.Free; + Bitmap.Free; + Jpeg.Free; + end; except - Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage'); + Log.LogError('Could not save file: "' + FileName.ToNative + '"', 'WriteJPGImage'); Exit; end; - Jpeg.Free; {$ELSE} // based on example.pas in FPC's packages/base/pasjpeg directory @@ -703,9 +719,9 @@ begin // open file for writing try - jpgFile := TFileStream.Create(FileName, fmCreate); + jpgFile := TBinaryFileStream.Create(FileName, fmCreate); except - Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage'); + Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteJPGImage'); Exit; end; @@ -763,27 +779,29 @@ end; (* * Loads an image from the given file *) -function LoadImage(const Filename: string): PSDL_Surface; +function LoadImage(const Filename: IPath): PSDL_Surface; var - FilenameFound: string; + FilenameCaseAdj: IPath; + FileStream: TBinaryFileStream; + SDLStream: PSDL_RWops; begin - Result := nil; - - // FileExistsInsensitive() requires a var-arg - FilenameFound := Filename; + Result := nil; - // try to find the file case insensitive - if (not FileExistsInsensitive(FilenameFound)) then + // try to adjust filename's case and check if it exists + FilenameCaseAdj := Filename.AdjustCase(false); + if (not FilenameCaseAdj.IsFile) then begin - Log.LogError('Image-File does not exist "'+FilenameFound+'"', 'LoadImage'); + Log.LogError('Image-File does not exist "' + FilenameCaseAdj.ToNative + '"', 'LoadImage'); Exit; end; // load from file try - Result := IMG_Load(PChar(FilenameFound)); + SDLStream := SDLStreamSetup(TBinaryFileStream.Create(FilenameCaseAdj, fmOpenRead)); + Result := IMG_Load_RW(SDLStream, 1); + // Note: TBinaryFileStream is freed by SDLStream. SDLStream by IMG_Load_RW(). except - Log.LogError('Could not load from file "'+FilenameFound+'"', 'LoadImage'); + Log.LogError('Could not load from file "' + FilenameCaseAdj.ToNative + '"', 'LoadImage'); Exit; end; end; diff --git a/src/base/UIni.pas b/src/base/UIni.pas index f92ea7c3..a3bc1876 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -37,7 +37,10 @@ uses Classes, IniFiles, SysUtils, - ULog; + ULog, + UTextEncoding, + UFilesystem, + UPath; type // TInputDeviceConfig stores the configuration for an input device. @@ -70,11 +73,10 @@ type TBackgroundMusicOption = (bmoOff, bmoOn); TIni = class private - function RemoveFileExt(FullName: string): string; function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: boolean = false): integer; - function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; + function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer; + function ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; procedure TranslateOptionValues; @@ -85,14 +87,14 @@ type procedure LoadScreenModes(IniFile: TCustomIniFile); public - Name: array[0..11] of string; + Name: array[0..11] of UTF8String; // Templates for Names Mod - NameTeam: array[0..2] of string; - NameTemplate: array[0..11] of string; + NameTeam: array[0..2] of UTF8String; + NameTemplate: array[0..11] of UTF8String; //Filename of the opened iniFile - Filename: string; + Filename: IPath; // Game Players: integer; @@ -165,19 +167,19 @@ type var Ini: TIni; - IResolution: array of string; - ILanguage: array of string; - ITheme: array of string; - ISkin: array of string; + IResolution: array of UTF8String; + ILanguage: array of UTF8String; + ITheme: array of UTF8String; + ISkin: array of UTF8String; const - IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6'); - IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); + IPlayers: array[0..4] of UTF8String = ('1', '2', '3', '4', '6'); + IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); - IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of string = ('Off', 'On'); + IDifficulty: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); + ITabs: array[0..1] of UTF8String = ('Off', 'On'); - ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISorting: array[0..7] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); sEdition = 0; sGenre = 1; sLanguage = 2; @@ -187,132 +189,132 @@ const sTitle2 = 6; sArtist2 = 7; - IDebug: array[0..1] of string = ('Off', 'On'); + IDebug: array[0..1] of UTF8String = ('Off', 'On'); - IScreens: array[0..1] of string = ('1', '2'); - IFullScreen: array[0..1] of string = ('Off', 'On'); - IDepth: array[0..1] of string = ('16 bit', '32 bit'); - IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + IScreens: array[0..1] of UTF8String = ('1', '2'); + IFullScreen: array[0..1] of UTF8String = ('Off', 'On'); + IDepth: array[0..1] of UTF8String = ('16 bit', '32 bit'); + IVisualizer: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On'); - IBackgroundMusic: array[0..1] of string = ('Off', 'On'); + IBackgroundMusic: array[0..1] of UTF8String = ('Off', 'On'); - ITextureSize: array[0..3] of string = ('64', '128', '256', '512'); - ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512); + ITextureSize: array[0..3] of UTF8String = ('64', '128', '256', '512'); + ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512); - ISingWindow: array[0..1] of string = ('Small', 'Big'); + ISingWindow: array[0..1] of UTF8String = ('Small', 'Big'); //SingBar Mod - IOscilloscope: array[0..1] of string = ('Off', 'On'); + IOscilloscope: array[0..1] of UTF8String = ('Off', 'On'); - ISpectrum: array[0..1] of string = ('Off', 'On'); - ISpectrograph: array[0..1] of string = ('Off', 'On'); - IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + ISpectrum: array[0..1] of UTF8String = ('Off', 'On'); + ISpectrograph: array[0..1] of UTF8String = ('Off', 'On'); + IMovieSize: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - IClickAssist: array[0..1] of string = ('Off', 'On'); - IBeatClick: array[0..1] of string = ('Off', 'On'); - ISavePlayback: array[0..1] of string = ('Off', 'On'); + IClickAssist: array[0..1] of UTF8String = ('Off', 'On'); + IBeatClick: array[0..1] of UTF8String = ('Off', 'On'); + ISavePlayback: array[0..1] of UTF8String = ('Off', 'On'); - IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%'); + IThreshold: array[0..3] of UTF8String = ('5%', '10%', '15%', '20%'); IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20); - IVoicePassthrough: array[0..1] of string = ('Off', 'On'); + IVoicePassthrough: array[0..1] of UTF8String = ('Off', 'On'); - IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + IAudioOutputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); - IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); + IAudioInputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); //Song Preview - IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); + IPreviewVolume: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 ); - IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); + IPreviewFading: array[0..5] of UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 ); - ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - INoteLines: array[0..1] of string = ('Off', 'On'); + ILyricsFont: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffect: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); + ISolmization: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); + INoteLines: array[0..1] of UTF8String = ('Off', 'On'); - IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + IColor: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); // Advanced - ILoadAnimation: array[0..1] of string = ('Off', 'On'); - IEffectSing: array[0..1] of string = ('Off', 'On'); - IScreenFade: array[0..1] of string = ('Off', 'On'); - IAskbeforeDel: array[0..1] of string = ('Off', 'On'); - IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonus: array[0..1] of string = ('Off', 'On'); - IPartyPopup: array[0..1] of string = ('Off', 'On'); + ILoadAnimation: array[0..1] of UTF8String = ('Off', 'On'); + IEffectSing: array[0..1] of UTF8String = ('Off', 'On'); + IScreenFade: array[0..1] of UTF8String = ('Off', 'On'); + IAskbeforeDel: array[0..1] of UTF8String = ('Off', 'On'); + IOnSongClick: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu'); + ILineBonus: array[0..1] of UTF8String = ('Off', 'On'); + IPartyPopup: array[0..1] of UTF8String = ('Off', 'On'); - IJoypad: array[0..1] of string = ('Off', 'On'); - IMouse: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor'); + IJoypad: array[0..1] of UTF8String = ('Off', 'On'); + IMouse: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor'); // Recording options - IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); - IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IChannelPlayer: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6'); + IMicBoost: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB'); var - ILanguageTranslated: array of string; + ILanguageTranslated: array of UTF8String; - IDifficultyTranslated: array[0..2] of string = ('Easy', 'Medium', 'Hard'); - ITabsTranslated: array[0..1] of string = ('Off', 'On'); + IDifficultyTranslated: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); + ITabsTranslated: array[0..1] of UTF8String = ('Off', 'On'); - ISortingTranslated: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISortingTranslated: array[0..7] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); - IDebugTranslated: array[0..1] of string = ('Off', 'On'); + IDebugTranslated: array[0..1] of UTF8String = ('Off', 'On'); - IFullScreenTranslated: array[0..1] of string = ('Off', 'On'); - IVisualizerTranslated: array[0..2] of string = ('Off', 'WhenNoVideo','On'); + IFullScreenTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IVisualizerTranslated: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On'); - IBackgroundMusicTranslated: array[0..1] of string = ('Off', 'On'); - ISingWindowTranslated: array[0..1] of string = ('Small', 'Big'); + IBackgroundMusicTranslated: array[0..1] of UTF8String = ('Off', 'On'); + ISingWindowTranslated: array[0..1] of UTF8String = ('Small', 'Big'); //SingBar Mod - IOscilloscopeTranslated: array[0..1] of string = ('Off', 'On'); + IOscilloscopeTranslated: array[0..1] of UTF8String = ('Off', 'On'); - ISpectrumTranslated: array[0..1] of string = ('Off', 'On'); - ISpectrographTranslated: array[0..1] of string = ('Off', 'On'); - IMovieSizeTranslated: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + ISpectrumTranslated: array[0..1] of UTF8String = ('Off', 'On'); + ISpectrographTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IMovieSizeTranslated: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); - IClickAssistTranslated: array[0..1] of string = ('Off', 'On'); - IBeatClickTranslated: array[0..1] of string = ('Off', 'On'); - ISavePlaybackTranslated: array[0..1] of string = ('Off', 'On'); + IClickAssistTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IBeatClickTranslated: array[0..1] of UTF8String = ('Off', 'On'); + ISavePlaybackTranslated: array[0..1] of UTF8String = ('Off', 'On'); - IVoicePassthroughTranslated: array[0..1] of string = ('Off', 'On'); + IVoicePassthroughTranslated: array[0..1] of UTF8String = ('Off', 'On'); //Song Preview - IPreviewVolumeTranslated: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); + IPreviewVolumeTranslated: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - IAudioOutputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioOutputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IAudioInputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); + IAudioInputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); - IPreviewFadingTranslated: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); + IPreviewFadingTranslated: array[0..5] of UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - ILyricsFontTranslated: array[0..2] of string = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffectTranslated: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmizationTranslated: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American'); - INoteLinesTranslated: array[0..1] of string = ('Off', 'On'); + ILyricsFontTranslated: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2'); + ILyricsEffectTranslated: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); + ISolmizationTranslated: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); + INoteLinesTranslated: array[0..1] of UTF8String = ('Off', 'On'); - IColorTranslated: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); + IColorTranslated: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); // Advanced - ILoadAnimationTranslated: array[0..1] of string = ('Off', 'On'); - IEffectSingTranslated: array[0..1] of string = ('Off', 'On'); - IScreenFadeTranslated: array[0..1] of string = ('Off', 'On'); - IAskbeforeDelTranslated: array[0..1] of string = ('Off', 'On'); - IOnSongClickTranslated: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu'); - ILineBonusTranslated: array[0..1] of string = ('Off', 'On'); - IPartyPopupTranslated: array[0..1] of string = ('Off', 'On'); + ILoadAnimationTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IEffectSingTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IScreenFadeTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IAskbeforeDelTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IOnSongClickTranslated: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu'); + ILineBonusTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IPartyPopupTranslated: array[0..1] of UTF8String = ('Off', 'On'); - IJoypadTranslated: array[0..1] of string = ('Off', 'On'); - IMouseTranslated: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor'); + IJoypadTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IMouseTranslated: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor'); // Recording options - IChannelPlayerTranslated: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6'); - IMicBoostTranslated: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB'); + IChannelPlayerTranslated: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6'); + IMicBoostTranslated: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB'); implementation @@ -323,9 +325,10 @@ uses ULanguage, UPlatform, UMain, - UPath, URecord, - USkins; + USkins, + UPathUtils, + UUnicodeUtils; (** * Translate and set the values of options, which need translation. @@ -523,14 +526,6 @@ begin end; -(** - * Returns the filename without its fileextension - *) -function TIni.RemoveFileExt(FullName: string): string; -begin - Result := ChangeFileExt(FullName, ''); -end; - (** * Extracts an index of a key that is surrounded by a Prefix/Suffix pair. * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1. @@ -581,7 +576,7 @@ end; * Returns the index of Value in SearchArray * or -1 if Value is not in SearchArray. *) -function TIni.GetArrayIndex(const SearchArray: array of string; Value: string; +function TIni.GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer; var i: integer; @@ -605,7 +600,7 @@ end; * If SearchArray does not contain the property value, the default value is * returned. *) -function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile; +function TIni.ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; var StrValue: string; @@ -718,9 +713,9 @@ begin // Load song-paths for I := 0 to PathStrings.Count-1 do begin - if (AnsiStartsText('SongDir', PathStrings[I])) then + if (Pos('SONGDIR', UpperCase(PathStrings[I])) = 1) then begin - AddSongPath(IniFile.ReadString('Directories', PathStrings[I], '')); + AddSongPath(Path(IniFile.ReadString('Directories', PathStrings[I], ''))); end; end; @@ -733,18 +728,23 @@ var ThemeIni: TMemIniFile; ThemeName: string; I: integer; + Iter: IFileIterator; + FileInfo: TFileInfo; begin // Theme SetLength(ITheme, 0); - Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme'); + Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme'); + - FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult); - Repeat - Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme'); + Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0); + while (Iter.HasNext) do + begin + FileInfo := Iter.Next; + Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme'); //Read Themename from Theme - ThemeIni := TMemIniFile.Create(SearchResult.Name); - ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name))); + ThemeIni := TMemIniFile.Create(FileInfo.Name.ToNative); + ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', FileInfo.Name.SetExtension('').ToNative)); ThemeIni.Free; //Search for Skins for this Theme @@ -753,12 +753,11 @@ begin if UpperCase(Skin.Skin[I].Theme) = ThemeName then begin SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name); + ITheme[High(ITheme)] := FileInfo.Name.SetExtension('').ToNative; break; end; end; - until FindNext(SearchResult) <> 0; - FindClose(SearchResult); + end; // No Theme Found if (Length(ITheme) = 0) then @@ -779,7 +778,7 @@ end; procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); // swap two strings - procedure swap(var s1, s2: string); + procedure swap(var s1, s2: UTF8String); var s3: string; begin @@ -888,19 +887,15 @@ var begin GamePath := Platform.GetGameUserPath; - Log.LogStatus( 'GamePath : ' +GamePath , '' ); + Log.LogStatus( 'GamePath : ' +GamePath.ToNative , '' ); - if (Params.ConfigFile <> '') then - try - FileName := Params.ConfigFile; - except - FileName := GamePath + 'config.ini'; - end + if (Params.ConfigFile.IsSet) then + FileName := Params.ConfigFile else - FileName := GamePath + 'config.ini'; + FileName := GamePath.Append('config.ini'); - Log.LogStatus( 'Using config : ' + FileName , 'Ini'); - IniFile := TMemIniFile.Create( FileName ); + Log.LogStatus('Using config : ' + FileName.ToNative, 'Ini'); + IniFile := TMemIniFile.Create(FileName.ToNative); // Name for I := 0 to 11 do @@ -1042,13 +1037,13 @@ procedure TIni.Save; var IniFile: TIniFile; begin - if (FileExists(Filename) and FileIsReadOnly(Filename)) then + if (Filename.IsFile and Filename.IsReadOnly) then begin Log.LogError('Config-file is read-only', 'TIni.Save'); Exit; end; - IniFile := TIniFile.Create(Filename); + IniFile := TIniFile.Create(Filename.ToNative); // Players IniFile.WriteString('Game', 'Players', IPlayers[Players]); @@ -1188,17 +1183,17 @@ var IniFile: TIniFile; I: integer; begin - if not FileIsReadOnly(Filename) then + if not Filename.IsReadOnly() then begin - IniFile := TIniFile.Create(Filename); + IniFile := TIniFile.Create(Filename.ToNative); //Name Templates for Names Mod - for I := 1 to 12 do - IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]); - for I := 1 to 3 do - IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]); - for I := 1 to 12 do - IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]); + for I := 0 to High(Name) do + IniFile.WriteString('Name', 'P' + IntToStr(I+1), Name[I]); + for I := 0 to High(NameTeam) do + IniFile.WriteString('NameTeam', 'T' + IntToStr(I+1), NameTeam[I]); + for I := 0 to High(NameTemplate) do + IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I+1), NameTemplate[I]); IniFile.Free; end; @@ -1208,9 +1203,9 @@ procedure TIni.SaveLevel; var IniFile: TIniFile; begin - if not FileIsReadOnly(Filename) then + if not Filename.IsReadOnly() then begin - IniFile := TIniFile.Create(Filename); + IniFile := TIniFile.Create(Filename.ToNative); // Difficulty IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas index 80926774..5f8a2692 100644 --- a/src/base/ULanguage.pas +++ b/src/base/ULanguage.pas @@ -33,33 +33,41 @@ interface {$I switches.inc} +uses + UUnicodeUtils; + type TLanguageEntry = record - ID: string; - Text: string; + ID: AnsiString; //**< identifier (ASCII) + Text: UTF8String; //**< translation (UTF-8) end; TLanguageList = record - Name: string; - {FileName: string; } + Name: AnsiString; //**< language name (ASCII) end; + TLanguageEntryArray = array of TLanguageEntry; + TLanguage = class - public - Entry: array of TLanguageEntry; //Entrys of Chosen Language - EntryDefault: array of TLanguageEntry; //Entrys of Standard Language - EntryConst: array of TLanguageEntry; //Constant Entrys e.g. Version - Implode_Glue1, Implode_Glue2: String; - public + private List: array of TLanguageList; - constructor Create; + Entry: TLanguageEntryArray; //**< Entrys of Chosen Language + EntryDefault: TLanguageEntryArray; //**< Entrys of Standard Language + EntryConst: TLanguageEntryArray; //**< Constant Entrys e.g. Version + + Implode_Glue1, Implode_Glue2: UTF8String; + procedure LoadList; - function Translate(Text: String): String; - procedure ChangeLanguage(Language: String); - procedure AddConst(ID, Text: String); - procedure ChangeConst(ID, Text: String); - function Implode(Pieces: Array of String): String; + function FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer; + + public + constructor Create; + function Translate(const Text: RawByteString): UTF8String; + procedure ChangeLanguage(const Language: AnsiString); + procedure AddConst(const ID: AnsiString; const Text: UTF8String); + procedure ChangeConst(const ID: AnsiString; const Text: UTF8String); + function Implode(const Pieces: array of UTF8String): UTF8String; end; var @@ -69,20 +77,18 @@ implementation uses UMain, - // UFiles, UIni, IniFiles, Classes, SysUtils, - {$IFDEF win32} - Windows, - {$ENDIF} ULog, - UPath; + UPath, + UFilesystem, + UPathUtils; -//---------- -//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues -//---------- +{** + * LoadList, set default language, set standard implode glues + *} constructor TLanguage.Create; var I, J: Integer; @@ -108,7 +114,7 @@ begin ChangeLanguage('English'); SetLength(EntryDefault, Length(Entry)); - for J := low(Entry) to high(Entry) do + for J := 0 to high(Entry) do EntryDefault[J] := Entry[J]; SetLength(Entry, 0); @@ -123,42 +129,44 @@ begin end; -//---------- -//LoadList - Parse the Language Dir searching Translations -//---------- +{** + * Parse the Language Dir searching Translations + *} procedure TLanguage.LoadList; var - SR: TSearchRec; // for parsing directory + Iter: IFileIterator; + IniInfo: TFileInfo; + LangName: string; begin SetLength(List, 0); SetLength(ILanguage, 0); - if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then + Iter := FileSystem.FileFind(LanguagesPath.Append('*.ini'), 0); + while(Iter.HasNext) do begin - repeat - SetLength(List, Length(List)+1); - SetLength(ILanguage, Length(ILanguage)+1); - SR.Name := ChangeFileExt(SR.Name, ''); + IniInfo := Iter.Next; + + LangName := IniInfo.Name.SetExtension('').ToUTF8; - List[High(List)].Name := SR.Name; - ILanguage[High(ILanguage)] := SR.Name; + SetLength(List, Length(List)+1); + List[High(List)].Name := LangName; - until FindNext(SR) <> 0; - SysUtils.FindClose(SR); - end; // if FindFirst + SetLength(ILanguage, Length(ILanguage)+1); + ILanguage[High(ILanguage)] := LangName; + end; end; -//---------- -//ChangeLanguage - Load the specified LanguageFile -//---------- -procedure TLanguage.ChangeLanguage(Language: String); +{** + * Load the specified LanguageFile + *} +procedure TLanguage.ChangeLanguage(const Language: AnsiString); var - IniFile: TIniFile; + IniFile: TUnicodeMemIniFile; E: integer; // entry S: TStringList; begin SetLength(Entry, 0); - IniFile := TIniFile.Create(LanguagesPath + Language + '.ini'); + IniFile := TUnicodeMemIniFile.Create(LanguagesPath.Append(Language + '.ini')); S := TStringList.Create; IniFile.ReadSectionValues('Text', S); @@ -178,57 +186,84 @@ begin IniFile.Free; end; -//---------- -//Translate - Translate the Text -//---------- -Function TLanguage.Translate(Text: String): String; +{** + * Find the index of ID an array of language entries. + * @returns the index on success, -1 otherwise. + *} +function TLanguage.FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer; var - E: integer; // entry + Index: integer; begin + for Index := 0 to High(EntryList) do + begin + if ID = EntryList[Index].ID then + begin + Result := Index; + Exit; + end; + end; + Result := -1; +end; + +{** + * Translate the Text. + * If Text is an ID, text will be translated according to the current language + * setting. If Text is not a known ID, it will be returned as is. + * @param Text either an ID or an UTF-8 encoded string + *} +function TLanguage.Translate(const Text: RawByteString): UTF8String; +var + E: integer; // entry + ID: AnsiString; + EntryIndex: integer; +begin + // fallback result in case Text is not a known ID Result := Text; - Text := Uppercase(Result); + + // normalize ID case + ID := UpperCase(Text); + + // Check if ID exists //Const Mod - for E := 0 to high(EntryConst) do - if Text = EntryConst[E].ID then - begin - Result := EntryConst[E].Text; - exit; - end; - //Const Mod End + EntryIndex := FindID(ID, EntryConst); + if (EntryIndex >= 0) then + begin + Result := EntryConst[EntryIndex].Text; + Exit; + end; - for E := 0 to high(Entry) do - if Text = Entry[E].ID then - begin - Result := Entry[E].Text; - exit; - end; + EntryIndex := FindID(ID, Entry); + if (EntryIndex >= 0) then + begin + Result := Entry[EntryIndex].Text; + Exit; + end; //Standard Language (If a Language File is Incomplete) //Then use Standard Language - for E := low(EntryDefault) to high(EntryDefault) do - if Text = EntryDefault[E].ID then - begin - Result := EntryDefault[E].Text; - Break; - end; - //Standard Language END + EntryIndex := FindID(ID, EntryDefault); + if (EntryIndex >= 0) then + begin + Result := EntryDefault[EntryIndex].Text; + Exit; + end; end; -//---------- -//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile -//---------- -procedure TLanguage.AddConst (ID, Text: String); +{** + * Add a Constant ID that will be Translated but not Loaded from the LanguageFile + *} +procedure TLanguage.AddConst(const ID: AnsiString; const Text: UTF8String); begin SetLength (EntryConst, Length(EntryConst) + 1); EntryConst[high(EntryConst)].ID := ID; EntryConst[high(EntryConst)].Text := Text; end; -//---------- -//ChangeConst - Change a Constant Value by ID -//---------- -procedure TLanguage.ChangeConst(ID, Text: String); +{** + * Change a Constant Value by ID + *} +procedure TLanguage.ChangeConst(const ID: AnsiString; const Text: UTF8String); var I: Integer; begin @@ -242,16 +277,16 @@ begin end; end; -//---------- -//Implode - Connect an Array of Strings with ' and ' or ', ' to one String -//---------- -function TLanguage.Implode(Pieces: Array of String): String; +{** + * Connect an array of strings with ' and ' or ', ' to one string + *} +function TLanguage.Implode(const Pieces: array of UTF8String): UTF8String; var I: Integer; begin Result := ''; //Go through Pieces - for I := low(Pieces) to high(Pieces) do + for I := 0 to high(Pieces) do begin //Add Value Result := Result + Pieces[I]; diff --git a/src/base/ULog.pas b/src/base/ULog.pas index a872729a..e4ff4862 100644 --- a/src/base/ULog.pas +++ b/src/base/ULog.pas @@ -34,7 +34,8 @@ interface {$I switches.inc} uses - Classes; + Classes, + UPath; (* * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each @@ -115,7 +116,7 @@ type // voice procedure LogVoice(SoundNr: integer); // buffer - procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string); + procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : IPath); end; procedure DebugWriteln(const aString: String); @@ -133,7 +134,7 @@ uses UTime, UCommon, UCommandLine, - UPath; + UPathUtils; (* * Write to console if in debug mode (Thread-safe). @@ -198,7 +199,7 @@ begin if not BenchmarkFileOpened then begin BenchmarkFileOpened := true; - AssignFile(BenchmarkFile, LogPath + 'Benchmark.log'); + AssignFile(BenchmarkFile, LogPath.Append('Benchmark.log').ToNative); {$I-} Rewrite(BenchmarkFile); if IOResult = 0 then @@ -270,7 +271,7 @@ procedure TLog.LogToFile(const Text: string); begin if (FileOutputEnabled and not LogFileOpened) then begin - AssignFile(LogFile, LogPath + 'Error.log'); + AssignFile(LogFile, LogPath.Append('Error.log').ToNative); {$I-} Rewrite(LogFile); if IOResult = 0 then @@ -399,20 +400,19 @@ end; procedure TLog.LogVoice(SoundNr: integer); var - FS: TFileStream; - FileName: string; + FS: TBinaryFileStream; + Prefix: string; + FileName: IPath; Num: integer; begin for Num := 1 to 9999 do begin - FileName := IntToStr(Num); - while Length(FileName) < 4 do - FileName := '0' + FileName; - FileName := LogPath + 'Voice' + FileName + '.raw'; - if not FileExists(FileName) then + Prefix := Format('Voice%.4d', [Num]); + FileName := LogPath.Append(Prefix + '.raw'); + if not FileName.Exists() then break end; - FS := TFileStream.Create(FileName, fmCreate); + FS := TBinaryFileStream.Create(FileName, fmCreate); AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning); FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size); @@ -420,21 +420,19 @@ begin FS.Free; end; -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string); +procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: IPath); var - f : TFileStream; + f : TBinaryFileStream; begin - f := nil; - try - f := TFileStream.Create( filename, fmCreate); - f.Write( buf^, bufLength); - f.Free; - except - on e : Exception do begin - Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message); + f := TBinaryFileStream.Create( filename, fmCreate); + try + f.Write( buf^, bufLength); + finally f.Free; end; + except on e : Exception do + Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename.ToNative + '". ErrMsg: ' + e.Message); end; end; diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas index 82982981..3f62db9c 100644 --- a/src/base/ULyrics.pas +++ b/src/base/ULyrics.pas @@ -52,14 +52,14 @@ type Width: real; // width Start: cardinal; // start of the word in quarters (beats) Length: cardinal; // length of the word in quarters - Text: string; // text + Text: UTF8String; // text Freestyle: boolean; // is freestyle? end; TLyricWordArray = array of TLyricWord; TLyricLine = class public - Text: string; // text + Text: UTF8String; // text Width: real; // width Height: real; // height Words: TLyricWordArray; // words in this line diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 33eca888..b8ddf346 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -80,7 +80,7 @@ uses UJoystick, ULanguage, ULog, - UPath, + UPathUtils, UPlaylist, UMusic, UBeatTimer, @@ -190,7 +190,7 @@ begin // Theme Log.BenchmarkStart(1); Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color); + Theme := TTheme.Create(ThemePath.Append(ITheme[Ini.Theme] + '.ini'), Ini.Color); Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Themes', 1); @@ -246,10 +246,10 @@ begin Log.LogStatus('DataBase System', 'Initialization'); DataBase := TDataBaseSystem.Create; - if (Params.ScoreFile = '') then - DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db') + if (Params.ScoreFile.IsUnset) then + DataBase.Init(Platform.GetGameUserPath.Append('Ultrastar.db')) else - DataBase.Init (Params.ScoreFile); + DataBase.Init(Params.ScoreFile); Log.BenchmarkEnd(1); Log.LogBenchmark('Loading DataBase System', 1); @@ -353,11 +353,9 @@ begin CountMidTime; Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); - //Log.LogError ('MainLoop', 'Delay: ' + intToStr(Delay)); if Delay >= 1 then SDL_Delay(Delay); // dynamic, maximum is 100 fps - //Log.LogError ('MainLoop', 'Delay: ok ' + intToStr(Delay)); CountSkipTime; @@ -433,6 +431,8 @@ begin if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then + done := not ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else @@ -462,6 +462,16 @@ begin end; SDL_KEYDOWN: begin + // translate CTRL-A (ASCII 1) - CTRL-Z (ASCII 26) to correct charcodes. + // keysyms (SDLK_A, ...) could be used instead but they ignore the + // current key mapping (if 'a' is pressed on a French keyboard the + // .unicode field will be 'a' and .sym SDLK_Q). + // IMPORTANT: if CTRL is pressed with a key different than 'A'-'Z' SDL + // will set .unicode to 0. There is no possibility to obtain a + // translated charcode. Use keysyms instead. + //if (Event.key.keysym.unicode in [1 .. 26]) then + // Event.key.keysym.unicode := Ord('A') + Event.key.keysym.unicode - 1; + // remap the "keypad enter" key to the "standard enter" key if (Event.key.keysym.sym = SDLK_KP_ENTER) then Event.key.keysym.sym := SDLK_RETURN; @@ -496,13 +506,15 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) + Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then + Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true) + Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin // check if screen wants to exit - Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), true); + Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit if Done then diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 19c54bee..5d816c9a 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -34,10 +34,11 @@ interface {$I switches.inc} uses - UTime, SysUtils, Classes, - UBeatTimer; + UTime, + UBeatTimer, + UPath; type TNoteType = (ntFreestyle, ntNormal, ntGolden); @@ -62,7 +63,7 @@ type Start: integer; // beat the fragment starts at Length: integer; // length in beats Tone: integer; // full range tone - Text: string; // text assigned to this fragment (a syllable, word, etc.) + Text: UTF8String; // text assigned to this fragment (a syllable, word, etc.) NoteType: TNoteType; // note-type: golden-note/freestyle etc. end; @@ -73,7 +74,7 @@ type PLine = ^TLine; TLine = record Start: integer; // the start beat of this line (<> start beat of the first note of this line) - Lyric: string; + Lyric: UTF8String; //LyricWidth: real; // @deprecated: width of the line in pixels. // Do not use this as the width is not correct. // Use TLyricsEngine.GetUpperLine().Width instead. @@ -315,7 +316,7 @@ type // soundcard output-devices information TAudioOutputDevice = class public - Name: string; // soundcard name + Name: UTF8String; // soundcard name end; TAudioOutputDeviceList = array of TAudioOutputDevice; @@ -324,7 +325,7 @@ type ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] function GetName: String; - function Open(const Filename: string): boolean; // true if succeed + function Open(const Filename: IPath): boolean; // true if succeed procedure Close; procedure Play; @@ -376,7 +377,7 @@ type // nil-pointers is not neccessary anymore. // PlaySound/StopSound will be removed then, OpenSound will be renamed to // CreateSound. - function OpenSound(const Filename: String): TAudioPlaybackStream; + function OpenSound(const Filename: IPath): TAudioPlaybackStream; procedure PlaySound(Stream: TAudioPlaybackStream); procedure StopSound(Stream: TAudioPlaybackStream); @@ -391,7 +392,7 @@ type IGenericDecoder = Interface ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] - function GetName(): String; + function GetName(): string; function InitializeDecoder(): boolean; function FinalizeDecoder(): boolean; //function IsSupported(const Filename: string): boolean; @@ -400,13 +401,13 @@ type (* IVideoDecoder = Interface( IGenericDecoder ) ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] - function Open(const Filename: string): TVideoDecodeStream; + function Open(const Filename: IPath): TVideoDecodeStream; end; *) IAudioDecoder = Interface( IGenericDecoder ) ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] - function Open(const Filename: string): TAudioDecodeStream; + function Open(const Filename: IPath): TAudioDecodeStream; end; IAudioInput = Interface @@ -456,7 +457,7 @@ const SOUNDID_CLICK = 5; LAST_SOUNDID = SOUNDID_CLICK; - BaseSoundFilenames: array[0..LAST_SOUNDID] of string = ( + BaseSoundFilenames: array[0..LAST_SOUNDID] of IPath = ( '%SOUNDPATH%/Common start.mp3', // Start '%SOUNDPATH%/Common back.mp3', // Back '%SOUNDPATH%/menu swoosh.mp3', // Swoosh @@ -497,7 +498,7 @@ type procedure StartBgMusic(); procedure PauseBgMusic(); // TODO - //function AddSound(Filename: string): integer; + //function AddSound(Filename: IPath): integer; //procedure RemoveSound(ID: integer); //function GetSound(ID: integer): TAudioPlaybackStream; //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default; @@ -533,7 +534,7 @@ uses UCommandLine, URecord, ULog, - UPath; + UPathUtils; var DefaultVideoPlayback : IVideoPlayback; @@ -654,7 +655,7 @@ begin FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do begin - CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]); + CurrentAudioDecoder := InterfaceList[i] as IAudioDecoder; if (not CurrentAudioDecoder.InitializeDecoder()) then begin Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName); @@ -671,7 +672,7 @@ begin FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do begin - CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]); + CurrentAudioPlayback := InterfaceList[i] as IAudioPlayback; if (CurrentAudioPlayback.InitializePlayback()) then begin DefaultAudioPlayback := CurrentAudioPlayback; @@ -686,7 +687,7 @@ begin FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do begin - CurrentAudioInput := IAudioInput(InterfaceList[i]); + CurrentAudioInput := InterfaceList[i] as IAudioInput; if (CurrentAudioInput.InitializeRecord()) then begin DefaultAudioInput := CurrentAudioInput; @@ -719,7 +720,7 @@ begin FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do begin - VideoInterface := IVideoPlayback(InterfaceList[i]); + VideoInterface := InterfaceList[i] as IVideoPlayback; if (VideoInterface.Init()) then begin DefaultVideoPlayback := VideoInterface; @@ -734,7 +735,7 @@ begin FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do begin - VisualInterface := IVideoVisualization(InterfaceList[i]); + VisualInterface := InterfaceList[i] as IVideoVisualization; if (VisualInterface.Init()) then begin DefaultVisualization := VisualInterface; @@ -748,7 +749,7 @@ begin // now that we have all interfaces, we can dump them // TODO: move this to another place - if FindCmdLineSwitch( cMediaInterfaces ) then + if FindCmdLineSwitch(cMediaInterfaces) then begin DumpMediaInterfaces(); halt; @@ -772,27 +773,27 @@ begin // finalize audio playback interfaces (should be done before the decoders) FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do - IAudioPlayback(InterfaceList[i]).FinalizePlayback(); + (InterfaceList[i] as IAudioPlayback).FinalizePlayback(); // finalize audio input interfaces FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do - IAudioInput(InterfaceList[i]).FinalizeRecord(); + (InterfaceList[i] as IAudioInput).FinalizeRecord(); // finalize audio decoder interfaces FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do - IAudioDecoder(InterfaceList[i]).FinalizeDecoder(); + (InterfaceList[i] as IAudioDecoder).FinalizeDecoder(); // finalize video interfaces FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do - IVideoPlayback(InterfaceList[i]).Finalize(); + (InterfaceList[i] as IVideoPlayback).Finalize(); // finalize audio decoder interfaces FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); for i := 0 to InterfaceList.Count-1 do - IVideoVisualization(InterfaceList[i]).Finalize(); + (InterfaceList[i] as IVideoVisualization).Finalize(); InterfaceList.Free; @@ -855,14 +856,14 @@ procedure TSoundLibrary.LoadSounds(); begin UnloadSounds(); - Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3'); - Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3'); - Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3'); - Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3'); - Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3'); - Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3'); + Start := AudioPlayback.OpenSound(SoundPath.Append('Common start.mp3')); + Back := AudioPlayback.OpenSound(SoundPath.Append('Common back.mp3')); + Swoosh := AudioPlayback.OpenSound(SoundPath.Append('menu swoosh.mp3')); + Change := AudioPlayback.OpenSound(SoundPath.Append('select music change music 50.mp3')); + Option := AudioPlayback.OpenSound(SoundPath.Append('option change col.mp3')); + Click := AudioPlayback.OpenSound(SoundPath.Append('rimshot022b.mp3')); - BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3'); + BGMusic := AudioPlayback.OpenSound(SoundPath.Append('Bebeto_-_Loop010.mp3')); if (BGMusic <> nil) then BGMusic.Loop := True; diff --git a/src/base/UNote.pas b/src/base/UNote.pas index 6da4cf07..8e5b709a 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -19,8 +19,8 @@ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UNote.pas $ - * $Id: UNote.pas 1626 2009-03-07 19:53:00Z k-m_schindler $ + * $URL$ + * $Id$ *} unit UNote; @@ -61,7 +61,7 @@ type PPLayer = ^TPlayer; TPlayer = record - Name: string; + Name: UTF8String; // Index in Teaminfo record TeamID: byte; @@ -129,7 +129,7 @@ uses UCommon, UGraphic, UGraphicClasses, - UPath, + UPathUtils, UPlatform, UThemes; diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 615418f1..52eb5a05 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -71,7 +71,7 @@ type procedure StartRound; procedure EndRound; function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: byte): string; + function GetWinnerString(Round: byte): UTF8String; end; var @@ -352,9 +352,9 @@ end; //---------- //GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or , //---------- -function TPartySession.GetWinnerString(Round: byte): string; +function TPartySession.GetWinnerString(Round: byte): UTF8String; var - Winners: array of string; + Winners: array of UTF8String; I: integer; begin Result := Language.Translate('PARTY_NOBODY'); diff --git a/src/base/UPath.pas b/src/base/UPath.pas index 2316ac02..03bd82eb 100644 --- a/src/base/UPath.pas +++ b/src/base/UPath.pas @@ -19,170 +19,1395 @@ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UPath.pas $ - * $Id: UPath.pas 1624 2009-03-06 23:45:10Z k-m_schindler $ + * $URL$ + * $Id$ *} unit UPath; -interface - {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$I switches.inc} +interface + uses SysUtils, - Classes; - -var - // Absolute Paths - GamePath: string; - SoundPath: string; - SongPaths: TStringList; - LogPath: string; - ThemePath: string; - SkinsPath: string; - ScreenshotsPath: string; - CoverPaths: TStringList; - LanguagesPath: string; - PluginPath: string; - VisualsPath: string; - FontPath: string; - ResourcesPath: string; - PlayListPath: string; - -function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean; -procedure InitializePaths; -procedure AddSongPath(const Path: string); + Classes, + IniFiles, + {$IFDEF MSWINDOWS} + TntClasses, + {$ENDIF} + UConfig, + UUnicodeUtils; + +type + IPath = interface; + + {** + * TUnicodeMemoryStream + *} + TUnicodeMemoryStream = class(TMemoryStream) + public + procedure LoadFromFile(const FileName: IPath); + procedure SaveToFile(const FileName: IPath); + end; + + {** + * Unicode capable IniFile implementation. + * TMemIniFile and TIniFile are not able to handle INI-files with + * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists + * and removes it from the internal string-list. + * UTF8Encoded is set accordingly. + *} + TUnicodeMemIniFile = class(TMemIniFile) + private + FFilename: IPath; + FUTF8Encoded: boolean; + public + constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce; + procedure UpdateFile; override; + property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded; + end; + + {** + * TBinaryFileStream (inherited from THandleStream) + *} + {$IFDEF MSWINDOWS} + TBinaryFileStream = class(TTntFileStream) + {$ELSE} + TBinaryFileStream = class(TFileStream) + {$ENDIF} + public + {** + * @seealso TFileStream.Create for valid Mode parameters + *} + constructor Create(const FileName: IPath; Mode: word); + end; + + {** + * TTextFileStream + *} + TTextFileStream = class(TStream) + protected + fLineBreak: RawByteString; + fFilename: IPath; + fMode: word; + + function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract; + public + constructor Create(Filename: IPath; Mode: word); + + function ReadString(): RawByteString; virtual; abstract; + function ReadLine(var Line: UTF8String): boolean; overload; + function ReadLine(var Line: AnsiString): boolean; overload; + + procedure WriteString(const Str: RawByteString); virtual; + procedure WriteLine(const Line: RawByteString); virtual; + + property LineBreak: RawByteString read fLineBreak write fLineBreak; + property Filename: IPath read fFilename; + end; + + {** + * TMemTextStream + *} + TMemTextFileStream = class(TTextFileStream) + private + fStream: TMemoryStream; + protected + function GetSize: int64; override; + + {** + * Copies fStream.Memory from StartPos to EndPos-1 to the result string; + *} + function CopyMemString(StartPos: int64; EndPos: int64): RawByteString; + public + constructor Create(Filename: IPath; Mode: word); + destructor Destroy(); override; + + function Read(var Buffer; Count: longint): longint; override; + function Write(const Buffer; Count: longint): longint; override; + function Seek(Offset: longint; Origin: word): longint; override; + function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override; + + function ReadLine(var Success: boolean): RawByteString; override; + function ReadString(): RawByteString; override; + end; + + {** + TUnicodeIniStream = class() + end; + *} + + {** + * pdKeep: Keep path as is, neither remove or append a delimiter + * pdAppend: Append a delimiter if path does not have a trailing one + * pdRemove: Remove a trailing delimiter from the path + *} + TPathDelimOption = (pdKeep, pdAppend, pdRemove); + + IPathDynArray = array of IPath; + + {** + * An IPath represents a filename, a directory or a filesystem path in general. + * It hides some of the operating system's specifics like path delimiters + * and encodings and provides an easy to use interface to handle them. + * Internally all paths are stored with the same path delimiter (PathDelim) + * and encoding (UTF-8). The transformation is already done AT THE CREATION of + * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between + * Unix and Windows style paths. + * + * Create new paths with one of the Path() functions. + * If you need a string representation use IPath.ToNative/ToUTF8/ToWide. + * Note that due to the path-delimiter and encoding transformation the string + * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'. + * + * It is recommended to use an IPath as long as possible without a string + * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI + * only on Windows. If you would use for example FileExists(MyPath.ToNative) + * it would not find a file which contains characters that are not in the + * current locale. Same applies to AssignFile(), TFileStream.Create() and + * everything else in the RTL that expects a filename. + * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions + * if the filename parameter is not of a UTF8String or WideString type. + * + * If you need to open a file use TBinaryStream or TFileStream instead. Many + * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods + * can be workaround. + * + * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot + * even pass a stream instead of a filename be aware that even if you know that + * a filename is ASCII only, subdirectories in an absolute path might contain + * some non-ASCII characters (for example the user's name) and hence might + * fail (if the characters are not in the current locale). + * It is rare but it happens. + * + * IMPORTANT: + * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems. + * Cwstring functions (WideUpperCase, ...) cannot be used by external threads + * as FPC uses Thread-Local-Storage for the implementation. As a result do not + * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads). + *} + IPath = interface + ['{686BF103-CE43-4598-B85D-A2C3AF950897}'] + {** + * Returns the path as an UTF8 encoded string. + * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) + * is used. If it is set to false the (more) portable '/' delimiter will used. + *} + function ToUTF8(UseNativeDelim: boolean = true): UTF8String; + + {** + * Returns the path as an UTF-16 encoded string. + * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) + * is used. If it is set to false the delimiter will be '/'. + *} + function ToWide(UseNativeDelim: boolean = true): WideString; + + {** + * Returns the path with the system's native encoding and path delimiter. + * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible) + * Mac: UTF8 + * Unix: UTF8 or ANSI according to LC_CTYPE + *} + function ToNative(): RawByteString; + + {** + * Note: File must be closed with FileClose(Handle) after usage + * @seealso SysUtils.FileOpen() + *} + function Open(Mode: longword): THandle; + + {** @seealso SysUtils.ExtractFileDrive() *} + function GetDrive(): IPath; + + {** @seealso SysUtils.ExtractFilePath() *} + function GetPath(): IPath; + + {** @seealso SysUtils.ExtractFileDir() *} + function GetDir(): IPath; + + {** @seealso SysUtils.ExtractFileName() *} + function GetName(): IPath; + + {** @seealso SysUtils.ExtractFileExtension() *} + function GetExtension(): IPath; + + {** + * Returns a copy of the path with the extension changed to Extension. + * The file itself is not changed, use Rename() for this task. + * @seealso SysUtils.ChangeFileExt() + *} + function SetExtension(const Extension: IPath): IPath; overload; + function SetExtension(const Extension: RawByteString): IPath; overload; + function SetExtension(const Extension: WideString): IPath; overload; + + {** + * Returns the representation of the path relative to Basename. + * Note that the basename must be terminated with a path delimiter + * otherwise the last path component will be ignored. + * @seealso SysUtils.ExtractRelativePath() + *} + function GetRelativePath(const BaseName: IPath): IPath; + + {** @seealso SysUtils.ExpandFileName() *} + function GetAbsolutePath(): IPath; + + {** + * Returns the concatenation of this path with Child. If this path does not + * end with a path delimiter one is inserted in front of the Child path. + * Example: Path('parent').Append(Path('child')) -> Path('parent/child') + *} + function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + + {** + * Splits the path into its components. Path delimiters are not removed from + * components. + * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir'] + *} + function SplitDirs(): IPathDynArray; + + {** + * Returns the parent directory or PATH_NONE if none exists. + *} + function GetParent(): IPath; + + {** + * Checks if this path is a subdir of or file inside Parent. + * If Direct is true this path must be a direct child. + * Example: C:\test\file is a direct child of C:\test and a child of C:\ + *} + function IsChildOf(const Parent: IPath; Direct: boolean): boolean; + + {** + * Adjusts the case of the path on case senstitive filesystems. + * If the path does not exist or the filesystem is case insensitive + * the original path will be returned. Otherwise a corrected copy. + *} + function AdjustCase(AdjustAllLevels: boolean): IPath; + + {** @seealso SysUtils.IncludeTrailingPathDelimiter() *} + function AppendPathDelim(): IPath; + + {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *} + function RemovePathDelim(): IPath; + + function Exists(): boolean; + function IsFile(): boolean; + function IsDirectory(): boolean; + function IsAbsolute(): boolean; + function GetFileAge(): integer; overload; + function GetFileAge(out FileDateTime: TDateTime): boolean; overload; + function GetAttr(): cardinal; + function SetAttr(Attr: Integer): boolean; + function IsReadOnly(): boolean; + function SetReadOnly(ReadOnly: boolean): boolean; + + {** + * Checks if this path points to nothing, that means the path consists of + * the empty string '' and hence equals PATH_NONE. + * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE). + * If IsUnset() returns true this path and PATH_NONE are equal but they must + * not be identical as the references might point to different objects. + * + * Example: + * Path('').Equals(PATH_EMPTY) -> true + * Path('') = PATH_EMPTY -> false + *} + function IsUnset(): boolean; + function IsSet(): boolean; + + {** + * Compares this path with Other and returns true if both paths are + * equal. Both paths are expanded and trailing slashes excluded before + * comparison. If IgnoreCase is true, the case will be ignored on + * case-sensitive filesystems. + *} + function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload; + function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload; + function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload; + + {** + * Searches for a file in DirList. The Result is nil if the file was + * not found. Use IFileSystem.FileFind() instead if you want to use + * wildcards. + * @seealso SysUtils.FileSearch() + *} + function FileSearch(const DirList: IPath): IPath; + + {** File must be closed with FileClose(Handle) after usage } + function CreateFile(): THandle; + function DeleteFile(): boolean; + function CreateDirectory(Force: boolean = false): boolean; + function DeleteEmptyDir(): boolean; + function Rename(const NewName: IPath): boolean; + function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; + + // TODO: Dirwatch stuff + // AddFileChangeListener(Listener: TFileChangeListener); + + {** + * Internal string representation. For debugging only. + *} + function GetIntern: UTF8String; + property Intern: UTF8String READ GetIntern; + end; + +{** + * Creates a new path with the given pathname. PathName can be either in UTF8 + * or the local encoding. + * Notes: + * - On Apple only UTF8 is supported + * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems) + *} +function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + +{** + * Creates a new path with the given UTF-16 pathname. + *} +function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + +{** + * Returns a singleton for Path(''). + *} +function PATH_NONE(): IPath; implementation uses - StrUtils, - UPlatform, - UCommandLine, - ULog; + RTLConsts, + UTextEncoding, + UFilesystem; + +{* + * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work + * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019). + * + * There are two (probably more) scenarios causes a program to crash: + * + * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will + * internally create a temporary variable to hold the result of Path('fail'). + * This temporary var is then passed as Self to GetParent(). Unfortunately FPC + * does already decrement the ref-count of the temporary var at the end of the + * call to Path('fail') and the ref-count drops to zero and the temp object + * is destroyed as FPC erroneously assumes that the temp is not used anymore. + * As a result the Self variable in GetParent() will be invalid, the same + * applies to TPathImpl.fName which reference count dropped to zero when the + * temp was destroyed. Hence GetParent() will likely crash. + * If it does not, ToUTF8() will either return some random string + * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash. + * Either way the result of ToUTF8() is messed up. + * This scenario applies whenever a function (or method) is called that returns + * an interfaced object (e.g. an IPath) and the result is used without storing + * a reference to it in a (temporary) variable first. + * + * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8(); + * + * will not crash but is very impractical and error-prone. Note that Tmp2 cannot + * be replaced with Tmp (see scenario 2). + * + * 2. Another situation this bug will ruin our lives is when a variable to an + * interfaced object is used at the left and right side of an assignment as in: + * MyPath := MyPath.GetParent() + * + * Although the bug is already fixed in the FPC development version 2.3.1 + * it will take quite some time till the next FPC release (> 2.2.4) in which + * this issue is fixed. + * + * To workaround this bug we use some very simple and stupid kind of garbage + * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList) + * to artificially increase the ref-count of the newly created object. + * This keeps the object alive when FPC's temporary variable comes to the end + * of its lifetime and the object's ref-count is decremented + * (and is now 1 instead of 0). + * Later on, the object is either garbage or referenced by another variable. + * + * Look at + * MyPath := Path('SomeDir/SubDir').GetParent() + * + * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore. + * (2) The result of GetParent() is referenced by MyPath + * Object (1) has a reference count of 1 (as it is only referenced by the + * GarbageList). Object (2) is referenced twice (MyPath + GarbageList). + * When the reference to (2) is finally stored in MyPath we can safely remove + * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of + * (2) will be decremented to 1. + * + * As we do not know when it is safe to remove an object from the GarbageList + * we assume that there are max. GarbageMaxCount IPath elements created until + * the execution of the expression is performed and a reference to the resulting + * object is assigned to a variable so all temps can be safely deleted. + * + * Worst-case scenarios are recursive calls or calls with large call stacks with + * functions that return an IPath. Also keep in mind that multiple threads might + * be executing such functions at the same time. + * A reasonable count might be a max. of 20.000 elements. With an average length + * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath + * this will consume ~1.2MB. + *} +{$IFDEF FPC} +{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4 + {$DEFINE HAVE_REFCNTBUG} +{$IFEND} +{$ENDIF} + +{$IFDEF HAVE_REFCNTBUG} +const + // when GarbageList.Count reaches GarbageMaxCount the oldest references in + // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount. + GarbageMaxCount = 20000; + GarbageAfterCleanCount = GarbageMaxCount-1000; + +var + GarbageList: IInterfaceList; +{$ENDIF} + +type + TPathImpl = class(TInterfacedObject, IPath) + private + fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim + + {** + * Unifies the filename. Path-delimiters are replaced by '/'. + *} + procedure Unify(DelimOption: TPathDelimOption); + + {** + * Returns a copy of fName with path delimiters changed to '/'. + *} + function GetPortableString(): UTF8String; + + procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF} + + public + constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption); + destructor Destroy(); override; + + function ToUTF8(UseNativeDelim: boolean): UTF8String; + function ToWide(UseNativeDelim: boolean): WideString; + function ToNative(): RawByteString; + + function Open(Mode: longword): THandle; + + function GetDrive(): IPath; + function GetPath(): IPath; + function GetDir(): IPath; + function GetName(): IPath; + function GetExtension(): IPath; + + function SetExtension(const Extension: IPath): IPath; overload; + function SetExtension(const Extension: RawByteString): IPath; overload; + function SetExtension(const Extension: WideString): IPath; overload; + + function GetRelativePath(const BaseName: IPath): IPath; + function GetAbsolutePath(): IPath; + function GetParent(): IPath; + function SplitDirs(): IPathDynArray; + + function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload; + function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload; + function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload; + + function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload; + function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload; + function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload; + + function IsChildOf(const Parent: IPath; Direct: boolean): boolean; + + function AdjustCase(AdjustAllLevels: boolean): IPath; + + function AppendPathDelim(): IPath; + function RemovePathDelim(): IPath; + + function GetFileAge(): integer; overload; + function GetFileAge(out FileDateTime: TDateTime): boolean; overload; + function Exists(): boolean; + function IsFile(): boolean; + function IsDirectory(): boolean; + function IsAbsolute(): boolean; + function GetAttr(): cardinal; + function SetAttr(Attr: Integer): boolean; + function IsReadOnly(): boolean; + function SetReadOnly(ReadOnly: boolean): boolean; + + function IsUnset(): boolean; + function IsSet(): boolean; + + function FileSearch(const DirList: IPath): IPath; + + function CreateFile(): THandle; + function DeleteFile(): boolean; + function CreateDirectory(Force: boolean): boolean; + function DeleteEmptyDir(): boolean; + function Rename(const NewName: IPath): boolean; + function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; + + function GetIntern(): UTF8String; + end; + +function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath; +begin + if (IsUTF8String(PathName)) then + Result := TPathImpl.Create(PathName, DelimOption) + else if (IsNativeUTF8()) then + Result := PATH_NONE + else + Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption); +end; + +function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath; +begin + Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption); +end; + + + +procedure TPathImpl.AssertRefCount; +begin + {$IFDEF HAVE_REFCNTBUG} + if (FRefCount <= 0) then + raise Exception.Create('RefCount error: ' + IntToStr(FRefCount)); + {$ENDIF} +end; + +constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption); +begin + inherited Create(); + fName := Name; + Unify(DelimOption); + {$IFDEF HAVE_REFCNTBUG} + GarbageList.Lock; + if (GarbageList.Count >= GarbageMaxCount) then + begin + while (GarbageList.Count > GarbageAfterCleanCount) do + GarbageList.Delete(0); + end; + GarbageList.Add(Self); + GarbageList.Unlock; + {$ENDIF} +end; + +destructor TPathImpl.Destroy(); +begin + inherited; +end; + +procedure TPathImpl.Unify(DelimOption: TPathDelimOption); +var + I: integer; +begin + // convert all path delimiters to native ones + for I := 1 to Length(fName) do + begin + if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then + fName[I] := PathDelim; + end; + + // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter + case DelimOption of + pdAppend: fName := IncludeTrailingPathDelimiter(fName); + pdRemove: fName := ExcludeTrailingPathDelimiter(fName); + end; +end; + +function TPathImpl.GetPortableString(): UTF8String; +var + I: integer; +begin + Result := fName; + if (PathDelim = '/') then + Exit; + + for I := 1 to Length(Result) do + begin + if (Result[I] = PathDelim) then + Result[I] := '/'; + end; +end; + +function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String; +begin + AssertRefCount; + + if (UseNativeDelim) then + Result := fName + else + Result := GetPortableString(); +end; + +function TPathImpl.ToWide(UseNativeDelim: boolean): WideString; +begin + if (UseNativeDelim) then + Result := UTF8Decode(fName) + else + Result := UTF8Decode(GetPortableString()); +end; + +function TPathImpl.ToNative(): RawByteString; +begin + if (IsNativeUTF8()) then + Result := fName + else + Result := Utf8ToAnsi(fName); +end; + +function TPathImpl.GetDrive(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileDrive(Self); +end; + +function TPathImpl.GetPath(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFilePath(Self); +end; + +function TPathImpl.GetDir(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileDir(Self); +end; + +function TPathImpl.GetName(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileName(Self); +end; + +function TPathImpl.GetExtension(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileExt(Self); +end; + +function TPathImpl.SetExtension(const Extension: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.ChangeFileExt(Self, Extension); +end; + +function TPathImpl.SetExtension(const Extension: RawByteString): IPath; +begin + Result := SetExtension(Path(Extension)); +end; + +function TPathImpl.SetExtension(const Extension: WideString): IPath; +begin + Result := SetExtension(Path(Extension)); +end; + +function TPathImpl.GetRelativePath(const BaseName: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractRelativePath(BaseName, Self); +end; + +function TPathImpl.GetAbsolutePath(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExpandFileName(Self); +end; + +function TPathImpl.GetParent(): IPath; +var + CurPath, ParentPath: IPath; +begin + AssertRefCount; + + Result := PATH_NONE; + + CurPath := Self.RemovePathDelim(); + // check if current path has a parent (no further '/') + if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then + Exit; + + // set new path and check if it has changed to avoid endless loops + // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too) + // on delphi/win32 + ParentPath := CurPath.GetPath(); + if (ParentPath.ToUTF8 = CurPath.ToUTF8) then + Exit; + + Result := ParentPath; +end; + +function TPathImpl.SplitDirs(): IPathDynArray; +var + CurPath: IPath; + Components: array of IPath; + CurPathStr: UTF8String; + DelimPos: integer; + I: integer; +begin + SetLength(Result, 0); + + if (Length(Self.ToUTF8(true)) = 0) then + Exit; + + CurPath := Self; + SetLength(Components, 0); + repeat + SetLength(Components, Length(Components)+1); + + CurPathStr := CurPath.ToUTF8(); + DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr)); + Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr))); + + CurPath := CurPath.GetParent(); + until (CurPath = PATH_NONE); + + // reverse list + SetLength(Result, Length(Components)); + for I := 0 to High(Components) do + Result[I] := Components[High(Components)-I]; +end; + +function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; +var + TmpResult: IPath; +begin + AssertRefCount; + + if (fName = '') then + TmpResult := Child + else + TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8()); + + case DelimOption of + pdKeep: Result := TmpResult; + pdAppend: Result := TmpResult.AppendPathDelim; + pdRemove: Result := TmpResult.RemovePathDelim; + end; +end; + +function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; +begin + AssertRefCount; + Result := Append(Path(Child), DelimOption); +end; + +function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; +begin + AssertRefCount; + Result := Append(Path(Child), DelimOption); +end; + +function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean; +var + SelfPath, OtherPath: UTF8String; +begin + SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8(); + OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8(); + if (FileSystem.IsCaseSensitive() and not IgnoreCase) then + Result := (CompareStr(SelfPath, OtherPath) = 0) + else + Result := (CompareText(SelfPath, OtherPath) = 0); +end; -procedure AddSpecialPath(var PathList: TStringList; const Path: string); +function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; +begin + Result := Equals(Path(Other), IgnoreCase); +end; + +function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean; +begin + Result := Equals(Path(Other), IgnoreCase); +end; + +function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean; var - Index: integer; - PathAbs, OldPathAbs: string; + SelfPath, ParentPath: UTF8String; begin - if (PathList = nil) then - PathList := TStringList.Create; + Result := false; + + if (Direct) then + begin + SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8(); + ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); + + // simply check if this paths parent path (SelfPath) equals ParentPath + Result := (SelfPath = ParentPath); + end + else + begin + SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8(); + ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); - if (Path = '') or not ForceDirectories(Path) then + if (Length(SelfPath) <= Length(ParentPath)) then + Exit; + + // check if ParentPath is a substring of SelfPath + if (FileSystem.IsCaseSensitive()) then + Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) + else + Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) + end; +end; + +function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath; +var + OldParent, AdjustedParent: IPath; + LocalName: IPath; + PathFound: IPath; + PathWithAdjParent: IPath; + SearchInfo: TFileInfo; + FileIter: IFileIterator; + Pattern: IPath; +begin + // if case-sensitive path exists there is no need to adjust case + if (CurPath.Exists()) then + begin + Result := CurPath; Exit; + end; + + LocalName := CurPath.RemovePathDelim().GetName(); - PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path)); + // try to adjust parent + OldParent := CurPath.GetParent(); + if (OldParent <> PATH_NONE) then + begin + if (not AdjustAllLevels) then + begin + AdjustedParent := OldParent; + end + else + begin + AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels); + if (AdjustedParent = nil) then + begin + // parent path was not found case-insensitive + Result := nil; + Exit; + end; - // check if path or a part of the path was already added - for Index := 0 to PathList.Count-1 do + // check if the path with adjusted parent can be found now + PathWithAdjParent := AdjustedParent.Append(LocalName); + if (PathWithAdjParent.Exists()) then + begin + Result := PathWithAdjParent; + Exit; + end; + end; + Pattern := AdjustedParent.Append(Path('*')); + end + else // path has no parent begin - OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[Index])); - // check if the new directory is a sub-directory of a previously added one. - // This is also true, if both paths point to the same directories. - if (AnsiStartsText(OldPathAbs, PathAbs)) then + // the top path can either be absolute or relative + if (CurPath.IsAbsolute) then begin - // ignore the new path + // the only absolute directory at Unix without a parent is root ('/') + // and hence does not need to be adjusted + Result := CurPath; Exit; end; + // this is a relative path, search in the current working dir + AdjustedParent := nil; + Pattern := Path('*'); + end; - // check if a previously added directory is a sub-directory of the new one. - if (AnsiStartsText(PathAbs, OldPathAbs)) then + // compare name with all files in the current directory case-insensitive + FileIter := FileSystem.FileFind(Pattern, faAnyFile); + while (FileIter.HasNext()) do + begin + SearchInfo := FileIter.Next(); + PathFound := SearchInfo.Name; + if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then begin - // replace the old with the new one. - PathList[Index] := PathAbs; + if (AdjustedParent <> nil) then + Result := AdjustedParent.Append(PathFound) + else + Result := PathFound; Exit; end; end; - PathList.Add(PathAbs); + // no matching file found + Result := nil; end; -procedure AddSongPath(const Path: string); +function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath; begin - AddSpecialPath(SongPaths, Path); + AssertRefCount; + + Result := Self; + + if (FileSystem.IsCaseSensitive) then + begin + Result := AdjustCaseRecursive(Self, AdjustAllLevels); + if (Result = nil) then + Result := Self; + end; end; -procedure AddCoverPath(const Path: string); +function TPathImpl.AppendPathDelim(): IPath; begin - AddSpecialPath(CoverPaths, Path); + AssertRefCount; + Result := FileSystem.IncludeTrailingPathDelimiter(Self); end; -(** - * Initialize a path variable - * After setting paths, make sure that paths exist - *) -function FindPath(out PathResult: string; - const RequestedPath: string; - NeedsWritePermission: boolean) - : boolean; +function TPathImpl.RemovePathDelim(): IPath; begin - Result := false; + AssertRefCount; + Result := FileSystem.ExcludeTrailingPathDelimiter(Self); +end; - if (RequestedPath = '') then - Exit; +function TPathImpl.CreateFile(): THandle; +begin + Result := FileSystem.FileCreate(Self); +end; + +function TPathImpl.CreateDirectory(Force: boolean): boolean; +begin + if (Force) then + Result := FileSystem.ForceDirectories(Self) + else + Result := FileSystem.DirectoryCreate(Self); +end; + +function TPathImpl.Open(Mode: longword): THandle; +begin + Result := FileSystem.FileOpen(Self, Mode); +end; + +function TPathImpl.GetFileAge(): integer; +begin + Result := FileSystem.FileAge(Self); +end; + +function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean; +begin + Result := FileSystem.FileAge(Self, FileDateTime); +end; + +function TPathImpl.Exists(): boolean; +begin + // note the different specifications of FileExists() on Win32 <> Unix + {$IFDEF MSWINDOWS} + Result := IsFile() or IsDirectory(); + {$ELSE} + Result := FileSystem.FileExists(Self); + {$ENDIF} +end; + +function TPathImpl.IsFile(): boolean; +begin + // note the different specifications of FileExists() on Win32 <> Unix + {$IFDEF MSWINDOWS} + Result := FileSystem.FileExists(Self); + {$ELSE} + Result := Exists() and not IsDirectory(); + {$ENDIF} +end; + +function TPathImpl.IsDirectory(): boolean; +begin + Result := FileSystem.DirectoryExists(Self); +end; + +function TPathImpl.IsAbsolute(): boolean; +begin + AssertRefCount; + Result := FileSystem.FileIsReadOnly(Self); +end; + +function TPathImpl.GetAttr(): cardinal; +begin + Result := FileSystem.FileGetAttr(Self); +end; + +function TPathImpl.SetAttr(Attr: Integer): boolean; +begin + Result := FileSystem.FileSetAttr(Self, Attr); +end; + +function TPathImpl.IsReadOnly(): boolean; +begin + Result := FileSystem.FileIsReadOnly(Self); +end; + +function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean; +begin + Result := FileSystem.FileSetReadOnly(Self, ReadOnly); +end; + +function TPathImpl.IsUnset(): boolean; +begin + Result := (fName = ''); +end; + +function TPathImpl.IsSet(): boolean; +begin + Result := (fName <> ''); +end; + +function TPathImpl.FileSearch(const DirList: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.FileSearch(Self, DirList); +end; + +function TPathImpl.Rename(const NewName: IPath): boolean; +begin + Result := FileSystem.RenameFile(Self, NewName); +end; + +function TPathImpl.DeleteFile(): boolean; +begin + Result := FileSystem.DeleteFile(Self); +end; + +function TPathImpl.DeleteEmptyDir(): boolean; +begin + Result := FileSystem.RemoveDir(Self); +end; + +function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean; +begin + Result := FileSystem.CopyFile(Self, Target, FailIfExists); +end; + +function TPathImpl.GetIntern(): UTF8String; +begin + Result := fName; +end; + + +{ TBinaryFileStream } + +constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word); +begin +{$IFDEF MSWINDOWS} + inherited Create(FileName.ToWide(), Mode); +{$ELSE} + inherited Create(FileName.ToNative(), Mode); +{$ENDIF} +end; - // Make sure the directory exists - if (not ForceDirectories(RequestedPath)) then +{ TTextStream } + +constructor TTextFileStream.Create(Filename: IPath; Mode: word); +begin + inherited Create(); + fMode := Mode; + fFilename := Filename; + fLineBreak := sLineBreak; +end; + +function TTextFileStream.ReadLine(var Line: UTF8String): boolean; +begin + Line := ReadLine(Result); +end; + +function TTextFileStream.ReadLine(var Line: AnsiString): boolean; +begin + Line := ReadLine(Result); +end; + +procedure TTextFileStream.WriteString(const Str: RawByteString); +begin + WriteBuffer(Str[1], Length(Str)); +end; + +procedure TTextFileStream.WriteLine(const Line: RawByteString); +begin + WriteBuffer(Line[1], Length(Line)); + WriteBuffer(fLineBreak[1], Length(fLineBreak)); +end; + +{ TMemTextStream } + +constructor TMemTextFileStream.Create(Filename: IPath; Mode: word); +var + FileStream: TBinaryFileStream; +begin + inherited Create(Filename, Mode); + + fStream := TMemoryStream.Create(); + + // load data to memory in read mode + if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then begin - PathResult := ''; - Exit; + FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); + try + fStream.LoadFromStream(FileStream); + finally + FileStream.Free; + end; + end + // check if file exists for write-mode + else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then + begin + raise EFOpenError.CreateResFmt(@SFOpenError, + [FileName.GetAbsolutePath.ToNative]); + end; +end; + +destructor TMemTextFileStream.Destroy(); +var + FileStream: TBinaryFileStream; + SaveMode: word; +begin + // save changes in write mode (= not read-only mode) + if ((fMode and 3) <> fmOpenRead) then + begin + if (fMode = fmCreate) then + SaveMode := fmCreate + else + SaveMode := fmOpenWrite; + FileStream := TBinaryFileStream.Create(fFilename, SaveMode); + try + fStream.SaveToStream(FileStream); + finally + FileStream.Free; + end; end; - PathResult := IncludeTrailingPathDelimiter(RequestedPath); + fStream.Free; + inherited; +end; + +function TMemTextFileStream.GetSize: int64; +begin + Result := fStream.Size; +end; + +function TMemTextFileStream.Read(var Buffer; Count: longint): longint; +begin + Result := fStream.Read(Buffer, Count); +end; + +function TMemTextFileStream.Write(const Buffer; Count: longint): longint; +begin + Result := fStream.Write(Buffer, Count); +end; - if (NeedsWritePermission) and - (FileIsReadOnly(RequestedPath)) then +function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint; +begin + Result := fStream.Seek(Offset, Origin); +end; + +function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64; +begin + Result := fStream.Seek(Offset, Origin); +end; + +function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString; +var + LineLength: cardinal; + Temp: RawByteString; +begin + LineLength := EndPos - StartPos; + if (LineLength > 0) then begin - Exit; + // set string length to line-length (+ zero-terminator) + SetLength(Temp, LineLength); + StrLCopy(PAnsiChar(Temp), + @PAnsiChar(fStream.Memory)[StartPos], + LineLength); + Result := Temp; + end + else + begin + Result := ''; + end; +end; + +function TMemTextFileStream.ReadString(): RawByteString; +var + TextPtr: PAnsiChar; + CurPos, StartPos, FileSize: int64; +begin + TextPtr := PAnsiChar(fStream.Memory); + CurPos := Position; + FileSize := Size; + StartPos := -1; + + while (CurPos < FileSize) do + begin + // check for whitespace (tab, lf, cr, space) + if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then + begin + // check if we are at the end of a string + if (StartPos > -1) then + Break; + end + else if (StartPos = -1) then // start of string found + begin + StartPos := CurPos; + end; + Inc(CurPos); end; - Result := true; + if (StartPos = -1) then + Result := '' + else + begin + Result := CopyMemString(StartPos, CurPos); + fStream.Position := CurPos; + end; end; -(** - * Function sets all absolute paths e.g. song path and makes sure the directorys exist - *) -procedure InitializePaths; +{* + * Implementation of ReadLine(). We need separate versions for UTF8String + * and AnsiString as "var" parameter types have to fit exactly. + * To avoid a var-parameter here, the internal version the Line parameter is + * used as return value. + *} +function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString; +var + TextPtr: PAnsiChar; + CurPos, FileSize: int64; begin - // Log directory (must be writable) - if (not FindPath(LogPath, Platform.GetLogPath, true)) then + TextPtr := PAnsiChar(fStream.Memory); + CurPos := fStream.Position; + FileSize := Size; + + // check for EOF + if (CurPos >= FileSize) then begin - Log.FileOutputEnabled := false; - Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths'); + Result := ''; + Success := false; + Exit; + end; + + Success := true; + + while (CurPos < FileSize) do + begin + if (TextPtr[CurPos] in [#10, #13]) then + begin + // copy text line + Result := CopyMemString(fStream.Position, CurPos); + + // handle windows style #13#10 (\r\n) newlines + if (TextPtr[CurPos] = #13) and + (CurPos+1 < FileSize) and + (TextPtr[CurPos+1] = #10) then + begin + Inc(CurPos); + end; + + // update stream pos + fStream.Position := CurPos+1; + + Exit; + end; + Inc(CurPos); + end; + + Result := CopyMemString(fStream.Position, CurPos); + fStream.Position := FileSize; +end; + +{ TUnicodeMemoryStream } + +procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath); +var + Stream: TStream; +begin + Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; end; +end; - FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false); - FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false); - FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false); - FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false); - FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false); - FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false); - FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false); - FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false); +procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath); +var + Stream: TStream; +begin + Stream := TBinaryFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +{ TUnicodeMemIniFile } - // Playlists are not shared as we need one directory to write too - FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true); +constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean); +var + List: TStringList; + Stream: TBinaryFileStream; + BOMBuf: array[0..2] of AnsiChar; +begin + inherited Create(''); + FFilename := FileName; + FUTF8Encoded := UTF8Encoded; - // Screenshot directory (must be writable) - if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then + if FileName.Exists() then begin - Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths'); + List := nil; + Stream := nil; + try + List := TStringList.Create; + Stream := TBinaryFileStream.Create(FileName, fmOpenRead); + if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and + (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then + begin + // truncate BOM + FUTF8Encoded := true; + end + else + begin + // rewind file + Stream.Seek(0, soBeginning); + end; + List.LoadFromStream(Stream); + SetStrings(List); + finally + Stream.Free; + List.Free; + end; end; +end; - // Add song paths - AddSongPath(Params.SongPath); - AddSongPath(Platform.GetGameSharedPath + 'songs'); - AddSongPath(Platform.GetGameUserPath + 'songs'); +procedure TUnicodeMemIniFile.UpdateFile; +var + List: TStringList; + Stream: TBinaryFileStream; +begin + List := nil; + Stream := nil; + try + List := TStringList.Create; + GetStrings(List); + Stream := TBinaryFileStream.Create(FFileName, fmCreate); + if UTF8Encoded then + Stream.Write(UTF8_BOM, Length(UTF8_BOM)); + List.SaveToStream(Stream); + finally + List.Free; + Stream.Free; + end; +end; - // Add category cover paths - AddCoverPath(Platform.GetGameSharedPath + 'covers'); - AddCoverPath(Platform.GetGameUserPath + 'covers'); + +var + PATH_NONE_Singelton: IPath; + +function PATH_NONE(): IPath; +begin + Result := PATH_NONE_Singelton; end; +initialization + {$IFDEF HAVE_REFCNTBUG} + GarbageList := TInterfaceList.Create(); + GarbageList.Capacity := GarbageMaxCount; + {$ENDIF} + PATH_NONE_Singelton := Path(''); + +finalization + PATH_NONE_Singelton := nil; + end. diff --git a/src/base/UPathUtils.pas b/src/base/UPathUtils.pas new file mode 100644 index 00000000..c2bcdd4b --- /dev/null +++ b/src/base/UPathUtils.pas @@ -0,0 +1,196 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UPathUtils; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + SysUtils, + Classes, + UPath; + +var + // Absolute Paths + GamePath: IPath; + SoundPath: IPath; + SongPaths: IInterfaceList; + LogPath: IPath; + ThemePath: IPath; + SkinsPath: IPath; + ScreenshotsPath: IPath; + CoverPaths: IInterfaceList; + LanguagesPath: IPath; + PluginPath: IPath; + VisualsPath: IPath; + FontPath: IPath; + ResourcesPath: IPath; + PlaylistPath: IPath; + +function FindPath(out PathResult: IPath; const RequestedPath: IPath; NeedsWritePermission: boolean): boolean; +procedure InitializePaths; +procedure AddSongPath(const Path: IPath); + +implementation + +uses + StrUtils, + UPlatform, + UCommandLine, + ULog; + +procedure AddSpecialPath(var PathList: IInterfaceList; const Path: IPath); +var + Index: integer; + PathAbs, PathTmp: IPath; + OldPath, OldPathAbs, OldPathTmp: IPath; +begin + if (PathList = nil) then + PathList := TInterfaceList.Create; + + if Path.Equals(PATH_NONE) or not Path.CreateDirectory(true) then + Exit; + + PathTmp := Path.GetAbsolutePath(); + PathAbs := PathTmp.AppendPathDelim(); + + // check if path or a part of the path was already added + for Index := 0 to PathList.Count-1 do + begin + OldPath := PathList[Index] as IPath; + OldPathTmp := OldPath.GetAbsolutePath(); + OldPathAbs := OldPathTmp.AppendPathDelim(); + + // check if the new directory is a sub-directory of a previously added one. + // This is also true, if both paths point to the same directories. + if (OldPathAbs.IsChildOf(PathAbs, false) or OldPathAbs.Equals(PathAbs)) then + begin + // ignore the new path + Exit; + end; + + // check if a previously added directory is a sub-directory of the new one. + if (PathAbs.IsChildOf(OldPathAbs, false)) then + begin + // replace the old with the new one. + PathList[Index] := PathAbs; + Exit; + end; + end; + + PathList.Add(PathAbs); +end; + +procedure AddSongPath(const Path: IPath); +begin + AddSpecialPath(SongPaths, Path); +end; + +procedure AddCoverPath(const Path: IPath); +begin + AddSpecialPath(CoverPaths, Path); +end; + +(** + * Initialize a path variable + * After setting paths, make sure that paths exist + *) +function FindPath( + out PathResult: IPath; + const RequestedPath: IPath; + NeedsWritePermission: boolean): boolean; +begin + Result := false; + + if (RequestedPath.Equals(PATH_NONE)) then + Exit; + + // Make sure the directory exists + if (not RequestedPath.CreateDirectory(true)) then + begin + PathResult := PATH_NONE; + Exit; + end; + + PathResult := RequestedPath.AppendPathDelim(); + + if (NeedsWritePermission) and RequestedPath.IsReadOnly() then + Exit; + + Result := true; +end; + +(** + * Function sets all absolute paths e.g. song path and makes sure the directorys exist + *) +procedure InitializePaths; +var + SharedPath, UserPath: IPath; +begin + // Log directory (must be writable) + if (not FindPath(LogPath, Platform.GetLogPath, true)) then + begin + Log.FileOutputEnabled := false; + Log.LogWarn('Log directory "'+ Platform.GetLogPath.ToNative +'" not available', 'InitializePaths'); + end; + + SharedPath := Platform.GetGameSharedPath; + UserPath := Platform.GetGameUserPath; + + FindPath(SoundPath, SharedPath.Append('sounds'), false); + FindPath(ThemePath, SharedPath.Append('themes'), false); + FindPath(SkinsPath, SharedPath.Append('themes'), false); + FindPath(LanguagesPath, SharedPath.Append('languages'), false); + FindPath(PluginPath, SharedPath.Append('plugins'), false); + FindPath(VisualsPath, SharedPath.Append('visuals'), false); + FindPath(FontPath, SharedPath.Append('fonts'), false); + FindPath(ResourcesPath, SharedPath.Append('resources'), false); + + // Playlists are not shared as we need one directory to write too + FindPath(PlaylistPath, UserPath.Append('playlists'), true); + + // Screenshot directory (must be writable) + if (not FindPath(ScreenshotsPath, UserPath.Append('screenshots'), true)) then + begin + Log.LogWarn('Screenshot directory "'+ UserPath.ToNative +'" not available', 'InitializePaths'); + end; + + // Add song paths + AddSongPath(Params.SongPath); + AddSongPath(SharedPath.Append('songs')); + AddSongPath(UserPath.Append('songs')); + + // Add category cover paths + AddCoverPath(SharedPath.Append('covers')); + AddCoverPath(UserPath.Append('covers')); +end; + +end. diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index 6f13481c..11c67fa7 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -39,28 +39,20 @@ interface {$I switches.inc} uses - Classes; + Classes, + UPath; type - TDirectoryEntry = record - Name: WideString; - IsDirectory: boolean; - IsFile: boolean; - end; - - TDirectoryEntryArray = array of TDirectoryEntry; - TPlatform = class - function GetExecutionDir(): string; + function GetExecutionDir(): IPath; procedure Init; virtual; - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract; + function TerminateIfAlreadyRunning(var WndTitle: string): boolean; virtual; - function FindSongFile(Dir, Mask: WideString): WideString; virtual; procedure Halt; virtual; - function GetLogPath: WideString; virtual; abstract; - function GetGameSharedPath: WideString; virtual; abstract; - function GetGameUserPath: WideString; virtual; abstract; - function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual; + + function GetLogPath: IPath; virtual; abstract; + function GetGameSharedPath: IPath; virtual; abstract; + function GetGameUserPath: IPath; virtual; abstract; end; function Platform(): TPlatform; @@ -76,7 +68,9 @@ uses {$ELSEIF Defined(UNIX)} UPlatformLinux, {$IFEND} - ULog; + ULog, + UUnicodeUtils, + UFilesystem; // I modified it to use the Platform_singleton in this location (in the implementation) @@ -109,9 +103,13 @@ end; {** * Returns the directory of the executable *} -function TPlatform.GetExecutionDir(): string; +function TPlatform.GetExecutionDir(): IPath; +var + ExecName, ExecDir: IPath; begin - Result := ExpandFileName(ExtractFilePath(ParamStr(0))); + ExecName := Path(ParamStr(0)); + ExecDir := ExecName.GetPath; + Result := ExecDir.GetAbsolutePath(); end; (** @@ -122,65 +120,6 @@ begin Result := false; end; -(** - * Default FindSongFile() implementation - *) -function TPlatform.FindSongFile(Dir, Mask: WideString): WideString; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then - begin - Result := SR.Name; - end; - SysUtils.FindClose(SR); -end; - -function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; -const - COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption -var - SourceFile, TargetFile: TFileStream; - FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer. - NumberOfBytes: integer; // number of bytes read from SourceFile -begin - Result := false; - SourceFile := nil; - TargetFile := nil; - - // if overwrite is disabled return if the target file already exists - if (FailIfExists and FileExists(Target)) then - Exit; - - try - try - // open source and target file (might throw an exception on error) - SourceFile := TFileStream.Create(Source, fmOpenRead); - TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite); - - while true do - begin - // read a block from the source file and check for errors or EOF - NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer)); - if (NumberOfBytes <= 0) then - Break; - // write block to target file and check if everything was written - if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then - Exit; - end; - except - Exit; - end; - finally - SourceFile.Free; - TargetFile.Free; - end; - - Result := true; -end; - - initialization {$IF Defined(MSWINDOWS)} Platform_singleton := TPlatformWindows.Create; diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas index 30499a97..693facaa 100644 --- a/src/base/UPlatformLinux.pas +++ b/src/base/UPlatformLinux.pas @@ -36,7 +36,8 @@ interface uses Classes, UPlatform, - UConfig; + UConfig, + UPath; type TPlatformLinux = class(TPlatform) @@ -44,15 +45,13 @@ type UseLocalDirs: boolean; procedure DetectLocalExecution(); - function GetHomeDir(): string; + function GetHomeDir(): IPath; public procedure Init; override; - - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; - - function GetLogPath : WideString; override; - function GetGameSharedPath : WideString; override; - function GetGameUserPath : WideString; override; + + function GetLogPath : IPath; override; + function GetGameSharedPath : IPath; override; + function GetGameUserPath : IPath; override; end; implementation @@ -60,9 +59,7 @@ implementation uses UCommandLine, BaseUnix, - {$IF FPC_VERSION_INT >= 2002002} pwd, - {$IFEND} SysUtils, ULog; @@ -88,114 +85,65 @@ end; *} procedure TPlatformLinux.DetectLocalExecution(); var - LocalDir: string; + LocalDir, LanguageDir: IPath; begin - LocalDir := GetExecutionDir(); - // we just check if the 'languages' folder exists in the // directory of the executable. If so -> local execution. - UseLocalDirs := (DirectoryExists(LocalDir + 'languages')); -end; - -function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; -var - i: Integer; - TheDir : pDir; - ADirent : pDirent; - Entry : Longint; - lAttrib : integer; -begin - i := 0; - Filter := LowerCase(Filter); - - TheDir := FpOpenDir( Dir ); - if Assigned(TheDir) then - begin - repeat - ADirent := FpReadDir(TheDir^); - - if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); - if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until (ADirent = nil); - - FpCloseDir(TheDir^); - end; + LocalDir := GetExecutionDir(); + LanguageDir := LocalDir.Append('languages'); + UseLocalDirs := LanguageDir.IsDirectory; end; -function TPlatformLinux.GetLogPath: WideString; +function TPlatformLinux.GetLogPath: IPath; begin if UseLocalDirs then Result := GetExecutionDir() else - Result := GetGameUserPath() + 'logs/'; + Result := GetGameUserPath().Append('logs', pdAppend); // create non-existing directories - ForceDirectories(Result); + Result.CreateDirectory(true); end; -function TPlatformLinux.GetGameSharedPath: WideString; +function TPlatformLinux.GetGameSharedPath: IPath; begin if UseLocalDirs then Result := GetExecutionDir() else - Result := IncludeTrailingPathDelimiter(INSTALL_DATADIR); + Result := Path(INSTALL_DATADIR, pdAppend); end; -function TPlatformLinux.GetGameUserPath: WideString; +function TPlatformLinux.GetGameUserPath: IPath; begin if UseLocalDirs then Result := GetExecutionDir() else - Result := GetHomeDir() + '.ultrastardx/'; + Result := GetHomeDir().Append('.ultrastardx', pdAppend); end; {** * Returns the user's home directory terminated by a path delimiter *} -function TPlatformLinux.GetHomeDir(): string; -{$IF FPC_VERSION_INT >= 2002002} +function TPlatformLinux.GetHomeDir(): IPath; var PasswdEntry: PPasswd; -{$IFEND} begin - Result := ''; + Result := PATH_NONE; - {$IF FPC_VERSION_INT >= 2002002} // try to retrieve the info from passwd PasswdEntry := FpGetpwuid(FpGetuid()); if (PasswdEntry <> nil) then - Result := PasswdEntry.pw_dir; - {$IFEND} + Result := Path(PasswdEntry.pw_dir); // fallback if passwd does not contain the path - if (Result = '') then - Result := GetEnvironmentVariable('HOME'); + if (Result.IsUnset) then + Result := Path(GetEnvironmentVariable('HOME')); // add trailing path delimiter (normally '/') - if (Result <> '') then - Result := IncludeTrailingPathDelimiter(Result); + if (Result.IsSet) then + Result := Result.AppendPathDelim(); - {$IF FPC_VERSION_INT >= 2002002} // GetUserDir() is another function that returns a user path. // It uses env-var HOME or a fallback to a temp-dir. //Result := GetUserDir(); - {$IFEND} end; end. diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 96e4bc63..1dc0014a 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -36,7 +36,9 @@ interface uses Classes, ULog, - UPlatform; + UPlatform, + UFilesystem, + UPath; type {** @@ -93,19 +95,21 @@ type * GetBundlePath returns the path to the application bundle * UltraStarDeluxe.app. *} - function GetBundlePath: WideString; + function GetBundlePath: IPath; {** * GetApplicationSupportPath returns the path to * $HOME/Library/Application Support/UltraStarDeluxe. *} - function GetApplicationSupportPath: WideString; + function GetApplicationSupportPath: IPath; {** * see the description of @link(Init). *} procedure CreateUserFolders(); + function GetHomeDir(): IPath; + public {** * Init simply calls @link(CreateUserFolders), which in turn scans the @@ -115,38 +119,31 @@ type *} procedure Init; override; - {** - * DirectoryFindFiles returns all entries of a folder with names and - * booleans about their type, i.e. file or directory. - *} - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override; - {** * GetLogPath returns the path for log messages. Currently it is set to * $HOME/Library/Application Support/UltraStarDeluxe/Log. *} - function GetLogPath : WideString; override; + function GetLogPath : IPath; override; {** * GetGameSharedPath returns the path for shared resources. Currently it * is set to /Library/Application Support/UltraStarDeluxe. * However it is not used. *} - function GetGameSharedPath : WideString; override; + function GetGameSharedPath : IPath; override; {** * GetGameUserPath returns the path for user resources. Currently it is * set to $HOME/Library/Application Support/UltraStarDeluxe. * This is where a user can add songs, themes, .... *} - function GetGameUserPath : WideString; override; + function GetGameUserPath : IPath; override; end; implementation uses - SysUtils, - BaseUnix; + SysUtils; procedure TPlatformMacOSX.Init; begin @@ -154,178 +151,129 @@ begin end; procedure TPlatformMacOSX.CreateUserFolders(); -const - // used to construct the @link(UserPathName) - PathName: string = '/Library/Application Support/UltraStarDeluxe'; var - RelativePath: string; + RelativePath: IPath; // BaseDir contains the path to the folder, where a search is performed. // It is set to the entries in @link(DirectoryList) one after the other. - BaseDir: string; + BaseDir: IPath; // OldBaseDir contains the path to the folder, where the search started. // It is used to return to it, when the search is completed in all folders. - OldBaseDir: string; - // This record contains the result of a file search with FindFirst or FindNext - SearchInfo: TSearchRec; + OldBaseDir: IPath; + Iter: IFileIterator; + FileInfo: TFileInfo; + CurPath: IPath; // These two lists contain all folder and file names found // within the folder @link(BaseDir). - DirectoryList, FileList: TStringList; + DirectoryList, FileList: IInterfaceList; // DirectoryIsFinished contains the index of the folder in @link(DirectoryList), // which is the last one completely searched. Later folders are still to be // searched for additional files and folders. DirectoryIsFinished: longint; - Counter: longint; + I: longint; // These three are for creating directories, due to possible symlinks CreatedDirectory: boolean; FileAttrs: integer; - DirectoryPath: string; - - UserPathName: string; + DirectoryPath: IPath; + UserPath: IPath; + SrcFile, TgtFile: IPath; begin // Get the current folder and save it in OldBaseDir for returning to it, when // finished. - GetDir(0, OldBaseDir); + OldBaseDir := FileSystem.GetCurrentDir(); - // UltraStarDeluxe.app/Contents contains all the default files and - // folders. - BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents'; - ChDir(BaseDir); + // UltraStarDeluxe.app/Contents contains all the default files and folders. + BaseDir := OldBaseDir.Append('UltraStarDeluxe.app/Contents'); + FileSystem.SetCurrentDir(BaseDir); - // Right now, only $HOME/Library/Application Support/UltraStarDeluxe - // is used. - UserPathName := GetEnvironmentVariable('HOME') + PathName; + // Right now, only $HOME/Library/Application Support/UltraStarDeluxe is used. + UserPath := GetGameUserPath(); DirectoryIsFinished := 0; - DirectoryList := TStringList.Create(); - FileList := TStringList.Create(); - DirectoryList.Add('.'); + // replace with IInterfaceList + DirectoryList := TInterfaceList.Create(); + FileList := TInterfaceList.Create(); + DirectoryList.Add(Path('.')); // create the folder and file lists repeat - - RelativePath := DirectoryList[DirectoryIsFinished]; - ChDir(BaseDir + '/' + RelativePath); - if (FindFirst('*', faAnyFile, SearchInfo) = 0) then + RelativePath := (DirectoryList[DirectoryIsFinished] as IPath); + FileSystem.SetCurrentDir(BaseDir.Append(RelativePath)); + Iter := FileSystem.FileFind(Path('*'), faAnyFile); + while (Iter.HasNext) do begin - repeat - if DirectoryExists(SearchInfo.Name) then - begin - if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then - DirectoryList.Add(RelativePath + '/' + SearchInfo.Name); - end - else - Filelist.Add(RelativePath + '/' + SearchInfo.Name); - until (FindNext(SearchInfo) <> 0); + FileInfo := Iter.Next; + CurPath := FileInfo.Name; + if CurPath.IsDirectory() then + begin + if (not CurPath.Equals('.')) and (not CurPath.Equals('..')) then + DirectoryList.Add(RelativePath.Append(CurPath)); + end + else + Filelist.Add(RelativePath.Append(CurPath)); end; - FindClose(SearchInfo); Inc(DirectoryIsFinished); until (DirectoryIsFinished = DirectoryList.Count); // create missing folders - ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created. - for Counter := 0 to DirectoryList.Count-1 do + UserPath.CreateDirectory(true); // should not be necessary since (UserPathName+'/.') is created. + for I := 0 to DirectoryList.Count-1 do begin - DirectoryPath := UserPathName + '/' + DirectoryList[Counter]; - CreatedDirectory := ForceDirectories(DirectoryPath); - FileAttrs := FileGetAttr(DirectoryPath); - // Don't know how to analyse the target of the link. + CurPath := DirectoryList[I] as IPath; + DirectoryPath := UserPath.Append(CurPath); + CreatedDirectory := DirectoryPath.CreateDirectory(); + FileAttrs := DirectoryPath.GetAttr(); + // Maybe analyse the target of the link with FpReadlink(). // Let's assume the symlink is pointing to an existing directory. if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then - Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"', + Log.LogError('Failed to create the folder "'+ DirectoryPath.ToNative +'"', 'TPlatformMacOSX.CreateUserFolders'); end; - DirectoryList.Free(); // copy missing files - for Counter := 0 to Filelist.Count-1 do + for I := 0 to Filelist.Count-1 do begin - CopyFile(BaseDir + '/' + Filelist[Counter], - UserPathName + '/' + Filelist[Counter], true); + CurPath := Filelist[I] as IPath; + SrcFile := BaseDir.Append(CurPath); + TgtFile := UserPath.Append(CurPath); + SrcFile.CopyFile(TgtFile, true); end; - FileList.Free(); // go back to the initial folder - ChDir(OldBaseDir); + FileSystem.SetCurrentDir(OldBaseDir); end; -function TPlatformMacOSX.GetBundlePath: WideString; -var - i, pos : integer; +function TPlatformMacOSX.GetBundlePath: IPath; begin // Mac applications are packaged in folders. // Cutting the last two folders yields the application folder. - - Result := GetExecutionDir(); - for i := 1 to 2 do - begin - pos := Length(Result); - repeat - Delete(Result, pos, 1); - pos := Length(Result); - until (pos = 0) or (Result[pos] = '/'); - end; + Result := GetExecutionDir().GetParent().GetParent(); end; -function TPlatformMacOSX.GetApplicationSupportPath: WideString; +function TPlatformMacOSX.GetApplicationSupportPath: IPath; const - PathName : string = '/Library/Application Support/UltraStarDeluxe'; + PathName: string = 'Library/Application Support/UltraStarDeluxe'; begin - Result := GetEnvironmentVariable('HOME') + PathName + '/'; + Result := GetHomeDir().Append(PathName, pdAppend); end; -function TPlatformMacOSX.GetLogPath: WideString; +function TPlatformMacOSX.GetHomeDir(): IPath; begin - Result := GetApplicationSupportPath + 'Logs'; + Result := Path(GetEnvironmentVariable('HOME')); end; -function TPlatformMacOSX.GetGameSharedPath: WideString; +function TPlatformMacOSX.GetLogPath: IPath; begin - Result := GetApplicationSupportPath; + Result := GetApplicationSupportPath.Append('Logs'); end; -function TPlatformMacOSX.GetGameUserPath: WideString; +function TPlatformMacOSX.GetGameSharedPath: IPath; begin Result := GetApplicationSupportPath; end; -function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; -var - i : integer; - TheDir : pdir; - ADirent : pDirent; - lAttrib : integer; +function TPlatformMacOSX.GetGameUserPath: IPath; begin - i := 0; - Filter := LowerCase(Filter); - - TheDir := FPOpenDir(Dir); - if Assigned(TheDir) then - repeat - ADirent := FPReadDir(TheDir); - - if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then - begin - lAttrib := FileGetAttr(Dir + ADirent^.d_name); - if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then - begin - SetLength(Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then - begin - SetLength(Result, i + 1); - Result[i].Name := ADirent^.d_name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until ADirent = nil; - - FPCloseDir(TheDir); + Result := GetApplicationSupportPath; end; end. diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index e198958a..a0372dad 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -38,21 +38,19 @@ interface uses Classes, - UPlatform; + UPlatform, + UPath; type TPlatformWindows = class(TPlatform) private - function GetSpecialPath(CSIDL: integer): WideString; + function GetSpecialPath(CSIDL: integer): IPath; public - function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override; function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; - function GetLogPath: WideString; override; - function GetGameSharedPath: WideString; override; - function GetGameUserPath: WideString; override; - - function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override; + function GetLogPath: IPath; override; + function GetGameSharedPath: IPath; override; + function GetGameUserPath: IPath; override; end; implementation @@ -63,95 +61,6 @@ uses Windows, UConfig; -type - TSearchRecW = record - Time: Integer; - Size: Integer; - Attr: Integer; - Name: WideString; - ExcludeAttr: Integer; - FindHandle: THandle; - FindData: TWin32FindDataW; - end; - -function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward; -function FindNextW(var F: TSearchRecW): Integer; forward; -procedure FindCloseW(var F: TSearchRecW); forward; -function FindMatchingFileW(var F: TSearchRecW): Integer; forward; -function DirectoryExistsW(const Directory: widestring): Boolean; forward; - -function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer; -const - faSpecial = faHidden or faSysFile or faVolumeID or faDirectory; -begin - F.ExcludeAttr := not Attr and faSpecial; -{$IFDEF Delphi} - F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData); -{$ELSE} - F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData); -{$ENDIF} - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Result := FindMatchingFileW(F); - if Result <> 0 then FindCloseW(F); - end else - Result := GetLastError; -end; - -function FindNextW(var F: TSearchRecW): Integer; -begin -{$IFDEF Delphi} - if FindNextFileW(F.FindHandle, F.FindData) then -{$ELSE} - if FindNextFileW(F.FindHandle, @F.FindData) then -{$ENDIF} - Result := FindMatchingFileW(F) - else - Result := GetLastError; -end; - -procedure FindCloseW(var F: TSearchRecW); -begin - if F.FindHandle <> INVALID_HANDLE_VALUE then - begin - Windows.FindClose(F.FindHandle); - F.FindHandle := INVALID_HANDLE_VALUE; - end; -end; - -function FindMatchingFileW(var F: TSearchRecW): Integer; -var - LocalFileTime: TFileTime; -begin - with F do - begin - while FindData.dwFileAttributes and ExcludeAttr <> 0 do -{$IFDEF Delphi} - if not FindNextFileW(FindHandle, FindData) then -{$ELSE} - if not FindNextFileW(FindHandle, @FindData) then -{$ENDIF} - begin - Result := GetLastError; - Exit; - end; - FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime); - FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo); - Size := FindData.nFileSizeLow; - Attr := FindData.dwFileAttributes; - Name := FindData.cFileName; - end; - Result := 0; -end; - -function DirectoryExistsW(const Directory: widestring): Boolean; -var - Code: Integer; -begin - Code := GetFileAttributesW(PWideChar(Directory)); - Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0); -end; - //------------------------------ //Start more than One Time Prevention //------------------------------ @@ -180,41 +89,6 @@ begin end; end; -function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; -var - i : Integer; - SR : TSearchRecW; - Attrib : Integer; -begin - i := 0; - Filter := LowerCase(Filter); - - if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - begin - Attrib := FileGetAttr(Dir + SR.name); - if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := SR.name; - Result[i].IsDirectory := true; - Result[i].IsFile := false; - i := i + 1; - end - else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then - begin - SetLength( Result, i + 1); - Result[i].Name := SR.Name; - Result[i].IsDirectory := false; - Result[i].IsFile := true; - i := i + 1; - end; - end; - until FindNextW(SR) <> 0; - FindCloseW(SR); -end; - (** * Returns the path of a special folder. * @@ -225,37 +99,30 @@ end; * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents) * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music) *) -function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString; +function TPlatformWindows.GetSpecialPath(CSIDL: integer): IPath; var Buffer: array [0..MAX_PATH-1] of WideChar; begin -{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2 if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then - Result := Buffer + Result := Path(Buffer) else -{$IFEND} - Result := ''; + Result := PATH_NONE; end; -function TPlatformWindows.GetLogPath: WideString; +function TPlatformWindows.GetLogPath: IPath; begin Result := GetExecutionDir(); end; -function TPlatformWindows.GetGameSharedPath: WideString; +function TPlatformWindows.GetGameSharedPath: IPath; begin Result := GetExecutionDir(); end; -function TPlatformWindows.GetGameUserPath: WideString; +function TPlatformWindows.GetGameUserPath: IPath; begin - //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim; + //Result := GetSpecialPath(CSIDL_APPDATA).Append('UltraStarDX', pdAppend); Result := GetExecutionDir(); end; -function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; -begin - Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists); -end; - end. diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 419ce687..03ae2ffb 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -34,21 +34,23 @@ interface {$I switches.inc} uses + Classes, USong, - UPath; + UPath, + UPathUtils; type TPlaylistItem = record - Artist: String; - Title: String; + Artist: UTF8String; + Title: UTF8String; SongID: Integer; end; APlaylistItem = array of TPlaylistItem; TPlaylist = record - Name: String; - Filename: String; + Name: UTF8String; + Filename: IPath; Items: APlaylistItem; end; @@ -68,20 +70,20 @@ type Playlists: APlaylist; constructor Create; - Procedure LoadPlayLists; - Function LoadPlayList(Index: Cardinal; Filename: String): Boolean; - Procedure SavePlayList(Index: Cardinal); + procedure LoadPlayLists; + function LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean; + procedure SavePlayList(Index: Cardinal); - Procedure SetPlayList(Index: Cardinal); + procedure SetPlayList(Index: Cardinal); - Function AddPlaylist(Name: String): Cardinal; - Procedure DelPlaylist(const Index: Cardinal); + function AddPlaylist(const Name: UTF8String): Cardinal; + procedure DelPlaylist(const Index: Cardinal); - Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); - Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); + procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1); + procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1); - Procedure GetNames(var PLNames: array of String); - Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; + procedure GetNames(var PLNames: array of UTF8String); + function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; end; {Modes: @@ -95,13 +97,15 @@ type implementation -uses USongs, - ULog, - UMain, - //UFiles, - UGraphic, - UThemes, - SysUtils; +uses + SysUtils, + USongs, + ULog, + UMain, + UFilesystem, + UGraphic, + UThemes, + UUnicodeUtils; //---------- //Create - Construct Class - Dummy for now @@ -117,90 +121,90 @@ end; //---------- Procedure TPlayListManager.LoadPlayLists; var - SR: TSearchRec; Len: Integer; PlayListBuffer: TPlayList; + Iter: IFileIterator; + FileInfo: TFileInfo; begin SetLength(Playlists, 0); - if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then + Iter := FileSystem.FileFind(PlayListPath.Append('*.upl'), 0); + while (Iter.HasNext) do begin - repeat - Len := Length(Playlists); - SetLength(Playlists, Len +1); + Len := Length(Playlists); + SetLength(Playlists, Len + 1); + + FileInfo := Iter.Next; - if not LoadPlayList (Len, Sr.Name) then - SetLength(Playlists, Len) - else + if not LoadPlayList(Len, FileInfo.Name) then + SetLength(Playlists, Len) + else + begin + // Sort the Playlists - Insertion Sort + PlayListBuffer := Playlists[Len]; + Dec(Len); + while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do begin - // Sort the Playlists - Insertion Sort - PlayListBuffer := Playlists[Len]; - Dec(Len); - while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do - begin - Playlists[Len+1] := Playlists[Len]; - Dec(Len); - end; - Playlists[Len+1] := PlayListBuffer; + Playlists[Len+1] := Playlists[Len]; + Dec(Len); end; - - until FindNext(SR) <> 0; - FindClose(SR); - end; + Playlists[Len+1] := PlayListBuffer; + end; + end; end; //---------- //LoadPlayList - Load a Playlist in the Array //---------- -Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean; - var - F: TextFile; - Line: String; - PosDelimiter: Integer; - SongID: Integer; - Len: Integer; +function TPlayListManager.LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean; - Function FindSong(Artist, Title: String): Integer; + function FindSong(Artist, Title: UTF8String): Integer; var I: Integer; begin Result := -1; For I := low(CatSongs.Song) to high(CatSongs.Song) do begin - if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then + if (CatSongs.Song[I].Title = Title) and (CatSongs.Song[I].Artist = Artist) then begin Result := I; Break; end; end; end; + +var + TextStream: TTextFileStream; + Line: UTF8String; + PosDelimiter: Integer; + SongID: Integer; + Len: Integer; + FilenameAbs: IPath; begin - if not FileExists(PlayListPath + Filename) then - begin - Log.LogError('Could not load Playlist: ' + Filename); - Result := False; - Exit; + //Load File + try + FilenameAbs := PlaylistPath.Append(Filename); + TextStream := TMemTextFileStream.Create(FilenameAbs, fmOpenRead); + except + begin + Log.LogError('Could not load Playlist: ' + FilenameAbs.ToNative); + Result := False; + Exit; + end; end; Result := True; - //Load File - AssignFile(F, PlayListPath + FileName); - Reset(F); - //Set Filename - PlayLists[Index].Filename := Filename; - PlayLists[Index].Name := ''; + Playlists[Index].Filename := Filename; + Playlists[Index].Name := ''; //Read Until End of File - While not Eof(F) do + while TextStream.ReadLine(Line) do begin - //Read Curent Line - Readln(F, Line); - if (Length(Line) > 0) then begin - PosDelimiter := Pos(':', Line); - if (PosDelimiter <> 0) then + PosDelimiter := UTF8Pos(':', Line); + if (PosDelimiter <> 0) then begin //Comment or Name String if (Line[1] = '#') then @@ -224,7 +228,7 @@ begin PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); end - else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line); + else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename.ToNative + ', ' + Line); end; end; end; @@ -233,71 +237,70 @@ begin //If no special name is given, use Filename if PlayLists[Index].Name = '' then begin - PlayLists[Index].Name := ChangeFileExt(FileName, ''); + PlayLists[Index].Name := FileName.SetExtension('').ToUTF8; end; //Finish (Close File) - CloseFile(F); + TextStream.Free; end; -//---------- -//SavePlayList - Saves the specified Playlist -//---------- -Procedure TPlayListManager.SavePlayList(Index: Cardinal); +{** + * Saves the specified Playlist + *} +procedure TPlayListManager.SavePlayList(Index: Cardinal); var - F: TextFile; + TextStream: TTextFileStream; + PlaylistFile: IPath; I: Integer; begin - if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then - begin + PlaylistFile := PlaylistPath.Append(Playlists[Index].Filename); - //open File for Rewriting - AssignFile(F, PlaylistPath + Playlists[Index].Filename); - try - try - Rewrite(F); + // cannot update read-only file + if PlaylistFile.IsFile() and PlaylistFile.IsReadOnly() then + Exit; - //Write Version (not nessecary but helpful) - WriteLn(F, '######################################'); - WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0'); - WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.'); - WriteLn(F, '######################################'); + // open file for rewriting + TextStream := TMemTextFileStream.Create(PlaylistFile, fmCreate); + try + // Write version (not nessecary but helpful) + TextStream.WriteLine('######################################'); + TextStream.WriteLine('#Ultrastar Deluxe Playlist Format v1.0'); + TextStream.WriteLine(Format('#Playlist %s with %d Songs.', + [ Playlists[Index].Name, Length(Playlists[Index].Items) ])); + TextStream.WriteLine('######################################'); - //Write Name Information - WriteLn(F, '#Name: ' + Playlists[Index].Name); + // Write name information + TextStream.WriteLine('#Name: ' + Playlists[Index].Name); - //Write Song Information - WriteLn(F, '#Songs:'); + // Write song information + TextStream.WriteLine('#Songs:'); - For I := 0 to high(Playlists[Index].Items) do - begin - WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); - end; - except - log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); - end; - finally - CloseFile(F); + for I := 0 to high(Playlists[Index].Items) do + begin + TextStream.WriteLine(Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title); end; + except + Log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"'); end; + TextStream.Free; end; -//---------- -//SetPlayList - Display a Playlist in CatSongs -//---------- -Procedure TPlayListManager.SetPlayList(Index: Cardinal); +{** + * Display a Playlist in CatSongs + *} +procedure TPlayListManager.SetPlayList(Index: Cardinal); var I: Integer; begin - If (Int(Index) > High(PlayLists)) then + if (Int(Index) > High(PlayLists)) then exit; //Hide all Songs - For I := 0 to high(CatSongs.Song) do + for I := 0 to high(CatSongs.Song) do CatSongs.Song[I].Visible := False; //Show Songs in PL - For I := 0 to high(PlayLists[Index].Items) do + for I := 0 to high(PlayLists[Index].Items) do begin CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; end; @@ -324,31 +327,30 @@ end; //---------- //AddPlaylist - Adds a Playlist and Returns the Index //---------- -Function TPlayListManager.AddPlaylist(Name: String): Cardinal; +function TPlayListManager.AddPlaylist(const Name: UTF8String): cardinal; var I: Integer; + PlaylistFile: IPath; begin Result := Length(Playlists); SetLength(Playlists, Result + 1); // Sort the Playlists - Insertion Sort - while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do + while (Result > 0) and (CompareText(Playlists[Result - 1].Name, Name) >= 0) do begin Dec(Result); Playlists[Result+1] := Playlists[Result]; end; - Playlists[Result].Name := Name; + Playlists[Result].Name := Name; I := 1; - if (not FileExists(PlaylistPath + Name + '.upl')) then - Playlists[Result].Filename := Name + '.upl' - else + PlaylistFile := PlaylistPath.Append(Name + '.upl'); + while (PlaylistFile.Exists) do begin - repeat - Inc(I); - until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl'); - Playlists[Result].Filename := Name + InttoStr(I) + '.upl'; + Inc(I); + PlaylistFile := PlaylistPath.Append(Name + InttoStr(I) + '.upl'); end; + Playlists[Result].Filename := PlaylistFile; //Save new Playlist SavePlayList(Result); @@ -357,28 +359,28 @@ end; //---------- //DelPlaylist - Deletes a Playlist //---------- -Procedure TPlayListManager.DelPlaylist(const Index: Cardinal); +procedure TPlayListManager.DelPlaylist(const Index: Cardinal); var I: Integer; - Filename: String; + Filename: IPath; begin - If Int(Index) > High(Playlists) then + if Int(Index) > High(Playlists) then Exit; - Filename := PlaylistPath + Playlists[Index].Filename; + Filename := PlaylistPath.Append(Playlists[Index].Filename); //If not FileExists or File is not Writeable then exit - If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then + if (not Filename.IsFile()) or (Filename.IsReadOnly()) then Exit; //Delete Playlist from FileSystem - if Not DeleteFile(Filename) then + if not Filename.DeleteFile() then Exit; //Delete Playlist from Array //move all PLs to the Hole - For I := Index to High(Playlists)-1 do + for I := Index to High(Playlists)-1 do PlayLists[I] := PlayLists[I+1]; //Delete last Playlist @@ -390,7 +392,7 @@ begin begin ScreenSong.UnLoadDetailedCover; ScreenSong.HideCatTL; - CatSongs.SetFilter('', 0); + CatSongs.SetFilter('', fltAll); ScreenSong.Interaction := 0; ScreenSong.FixSelected; ScreenSong.ChangeMusic; @@ -471,7 +473,7 @@ end; //---------- //GetNames - Writes Playlist Names in a Array //---------- -Procedure TPlayListManager.GetNames(var PLNames: array of String); +procedure TPlayListManager.GetNames(var PLNames: array of UTF8String); var I: Integer; Len: Integer; diff --git a/src/base/USkins.pas b/src/base/USkins.pas index a4722d95..6ef5c596 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -33,31 +33,34 @@ interface {$I switches.inc} +uses + UPath; + type TSkinTexture = record Name: string; - FileName: string; + FileName: IPath; end; TSkinEntry = record Theme: string; Name: string; - Path: string; - FileName: string; + Path: IPath; + FileName: IPath; Creator: string; // not used yet end; TSkin = class Skin: array of TSkinEntry; SkinTexture: array of TSkinTexture; - SkinPath: string; + SkinPath: IPath; Color: integer; constructor Create; procedure LoadList; - procedure ParseDir(Dir: string); - procedure LoadHeader(FileName: string); + procedure ParseDir(Dir: IPath); + procedure LoadHeader(FileName: IPath); procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): string; + function GetTextureFileName(TextureName: string): IPath; function GetSkinNumber(Name: string): integer; procedure onThemeChange; end; @@ -74,7 +77,8 @@ uses UIni, ULog, UMain, - UPath; + UPathUtils, + UFileSystem; constructor TSkin.Create; begin @@ -86,45 +90,43 @@ end; procedure TSkin.LoadList; var - SR: TSearchRec; + Iter: IFileIterator; + DirInfo: TFileInfo; begin - if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then + Iter := FileSystem.FileFind(SkinsPath.Append('*'), faDirectory); + while Iter.HasNext do begin - repeat - if (SR.Name <> '.') and (SR.Name <> '..') then - ParseDir(SkinsPath + SR.Name + PathDelim); - until FindNext(SR) <> 0; - end; // if - FindClose(SR); + DirInfo := Iter.Next(); + if (not DirInfo.Name.Equals('.')) and (not DirInfo.Name.Equals('..')) then + ParseDir(SkinsPath.Append(DirInfo.Name, pdAppend)); + end; end; -procedure TSkin.ParseDir(Dir: string); +procedure TSkin.ParseDir(Dir: IPath); var - SR: TSearchRec; + Iter: IFileIterator; + IniInfo: TFileInfo; begin - if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then + Iter := FileSystem.FileFind(Dir.Append('*.ini'), 0); + while Iter.HasNext do begin - repeat - - if (SR.Name <> '.') and (SR.Name <> '..') then - LoadHeader(Dir + SR.Name); - - until FindNext(SR) <> 0; + IniInfo := Iter.Next; + LoadHeader(Dir.Append(IniInfo.Name)); end; end; -procedure TSkin.LoadHeader(FileName: string); +procedure TSkin.LoadHeader(FileName: IPath); var SkinIni: TMemIniFile; S: integer; begin - SkinIni := TMemIniFile.Create(FileName); + SkinIni := TMemIniFile.Create(FileName.ToNative); S := Length(Skin); SetLength(Skin, S+1); - Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName)); - Skin[S].FileName := ExtractFileName(FileName); + Skin[S].Path := FileName.GetPath; + Skin[S].FileName := FileName.GetName; Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); @@ -142,7 +144,7 @@ begin S := GetSkinNumber(Name); SkinPath := Skin[S].Path; - SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName); + SkinIni := TMemIniFile.Create(SkinPath.Append(Skin[S].FileName).ToNative); SL := TStringList.Create; SkinIni.ReadSection('Textures', SL); @@ -151,30 +153,29 @@ begin for T := 0 to SL.Count-1 do begin SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], ''); + SkinTexture[T].FileName := Path(SkinIni.ReadString('Textures', SL.Strings[T], '')); end; SL.Free; SkinIni.Free; end; -function TSkin.GetTextureFileName(TextureName: string): string; +function TSkin.GetTextureFileName(TextureName: string): IPath; var T: integer; begin - Result := ''; + Result := PATH_NONE; for T := 0 to High(SkinTexture) do begin - if ( SkinTexture[T].Name = TextureName ) and - ( SkinTexture[T].FileName <> '' ) then + if (SkinTexture[T].Name = TextureName) and + (SkinTexture[T].FileName.IsSet) then begin - Result := SkinPath + SkinTexture[T].FileName; + Result := SkinPath.Append(SkinTexture[T].FileName); end; end; - if ( TextureName <> '' ) and - ( Result <> '' ) then + if (TextureName <> '') and (Result.IsSet) then begin //Log.LogError('', '-----------------------------------------'); //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); diff --git a/src/base/USong.pas b/src/base/USong.pas index 57f78a27..d2043a93 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -56,7 +56,11 @@ uses PseudoThread, {$ENDIF} UCatCovers, - UXMLSong; + UXMLSong, + UUnicodeUtils, + UTextEncoding, + UFilesystem, + UPath; type @@ -68,42 +72,54 @@ type end; TScore = record - Name: WideString; + Name: UTF8String; Score: integer; - Length: string; end; TSong = class + private FileLineNo : integer; // line, which is read last, for error reporting - procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); + function DecodeFilename(Filename: RawByteString): IPath; + function Solmizate(Note: integer; Type_: integer): string; + procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); - function ReadTXTHeader( const aFileName : WideString ): boolean; - function ReadXMLHeader( const aFileName : WideString ): boolean; - public - Path: WideString; - Folder: WideString; // for sorting by folder - fFileName, - FileName: WideString; + function ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString; + function ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer; + function ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): real; + function ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar; + function ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString; + + function ReadTXTHeader(SongFile: TTextFileStream): boolean; + function ReadXMLHeader(const aFileName: IPath): boolean; + function GetFolderCategory(const aFileName: IPath): UTF8String; + function FindSongFile(Dir: IPath; Mask: UTF8String): IPath; + + public + Path: IPath; // kust path component of file (only set if file was found) + Folder: UTF8String; // for sorting by folder (only set if file was found) + FileName: IPath; // just name component of file (only set if file was found) + + // filenames + Cover: IPath; + Mp3: IPath; + Background: IPath; + Video: IPath; + // sorting methods - //Category: array of WideString; // TODO: do we need this? - Genre: WideString; - Edition: WideString; - Language: WideString; + Genre: UTF8String; + Edition: UTF8String; + Language: UTF8String; - Title: WideString; - Artist: WideString; + Title: UTF8String; + Artist: UTF8String; - Text: WideString; - Creator: WideString; + Creator: UTF8String; - Cover: WideString; CoverTex: TTexture; - Mp3: WideString; - Background: WideString; - Video: WideString; + VideoGAP: real; NotesGAP: integer; Start: real; // in seconds @@ -113,6 +129,8 @@ type BPM: array of TBPM; GAP: real; // in miliseconds + Encoding: TEncoding; + Score: array[0..2] of array of TScore; // these are used when sorting is enabled @@ -122,20 +140,18 @@ type 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 operate on this file - Base : array[0..1] of integer; Rel : array[0..1] of integer; Mult : integer; MultBPM : integer; - LastError: String; + LastError: AnsiString; function GetErrorLineNo: integer; property ErrorLineNo: integer read GetErrorLineNo; - constructor Create (); overload; - constructor Create ( const aFileName : WideString ); overload; + constructor Create(); overload; + constructor Create(const aFileName : IPath); overload; function LoadSong: boolean; function LoadXMLSong: boolean; function Analyse(): boolean; @@ -149,67 +165,74 @@ uses StrUtils, TextGL, UIni, - UPath, + UPathUtils, UMusic, //needed for Lines UNote; //needed for Player +const + // use USDX < 1.1 encoding for backward compatibility + DEFAULT_ENCODING = encCP1252; + constructor TSong.Create(); begin inherited; end; -constructor TSong.Create( const aFileName: WideString ); - // This may be changed, when we rewrite song select code. - // it is some kind of dirty, but imho the best possible - // solution as we do atm not support nested categorys. - // it works like the folder sorting in 1.0.1a - // folder is set to the first folder under the songdir - // so songs ~/.ultrastardx/songs/punk is in the same - // category as songs in shared/ultrastardx/songs are. - // note: folder is just the name of a category it has - // nothing to do with the path used for file loading - function GetFolderCategory: WideString; - var - I: Integer; - P: Integer; //position of next path delimiter - begin - Result := 'Unknown'; //default folder category, if we can't locate the song dir +// This may be changed, when we rewrite song select code. +// it is some kind of dirty, but imho the best possible +// solution as we do atm not support nested categorys. +// it works like the folder sorting in 1.0.1a +// folder is set to the first folder under the songdir +// so songs ~/.ultrastardx/songs/punk is in the same +// category as songs in shared/ultrastardx/songs are. +// note: folder is just the name of a category it has +// nothing to do with the path used for file loading +function TSong.GetFolderCategory(const aFileName: IPath): UTF8String; +var + I: Integer; + CurSongPath: IPath; + CurSongPathRel: IPath; +begin + Result := 'Unknown'; //default folder category, if we can't locate the song dir - for I := 0 to SongPaths.Count-1 do - if (AnsiStartsText(SongPaths.Strings[I], aFilename)) then + for I := 0 to SongPaths.Count-1 do + begin + CurSongPath := SongPaths[I] as IPath; + if (aFileName.IsChildOf(CurSongPath, false)) then + begin + if (aFileName.IsChildOf(CurSongPath, true)) then begin - P := PosEx(PathDelim, aFilename, Length(SongPaths.Strings[I]) + 1); - - If (P > 0) then - begin - // we have found the category name => get it - Result := copy(self.Path, Length(SongPaths.Strings[I]) + 1, P - Length(SongPaths.Strings[I]) - 1); - end - else - begin - // songs are in the "root" of the songdir => use songdir for the categorys name - Result := SongPaths.Strings[I]; - end; - - Exit; + // songs are in the "root" of the songdir => use songdir for the categorys name + Result := CurSongPath.ToUTF8; // TODO: remove trailing path-delim? + end + else + begin + // use the first subdirectory below CurSongPath as the category name + CurSongPathRel := aFileName.GetRelativePath(CurSongPath.AppendPathDelim); + Result := CurSongPathRel.SplitDirs[0].RemovePathDelim.ToUTF8; end; + Exit; + end; end; +end; + +constructor TSong.Create(const aFileName: IPath); begin inherited Create(); Mult := 1; MultBPM := 4; - fFileName := aFileName; LastError := ''; - if fileexists( aFileName ) then + Self.Path := aFileName.GetPath; + Self.FileName := aFileName.GetName; + Self.Folder := GetFolderCategory(aFileName); + + (* + if (aFileName.IsFile) then begin - self.Path := ExtractFilePath( aFileName ); - self.Folder := GetFolderCategory; - self.FileName := ExtractFileName( aFileName ); - (* - if ReadTXTHeader( aFileName ) then + if ReadTXTHeader(aFileName) then begin LoadSong(); end @@ -218,45 +241,178 @@ begin Log.LogError('Error Loading SongHeader, abort Song Loading'); Exit; end; - *) + end; + *) +end; + +function TSong.FindSongFile(Dir: IPath; Mask: UTF8String): IPath; +var + Iter: IFileIterator; + FileInfo: TFileInfo; + FileName: IPath; +begin + Iter := FileSystem.FileFind(Dir.Append(Mask), faDirectory); + if (Iter.HasNext) then + Result := Iter.Next.Name + else + Result := PATH_NONE; +end; + +function TSong.DecodeFilename(Filename: RawByteString): IPath; +begin + Result := UPath.Path(DecodeStringUTF8(Filename, Encoding)); +end; + +type + EUSDXParseException = class(Exception); + +{** + * Parses the Line string starting from LinePos for a parameter. + * Leading whitespace is trimmed, same applies to the first trailing whitespace. + * After the call LinePos will point to the position after the first trailing + * whitespace. + * + * Raises an EUSDXParseException if no string was found. + * + * Example: + * ParseLyricParam(Line:'Param0 Param1 Param2', LinePos:8, ...) + * -> Param:'Param1', LinePos:16 (= start of 'Param2') + *} +function TSong.ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString; +var + Start: integer; + OldLinePos: integer; +const + Whitespace = [#9, ' ']; +begin + OldLinePos := LinePos; + + Start := 0; + while (LinePos <= Length(Line)) do + begin + if (Line[LinePos] in Whitespace) then + begin + // check for end of param + if (Start > 0) then + Break; + end + // check for beginning of param + else if (Start = 0) then + begin + Start := LinePos; + end; + Inc(LinePos); + end; + + // check if param was found + if (Start = 0) then + begin + LinePos := OldLinePos; + raise EUSDXParseException.Create('String expected'); + end + else + begin + // copy param without trailing whitespace + Result := Copy(Line, Start, LinePos-Start); + // skip first trailing whitespace (if not at EOL) + if (LinePos <= Length(Line)) then + Inc(LinePos); + end; +end; + +function TSong.ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer; +var + Str: RawByteString; + OldLinePos: integer; +begin + OldLinePos := LinePos; + Str := ParseLyricStringParam(Line, LinePos); + try + Result := StrToInt(Str); + except // on EConvertError + LinePos := OldLinePos; + raise EUSDXParseException.Create('Integer expected'); end; end; -{function TSong.LoadSong(): boolean; +function TSong.ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): real; +var + Str: RawByteString; + OldLinePos: integer; +begin + OldLinePos := LinePos; + Str := ParseLyricStringParam(Line, LinePos); + try + Result := StrToFloat(Str); + except // on EConvertError + LinePos := OldLinePos; + raise EUSDXParseException.Create('Float expected'); + end; +end; + +function TSong.ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar; +var + Str: RawByteString; + OldLinePos: integer; begin + OldLinePos := LinePos; + Str := ParseLyricStringParam(Line, LinePos); + if (Length(Str) <> 1) then + begin + LinePos := OldLinePos; + raise EUSDXParseException.Create('Character expected'); + end; + Result := Str[1]; +end; -end; } +{** + * Returns the rest of the line from LinePos as lyric text. + * Leading and trailing whitespace is not trimmed. + *} +function TSong.ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString; +begin + if (LinePos > Length(Line)) then + Result := '' + else + begin + Result := Copy(Line, LinePos, Length(Line)-LinePos+1); + LinePos := Length(Line)+1; + end; +end; //Load TXT Song function TSong.LoadSong(): boolean; - var - TempC: char; - Text: string; - CP: integer; // Current Player (0 or 1) + CurLine: RawByteString; + LinePos: integer; Count: integer; Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I: integer; + Param0: AnsiChar; + Param1: integer; + Param2: integer; + Param3: integer; + ParamLyric: UTF8String; + + I: integer; + NotesFound: boolean; + SongFile: TTextFileStream; + FileNamePath: IPath; begin Result := false; LastError := ''; - if not FileExists(Path + PathDelim + FileName) then + FileNamePath := Path.Append(FileName); + if not FileNamePath.IsFile() then begin LastError := 'ERROR_CORRUPT_SONG_FILE_NOT_FOUND'; - Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); - exit; + Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()'); + Exit; end; MultBPM := 4; // multiply beat-count of note by 4 Mult := 1; // accuracy of measurement of note Rel[0] := 0; - CP := 0; Both := false; if Length(Player) = 2 then @@ -264,156 +420,155 @@ begin 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); - - FileLineNo := 0; - //Search for Note Begining - repeat - ReadLn(SongFile, Text); - Inc(FileLineNo); + SongFile := TMemTextFileStream.Create(FileNamePath, fmOpenRead); + try + //Search for Note Beginning + FileLineNo := 0; + NotesFound := false; + while (SongFile.ReadLine(CurLine)) do + begin + Inc(FileLineNo); + if (Length(CurLine) > 0) and (CurLine[1] in [':', 'F', '*']) then + begin + NotesFound := true; + Break; + end; + end; - if (EoF(SongFile)) then + if (not NotesFound) then begin //Song File Corrupted - No Notes - CloseFile(SongFile); - Log.LogError('Could not load txt File, no Notes found: ' + FileName); + Log.LogError('Could not load txt File, no notes found: ' + FileNamePath.ToNative); LastError := 'ERROR_CORRUPT_SONG_NO_NOTES'; Exit; end; - Read(SongFile, TempC); - until ((TempC = ':') or (TempC = 'F') or (TempC = '*')); - - SetLength(Lines, 2); - for Count := 0 to High(Lines) do - begin - Lines[Count].High := 0; - Lines[Count].Number := 1; - Lines[Count].Current := 0; - Lines[Count].Resolution := self.Resolution; - Lines[Count].NotesGAP := self.NotesGAP; - Lines[Count].ScoreValue := 0; - //Add first line and set some standard values to fields - //see procedure NewSentence for further explantation - //concerning most of these values - SetLength(Lines[Count].Line, 1); - Lines[Count].Line[0].HighNote := -1; - Lines[Count].Line[0].LastLine := false; - Lines[Count].Line[0].BaseNote := High(Integer); - Lines[Count].Line[0].TotalNotes := 0; - end; - - while (TempC <> 'E') and (not EOF(SongFile)) do - begin - - if (TempC = ':') or (TempC = '*') or (TempC = 'F') then + SetLength(Lines, 2); + for Count := 0 to High(Lines) do begin - // read notes - Read(SongFile, Param1); - Read(SongFile, Param2); - Read(SongFile, Param3); - Read(SongFile, ParamS); - - //Check for ZeroNote - if Param2 = 0 then - Log.LogError('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 - - else 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 + Lines[Count].High := 0; + Lines[Count].Number := 1; + Lines[Count].Current := 0; + Lines[Count].Resolution := self.Resolution; + Lines[Count].NotesGAP := self.NotesGAP; + Lines[Count].ScoreValue := 0; + + //Add first line and set some standard values to fields + //see procedure NewSentence for further explantation + //concerning most of these values + SetLength(Lines[Count].Line, 1); + Lines[Count].Line[0].HighNote := -1; + Lines[Count].Line[0].LastLine := false; + Lines[Count].Line[0].BaseNote := High(Integer); + Lines[Count].Line[0].TotalNotes := 0; + end; - else if TempC = 'B' then + while true do 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]; + LinePos := 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; + Param0 := ParseLyricCharParam(CurLine, LinePos); + if (Param0 = 'E') then + begin + Break + end + else if (Param0 in [':', '*', 'F']) then + begin + // read notes + Param1 := ParseLyricIntParam(CurLine, LinePos); + Param2 := ParseLyricIntParam(CurLine, LinePos); + Param3 := ParseLyricIntParam(CurLine, LinePos); + ParamLyric := ParseLyricText(CurLine, LinePos); + + //Check for ZeroNote + if Param2 = 0 then + Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!') + else + begin + // add notes + if not Both then + // P1 + ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric) + else + begin + // P1 + P2 + ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric); + ParseNote(1, Param0, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamLyric); + end; + end; //Zeronote check + end // if + + else if Param0 = '-' then + begin + // reads sentence + Param1 := ParseLyricIntParam(CurLine, LinePos); + if self.Relative then + Param2 := ParseLyricIntParam(CurLine, LinePos); // 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 - ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32) + else if Param0 = 'B' then + begin + SetLength(self.BPM, Length(self.BPM) + 1); + self.BPM[High(self.BPM)].StartBeat := ParseLyricFloatParam(CurLine, LinePos); + self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0]; - Read(SongFile, TempC); - Inc(FileLineNo); - end; // while} + self.BPM[High(self.BPM)].BPM := ParseLyricFloatParam(CurLine, LinePos); + self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; + end; - CloseFile(SongFile); + // Read next line in File + if (not SongFile.ReadLine(CurLine)) then + Break; - for I := 0 to High(Lines) do + Inc(FileLineNo); + end; // while + finally + SongFile.Free; + end; + except + on E: Exception do begin - if ((Both) or (I = 0)) then - begin - if (Length(Lines[I].Line) < 2) then - begin - LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS'; - Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"'); - exit; - end; - - if (Lines[I].Line[Lines[I].High].HighNote < 0) then - begin - SetLength(Lines[I].Line, Lines[I].Number - 1); - Lines[I].High := Lines[I].High - 1; - Lines[I].Number := Lines[I].Number - 1; - Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + Filename); - end; - end; + Log.LogError(Format('Error loading file: "%s" in line %d,%d: %s', + [FileNamePath.ToNative, FileLineNo, LinePos, E.Message])); + Exit; end; + end; - for Count := 0 to High(Lines) do + for I := 0 to High(Lines) do + begin + if ((Both) or (I = 0)) then begin - if (High(Lines[Count].Line) >= 0) then - Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; - end; - except - try - CloseFile(SongFile); - except + if (Length(Lines[I].Line) < 2) then + begin + LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS'; + Log.LogError('Error loading file: Can''t find any linebreaks in "' + FileNamePath.ToNative + '"'); + exit; + end; + if (Lines[I].Line[Lines[I].High].HighNote < 0) then + begin + SetLength(Lines[I].Line, Lines[I].Number - 1); + Lines[I].High := Lines[I].High - 1; + Lines[I].Number := Lines[I].Number - 1; + Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + FileNamePath.ToNative); + end; end; + end; - LastError := 'ERROR_CORRUPT_SONG_ERROR_IN_LINE'; - Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo)); - exit; + for Count := 0 to High(Lines) do + begin + if (High(Lines[Count].Line) >= 0) then + Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; end; Result := true; @@ -421,11 +576,7 @@ end; //Load XML Song function TSong.LoadXMLSong(): boolean; - var - //TempC: char; - Text: string; - CP: integer; // Current Player (0 or 1) Count: integer; Both: boolean; Param1: integer; @@ -438,14 +589,15 @@ var NoteType: char; SentenceEnd, Rest, Time: integer; Parser: TParser; - + FileNamePath: IPath; begin Result := false; LastError := ''; - if not FileExists(Path + PathDelim + FileName) then + FileNamePath := Path.Append(FileName); + if not FileNamePath.IsFile() then begin - Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()'); + Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()'); exit; end; @@ -454,7 +606,6 @@ begin Lines[0].ScoreValue := 0; self.Relative := false; Rel[0] := 0; - CP := 0; Both := false; if Length(Player) = 2 then @@ -484,7 +635,7 @@ begin //Try to Parse the Song - if Parser.ParseSong(Path + PathDelim + FileName) then + if Parser.ParseSong(FileNamePath) then begin //Writeln('XML Inputfile Parsed succesful'); @@ -551,7 +702,7 @@ begin end else begin - Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName); + Log.LogError('Could not parse inputfile: ' + FileNamePath.ToNative); exit; end; @@ -563,14 +714,11 @@ begin Result := true; end; -function TSong.ReadXMLHeader(const aFileName : WideString): boolean; - +function TSong.ReadXMLHeader(const aFileName : IPath): boolean; var - //Line, Identifier, Value: string; - //Temp : word; Done : byte; Parser : TParser; - + FileNamePath: IPath; begin Result := true; Done := 0; @@ -579,7 +727,8 @@ begin Parser := TParser.Create; Parser.Settings.DashReplacement := '~'; - if Parser.ParseSong(self.Path + self.FileName) then + FileNamePath := Self.Path.Append(Self.FileName); + if Parser.ParseSong(FileNamePath) then begin //----------- //Required Attributes @@ -598,9 +747,9 @@ begin Done := Done or 2; //MP3 File //Test if Exists - self.Mp3 := platform.FindSongFile(Path, '*.mp3'); + Self.Mp3 := FindSongFile(Self.Path, '*.mp3'); //Add Mp3 Flag to Done - if (FileExists(self.Path + self.Mp3)) then + if (Self.Path.Append(Self.Mp3).IsFile()) then Done := Done or 4; //Beats per Minute @@ -621,16 +770,16 @@ begin self.GAP := Parser.SongInfo.Header.Gap; //Cover Picture - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + self.Cover := FindSongFile(Path, '*[CO].jpg'); //Background Picture - self.Background := platform.FindSongFile(Path, '*[BG].jpg'); + self.Background := FindSongFile(Path, '*[BG].jpg'); // Video File // self.Video := Value // Video Gap - // self.VideoGAP := song_StrtoFloat( Value ) + // self.VideoGAP := StrtoFloatI18n( Value ) //Genre Sorting self.Genre := Parser.SongInfo.Header.Genre; @@ -645,7 +794,7 @@ begin self.Language := Parser.SongInfo.Header.Language; end else - Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName); + Log.LogError('File incomplete or not SingStar XML (A): ' + aFileName.ToNative); Parser.Free; @@ -654,220 +803,260 @@ begin begin Result := false; if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM Tag Missing: ' + self.FileName) + Log.LogError('BPM tag missing: ' + self.FileName.ToNative) else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + Log.LogError('MP3 tag/file missing: ' + self.FileName.ToNative) else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + self.FileName) + Log.LogError('Artist tag missing: ' + self.FileName.ToNative) else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + self.FileName) + Log.LogError('Title tag missing: ' + self.FileName.ToNative) else //unknown Error - Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName); + Log.LogError('File incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName.ToNative); end; end; -function TSong.ReadTXTHeader(const aFileName : WideString): boolean; - - function song_StrtoFloat( aValue : string ) : extended; - - var - lValue : string; - - begin - lValue := aValue; - - if (Pos(',', lValue) <> 0) then - lValue[Pos(',', lValue)] := '.'; - - Result := StrToFloatDef(lValue, 0); - end; - +{** + * "International" StrToFloat variant. Uses either ',' or '.' as decimal + * separator. + *} +function StrToFloatI18n(const Value: string): extended; var - Line, Identifier, Value: string; - Temp : word; - Done : byte; + TempValue : string; +begin + TempValue := Value; + if (Pos(',', TempValue) <> 0) then + TempValue[Pos(',', TempValue)] := '.'; + Result := StrToFloatDef(TempValue, 0); +end; +function TSong.ReadTXTHeader(SongFile: TTextFileStream): boolean; +var + Line, Identifier: string; + Value: string; + SepPos: integer; // separator position + Done: byte; // bit-vector of mandatory fields + EncFile: IPath; // encoded filename + FullFileName: string; begin Result := true; Done := 0; - //Read first Line - ReadLn (SongFile, Line); + FullFileName := Path.Append(Filename).ToNative; + //Read first Line + SongFile.ReadLine(Line); if (Length(Line) <= 0) then begin - Log.LogError('File Starts with Empty Line: ' + aFileName); + Log.LogError('File starts with empty line: ' + FullFileName, + 'TSong.ReadTXTHeader'); Result := false; Exit; end; + // check if file begins with a UTF-8 BOM, if so set encoding to UTF-8 + if (CheckReplaceUTF8BOM(Line)) then + Encoding := encUTF8; + //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); + SepPos := 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)); + //Line has no Seperator, ignore non header field + if (SepPos = 0) then + Continue; - //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} + //Read Identifier and Value + Identifier := UpperCase(Trim(Copy(Line, 2, SepPos - 2))); //Uppercase is for Case Insensitive Checks + Value := Trim(Copy(Line, SepPos + 1, Length(Line) - SepPos)); - //Title - if (Identifier = 'TITLE') then - begin - self.Title := Value; - - //Add Title Flag to Done - Done := Done or 1; - end + //Check the Identifier (If Value is given) + if (Length(Value) = 0) then + begin + Log.LogWarn('Empty field "'+Identifier+'" in file ' + FullFileName, + 'TSong.ReadTXTHeader'); + end + else + begin + + //----------- + //Required Attributes + //----------- - //Artist - else if (Identifier = 'ARTIST') then - begin - self.Artist := Value; + if (Identifier = 'TITLE') then + begin + DecodeStringUTF8(Value, Title, Encoding); + //Add Title Flag to Done + Done := Done or 1; + end - //Add Artist Flag to Done - Done := Done or 2; - end + else if (Identifier = 'ARTIST') then + begin + DecodeStringUTF8(Value, Artist, Encoding); + //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 + //MP3 File + else if (Identifier = 'MP3') then + begin + EncFile := DecodeFilename(Value); + if (Self.Path.Append(EncFile).IsFile) then begin - self.Mp3 := Value; + self.Mp3 := EncFile; //Add Mp3 Flag to Done Done := Done or 4; - end + end; + end - //Beats per Minute - else if (Identifier = 'BPM') then - begin - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; + //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; + self.BPM[0].BPM := StrToFloatI18n( Value ) * Mult * MultBPM; - if self.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end + if self.BPM[0].BPM <> 0 then + begin + //Add BPM Flag to Done + Done := Done or 8; + end; + end - //--------- - //Additional Header Information - //--------- + //--------- + //Additional Header Information + //--------- - // Gap - else if (Identifier = 'GAP') then - self.GAP := song_StrtoFloat( Value ) + // Gap + else if (Identifier = 'GAP') then + begin + self.GAP := StrToFloatI18n(Value); + end - //Cover Picture - else if (Identifier = 'COVER') then - self.Cover := Value + //Cover Picture + else if (Identifier = 'COVER') then + begin + self.Cover := DecodeFilename(Value); + end - //Background Picture - else if (Identifier = 'BACKGROUND') then - self.Background := Value + //Background Picture + else if (Identifier = 'BACKGROUND') then + begin + self.Background := DecodeFilename(Value); + end - // 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 File + else if (Identifier = 'VIDEO') then + begin + EncFile := DecodeFilename(Value); + if (self.Path.Append(EncFile).IsFile) then + self.Video := EncFile + else + Log.LogError('Can''t find video file in song: ' + FullFileName); + end - // Video Gap - else if (Identifier = 'VIDEOGAP') then - self.VideoGAP := song_StrtoFloat( Value ) + // Video Gap + else if (Identifier = 'VIDEOGAP') then + begin + self.VideoGAP := StrToFloatI18n( Value ) + end - //Genre Sorting - else if (Identifier = 'GENRE') then - self.Genre := Value + //Genre Sorting + else if (Identifier = 'GENRE') then + begin + DecodeStringUTF8(Value, Genre, Encoding) + end - //Edition Sorting - else if (Identifier = 'EDITION') then - self.Edition := Value + //Edition Sorting + else if (Identifier = 'EDITION') then + begin + DecodeStringUTF8(Value, Edition, Encoding) + end - //Creator Tag - else if (Identifier = 'CREATOR') then - self.Creator := Value + //Creator Tag + else if (Identifier = 'CREATOR') then + begin + DecodeStringUTF8(Value, Creator, Encoding) + end + + //Language Sorting + else if (Identifier = 'LANGUAGE') then + begin + DecodeStringUTF8(Value, Language, Encoding) + end - //Language Sorting - else if (Identifier = 'LANGUAGE') then - self.Language := Value + // Song Start + else if (Identifier = 'START') then + begin + self.Start := StrToFloatI18n( Value ) + end - // Song Start - else if (Identifier = 'START') then - self.Start := song_StrtoFloat( Value ) + // Song Ending + else if (Identifier = 'END') then + begin + TryStrtoInt(Value, self.Finish) + end - // Song Ending - else if (Identifier = 'END') then - TryStrtoInt(Value, self.Finish) + // Resolution + else if (Identifier = 'RESOLUTION') then + begin + TryStrtoInt(Value, self.Resolution) + end - // Resolution - else if (Identifier = 'RESOLUTION') then - TryStrtoInt(Value, self.Resolution) + // Notes Gap + else if (Identifier = 'NOTESGAP') then + begin + TryStrtoInt(Value, self.NotesGAP) + end - // Notes Gap - else if (Identifier = 'NOTESGAP') then - TryStrtoInt(Value, self.NotesGAP) - // Relative Notes - else if (Identifier = 'RELATIVE') and (uppercase(Value) = 'YES') then + // Relative Notes + else if (Identifier = 'RELATIVE') then + begin + if (UpperCase(Value) = 'YES') then self.Relative := true; + end + // File encoding + else if (Identifier = 'ENCODING') then + begin + self.Encoding := ParseEncoding(Value, DEFAULT_ENCODING); end; - end; + + end; // End check for non-empty Value - if not EOF(SongFile) then - ReadLn (SongFile, Line) - else + // read next line + if (not SongFile.ReadLine(Line)) then begin Result := false; - Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName); - break; + Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName); + Break; end; + end; // while - end; - - if self.Cover = '' then - self.Cover := platform.FindSongFile(Path, '*[CO].jpg'); + if self.Cover.IsUnset then + self.Cover := 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) + Log.LogError('BPM tag missing: ' + FullFileName) else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 Tag/File Missing: ' + self.FileName) + Log.LogError('MP3 tag/file missing: ' + FullFileName) else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist Tag Missing: ' + self.FileName) + Log.LogError('Artist tag missing: ' + FullFileName) else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title Tag Missing: ' + self.FileName) + Log.LogError('Title tag missing: ' + FullFileName) else //unknown Error - Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName); + Log.LogError('File incomplete or not Ultrastar txt (B - '+ inttostr(Done) +'): ' + FullFileName); end; - end; function TSong.GetErrorLineNo: integer; @@ -878,47 +1067,52 @@ begin Result := -1; end; -procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string); - +function TSong.Solmizate(Note: integer; Type_: integer): string; begin - case Ini.Solmization of + case (Type_) 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 '; + case (Note mod 12) of + 0..1: Result := ' do '; + 2..3: Result := ' re '; + 4: Result := ' mi '; + 5..6: Result := ' fa '; + 7..8: Result := ' sol '; + 9..10: Result := ' la '; + 11: Result := ' 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 '; + case (Note mod 12) of + 0..1: Result := ' do '; + 2..3: Result := ' re '; + 4: Result := ' mi '; + 5..6: Result := ' fa '; + 7..8: Result := ' so '; + 9..10: Result := ' la '; + 11: Result := ' 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 '; + case (Note mod 12) of + 0..1: Result := ' do '; + 2..3: Result := ' re '; + 4: Result := ' mi '; + 5..6: Result := ' fa '; + 7..8: Result := ' sol '; + 9..10: Result := ' la '; + 11: Result := ' ti '; end; end; end; // case +end; + +procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); +begin + if (Ini.Solmization <> 0) then + LyricS := Solmizate(NoteP, Ini.Solmization); with Lines[LineNumber].Line[Lines[LineNumber].High] do begin @@ -956,14 +1150,7 @@ begin if Note[HighNote].Tone < BaseNote then BaseNote := Note[HighNote].Tone; - //delete the space that seperates the notes pitch from its lyrics - //it is left in the LyricS string because Read("some ordinal type") will - //set the files pointer to the first whitespace character after the - //ordinal string. Trim is no solution because it would cut the spaces - //that seperate the words of the lyrics, too. - Delete(LyricS, 1, 1); - - Note[HighNote].Text := LyricS; + DecodeStringUTF8(LyricS, Note[HighNote].Text, Encoding); Lyric := Lyric + Note[HighNote].Text; End_ := Note[HighNote].Start + Note[HighNote].Length; @@ -971,10 +1158,8 @@ begin end; procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); - var I: integer; - begin if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then @@ -985,7 +1170,8 @@ begin end else begin //use old line if it there were no notes added since last call of NewSentence - Log.LogError('Error loading Song, sentence w/o note found in line ' + InttoStr(FileLineNo) + ': ' + Filename); + Log.LogError('Error loading Song, sentence w/o note found in line ' + + InttoStr(FileLineNo) + ': ' + Filename.ToNative); end; Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; @@ -1012,8 +1198,7 @@ begin Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false; end; -procedure TSong.clear(); - +procedure TSong.Clear(); begin //Main Information Title := ''; @@ -1024,22 +1209,21 @@ begin Edition := 'Unknown'; Language := 'Unknown'; //Language Patch + // set to default encoding + Encoding := DEFAULT_ENCODING; + //Required Information - Mp3 := ''; - {$IFDEF FPC} - setlength( BPM, 0 ); - {$ELSE} - BPM := nil; - {$ENDIF} + Mp3 := PATH_NONE; + SetLength(BPM, 0); GAP := 0; Start := 0; Finish := 0; //Additional Information - Background := ''; - Cover := ''; - Video := ''; + Background := PATH_NONE; + Cover := PATH_NONE; + Video := PATH_NONE; VideoGAP := 0; NotesGAP := 0; Resolution := 4; @@ -1049,7 +1233,8 @@ begin end; function TSong.Analyse(): boolean; - +var + SongFile: TTextFileStream; begin Result := false; @@ -1057,20 +1242,15 @@ begin FileLineNo := 0; //Open File and set File Pointer to the beginning - AssignFile(SongFile, self.Path + self.FileName); - + SongFile := TMemTextFileStream.Create(Self.Path.Append(Self.FileName), fmOpenRead); try - Reset(SongFile); - //Clear old Song Header - self.clear; + Self.clear; //Read Header - Result := self.ReadTxTHeader( FileName ) - - //And Close File + Result := Self.ReadTxTHeader(SongFile) finally - CloseFile(SongFile); + SongFile.Free; end; end; diff --git a/src/base/USongs.pas b/src/base/USongs.pas index c4871f18..49b84425 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -40,32 +40,35 @@ interface {$ENDIF} uses + SysUtils, + Classes, {$IFDEF MSWINDOWS} Windows, DirWatch, {$ELSE} {$IFNDEF DARWIN} - syscall, + syscall, {$ENDIF} baseunix, UnixType, {$ENDIF} - SysUtils, - Classes, UPlatform, ULog, UTexture, UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, + PseudoThread, {$ENDIF} + UPath, USong, UCatCovers; type + TSongFilter = ( + fltAll, + fltTitle, + fltArtist + ); TBPM = record BPM: real; @@ -73,11 +76,13 @@ type end; TScore = record - Name: widestring; + Name: UTF8String; Score: integer; Length: string; end; + TPathDynArray = array of IPath; + {$IFDEF USE_PSEUDO_THREAD} TSongs = class(TPseudoThread) {$ELSE} @@ -102,11 +107,11 @@ type procedure LoadSongList; // load all songs - procedure BrowseDir(Dir: widestring); // should return number of songs in the future - procedure BrowseTXTFiles(Dir: widestring); - procedure BrowseXMLFiles(Dir: widestring); + procedure FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray); + procedure BrowseDir(Dir: IPath); // should return number of songs in the future + procedure BrowseTXTFiles(Dir: IPath); + procedure BrowseXMLFiles(Dir: IPath); procedure Sort(Order: integer); - function FindSongFile(Dir, Mask: widestring): widestring; property Processing: boolean read fProcessing; end; @@ -128,7 +133,7 @@ type function VisibleSongs: integer; // returns number of visible songs (for tabs) function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - function SetFilter(FilterStr: string; const fType: byte): cardinal; + function SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal; end; var @@ -156,9 +161,12 @@ uses UCovers, UFiles, UGraphic, + UMain, UIni, - UPath, - UNote; + UPathUtils, + UNote, + UFilesystem, + UUnicodeUtils; constructor TSongs.Create(); begin @@ -232,7 +240,7 @@ begin // browse directories for I := 0 to SongPaths.Count-1 do - BrowseDir(SongPaths[I]); + BrowseDir(SongPaths[I] as IPath); if assigned(CatSongs) then CatSongs.Refresh; @@ -264,84 +272,92 @@ begin Resume(); end; -procedure TSongs.BrowseDir(Dir: widestring); +procedure TSongs.BrowseDir(Dir: IPath); begin BrowseTXTFiles(Dir); BrowseXMLFiles(Dir); end; -procedure TSongs.BrowseTXTFiles(Dir: widestring); +procedure TSongs.FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray); var - i: integer; - Files: TDirectoryEntryArray; - lSong: TSong; + Iter: IFileIterator; + FileInfo: TFileInfo; + FileName: IPath; begin - - try - Files := Platform.DirectoryFindFiles(Dir, '.txt', true) - except - Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles') - end; - - for i := 0 to Length(Files) - 1 do + // search for all files and directories + Iter := FileSystem.FileFind(Dir.Append('*'), faAnyFile); + while (Iter.HasNext) do begin - if Files[i].IsDirectory then + FileInfo := Iter.Next; + FileName := FileInfo.Name; + if ((FileInfo.Attr and faDirectory) <> 0) then begin - BrowseTXTFiles(Dir + Files[i].Name + PathDelim); //Recursive Call + if Recursive and (not FileName.Equals('.')) and (not FileName.Equals('..')) then + FindFilesByExtension(Dir.Append(FileName), Ext, true, Files); end else begin - lSong := TSong.create(Dir + Files[i].Name); - - if lSong.Analyse then - SongList.add(lSong) - else + if (Ext.Equals(FileName.GetExtension(), true)) then begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil(lSong); + SetLength(Files, Length(Files)+1); + Files[High(Files)] := Dir.Append(FileName); end; - end; end; - SetLength(Files, 0); - end; -procedure TSongs.BrowseXMLFiles(Dir: widestring); +procedure TSongs.BrowseTXTFiles(Dir: IPath); var - i: integer; - Files: TDirectoryEntryArray; - lSong: TSong; + I: integer; + Files: TPathDynArray; + Song: TSong; + Extension: IPath; begin + SetLength(Files, 0); + Extension := Path('.txt'); + FindFilesByExtension(Dir, Extension, true, Files); - try - Files := Platform.DirectoryFindFiles(Dir, '.xml', true) - except - Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles') - end; - - for i := 0 to Length(Files) - 1 do + for I := 0 to High(Files) do begin - if Files[i].IsDirectory then - begin - BrowseXMLFiles(Dir + Files[i].Name + PathDelim); // Recursive Call - end + Song := TSong.Create(Files[I]); + + if Song.Analyse then + SongList.Add(Song) else begin - lSong := TSong.create(Dir + Files[i].Name); + Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".'); + FreeAndNil(Song); + end; + end; - if lSong.AnalyseXML then - SongList.add(lSong) - else - begin - Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); - freeandnil(lSong); - end; + SetLength(Files, 0); +end; + +procedure TSongs.BrowseXMLFiles(Dir: IPath); +var + I: integer; + Files: TPathDynArray; + Song: TSong; + Extension: IPath; +begin + SetLength(Files, 0); + Extension := Path('.xml'); + FindFilesByExtension(Dir, Extension, true, Files); + + for I := 0 to High(Files) do + begin + Song := TSong.Create(Files[I]); + if Song.AnalyseXML then + SongList.Add(Song) + else + begin + Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".'); + FreeAndNil(Song); end; end; - SetLength(Files, 0); + SetLength(Files, 0); end; (* @@ -350,32 +366,32 @@ end; function CompareByEdition(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition); + Result := UTF8CompareText(TSong(Song1).Edition, TSong(Song2).Edition); end; function CompareByGenre(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre); + Result := UTF8CompareText(TSong(Song1).Genre, TSong(Song2).Genre); end; function CompareByTitle(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Title, TSong(Song2).Title); + Result := UTF8CompareText(TSong(Song1).Title, TSong(Song2).Title); end; function CompareByArtist(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist); + Result := UTF8CompareText(TSong(Song1).Artist, TSong(Song2).Artist); end; function CompareByFolder(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder); + Result := UTF8CompareText(TSong(Song1).Folder, TSong(Song2).Folder); end; function CompareByLanguage(Song1, Song2: Pointer): integer; begin - Result := CompareText(TSong(Song1).Language, TSong(Song2).Language); + Result := UTF8CompareText(TSong(Song1).Language, TSong(Song2).Language); end; procedure TSongs.Sort(Order: integer); @@ -412,18 +428,6 @@ begin MergeSort(SongList, CompareFunc); end; -function TSongs.FindSongFile(Dir, Mask: widestring): widestring; -var - SR: TSearchRec; // for parsing song directory -begin - Result := ''; - if FindFirst(Dir + Mask, faDirectory, SR) = 0 then - begin - Result := SR.Name; - end; // if - FindClose(SR); -end; - procedure TCatSongs.SortSongs(); begin case Ini.Sorting of @@ -469,14 +473,14 @@ procedure TCatSongs.Refresh; var SongIndex: integer; CurSong: TSong; - CatIndex: integer; // index of current song in Song - Letter: char; // current letter for sorting using letter - CurCategory: string; // current edition for sorting using edition, genre etc. - Order: integer; // number used for ordernum - LetterTmp: char; - CatNumber: integer; // Number of Song in Category - - procedure AddCategoryButton(const CategoryName: string); + CatIndex: integer; // index of current song in Song + Letter: UCS4Char; // current letter for sorting using letter + CurCategory: UTF8String; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + LetterTmp: UCS4Char; + CatNumber: integer; // Number of Song in Category + + procedure AddCategoryButton(const CategoryName: UTF8String); var PrevCatBtnIndex: integer; begin @@ -511,7 +515,7 @@ begin // Note: do NOT set Letter to ' ', otherwise no category-button will be // created for songs beginning with ' ' if songs of this category exist. // TODO: trim song-properties so ' ' will not occur as first chararcter. - Letter := #0; + Letter := 0; // clear song-list for SongIndex := 0 to Songs.SongList.Count - 1 do @@ -530,91 +534,110 @@ begin // if tabs are on, add section buttons for each new section if (Ini.Tabs = 1) then begin - if (Ini.Sorting = sEdition) and - (CompareText(CurCategory, CurSong.Edition) <> 0) then - begin - CurCategory := CurSong.Edition; - - // add Category Button - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sGenre) and - (CompareText(CurCategory, CurSong.Genre) <> 0) then - begin - CurCategory := CurSong.Genre; - // add Genre Button - AddCategoryButton(CurCategory); - end - - else if (Ini.Sorting = sLanguage) and - (CompareText(CurCategory, CurSong.Language) <> 0) then - begin - CurCategory := CurSong.Language; - // add Language Button - AddCategoryButton(CurCategory); - end + case (Ini.Sorting) of + sEdition: begin + if (CompareText(CurCategory, CurSong.Edition) <> 0) then + begin + CurCategory := CurSong.Edition; + + // add Category Button + AddCategoryButton(CurCategory); + end; + end; - else if (Ini.Sorting = sTitle) and - (Length(CurSong.Title) >= 1) and - (Letter <> UpperCase(CurSong.Title)[1]) then - begin - Letter := Uppercase(CurSong.Title)[1]; - // add a letter Category Button - AddCategoryButton(Letter); - end + sGenre: begin + if (CompareText(CurCategory, CurSong.Genre) <> 0) then + begin + CurCategory := CurSong.Genre; + // add Genre Button + AddCategoryButton(CurCategory); + end; + end; - else if (Ini.Sorting = sArtist) and - (Length(CurSong.Artist) >= 1) and - (Letter <> UpperCase(CurSong.Artist)[1]) then - begin - Letter := UpperCase(CurSong.Artist)[1]; - // add a letter Category Button - AddCategoryButton(Letter); - end + sLanguage: begin + if (CompareText(CurCategory, CurSong.Language) <> 0) then + begin + CurCategory := CurSong.Language; + // add Language Button + AddCategoryButton(CurCategory); + end + end; - else if (Ini.Sorting = sFolder) and - (CompareText(CurCategory, CurSong.Folder) <> 0) then - begin - CurCategory := CurSong.Folder; - // add folder tab - AddCategoryButton(CurCategory); - end + sTitle: begin + if (Length(CurSong.Title) >= 1) then + begin + LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Title)[0]); + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(UCS4ToUTF8String(Letter)); + end; + end; + end; - else if (Ini.Sorting = sTitle2) and - (Length(CurSong.Title) >= 1) then - begin - // pack all numbers into a category named '#' - if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then - LetterTmp := '#' - else - LetterTmp := UpperCase(CurSong.Title)[1]; + sArtist: begin + if (Length(CurSong.Artist) >= 1) then + begin + LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Artist)[0]); + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(UCS4ToUTF8String(Letter)); + end; + end; + end; - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(Letter); + sFolder: begin + if (UTF8CompareText(CurCategory, CurSong.Folder) <> 0) then + begin + CurCategory := CurSong.Folder; + // add folder tab + AddCategoryButton(CurCategory); + end; end; - end - else if (Ini.Sorting = sArtist2) and - (Length(CurSong.Artist)>=1) then - begin - // pack all numbers into a category named '#' - if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then - LetterTmp := '#' - else - LetterTmp := UpperCase(CurSong.Artist)[1]; + sTitle2: begin + if (Length(CurSong.Title) >= 1) then + begin + LetterTmp := UTF8ToUCS4String(CurSong.Title)[0]; + // pack all numbers into a category named '#' + if (LetterTmp in [Ord('0') .. Ord('9')]) then + LetterTmp := Ord('#') + else + LetterTmp := UCS4UpperCase(LetterTmp); + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(UCS4ToUTF8String(Letter)); + end; + end; + end; - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(Letter); + sArtist2: begin + if (Length(CurSong.Artist) >= 1) then + begin + LetterTmp := UTF8ToUCS4String(CurSong.Artist)[0]; + // pack all numbers into a category named '#' + if (LetterTmp in [Ord('0') .. Ord('9')]) then + LetterTmp := Ord('#') + else + LetterTmp := UCS4UpperCase(LetterTmp); + + if (Letter <> LetterTmp) then + begin + Letter := LetterTmp; + // add a letter Category Button + AddCategoryButton(UCS4ToUTF8String(Letter)); + end; + end; end; - end; - end; + + end; // case (Ini.Sorting) + end; // if (Ini.Tabs = 1) CatIndex := Length(Song); SetLength(Song, CatIndex+1); @@ -761,58 +784,58 @@ begin end; end; -function TCatSongs.SetFilter(FilterStr: string; const fType: byte): cardinal; +function TCatSongs.SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal; var I, J: integer; - cString: string; - SearchStr: array of string; + TmpString: UTF8String; + WordArray: array of UTF8String; begin -{ - fType: 0: All - 1: Title - 2: Artist -} FilterStr := Trim(FilterStr); - if FilterStr<>'' then + if (FilterStr <> '') then begin Result := 0; - // Create Search Array - SetLength(SearchStr, 1); + + // initialize word array + SetLength(WordArray, 1); + + // Copy words to SearchStr I := Pos(' ', FilterStr); while (I <> 0) do begin - SetLength(SearchStr, Length(SearchStr) + 1); - cString := Copy(FilterStr, 1, I - 1); - if (cString <> ' ') and (cString <> '') then - SearchStr[High(SearchStr) - 1] := cString; - Delete (FilterStr, 1, I); + WordArray[High(WordArray)] := Copy(FilterStr, 1, I-1); + SetLength(WordArray, Length(WordArray) + 1); - I := Pos (' ', FilterStr); + FilterStr := TrimLeft(Copy(FilterStr, I+1, Length(FilterStr)-I)); + I := Pos(' ', FilterStr); end; - // Copy last Word - if (FilterStr <> ' ') and (FilterStr <> '') then - SearchStr[High(SearchStr)] := FilterStr; + + // Copy last word + WordArray[High(WordArray)] := FilterStr; for I := 0 to High(Song) do begin if not Song[i].Main then begin - case fType of - 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; - 1: cString := Song[I].Title; - 2: cString := Song[I].Artist; + case Filter of + fltAll: + TmpString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder; + fltTitle: + TmpString := Song[I].Title; + fltArtist: + TmpString := Song[I].Artist; end; - Song[i].Visible:=true; - // Look for every Searched Word - for J := 0 to High(SearchStr) do + Song[i].Visible := true; + // Look for every searched word + for J := 0 to High(WordArray) do begin - Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J]) + Song[i].Visible := Song[i].Visible and + UTF8ContainsText(TmpString, WordArray[J]) end; if Song[i].Visible then Inc(Result); end else - Song[i].Visible:=false; + Song[i].Visible := false; end; CatNumShow := -2; end @@ -820,7 +843,7 @@ begin begin for i := 0 to High(Song) do begin - Song[i].Visible := (Ini.Tabs=1) = Song[i].Main; + Song[i].Visible := (Ini.Tabs = 1) = Song[i].Main; CatNumShow := -1; end; Result := 0; diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas index 6eec8eec..bb3d0f1a 100644 --- a/src/base/UTextEncoding.pas +++ b/src/base/UTextEncoding.pas @@ -19,8 +19,8 @@ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, * Boston, MA 02110-1301, USA. * - * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/menu/UMenuText.pas $ - * $Id: UMenuText.pas 1485 2008-10-28 20:16:05Z tobigun $ + * $URL$ + * $Id$ *} unit UTextEncoding; @@ -34,114 +34,206 @@ interface {$I switches.inc} uses - SysUtils; + SysUtils, + UUnicodeUtils; type - TEncoding = (encCP1250, encCP1252, encUTF8, encNative); + TEncoding = ( + encLocale, // current locale (needs cwstring on linux) + encUTF8, // UTF-8 + encCP1250, // Windows-1250 Central/Eastern Europe (used by Ultrastar) + encCP1252 // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1) + ); -function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString; +const + UTF8_BOM: UTF8String = #$EF#$BB#$BF; + +{** + * Decodes Src encoded in SrcEncoding to a UTF-16 or UTF-8 encoded Dst string. + * Returns true if the conversion was successful. + *} +function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean; overload; +function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString; overload; +function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean; overload; +function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String; overload; + +{** + * Encodes the UTF-16 or UTF-8 encoded Src string to Dst using DstEncoding + * Returns true if the conversion was successful. + *} +function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload; +function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString; overload; +function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload; +function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString; overload; + +{** + * If Text starts with an UTF-8 BOM, the BOM is removed and true will + * be returned. + *} +function CheckReplaceUTF8BOM(var Text: RawByteString): boolean; + +{** + * Parses an encoding string to its TEncoding equivalent. + * Surrounding whitespace and dashes ('-') are removed, the upper-cased + * resulting value is then compared with TEncodingNames. + * If the encoding was not found, the result is set to the Default encoding. + *} +function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding; + +{** + * Returns the name of an encoding. + *} +function EncodingName(Encoding: TEncoding): AnsiString; implementation +uses + StrUtils; + type - TConversionTable = array[0..127] of WideChar; + IEncoder = interface + function GetName(): AnsiString; + function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; + function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; + end; + + TEncoder = class(TInterfacedObject, IEncoder) + public + function GetName(): AnsiString; virtual; abstract; + function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; virtual; abstract; + function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; virtual; abstract; + end; + + TSingleByteEncoder = class(TEncoder) + public + function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; override; + function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; override; + function DecodeChar(InChr: AnsiChar; out OutChr: UCS4Char): boolean; virtual; abstract; + function EncodeChar(InChr: UCS4Char; out OutChr: AnsiChar): boolean; virtual; abstract; + end; const - // Windows-1250 Central/Eastern Europe (used by Ultrastar) - CP1250Table: TConversionTable = ( - { $80 } - #$20AC, #0, #$201A, #0, #$201E, #$2026, #$2020, #$2021, - #0, #$2030, #$0160, #$2039, #$015A, #$0164, #$017D, #$0179, - { $90 } - #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014, - #0, #$2122, #$0161, #$203A, #$015B, #$0165, #$017E, #$017A, - { $A0 } - #$00A0, #$02C7, #$02D8, #$0141, #$00A4, #$0104, #$00A6, #$00A7, - #$00A8, #$00A9, #$015E, #$00AB, #$00AC, #$00AD, #$00AE, #$017B, - { $B0 } - #$00B0, #$00B1, #$02DB, #$0142, #$00B4, #$00B5, #$00B6, #$00B7, - #$00B8, #$0105, #$015F, #$00BB, #$013D, #$02DD, #$013E, #$017C, - { $C0 } - #$0154, #$00C1, #$00C2, #$0102, #$00C4, #$0139, #$0106, #$00C7, - #$010C, #$00C9, #$0118, #$00CB, #$011A, #$00CD, #$00CE, #$010E, - { $D0 } - #$0110, #$0143, #$0147, #$00D3, #$00D4, #$0150, #$00D6, #$00D7, - #$0158, #$016E, #$00DA, #$0170, #$00DC, #$00DD, #$0162, #$00DF, - { $E0 } - #$0155, #$00E1, #$00E2, #$0103, #$00E4, #$013A, #$0107, #$00E7, - #$010D, #$00E9, #$0119, #$00EB, #$011B, #$00ED, #$00EE, #$010F, - { $F0 } - #$0111, #$0144, #$0148, #$00F3, #$00F4, #$0151, #$00F6, #$00F7, - #$0159, #$016F, #$00FA, #$0171, #$00FC, #$00FD, #$0163, #$02D9 - ); + ERROR_CHAR = '?'; - // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1) - CP1252Table: TConversionTable = ( - { $80 } - #$20AC, #0, #$201A, #$0192, #$201E, #$2026, #$2020, #$2021, - #$02C6, #$2030, #$0160, #$2039, #$0152, #0, #$017D, #0, - { $90 } - #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014, - #$02DC, #$2122, #$0161, #$203A, #$0153, #0, #$017E, #$0178, - { $A0 } - #$00A0, #$00A1, #$00A2, #$00A3, #$00A4, #$00A5, #$00A6, #$00A7, - #$00A8, #$00A9, #$00AA, #$00AB, #$00AC, #$00AD, #$00AE, #$00AF, - { $B0 } - #$00B0, #$00B1, #$00B2, #$00B3, #$00B4, #$00B5, #$00B6, #$00B7, - #$00B8, #$00B9, #$00BA, #$00BB, #$00BC, #$00BD, #$00BE, #$00BF, - { $C0 } - #$00C0, #$00C1, #$00C2, #$00C3, #$00C4, #$00C5, #$00C6, #$00C7, - #$00C8, #$00C9, #$00CA, #$00CB, #$00CC, #$00CD, #$00CE, #$00CF, - { $D0 } - #$00D0, #$00D1, #$00D2, #$00D3, #$00D4, #$00D5, #$00D6, #$00D7, - #$00D8, #$00D9, #$00DA, #$00DB, #$00DC, #$00DD, #$00DE, #$00DF, - { $E0 } - #$00E0, #$00E1, #$00E2, #$00E3, #$00E4, #$00E5, #$00E6, #$00E7, - #$00E8, #$00E9, #$00EA, #$00EB, #$00EC, #$00ED, #$00EE, #$00EF, - { $F0 } - #$00F0, #$00F1, #$00F2, #$00F3, #$00F4, #$00F5, #$00F6, #$00F7, - #$00F8, #$00F9, #$00FA, #$00FB, #$00FC, #$00FD, #$00FE, #$00FF - ); +var + Encoders: array[TEncoding] of IEncoder; +function TSingleByteEncoder.Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; +var + I: integer; +begin + SetLength(OutStr, LengthUCS4(InStr)); + Result := true; + for I := 1 to Length(OutStr) do + begin + if (not EncodeChar(InStr[I-1], OutStr[I])) then + Result := false; + end; +end; -function Convert(const Src: string; const Table: TConversionTable): WideString; +function TSingleByteEncoder.Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; var - SrcPos, DstPos: integer; + I: integer; begin - SetLength(Result, Length(Src)); - DstPos := 1; - for SrcPos := 1 to Length(Src) do + SetLength(OutStr, Length(InStr)+1); + Result := true; + for I := 1 to Length(InStr) do begin - if (Src[SrcPos] < #128) then - begin - // copy ASCII char - Result[DstPos] := Src[SrcPos]; - Inc(DstPos); - end - else + if (not DecodeChar(InStr[I], OutStr[I-1])) then + Result := false; + end; + OutStr[High(OutStr)] := 0; +end; + +function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean; +var + DstUCS4: UCS4String; +begin + Result := Encoders[SrcEncoding].Decode(Src, DstUCS4); + Dst := UCS4StringToWideString(DstUCS4); +end; + +function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString; +begin + DecodeString(Src, Result, SrcEncoding); +end; + +function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean; +var + DstUCS4: UCS4String; +begin + Result := Encoders[SrcEncoding].Decode(Src, DstUCS4); + Dst := UCS4ToUTF8String(DstUCS4); +end; + +function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String; +begin + DecodeStringUTF8(Src, Result, SrcEncoding); +end; + +function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean; +begin + Result := Encoders[DstEncoding].Encode(WideStringToUCS4String(Src), Dst); +end; + +function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString; +begin + EncodeString(Src, Result, DstEncoding); +end; + +function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean; +begin + Result := Encoders[DstEncoding].Encode(UTF8ToUCS4String(Src), Dst); +end; + +function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString; +begin + EncodeStringUTF8(Src, Result, DstEncoding); +end; + +function CheckReplaceUTF8BOM(var Text: RawByteString): boolean; +begin + if AnsiStartsStr(UTF8_BOM, Text) then + begin + Text := Copy(Text, Length(UTF8_BOM)+1, Length(Text)-Length(UTF8_BOM)); + Result := true; + Exit; + end; + Result := false; +end; + +function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding; +var + PrepStr: AnsiString; // prepared encoding string + Encoding: TEncoding; +begin + // remove surrounding whitespace, replace dashes, to upper case + PrepStr := UpperCase(AnsiReplaceStr(Trim(EncodingStr), '-', '')); + for Encoding := Low(TEncoding) to High(TEncoding) do + begin + if (Encoders[Encoding].GetName() = PrepStr) then begin - // look-up char - Result[DstPos] := Table[Ord(Src[SrcPos]) - 128]; - // ignore invalid characters - if (Result[DstPos] <> #0) then - Inc(DstPos); + Result := Encoding; + Exit; end; end; - SetLength(Result, DstPos-1); + Result := Default; end; -function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString; +function EncodingName(Encoding: TEncoding): AnsiString; begin - case SrcEncoding of - encCP1250: - Result := Convert(Src, CP1250Table); - encCP1252: - Result := Convert(Src, CP1252Table); - encUTF8: - Result := UTF8Decode(Src); - encNative: - Result := UTF8Decode(AnsiToUtf8(Src)); - end; + Result := Encoders[Encoding].GetName(); end; +{$I ../encoding/Locale.inc} +{$I ../encoding/UTF8.inc} +{$I ../encoding/CP1250.inc} +{$I ../encoding/CP1252.inc} + +initialization + Encoders[encLocale] := TEncoderLocale.Create; + Encoders[encUTF8] := TEncoderUTF8.Create; + Encoders[encCP1250] := TEncoderCP1250.Create; + Encoders[encCP1252] := TEncoderCP1252.Create; + end. diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index 97f244fe..e477dbb1 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -40,6 +40,7 @@ uses Classes, SysUtils, UCommon, + UPath, SDL, SDL_Image; @@ -66,7 +67,7 @@ type TexX2: real; TexY2: real; Alpha: real; - Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins + Name: IPath; // experimental for handling cache images. maybe it's useful for dynamic skins end; type @@ -91,7 +92,7 @@ procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); type PTextureEntry = ^TTextureEntry; TTextureEntry = record - Name: string; + Name: IPath; Typ: TTextureType; Color: cardinal; @@ -105,7 +106,7 @@ type Texture: array of TTextureEntry; public procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); - function FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; + function FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer; end; TTextureUnit = class @@ -116,14 +117,14 @@ type procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload; - function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; - function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; - function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; - function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload; - function LoadTexture(const Identifier: string): TTexture; overload; - function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; - procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload; - procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload; + function GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean = false): TTexture; overload; + function GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload; + function LoadTexture(FromRegistry: boolean; const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload; + function LoadTexture(const Identifier: IPath): TTexture; overload; + function CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture; + procedure UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean); overload; + procedure UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload; //procedure FlushTextureDatabase(); constructor Create; @@ -188,7 +189,7 @@ begin Texture[TextureIndex].Texture := Tex; end; -function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer; +function TTextureDatabase.FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer; var TextureIndex: integer; CurrentTexture: PTextureEntry; @@ -197,7 +198,7 @@ begin for TextureIndex := 0 to High(Texture) do begin CurrentTexture := @Texture[TextureIndex]; - if (CurrentTexture.Name = Name) and + if (CurrentTexture.Name.Equals(Name)) and (CurrentTexture.Typ = Typ) then begin // colorized textures must match in their color too @@ -235,18 +236,18 @@ begin TextureDatabase.AddTexture(Tex, Typ, Color, Cache); end; -function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; begin // FIXME: what is the FromRegistry parameter supposed to do? Result := LoadTexture(Identifier, Typ, Col); end; -function TTextureUnit.LoadTexture(const Identifier: string): TTexture; +function TTextureUnit.LoadTexture(const Identifier: IPath): TTexture; begin Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0); end; -function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; +function TTextureUnit.LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; var TexSurface: PSDL_Surface; newWidth, newHeight: integer; @@ -260,7 +261,7 @@ begin TexSurface := LoadImage(Identifier); if not assigned(TexSurface) then begin - Log.LogError('Could not load texture: "' + Identifier +'" with type "'+ TextureTypeToStr(Typ) +'"', + Log.LogError('Could not load texture: "' + Identifier.ToNative +'" with type "'+ TextureTypeToStr(Typ) +'"', 'TTextureUnit.LoadTexture'); Exit; end; @@ -363,16 +364,16 @@ begin SDL_FreeSurface(TexSurface); end; -function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture; +function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean): TTexture; begin Result := GetTexture(Name, Typ, 0, FromCache); end; -function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; +function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; var TextureIndex: integer; begin - if (Name = '') then + if (Name.IsUnset) then begin // zero texture data FillChar(Result, SizeOf(Result), 0); @@ -413,7 +414,7 @@ begin Result := TextureDatabase.Texture[TextureIndex].Texture; end; -function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture; +function TTextureUnit.CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture; var //Error: integer; ActTex: GLuint; @@ -467,12 +468,12 @@ begin Result.Name := Name; end; -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); +procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean); begin UnloadTexture(Name, Typ, 0, FromCache); end; -procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); +procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean); var T: integer; TexNum: GLuint; diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 3fd77853..c1a26927 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -34,11 +34,12 @@ interface {$I switches.inc} uses - ULog, IniFiles, SysUtils, Classes, - UTexture; + ULog, + UTexture, + UPath; type TRGB = record @@ -112,7 +113,7 @@ type Font: integer; Size: integer; Align: integer; - Text: string; + Text: UTF8String; //Reflection Reflection: boolean; ReflectionSpacing: real; @@ -182,7 +183,7 @@ type showArrows:boolean; oneItemOnly:boolean; - Text: string; + Text: UTF8String; ColR, ColG, ColB, Int: real; DColR, DColG, DColB, DInt: real; TColR, TColG, TColB, TInt: real; @@ -236,8 +237,8 @@ type TextDescription: TThemeText; TextDescriptionLong: TThemeText; - Description: array[0..5] of string; - DescriptionLong: array[0..5] of string; + Description: array[0..5] of UTF8String; + DescriptionLong: array[0..5] of UTF8String; end; TThemeName = class(TThemeBasic) @@ -354,7 +355,7 @@ type TextP3RScore: TThemeText; //Linebonus Translations - LineBonusText: array [0..8] of string; + LineBonusText: array [0..8] of UTF8String; //Pause Popup PausePopUp: TThemeStatic; @@ -421,7 +422,7 @@ type ButtonExit: TThemeButton; TextDescription: TThemeText; - Description: array[0..7] of string; + Description: array[0..7] of UTF8String; end; TThemeOptionsGame = class(TThemeBasic) @@ -496,8 +497,8 @@ type TextDescription: TThemeText; TextDescriptionLong: TThemeText; - Description: array[0..5] of string; - DescriptionLong: array[0..5] of string; + Description: array[0..5] of UTF8string; + DescriptionLong: array[0..5] of UTF8string; end; //Error- and Check-Popup @@ -531,10 +532,10 @@ type TextFound: TThemeText; //Translated Texts - Songsfound: string; - NoSongsfound: string; - CatText: string; - IType: array [0..2] of string; + Songsfound: UTF8String; + NoSongsfound: UTF8String; + CatText: UTF8String; + IType: array [0..2] of UTF8String; end; //Party Screens @@ -700,15 +701,15 @@ type TextPage: TThemeText; TextList: AThemeText; - Description: array[0..3] of string; - DescriptionR: array[0..3] of string; - FormatStr: array[0..3] of string; - PageStr: string; + Description: array[0..3] of UTF8String; + DescriptionR: array[0..3] of UTF8String; + FormatStr: array[0..3] of UTF8String; + PageStr: UTF8String; end; //Playlist Translations TThemePlaylist = record - CatText: string; + CatText: UTF8String; end; TTheme = class @@ -761,11 +762,11 @@ type Playlist: TThemePlaylist; - ILevel: array[0..2] of string; + ILevel: array[0..2] of UTF8String; - constructor Create(const FileName: string); overload; // Initialize theme system - constructor Create(const FileName: string; Color: integer); overload; // Initialize theme system with color - function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file + constructor Create(const FileName: IPath); overload; // Initialize theme system + constructor Create(const FileName: IPath; Color: integer); overload; // Initialize theme system with color + function LoadTheme(const FileName: IPath; sColor: integer): boolean; // Load some theme settings from file procedure LoadColors; @@ -845,12 +846,12 @@ begin glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); end; -constructor TTheme.Create(const FileName: string); +constructor TTheme.Create(const FileName: IPath); begin Create(FileName, 0); end; -constructor TTheme.Create(const FileName: string; Color: integer); +constructor TTheme.Create(const FileName: IPath; Color: integer); begin inherited Create(); @@ -893,7 +894,7 @@ begin end; -function TTheme.LoadTheme(FileName: string; sColor: integer): boolean; +function TTheme.LoadTheme(const FileName: IPath; sColor: integer): boolean; var I: integer; begin @@ -901,23 +902,21 @@ begin CreateThemeObjects(); - Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme'); - - FileName := AdaptFilePaths(FileName); + Log.LogStatus('Loading: '+ FileName.ToNative, 'TTheme.LoadTheme'); - if not FileExists(FileName) then + if not FileName.IsFile() then begin - Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme'); + Log.LogError('Theme does not exist ('+ FileName.ToNative +')', 'TTheme.LoadTheme'); end; - if FileExists(FileName) then + if FileName.IsFile() then begin Result := true; {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName); + ThemeIni := TIniFile.Create(FileName.ToNative); {$ELSE} - ThemeIni := TMemIniFile.Create(FileName); + ThemeIni := TMemIniFile.Create(FileName.ToNative); {$ENDIF} if ThemeIni.ReadString('Theme', 'Name', '') <> '' then diff --git a/src/base/UUnicodeUtils.pas b/src/base/UUnicodeUtils.pas new file mode 100644 index 00000000..37b53a67 --- /dev/null +++ b/src/base/UUnicodeUtils.pas @@ -0,0 +1,670 @@ +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UUnicodeUtils; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +uses +{$IFDEF MSWINDOWS} + Windows, +{$ENDIF} + StrUtils, + SysUtils; + +type + // String with unknown encoding. Introduced with Delphi 2009 and maybe soon + // with FPC. + RawByteString = AnsiString; + +{** + * Returns true if the system uses UTF-8 as default string type + * (filesystem or API calls). + * This is always true on Mac OS X and always false on Win32. On Unix it depends + * on the LC_CTYPE setting. + * Do not use AnsiToUTF8() or UTF8ToAnsi() if this function returns true. + *} +function IsNativeUTF8(): boolean; + +(* + * Character classes + *) + +function IsAlphaChar(ch: WideChar): boolean; overload; +function IsAlphaChar(ch: UCS4Char): boolean; overload; + +function IsNumericChar(ch: WideChar): boolean; overload; +function IsNumericChar(ch: UCS4Char): boolean; overload; + +function IsAlphaNumericChar(ch: WideChar): boolean; overload; +function IsAlphaNumericChar(ch: UCS4Char): boolean; overload; + +function IsPunctuationChar(ch: WideChar): boolean; overload; +function IsPunctuationChar(ch: UCS4Char): boolean; overload; + +function IsControlChar(ch: WideChar): boolean; overload; +function IsControlChar(ch: UCS4Char): boolean; overload; + +function IsPrintableChar(ch: WideChar): boolean; overload; +function IsPrintableChar(ch: UCS4Char): boolean; overload; + +{** + * Checks if the given string is a valid UTF-8 string. + * If an ANSI encoded string (with char codes >= 128) is passed, the + * function will most probably return false, as most ANSI strings sequences + * are illegal in UTF-8. + *} +function IsUTF8String(const str: RawByteString): boolean; + +{** + * Iterates over an UTF-8 encoded string. + * StrPtr will be increased to the beginning of the next character on each + * call. + * Results true if the given string starts with an UTF-8 encoded char. + *} +function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean; + +{** + * Deletes Count chars (not bytes) beginning at char- (not byte-) position Index. + * Index values start with 1. + *} +procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer); +procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer); + +{** + * Checks if the string is composed of ASCII characters. + *} +function IsASCIIString(const str: RawByteString): boolean; + +{* + * String format conversion + *} + +function UTF8ToUCS4String(const str: UTF8String): UCS4String; +function UCS4ToUTF8String(const str: UCS4String): UTF8String; overload; +function UCS4ToUTF8String(ch: UCS4Char): UTF8String; overload; + +{** + * Returns the number of characters (not bytes) in string str. + *} +function LengthUTF8(const str: UTF8String): integer; + +{** + * Returns the length of an UCS4String. Note that Length(UCS4String) returns + * the length+1 as UCS4Strings are zero-terminated. + *} +function LengthUCS4(const str: UCS4String): integer; + +{** @seealso WideCompareStr *} +function UTF8CompareStr(const S1, S2: UTF8String): integer; +{** @seealso WideCompareText *} +function UTF8CompareText(const S1, S2: UTF8String): integer; + +function UTF8StartsText(const SubText, Text: UTF8String): boolean; + +function UTF8ContainsStr(const Text, SubText: UTF8String): boolean; +function UTF8ContainsText(const Text, SubText: UTF8String): boolean; + +{** @seealso WideUpperCase *} +function UTF8UpperCase(const str: UTF8String): UTF8String; +{** @seealso WideCompareText *} +function UTF8LowerCase(const str: UTF8String): UTF8String; + +{** + * Converts a UCS-4 char ch to its upper-case representation. + *} +function UCS4UpperCase(ch: UCS4Char): UCS4Char; overload; + +{** + * Converts a UCS-4 string str to its upper-case representation. + *} +function UCS4UpperCase(const str: UCS4String): UCS4String; overload; + +{** + * Converts a UCS4Char to an UCS4String. + * Note that UCS4Strings are zero-terminated dynamic arrays. + *} +function UCS4CharToString(ch: UCS4Char): UCS4String; + +{** + * @seealso System.Pos() + *} +function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer; + +{** + * Copies a segment of str starting with Index (1-based) with Count characters (not bytes). + *} +function UTF8Copy(const str: UTF8String; Index: Integer = 1; Count: Integer = -1): UTF8String; + +{** + * Copies a segment of str starting with Index (0-based) with Count characters. + * Note: Do not use Copy() to copy UCS4Strings as the result will not contain + * a trailing #0 character and hence is invalid. + *} +function UCS4Copy(const str: UCS4String; Index: Integer = 0; Count: Integer = -1): UCS4String; + +(* + * Converts a WideString to its upper- or lower-case representation. + * Wrapper for WideUpper/LowerCase. Needed because some plattforms have + * problems with unicode support. + * + * Note that characters in UTF-16 might consist of one or two WideChar valus + * (see surrogates). So instead of using WideStringUpperCase(ch)[1] for single + * character access, convert to UCS-4 where each character is represented by + * one UCS4Char. + *) +function WideStringUpperCase(const str: WideString) : WideString; overload; +function WideStringUpperCase(ch: WideChar): WideString; overload; +function WideStringLowerCase(const str: WideString): WideString; overload; +function WideStringLowerCase(ch: WideChar): WideString; overload; + +function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString; + +implementation + +{$IFDEF UNIX} +{$IFNDEF DARWIN} +const + LC_CTYPE = 0; + +function setlocale(category: integer; locale: PChar): PChar; cdecl; external 'c'; +{$ENDIF} +{$ENDIF} + +var + NativeUTF8: boolean; + +procedure InitUnicodeUtils(); +{$IFDEF UNIX} +{$IFNDEF DARWIN} +var + localeName: PChar; +{$ENDIF} +{$ENDIF} +begin + {$IF Defined(DARWIN)} + NativeUTF8 := true; + {$ELSEIF Defined(MSWindows)} + NativeUTF8 := false; + {$ELSEIF Defined(UNIX)} + // check if locale name contains UTF8 or UTF-8 + localeName := setlocale(LC_CTYPE, nil); + NativeUTF8 := Pos('UTF8', UpperCase(AnsiReplaceStr(localeName, '-', ''))) > 0; + {$ELSE} + raise Exception.Create('Unknown system'); + {$IFEND} +end; + +function IsNativeUTF8(): boolean; +begin + Result := NativeUTF8; +end; + +function IsAlphaChar(ch: WideChar): boolean; +begin + {$IFDEF MSWINDOWS} + Result := IsCharAlphaW(ch); + {$ELSE} + // TODO: add chars > 255 (or replace with libxml2 functions?) + case ch of + 'A'..'Z', // A-Z + 'a'..'z', // a-z + #170,#181,#186, + #192..#214, + #216..#246, + #248..#255: + Result := true; + else + Result := false; + end; + {$ENDIF} +end; + +function IsAlphaChar(ch: UCS4Char): boolean; +begin + Result := IsAlphaChar(WideChar(Ord(ch))); +end; + +function IsNumericChar(ch: WideChar): boolean; +begin + // TODO: replace with libxml2 functions? + // ignore non-arabic numerals as we do not want to handle them + case ch of + '0'..'9': + Result := true; + else + Result := false; + end; +end; + +function IsNumericChar(ch: UCS4Char): boolean; +begin + Result := IsNumericChar(WideChar(Ord(ch))); +end; + +function IsAlphaNumericChar(ch: WideChar): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsAlphaNumericChar(ch: UCS4Char): boolean; +begin + Result := (IsAlphaChar(ch) or IsNumericChar(ch)); +end; + +function IsPunctuationChar(ch: WideChar): boolean; +begin + // TODO: add chars > 255 (or replace with libxml2 functions?) + case ch of + ' '..'/',':'..'@','['..'`','{'..'~', + #160..#191,#215,#247: + Result := true; + else + Result := false; + end; +end; + +function IsPunctuationChar(ch: UCS4Char): boolean; +begin + Result := IsPunctuationChar(WideChar(Ord(ch))); +end; + +function IsControlChar(ch: WideChar): boolean; +begin + case ch of + #0..#31, + #127..#159: + Result := true; + else + Result := false; + end; +end; + +function IsControlChar(ch: UCS4Char): boolean; +begin + Result := IsControlChar(WideChar(Ord(ch))); +end; + +function IsPrintableChar(ch: WideChar): boolean; +begin + Result := not IsControlChar(ch); +end; + +function IsPrintableChar(ch: UCS4Char): boolean; +begin + Result := IsPrintableChar(WideChar(Ord(ch))); +end; + + +function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean; + + // find the most significant zero bit (Result: [7..-1]) + function FindZeroMSB(b: byte): integer; + var + Mask: byte; + begin + Mask := $80; + Result := 7; + while (b and Mask <> 0) do + begin + Mask := Mask shr 1; + Dec(Result); + end; + end; + +var + ZeroBit: integer; + SeqCount: integer; // number of trailing bytes to follow +const + Mask: array[1..3] of byte = ($1F, $0F, $07); +begin + Result := false; + SeqCount := 0; + Ch := 0; + + while (StrPtr^ <> #0) do + begin + if (StrPtr^ < #128) then + begin + // check that no more trailing bytes are expected + if (SeqCount = 0) then + begin + Ch := Ord(StrPtr^); + Inc(StrPtr); + Result := true; + end; + Break; + end + else + begin + ZeroBit := FindZeroMSB(Ord(StrPtr^)); + // trailing byte expected + if (SeqCount > 0) then + begin + // check if trailing byte has pattern 10xxxxxx + if (ZeroBit <> 6) then + begin + Inc(StrPtr); + Break; + end; + + Dec(SeqCount); + Ch := (Ch shl 6) or (Ord(StrPtr^) and $3F); + + // check if char is finished + if (SeqCount = 0) then + begin + Inc(StrPtr); + Result := true; + Break; + end; + end + else // leading byte expected + begin + // check if pattern is one of 110xxxxx/1110xxxx/11110xxx + if (ZeroBit > 5) or (ZeroBit < 3) then + begin + Inc(StrPtr); + Break; + end; + // calculate number of trailing bytes (1, 2 or 3) + SeqCount := 6 - ZeroBit; + // extract first part of char + Ch := Ord(StrPtr^) and Mask[SeqCount]; + end; + end; + + Inc(StrPtr); + end; + + if (not Result) then + Ch := Ord('?'); +end; + +function IsUTF8String(const str: RawByteString): boolean; +var + Ch: UCS4Char; + StrPtr: PAnsiChar; +begin + Result := true; + StrPtr := PChar(str); + while (StrPtr^ <> #0) do + begin + if (not NextCharUTF8(StrPtr, Ch)) then + begin + Result := false; + Exit; + end; + end; +end; + +function IsASCIIString(const str: RawByteString): boolean; +var + I: integer; +begin + for I := 1 to Length(str) do + begin + if (str[I] >= #128) then + begin + Result := false; + Exit; + end; + end; + Result := true; +end; + + +function UTF8ToUCS4String(const str: UTF8String): UCS4String; +begin + Result := WideStringToUCS4String(UTF8Decode(str)); +end; + +function UCS4ToUTF8String(const str: UCS4String): UTF8String; +begin + Result := UTF8Encode(UCS4StringToWideString(str)); +end; + +function UCS4ToUTF8String(ch: UCS4Char): UTF8String; +begin + Result := UCS4ToUTF8String(UCS4CharToString(ch)); +end; + +function LengthUTF8(const str: UTF8String): integer; +begin + Result := LengthUCS4(UTF8ToUCS4String(str)); +end; + +function LengthUCS4(const str: UCS4String): integer; +begin + Result := High(str); + if (Result = -1) then + Result := 0; +end; + +function UTF8CompareStr(const S1, S2: UTF8String): integer; +begin + Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2)); +end; + +function UTF8CompareText(const S1, S2: UTF8String): integer; +begin + Result := WideCompareText(UTF8Decode(S1), UTF8Decode(S2)); +end; + +function UTF8StartsStr(const SubText, Text: UTF8String): boolean; +begin + // TODO: use WideSameStr (slower but handles different representations of the same char)? + Result := (Pos(SubText, Text) = 1); +end; + +function UTF8StartsText(const SubText, Text: UTF8String): boolean; +begin + // TODO: use WideSameText (slower but handles different representations of the same char)? + Result := (Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) = 1); +end; + +function UTF8ContainsStr(const Text, SubText: UTF8String): boolean; +begin + Result := Pos(SubText, Text) > 0; +end; + +function UTF8ContainsText(const Text, SubText: UTF8String): boolean; +begin + Result := Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) > 0; +end; + +function UTF8UpperCase(const str: UTF8String): UTF8String; +begin + Result := UTF8Encode(WideStringUpperCase(UTF8Decode(str))); +end; + +function UTF8LowerCase(const str: UTF8String): UTF8String; +begin + Result := UTF8Encode(WideStringLowerCase(UTF8Decode(str))); +end; + +function UCS4UpperCase(ch: UCS4Char): UCS4Char; +begin + Result := UCS4UpperCase(UCS4CharToString(ch))[0]; +end; + +function UCS4UpperCase(const str: UCS4String): UCS4String; +begin + // convert to upper-case as WideString and convert result back to UCS-4 + Result := WideStringToUCS4String( + WideStringUpperCase( + UCS4StringToWideString(str))); +end; + +function UCS4CharToString(ch: UCS4Char): UCS4String; +begin + SetLength(Result, 2); + Result[0] := ch; + Result[1] := 0; +end; + +function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer; +begin + Result := Pos(substr, str); +end; + +function UTF8Copy(const str: UTF8String; Index: Integer; Count: Integer): UTF8String; +begin + Result := UCS4ToUTF8String(UCS4Copy(UTF8ToUCS4String(str), Index-1, Count)); +end; + +function UCS4Copy(const str: UCS4String; Index: Integer; Count: Integer): UCS4String; +var + I: integer; + MaxCount: integer; +begin + // calculate max. copy count + MaxCount := LengthUCS4(str)-Index; + if (MaxCount < 0) then + MaxCount := 0; + // adjust copy count + if (Count > MaxCount) or (Count < 0) then + Count := MaxCount; + + // copy (and add zero terminator) + SetLength(Result, Count + 1); + for I := 0 to Count-1 do + Result[I] := str[Index+I]; + Result[Count] := 0; +end; + +procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer); +var + StrUCS4: UCS4String; +begin + StrUCS4 := UTF8ToUCS4String(str); + UCS4Delete(StrUCS4, Index-1, Count); + Str := UCS4ToUTF8String(StrUCS4); +end; + +procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer); +var + Len: integer; + OldStr: UCS4String; + I: integer; +begin + Len := LengthUCS4(Str); + if (Count <= 0) or (Index < 0) or (Index >= Len) then + Exit; + if (Index + Count > Len) then + Count := Len-Index; + + OldStr := Str; + SetLength(Str, Len-Count+1); + for I := 0 to Index-1 do + Str[I] := OldStr[I]; + for I := Index+Count to Len-1 do + Str[I-Count] := OldStr[I]; + Str[High(Str)] := 0; +end; + +function WideStringUpperCase(ch: WideChar): WideString; +begin + // If WideChar #0 is converted to a WideString in Delphi, a string with + // length 1 and a single char #0 is returned. In FPC an empty (length=0) + // string will be returned. This will crash, if a non printable key was + // pressed, its char code (#0) is translated to upper-case and the the first + // character is accessed with Result[1]. + // We cannot catch this error in the WideString parameter variant as the string + // has length 0 already. + + // Force min. string length of 1 + if (ch = #0) then + Result := #0 + else + Result := WideStringUpperCase(WideString(ch)); +end; + +function WideStringUpperCase(const str: WideString): WideString; +begin + // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls. + // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()). + // The Unicode manager cwstring does not work with MacOSX at the moment because + // of missing references to iconv. + // Note: Should be fixed now + + {.$IFNDEF DARWIN} + {.$IFDEF NOIGNORE} + Result := WideUpperCase(str) + {.$ELSE} + //Result := UTF8Decode(UpperCase(UTF8Encode(str))); + {.$ENDIF} +end; + +function WideStringLowerCase(ch: WideChar): WideString; +begin + // see WideStringUpperCase + if (ch = #0) then + Result := #0 + else + Result := WideStringLowerCase(WideString(ch)); +end; + +function WideStringLowerCase(const str: WideString): WideString; +begin + // see WideStringUpperCase + Result := WideLowerCase(str) +end; + +function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString; +var + iPos : integer; +// sTemp : WideString; +begin +(* + result := text; + iPos := Pos(search, result); + while (iPos > 0) do + begin + sTemp := copy(result, iPos + length(search), length(result)); + result := copy(result, 1, iPos - 1) + rep + sTEmp; + iPos := Pos(search, result); + end; +*) + result := text; + + if search = rep then + exit; + + for iPos := 1 to length(result) do + begin + if result[iPos] = search then + result[iPos] := rep; + end; +end; + +initialization + InitUnicodeUtils; + +end. diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas index 58b48789..e9751eba 100644 --- a/src/base/UXMLSong.pas +++ b/src/base/UXMLSong.pas @@ -34,7 +34,9 @@ interface {$I switches.inc} uses - Classes; + Classes, + UPath, + UUnicodeUtils; type TNote = record @@ -42,30 +44,30 @@ type Duration: Cardinal; Tone: Integer; NoteTyp: Byte; - Lyric: String; + Lyric: UTF8String; end; - ANote = Array of TNote; + ANote = array of TNote; TSentence = record Singer: Byte; Duration: Cardinal; Notes: ANote; end; - ASentence = Array of TSentence; + ASentence = array of TSentence; - TSongInfo = Record + TSongInfo = record ID: Cardinal; DualChannel: Boolean; - Header: Record - Artist: String; - Title: String; + Header: record + Artist: UTF8String; + Title: UTF8String; Gap: Cardinal; BPM: Real; Resolution: Byte; - Edition: String; - Genre: String; - Year: String; - Language: String; + Edition: UTF8String; + Genre: UTF8String; + Year: UTF8String; + Language: UTF8String; end; CountSentences: Cardinal; Sentences: ASentence; @@ -81,23 +83,23 @@ type BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space) FirstNote: Boolean; //Is this the First Note found? For Gap calculating - Function ParseLine(Line: String): Boolean; + function ParseLine(Line: RawByteString): Boolean; public SongInfo: TSongInfo; - ErrorMessage: String; - Edition: String; - SingstarVersion: String; + ErrorMessage: string; + Edition: UTF8String; + SingstarVersion: string; - Settings: Record + Settings: record DashReplacement: Char; end; - Constructor Create; + constructor Create; - Function ParseConfigforEdition(const Filename: String): String; + function ParseConfigForEdition(const Filename: IPath): String; - Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only - Function ParseSong (const Filename: String): Boolean; //Parse whole Song + function ParseSongHeader(const Filename: IPath): Boolean; //Parse Song Header only + function ParseSong (const Filename: IPath): Boolean; //Parse whole Song end; const @@ -114,9 +116,12 @@ const DS_Both = 3; implementation -uses SysUtils, StrUtils; -Constructor TParser.Create; +uses + SysUtils, + StrUtils; + +constructor TParser.Create; begin inherited Create; ErrorMessage := ''; @@ -124,19 +129,24 @@ begin DecimalSeparator := '.'; end; -Function TParser.ParseSong (const Filename: String): Boolean; -var I: Integer; +function TParser.ParseSong(const Filename: IPath): Boolean; +var + I: Integer; + FileStream: TBinaryFileStream; begin Result := False; - if FileExists(Filename) then + if Filename.IsFile() then begin - SSFile := TStringList.Create; + ErrorMessage := 'Can''t open melody.xml file'; + SSFile := TStringList.Create; + FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); try - ErrorMessage := 'Can''t open melody.xml file'; - SSFile.LoadFromFile(Filename); + SSFile.LoadFromStream(FileStream); + ErrorMessage := ''; Result := True; + I := 0; SongInfo.CountSentences := 0; @@ -153,7 +163,7 @@ begin SetLength(SongInfo.Sentences, 0); - While Result And (I < SSFile.Count) do + while Result and (I < SSFile.Count) do begin Result := ParseLine(SSFile.Strings[I]); @@ -162,21 +172,24 @@ begin finally SSFile.Free; + FileStream.Free; end; end; end; -Function TParser.ParseSongHeader (const Filename: String): Boolean; -var I: Integer; +function TParser.ParseSongHeader (const Filename: IPath): Boolean; +var + I: Integer; + Stream: TBinaryFileStream; begin Result := False; - if FileExists(Filename) then + + if Filename.IsFile() then begin SSFile := TStringList.Create; - SSFile.Clear; - + Stream := TBinaryFileStream.Create(Filename, fmOpenRead); try - SSFile.LoadFromFile(Filename); + SSFile.LoadFromStream(Stream); If (SSFile.Count > 0) then begin @@ -207,6 +220,7 @@ begin finally SSFile.Free; + Stream.Free; end; end else @@ -569,18 +583,20 @@ begin Result := true; end; -Function TParser.ParseConfigforEdition(const Filename: String): String; +Function TParser.ParseConfigForEdition(const Filename: IPath): String; var txt: TStringlist; + Stream: TBinaryFileStream; I: Integer; J, K: Integer; S: String; begin Result := ''; - txt := TStringlist.Create; - try - txt.LoadFromFile(Filename); + Stream := TBinaryFileStream.Create(Filename, fmOpenRead); + try + txt := TStringlist.Create; + txt.LoadFromStream(Stream); For I := 0 to txt.Count-1 do begin S := Trim(txt.Strings[I]); @@ -600,6 +616,7 @@ begin Edition := Result; finally txt.Free; + Stream.Free; end; end; -- cgit v1.2.3 From 5770b03c014bffe3318b96dcb935ff3438fd12fa Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 9 Nov 2009 07:41:42 +0000 Subject: fixed div 0 errors git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1940 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 16 +++++++++++++--- 1 file changed, 13 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 72409ac1..191e74d2 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1167,12 +1167,22 @@ begin // projected width ||(x1, y1) - (x2, y1)|| Dist := (WinCoords[0][0] - WinCoords[1][0]); Dist2 := (WinCoords[0][1] - WinCoords[1][1]); - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + WidthScale := 1; + if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + begin + WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + end; // projected height ||(x1, y1) - (x1, y2)|| Dist := (WinCoords[0][0] - WinCoords[2][0]); Dist2 := (WinCoords[0][1] - WinCoords[2][1]); - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + + HeightScale := 1; + if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + begin + HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + end; //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); @@ -1326,7 +1336,7 @@ var Level: integer; begin for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then + if ((fMipmapFonts[Level] <> nil) AND (GetMipmapScale(Level) > 0)) then fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); end; -- cgit v1.2.3 From 85c7cf68848e3640238cfaa631305ae87e59cf66 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 9 Nov 2009 21:00:17 +0000 Subject: fixed folders=on bug for the moment git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1941 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index d2043a93..a6d46c4c 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -176,6 +176,14 @@ const constructor TSong.Create(); begin inherited; + + //dirty fix to fix folders=on + Self.Path := PATH_NONE(); + Self.FileName := PATH_NONE(); + Self.Cover := PATH_NONE(); + Self.Mp3 := PATH_NONE(); + Self.Background:= PATH_NONE(); + Self.Video := PATH_NONE(); end; // This may be changed, when we rewrite song select code. -- cgit v1.2.3 From ec75bc2b03e707c479f3605ffc1a8d9fe38c165b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Nov 2009 15:25:54 +0000 Subject: header tags that are not supported are written to the end of the songheader when saving in editor fixed header reader ending in infinite loop when there is a header line w/o Colon git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1943 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFiles.pas | 22 ++++++++++++++++++++ src/base/USong.pas | 60 ++++++++++++++++++++++++++++++++++++++++++++++------- 2 files changed, 74 insertions(+), 8 deletions(-) (limited to 'src/base') diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index a46d4e0d..2820a08c 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -102,6 +102,22 @@ var SaveSong := ssrEncodingError; end; + procedure WriteCustomTags; + var + I: integer; + Line: RawByteString; + begin + for I := 0 to High(Song.CustomTags) do + begin + Line := EncodeToken(Song.CustomTags[I].Content); + if (Length(Song.CustomTags[I].Tag) > 0) then + Line := EncodeToken(Song.CustomTags[I].Tag) + ':' + Line; + + SongFile.WriteLine('#' + Line); + end; + + end; + begin // Relative := true; // override (idea - use shift+S to save with relative) Result := ssrOK; @@ -109,6 +125,9 @@ begin try SongFile := TMemTextFileStream.Create(Name, fmCreate); try + // to-do: should we really write the BOM? + // it causes problems w/ older versions + // e.g. usdx 1.0.1a or ultrastar < 0.7.0 if (Song.Encoding = encUTF8) then SongFile.WriteString(UTF8_BOM); @@ -136,6 +155,9 @@ begin SongFile.WriteLine('#BPM:' + FloatToStr(Song.BPM[0].BPM / 4)); SongFile.WriteLine('#GAP:' + FloatToStr(Song.GAP)); + // write custom header tags + WriteCustomTags; + RelativeSubTime := 0; for B := 1 to High(Song.BPM) do SongFile.WriteLine('B ' + FloatToStr(Song.BPM[B].StartBeat) + ' ' diff --git a/src/base/USong.pas b/src/base/USong.pas index a6d46c4c..d76718d2 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -76,6 +76,14 @@ type Score: integer; end; + { used to hold header tags that are not supported by this version of + usdx (e.g. some tags from ultrastar 0.7.0) when songs are loaded in + songeditor. They will be written the end of the song header } + TCustomHeaderTag = record + Tag: UTF8String; + Content: UTF8String; + end; + TSong = class private FileLineNo : integer; // line, which is read last, for error reporting @@ -91,12 +99,11 @@ type function ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar; function ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString; - function ReadTXTHeader(SongFile: TTextFileStream): boolean; + function ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean; function ReadXMLHeader(const aFileName: IPath): boolean; function GetFolderCategory(const aFileName: IPath): UTF8String; function FindSongFile(Dir: IPath; Mask: UTF8String): IPath; - public Path: IPath; // kust path component of file (only set if file was found) Folder: UTF8String; // for sorting by folder (only set if file was found) @@ -131,6 +138,8 @@ type Encoding: TEncoding; + CustomTags: array of TCustomHeaderTag; + Score: array[0..2] of array of TScore; // these are used when sorting is enabled @@ -154,7 +163,7 @@ type constructor Create(const aFileName : IPath); overload; function LoadSong: boolean; function LoadXMLSong: boolean; - function Analyse(): boolean; + function Analyse(const ReadCustomTags: Boolean = false): boolean; function AnalyseXML(): boolean; procedure Clear(); end; @@ -177,6 +186,7 @@ constructor TSong.Create(); begin inherited; + // to-do : special create for category "songs" //dirty fix to fix folders=on Self.Path := PATH_NONE(); Self.FileName := PATH_NONE(); @@ -211,7 +221,7 @@ begin if (aFileName.IsChildOf(CurSongPath, true)) then begin // songs are in the "root" of the songdir => use songdir for the categorys name - Result := CurSongPath.ToUTF8; // TODO: remove trailing path-delim? + Result := CurSongPath.RemovePathDelim.ToUTF8; end else begin @@ -824,7 +834,6 @@ begin end; - {** * "International" StrToFloat variant. Uses either ',' or '.' as decimal * separator. @@ -839,7 +848,7 @@ begin Result := StrToFloatDef(TempValue, 0); end; -function TSong.ReadTXTHeader(SongFile: TTextFileStream): boolean; +function TSong.ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean; var Line, Identifier: string; Value: string; @@ -847,6 +856,21 @@ var Done: byte; // bit-vector of mandatory fields EncFile: IPath; // encoded filename FullFileName: string; + + { adds a custom header tag to the song + if there is no ':' in the read line, Tag should be empty + and the whole line should be in Content } + procedure AddCustomTag(const Tag, Content: String); + var Len: Integer; + begin + if ReadCustomTags then + begin + Len := Length(CustomTags); + SetLength(CustomTags, Len + 1); + CustomTags[Len].Tag := DecodeStringUTF8(Tag, Encoding); + CustomTags[Len].Content := DecodeStringUTF8(Content, Encoding); + end; + end; begin Result := true; Done := 0; @@ -876,7 +900,17 @@ begin //Line has no Seperator, ignore non header field if (SepPos = 0) then + begin + AddCustomTag('', Copy(Line, 2, Length(Line) - 1)); + // read next line + if (not SongFile.ReadLine(Line)) then + begin + Result := false; + Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName); + Break; + end; Continue; + end; //Read Identifier and Value Identifier := UpperCase(Trim(Copy(Line, 2, SepPos - 2))); //Uppercase is for Case Insensitive Checks @@ -887,6 +921,7 @@ begin begin Log.LogWarn('Empty field "'+Identifier+'" in file ' + FullFileName, 'TSong.ReadTXTHeader'); + AddCustomTag(Identifier, ''); end else begin @@ -1034,6 +1069,12 @@ begin else if (Identifier = 'ENCODING') then begin self.Encoding := ParseEncoding(Value, DEFAULT_ENCODING); + end + + // unsupported tag + else + begin + AddCustomTag(Identifier, Value); end; end; // End check for non-empty Value @@ -1220,6 +1261,9 @@ begin // set to default encoding Encoding := DEFAULT_ENCODING; + // clear custom header tags + SetLength(CustomTags, 0); + //Required Information Mp3 := PATH_NONE; SetLength(BPM, 0); @@ -1240,7 +1284,7 @@ begin Relative := false; end; -function TSong.Analyse(): boolean; +function TSong.Analyse(const ReadCustomTags: Boolean): boolean; var SongFile: TTextFileStream; begin @@ -1256,7 +1300,7 @@ begin Self.clear; //Read Header - Result := Self.ReadTxTHeader(SongFile) + Result := Self.ReadTxTHeader(SongFile, ReadCustomTags) finally SongFile.Free; end; -- cgit v1.2.3 From 61eaa45ee2bf7fc1d91faae3d10f3e093e3bc42c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Nov 2009 15:37:08 +0000 Subject: load and save year tag sorting by year still missing git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1944 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFiles.pas | 1 + src/base/USong.pas | 10 +++++++++- 2 files changed, 10 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index 2820a08c..5a258e3e 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -139,6 +139,7 @@ begin if Song.Edition <> 'Unknown' then SongFile.WriteLine('#EDITION:' + EncodeToken(Song.Edition)); if Song.Genre <> 'Unknown' then SongFile.WriteLine('#GENRE:' + EncodeToken(Song.Genre)); if Song.Language <> 'Unknown' then SongFile.WriteLine('#LANGUAGE:' + EncodeToken(Song.Language)); + if Song.Year <> 0 then SongFile.WriteLine('#YEAR:' + IntToStr(Song.Year)); SongFile.WriteLine('#MP3:' + EncodeToken(Song.Mp3.ToUTF8)); if Song.Cover.IsSet then SongFile.WriteLine('#COVER:' + EncodeToken(Song.Cover.ToUTF8)); diff --git a/src/base/USong.pas b/src/base/USong.pas index d76718d2..33e8d8df 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -119,6 +119,7 @@ type Genre: UTF8String; Edition: UTF8String; Language: UTF8String; + Year: Integer; Title: UTF8String; Artist: UTF8String; @@ -1034,6 +1035,12 @@ begin DecodeStringUTF8(Value, Language, Encoding) end + //Language Sorting + else if (Identifier = 'YEAR') then + begin + TryStrtoInt(Value, self.Year) + end + // Song Start else if (Identifier = 'START') then begin @@ -1256,7 +1263,8 @@ begin //Sortings: Genre := 'Unknown'; Edition := 'Unknown'; - Language := 'Unknown'; //Language Patch + Language := 'Unknown'; + Year := 0; // set to default encoding Encoding := DEFAULT_ENCODING; -- cgit v1.2.3 From df0a8e7c62a4006ea7ac66ad7c0745a48a32ef24 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Nov 2009 16:21:03 +0000 Subject: implemented suggestions by Canni from Assembla ticket #85 artist sorting replaced by artist2 title sorting replaced by title2 new sorting artist2 (suggestions for a better name?!) all songs by the same artist are put into the same category named by the artist git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1945 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCatCovers.pas | 4 +-- src/base/UIni.pas | 10 +++----- src/base/USongs.pas | 68 ++++++++++++++++++++----------------------------- 3 files changed, 33 insertions(+), 49 deletions(-) (limited to 'src/base') diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index 6e004b22..d33bbbe1 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -134,9 +134,9 @@ begin for I := 0 to high(ISorting) do begin TmpName := Name; - if ((I = sTitle) or (I = sTitle2)) and (UTF8Pos('Title', TmpName) <> 0) then + if (I = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5) - else if (I = sArtist) or (I = sArtist2) and (UTF8Pos('Artist', TmpName) <> 0) then + else if (I = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6); if not CoverExists(I, TmpName) then diff --git a/src/base/UIni.pas b/src/base/UIni.pas index a3bc1876..284389c2 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -179,15 +179,14 @@ const IDifficulty: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); ITabs: array[0..1] of UTF8String = ('Off', 'On'); - ISorting: array[0..7] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2'); sEdition = 0; sGenre = 1; sLanguage = 2; sFolder = 3; sTitle = 4; sArtist = 5; - sTitle2 = 6; - sArtist2 = 7; + sArtist2 = 6; IDebug: array[0..1] of UTF8String = ('Off', 'On'); @@ -261,7 +260,7 @@ var IDifficultyTranslated: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); ITabsTranslated: array[0..1] of UTF8String = ('Off', 'On'); - ISortingTranslated: array[0..7] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2'); + ISortingTranslated: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2'); IDebugTranslated: array[0..1] of UTF8String = ('Off', 'On'); @@ -364,8 +363,7 @@ begin ISortingTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_FOLDER'); ISortingTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_TITLE'); ISortingTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST'); - ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_TITLE2'); - ISortingTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2'); + ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2'); IDebugTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); IDebugTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 49b84425..d3018bcf 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -410,8 +410,6 @@ begin CompareFunc := CompareByArtist; sFolder: // by folder CompareFunc := CompareByFolder; - sTitle2: // by title2 - CompareFunc := CompareByTitle; sArtist2: // by artist2 CompareFunc := CompareByArtist; sLanguage: // by Language @@ -458,12 +456,8 @@ begin Songs.Sort(sTitle); Songs.Sort(sArtist); end; - sTitle2: begin - Songs.Sort(sArtist2); - Songs.Sort(sTitle2); - end; sArtist2: begin - Songs.Sort(sTitle2); + Songs.Sort(sTitle); Songs.Sort(sArtist2); end; end; // case @@ -567,6 +561,15 @@ begin if (Length(CurSong.Title) >= 1) then begin LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Title)[0]); + { all numbers and some punctuation chars are put into a + category named '#' + we can't put the other punctuation chars into this category + because they are not in order, so there will be two different + categories named '#' } + if (LetterTmp in [Ord('!') .. Ord('?')]) then + LetterTmp := Ord('#') + else + LetterTmp := UCS4UpperCase(LetterTmp); if (Letter <> LetterTmp) then begin Letter := LetterTmp; @@ -580,6 +583,16 @@ begin if (Length(CurSong.Artist) >= 1) then begin LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Artist)[0]); + { all numbers and some punctuation chars are put into a + category named '#' + we can't put the other punctuation chars into this category + because they are not in order, so there will be two different + categories named '#' } + if (LetterTmp in [Ord('!') .. Ord('?')]) then + LetterTmp := Ord('#') + else + LetterTmp := UCS4UpperCase(LetterTmp); + if (Letter <> LetterTmp) then begin Letter := LetterTmp; @@ -598,44 +611,17 @@ begin end; end; - sTitle2: begin - if (Length(CurSong.Title) >= 1) then - begin - LetterTmp := UTF8ToUCS4String(CurSong.Title)[0]; - // pack all numbers into a category named '#' - if (LetterTmp in [Ord('0') .. Ord('9')]) then - LetterTmp := Ord('#') - else - LetterTmp := UCS4UpperCase(LetterTmp); - - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(UCS4ToUTF8String(Letter)); - end; - end; - end; - sArtist2: begin - if (Length(CurSong.Artist) >= 1) then + { this new sorting puts all songs by the same artist into + a single category } + if (UTF8CompareText(CurCategory, CurSong.Artist) <> 0) then begin - LetterTmp := UTF8ToUCS4String(CurSong.Artist)[0]; - // pack all numbers into a category named '#' - if (LetterTmp in [Ord('0') .. Ord('9')]) then - LetterTmp := Ord('#') - else - LetterTmp := UCS4UpperCase(LetterTmp); - - if (Letter <> LetterTmp) then - begin - Letter := LetterTmp; - // add a letter Category Button - AddCategoryButton(UCS4ToUTF8String(Letter)); - end; + CurCategory := CurSong.Artist; + // add folder tab + AddCategoryButton(CurCategory); end; end; - + end; // case (Ini.Sorting) end; // if (Ini.Tabs = 1) -- cgit v1.2.3 From 4a0804396809345423d596b079aed51261b8612f Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 17 Nov 2009 17:35:07 +0000 Subject: prevent key input from being sent to the screen that is fading out, send it to the screen that is fading in instead. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1946 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index b8ddf346..439b0faa 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -514,7 +514,7 @@ begin else begin // check if screen wants to exit - Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); + Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit if Done then -- cgit v1.2.3 From 69f8925636e89f9803490f3407380879eb0549e6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 18 Nov 2009 12:45:34 +0000 Subject: fixed playlist creation bug: absolute path instead of just the filename was written to Playlist.Filename git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1948 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlaylist.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 03ae2ffb..188b02a6 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -350,7 +350,7 @@ begin Inc(I); PlaylistFile := PlaylistPath.Append(Name + InttoStr(I) + '.upl'); end; - Playlists[Result].Filename := PlaylistFile; + Playlists[Result].Filename := PlaylistFile.GetName; //Save new Playlist SavePlayList(Result); -- cgit v1.2.3 From d36fb79a6e0914a43fe9381c32dfdc4639e9a19e Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 18 Nov 2009 12:52:07 +0000 Subject: fixed new created playlist contents songs from old one items were not cleared on playlist creation git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1949 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlaylist.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 188b02a6..f12e06cf 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -343,6 +343,9 @@ begin end; Playlists[Result].Name := Name; + // clear playlist items + SetLength(Playlists[Result].Items, 0); + I := 1; PlaylistFile := PlaylistPath.Append(Name + '.upl'); while (PlaylistFile.Exists) do -- cgit v1.2.3 From 64e2aab2ea368ed666ad1afd7105e06917eeadb7 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 18 Nov 2009 15:34:06 +0000 Subject: fixed TCatSongs.FindNextVisible git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1951 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USongs.pas | 14 +++++++++----- 1 file changed, 9 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/USongs.pas b/src/base/USongs.pas index d3018bcf..baeec13a 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -727,14 +727,18 @@ var I: integer; begin Result := -1; - I := SearchFrom + 1; - while not CatSongs.Song[I].Visible do + I := SearchFrom; + while (Result = -1) do begin Inc (I); - if (I>high(CatSongs.Song)) then - I := low(CatSongs.Song); + + if (I > High(CatSongs.Song)) then + I := Low(CatSongs.Song); if (I = SearchFrom) then // Make One Round and no song found->quit - break; + Break; + + if (CatSongs.Song[I].Visible) then + Result := I; end; end; // Wrong song selected when tabs on bug End -- cgit v1.2.3 From 73485cb418d63ee59ab904c43e66665a3c8d0733 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 24 Nov 2009 17:50:12 +0000 Subject: refuse keyboard and mouse input when fading from screen to screen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1956 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 122 ++++++++++++++++++++++++++++------------------------- 1 file changed, 65 insertions(+), 57 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 439b0faa..0012fef3 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -390,9 +390,6 @@ var mouseDown: boolean; mouseBtn: integer; begin - if Assigned(Display.NextScreen) then - Exit; - while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -417,31 +414,39 @@ begin begin mouseDown := true; mouseBtn := Event.button.button; + + if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then + Display.OnMouseButton(true); end; SDL_MOUSEBUTTONUP: begin mouseDown := false; mouseBtn := Event.button.button; + + if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then + Display.OnMouseButton(false); end; end; Display.MoveCursor(Event.button.X * 800 / Screen.w, - Event.button.Y * 600 / Screen.h, - mouseDown and ((mouseBtn <> SDL_BUTTON_WHEELDOWN) or (mouseBtn <> SDL_BUTTON_WHEELUP))); - - if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) - else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - done := not ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) - else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) - else - begin - done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); - - // if screen wants to exit - if done then - DoQuit; + Event.button.Y * 600 / Screen.h); + + if not Assigned(Display.NextScreen) then + begin //drop input when changing screens + if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then + done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then + done := not ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then + done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + else + begin + done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); + + // if screen wants to exit + if done then + DoQuit; + end; end; end; end; @@ -476,50 +481,53 @@ begin if (Event.key.keysym.sym = SDLK_KP_ENTER) then Event.key.keysym.sym := SDLK_RETURN; - if (Event.key.keysym.sym = SDLK_F11) or - ((Event.key.keysym.sym = SDLK_RETURN) and - ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen - begin - Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); - - // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to - // reload all texture data (-> whitescreen bug). - // Only Linux and FreeBSD are able to handle screen-switching this way. - {$IF Defined(Linux) or Defined(FreeBSD)} - if boolean( Ini.FullScreen ) then + if not Assigned(Display.NextScreen) then + begin //drop input when changing screens + if (Event.key.keysym.sym = SDLK_F11) or + ((Event.key.keysym.sym = SDLK_RETURN) and + ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen begin - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); + + // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to + // reload all texture data (-> whitescreen bug). + // Only Linux and FreeBSD are able to handle screen-switching this way. + {$IF Defined(Linux) or Defined(FreeBSD)} + if boolean( Ini.FullScreen ) then + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN); + end + else + begin + SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + end; + + Display.SetCursor; + + glViewPort(0, 0, ScreenW, ScreenH); + {$IFEND} end + // if print is pressed -> make screenshot and save to screenshot path + else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then + Display.SaveScreenShot + // if there is a visible popup then let it handle input instead of underlying screen + // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) + else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then + Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then + Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then + Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - end; + // check if screen wants to exit + Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); - Display.SetCursor; - - glViewPort(0, 0, ScreenW, ScreenH); - {$IFEND} - end - // if print is pressed -> make screenshot and save to screenshot path - else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then - Display.SaveScreenShot - // if there is a visible popup then let it handle input instead of underlying screen - // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) - else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else - begin - // check if screen wants to exit - Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); - - // if screen wants to exit - if Done then - DoQuit; + // if screen wants to exit + if Done then + DoQuit; + end; end; end; SDL_JOYAXISMOTION: -- cgit v1.2.3 From 12f978afaf1a2435ce2f94c19a73bcade3983d24 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 24 Nov 2009 18:32:49 +0000 Subject: fixed this f11 thing canni mentioned git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1959 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 0012fef3..d5e0ccb3 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -483,8 +483,13 @@ begin if not Assigned(Display.NextScreen) then begin //drop input when changing screens - if (Event.key.keysym.sym = SDLK_F11) or - ((Event.key.keysym.sym = SDLK_RETURN) and + { to-do : F11 was used for fullscreen toggle, too here + but we also use the key in screenname and some other + screens. It is droped although fullscreen toggle doesn't + even work on windows. + should we add (Event.key.keysym.sym = SDLK_F11) here + anyway? } + if ((Event.key.keysym.sym = SDLK_RETURN) and ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen begin Ini.FullScreen := integer( not boolean( Ini.FullScreen ) ); -- cgit v1.2.3 From 735a5b67345e2888de89d89b4f31b4d48c06f9ec Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 24 Nov 2009 20:04:01 +0000 Subject: use second players color to indicate selected note in editor git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1960 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 15 +++------------ src/base/USong.pas | 2 ++ 2 files changed, 5 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 7738e010..b0e5a7d8 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -153,9 +153,9 @@ var ScreenPopupInfo: TScreenPopupInfo; //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_Left: array[1..6] of TTexture; //rename to tex_note_left + Tex_Mid: array[1..6] of TTexture; //rename to tex_note_mid + Tex_Right: array[1..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 @@ -299,15 +299,6 @@ var begin Log.LogStatus('Loading Textures', 'LoadTextures'); - // FIXME: do we need this? (REMOVE otherwise) - Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); - // FIXME: do we need this? (REMOVE otherwise) - Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); - // FIXME: do we need this? (REMOVE otherwise) - Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); - - 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 !? diff --git a/src/base/USong.pas b/src/base/USong.pas index 33e8d8df..f8d465c7 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -1206,6 +1206,8 @@ begin if Note[HighNote].Tone < BaseNote then BaseNote := Note[HighNote].Tone; + Note[HighNote].Color := 1; // default color to 1 for editor + DecodeStringUTF8(LyricS, Note[HighNote].Text, Encoding); Lyric := Lyric + Note[HighNote].Text; -- cgit v1.2.3 From d589e6221ffcafc077eeefaa60cdc3e33a800558 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Sat, 5 Dec 2009 12:26:00 +0000 Subject: added autodetection of utf8 used w3c regex to match all song lines whether they are utf8 lines and decode it on match as utf8 and as latin1 otherwise git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1964 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 15 +++++++-------- src/base/UTextEncoding.pas | 12 ++++++++++-- 2 files changed, 17 insertions(+), 10 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index f8d465c7..f8698d43 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -114,7 +114,7 @@ type Mp3: IPath; Background: IPath; Video: IPath; - + // sorting methods Genre: UTF8String; Edition: UTF8String; @@ -127,7 +127,7 @@ type Creator: UTF8String; CoverTex: TTexture; - + VideoGAP: real; NotesGAP: integer; Start: real; // in seconds @@ -180,8 +180,7 @@ uses UNote; //needed for Player const - // use USDX < 1.1 encoding for backward compatibility - DEFAULT_ENCODING = encCP1252; + DEFAULT_ENCODING = encAuto; constructor TSong.Create(); begin @@ -381,7 +380,7 @@ begin LinePos := OldLinePos; raise EUSDXParseException.Create('Character expected'); end; - Result := Str[1]; + Result := Str[1]; end; {** @@ -926,7 +925,7 @@ begin end else begin - + //----------- //Required Attributes //----------- @@ -1083,7 +1082,7 @@ begin begin AddCustomTag(Identifier, Value); end; - + end; // End check for non-empty Value // read next line @@ -1265,7 +1264,7 @@ begin //Sortings: Genre := 'Unknown'; Edition := 'Unknown'; - Language := 'Unknown'; + Language := 'Unknown'; Year := 0; // set to default encoding diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas index bb3d0f1a..79e5a297 100644 --- a/src/base/UTextEncoding.pas +++ b/src/base/UTextEncoding.pas @@ -42,7 +42,9 @@ type encLocale, // current locale (needs cwstring on linux) encUTF8, // UTF-8 encCP1250, // Windows-1250 Central/Eastern Europe (used by Ultrastar) - encCP1252 // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1) + encCP1252, // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1) + encAuto // try to match the w3c regex and decode as unicode on match + // and as fallback if not match ); const @@ -88,7 +90,9 @@ function EncodingName(Encoding: TEncoding): AnsiString; implementation uses - StrUtils; + StrUtils, + pcre, + ULog; type IEncoder = interface @@ -229,6 +233,7 @@ end; {$I ../encoding/UTF8.inc} {$I ../encoding/CP1250.inc} {$I ../encoding/CP1252.inc} +{$I ../encoding/Auto.inc} initialization Encoders[encLocale] := TEncoderLocale.Create; @@ -236,4 +241,7 @@ initialization Encoders[encCP1250] := TEncoderCP1250.Create; Encoders[encCP1252] := TEncoderCP1252.Create; + // use USDX < 1.1 encoding for backward compatibility (encCP1252) + Encoders[encAuto] := TEncoderAuto.Create(Encoders[encUTF8], Encoders[encCP1252]); + end. -- cgit v1.2.3 From 13220c16acafe9e9c1cab5a59a6be4ce38b43754 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Sun, 6 Dec 2009 12:13:34 +0000 Subject: Add Date to Score, Filter Players, Switch Difficulty - ID: 2901824 applied patch form sf.net bug tracker (id: 2901824) thanks to brunzelchen - Add a date-column to the score entries (UNIX-Timestamp); the date will be shown on Top5- und Stats Screen! - The Players on Top-5-Screen are now filtered: Every player with his best score! - You can switch through the difficulties on Top-5-Screen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1972 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 127 ++++++++++++++++++++++++++++++------------------- src/base/USong.pas | 1 + src/base/UThemes.pas | 2 + 3 files changed, 80 insertions(+), 50 deletions(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index bdcbd30f..85b4b8e8 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -64,6 +64,7 @@ type Difficulty: byte; SongArtist: UTF8String; SongTitle: UTF8String; + Date: UTF8String; end; TStatResultBestSingers = class(TStatResult) @@ -85,7 +86,7 @@ type TimesSungTot: word; end; - + TDataBaseSystem = class private ScoreDB: TSQLiteDatabase; @@ -107,6 +108,7 @@ type procedure FreeStats(StatList: TList); function GetTotalEntrys(Typ: TStatType): cardinal; function GetStatReset: TDateTime; + function FormatDate(time_stamp: integer): UTF8String; end; var @@ -116,6 +118,7 @@ implementation uses DateUtils, + ULanguage, StrUtils, SysUtils, ULog; @@ -145,7 +148,7 @@ begin Log.LogStatus('Initializing database: "' + Filename.ToNative + '"', 'TDataBaseSystem.Init'); try - + // open database ScoreDB := TSQLiteDatabase.Create(Filename.ToUTF8); fFilename := Filename; @@ -192,7 +195,8 @@ begin '[SongID] INTEGER NOT NULL, ' + '[Difficulty] INTEGER NOT NULL, ' + '[Player] TEXT NOT NULL, ' + - '[Score] INTEGER NOT NULL' + + '[Score] INTEGER NOT NULL, ' + + '[Date] INTEGER NULL' + ');'); ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Songs + '] (' + @@ -200,7 +204,7 @@ begin '[Artist] TEXT NOT NULL, ' + '[Title] TEXT NOT NULL, ' + '[TimesPlayed] INTEGER NOT NULL, ' + - '[Rating] INTEGER NULL' + + '[Rating] INTEGER NULL' + ');'); // convert data from 1.01 to 1.1 @@ -221,7 +225,15 @@ begin if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then begin Log.LogInfo('Outdated song database found - adding column rating to "' + cUS_Songs + '"', 'TDataBaseSystem.Init'); - ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN Rating INTEGER NULL'); + ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN [Rating] INTEGER NULL'); + end; + + + //add column date to cUS-Scores + if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') then + begin + Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init'); + ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL'); end; except @@ -244,6 +256,27 @@ begin inherited; end; +(** + * Format a UNIX-Timestamp into DATE (If 0 then '') + *) +function TDataBaseSystem.FormatDate(time_stamp: integer): UTF8String; +var + Year, Month, Day: word; +begin + Result:=''; + try + if time_stamp<>0 then + begin + DecodeDate(UnixToDateTime(time_stamp), Year, Month, Day); + Result := Format(Language.Translate('STAT_FORMAT_DATE'), [Day, Month, Year]); + end; + except + on E: EConvertError do + Log.LogError('Error Parsing FormatString "STAT_FORMAT_DATE": ' + E.Message); + end; +end; + + (** * Read Scores into SongArray *) @@ -251,27 +284,28 @@ procedure TDataBaseSystem.ReadScore(Song: TSong); var TableData: TSQLiteUniTable; Difficulty: integer; + I: integer; + PlayerListed: boolean; begin if not Assigned(ScoreDB) then Exit; TableData := nil; - try // Search Song in DB TableData := ScoreDB.GetUniTable( - 'SELECT [Difficulty], [Player], [Score] FROM [' + cUS_Scores + '] ' + + 'SELECT [Difficulty], [Player], [Score], [Date] FROM [' + cUS_Scores + '] ' + 'WHERE [SongID] = (' + 'SELECT [ID] FROM [' + cUS_Songs + '] ' + 'WHERE [Artist] = ? AND [Title] = ? ' + 'LIMIT 1) ' + - 'ORDER BY [Score] DESC LIMIT 15', + 'ORDER BY [Score] DESC;', //no LIMIT! see filter below! [Song.Artist, Song.Title]); // Empty Old Scores - SetLength(Song.Score[0], 0); - SetLength(Song.Score[1], 0); - SetLength(Song.Score[2], 0); + SetLength(Song.Score[0], 0); //easy + SetLength(Song.Score[1], 0); //medium + SetLength(Song.Score[2], 0); //hard // Go through all Entrys while (not TableData.EOF) do @@ -281,12 +315,31 @@ begin if ((Difficulty >= 0) and (Difficulty <= 2)) and (Length(Song.Score[Difficulty]) < 5) then begin - SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); + //filter player + PlayerListed:=false; + if (Length(Song.Score[Difficulty])>0) then + begin + for I := 0 to Length(Song.Score[Difficulty]) - 1 do + begin + if (Song.Score[Difficulty, I].Name = TableData.FieldByName['Player']) then + begin + PlayerListed:=true; + break; + end; + end; + end; - Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := + if not PlayerListed then + begin + SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1); + + Song.Score[Difficulty, High(Song.Score[Difficulty])].Name := TableData.FieldByName['Player']; - Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := + Song.Score[Difficulty, High(Song.Score[Difficulty])].Score := TableData.FieldAsInteger(TableData.FieldIndex['Score']); + Song.Score[Difficulty, High(Song.Score[Difficulty])].Date := + FormatDate(TableData.FieldAsInteger(TableData.FieldIndex['Date'])); + end; end; TableData.Next; @@ -314,9 +367,9 @@ begin if not Assigned(ScoreDB) then Exit; - // Prevent 0 Scores from being added - if (Score <= 0) then - Exit; + // Prevent 0 Scores from being added EDIT: ==> UScreenTop5.pas! + //if (Score <= 0) then + // Exit; TableData := nil; @@ -339,37 +392,10 @@ begin end; // Create new entry ScoreDB.ExecSQL( - 'INSERT INTO [' + cUS_Scores + '] ' + - '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' + - '(?, ?, ?, ?);', - [ID, Level, Name, Score]); - - // Delete last position when there are more than 5 entrys. - // Fixes crash when there are > 5 ScoreEntrys - // Note: GetUniTable is not applicable here, as the results are used while - // table entries are deleted. - TableData := ScoreDB.GetTable( - 'SELECT [Player], [Score] FROM [' + cUS_Scores + '] ' + - 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + - '[Difficulty] = ' + InttoStr(Level) + ' ' + - 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5'); - - while (not TableData.EOF) do - begin - // Note: Score is an int-value, so in contrast to Player, we do not bind - // this value. Otherwise we had to convert the string to an int to avoid - // an automatic cast of this field to the TEXT type (although it might even - // work that way). - ScoreDB.ExecSQL( - 'DELETE FROM [' + cUS_Scores + '] ' + - 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' + - '[Difficulty] = ' + InttoStr(Level) +' AND ' + - '[Player] = ? AND ' + - '[Score] = ' + TableData.FieldByName['Score'], - [TableData.FieldByName['Player']]); - - TableData.Next; - end; + 'INSERT INTO [' + cUS_Scores + '] ' + + '([SongID] ,[Difficulty], [Player], [Score], [Date]) VALUES ' + + '(?, ?, ?, ?, ?);', + [ID, Level, Name, Score, DateTimeToUnix(Now())]); except on E: Exception do Log.LogError(E.Message, 'TDataBaseSystem.AddScore'); @@ -386,7 +412,7 @@ procedure TDataBaseSystem.WriteScore(Song: TSong); begin if not Assigned(ScoreDB) then Exit; - + try // Increase TimesPlayed ScoreDB.ExecSQL( @@ -421,7 +447,7 @@ begin // Create query case Typ of stBestScores: begin - Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM [' + cUS_Scores + '] ' + + Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title], [Date] FROM [' + cUS_Scores + '] ' + 'INNER JOIN [' + cUS_Songs + '] ON ([SongID] = [ID]) ORDER BY [Score]'; end; stBestSingers: begin @@ -471,6 +497,7 @@ begin Score := TableData.FieldAsInteger(2); SongArtist := TableData.Fields[3]; SongTitle := TableData.Fields[4]; + Date := FormatDate(TableData.FieldAsInteger(5)); end; end; stBestSingers: begin diff --git a/src/base/USong.pas b/src/base/USong.pas index f8698d43..c465f198 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -74,6 +74,7 @@ type TScore = record Name: UTF8String; Score: integer; + Date: UTF8String; end; { used to hold header tags that are not supported by this version of diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index c1a26927..4322815e 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -409,6 +409,7 @@ type TextNumber: AThemeText; TextName: AThemeText; TextScore: AThemeText; + TextDate: AThemeText; end; TThemeOptions = class(TThemeBasic) @@ -1176,6 +1177,7 @@ begin ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); ThemeLoadTexts(Top5.TextName, 'Top5TextName'); ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); + ThemeLoadTexts(Top5.TextDate, 'Top5TextDate'); // Options ThemeLoadBasic(Options, 'Options'); -- cgit v1.2.3 From ba2e579b547b5331a2bcd900de04ae50818ada84 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Sun, 6 Dec 2009 14:40:10 +0000 Subject: fix bugtracker issue 2817034 if selected to show the name screen after song select, than this screen is now not shown before song select git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1975 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 284389c2..998d19fb 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -244,6 +244,10 @@ const IScreenFade: array[0..1] of UTF8String = ('Off', 'On'); IAskbeforeDel: array[0..1] of UTF8String = ('Off', 'On'); IOnSongClick: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu'); + sStartSing = 0; + sSelectPlayer = 1; + sOpenMenu = 2; + ILineBonus: array[0..1] of UTF8String = ('Off', 'On'); IPartyPopup: array[0..1] of UTF8String = ('Off', 'On'); -- cgit v1.2.3 From c5c8fd69256016ebd39f2de51cad9e35974bc703 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 6 Dec 2009 22:14:34 +0000 Subject: fix performance problem on scroll git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1999 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlaylist.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index f12e06cf..527eca7b 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -317,7 +317,7 @@ begin //Fix SongSelection ScreenSong.Interaction := 0; - ScreenSong.SelectNext; + ScreenSong.SelectNext(true); ScreenSong.FixSelected; //Play correct Music -- cgit v1.2.3 From c3ddbfc1dbc470c1c52c6a3d2dea6f192aad059f Mon Sep 17 00:00:00 2001 From: s_alexander Date: Mon, 7 Dec 2009 21:44:40 +0000 Subject: fixed compilation on win32 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2001 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTextEncoding.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas index 79e5a297..148cd5d4 100644 --- a/src/base/UTextEncoding.pas +++ b/src/base/UTextEncoding.pas @@ -229,11 +229,11 @@ begin Result := Encoders[Encoding].GetName(); end; -{$I ../encoding/Locale.inc} -{$I ../encoding/UTF8.inc} -{$I ../encoding/CP1250.inc} -{$I ../encoding/CP1252.inc} -{$I ../encoding/Auto.inc} +{$I ..\\encoding\\Locale.inc} +{$I ..\\encoding\\UTF8.inc} +{$I ..\\encoding\\CP1250.inc} +{$I ..\\encoding\\CP1252.inc} +{$I ..\\encoding\\Auto.inc} initialization Encoders[encLocale] := TEncoderLocale.Create; -- cgit v1.2.3 From d803b2322d8322a8e3fab7cffb043c0c62d94c9d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 13 Dec 2009 11:04:30 +0000 Subject: fixed bug in song parser that may lead to an Access Violation git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2023 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index c465f198..47200e63 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -483,7 +483,7 @@ begin while true do begin - LinePos := 0; + LinePos := 1; Param0 := ParseLyricCharParam(CurLine, LinePos); if (Param0 = 'E') then -- cgit v1.2.3 From 9902c756e8a15bb4582cdc43bb94378f29de0999 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 13 Dec 2009 11:16:12 +0000 Subject: use TryStrToInt and TryStrToFloat instead of try .. except block may increase performance at least for medley branch git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2024 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 18 ++++++++++-------- 1 file changed, 10 insertions(+), 8 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 47200e63..151ad73d 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -96,7 +96,7 @@ type function ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString; function ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer; - function ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): real; + function ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended; function ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar; function ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString; @@ -346,24 +346,26 @@ var begin OldLinePos := LinePos; Str := ParseLyricStringParam(Line, LinePos); - try - Result := StrToInt(Str); - except // on EConvertError + + if not TryStrToInt(Str, Result) then + begin // on convert error + Result := 0; LinePos := OldLinePos; raise EUSDXParseException.Create('Integer expected'); end; end; -function TSong.ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): real; +function TSong.ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended; var Str: RawByteString; OldLinePos: integer; begin OldLinePos := LinePos; Str := ParseLyricStringParam(Line, LinePos); - try - Result := StrToFloat(Str); - except // on EConvertError + + if not TryStrToFloat(Str, Result) then + begin // on convert error + Result := 0; LinePos := OldLinePos; raise EUSDXParseException.Create('Float expected'); end; -- cgit v1.2.3 From bc2e9999248beb57e85d3ae9d0f154eb1c3c1c52 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 13 Dec 2009 11:27:28 +0000 Subject: added a note concerning song parser needs to be fixed before release git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2025 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 151ad73d..fccf2757 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -380,6 +380,14 @@ begin Str := ParseLyricStringParam(Line, LinePos); if (Length(Str) <> 1) then begin + { to-do : decide what to do here + usdx < 1.1 does not nead a whitespace after a char param + so we may just write a warning to error.log and use the + first non whitespace character instead of raising an + exception that causes the song not to load. So the more + error resistant code is: + LinePos := OldLinePos + 1; + // raise EUSDXParseException.Create('Character expected'); } LinePos := OldLinePos; raise EUSDXParseException.Create('Character expected'); end; -- cgit v1.2.3 From 46e4f20c37be63c326b9ac798c656c266301d5b0 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 13 Dec 2009 13:32:09 +0000 Subject: fixed score display with linebonus=off git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2026 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 103 +++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 103 insertions(+) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index ed99e2c5..dc49e013 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -138,9 +138,18 @@ type FirstPopUp: PScorePopUp; LastPopUp: PScorePopUp; + // only defined during draw, time passed between + // current and previous call of draw + TimePassed: Cardinal; + // draws a popup by pointer procedure DrawPopUp(const PopUp: PScorePopUp); + // raises players score if RaiseScore was called + // has to be called after DrawPopUp and before + // DrawScore + procedure DoRaiseScore(const Index: integer); + // draws a score by playerindex procedure DrawScore(const Index: integer); @@ -149,6 +158,10 @@ type // removes a popup w/o destroying the list procedure KillPopUp(const last, cur: PScorePopUp); + + // calculate the amount of points for a player that is + // still in popups and therfore not displayed + function GetPopUpPoints(const Index: integer): integer; public Settings: record // Record containing some Displaying Options Phase1Time: real; // time for phase 1 to complete (in msecs) @@ -201,6 +214,12 @@ type // it gives every player a score position procedure Init; + // raises the score of a specified player to the specified score + procedure RaiseScore(Player: byte; Score: integer); + + // sets the score of a specified player to the specified score + procedure SetScore(Player: byte; Score: integer); + // spawns a new line bonus popup for the player procedure SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer); @@ -215,6 +234,7 @@ implementation uses SysUtils, + Math, SDL, TextGL, ULog, @@ -318,6 +338,7 @@ procedure TSingScores.ClearPlayers; begin KillAllPopUps; oPlayerCount := 0; + TimePassed := 0; end; {** @@ -328,6 +349,7 @@ begin KillAllPopUps; oPlayerCount := 0; oPositionCount := 0; + TimePassed := 0; end; {** @@ -399,6 +421,30 @@ begin AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore); end; +{** + * raises the score of a specified player to the specified score + *} +procedure TSingScores.RaiseScore(Player: byte; Score: integer); +begin + if (Player <= PlayerCount - 1) then + aPlayers[Player].Score := Score; +end; + +{** + * sets the score of a specified player to the specified score + *} +procedure TSingScores.SetScore(Player: byte; Score: integer); + var + Diff: Integer; +begin + if (Player <= PlayerCount - 1) then + begin + Diff := Score - Players[Player].Score; + aPlayers[Player].Score := Score; + Inc(aPlayers[Player].ScoreDisplayed, Diff); + end; +end; + {** * spawns a new line bonus popup for the player *} @@ -514,6 +560,32 @@ begin LastPopUp := nil; end; +{** + * calculate the amount of points for a player that is + * still in popups and therfore not displayed + *} +function TSingScores.GetPopUpPoints(const Index: integer): integer; + var + CurPopUp: PScorePopUp; +begin + Result := 0; + + // only check points if there is a difference between actual + // and displayed points + if (Players[Index].Score > Players[Index].ScoreDisplayed) then + begin + CurPopUp := FirstPopUp; + while (CurPopUp <> nil) do + begin + if (CurPopUp.Player = Index) then + begin // add points left "in" popup to result + Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven); + end; + CurPopUp := CurPopUp.Next; + end; + end; +end; + {** * has to be called after positions and players have been added, before first call of draw * it gives each player a score position @@ -616,6 +688,8 @@ var CurPopUp, LastPopUp: PScorePopUp; begin CurTime := SDL_GetTicks; + if (TimePassed <> 0) then + TimePassed := CurTime - TimePassed; if Visible then begin @@ -646,6 +720,7 @@ begin // draw players w/ rating bar for I := 0 to PlayerCount-1 do begin + DoRaiseScore(I); DrawScore(I); DrawRatingBar(I); end @@ -653,10 +728,38 @@ begin // draw players w/o rating bar for I := 0 to PlayerCount-1 do begin + DoRaiseScore(I); DrawScore(I); end; end; // eo visible + + TimePassed := CurTime; +end; + +{** + * raises players score if RaiseScore was called + * has to be called after DrawPopUp and before + * DrawScore + *} +procedure TSingScores.DoRaiseScore(const Index: integer); + var + S: integer; + Diff: integer; + const + RaisePerSecond = 500; +begin + S := (Players[Index].Score - Players[Index].ScoreDisplayed) + GetPopUpPoints(Index); + + if (S <> 0) then + begin + if (S > 0) then + Diff := Min(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S) + else + Diff := Max(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S); + + Inc(aPlayers[Index].ScoreDisplayed, Diff); + end; end; {** -- cgit v1.2.3 From d3b710957904ec42fa9492e0b19f30a84e0fb362 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 18 Dec 2009 16:10:21 +0000 Subject: fixed infinite score raising bug git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2049 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index dc49e013..f280900e 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -749,7 +749,7 @@ procedure TSingScores.DoRaiseScore(const Index: integer); const RaisePerSecond = 500; begin - S := (Players[Index].Score - Players[Index].ScoreDisplayed) + GetPopUpPoints(Index); + S := (Players[Index].Score - (Players[Index].ScoreDisplayed + GetPopUpPoints(Index))); if (S <> 0) then begin -- cgit v1.2.3 From 5d1e512e23f6506f270868f1509397674c2e4d5b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 18 Dec 2009 16:12:33 +0000 Subject: change zero note error to warning with better description git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2050 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index fccf2757..705206c4 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -510,7 +510,9 @@ begin //Check for ZeroNote if Param2 = 0 then - Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!') + Log.LogWarn(Format('"%s" in line %d: %s', + [FileNamePath.ToNative, FileLineNo, 'found note with length zero -> note ignored']), 'TSong.LoadSong') + //Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!') else begin // add notes -- cgit v1.2.3 From 115be023b64d9de135a09ab2a63553856eef15d9 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Sun, 20 Dec 2009 20:35:40 +0000 Subject: changed TSyncSource to interface ISyncSource git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2051 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 5d816c9a..e1184da8 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -188,8 +188,8 @@ type end; type - TSyncSource = class - function GetClock(): real; virtual; abstract; + ISyncSource = interface + function GetClock(): real; end; TAudioProcessingStream = class; @@ -250,7 +250,7 @@ type TAudioPlaybackStream = class(TAudioProcessingStream) protected - SyncSource: TSyncSource; + SyncSource: ISyncSource; AvgSyncDiff: double; SourceStream: TAudioSourceStream; @@ -282,7 +282,7 @@ type procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; - procedure SetSyncSource(SyncSource: TSyncSource); + procedure SetSyncSource(SyncSource: ISyncSource); function GetSourceStream(): TAudioSourceStream; property Status: TStreamStatus read GetStatus; @@ -364,7 +364,7 @@ type procedure SetLoop(Enabled: boolean); procedure FadeIn(Time: real; TargetVolume: single); - procedure SetSyncSource(SyncSource: TSyncSource); + procedure SetSyncSource(SyncSource: ISyncSource); procedure Rewind; function Finished: boolean; @@ -978,7 +978,7 @@ begin Result := SourceStream; end; -procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource); +procedure TAudioPlaybackStream.SetSyncSource(SyncSource: ISyncSource); begin Self.SyncSource := SyncSource; AvgSyncDiff := -1; -- cgit v1.2.3 From 1b38db896c698b754ff145931e432f4f3ee05345 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 29 Dec 2009 14:04:52 +0000 Subject: revert submission 2051. leeds to crash on 2nd song. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2056 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index e1184da8..5d816c9a 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -188,8 +188,8 @@ type end; type - ISyncSource = interface - function GetClock(): real; + TSyncSource = class + function GetClock(): real; virtual; abstract; end; TAudioProcessingStream = class; @@ -250,7 +250,7 @@ type TAudioPlaybackStream = class(TAudioProcessingStream) protected - SyncSource: ISyncSource; + SyncSource: TSyncSource; AvgSyncDiff: double; SourceStream: TAudioSourceStream; @@ -282,7 +282,7 @@ type procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; - procedure SetSyncSource(SyncSource: ISyncSource); + procedure SetSyncSource(SyncSource: TSyncSource); function GetSourceStream(): TAudioSourceStream; property Status: TStreamStatus read GetStatus; @@ -364,7 +364,7 @@ type procedure SetLoop(Enabled: boolean); procedure FadeIn(Time: real; TargetVolume: single); - procedure SetSyncSource(SyncSource: ISyncSource); + procedure SetSyncSource(SyncSource: TSyncSource); procedure Rewind; function Finished: boolean; @@ -978,7 +978,7 @@ begin Result := SourceStream; end; -procedure TAudioPlaybackStream.SetSyncSource(SyncSource: ISyncSource); +procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource); begin Self.SyncSource := SyncSource; AvgSyncDiff := -1; -- cgit v1.2.3 From 4711217f127aa0c10fa52755fd567c570277a1a1 Mon Sep 17 00:00:00 2001 From: s_alexander Date: Tue, 12 Jan 2010 17:42:41 +0000 Subject: merged lua into trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2071 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UConfig.pas | 18 +- src/base/UDraw.pas | 119 +++--- src/base/UGraphic.pas | 13 +- src/base/UMain.pas | 43 +- src/base/UParty.pas | 1021 ++++++++++++++++++++++++++++++++++++---------- src/base/USingScores.pas | 57 +-- src/base/UThemes.pas | 36 +- 7 files changed, 974 insertions(+), 333 deletions(-) (limited to 'src/base') diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index f6dc69a5..a24242e8 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -58,7 +58,7 @@ unit UConfig; // not possible to use the version-numbers in this uses-clause. // Example: // interface -// uses +// uses // versions, // include this file // {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined // const @@ -68,13 +68,13 @@ unit UConfig; // // Even if this file was an include-file no constants could be declared // before the interface's uses clause. -// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers +// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers // but this is incompatible to Delphi. In addition macros do not allow expand -// arithmetic expressions. Although you can define +// arithmetic expressions. Although you can define // {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} // the following check would fail: // {$IF FPC_VERSION_INT >= 002002000} -// would fail because FPC_VERSION_INT is interpreted as a string. +// would fail because FPC_VERSION_INT is interpreted as a string. // // PLEASE consider this if you use version numbers in $IF compiler- // directives. Otherwise you might break portability. @@ -88,7 +88,7 @@ interface {$ENDIF} {$I switches.inc} - + uses SysUtils; @@ -151,7 +151,7 @@ const FPC_RELEASE = 0; FPC_PATCH = 0; {$ENDIF} - + FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) + (FPC_RELEASE * VERSION_MINOR) + (FPC_PATCH * VERSION_RELEASE); @@ -185,13 +185,13 @@ const {$ENDIF} - {$IFDEF HaveProjectM} + {$IFDEF HaveProjectM} PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + (PROJECTM_VERSION_MINOR * VERSION_MINOR) + (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); {$ENDIF} - {$IFDEF HavePortaudio} + {$IFDEF HavePortaudio} PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); @@ -229,4 +229,4 @@ begin ' Build'; end; -end. +end. \ No newline at end of file diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 1783986f..47863f62 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -258,19 +258,21 @@ begin // So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero // This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then // BUT this is not implemented yet, all notes are drawn! :D + if (ScreenSing.settings.NotesVisible and (1 shl NrLines) <> 0) then + begin - PlayerNumber := NrLines + 1; // Player 1 is 0 - NrLines := 0; + PlayerNumber := NrLines + 1; // Player 1 is 0 + NrLines := 0; -// exploit done + // exploit done - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glColor3f(1, 1, 1); + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - lTmpA := (Right-Left); - lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); + lTmpA := (Right-Left); + lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); if ( lTmpA > 0 ) and ( lTmpB > 0 ) then TempR := lTmpA / lTmpB @@ -285,16 +287,17 @@ begin begin if NoteType <> ntFreestyle then begin - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case NoteType of - ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case NoteType of + ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could end; // case - end //Else all Notes same Color - else - glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + end //Else all Notes same Color + else + glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself // left part Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; @@ -309,35 +312,35 @@ begin glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); glEnd; - //We keep the postion of the top left corner b4 it's overwritten + //We keep the postion of the top left corner b4 it's overwritten GoldenStarPos := Rec.Left; - //done + //done - // middle part - Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; + // middle part + Rec.Left := Rec.Right; + Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; - glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; + glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); + glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; // right part Rec.Left := Rec.Right; Rec.Right := Rec.Right + NotesW; - glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; + glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); + glBegin(GL_QUADS); + glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); + glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); + glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); + glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); + glEnd; // Golden Star Patch if (NoteType = ntGolden) and (Ini.EffectSing=1) then @@ -345,13 +348,14 @@ begin GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); end; - end; // if not FreeStyle - end; // with - end; // for - end; // with + end; // if not FreeStyle + end; // with + end; // for + end; // with - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; end; // draw sung notes @@ -481,7 +485,7 @@ var W, H: real; lTmpA, lTmpB: real; begin - if (Player[PlayerIndex].ScoreTotalInt >= 0) then + if (ScreenSing.settings.NotesVisible and (1 shl PlayerIndex) <> 0) then begin glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 ); glEnable(GL_TEXTURE_2D); @@ -683,20 +687,25 @@ begin // draw note-lines - if (PlayersPlay = 1) and (Ini.NoteLines = 1) then + // to-do : needs fix when party mode works w/ 2 screens + if (PlayersPlay = 1) and (Ini.NoteLines = 1) and (ScreenSing.settings.NotesVisible and (1) <> 0) then SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then begin - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); + if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15); + if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15); end; - if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then - begin - SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); + if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin + if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12); + if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12); + if (ScreenSing.settings.NotesVisible and (1 shl 2) <> 0) then + SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12); end; // draw Lyrics @@ -937,7 +946,7 @@ begin end; // Draw Lyrics - ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); + //ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); // TODO: Lyrics helper // oscilloscope | the thing that moves when you yell into your mic (imho) diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index b0e5a7d8..f658c800 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -77,6 +77,7 @@ uses UScreenPartyOptions, UScreenPartyWin, UScreenPartyPlayer, + UScreenPartyRounds, {Stats Screens} UScreenStatMain, UScreenStatDetail, @@ -133,12 +134,13 @@ var ScreenSongJumpto: TScreenSongJumpto; //Party Screens - ScreenSingModi: TScreenSingModi; + //ScreenSingModi: TScreenSingModi; ScreenPartyNewRound: TScreenPartyNewRound; ScreenPartyScore: TScreenPartyScore; ScreenPartyWin: TScreenPartyWin; ScreenPartyOptions: TScreenPartyOptions; ScreenPartyPlayer: TScreenPartyPlayer; + ScreenPartyRounds: TScreenPartyRounds; //StatsScreens ScreenStatMain: TScreenStatMain; @@ -747,8 +749,8 @@ begin // 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); + //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; @@ -769,6 +771,8 @@ begin 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); + ScreenPartyRounds := TScreenPartyRounds.Create; + Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyRounds', 3); Log.BenchmarkStart(3); ScreenStatMain := TScreenStatMain.Create; Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); ScreenStatDetail := TScreenStatDetail.Create; @@ -805,7 +809,7 @@ begin ScreenEdit.Destroy; ScreenEditConvert.Destroy; ScreenOpen.Destroy; - ScreenSingModi.Destroy; + //ScreenSingModi.Destroy; ScreenSongMenu.Destroy; ScreenSongJumpto.Destroy; ScreenPopupCheck.Destroy; @@ -816,6 +820,7 @@ begin ScreenPartyWin.Destroy; ScreenPartyOptions.Destroy; ScreenPartyPlayer.Destroy; + ScreenPartyRounds.Destroy; ScreenStatMain.Destroy; ScreenStatDetail.Destroy; end; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index d5e0ccb3..7b082c57 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -35,6 +35,7 @@ interface uses SysUtils, + SDL; var @@ -89,6 +90,14 @@ uses USongs, UThemes, UParty, + ULuaCore, + UHookableEvent, + ULuaGl, + ULuaLog, + ULuaTexture, + ULuaTextGL, + ULuaParty, + ULuaScreenSing, UTime; procedure Main; @@ -124,6 +133,10 @@ begin SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); SDL_EnableUnicode(1); + // create luacore first so other classes can register their events + LuaCore := TLuaCore.Create; + + USTime := TTime.Create; VideoBGTimer := TRelativeTimer.Create; @@ -227,13 +240,6 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading PluginManager', 1); - // Party Mode Manager - Log.BenchmarkStart(1); - Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TPartySession.Create; //Load PartySession - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); - // Graphics Log.BenchmarkStart(1); Log.LogStatus('Initialize 3D', 'Initialization'); @@ -278,6 +284,29 @@ begin Log.LogBenchmark('Initializing Joystick', 1); end; + // Lua + Log.BenchmarkStart(1); + Party := TPartyGame.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing Party Manager', 1); + + Log.BenchmarkStart(1); + LuaCore.RegisterModule('Log', ULuaLog_Lib_f); + LuaCore.RegisterModule('Gl', ULuaGl_Lib_f); + LuaCore.RegisterModule('TextGl', ULuaTextGl_Lib_f); + LuaCore.RegisterModule('Party', ULuaParty_Lib_f); + LuaCore.RegisterModule('ScreenSing', ULuaScreenSing_Lib_f); + + Log.BenchmarkEnd(1); + Log.LogBenchmark('Initializing LuaCore', 1); + + Log.BenchmarkStart(1); + LuaCore.LoadPlugins; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Lua Plugins', 1); + + LuaCore.DumpPlugins; + Log.BenchmarkEnd(0); Log.LogBenchmark('Loading Time', 0); diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 52eb5a05..94580241 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -34,355 +34,938 @@ interface {$I switches.inc} uses - ModiSDK; + ULua; type - TRoundInfo = record - Plugin: word; - Winner: byte; + { array holds ids of modes or Party_Round_Random + its length defines the number of rounds + it is used as argument for TPartyGame.StartParty } + ARounds = array of integer; + + { element of APartyTeamRanking returned by TPartyGame.GetTeamRanking + and parameter for TPartyGame.SetWinner } + TParty_TeamRanking = record + Team: Integer; //< id of team + Rank: Integer; //< 1 to Length(Teams) e.g. 1 is for placed first end; + AParty_TeamRanking = array of TParty_TeamRanking; //< returned by TPartyGame.GetTeamRanking - TeamOrderEntry = record - TeamNum: byte; - Score: byte; + TParty_RoundList = record + Index: integer; + Name: UTF8String; end; + AParty_ModeList = array of TParty_RoundList; + + { record used by TPartyGame to store round specific data } + TParty_Round = record + Mode: Integer; + AlreadyPlayed: Boolean; //< true if round was already played + Ranking: AParty_TeamRanking; + RankingSet: Boolean; //< true if Self.Ranking is already set + end; + + TParty_ModeInfo = record + Name: String; // name of this mode + Parent: Integer; // Id of owning plugin + + CanNonParty: Boolean; //< is playable when not in party mode + CanParty: Boolean; //< is playable in party mode + + // one bit in the following settings stands for + // a player or team count + // PlayerCount = 2 or 4 indicates that the mode is playable with 2 and 3 players per team + // TeamCount = 1 or 2 or 4 or 8 or 16 or 32 indicates that the mode is playable with 1 to 6 teams + PlayerCount: Integer; //< playable with one, two, three etc. players per team + TeamCount: Integer; //< playable with one, two, three etc. different teams + + + Functions: record // lua functions that will be called at specific events + BeforeSongSelect: String; // default actions are executed if functions = nil + AfterSongSelect: String; + + BeforeSing: String; + OnSing: String; + AfterSing: String; + end; + end; + + { used by TPartyGame to store player specific data } + TParty_PlayerInfo = record + Name: String; //< Playername + TimesPlayed: Integer; //< How often this Player has Sung + end; + + { used by TPartyGame to store team specific data } + TParty_TeamInfo = record + Name: String; //< name of the Team + Score: Word; //< current score + JokersLeft: Integer; //< jokers this team has left - TeamOrderArray = array[0..5] of byte; + NextPlayer: Integer; //Id of the player that plays the next (the current) song - TPartyPlugin = record - ID: byte; - TimesPlayed: byte; + Players: array of TParty_PlayerInfo; end; - TPartySession = class + TPartyGame = class private - function GetRandomPlayer(Team: byte): byte; - function GetRandomPlugin(Plugins: array of TPartyPlugin): byte; - function IsWinner(Player, Winner: byte): boolean; + bPartyGame: boolean; //< are we playing party or standard mode + CurRound: Integer; //< indicates which of the elements of Rounds is played next (at the moment) + + bPartyStarted: Boolean; + + TimesPlayed: array of Integer; //< times every mode was played in current party game (for random mode calculation) + procedure GenScores; + function GetRandomMode: integer; + function GetRandomPlayer(Team: integer): integer; + + { returns true if a mode is playable with current playerconfig } + function ModePlayable(I: integer): boolean; + + function CallLua(Parent: Integer; Func: String):Boolean; + + procedure SetRankingByScore; public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: byte; + //Teams: TTeamInfo; + Rounds: array of TParty_Round; //< holds info which modes are played in this party game (if started) + Teams: array of TParty_TeamInfo; //< holds info of teams playing in current round (private for easy manipulation of lua functions) + + Modes: array of TParty_ModeInfo; //< holds info of registred party modes + + property CurrentRound: Integer read CurRound; constructor Create; - procedure StartNewParty(NumRounds: byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: byte): UTF8String; + { set the attributes of Info to default values } + procedure DefaultModeInfo(var Info: TParty_ModeInfo); + + { registers a new mode, returns true on success + (mode name does not already exist) } + function RegisterMode(Info: TParty_ModeInfo): Boolean; + + { returns true if modes are available for + players and teams that are currently set + up. if there are no teams set up it returns + if there are any party modes available } + function ModesAvailable: Boolean; + + { returns an array with the name of all available modes (that + are playable with current player configuration } + function GetAvailableModes: AParty_ModeList; + + { clears all party specific data previously stored } + procedure Clear; + + { adds a team to the team array, returning its id + can only be called when game is not already started } + function AddTeam(Name: String): Integer; + + { adds a player to the player array, returning its id + can only be called when game is not already started } + function AddPlayer(Team: Integer; Name: String): Integer; + + { starts a new PartyGame, returns true on success + before a call of this function teams and players + has to be added by AddTeam and AddPlayer } + + function StartGame(Rounds: ARounds): Boolean; + + { sets the winner(s) of current round + returns true on success } + function SetRanking(Ranking: AParty_TeamRanking): Boolean; + + { increases round counter by 1 and clears all round specific information; + returns the number of the current round or -1 if last round has already + been played } + function NextRound: integer; + + { indicates that current round has already been played } + procedure RoundPlayed; + + { true if in a Party Game (not in standard mode) } + property PartyGame: Boolean read BPartyGame; + + + { returns true if last round was already played } + function GameFinished: Boolean; + + { call plugins defined function and/or default procedure + only default procedure is called when no function is defined by plugin + if plugins function returns true then default is called after plugins + function was executed} + procedure CallBeforeSongSelect; + procedure CallAfterSongSelect; + procedure CallBeforeSing; + procedure CallOnSing; + procedure CallAfterSing; + + { returns an array[1..6] of TParty_TeamRanking. + the index stands for the placing, + team is the team number (in the team array) + rank is correct rank if some teams have the + same score. + } + function GetTeamRanking: AParty_TeamRanking; + + { returns a string like "Team 1 (and Team 2) win" } + function GetWinnerString(Round: integer): UTF8String; + + destructor Destroy; end; +const + { minimal amount of teams for party mode } + Party_Teams_Min = 2; + + { maximal amount of teams for party mode } + Party_Teams_Max = 3; + + { minimal amount of players for party mode } + Party_Players_Min = 1; + + { maximal amount of players for party mode } + Party_Players_Max = 4; + + { amount of jokers each team gets at the beginning of the game } + Party_Count_Jokers = 5; + + { to indicate that element (mode) should set randomly in ARounds array } + Party_Round_Random = -1; + + { values for TParty_TeamRanking.Rank } + PR_First = 1; + PR_Second = 2; + PR_Third = 3; + + StandardModus = 0; //Modus Id that will be played in non-party mode + var - PartySession: TPartySession; + Party: TPartyGame; implementation uses - UDLLManager, UGraphic, - UNote, ULanguage, - ULog; + ULog, + ULuaCore, + UDisplay, + USong, + UNote, + SysUtils; -constructor TPartySession.Create; +//------------- +// Just the constructor +//------------- +constructor TPartyGame.Create; begin inherited; + + Clear; end; -//---------- -// Returns a number of a random plugin -//---------- -function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte; +destructor TPartyGame.Destroy; +begin + inherited; +end; + +{ clears all party specific data previously stored } +procedure TPartyGame.Clear; + var + I: Integer; +begin + bPartyGame := false; // no party game + CurRound := low(integer); + + bPartyStarted := false; //game not startet + + SetLength(Teams, 0); //remove team info + SetLength(Rounds, 0); //remove round info + + // clear times played + for I := 0 to High(TimesPlayed) do + TimesPlayed[I] := 0; +end; + +{ private: some intelligent randomnes for plugins } +function TPartyGame.GetRandomMode: integer; +var + LowestTP: integer; + NumPwithLTP: integer; + I: integer; + R: integer; +begin + Result := 0; //If there are no matching modes, play first modus + LowestTP := high(Integer); + NumPwithLTP := 0; + + // search for the plugins less played yet + for I := 0 to high(Modes) do + begin + if (ModePlayable(I)) then + begin + if (TimesPlayed[I] < lowestTP) then + begin + lowestTP := TimesPlayed[I]; + NumPwithLTP := 1; + end + else if (TimesPlayed[I] = lowestTP) then + begin + Inc(NumPwithLTP); + end; + end; + end; + + // create random number + R := Random(NumPwithLTP); + + // select the random mode from the modes with less timesplayed + for I := 0 to high(Modes) do + begin + if (TimesPlayed[I] = lowestTP) and (ModePlayable(I)) then + begin + //Plugin found + if (R = 0) then + begin + Result := I; + Inc(TimesPlayed[I]); + Break; + end; + + Dec(R); + end; + end; +end; + +{ private: GetRandomPlayer - returns a random player + that does not play to often ;) } +function TPartyGame.GetRandomPlayer(Team: integer): integer; var - LowestTP: byte; - NumPwithLTP: word; - I: integer; - R: word; + I, R: integer; + lowestTP: Integer; + NumPwithLTP: Integer; begin - LowestTP := high(byte); + LowestTP := high(Integer); NumPwithLTP := 0; + Result := 0; - //Search for Plugins not often played yet - for I := 0 to high(Plugins) do + // search for players that have less played yet + for I := 0 to High(Teams[Team].Players) do begin - if (Plugins[I].TimesPlayed < lowestTP) then + if (Teams[Team].Players[I].TimesPlayed < lowestTP) then begin - lowestTP := Plugins[I].TimesPlayed; + lowestTP := Teams[Team].Players[I].TimesPlayed; NumPwithLTP := 1; end - else if (Plugins[I].TimesPlayed = lowestTP) then + else if (Teams[Team].Players[I].TimesPlayed = lowestTP) then begin Inc(NumPwithLTP); end; end; - //Create random no + // create random number R := Random(NumPwithLTP); - //Search for random plugin - for I := 0 to high(Plugins) do + // search for selected random player + for I := 0 to High(Teams[Team].Players) do begin - if Plugins[I].TimesPlayed = LowestTP then + if Teams[Team].Players[I].TimesPlayed = lowestTP then begin - //Plugin found if (R = 0) then - begin - Result := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); + begin // found selected player + Result := I; Break; end; + Dec(R); end; end; end; //---------- -//StartNewParty - Reset and prepares for new party +//GenScores - inc scores for cur. round //---------- -procedure TPartySession.StartNewParty(NumRounds: byte); +procedure TPartyGame.GenScores; var - Plugins: array of TPartyPlugin; - TeamMode: boolean; - Len: integer; - I, J: integer; + I: Integer; +begin + if (Length(Teams) = 2) then + begin // score generation for 2 teams, winner gets 1 point + for I := 0 to High(Rounds[CurRound].Ranking) do + if (Rounds[CurRound].Ranking[I].Rank = PR_First) then + Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score); + end + else if (Length(Teams) = 3) then + begin // score generation for 3 teams, + // winner gets 3 points 2nd gets 1 point + for I := 0 to High(Rounds[CurRound].Ranking) do + if (Rounds[CurRound].Ranking[I].Rank = PR_First) then + Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score, 3) + else if (Rounds[CurRound].Ranking[I].Rank = PR_Second) then + Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score); + end +end; + +{ set the attributes of Info to default values } +procedure TPartyGame.DefaultModeInfo(var Info: TParty_ModeInfo); begin - //Set current round to 1 - CurRound := 255; + Info.Name := 'undefined'; + Info.Parent := -1; //< not loaded by plugin (e.g. Duell) + Info.CanNonParty := false; + Info.CanParty := false; + Info.PlayerCount := High(Integer); //< no restrictions either on player count + Info.TeamCount := High(Integer); //< nor on team count + Info.Functions.BeforeSongSelect := ''; //< use default functions + Info.Functions.AfterSongSelect := ''; + Info.Functions.BeforeSing := ''; + Info.Functions.OnSing := ''; + Info.Functions.AfterSing := ''; +end; - PlayersPlay := Teams.NumTeams; +{ registers a new mode, returns true on success + (mode name does not already exist) } +function TPartyGame.RegisterMode(Info: TParty_ModeInfo): Boolean; + var + Len: integer; + LowerName: String; + I: integer; +begin + Result := false; - //Get team-mode and set joker, also set TimesPlayed - TeamMode := true; - for I := 0 to Teams.NumTeams - 1 do + if (Info.Name <> 'undefined') then begin - if Teams.Teaminfo[I].NumPlayers < 2 then + // search for a plugin w/ same name + LowerName := lowercase(Info.Name); // case sensitive search + for I := 0 to high(Modes) do + if (LowerName = lowercase(Modes[I].Name)) then + exit; //< no success (name already exist) + + // add new mode to array and append and clear a new TimesPlayed element + Len := Length(Modes); + SetLength(Modes, Len + 1); + SetLength(TimesPlayed, Len + 1); + + Modes[Len] := Info; + TimesPlayed[Len] := 0; + + Result := True; + end; +end; + +{ returns true if a mode is playable with current playerconfig } +function TPartyGame.ModePlayable(I: integer): boolean; + var + J: integer; +begin + if (Length(Teams) = 0) then + Result := true + else + begin + if (Modes[I].TeamCount and (1 shl (Length(Teams) - 1)) <> 0) then begin - TeamMode := false; + Result := true; + + for J := 0 to High(Teams) do + Result := Result and (Modes[I].PlayerCount and (1 shl (Length(Teams[J].Players) - 1)) <> 0); + end + else + Result := false; + end; +end; + +{ returns true if modes are available for + players and teams that are currently set + up. if there are no teams set up it returns + if there are any party modes available } +function TPartyGame.ModesAvailable: Boolean; + var + I: integer; + CountTeams: integer; +begin + CountTeams := Length(Teams); + if CountTeams = 0 then + begin + Result := (Length(Modes) > 0); + end + else + begin + Result := false; + for I := 0 to High(Modes) do + begin + Result := ModePlayable(I); + + if Result then + Exit; end; - //Set player attributes - for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do + end; +end; + +{ returns an array with the name of all available modes (that + are playable with current player configuration } +function TPartyGame.GetAvailableModes: AParty_ModeList; + var + I: integer; + Len: integer; +begin + Len := 0; + SetLength(Result, Len + 1); + Result[Len].Index := Party_Round_Random; + Result[Len].Name := Language.Translate('MODE_RANDOM_NAME'); + + for I := 0 to High(Modes) do + if (ModePlayable(I)) then begin - Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; + Inc(Len); + SetLength(Result, Len + 1); + Result[Len].Index := I; + Result[Len].Name := Language.Translate('MODE_' + Uppercase(Modes[I].Name) + '_NAME'); end; - Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7); - Teams.Teaminfo[I].Score := 0; +end; + +{ adds a team to the team array, returning its id + can only be called when game is not already started } +function TPartyGame.AddTeam(Name: String): Integer; +begin + Result := -1; + if (not bPartyStarted) and (Length(Name) > 0) and (Length(Teams) < Party_Teams_Max) then + begin + Result := Length(Teams); + SetLength(Teams, Result + 1); + + Teams[Result].Name := Name; + Teams[Result].Score := 0; + Teams[Result].JokersLeft := Party_Count_Jokers; + Teams[Result].NextPlayer := -1; end; +end; + +{ adds a player to the player array, returning its id + can only be called when game is not already started } +function TPartyGame.AddPlayer(Team: Integer; Name: String): Integer; +begin + Result := -1; - //Fill plugin array - SetLength(Plugins, 0); - for I := 0 to high(DLLMan.Plugins) do + if (not bPartyStarted) and (Team >= 0) and (Team <= High(Teams)) and (Length(Teams[Team].Players) < Party_Players_Max) and (Length(Name) > 0) then begin - if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then - begin - //Add only those plugins playable with current PlayerConfiguration - Len := Length(Plugins); - SetLength(Plugins, Len + 1); - Plugins[Len].ID := I; - Plugins[Len].TimesPlayed := 0; - end; + // append element to players array + Result := Length(Teams[Team].Players); + SetLength(Teams[Team].Players, Result + 1); + + // fill w/ data + Teams[Team].Players[Result].Name := Name; + Teams[Team].Players[Result].TimesPlayed := 0; end; +end; + +{ starts a new PartyGame, returns true on success + before a call of this function teams and players + has to be added by AddTeam and AddPlayer } +function TPartyGame.StartGame(Rounds: ARounds): Boolean; + var + I: integer; +begin + Result := false; - //Set rounds - if (Length(Plugins) >= 1) then + if (not bPartyStarted) and (Length(Rounds) > 0) and (Length(Teams) >= Party_Teams_Min) then begin - SetLength (Rounds, NumRounds); - for I := 0 to NumRounds - 1 do + // check teams for minimal player count + for I := 0 to High(Teams) do + if (Length(Teams[I].Players) < Party_Players_Min) then + exit; + + // create rounds array + SetLength(Self.Rounds, Length(Rounds)); + + for I := 0 to High(Rounds) do begin - PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins); - PartySession.Rounds[I].Winner := 255; + // copy round or select a random round + if (Rounds[I] <> Party_Round_Random) and (Rounds[I] >= 0) and (Rounds[I] <= High(Modes)) then + Self.Rounds[I].Mode := Rounds[I] + else + Self.Rounds[I].Mode := GetRandomMode; + + Self.Rounds[I].AlreadyPlayed := false; + Self.Rounds[I].RankingSet := false; + + SetLength(Self.Rounds[I].Ranking, 0); end; + + // get the party started!11 + bPartyStarted := true; + bPartyGame := true; + CurRound := low(integer); //< set not to -1 to indicate that party game is not finished + + // first round + NextRound; + + Result := True; + end; +end; + +{ sets the winner(s) of current round + returns true on success } +function TPartyGame.SetRanking(Ranking: AParty_TeamRanking): Boolean; + var + I, J: Integer; + TeamExists: Integer; + Len: Integer; + Temp: TParty_TeamRanking; +begin + if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then + begin + Rounds[CurRound].Ranking := Ranking; + Result := true; + + // look for teams that don't exist + TeamExists := 0; + for I := 0 to High(Rounds[CurRound].Ranking) do + TeamExists := TeamExists or (1 shl (Rounds[CurRound].Ranking[I].Team-1)); + + // create teams that don't exist + Len := Length(Rounds[CurRound].Ranking); + for I := 0 to High(Teams) do + if (TeamExists and (1 shl I) = 0) then + begin + Inc(Len); + SetLength(Rounds[CurRound].Ranking, Len); + Rounds[CurRound].Ranking[Len-1].Team := I + 1; + Rounds[CurRound].Ranking[Len-1].Rank := Length(Teams); + end; + + // we may remove rankings from invalid teams here to + // but at the moment this is not necessary, because the + // functions this function is called from don't create + // invalid rankings + + // bubble sort rankings by team + J := High(Rounds[CurRound].Ranking); + repeat + for I := 0 to J - 1 do + if (Rounds[CurRound].Ranking[I].Team > Rounds[CurRound].Ranking[I+1].Team) then + begin + Temp := Rounds[CurRound].Ranking[I]; + Rounds[CurRound].Ranking[I] := Rounds[CurRound].Ranking[I+1]; + Rounds[CurRound].Ranking[I+1] := Temp; + end; + Dec(J); + until J <= 0; + + //set rounds RankingSet to true + Rounds[CurRound].RankingSet := true; end else - SetLength (Rounds, 0); + Result := false; end; -{** - * Returns a random player to play next round - *} -function TPartySession.GetRandomPlayer(Team: byte): byte; -var - I, R: integer; - LowestTP: byte; - NumPwithLTP: byte; +{ sets ranking of current round by score saved in players array } +procedure TPartyGame.SetRankingByScore; + var + I, J: Integer; + Rank: Integer; + Ranking: AParty_TeamRanking; + Scores: array of Integer; + TmpRanking: TParty_TeamRanking; + TmpScore: Integer; begin - LowestTP := high(byte); - NumPwithLTP := 0; - Result := 0; - - //Search for players that have not often played yet - for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do + if (Length(Player) = Length(Teams)) then begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then + SetLength(Ranking, Length(Teams)); + SetLength(Scores, Length(Teams)); + + // fill ranking array + for I := 0 to High(Ranking) do begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then + Ranking[I].Team := I; + Ranking[I].Rank := 0; + Scores[I] := Player[I].ScoreTotalInt; + end; + + // bubble sort by score + J := High(Ranking); + repeat + for I := 0 to J - 1 do + if (Scores[I] < Scores[I+1]) then + begin + TmpRanking := Ranking[I]; + Ranking[I] := Ranking[I+1]; + Ranking[I+1] := TmpRanking; + + TmpScore := Scores[I]; + Scores[I] := Scores[I+1]; + Scores[I+1] := TmpScore; + end; + Dec(J); + until J <= 0; + + // set rank field + Rank := 1; //first rank has id 1 + for I := 0 to High(Ranking) do begin - Inc(NumPwithLTP); + Ranking[I].Rank := Rank; + + if (I < High(Ranking)) and (Scores[I] <> Scores[I+1]) then + Inc(Rank); // next rank if next team has different score end; + end + else + SetLength(Ranking, 0); + + SetRanking(Ranking); +end; + +{ increases round counter by 1 and clears all round specific information; + returns the number of the current round or -1 if last round has already + been played } +function TPartyGame.NextRound: integer; + var I: Integer; +begin + // some lines concerning the previous round + if (CurRound >= 0) then + begin + Rounds[CurRound].AlreadyPlayed := true; + + GenScores; end; - //Create random number - R := Random(NumPwithLTP); + // increase round counter + Inc(CurRound); + if (CurRound < -1) then // we start first round + CurRound := 0; - //Search for random player - for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do + if (CurRound > High(Rounds)) then + CurRound := -1; //< last round played + + Result := CurRound; + + // some lines concerning the next round + if (CurRound >= 0) then begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then - begin - //Player found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); - end; + // select player + for I := 0 to High(Teams) do + Teams[I].NextPlayer := GetRandomPlayer(I); end; end; -{** - * Prepares ScreenSingModi for next round and loads plugin - *} -procedure TPartySession.StartRound; -var - I: integer; +{ indicates that current round has already been played } +procedure TPartyGame.RoundPlayed; begin - if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then + if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then begin - // Increase Current Round but not beyond its limit - // CurRound is set to 255 to begin with! - // Ugly solution if you ask me. - if CurRound < high(CurRound) then - Inc(CurRound) - else - CurRound := 0; + // set rounds ranking by score if it was not set by plugin + if (not Rounds[CurRound].RankingSet) then + SetRankingByScore; + + Rounds[CurRound].AlreadyPlayed := True; + end; +end; + +{ returns true if last round was already played } +function TPartyGame.GameFinished: Boolean; +begin + Result := (bPartyStarted and (CurRound = -1)); +end; - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); +{ private: calls the specified function Func from lua plugin Parent + if both exist. + return true if default function should be called + (function or plugin does not exist, or function returns + true) } +function TPartyGame.CallLua(Parent: Integer; Func: String):Boolean; + var + P: TLuaPlugin; +begin + // call default function by default + Result := true; - //Select Players - for I := 0 to Teams.NumTeams - 1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); + // check for core plugin and empty function name + if (Parent >= 0) and (Length(Func) > 0) then + begin + // get plugin that registred the mode + P := LuaCore.GetPluginById(Parent); - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; + if (P <> nil) then + begin + if (P.CallFunctionByName(Func, 0, 1)) then + // check result + Result := (lua_toboolean(P.LuaState, 1)); + end; end; end; -//---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray -//---------- -procedure TPartySession.EndRound; -var - I: Integer; +{ call plugins defined function and/or default procedure + only default procedure is called when no function is defined by plugin + if plugins function returns true then default is called after plugins + function was executed} +procedure TPartyGame.CallBeforeSongSelect; begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; + if (CurRound >= 0) then + begin + // we set screen song to party mode + // plugin should not have to do this if it + // don't want default procedure to be executed + ScreenSong.Mode := smPartyMode; + + with Modes[Rounds[CurRound].Mode] do + if (CallLua(Parent, Functions.BeforeSongSelect)) then + begin // execute default function: + // display song select screen + Display.FadeTo(@ScreenSong); + end; + end; +end; - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); +procedure TPartyGame.CallAfterSongSelect; +begin + if (CurRound >= 0) then + begin + with Modes[Rounds[CurRound].Mode] do + if (CallLua(Parent, Functions.AfterSongSelect)) then + begin // execute default function: + // display sing screen + ScreenSong.StartSong; + end; + end; end; -//---------- -//IsWinner - returns true if the player's bit is set in the winner byte -//---------- -function TPartySession.IsWinner(Player, Winner: byte): boolean; -var - Mask: byte; +procedure TPartyGame.CallBeforeSing; begin - Mask := 1 shl Player; - Result := (Winner and Mask) <> 0; + if (CurRound >= 0) then + begin + with Modes[Rounds[CurRound].Mode] do + if (CallLua(Parent, Functions.BeforeSing)) then + begin // execute default function: + + //nothing atm + { to-do : compartmentalize TSingScreen.OnShow into + functions for init of a specific part of + sing screen. + these functions should be called here before + sing screen is shown, or it should be called + by plugin if it wants to define a custom + singscreen start up. } + + //set correct playersplay + if (bPartyGame) then + PlayersPlay := Length(Teams); + end; + end; end; -//---------- -//GenScores - increase scores for current round -//---------- -procedure TPartySession.GenScores; -var - I: byte; +procedure TPartyGame.CallOnSing; begin - for I := 0 to Teams.NumTeams - 1 do + if (CurRound >= 0) then begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); + with Modes[Rounds[CurRound].Mode] do + if (CallLua(Parent, Functions.OnSing)) then + begin // execute default function: + + //nothing atm + end; end; end; -//---------- -//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...] -//---------- -function TPartySession.GetTeamOrder: TeamOrderArray; -var - I, J: integer; - ATeams: array [0..5] of TeamOrderEntry; - TempTeam: TeamOrderEntry; +procedure TPartyGame.CallAfterSing; begin - // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place - //Fill Team array - for I := 0 to Teams.NumTeams - 1 do + if (CurRound >= 0) then + begin + with Modes[Rounds[CurRound].Mode] do + if (CallLua(Parent, Functions.AfterSing)) then + begin // execute default function: + + if (bPartyGame) then + // display party score screen + Display.FadeTo(@ScreenPartyScore) + else //display standard score screen + Display.FadeTo(@ScreenScore); + end; + end; +end; + +{ returns an array[1..6] of integer. the index stands for the placing, + value is the team number (in the team array) } +function TPartyGame.GetTeamRanking: AParty_TeamRanking; + var + I, J: Integer; + Temp: TParty_TeamRanking; + Rank: Integer; +begin + SetLength(Result, Length(Teams)); + + // fill ranking array + for I := 0 to High(Result) do begin - ATeams[I].Teamnum := I; - ATeams[I].Score := Teams.Teaminfo[I].Score; + Result[I].Team := I; + Result[I].Rank := 0; end; - //Sort teams - for J := 0 to Teams.NumTeams - 1 do - for I := 1 to Teams.NumTeams - 1 do - if ATeams[I].Score > ATeams[I-1].Score then + // bubble sort by score + J := High(Result); + repeat + for I := 0 to J - 1 do + if (Teams[Result[I].Team].Score < Teams[Result[I+1].Team].Score) then begin - TempTeam := ATeams[I-1]; - ATeams[I-1] := ATeams[I]; - ATeams[I] := TempTeam; + Temp := Result[I]; + Result[I] := Result[I+1]; + Result[I+1] := Temp; end; + Dec(J); + until J <= 0; - //Copy to Result - for I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; + // set rank field + Rank := 1; //first rank has id 1 + for I := 0 to High(Result) do + begin + Result[I].Rank := Rank; + + if (I < High(Result)) and (Teams[Result[I].Team].Score <> Teams[Result[I+1].Team].Score) then + Inc(Rank); // next rank if next team has different score + end; end; -//---------- -//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or , -//---------- -function TPartySession.GetWinnerString(Round: byte): UTF8String; +{ returns a string like "Team 1 (and Team 2) win" + if Round is in range from 0 to high(Rounds) then + result is name of winners of specified round. + if Round is -1 the result is name of winners of + the whole party game} +function TPartyGame.GetWinnerString(Round: integer): UTF8String; var Winners: array of UTF8String; - I: integer; + I: integer; + Ranking: AParty_TeamRanking; begin - Result := Language.Translate('PARTY_NOBODY'); + Result := ''; + Ranking := nil; - if (Round > High(Rounds)) then - exit; - - if (Rounds[Round].Winner = 0) then + if (Round >= 0) and (Round <= High(Rounds)) then begin - exit; - end; + if (not Rounds[Round].AlreadyPlayed) then + Result := Language.Translate('PARTY_NOTPLAYEDYET') + else + Ranking := Rounds[Round].Ranking; + end + else if (Round = -1) then + Ranking := GetTeamRanking; - if (Rounds[Round].Winner = 255) then - begin - Result := Language.Translate('PARTY_NOTPLAYEDYET'); - exit; - end; - SetLength(Winners, 0); - for I := 0 to Teams.NumTeams - 1 do + if (Ranking <> nil) then begin - if isWinner(I, Rounds[Round].Winner) then + SetLength(Winners, 0); + for I := 0 to High(Ranking) do begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; + if (Ranking[I].Rank = PR_First) and (Ranking[I].Team >= 0) and (Ranking[I].Team <= High(Teams)) then + begin + SetLength(Winners, Length(Winners) + 1); + Winners[high(Winners)] := UTF8String(Teams[Ranking[I].Team].Name); + end; end; + + if (Length(Winners) > 0) then + Result := Language.Implode(Winners); end; - Result := Language.Implode(Winners); + + if (Length(Result) = 0) then + Result := Language.Translate('PARTY_NOBODY'); end; end. diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index f280900e..6fdfaeb6 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -129,7 +129,7 @@ type //----------- TSingScores = class private - Positions: aScorePosition; + aPositions: aScorePosition; aPlayers: aScorePlayer; oPositionCount: byte; oPlayerCount: byte; @@ -187,6 +187,7 @@ type property PositionCount: byte read oPositionCount; property PlayerCount: byte read oPlayerCount; property Players: aScorePlayer read aPlayers; + property Positions: aScorePosition read aPositions; // constructor just sets some standard settings constructor Create; @@ -286,7 +287,7 @@ procedure TSingScores.AddPosition(const pPosition: PScorePosition); begin if (PositionCount < MaxPositions) then begin - Positions[PositionCount] := pPosition^; + aPositions[PositionCount] := pPosition^; Inc(oPositionCount); end; end; @@ -606,7 +607,7 @@ var for I := 0 to PositionCount - 1 do begin - if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then + if ((aPositions[I].PlayerCount and bPlayerCount) <> 0) then Inc(Result); end; end; @@ -620,7 +621,7 @@ var for I := 0 to PositionCount - 1 do begin - if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then + if ((aPositions[I].PlayerCount and bPlayerCount) <> 0) then begin if (bPlayer = 0) then begin @@ -806,13 +807,13 @@ begin Progress := TimeDiff / Settings.Phase1Time; - W := Positions[PIndex].PUW * Sin(Progress/2*Pi); - H := Positions[PIndex].PUH * Sin(Progress/2*Pi); + W := aPositions[PIndex].PUW * Sin(Progress/2*Pi); + H := aPositions[PIndex].PUH * Sin(Progress/2*Pi); - X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; - Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; + X := aPositions[PIndex].PUStartX + (aPositions[PIndex].PUW - W)/2; + Y := aPositions[PIndex].PUStartY + (aPositions[PIndex].PUH - H)/2; - FontSize := Round(Progress * Positions[PIndex].PUFontSize); + FontSize := Round(Progress * aPositions[PIndex].PUFontSize); FontOffset := (H - FontSize) / 2; Alpha := 1; end @@ -822,20 +823,20 @@ begin // phase 2 - the moving Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; + W := aPositions[PIndex].PUW; + H := aPositions[PIndex].PUH; - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX; if PosDiff > 0 then PosDiff := PosDiff + W; - X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); + X := aPositions[PIndex].PUStartX + PosDiff * sqr(Progress); - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY; if PosDiff < 0 then - PosDiff := PosDiff + Positions[PIndex].BGH; - Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); + PosDiff := PosDiff + aPositions[PIndex].BGH; + Y := aPositions[PIndex].PUStartY + PosDiff * sqr(Progress); - FontSize := Positions[PIndex].PUFontSize; + FontSize := aPositions[PIndex].PUFontSize; FontOffset := (H - FontSize) / 2; Alpha := 1 - 0.3 * Progress; end @@ -868,24 +869,24 @@ begin // set positions etc. Alpha := 0.7 - 0.7 * Progress; - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; + W := aPositions[PIndex].PUW; + H := aPositions[PIndex].PUH; - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; + PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX; if (PosDiff > 0) then PosDiff := W else PosDiff := 0; - X := Positions[PIndex].PUTargetX + PosDiff * Progress; + X := aPositions[PIndex].PUTargetX + PosDiff * Progress; - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; + PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY; if (PosDiff < 0) then - PosDiff := -Positions[PIndex].BGH + PosDiff := -aPositions[PIndex].BGH else PosDiff := 0; - Y := Positions[PIndex].PUTargetY - PosDiff * (1 - Progress); + Y := aPositions[PIndex].PUTargetY - PosDiff * (1 - Progress); - FontSize := Positions[PIndex].PUFontSize; + FontSize := aPositions[PIndex].PUFontSize; FontOffset := (H - FontSize) / 2; end else @@ -922,7 +923,7 @@ begin glDisable(GL_BLEND); // set font style and size - SetFontStyle(Positions[PIndex].PUFont); + SetFontStyle(aPositions[PIndex].PUFont); SetFontItalic(false); SetFontSize(FontSize); SetFontReflection(false, 0); @@ -958,7 +959,7 @@ begin // only draw if player is on cur screen if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1)) and Players[Index].Visible then begin - Position := @Positions[Players[Index].Position and 127]; + Position := @aPositions[Players[Index].Position and 127]; // draw scorebg glEnable(GL_TEXTURE_2D); @@ -1010,7 +1011,7 @@ begin Players[index].RBVisible and Players[index].Visible) then begin - Position := @Positions[Players[Index].Position and 127]; + Position := @aPositions[Players[Index].Position and 127]; if (Enabled and Players[Index].Enabled) then begin diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 4322815e..2ecaa9f4 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -648,17 +648,17 @@ type SelectLevel: TThemeSelectSlide; SelectPlayList: TThemeSelectSlide; SelectPlayList2: TThemeSelectSlide; - SelectRounds: TThemeSelectSlide; - SelectTeams: TThemeSelectSlide; - SelectPlayers1: TThemeSelectSlide; - SelectPlayers2: TThemeSelectSlide; - SelectPlayers3: TThemeSelectSlide; {ButtonNext: TThemeButton; ButtonPrev: TThemeButton;} end; TThemePartyPlayer = class(TThemeBasic) + SelectTeams: TThemeSelectSlide; + SelectPlayers1: TThemeSelectSlide; + SelectPlayers2: TThemeSelectSlide; + SelectPlayers3: TThemeSelectSlide; + Team1Name: TThemeButton; Player1Name: TThemeButton; Player2Name: TThemeButton; @@ -681,6 +681,11 @@ type ButtonPrev: TThemeButton;} end; + TThemePartyRounds = class(TThemeBasic) + SelectRoundCount: TThemeSelectSlide; + SelectRound: array [0..6] of TThemeSelectSlide; + end; + //Stats Screens TThemeStatMain = class(TThemeBasic) ButtonScores: TThemeButton; @@ -756,6 +761,7 @@ type PartyWin: TThemePartyWin; PartyOptions: TThemePartyOptions; PartyPlayer: TThemePartyPlayer; + PartyRounds: TThemePartyRounds; //Stats Screens: StatMain: TThemeStatMain; @@ -886,6 +892,7 @@ begin PartyScore := TThemePartyScore.Create; PartyOptions := TThemePartyOptions.Create; PartyPlayer := TThemePartyPlayer.Create; + PartyRounds := TThemePartyRounds.Create; //Stats Screens: StatMain := TThemeStatMain.Create; @@ -1435,17 +1442,17 @@ begin ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel'); ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList'); ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2'); - ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds'); - ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3'); - {ThemeLoadButton (ButtonNext, 'ButtonNext'); ThemeLoadButton (ButtonPrev, 'ButtonPrev');} //Party Player ThemeLoadBasic(PartyPlayer, 'PartyPlayer'); + + ThemeLoadSelectSlide(PartyPlayer.SelectTeams, 'PartyPlayerSelectTeams'); + ThemeLoadSelectSlide(PartyPlayer.SelectPlayers1, 'PartyPlayerSelectPlayers1'); + ThemeLoadSelectSlide(PartyPlayer.SelectPlayers2, 'PartyPlayerSelectPlayers2'); + ThemeLoadSelectSlide(PartyPlayer.SelectPlayers3, 'PartyPlayerSelectPlayers3'); + ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name'); ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name'); ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name'); @@ -1464,6 +1471,13 @@ begin ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name'); ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name'); + // Party Rounds + ThemeLoadBasic(PartyRounds, 'PartyRounds'); + + ThemeLoadSelectSlide(PartyRounds.SelectRoundCount, 'PartyRoundsSelectRoundCount'); + for I := 0 to High(PartyRounds.SelectRound) do + ThemeLoadSelectSlide(PartyRounds.SelectRound[I], 'PartyRoundsSelectRound' + IntToStr(I + 1)); + {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} -- cgit v1.2.3 From f29685523465fb0d2d0d6bbe9985cf11207cde23 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 12 Jan 2010 19:55:25 +0000 Subject: deleted leftovers from old plugin system and party mode git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2080 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDLLManager.pas | 293 ----------------------------------------------- src/base/UDraw.pas | 256 ----------------------------------------- src/base/UGraphic.pas | 1 - src/base/UMain.pas | 1 - src/base/UNote.pas | 1 - 5 files changed, 552 deletions(-) delete mode 100644 src/base/UDLLManager.pas (limited to 'src/base') diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas deleted file mode 100644 index d5bb1480..00000000 --- a/src/base/UDLLManager.pas +++ /dev/null @@ -1,293 +0,0 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UDLLManager; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - ModiSDK, - UFiles, - UPath, - UFilesystem; - -type - TDLLMan = class - private - hLib: THandle; - P_Init: fModi_Init; - P_Draw: fModi_Draw; - P_Finish: fModi_Finish; - P_RData: pModi_RData; - public - Plugins: array of TPluginInfo; - PluginPaths: array of IPath; - Selected: ^TPluginInfo; - - constructor Create; - - procedure GetPluginList; - procedure ClearPluginInfo(No: cardinal); - function LoadPluginInfo(const Filename: IPath; No: cardinal): boolean; - - function LoadPlugin(No: cardinal): boolean; - procedure UnLoadPlugin; - - function PluginInit (const TeamInfo: TTeamInfo; - var Playerinfo: TPlayerinfo; - const Sentences: TSentences; - const LoadTex: fModi_LoadTex; - const Print: fModi_Print; - LoadSound: fModi_LoadSound; - PlaySound: pModi_PlaySound) - : boolean; - function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean; - function PluginFinish (var Playerinfo: TPlayerinfo): byte; - procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: dword; user: dword); - end; - -var - DLLMan: TDLLMan; - -const -{$IF Defined(MSWINDOWS)} - DLLExt = '.dll'; -{$ELSEIF Defined(DARWIN)} - DLLExt = '.dylib'; -{$ELSEIF Defined(UNIX)} - DLLExt = '.so'; -{$IFEND} - -implementation - -uses - {$IFDEF MSWINDOWS} - windows, - {$ELSE} - dynlibs, - {$ENDIF} - UPathUtils, - ULog, - SysUtils; - - -constructor TDLLMan.Create; -begin - inherited; - SetLength(Plugins, 0); - SetLength(PluginPaths, Length(Plugins)); - GetPluginList; -end; - -procedure TDLLMan.GetPluginList; -var - Iter: IFileIterator; - FileInfo: TFileInfo; -begin - Iter := FileSystem.FileFind(PluginPath.Append('*' + DLLExt), 0); - while (Iter.HasNext) do - begin - SetLength(Plugins, Length(Plugins)+1); - SetLength(PluginPaths, Length(Plugins)); - - FileInfo := Iter.Next; - - if LoadPluginInfo(FileInfo.Name, High(Plugins)) then // loaded succesful - begin - PluginPaths[High(PluginPaths)] := FileInfo.Name; - end - else // error loading - begin - SetLength(Plugins, Length(Plugins)-1); - SetLength(PluginPaths, Length(Plugins)); - end; - end; -end; - -procedure TDLLMan.ClearPluginInfo(No: cardinal); -begin -// set to party modi plugin - Plugins[No].Typ := 8; - - Plugins[No].Name := 'unknown'; - Plugins[No].NumPlayers := 0; - - Plugins[No].Creator := 'Nobody'; - Plugins[No].PluginDesc := 'NO_PLUGIN_DESC'; - - Plugins[No].LoadSong := true; - Plugins[No].ShowScore := true; - Plugins[No].ShowBars := true; - Plugins[No].ShowNotes := true; - Plugins[No].LoadVideo := true; - Plugins[No].LoadBack := true; - - Plugins[No].TeamModeOnly := true; - Plugins[No].GetSoundData := true; - Plugins[No].Dummy := true; - - - Plugins[No].BGShowFull := true; - Plugins[No].BGShowFull_O := true; - - Plugins[No].ShowRateBar := true; - Plugins[No].ShowRateBar_O := true; - - Plugins[No].EnLineBonus := true; - Plugins[No].EnLineBonus_O := true; -end; - -function TDLLMan.LoadPluginInfo(const Filename: IPath; No: cardinal): boolean; -var - hLibg: THandle; - Info: pModi_PluginInfo; -// I: integer; -begin - Result := true; -// clear plugin info - ClearPluginInfo(No); - -{ -// workaround plugins loaded 2 times - for i := low(pluginpaths) to high(pluginpaths) do - if (pluginpaths[i] = filename) then - exit; -} - -// load libary - hLibg := LoadLibrary(PChar(PluginPath.Append(Filename).ToNative)); -// if loaded - if (hLibg <> 0) then - begin -// load info procedure - @Info := GetProcAddress(hLibg, PChar('PluginInfo')); - -// if loaded - if (@Info <> nil) then - begin -// load plugininfo - Info(Plugins[No]); - Result := true; - end - else - Log.LogError('Could not load plugin "' + Filename.ToNative + '": Info procedure not found'); - - FreeLibrary (hLibg); - end - else - Log.LogError('Could not load plugin "' + Filename.ToNative + '": Libary not loaded'); -end; - -function TDLLMan.LoadPlugin(No: cardinal): boolean; -begin - Result := true; -// load libary - hLib := LoadLibrary(PChar(PluginPath.Append(PluginPaths[No]).ToNative)); -// if loaded - if (hLib <> 0) then - begin -// load info procedure - @P_Init := GetProcAddress (hLib, 'Init'); - @P_Draw := GetProcAddress (hLib, 'Draw'); - @P_Finish := GetProcAddress (hLib, 'Finish'); - -// if loaded - if (@P_Init <> nil) and (@P_Draw <> nil) and (@P_Finish <> nil) then - begin - Selected := @Plugins[No]; - Result := true; - end - else - begin - Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Procedures not found'); - end; - end - else - Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": Libary not loaded'); -end; - -procedure TDLLMan.UnLoadPlugin; -begin - if (hLib <> 0) then - FreeLibrary (hLib); - -// Selected := nil; - @P_Init := nil; - @P_Draw := nil; - @P_Finish := nil; - @P_RData := nil; -end; - -function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; - var Playerinfo: TPlayerinfo; - const Sentences: TSentences; - const LoadTex: fModi_LoadTex; - const Print: fModi_Print; - LoadSound: fModi_LoadSound; - PlaySound: pModi_PlaySound) - : boolean; -var - Methods: TMethodRec; -begin - Methods.LoadTex := LoadTex; - Methods.Print := Print; - Methods.LoadSound := LoadSound; - Methods.PlaySound := PlaySound; - - if (@P_Init <> nil) then - Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods) - else - Result := true -end; - -function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean; -begin - if (@P_Draw <> nil) then - Result := P_Draw (PlayerInfo, CurSentence) - else - Result := true -end; - -function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte; -begin - if (@P_Finish <> nil) then - Result := P_Finish (PlayerInfo) - else - Result := 0; -end; - -procedure TDLLMan.PluginRData (handle: HStream; buffer: Pointer; len: dword; user: dword); -begin -if (@P_RData <> nil) then - P_RData (handle, buffer, len, user); -end; - -end. diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 47863f62..ada0bdb6 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -35,11 +35,9 @@ interface uses UThemes, - ModiSDK, UGraphicClasses; procedure SingDraw; -procedure SingModiDraw (PlayerInfo: TPlayerInfo); procedure SingDrawBackground; procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); @@ -86,7 +84,6 @@ uses Math, gl, TextGL, - UDLLManager, UDrawTexture, UGraphic, UIni, @@ -904,259 +901,6 @@ begin glDisable(GL_TEXTURE_2D); end; -// q'n'd for using the game mode dll's -procedure SingModiDraw (PlayerInfo: TPlayerInfo); -var - NR: TRecR; -begin - // positions - if Ini.SingWindow = 0 then - begin - NR.Left := 120; - end - else - begin - NR.Left := 20; - end; - - NR.Right := 780; - NR.Width := NR.Right - NR.Left; - NR.WMid := NR.Width / 2; - NR.Mid := NR.Left + NR.WMid; - - // time bar - SingDrawTimeBar(); - - if DLLMan.Selected.ShowNotes then - begin - if PlayersPlay = 1 then - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); - if (PlayersPlay = 2) or (PlayersPlay = 4) then - begin - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); - end; - - if (PlayersPlay = 3) or (PlayersPlay = 6) then - begin - SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); - end; - end; - - // Draw Lyrics - //ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat); - // TODO: Lyrics helper - - // oscilloscope | the thing that moves when you yell into your mic (imho) - if (((Ini.Oscilloscope = 1) and (DLLMan.Selected.ShowRateBar_O)) and (not DLLMan.Selected.ShowRateBar)) then - begin - if PlayersPlay = 1 then - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - - if PlayersPlay = 2 then - begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - - if PlayersPlay = 4 then - begin - if ScreenAct = 1 then - begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - if ScreenAct = 2 then - begin - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); - end; - end; - - if PlayersPlay = 3 then - begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - - if PlayersPlay = 6 then - begin - if ScreenAct = 1 then - begin - if PlayerInfo.Playerinfo[0].Enabled then - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - if PlayerInfo.Playerinfo[1].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - if PlayerInfo.Playerinfo[2].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - if ScreenAct = 2 then - begin - if PlayerInfo.Playerinfo[3].Enabled then - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); - if PlayerInfo.Playerinfo[4].Enabled then - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); - if PlayerInfo.Playerinfo[5].Enabled then - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); - end; - end; - - end; - -// resize the notes according to the difficulty level - case Ini.Difficulty of - 0: - begin - NotesH := 11; // 9 - NotesW := 6; // 5 - end; - 1: - begin - NotesH := 8; // 7 - NotesW := 4; // 4 - end; - 2: - begin - NotesH := 5; - NotesW := 3; - end; - end; - - if (DLLMAn.Selected.ShowNotes and DLLMan.Selected.LoadSong) then - begin - if (PlayersPlay = 1) and PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); - end; - - if PlayersPlay = 2 then - begin - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); - end; - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); - end; - - end; - - if PlayersPlay = 3 then - begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if PlayerInfo.Playerinfo[0].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); - end; - - if PlayerInfo.Playerinfo[1].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); - end; - - if PlayerInfo.Playerinfo[2].Enabled then - begin - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); - end; - end; - - if PlayersPlay = 4 then - begin - if ScreenAct = 1 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); - end; - - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); - - if ScreenAct = 1 then - begin - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); - end; - end; - - if PlayersPlay = 6 then - begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if ScreenAct = 1 then - begin - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); - end; - - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); - - if ScreenAct = 1 then - begin - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); - end; - end; - end; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - {//SingBar Mod procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer); var diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index f658c800..784e5493 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -71,7 +71,6 @@ uses UScreenSongMenu, UScreenSongJumpto, {Party Screens} - UScreenSingModi, UScreenPartyNewRound, UScreenPartyScore, UScreenPartyOptions, diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 7b082c57..aefbf9f0 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -74,7 +74,6 @@ uses UCovers, UDataBase, UDisplay, - UDLLManager, UGraphic, UGraphicClasses, UIni, diff --git a/src/base/UNote.pas b/src/base/UNote.pas index 8e5b709a..6eb99df9 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -123,7 +123,6 @@ uses UCatCovers, UDataBase, UPlaylist, - UDLLManager, UParty, UConfig, UCommon, -- cgit v1.2.3 From e336be02c875f0889fc91896a878ff52fea29aca Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 12 Jan 2010 19:58:31 +0000 Subject: forgotten updates from last commit again git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2082 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 1 - src/base/UMain.pas | 7 ------- 2 files changed, 8 deletions(-) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index ada0bdb6..308526b8 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -93,7 +93,6 @@ uses UMusic, URecord, UScreenSing, - UScreenSingModi, UTexture; procedure SingDrawBackground; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index aefbf9f0..126d8ac8 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -232,13 +232,6 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Songs', 1); - // PluginManager - Log.BenchmarkStart(1); - Log.LogStatus('PluginManager', 'Initialization'); - DLLMan := TDLLMan.Create; // Load PluginList - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PluginManager', 1); - // Graphics Log.BenchmarkStart(1); Log.LogStatus('Initialize 3D', 'Initialization'); -- cgit v1.2.3 From c8af7cb20362428d566d41d8bbe3091b40e7346a Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jan 2010 19:15:54 +0000 Subject: fix execution of default behaviour for party hooks (caused e.g. song never ending bug) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2093 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 133 ++++++++++++++++++++++++++++++++++------------------ 1 file changed, 87 insertions(+), 46 deletions(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 94580241..2f89afd6 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -797,8 +797,12 @@ end; if plugins function returns true then default is called after plugins function was executed} procedure TPartyGame.CallBeforeSongSelect; + var + ExecuteDefault: boolean; begin - if (CurRound >= 0) then + if not bPartyStarted then + ExecuteDefault := true + else if (CurRound >= 0) then begin // we set screen song to party mode // plugin should not have to do this if it @@ -806,79 +810,116 @@ begin ScreenSong.Mode := smPartyMode; with Modes[Rounds[CurRound].Mode] do - if (CallLua(Parent, Functions.BeforeSongSelect)) then - begin // execute default function: - // display song select screen - Display.FadeTo(@ScreenSong); - end; + ExecuteDefault := (CallLua(Parent, Functions.BeforeSongSelect)); + end + else + ExecuteDefault := true; + + // execute default function: + if ExecuteDefault then + begin + // display song select screen + Display.FadeTo(@ScreenSong); end; end; -procedure TPartyGame.CallAfterSongSelect; +procedure TPartyGame.CallAfterSongSelect; + var + ExecuteDefault: boolean; begin - if (CurRound >= 0) then + if not bPartyStarted then + ExecuteDefault := true + else if (CurRound >= 0) then begin with Modes[Rounds[CurRound].Mode] do - if (CallLua(Parent, Functions.AfterSongSelect)) then - begin // execute default function: + ExecuteDefault := (CallLua(Parent, Functions.AfterSongSelect)); + end + else + ExecuteDefault := true; - // display sing screen - ScreenSong.StartSong; - end; + // execute default function: + if ExecuteDefault then + begin + // display sing screen + ScreenSong.StartSong; end; end; -procedure TPartyGame.CallBeforeSing; +procedure TPartyGame.CallBeforeSing; + var + ExecuteDefault: boolean; begin - if (CurRound >= 0) then + if not bPartyStarted then + ExecuteDefault := true + else if (CurRound >= 0) then begin with Modes[Rounds[CurRound].Mode] do - if (CallLua(Parent, Functions.BeforeSing)) then - begin // execute default function: - - //nothing atm - { to-do : compartmentalize TSingScreen.OnShow into - functions for init of a specific part of - sing screen. - these functions should be called here before - sing screen is shown, or it should be called - by plugin if it wants to define a custom - singscreen start up. } - - //set correct playersplay - if (bPartyGame) then - PlayersPlay := Length(Teams); - end; + ExecuteDefault := (CallLua(Parent, Functions.BeforeSing)); + end + else + ExecuteDefault := true; + + // execute default function: + if ExecuteDefault then + begin + //nothing atm + { to-do : compartmentalize TSingScreen.OnShow into + functions for init of a specific part of + sing screen. + these functions should be called here before + sing screen is shown, or it should be called + by plugin if it wants to define a custom + singscreen start up. } + + //set correct playersplay + if (bPartyGame) then + PlayersPlay := Length(Teams); end; end; procedure TPartyGame.CallOnSing; + var + ExecuteDefault: boolean; begin - if (CurRound >= 0) then + if not bPartyStarted then + ExecuteDefault := true + else if (CurRound >= 0) then begin with Modes[Rounds[CurRound].Mode] do - if (CallLua(Parent, Functions.OnSing)) then - begin // execute default function: + ExecuteDefault := (CallLua(Parent, Functions.OnSing));; + end + else + ExecuteDefault := true; - //nothing atm - end; + // execute default function: + if ExecuteDefault then + begin + //nothing atm end; end; procedure TPartyGame.CallAfterSing; + var + ExecuteDefault: boolean; begin - if (CurRound >= 0) then + if not bPartyStarted then + ExecuteDefault := true + else if (CurRound >= 0) then begin with Modes[Rounds[CurRound].Mode] do - if (CallLua(Parent, Functions.AfterSing)) then - begin // execute default function: - - if (bPartyGame) then - // display party score screen - Display.FadeTo(@ScreenPartyScore) - else //display standard score screen - Display.FadeTo(@ScreenScore); - end; + ExecuteDefault := (CallLua(Parent, Functions.AfterSing)); + end + else + ExecuteDefault := true; + + // execute default function: + if ExecuteDefault then + begin + if (bPartyGame) then + // display party score screen + Display.FadeTo(@ScreenPartyScore) + else //display standard score screen + Display.FadeTo(@ScreenScore); end; end; -- cgit v1.2.3 From 4788a676e9275e9e6da128ad3a070a80311bd012 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jan 2010 19:43:36 +0000 Subject: use APPDATA\ultrastardx to store config files on windows a portable installation (old behaviour; all config files stored in the directory of the executable) is also available detection works as follows: if a config.ini file is detected in the executable dir -> portable installation otherwise -> new behaviour only tested on Windows XP, please test on Vista and Seven. It should work there as well. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2094 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformWindows.pas | 43 +++++++++++++++++++++++++++++++++++++++++-- 1 file changed, 41 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index a0372dad..102ae67a 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -44,8 +44,12 @@ uses type TPlatformWindows = class(TPlatform) private + UseLocalDirs: boolean; + function GetSpecialPath(CSIDL: integer): IPath; + procedure DetectLocalExecution(); public + procedure Init; override; function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; function GetLogPath: IPath; override; @@ -61,6 +65,12 @@ uses Windows, UConfig; +procedure TPlatformWindows.Init; +begin + inherited Init(); + DetectLocalExecution(); +end; + //------------------------------ //Start more than One Time Prevention //------------------------------ @@ -109,6 +119,33 @@ begin Result := PATH_NONE; end; +{** + * Detects whether the game was executed locally or globally. + * - It is local if a config.ini exists in the directory of the + * executable. In config files like config.ini or score db + * reside in the directory of the executable. This is useful + * to enable windows users to have a portable installation + * e.g. on an external hdd. This is also the default behaviour + * of usdx prior to version 1.1 + * - It is global if no config.ini exists in the directory of the + * executable the config files are in a separate folder + * (e.g. APPDATA\ultrastardx) + * On windows resources (themes, language-files) + * reside in the directory of the executable in every case + * + * Sets UseLocalDirs to true if the game is executed locally, false otherwise. + *} +procedure TPlatformWindows.DetectLocalExecution(); +var + LocalDir, ConfigIni: IPath; +begin + // we just check if the 'languages' folder exists in the + // directory of the executable. If so -> local execution. + LocalDir := GetExecutionDir(); + ConfigIni := LocalDir.Append('config.ini'); + UseLocalDirs := (ConfigIni.IsFile and ConfigIni.Exists); +end; + function TPlatformWindows.GetLogPath: IPath; begin Result := GetExecutionDir(); @@ -121,8 +158,10 @@ end; function TPlatformWindows.GetGameUserPath: IPath; begin - //Result := GetSpecialPath(CSIDL_APPDATA).Append('UltraStarDX', pdAppend); - Result := GetExecutionDir(); + if UseLocalDirs then + Result := GetExecutionDir() + else + Result := GetSpecialPath(CSIDL_APPDATA).Append('ultrastardx', pdAppend); end; end. -- cgit v1.2.3 From e1235ca003a31dd2edb6c2957dd8670508b261ba Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jan 2010 19:49:22 +0000 Subject: removed some old commented stuff git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2095 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 14 -------------- 1 file changed, 14 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 126d8ac8..777784b7 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -302,20 +302,6 @@ begin Log.BenchmarkEnd(0); Log.LogBenchmark('Loading Time', 0); - Log.LogStatus('Creating Core', 'Initialization'); -{ - Core := TCore.Create( - USDXShortVersionStr, - MakeVersion(USDX_VERSION_MAJOR, - USDX_VERSION_MINOR, - USDX_VERSION_RELEASE, - chr(0)) - ); -} - - Log.LogStatus('Running Core', 'Initialization'); - //Core.Run; - //------------------------------ // Start Mainloop //------------------------------ -- cgit v1.2.3 From 8a5aebdd230d32c453292f480be693b08028e619 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 25 Jan 2010 20:50:39 +0000 Subject: fix software cursor w/ screens = 2 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2096 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 777784b7..f05470c1 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -435,7 +435,7 @@ begin end; end; - Display.MoveCursor(Event.button.X * 800 / Screen.w, + Display.MoveCursor(Event.button.X * 800 * Screens / Screen.w, Event.button.Y * 600 / Screen.h); if not Assigned(Display.NextScreen) then -- cgit v1.2.3 From ca4174bf978fc74150b6b619bbb68ae3d53e4f2c Mon Sep 17 00:00:00 2001 From: canni0 Date: Tue, 26 Jan 2010 02:03:18 +0000 Subject: - added windows version check in addition to commit #2094 Behaviour changes as follows: Use local path (old behaviour) if ... - ... config.ini is detected -> use local path (old behaviour) Use global path (%APPDATA%/ultrastardx) if ... - ... no config.ini is present (allows portable installations) - ... user is running Vista or later git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2097 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformWindows.pas | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index 102ae67a..cf69a359 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -129,7 +129,7 @@ end; * of usdx prior to version 1.1 * - It is global if no config.ini exists in the directory of the * executable the config files are in a separate folder - * (e.g. APPDATA\ultrastardx) + * (e.g. %APPDATA%\ultrastardx) * On windows resources (themes, language-files) * reside in the directory of the executable in every case * @@ -138,12 +138,15 @@ end; procedure TPlatformWindows.DetectLocalExecution(); var LocalDir, ConfigIni: IPath; + OSVerInfo: TOSVersionInfo; begin - // we just check if the 'languages' folder exists in the - // directory of the executable. If so -> local execution. + // we just check if 'config.ini' exists in the + // directory of the executable or if windows version + // is less than Windows Vista (major version = 6). + // If so -> local execution. LocalDir := GetExecutionDir(); ConfigIni := LocalDir.Append('config.ini'); - UseLocalDirs := (ConfigIni.IsFile and ConfigIni.Exists); + UseLocalDirs := ((ConfigIni.IsFile and ConfigIni.Exists) and (OSVerInfo.dwMajorVersion < 6)); end; function TPlatformWindows.GetLogPath: IPath; -- cgit v1.2.3 From 6452b6942e423943fcd8b4a7acc6d1d06f2461a3 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sat, 6 Feb 2010 23:35:42 +0000 Subject: a small optimization. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2099 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 12 +++++++----- 1 file changed, 7 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 191e74d2..b97b2890 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1127,7 +1127,7 @@ var ModelMatrix, ProjMatrix: T16dArray; WinCoords: array[0..2, 0..2] of GLdouble; ViewPortArray: TViewPortArray; - Dist, Dist2: double; + Dist, Dist2, DistSum: double; WidthScale, HeightScale: double; const // width/height of square used for determining the scale @@ -1169,9 +1169,10 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[1][1]); WidthScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + DistSum := Dist*Dist + Dist2*Dist2 + if DistSum > 0) then begin - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + WidthScale := cTestSize / Sqrt(DistSum); end; // projected height ||(x1, y1) - (x1, y2)|| @@ -1179,9 +1180,10 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[2][1]); HeightScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then + DistSum := Dist*Dist + Dist2*Dist2 + if DistSum > 0) then begin - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); + HeightScale := cTestSize / Sqrt(DistSum); end; //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); -- cgit v1.2.3 From 7745d3787c6ab93a1f54eaeb3475f76ac64735fd Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 7 Feb 2010 00:13:44 +0000 Subject: typo git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2100 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index b97b2890..473ac23c 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1169,7 +1169,7 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[1][1]); WidthScale := 1; - DistSum := Dist*Dist + Dist2*Dist2 + DistSum := Dist*Dist + Dist2*Dist2; if DistSum > 0) then begin WidthScale := cTestSize / Sqrt(DistSum); @@ -1180,7 +1180,7 @@ begin Dist2 := (WinCoords[0][1] - WinCoords[2][1]); HeightScale := 1; - DistSum := Dist*Dist + Dist2*Dist2 + DistSum := Dist*Dist + Dist2*Dist2; if DistSum > 0) then begin HeightScale := cTestSize / Sqrt(DistSum); -- cgit v1.2.3 From 5c101e3a76ea5809ae5b6986f2ad5317f95f19d1 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Sun, 7 Feb 2010 00:15:18 +0000 Subject: Aller guten Dinge sind 3 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2101 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 473ac23c..03918e3b 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -1170,7 +1170,7 @@ begin WidthScale := 1; DistSum := Dist*Dist + Dist2*Dist2; - if DistSum > 0) then + if (DistSum > 0) then begin WidthScale := cTestSize / Sqrt(DistSum); end; @@ -1181,7 +1181,7 @@ begin HeightScale := 1; DistSum := Dist*Dist + Dist2*Dist2; - if DistSum > 0) then + if (DistSum > 0) then begin HeightScale := cTestSize / Sqrt(DistSum); end; -- cgit v1.2.3 From c710a7b0d52b408b865e82eb55480146cbbbaed7 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 22 Feb 2010 15:59:35 +0000 Subject: completly remove unused UScreenWelcome git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2138 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 4 ---- 1 file changed, 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 784e5493..45befc46 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -45,7 +45,6 @@ uses UImage, UMusic, UScreenLoading, - UScreenWelcome, UScreenMain, UScreenName, UScreenLevel, @@ -107,7 +106,6 @@ var ScreenX: integer; ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; ScreenMain: TScreenMain; ScreenName: TScreenName; ScreenLevel: TScreenLevel; @@ -704,8 +702,6 @@ begin 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; -- cgit v1.2.3 From e90a0510b951c4e08d94d7ca4643eec6add3437c Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Mon, 22 Feb 2010 16:22:28 +0000 Subject: some changes to fps limiter, dependency to old UTime stuff removed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2139 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 11 +++++++---- 1 file changed, 7 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index f05470c1..473a78a9 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -41,6 +41,7 @@ uses var Done: boolean; Restart: boolean; + TicksBeforeFrame: Cardinal; procedure Main; procedure MainLoop; @@ -337,6 +338,7 @@ end; procedure MainLoop; var Delay: integer; + TicksCurrent: Cardinal; const MAX_FPS = 100; begin @@ -345,6 +347,8 @@ begin CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. while not Done do begin + TicksBeforeFrame := SDL_GetTicks; + // joypad if (Ini.Joypad = 1) or (Params.Joypad) then Joy.Update; @@ -356,10 +360,9 @@ begin Done := not Display.Draw; SwapBuffers; - // delay - CountMidTime; - - Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); + // FPS limiter + TicksCurrent := SDL_GetTicks; + Delay := 1000 div MAX_FPS - (TicksCurrent - TicksBeforeFrame); if Delay >= 1 then SDL_Delay(Delay); // dynamic, maximum is 100 fps -- cgit v1.2.3 From 04661aa013280e8be87162e710aab74817316df7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 22 Feb 2010 17:35:46 +0000 Subject: changing variables to more local usage git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2141 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 41 +++++++++++++++++++++-------------------- 1 file changed, 21 insertions(+), 20 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 473a78a9..84501b6e 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -39,13 +39,11 @@ uses SDL; var - Done: boolean; Restart: boolean; - TicksBeforeFrame: Cardinal; procedure Main; procedure MainLoop; -procedure CheckEvents; +function CheckEvents: boolean; type TMainThreadExecProc = procedure(Data: Pointer); @@ -336,16 +334,18 @@ begin end; procedure MainLoop; -var - Delay: integer; - TicksCurrent: Cardinal; const MAX_FPS = 100; +var + Delay: integer; + TicksCurrent: cardinal; + TicksBeforeFrame: cardinal; + Continue: boolean; begin SDL_EnableKeyRepeat(125, 125); CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - while not Done do + while Continue do begin TicksBeforeFrame := SDL_GetTicks; @@ -354,10 +354,10 @@ begin Joy.Update; // keyboard events - CheckEvents; + Continue := CheckEvents; // display - Done := not Display.Draw; + Continue := Display.Draw; SwapBuffers; // FPS limiter @@ -394,12 +394,13 @@ begin end; end; -procedure CheckEvents; +function CheckEvents: boolean; var Event: TSDL_event; mouseDown: boolean; mouseBtn: integer; begin + Result := true; while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -444,17 +445,17 @@ begin if not Assigned(Display.NextScreen) then begin //drop input when changing screens if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Result := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - done := not ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Result := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Result := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else begin - done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); + Result := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); // if screen wants to exit - if done then + if not Result then DoQuit; end; end; @@ -528,18 +529,18 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Result := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Result := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Result := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin // check if screen wants to exit - Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); + Result := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit - if Done then + if not Result then DoQuit; end; -- cgit v1.2.3 From 39c1614799d186b9de9c0925d247c678b1d18a39 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Mon, 22 Feb 2010 17:45:25 +0000 Subject: cleanup of code, which has never been used from start. Part 2. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2143 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 11 ----------- 1 file changed, 11 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 84501b6e..0de8ddeb 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -35,12 +35,8 @@ interface uses SysUtils, - SDL; -var - Restart: boolean; - procedure Main; procedure MainLoop; function CheckEvents: boolean; @@ -369,13 +365,6 @@ begin CountSkipTime; - // reinitialization of graphics - if Restart then - begin - Reinitialize3D; - Restart := false; - end; - end; end; -- cgit v1.2.3 From 62f4a5bc497a05431df9b324c3d5f4a1656a4ea4 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 12 Mar 2010 20:54:19 +0000 Subject: fix bug report ID: 2969613. Thanks to Mike greywind git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2191 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 11 ++++++----- 1 file changed, 6 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 2c2093a0..a3f665e5 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -753,11 +753,12 @@ var // search devices with same description for i := 0 to deviceIndex-1 do begin - if (AudioInputProcessor.DeviceList[i].Name = name) then - begin - Result := true; - Break; - end; + if (AudioInputProcessor.DeviceList[i] <> nil) then + if (AudioInputProcessor.DeviceList[i].Name = name) then + begin + Result := true; + Break; + end; end; end; -- cgit v1.2.3 From c64660c6be281ca1c5b7a2d21ce551dfcf6afbb1 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 14 Mar 2010 20:38:07 +0000 Subject: added more screen resolution options, changed default texture size to 256 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2198 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 26 +++++++++++++++++--------- 1 file changed, 17 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 998d19fb..1ba47251 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -817,17 +817,25 @@ begin else if (Modes = PPSDL_Rect(-1)) then begin // Fallback to some standard resolutions - SetLength(IResolution, 10); + SetLength(IResolution, 18); IResolution[0] := '640x480'; IResolution[1] := '800x600'; IResolution[2] := '1024x768'; - IResolution[3] := '1152x864'; - IResolution[4] := '1280x800'; - IResolution[5] := '1280x960'; - IResolution[6] := '1400x1050'; - IResolution[7] := '1440x900'; - IResolution[8] := '1600x1200'; - IResolution[9] := '1680x1050'; + IResolution[3] := '1152x666';; + IResolution[4] := '1152x864'; + IResolution[5] := '1280x800'; + IResolution[6] := '1280x960'; + IResolution[7] := '1280x1024'; + IResolution[8] := '1366x768'; + IResolution[9] := '1400x1050'; + IResolution[10] := '1440x900'; + IResolution[11] := '1600x900'; + IResolution[12] := '1600x1200'; + IResolution[13] := '1680x1050'; + IResolution[14] := '1920x1080'; + IResolution[15] := '1920x1200'; + IResolution[16] := '2048x1152'; + IResolution[17] := '2560x1600'; Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); if Resolution = -1 then @@ -931,7 +939,7 @@ begin LoadScreenModes(IniFile); // TextureSize - TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1])); + TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[2])); // SingWindow SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); -- cgit v1.2.3 From 578b9415aa600bdd5323784570edc0a96c605eb5 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 14 Mar 2010 20:56:20 +0000 Subject: fixed cover loading/showing when using tabs=on; deleted unused argument in SelectNext and SelectPrev git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2199 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlaylist.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas index 527eca7b..f12e06cf 100644 --- a/src/base/UPlaylist.pas +++ b/src/base/UPlaylist.pas @@ -317,7 +317,7 @@ begin //Fix SongSelection ScreenSong.Interaction := 0; - ScreenSong.SelectNext(true); + ScreenSong.SelectNext; ScreenSong.FixSelected; //Play correct Music -- cgit v1.2.3 From 517d37a95f797204758f54607969a56761b4a0db Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 18 Mar 2010 17:56:04 +0000 Subject: some changes to "Select Slides" - read ShowArrows and OneItemOnly from theme - use constants for arrows alpha value - fix arrows if select has only one possible option - draw colorized selects like colorized buttons (2nd "deselect" texture) => a uniform look for option menus is possible again option screens that need some theme editing: sound, lyrics, themes, record, advanced git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2205 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 2ecaa9f4..582f34e8 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -1822,6 +1822,9 @@ begin ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); + + ThemeSelectS.showArrows := (ThemeIni.ReadInteger(Name, 'ShowArrows', 0) = 1); + ThemeSelectS.oneItemOnly := (ThemeIni.ReadInteger(Name, 'OneItemOnly', 0) = 1); end; procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string); -- cgit v1.2.3 From 9bcf10e01e4bb3b60b295c7173d7e7ce1eb5ed74 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 19 Mar 2010 22:14:57 +0000 Subject: Do not copy the folder Mac OS with the binaries. Not needed. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2210 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 1dc0014a..fda49a45 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -205,7 +205,9 @@ begin CurPath := FileInfo.Name; if CurPath.IsDirectory() then begin - if (not CurPath.Equals('.')) and (not CurPath.Equals('..')) then + if (not CurPath.Equals('.')) and + (not CurPath.Equals('..')) and + (not CurPath.Equals('MacOS')) then DirectoryList.Add(RelativePath.Append(CurPath)); end else -- cgit v1.2.3 From 429409de6a59388f26b4857851751b1017eba0ca Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 19 Mar 2010 22:21:51 +0000 Subject: lowercase log folder name and soure cosmetics. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2211 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index fda49a45..d55e8bea 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -121,23 +121,23 @@ type {** * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Log. + * $HOME/Library/Application Support/UltraStarDeluxe/log. *} - function GetLogPath : IPath; override; + function GetLogPath: IPath; override; {** * GetGameSharedPath returns the path for shared resources. Currently it * is set to /Library/Application Support/UltraStarDeluxe. * However it is not used. *} - function GetGameSharedPath : IPath; override; + function GetGameSharedPath: IPath; override; {** * GetGameUserPath returns the path for user resources. Currently it is * set to $HOME/Library/Application Support/UltraStarDeluxe. * This is where a user can add songs, themes, .... *} - function GetGameUserPath : IPath; override; + function GetGameUserPath: IPath; override; end; implementation @@ -159,9 +159,9 @@ var // OldBaseDir contains the path to the folder, where the search started. // It is used to return to it, when the search is completed in all folders. OldBaseDir: IPath; - Iter: IFileIterator; - FileInfo: TFileInfo; - CurPath: IPath; + Iter: IFileIterator; + FileInfo: TFileInfo; + CurPath: IPath; // These two lists contain all folder and file names found // within the folder @link(BaseDir). DirectoryList, FileList: IInterfaceList; @@ -174,7 +174,7 @@ var CreatedDirectory: boolean; FileAttrs: integer; DirectoryPath: IPath; - UserPath: IPath; + UserPath: IPath; SrcFile, TgtFile: IPath; begin // Get the current folder and save it in OldBaseDir for returning to it, when @@ -265,7 +265,7 @@ end; function TPlatformMacOSX.GetLogPath: IPath; begin - Result := GetApplicationSupportPath.Append('Logs'); + Result := GetApplicationSupportPath.Append('logs'); end; function TPlatformMacOSX.GetGameSharedPath: IPath; -- cgit v1.2.3 From 69d6fc57ff2cf57a3f8fe67e82ff8f900436c873 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Tue, 6 Apr 2010 16:29:29 +0000 Subject: change of version check and comments upgrade. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2217 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformWindows.pas | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index cf69a359..30bad264 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -121,32 +121,31 @@ end; {** * Detects whether the game was executed locally or globally. - * - It is local if a config.ini exists in the directory of the - * executable. In config files like config.ini or score db + * - It is local if config.ini exists in the directory of the + * executable. Config files like config.ini or score db * reside in the directory of the executable. This is useful * to enable windows users to have a portable installation * e.g. on an external hdd. This is also the default behaviour * of usdx prior to version 1.1 * - It is global if no config.ini exists in the directory of the - * executable the config files are in a separate folder + * executable. The config files are in a separate folder * (e.g. %APPDATA%\ultrastardx) - * On windows resources (themes, language-files) - * reside in the directory of the executable in every case + * On windows, resources (themes, language-files) + * reside in the directory of the executable in any case * * Sets UseLocalDirs to true if the game is executed locally, false otherwise. *} procedure TPlatformWindows.DetectLocalExecution(); var LocalDir, ConfigIni: IPath; - OSVerInfo: TOSVersionInfo; begin // we just check if 'config.ini' exists in the - // directory of the executable or if windows version + // directory of the executable or if the windows version // is less than Windows Vista (major version = 6). // If so -> local execution. LocalDir := GetExecutionDir(); ConfigIni := LocalDir.Append('config.ini'); - UseLocalDirs := ((ConfigIni.IsFile and ConfigIni.Exists) and (OSVerInfo.dwMajorVersion < 6)); + UseLocalDirs := (ConfigIni.IsFile and ConfigIni.Exists and (Win32MajorVersion < 6)); end; function TPlatformWindows.GetLogPath: IPath; -- cgit v1.2.3 From 94f7a113b7a8faba16ef04beb115c6aeaebe77b9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 6 Apr 2010 18:59:19 +0000 Subject: Fix for Windows7/64bit/Delphi2006 (and maybe others): - Problem: Videos with filenames that contain special characters (like German umlauts) could not be found - Solution: The correct Path() variant could not be resolved as there were only two overloaded variants (AnsiString/RawByteString and WideString). If a PChar was passed, erroneously Path(WideString) was called which caused a garbage result. - Please test if videos with special chars work now (especially on linux and mac) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2218 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPath.pas | 2832 ++++++++++++++++++++++++++-------------------------- 1 file changed, 1419 insertions(+), 1413 deletions(-) (limited to 'src/base') diff --git a/src/base/UPath.pas b/src/base/UPath.pas index 03bd82eb..79045486 100644 --- a/src/base/UPath.pas +++ b/src/base/UPath.pas @@ -1,1413 +1,1419 @@ -{* UltraStar Deluxe - Karaoke Game - * - * UltraStar Deluxe is the legal property of its developers, whose names - * are too numerous to list here. Please refer to the COPYRIGHT - * file distributed with this source distribution. - * - * This program is free software; you can redistribute it and/or - * modify it under the terms of the GNU General Public License - * as published by the Free Software Foundation; either version 2 - * of the License, or (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program; see the file COPYING. If not, write to - * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, - * Boston, MA 02110-1301, USA. - * - * $URL$ - * $Id$ - *} - -unit UPath; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -interface - -uses - SysUtils, - Classes, - IniFiles, - {$IFDEF MSWINDOWS} - TntClasses, - {$ENDIF} - UConfig, - UUnicodeUtils; - -type - IPath = interface; - - {** - * TUnicodeMemoryStream - *} - TUnicodeMemoryStream = class(TMemoryStream) - public - procedure LoadFromFile(const FileName: IPath); - procedure SaveToFile(const FileName: IPath); - end; - - {** - * Unicode capable IniFile implementation. - * TMemIniFile and TIniFile are not able to handle INI-files with - * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists - * and removes it from the internal string-list. - * UTF8Encoded is set accordingly. - *} - TUnicodeMemIniFile = class(TMemIniFile) - private - FFilename: IPath; - FUTF8Encoded: boolean; - public - constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce; - procedure UpdateFile; override; - property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded; - end; - - {** - * TBinaryFileStream (inherited from THandleStream) - *} - {$IFDEF MSWINDOWS} - TBinaryFileStream = class(TTntFileStream) - {$ELSE} - TBinaryFileStream = class(TFileStream) - {$ENDIF} - public - {** - * @seealso TFileStream.Create for valid Mode parameters - *} - constructor Create(const FileName: IPath; Mode: word); - end; - - {** - * TTextFileStream - *} - TTextFileStream = class(TStream) - protected - fLineBreak: RawByteString; - fFilename: IPath; - fMode: word; - - function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract; - public - constructor Create(Filename: IPath; Mode: word); - - function ReadString(): RawByteString; virtual; abstract; - function ReadLine(var Line: UTF8String): boolean; overload; - function ReadLine(var Line: AnsiString): boolean; overload; - - procedure WriteString(const Str: RawByteString); virtual; - procedure WriteLine(const Line: RawByteString); virtual; - - property LineBreak: RawByteString read fLineBreak write fLineBreak; - property Filename: IPath read fFilename; - end; - - {** - * TMemTextStream - *} - TMemTextFileStream = class(TTextFileStream) - private - fStream: TMemoryStream; - protected - function GetSize: int64; override; - - {** - * Copies fStream.Memory from StartPos to EndPos-1 to the result string; - *} - function CopyMemString(StartPos: int64; EndPos: int64): RawByteString; - public - constructor Create(Filename: IPath; Mode: word); - destructor Destroy(); override; - - function Read(var Buffer; Count: longint): longint; override; - function Write(const Buffer; Count: longint): longint; override; - function Seek(Offset: longint; Origin: word): longint; override; - function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override; - - function ReadLine(var Success: boolean): RawByteString; override; - function ReadString(): RawByteString; override; - end; - - {** - TUnicodeIniStream = class() - end; - *} - - {** - * pdKeep: Keep path as is, neither remove or append a delimiter - * pdAppend: Append a delimiter if path does not have a trailing one - * pdRemove: Remove a trailing delimiter from the path - *} - TPathDelimOption = (pdKeep, pdAppend, pdRemove); - - IPathDynArray = array of IPath; - - {** - * An IPath represents a filename, a directory or a filesystem path in general. - * It hides some of the operating system's specifics like path delimiters - * and encodings and provides an easy to use interface to handle them. - * Internally all paths are stored with the same path delimiter (PathDelim) - * and encoding (UTF-8). The transformation is already done AT THE CREATION of - * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between - * Unix and Windows style paths. - * - * Create new paths with one of the Path() functions. - * If you need a string representation use IPath.ToNative/ToUTF8/ToWide. - * Note that due to the path-delimiter and encoding transformation the string - * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'. - * - * It is recommended to use an IPath as long as possible without a string - * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI - * only on Windows. If you would use for example FileExists(MyPath.ToNative) - * it would not find a file which contains characters that are not in the - * current locale. Same applies to AssignFile(), TFileStream.Create() and - * everything else in the RTL that expects a filename. - * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions - * if the filename parameter is not of a UTF8String or WideString type. - * - * If you need to open a file use TBinaryStream or TFileStream instead. Many - * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods - * can be workaround. - * - * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot - * even pass a stream instead of a filename be aware that even if you know that - * a filename is ASCII only, subdirectories in an absolute path might contain - * some non-ASCII characters (for example the user's name) and hence might - * fail (if the characters are not in the current locale). - * It is rare but it happens. - * - * IMPORTANT: - * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems. - * Cwstring functions (WideUpperCase, ...) cannot be used by external threads - * as FPC uses Thread-Local-Storage for the implementation. As a result do not - * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads). - *} - IPath = interface - ['{686BF103-CE43-4598-B85D-A2C3AF950897}'] - {** - * Returns the path as an UTF8 encoded string. - * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) - * is used. If it is set to false the (more) portable '/' delimiter will used. - *} - function ToUTF8(UseNativeDelim: boolean = true): UTF8String; - - {** - * Returns the path as an UTF-16 encoded string. - * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) - * is used. If it is set to false the delimiter will be '/'. - *} - function ToWide(UseNativeDelim: boolean = true): WideString; - - {** - * Returns the path with the system's native encoding and path delimiter. - * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible) - * Mac: UTF8 - * Unix: UTF8 or ANSI according to LC_CTYPE - *} - function ToNative(): RawByteString; - - {** - * Note: File must be closed with FileClose(Handle) after usage - * @seealso SysUtils.FileOpen() - *} - function Open(Mode: longword): THandle; - - {** @seealso SysUtils.ExtractFileDrive() *} - function GetDrive(): IPath; - - {** @seealso SysUtils.ExtractFilePath() *} - function GetPath(): IPath; - - {** @seealso SysUtils.ExtractFileDir() *} - function GetDir(): IPath; - - {** @seealso SysUtils.ExtractFileName() *} - function GetName(): IPath; - - {** @seealso SysUtils.ExtractFileExtension() *} - function GetExtension(): IPath; - - {** - * Returns a copy of the path with the extension changed to Extension. - * The file itself is not changed, use Rename() for this task. - * @seealso SysUtils.ChangeFileExt() - *} - function SetExtension(const Extension: IPath): IPath; overload; - function SetExtension(const Extension: RawByteString): IPath; overload; - function SetExtension(const Extension: WideString): IPath; overload; - - {** - * Returns the representation of the path relative to Basename. - * Note that the basename must be terminated with a path delimiter - * otherwise the last path component will be ignored. - * @seealso SysUtils.ExtractRelativePath() - *} - function GetRelativePath(const BaseName: IPath): IPath; - - {** @seealso SysUtils.ExpandFileName() *} - function GetAbsolutePath(): IPath; - - {** - * Returns the concatenation of this path with Child. If this path does not - * end with a path delimiter one is inserted in front of the Child path. - * Example: Path('parent').Append(Path('child')) -> Path('parent/child') - *} - function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload; - function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; - function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; - - {** - * Splits the path into its components. Path delimiters are not removed from - * components. - * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir'] - *} - function SplitDirs(): IPathDynArray; - - {** - * Returns the parent directory or PATH_NONE if none exists. - *} - function GetParent(): IPath; - - {** - * Checks if this path is a subdir of or file inside Parent. - * If Direct is true this path must be a direct child. - * Example: C:\test\file is a direct child of C:\test and a child of C:\ - *} - function IsChildOf(const Parent: IPath; Direct: boolean): boolean; - - {** - * Adjusts the case of the path on case senstitive filesystems. - * If the path does not exist or the filesystem is case insensitive - * the original path will be returned. Otherwise a corrected copy. - *} - function AdjustCase(AdjustAllLevels: boolean): IPath; - - {** @seealso SysUtils.IncludeTrailingPathDelimiter() *} - function AppendPathDelim(): IPath; - - {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *} - function RemovePathDelim(): IPath; - - function Exists(): boolean; - function IsFile(): boolean; - function IsDirectory(): boolean; - function IsAbsolute(): boolean; - function GetFileAge(): integer; overload; - function GetFileAge(out FileDateTime: TDateTime): boolean; overload; - function GetAttr(): cardinal; - function SetAttr(Attr: Integer): boolean; - function IsReadOnly(): boolean; - function SetReadOnly(ReadOnly: boolean): boolean; - - {** - * Checks if this path points to nothing, that means the path consists of - * the empty string '' and hence equals PATH_NONE. - * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE). - * If IsUnset() returns true this path and PATH_NONE are equal but they must - * not be identical as the references might point to different objects. - * - * Example: - * Path('').Equals(PATH_EMPTY) -> true - * Path('') = PATH_EMPTY -> false - *} - function IsUnset(): boolean; - function IsSet(): boolean; - - {** - * Compares this path with Other and returns true if both paths are - * equal. Both paths are expanded and trailing slashes excluded before - * comparison. If IgnoreCase is true, the case will be ignored on - * case-sensitive filesystems. - *} - function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload; - function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload; - function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload; - - {** - * Searches for a file in DirList. The Result is nil if the file was - * not found. Use IFileSystem.FileFind() instead if you want to use - * wildcards. - * @seealso SysUtils.FileSearch() - *} - function FileSearch(const DirList: IPath): IPath; - - {** File must be closed with FileClose(Handle) after usage } - function CreateFile(): THandle; - function DeleteFile(): boolean; - function CreateDirectory(Force: boolean = false): boolean; - function DeleteEmptyDir(): boolean; - function Rename(const NewName: IPath): boolean; - function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; - - // TODO: Dirwatch stuff - // AddFileChangeListener(Listener: TFileChangeListener); - - {** - * Internal string representation. For debugging only. - *} - function GetIntern: UTF8String; - property Intern: UTF8String READ GetIntern; - end; - -{** - * Creates a new path with the given pathname. PathName can be either in UTF8 - * or the local encoding. - * Notes: - * - On Apple only UTF8 is supported - * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems) - *} -function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; - -{** - * Creates a new path with the given UTF-16 pathname. - *} -function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; - -{** - * Returns a singleton for Path(''). - *} -function PATH_NONE(): IPath; - -implementation - -uses - RTLConsts, - UTextEncoding, - UFilesystem; - -{* - * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work - * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019). - * - * There are two (probably more) scenarios causes a program to crash: - * - * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will - * internally create a temporary variable to hold the result of Path('fail'). - * This temporary var is then passed as Self to GetParent(). Unfortunately FPC - * does already decrement the ref-count of the temporary var at the end of the - * call to Path('fail') and the ref-count drops to zero and the temp object - * is destroyed as FPC erroneously assumes that the temp is not used anymore. - * As a result the Self variable in GetParent() will be invalid, the same - * applies to TPathImpl.fName which reference count dropped to zero when the - * temp was destroyed. Hence GetParent() will likely crash. - * If it does not, ToUTF8() will either return some random string - * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash. - * Either way the result of ToUTF8() is messed up. - * This scenario applies whenever a function (or method) is called that returns - * an interfaced object (e.g. an IPath) and the result is used without storing - * a reference to it in a (temporary) variable first. - * - * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8(); - * - * will not crash but is very impractical and error-prone. Note that Tmp2 cannot - * be replaced with Tmp (see scenario 2). - * - * 2. Another situation this bug will ruin our lives is when a variable to an - * interfaced object is used at the left and right side of an assignment as in: - * MyPath := MyPath.GetParent() - * - * Although the bug is already fixed in the FPC development version 2.3.1 - * it will take quite some time till the next FPC release (> 2.2.4) in which - * this issue is fixed. - * - * To workaround this bug we use some very simple and stupid kind of garbage - * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList) - * to artificially increase the ref-count of the newly created object. - * This keeps the object alive when FPC's temporary variable comes to the end - * of its lifetime and the object's ref-count is decremented - * (and is now 1 instead of 0). - * Later on, the object is either garbage or referenced by another variable. - * - * Look at - * MyPath := Path('SomeDir/SubDir').GetParent() - * - * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore. - * (2) The result of GetParent() is referenced by MyPath - * Object (1) has a reference count of 1 (as it is only referenced by the - * GarbageList). Object (2) is referenced twice (MyPath + GarbageList). - * When the reference to (2) is finally stored in MyPath we can safely remove - * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of - * (2) will be decremented to 1. - * - * As we do not know when it is safe to remove an object from the GarbageList - * we assume that there are max. GarbageMaxCount IPath elements created until - * the execution of the expression is performed and a reference to the resulting - * object is assigned to a variable so all temps can be safely deleted. - * - * Worst-case scenarios are recursive calls or calls with large call stacks with - * functions that return an IPath. Also keep in mind that multiple threads might - * be executing such functions at the same time. - * A reasonable count might be a max. of 20.000 elements. With an average length - * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath - * this will consume ~1.2MB. - *} -{$IFDEF FPC} -{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4 - {$DEFINE HAVE_REFCNTBUG} -{$IFEND} -{$ENDIF} - -{$IFDEF HAVE_REFCNTBUG} -const - // when GarbageList.Count reaches GarbageMaxCount the oldest references in - // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount. - GarbageMaxCount = 20000; - GarbageAfterCleanCount = GarbageMaxCount-1000; - -var - GarbageList: IInterfaceList; -{$ENDIF} - -type - TPathImpl = class(TInterfacedObject, IPath) - private - fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim - - {** - * Unifies the filename. Path-delimiters are replaced by '/'. - *} - procedure Unify(DelimOption: TPathDelimOption); - - {** - * Returns a copy of fName with path delimiters changed to '/'. - *} - function GetPortableString(): UTF8String; - - procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF} - - public - constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption); - destructor Destroy(); override; - - function ToUTF8(UseNativeDelim: boolean): UTF8String; - function ToWide(UseNativeDelim: boolean): WideString; - function ToNative(): RawByteString; - - function Open(Mode: longword): THandle; - - function GetDrive(): IPath; - function GetPath(): IPath; - function GetDir(): IPath; - function GetName(): IPath; - function GetExtension(): IPath; - - function SetExtension(const Extension: IPath): IPath; overload; - function SetExtension(const Extension: RawByteString): IPath; overload; - function SetExtension(const Extension: WideString): IPath; overload; - - function GetRelativePath(const BaseName: IPath): IPath; - function GetAbsolutePath(): IPath; - function GetParent(): IPath; - function SplitDirs(): IPathDynArray; - - function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload; - function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload; - function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload; - - function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload; - function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload; - function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload; - - function IsChildOf(const Parent: IPath; Direct: boolean): boolean; - - function AdjustCase(AdjustAllLevels: boolean): IPath; - - function AppendPathDelim(): IPath; - function RemovePathDelim(): IPath; - - function GetFileAge(): integer; overload; - function GetFileAge(out FileDateTime: TDateTime): boolean; overload; - function Exists(): boolean; - function IsFile(): boolean; - function IsDirectory(): boolean; - function IsAbsolute(): boolean; - function GetAttr(): cardinal; - function SetAttr(Attr: Integer): boolean; - function IsReadOnly(): boolean; - function SetReadOnly(ReadOnly: boolean): boolean; - - function IsUnset(): boolean; - function IsSet(): boolean; - - function FileSearch(const DirList: IPath): IPath; - - function CreateFile(): THandle; - function DeleteFile(): boolean; - function CreateDirectory(Force: boolean): boolean; - function DeleteEmptyDir(): boolean; - function Rename(const NewName: IPath): boolean; - function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; - - function GetIntern(): UTF8String; - end; - -function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath; -begin - if (IsUTF8String(PathName)) then - Result := TPathImpl.Create(PathName, DelimOption) - else if (IsNativeUTF8()) then - Result := PATH_NONE - else - Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption); -end; - -function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath; -begin - Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption); -end; - - - -procedure TPathImpl.AssertRefCount; -begin - {$IFDEF HAVE_REFCNTBUG} - if (FRefCount <= 0) then - raise Exception.Create('RefCount error: ' + IntToStr(FRefCount)); - {$ENDIF} -end; - -constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption); -begin - inherited Create(); - fName := Name; - Unify(DelimOption); - {$IFDEF HAVE_REFCNTBUG} - GarbageList.Lock; - if (GarbageList.Count >= GarbageMaxCount) then - begin - while (GarbageList.Count > GarbageAfterCleanCount) do - GarbageList.Delete(0); - end; - GarbageList.Add(Self); - GarbageList.Unlock; - {$ENDIF} -end; - -destructor TPathImpl.Destroy(); -begin - inherited; -end; - -procedure TPathImpl.Unify(DelimOption: TPathDelimOption); -var - I: integer; -begin - // convert all path delimiters to native ones - for I := 1 to Length(fName) do - begin - if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then - fName[I] := PathDelim; - end; - - // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter - case DelimOption of - pdAppend: fName := IncludeTrailingPathDelimiter(fName); - pdRemove: fName := ExcludeTrailingPathDelimiter(fName); - end; -end; - -function TPathImpl.GetPortableString(): UTF8String; -var - I: integer; -begin - Result := fName; - if (PathDelim = '/') then - Exit; - - for I := 1 to Length(Result) do - begin - if (Result[I] = PathDelim) then - Result[I] := '/'; - end; -end; - -function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String; -begin - AssertRefCount; - - if (UseNativeDelim) then - Result := fName - else - Result := GetPortableString(); -end; - -function TPathImpl.ToWide(UseNativeDelim: boolean): WideString; -begin - if (UseNativeDelim) then - Result := UTF8Decode(fName) - else - Result := UTF8Decode(GetPortableString()); -end; - -function TPathImpl.ToNative(): RawByteString; -begin - if (IsNativeUTF8()) then - Result := fName - else - Result := Utf8ToAnsi(fName); -end; - -function TPathImpl.GetDrive(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractFileDrive(Self); -end; - -function TPathImpl.GetPath(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractFilePath(Self); -end; - -function TPathImpl.GetDir(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractFileDir(Self); -end; - -function TPathImpl.GetName(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractFileName(Self); -end; - -function TPathImpl.GetExtension(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractFileExt(Self); -end; - -function TPathImpl.SetExtension(const Extension: IPath): IPath; -begin - AssertRefCount; - Result := FileSystem.ChangeFileExt(Self, Extension); -end; - -function TPathImpl.SetExtension(const Extension: RawByteString): IPath; -begin - Result := SetExtension(Path(Extension)); -end; - -function TPathImpl.SetExtension(const Extension: WideString): IPath; -begin - Result := SetExtension(Path(Extension)); -end; - -function TPathImpl.GetRelativePath(const BaseName: IPath): IPath; -begin - AssertRefCount; - Result := FileSystem.ExtractRelativePath(BaseName, Self); -end; - -function TPathImpl.GetAbsolutePath(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExpandFileName(Self); -end; - -function TPathImpl.GetParent(): IPath; -var - CurPath, ParentPath: IPath; -begin - AssertRefCount; - - Result := PATH_NONE; - - CurPath := Self.RemovePathDelim(); - // check if current path has a parent (no further '/') - if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then - Exit; - - // set new path and check if it has changed to avoid endless loops - // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too) - // on delphi/win32 - ParentPath := CurPath.GetPath(); - if (ParentPath.ToUTF8 = CurPath.ToUTF8) then - Exit; - - Result := ParentPath; -end; - -function TPathImpl.SplitDirs(): IPathDynArray; -var - CurPath: IPath; - Components: array of IPath; - CurPathStr: UTF8String; - DelimPos: integer; - I: integer; -begin - SetLength(Result, 0); - - if (Length(Self.ToUTF8(true)) = 0) then - Exit; - - CurPath := Self; - SetLength(Components, 0); - repeat - SetLength(Components, Length(Components)+1); - - CurPathStr := CurPath.ToUTF8(); - DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr)); - Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr))); - - CurPath := CurPath.GetParent(); - until (CurPath = PATH_NONE); - - // reverse list - SetLength(Result, Length(Components)); - for I := 0 to High(Components) do - Result[I] := Components[High(Components)-I]; -end; - -function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; -var - TmpResult: IPath; -begin - AssertRefCount; - - if (fName = '') then - TmpResult := Child - else - TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8()); - - case DelimOption of - pdKeep: Result := TmpResult; - pdAppend: Result := TmpResult.AppendPathDelim; - pdRemove: Result := TmpResult.RemovePathDelim; - end; -end; - -function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; -begin - AssertRefCount; - Result := Append(Path(Child), DelimOption); -end; - -function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; -begin - AssertRefCount; - Result := Append(Path(Child), DelimOption); -end; - -function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean; -var - SelfPath, OtherPath: UTF8String; -begin - SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8(); - OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8(); - if (FileSystem.IsCaseSensitive() and not IgnoreCase) then - Result := (CompareStr(SelfPath, OtherPath) = 0) - else - Result := (CompareText(SelfPath, OtherPath) = 0); -end; - -function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; -begin - Result := Equals(Path(Other), IgnoreCase); -end; - -function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean; -begin - Result := Equals(Path(Other), IgnoreCase); -end; - -function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean; -var - SelfPath, ParentPath: UTF8String; -begin - Result := false; - - if (Direct) then - begin - SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8(); - ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); - - // simply check if this paths parent path (SelfPath) equals ParentPath - Result := (SelfPath = ParentPath); - end - else - begin - SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8(); - ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); - - if (Length(SelfPath) <= Length(ParentPath)) then - Exit; - - // check if ParentPath is a substring of SelfPath - if (FileSystem.IsCaseSensitive()) then - Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) - else - Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) - end; -end; - -function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath; -var - OldParent, AdjustedParent: IPath; - LocalName: IPath; - PathFound: IPath; - PathWithAdjParent: IPath; - SearchInfo: TFileInfo; - FileIter: IFileIterator; - Pattern: IPath; -begin - // if case-sensitive path exists there is no need to adjust case - if (CurPath.Exists()) then - begin - Result := CurPath; - Exit; - end; - - LocalName := CurPath.RemovePathDelim().GetName(); - - // try to adjust parent - OldParent := CurPath.GetParent(); - if (OldParent <> PATH_NONE) then - begin - if (not AdjustAllLevels) then - begin - AdjustedParent := OldParent; - end - else - begin - AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels); - if (AdjustedParent = nil) then - begin - // parent path was not found case-insensitive - Result := nil; - Exit; - end; - - // check if the path with adjusted parent can be found now - PathWithAdjParent := AdjustedParent.Append(LocalName); - if (PathWithAdjParent.Exists()) then - begin - Result := PathWithAdjParent; - Exit; - end; - end; - Pattern := AdjustedParent.Append(Path('*')); - end - else // path has no parent - begin - // the top path can either be absolute or relative - if (CurPath.IsAbsolute) then - begin - // the only absolute directory at Unix without a parent is root ('/') - // and hence does not need to be adjusted - Result := CurPath; - Exit; - end; - // this is a relative path, search in the current working dir - AdjustedParent := nil; - Pattern := Path('*'); - end; - - // compare name with all files in the current directory case-insensitive - FileIter := FileSystem.FileFind(Pattern, faAnyFile); - while (FileIter.HasNext()) do - begin - SearchInfo := FileIter.Next(); - PathFound := SearchInfo.Name; - if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then - begin - if (AdjustedParent <> nil) then - Result := AdjustedParent.Append(PathFound) - else - Result := PathFound; - Exit; - end; - end; - - // no matching file found - Result := nil; -end; - -function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath; -begin - AssertRefCount; - - Result := Self; - - if (FileSystem.IsCaseSensitive) then - begin - Result := AdjustCaseRecursive(Self, AdjustAllLevels); - if (Result = nil) then - Result := Self; - end; -end; - -function TPathImpl.AppendPathDelim(): IPath; -begin - AssertRefCount; - Result := FileSystem.IncludeTrailingPathDelimiter(Self); -end; - -function TPathImpl.RemovePathDelim(): IPath; -begin - AssertRefCount; - Result := FileSystem.ExcludeTrailingPathDelimiter(Self); -end; - -function TPathImpl.CreateFile(): THandle; -begin - Result := FileSystem.FileCreate(Self); -end; - -function TPathImpl.CreateDirectory(Force: boolean): boolean; -begin - if (Force) then - Result := FileSystem.ForceDirectories(Self) - else - Result := FileSystem.DirectoryCreate(Self); -end; - -function TPathImpl.Open(Mode: longword): THandle; -begin - Result := FileSystem.FileOpen(Self, Mode); -end; - -function TPathImpl.GetFileAge(): integer; -begin - Result := FileSystem.FileAge(Self); -end; - -function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean; -begin - Result := FileSystem.FileAge(Self, FileDateTime); -end; - -function TPathImpl.Exists(): boolean; -begin - // note the different specifications of FileExists() on Win32 <> Unix - {$IFDEF MSWINDOWS} - Result := IsFile() or IsDirectory(); - {$ELSE} - Result := FileSystem.FileExists(Self); - {$ENDIF} -end; - -function TPathImpl.IsFile(): boolean; -begin - // note the different specifications of FileExists() on Win32 <> Unix - {$IFDEF MSWINDOWS} - Result := FileSystem.FileExists(Self); - {$ELSE} - Result := Exists() and not IsDirectory(); - {$ENDIF} -end; - -function TPathImpl.IsDirectory(): boolean; -begin - Result := FileSystem.DirectoryExists(Self); -end; - -function TPathImpl.IsAbsolute(): boolean; -begin - AssertRefCount; - Result := FileSystem.FileIsReadOnly(Self); -end; - -function TPathImpl.GetAttr(): cardinal; -begin - Result := FileSystem.FileGetAttr(Self); -end; - -function TPathImpl.SetAttr(Attr: Integer): boolean; -begin - Result := FileSystem.FileSetAttr(Self, Attr); -end; - -function TPathImpl.IsReadOnly(): boolean; -begin - Result := FileSystem.FileIsReadOnly(Self); -end; - -function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean; -begin - Result := FileSystem.FileSetReadOnly(Self, ReadOnly); -end; - -function TPathImpl.IsUnset(): boolean; -begin - Result := (fName = ''); -end; - -function TPathImpl.IsSet(): boolean; -begin - Result := (fName <> ''); -end; - -function TPathImpl.FileSearch(const DirList: IPath): IPath; -begin - AssertRefCount; - Result := FileSystem.FileSearch(Self, DirList); -end; - -function TPathImpl.Rename(const NewName: IPath): boolean; -begin - Result := FileSystem.RenameFile(Self, NewName); -end; - -function TPathImpl.DeleteFile(): boolean; -begin - Result := FileSystem.DeleteFile(Self); -end; - -function TPathImpl.DeleteEmptyDir(): boolean; -begin - Result := FileSystem.RemoveDir(Self); -end; - -function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean; -begin - Result := FileSystem.CopyFile(Self, Target, FailIfExists); -end; - -function TPathImpl.GetIntern(): UTF8String; -begin - Result := fName; -end; - - -{ TBinaryFileStream } - -constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word); -begin -{$IFDEF MSWINDOWS} - inherited Create(FileName.ToWide(), Mode); -{$ELSE} - inherited Create(FileName.ToNative(), Mode); -{$ENDIF} -end; - -{ TTextStream } - -constructor TTextFileStream.Create(Filename: IPath; Mode: word); -begin - inherited Create(); - fMode := Mode; - fFilename := Filename; - fLineBreak := sLineBreak; -end; - -function TTextFileStream.ReadLine(var Line: UTF8String): boolean; -begin - Line := ReadLine(Result); -end; - -function TTextFileStream.ReadLine(var Line: AnsiString): boolean; -begin - Line := ReadLine(Result); -end; - -procedure TTextFileStream.WriteString(const Str: RawByteString); -begin - WriteBuffer(Str[1], Length(Str)); -end; - -procedure TTextFileStream.WriteLine(const Line: RawByteString); -begin - WriteBuffer(Line[1], Length(Line)); - WriteBuffer(fLineBreak[1], Length(fLineBreak)); -end; - -{ TMemTextStream } - -constructor TMemTextFileStream.Create(Filename: IPath; Mode: word); -var - FileStream: TBinaryFileStream; -begin - inherited Create(Filename, Mode); - - fStream := TMemoryStream.Create(); - - // load data to memory in read mode - if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then - begin - FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); - try - fStream.LoadFromStream(FileStream); - finally - FileStream.Free; - end; - end - // check if file exists for write-mode - else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then - begin - raise EFOpenError.CreateResFmt(@SFOpenError, - [FileName.GetAbsolutePath.ToNative]); - end; -end; - -destructor TMemTextFileStream.Destroy(); -var - FileStream: TBinaryFileStream; - SaveMode: word; -begin - // save changes in write mode (= not read-only mode) - if ((fMode and 3) <> fmOpenRead) then - begin - if (fMode = fmCreate) then - SaveMode := fmCreate - else - SaveMode := fmOpenWrite; - FileStream := TBinaryFileStream.Create(fFilename, SaveMode); - try - fStream.SaveToStream(FileStream); - finally - FileStream.Free; - end; - end; - - fStream.Free; - inherited; -end; - -function TMemTextFileStream.GetSize: int64; -begin - Result := fStream.Size; -end; - -function TMemTextFileStream.Read(var Buffer; Count: longint): longint; -begin - Result := fStream.Read(Buffer, Count); -end; - -function TMemTextFileStream.Write(const Buffer; Count: longint): longint; -begin - Result := fStream.Write(Buffer, Count); -end; - -function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint; -begin - Result := fStream.Seek(Offset, Origin); -end; - -function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64; -begin - Result := fStream.Seek(Offset, Origin); -end; - -function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString; -var - LineLength: cardinal; - Temp: RawByteString; -begin - LineLength := EndPos - StartPos; - if (LineLength > 0) then - begin - // set string length to line-length (+ zero-terminator) - SetLength(Temp, LineLength); - StrLCopy(PAnsiChar(Temp), - @PAnsiChar(fStream.Memory)[StartPos], - LineLength); - Result := Temp; - end - else - begin - Result := ''; - end; -end; - -function TMemTextFileStream.ReadString(): RawByteString; -var - TextPtr: PAnsiChar; - CurPos, StartPos, FileSize: int64; -begin - TextPtr := PAnsiChar(fStream.Memory); - CurPos := Position; - FileSize := Size; - StartPos := -1; - - while (CurPos < FileSize) do - begin - // check for whitespace (tab, lf, cr, space) - if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then - begin - // check if we are at the end of a string - if (StartPos > -1) then - Break; - end - else if (StartPos = -1) then // start of string found - begin - StartPos := CurPos; - end; - Inc(CurPos); - end; - - if (StartPos = -1) then - Result := '' - else - begin - Result := CopyMemString(StartPos, CurPos); - fStream.Position := CurPos; - end; -end; - -{* - * Implementation of ReadLine(). We need separate versions for UTF8String - * and AnsiString as "var" parameter types have to fit exactly. - * To avoid a var-parameter here, the internal version the Line parameter is - * used as return value. - *} -function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString; -var - TextPtr: PAnsiChar; - CurPos, FileSize: int64; -begin - TextPtr := PAnsiChar(fStream.Memory); - CurPos := fStream.Position; - FileSize := Size; - - // check for EOF - if (CurPos >= FileSize) then - begin - Result := ''; - Success := false; - Exit; - end; - - Success := true; - - while (CurPos < FileSize) do - begin - if (TextPtr[CurPos] in [#10, #13]) then - begin - // copy text line - Result := CopyMemString(fStream.Position, CurPos); - - // handle windows style #13#10 (\r\n) newlines - if (TextPtr[CurPos] = #13) and - (CurPos+1 < FileSize) and - (TextPtr[CurPos+1] = #10) then - begin - Inc(CurPos); - end; - - // update stream pos - fStream.Position := CurPos+1; - - Exit; - end; - Inc(CurPos); - end; - - Result := CopyMemString(fStream.Position, CurPos); - fStream.Position := FileSize; -end; - -{ TUnicodeMemoryStream } - -procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath); -var - Stream: TStream; -begin - Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); - try - LoadFromStream(Stream); - finally - Stream.Free; - end; -end; - -procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath); -var - Stream: TStream; -begin - Stream := TBinaryFileStream.Create(FileName, fmCreate); - try - SaveToStream(Stream); - finally - Stream.Free; - end; -end; - -{ TUnicodeMemIniFile } - -constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean); -var - List: TStringList; - Stream: TBinaryFileStream; - BOMBuf: array[0..2] of AnsiChar; -begin - inherited Create(''); - FFilename := FileName; - FUTF8Encoded := UTF8Encoded; - - if FileName.Exists() then - begin - List := nil; - Stream := nil; - try - List := TStringList.Create; - Stream := TBinaryFileStream.Create(FileName, fmOpenRead); - if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and - (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then - begin - // truncate BOM - FUTF8Encoded := true; - end - else - begin - // rewind file - Stream.Seek(0, soBeginning); - end; - List.LoadFromStream(Stream); - SetStrings(List); - finally - Stream.Free; - List.Free; - end; - end; -end; - -procedure TUnicodeMemIniFile.UpdateFile; -var - List: TStringList; - Stream: TBinaryFileStream; -begin - List := nil; - Stream := nil; - try - List := TStringList.Create; - GetStrings(List); - Stream := TBinaryFileStream.Create(FFileName, fmCreate); - if UTF8Encoded then - Stream.Write(UTF8_BOM, Length(UTF8_BOM)); - List.SaveToStream(Stream); - finally - List.Free; - Stream.Free; - end; -end; - - -var - PATH_NONE_Singelton: IPath; - -function PATH_NONE(): IPath; -begin - Result := PATH_NONE_Singelton; -end; - -initialization - {$IFDEF HAVE_REFCNTBUG} - GarbageList := TInterfaceList.Create(); - GarbageList.Capacity := GarbageMaxCount; - {$ENDIF} - PATH_NONE_Singelton := Path(''); - -finalization - PATH_NONE_Singelton := nil; - -end. +{* UltraStar Deluxe - Karaoke Game + * + * UltraStar Deluxe is the legal property of its developers, whose names + * are too numerous to list here. Please refer to the COPYRIGHT + * file distributed with this source distribution. + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; see the file COPYING. If not, write to + * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, + * Boston, MA 02110-1301, USA. + * + * $URL$ + * $Id$ + *} + +unit UPath; + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +interface + +uses + SysUtils, + Classes, + IniFiles, + {$IFDEF MSWINDOWS} + TntClasses, + {$ENDIF} + UConfig, + UUnicodeUtils; + +type + IPath = interface; + + {** + * TUnicodeMemoryStream + *} + TUnicodeMemoryStream = class(TMemoryStream) + public + procedure LoadFromFile(const FileName: IPath); + procedure SaveToFile(const FileName: IPath); + end; + + {** + * Unicode capable IniFile implementation. + * TMemIniFile and TIniFile are not able to handle INI-files with + * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists + * and removes it from the internal string-list. + * UTF8Encoded is set accordingly. + *} + TUnicodeMemIniFile = class(TMemIniFile) + private + FFilename: IPath; + FUTF8Encoded: boolean; + public + constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce; + procedure UpdateFile; override; + property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded; + end; + + {** + * TBinaryFileStream (inherited from THandleStream) + *} + {$IFDEF MSWINDOWS} + TBinaryFileStream = class(TTntFileStream) + {$ELSE} + TBinaryFileStream = class(TFileStream) + {$ENDIF} + public + {** + * @seealso TFileStream.Create for valid Mode parameters + *} + constructor Create(const FileName: IPath; Mode: word); + end; + + {** + * TTextFileStream + *} + TTextFileStream = class(TStream) + protected + fLineBreak: RawByteString; + fFilename: IPath; + fMode: word; + + function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract; + public + constructor Create(Filename: IPath; Mode: word); + + function ReadString(): RawByteString; virtual; abstract; + function ReadLine(var Line: UTF8String): boolean; overload; + function ReadLine(var Line: AnsiString): boolean; overload; + + procedure WriteString(const Str: RawByteString); virtual; + procedure WriteLine(const Line: RawByteString); virtual; + + property LineBreak: RawByteString read fLineBreak write fLineBreak; + property Filename: IPath read fFilename; + end; + + {** + * TMemTextStream + *} + TMemTextFileStream = class(TTextFileStream) + private + fStream: TMemoryStream; + protected + function GetSize: int64; override; + + {** + * Copies fStream.Memory from StartPos to EndPos-1 to the result string; + *} + function CopyMemString(StartPos: int64; EndPos: int64): RawByteString; + public + constructor Create(Filename: IPath; Mode: word); + destructor Destroy(); override; + + function Read(var Buffer; Count: longint): longint; override; + function Write(const Buffer; Count: longint): longint; override; + function Seek(Offset: longint; Origin: word): longint; override; + function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override; + + function ReadLine(var Success: boolean): RawByteString; override; + function ReadString(): RawByteString; override; + end; + + {** + TUnicodeIniStream = class() + end; + *} + + {** + * pdKeep: Keep path as is, neither remove or append a delimiter + * pdAppend: Append a delimiter if path does not have a trailing one + * pdRemove: Remove a trailing delimiter from the path + *} + TPathDelimOption = (pdKeep, pdAppend, pdRemove); + + IPathDynArray = array of IPath; + + {** + * An IPath represents a filename, a directory or a filesystem path in general. + * It hides some of the operating system's specifics like path delimiters + * and encodings and provides an easy to use interface to handle them. + * Internally all paths are stored with the same path delimiter (PathDelim) + * and encoding (UTF-8). The transformation is already done AT THE CREATION of + * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between + * Unix and Windows style paths. + * + * Create new paths with one of the Path() functions. + * If you need a string representation use IPath.ToNative/ToUTF8/ToWide. + * Note that due to the path-delimiter and encoding transformation the string + * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'. + * + * It is recommended to use an IPath as long as possible without a string + * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI + * only on Windows. If you would use for example FileExists(MyPath.ToNative) + * it would not find a file which contains characters that are not in the + * current locale. Same applies to AssignFile(), TFileStream.Create() and + * everything else in the RTL that expects a filename. + * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions + * if the filename parameter is not of a UTF8String or WideString type. + * + * If you need to open a file use TBinaryStream or TFileStream instead. Many + * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods + * can be workaround. + * + * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot + * even pass a stream instead of a filename be aware that even if you know that + * a filename is ASCII only, subdirectories in an absolute path might contain + * some non-ASCII characters (for example the user's name) and hence might + * fail (if the characters are not in the current locale). + * It is rare but it happens. + * + * IMPORTANT: + * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems. + * Cwstring functions (WideUpperCase, ...) cannot be used by external threads + * as FPC uses Thread-Local-Storage for the implementation. As a result do not + * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads). + *} + IPath = interface + ['{686BF103-CE43-4598-B85D-A2C3AF950897}'] + {** + * Returns the path as an UTF8 encoded string. + * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) + * is used. If it is set to false the (more) portable '/' delimiter will used. + *} + function ToUTF8(UseNativeDelim: boolean = true): UTF8String; + + {** + * Returns the path as an UTF-16 encoded string. + * If UseNativeDelim is set to true, the native path delimiter ('\' on win32) + * is used. If it is set to false the delimiter will be '/'. + *} + function ToWide(UseNativeDelim: boolean = true): WideString; + + {** + * Returns the path with the system's native encoding and path delimiter. + * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible) + * Mac: UTF8 + * Unix: UTF8 or ANSI according to LC_CTYPE + *} + function ToNative(): RawByteString; + + {** + * Note: File must be closed with FileClose(Handle) after usage + * @seealso SysUtils.FileOpen() + *} + function Open(Mode: longword): THandle; + + {** @seealso SysUtils.ExtractFileDrive() *} + function GetDrive(): IPath; + + {** @seealso SysUtils.ExtractFilePath() *} + function GetPath(): IPath; + + {** @seealso SysUtils.ExtractFileDir() *} + function GetDir(): IPath; + + {** @seealso SysUtils.ExtractFileName() *} + function GetName(): IPath; + + {** @seealso SysUtils.ExtractFileExtension() *} + function GetExtension(): IPath; + + {** + * Returns a copy of the path with the extension changed to Extension. + * The file itself is not changed, use Rename() for this task. + * @seealso SysUtils.ChangeFileExt() + *} + function SetExtension(const Extension: IPath): IPath; overload; + function SetExtension(const Extension: RawByteString): IPath; overload; + function SetExtension(const Extension: WideString): IPath; overload; + + {** + * Returns the representation of the path relative to Basename. + * Note that the basename must be terminated with a path delimiter + * otherwise the last path component will be ignored. + * @seealso SysUtils.ExtractRelativePath() + *} + function GetRelativePath(const BaseName: IPath): IPath; + + {** @seealso SysUtils.ExpandFileName() *} + function GetAbsolutePath(): IPath; + + {** + * Returns the concatenation of this path with Child. If this path does not + * end with a path delimiter one is inserted in front of the Child path. + * Example: Path('parent').Append(Path('child')) -> Path('parent/child') + *} + function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + + {** + * Splits the path into its components. Path delimiters are not removed from + * components. + * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir'] + *} + function SplitDirs(): IPathDynArray; + + {** + * Returns the parent directory or PATH_NONE if none exists. + *} + function GetParent(): IPath; + + {** + * Checks if this path is a subdir of or file inside Parent. + * If Direct is true this path must be a direct child. + * Example: C:\test\file is a direct child of C:\test and a child of C:\ + *} + function IsChildOf(const Parent: IPath; Direct: boolean): boolean; + + {** + * Adjusts the case of the path on case senstitive filesystems. + * If the path does not exist or the filesystem is case insensitive + * the original path will be returned. Otherwise a corrected copy. + *} + function AdjustCase(AdjustAllLevels: boolean): IPath; + + {** @seealso SysUtils.IncludeTrailingPathDelimiter() *} + function AppendPathDelim(): IPath; + + {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *} + function RemovePathDelim(): IPath; + + function Exists(): boolean; + function IsFile(): boolean; + function IsDirectory(): boolean; + function IsAbsolute(): boolean; + function GetFileAge(): integer; overload; + function GetFileAge(out FileDateTime: TDateTime): boolean; overload; + function GetAttr(): cardinal; + function SetAttr(Attr: Integer): boolean; + function IsReadOnly(): boolean; + function SetReadOnly(ReadOnly: boolean): boolean; + + {** + * Checks if this path points to nothing, that means the path consists of + * the empty string '' and hence equals PATH_NONE. + * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE). + * If IsUnset() returns true this path and PATH_NONE are equal but they must + * not be identical as the references might point to different objects. + * + * Example: + * Path('').Equals(PATH_EMPTY) -> true + * Path('') = PATH_EMPTY -> false + *} + function IsUnset(): boolean; + function IsSet(): boolean; + + {** + * Compares this path with Other and returns true if both paths are + * equal. Both paths are expanded and trailing slashes excluded before + * comparison. If IgnoreCase is true, the case will be ignored on + * case-sensitive filesystems. + *} + function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload; + function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload; + function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload; + + {** + * Searches for a file in DirList. The Result is nil if the file was + * not found. Use IFileSystem.FileFind() instead if you want to use + * wildcards. + * @seealso SysUtils.FileSearch() + *} + function FileSearch(const DirList: IPath): IPath; + + {** File must be closed with FileClose(Handle) after usage } + function CreateFile(): THandle; + function DeleteFile(): boolean; + function CreateDirectory(Force: boolean = false): boolean; + function DeleteEmptyDir(): boolean; + function Rename(const NewName: IPath): boolean; + function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; + + // TODO: Dirwatch stuff + // AddFileChangeListener(Listener: TFileChangeListener); + + {** + * Internal string representation. For debugging only. + *} + function GetIntern: UTF8String; + property Intern: UTF8String READ GetIntern; + end; + +{** + * Creates a new path with the given pathname. PathName can be either in UTF8 + * or the local encoding. + * Notes: + * - On Apple only UTF8 is supported + * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems) + *} +function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; +function Path(PathName: PChar; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + +{** + * Creates a new path with the given UTF-16 pathname. + *} +function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload; + +{** + * Returns a singleton for Path(''). + *} +function PATH_NONE(): IPath; + +implementation + +uses + RTLConsts, + UTextEncoding, + UFilesystem; + +{* + * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work + * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019). + * + * There are two (probably more) scenarios causes a program to crash: + * + * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will + * internally create a temporary variable to hold the result of Path('fail'). + * This temporary var is then passed as Self to GetParent(). Unfortunately FPC + * does already decrement the ref-count of the temporary var at the end of the + * call to Path('fail') and the ref-count drops to zero and the temp object + * is destroyed as FPC erroneously assumes that the temp is not used anymore. + * As a result the Self variable in GetParent() will be invalid, the same + * applies to TPathImpl.fName which reference count dropped to zero when the + * temp was destroyed. Hence GetParent() will likely crash. + * If it does not, ToUTF8() will either return some random string + * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash. + * Either way the result of ToUTF8() is messed up. + * This scenario applies whenever a function (or method) is called that returns + * an interfaced object (e.g. an IPath) and the result is used without storing + * a reference to it in a (temporary) variable first. + * + * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8(); + * + * will not crash but is very impractical and error-prone. Note that Tmp2 cannot + * be replaced with Tmp (see scenario 2). + * + * 2. Another situation this bug will ruin our lives is when a variable to an + * interfaced object is used at the left and right side of an assignment as in: + * MyPath := MyPath.GetParent() + * + * Although the bug is already fixed in the FPC development version 2.3.1 + * it will take quite some time till the next FPC release (> 2.2.4) in which + * this issue is fixed. + * + * To workaround this bug we use some very simple and stupid kind of garbage + * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList) + * to artificially increase the ref-count of the newly created object. + * This keeps the object alive when FPC's temporary variable comes to the end + * of its lifetime and the object's ref-count is decremented + * (and is now 1 instead of 0). + * Later on, the object is either garbage or referenced by another variable. + * + * Look at + * MyPath := Path('SomeDir/SubDir').GetParent() + * + * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore. + * (2) The result of GetParent() is referenced by MyPath + * Object (1) has a reference count of 1 (as it is only referenced by the + * GarbageList). Object (2) is referenced twice (MyPath + GarbageList). + * When the reference to (2) is finally stored in MyPath we can safely remove + * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of + * (2) will be decremented to 1. + * + * As we do not know when it is safe to remove an object from the GarbageList + * we assume that there are max. GarbageMaxCount IPath elements created until + * the execution of the expression is performed and a reference to the resulting + * object is assigned to a variable so all temps can be safely deleted. + * + * Worst-case scenarios are recursive calls or calls with large call stacks with + * functions that return an IPath. Also keep in mind that multiple threads might + * be executing such functions at the same time. + * A reasonable count might be a max. of 20.000 elements. With an average length + * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath + * this will consume ~1.2MB. + *} +{$IFDEF FPC} +{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4 + {$DEFINE HAVE_REFCNTBUG} +{$IFEND} +{$ENDIF} + +{$IFDEF HAVE_REFCNTBUG} +const + // when GarbageList.Count reaches GarbageMaxCount the oldest references in + // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount. + GarbageMaxCount = 20000; + GarbageAfterCleanCount = GarbageMaxCount-1000; + +var + GarbageList: IInterfaceList; +{$ENDIF} + +type + TPathImpl = class(TInterfacedObject, IPath) + private + fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim + + {** + * Unifies the filename. Path-delimiters are replaced by '/'. + *} + procedure Unify(DelimOption: TPathDelimOption); + + {** + * Returns a copy of fName with path delimiters changed to '/'. + *} + function GetPortableString(): UTF8String; + + procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF} + + public + constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption); + destructor Destroy(); override; + + function ToUTF8(UseNativeDelim: boolean): UTF8String; + function ToWide(UseNativeDelim: boolean): WideString; + function ToNative(): RawByteString; + + function Open(Mode: longword): THandle; + + function GetDrive(): IPath; + function GetPath(): IPath; + function GetDir(): IPath; + function GetName(): IPath; + function GetExtension(): IPath; + + function SetExtension(const Extension: IPath): IPath; overload; + function SetExtension(const Extension: RawByteString): IPath; overload; + function SetExtension(const Extension: WideString): IPath; overload; + + function GetRelativePath(const BaseName: IPath): IPath; + function GetAbsolutePath(): IPath; + function GetParent(): IPath; + function SplitDirs(): IPathDynArray; + + function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload; + function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload; + function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload; + + function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload; + function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload; + function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload; + + function IsChildOf(const Parent: IPath; Direct: boolean): boolean; + + function AdjustCase(AdjustAllLevels: boolean): IPath; + + function AppendPathDelim(): IPath; + function RemovePathDelim(): IPath; + + function GetFileAge(): integer; overload; + function GetFileAge(out FileDateTime: TDateTime): boolean; overload; + function Exists(): boolean; + function IsFile(): boolean; + function IsDirectory(): boolean; + function IsAbsolute(): boolean; + function GetAttr(): cardinal; + function SetAttr(Attr: Integer): boolean; + function IsReadOnly(): boolean; + function SetReadOnly(ReadOnly: boolean): boolean; + + function IsUnset(): boolean; + function IsSet(): boolean; + + function FileSearch(const DirList: IPath): IPath; + + function CreateFile(): THandle; + function DeleteFile(): boolean; + function CreateDirectory(Force: boolean): boolean; + function DeleteEmptyDir(): boolean; + function Rename(const NewName: IPath): boolean; + function CopyFile(const Target: IPath; FailIfExists: boolean): boolean; + + function GetIntern(): UTF8String; + end; + +function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath; +begin + if (IsUTF8String(PathName)) then + Result := TPathImpl.Create(PathName, DelimOption) + else if (IsNativeUTF8()) then + Result := PATH_NONE + else + Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption); +end; + +function Path(PathName: PChar; DelimOption: TPathDelimOption): IPath; +begin + Result := Path(string(PathName)); +end; + +function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath; +begin + Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption); +end; + + + +procedure TPathImpl.AssertRefCount; +begin + {$IFDEF HAVE_REFCNTBUG} + if (FRefCount <= 0) then + raise Exception.Create('RefCount error: ' + IntToStr(FRefCount)); + {$ENDIF} +end; + +constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption); +begin + inherited Create(); + fName := Name; + Unify(DelimOption); + {$IFDEF HAVE_REFCNTBUG} + GarbageList.Lock; + if (GarbageList.Count >= GarbageMaxCount) then + begin + while (GarbageList.Count > GarbageAfterCleanCount) do + GarbageList.Delete(0); + end; + GarbageList.Add(Self); + GarbageList.Unlock; + {$ENDIF} +end; + +destructor TPathImpl.Destroy(); +begin + inherited; +end; + +procedure TPathImpl.Unify(DelimOption: TPathDelimOption); +var + I: integer; +begin + // convert all path delimiters to native ones + for I := 1 to Length(fName) do + begin + if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then + fName[I] := PathDelim; + end; + + // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter + case DelimOption of + pdAppend: fName := IncludeTrailingPathDelimiter(fName); + pdRemove: fName := ExcludeTrailingPathDelimiter(fName); + end; +end; + +function TPathImpl.GetPortableString(): UTF8String; +var + I: integer; +begin + Result := fName; + if (PathDelim = '/') then + Exit; + + for I := 1 to Length(Result) do + begin + if (Result[I] = PathDelim) then + Result[I] := '/'; + end; +end; + +function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String; +begin + AssertRefCount; + + if (UseNativeDelim) then + Result := fName + else + Result := GetPortableString(); +end; + +function TPathImpl.ToWide(UseNativeDelim: boolean): WideString; +begin + if (UseNativeDelim) then + Result := UTF8Decode(fName) + else + Result := UTF8Decode(GetPortableString()); +end; + +function TPathImpl.ToNative(): RawByteString; +begin + if (IsNativeUTF8()) then + Result := fName + else + Result := Utf8ToAnsi(fName); +end; + +function TPathImpl.GetDrive(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileDrive(Self); +end; + +function TPathImpl.GetPath(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFilePath(Self); +end; + +function TPathImpl.GetDir(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileDir(Self); +end; + +function TPathImpl.GetName(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileName(Self); +end; + +function TPathImpl.GetExtension(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractFileExt(Self); +end; + +function TPathImpl.SetExtension(const Extension: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.ChangeFileExt(Self, Extension); +end; + +function TPathImpl.SetExtension(const Extension: RawByteString): IPath; +begin + Result := SetExtension(Path(Extension)); +end; + +function TPathImpl.SetExtension(const Extension: WideString): IPath; +begin + Result := SetExtension(Path(Extension)); +end; + +function TPathImpl.GetRelativePath(const BaseName: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.ExtractRelativePath(BaseName, Self); +end; + +function TPathImpl.GetAbsolutePath(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExpandFileName(Self); +end; + +function TPathImpl.GetParent(): IPath; +var + CurPath, ParentPath: IPath; +begin + AssertRefCount; + + Result := PATH_NONE; + + CurPath := Self.RemovePathDelim(); + // check if current path has a parent (no further '/') + if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then + Exit; + + // set new path and check if it has changed to avoid endless loops + // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too) + // on delphi/win32 + ParentPath := CurPath.GetPath(); + if (ParentPath.ToUTF8 = CurPath.ToUTF8) then + Exit; + + Result := ParentPath; +end; + +function TPathImpl.SplitDirs(): IPathDynArray; +var + CurPath: IPath; + Components: array of IPath; + CurPathStr: UTF8String; + DelimPos: integer; + I: integer; +begin + SetLength(Result, 0); + + if (Length(Self.ToUTF8(true)) = 0) then + Exit; + + CurPath := Self; + SetLength(Components, 0); + repeat + SetLength(Components, Length(Components)+1); + + CurPathStr := CurPath.ToUTF8(); + DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr)); + Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr))); + + CurPath := CurPath.GetParent(); + until (CurPath = PATH_NONE); + + // reverse list + SetLength(Result, Length(Components)); + for I := 0 to High(Components) do + Result[I] := Components[High(Components)-I]; +end; + +function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; +var + TmpResult: IPath; +begin + AssertRefCount; + + if (fName = '') then + TmpResult := Child + else + TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8()); + + case DelimOption of + pdKeep: Result := TmpResult; + pdAppend: Result := TmpResult.AppendPathDelim; + pdRemove: Result := TmpResult.RemovePathDelim; + end; +end; + +function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; +begin + AssertRefCount; + Result := Append(Path(Child), DelimOption); +end; + +function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; +begin + AssertRefCount; + Result := Append(Path(Child), DelimOption); +end; + +function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean; +var + SelfPath, OtherPath: UTF8String; +begin + SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8(); + OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8(); + if (FileSystem.IsCaseSensitive() and not IgnoreCase) then + Result := (CompareStr(SelfPath, OtherPath) = 0) + else + Result := (CompareText(SelfPath, OtherPath) = 0); +end; + +function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; +begin + Result := Equals(Path(Other), IgnoreCase); +end; + +function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean; +begin + Result := Equals(Path(Other), IgnoreCase); +end; + +function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean; +var + SelfPath, ParentPath: UTF8String; +begin + Result := false; + + if (Direct) then + begin + SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8(); + ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); + + // simply check if this paths parent path (SelfPath) equals ParentPath + Result := (SelfPath = ParentPath); + end + else + begin + SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8(); + ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8(); + + if (Length(SelfPath) <= Length(ParentPath)) then + Exit; + + // check if ParentPath is a substring of SelfPath + if (FileSystem.IsCaseSensitive()) then + Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) + else + Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0) + end; +end; + +function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath; +var + OldParent, AdjustedParent: IPath; + LocalName: IPath; + PathFound: IPath; + PathWithAdjParent: IPath; + SearchInfo: TFileInfo; + FileIter: IFileIterator; + Pattern: IPath; +begin + // if case-sensitive path exists there is no need to adjust case + if (CurPath.Exists()) then + begin + Result := CurPath; + Exit; + end; + + LocalName := CurPath.RemovePathDelim().GetName(); + + // try to adjust parent + OldParent := CurPath.GetParent(); + if (OldParent <> PATH_NONE) then + begin + if (not AdjustAllLevels) then + begin + AdjustedParent := OldParent; + end + else + begin + AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels); + if (AdjustedParent = nil) then + begin + // parent path was not found case-insensitive + Result := nil; + Exit; + end; + + // check if the path with adjusted parent can be found now + PathWithAdjParent := AdjustedParent.Append(LocalName); + if (PathWithAdjParent.Exists()) then + begin + Result := PathWithAdjParent; + Exit; + end; + end; + Pattern := AdjustedParent.Append(Path('*')); + end + else // path has no parent + begin + // the top path can either be absolute or relative + if (CurPath.IsAbsolute) then + begin + // the only absolute directory at Unix without a parent is root ('/') + // and hence does not need to be adjusted + Result := CurPath; + Exit; + end; + // this is a relative path, search in the current working dir + AdjustedParent := nil; + Pattern := Path('*'); + end; + + // compare name with all files in the current directory case-insensitive + FileIter := FileSystem.FileFind(Pattern, faAnyFile); + while (FileIter.HasNext()) do + begin + SearchInfo := FileIter.Next(); + PathFound := SearchInfo.Name; + if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then + begin + if (AdjustedParent <> nil) then + Result := AdjustedParent.Append(PathFound) + else + Result := PathFound; + Exit; + end; + end; + + // no matching file found + Result := nil; +end; + +function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath; +begin + AssertRefCount; + + Result := Self; + + if (FileSystem.IsCaseSensitive) then + begin + Result := AdjustCaseRecursive(Self, AdjustAllLevels); + if (Result = nil) then + Result := Self; + end; +end; + +function TPathImpl.AppendPathDelim(): IPath; +begin + AssertRefCount; + Result := FileSystem.IncludeTrailingPathDelimiter(Self); +end; + +function TPathImpl.RemovePathDelim(): IPath; +begin + AssertRefCount; + Result := FileSystem.ExcludeTrailingPathDelimiter(Self); +end; + +function TPathImpl.CreateFile(): THandle; +begin + Result := FileSystem.FileCreate(Self); +end; + +function TPathImpl.CreateDirectory(Force: boolean): boolean; +begin + if (Force) then + Result := FileSystem.ForceDirectories(Self) + else + Result := FileSystem.DirectoryCreate(Self); +end; + +function TPathImpl.Open(Mode: longword): THandle; +begin + Result := FileSystem.FileOpen(Self, Mode); +end; + +function TPathImpl.GetFileAge(): integer; +begin + Result := FileSystem.FileAge(Self); +end; + +function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean; +begin + Result := FileSystem.FileAge(Self, FileDateTime); +end; + +function TPathImpl.Exists(): boolean; +begin + // note the different specifications of FileExists() on Win32 <> Unix + {$IFDEF MSWINDOWS} + Result := IsFile() or IsDirectory(); + {$ELSE} + Result := FileSystem.FileExists(Self); + {$ENDIF} +end; + +function TPathImpl.IsFile(): boolean; +begin + // note the different specifications of FileExists() on Win32 <> Unix + {$IFDEF MSWINDOWS} + Result := FileSystem.FileExists(Self); + {$ELSE} + Result := Exists() and not IsDirectory(); + {$ENDIF} +end; + +function TPathImpl.IsDirectory(): boolean; +begin + Result := FileSystem.DirectoryExists(Self); +end; + +function TPathImpl.IsAbsolute(): boolean; +begin + AssertRefCount; + Result := FileSystem.FileIsReadOnly(Self); +end; + +function TPathImpl.GetAttr(): cardinal; +begin + Result := FileSystem.FileGetAttr(Self); +end; + +function TPathImpl.SetAttr(Attr: Integer): boolean; +begin + Result := FileSystem.FileSetAttr(Self, Attr); +end; + +function TPathImpl.IsReadOnly(): boolean; +begin + Result := FileSystem.FileIsReadOnly(Self); +end; + +function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean; +begin + Result := FileSystem.FileSetReadOnly(Self, ReadOnly); +end; + +function TPathImpl.IsUnset(): boolean; +begin + Result := (fName = ''); +end; + +function TPathImpl.IsSet(): boolean; +begin + Result := (fName <> ''); +end; + +function TPathImpl.FileSearch(const DirList: IPath): IPath; +begin + AssertRefCount; + Result := FileSystem.FileSearch(Self, DirList); +end; + +function TPathImpl.Rename(const NewName: IPath): boolean; +begin + Result := FileSystem.RenameFile(Self, NewName); +end; + +function TPathImpl.DeleteFile(): boolean; +begin + Result := FileSystem.DeleteFile(Self); +end; + +function TPathImpl.DeleteEmptyDir(): boolean; +begin + Result := FileSystem.RemoveDir(Self); +end; + +function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean; +begin + Result := FileSystem.CopyFile(Self, Target, FailIfExists); +end; + +function TPathImpl.GetIntern(): UTF8String; +begin + Result := fName; +end; + + +{ TBinaryFileStream } + +constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word); +begin +{$IFDEF MSWINDOWS} + inherited Create(FileName.ToWide(), Mode); +{$ELSE} + inherited Create(FileName.ToNative(), Mode); +{$ENDIF} +end; + +{ TTextStream } + +constructor TTextFileStream.Create(Filename: IPath; Mode: word); +begin + inherited Create(); + fMode := Mode; + fFilename := Filename; + fLineBreak := sLineBreak; +end; + +function TTextFileStream.ReadLine(var Line: UTF8String): boolean; +begin + Line := ReadLine(Result); +end; + +function TTextFileStream.ReadLine(var Line: AnsiString): boolean; +begin + Line := ReadLine(Result); +end; + +procedure TTextFileStream.WriteString(const Str: RawByteString); +begin + WriteBuffer(Str[1], Length(Str)); +end; + +procedure TTextFileStream.WriteLine(const Line: RawByteString); +begin + WriteBuffer(Line[1], Length(Line)); + WriteBuffer(fLineBreak[1], Length(fLineBreak)); +end; + +{ TMemTextStream } + +constructor TMemTextFileStream.Create(Filename: IPath; Mode: word); +var + FileStream: TBinaryFileStream; +begin + inherited Create(Filename, Mode); + + fStream := TMemoryStream.Create(); + + // load data to memory in read mode + if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then + begin + FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); + try + fStream.LoadFromStream(FileStream); + finally + FileStream.Free; + end; + end + // check if file exists for write-mode + else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then + begin + raise EFOpenError.CreateResFmt(@SFOpenError, + [FileName.GetAbsolutePath.ToNative]); + end; +end; + +destructor TMemTextFileStream.Destroy(); +var + FileStream: TBinaryFileStream; + SaveMode: word; +begin + // save changes in write mode (= not read-only mode) + if ((fMode and 3) <> fmOpenRead) then + begin + if (fMode = fmCreate) then + SaveMode := fmCreate + else + SaveMode := fmOpenWrite; + FileStream := TBinaryFileStream.Create(fFilename, SaveMode); + try + fStream.SaveToStream(FileStream); + finally + FileStream.Free; + end; + end; + + fStream.Free; + inherited; +end; + +function TMemTextFileStream.GetSize: int64; +begin + Result := fStream.Size; +end; + +function TMemTextFileStream.Read(var Buffer; Count: longint): longint; +begin + Result := fStream.Read(Buffer, Count); +end; + +function TMemTextFileStream.Write(const Buffer; Count: longint): longint; +begin + Result := fStream.Write(Buffer, Count); +end; + +function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint; +begin + Result := fStream.Seek(Offset, Origin); +end; + +function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64; +begin + Result := fStream.Seek(Offset, Origin); +end; + +function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString; +var + LineLength: cardinal; + Temp: RawByteString; +begin + LineLength := EndPos - StartPos; + if (LineLength > 0) then + begin + // set string length to line-length (+ zero-terminator) + SetLength(Temp, LineLength); + StrLCopy(PAnsiChar(Temp), + @PAnsiChar(fStream.Memory)[StartPos], + LineLength); + Result := Temp; + end + else + begin + Result := ''; + end; +end; + +function TMemTextFileStream.ReadString(): RawByteString; +var + TextPtr: PAnsiChar; + CurPos, StartPos, FileSize: int64; +begin + TextPtr := PAnsiChar(fStream.Memory); + CurPos := Position; + FileSize := Size; + StartPos := -1; + + while (CurPos < FileSize) do + begin + // check for whitespace (tab, lf, cr, space) + if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then + begin + // check if we are at the end of a string + if (StartPos > -1) then + Break; + end + else if (StartPos = -1) then // start of string found + begin + StartPos := CurPos; + end; + Inc(CurPos); + end; + + if (StartPos = -1) then + Result := '' + else + begin + Result := CopyMemString(StartPos, CurPos); + fStream.Position := CurPos; + end; +end; + +{* + * Implementation of ReadLine(). We need separate versions for UTF8String + * and AnsiString as "var" parameter types have to fit exactly. + * To avoid a var-parameter here, the internal version the Line parameter is + * used as return value. + *} +function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString; +var + TextPtr: PAnsiChar; + CurPos, FileSize: int64; +begin + TextPtr := PAnsiChar(fStream.Memory); + CurPos := fStream.Position; + FileSize := Size; + + // check for EOF + if (CurPos >= FileSize) then + begin + Result := ''; + Success := false; + Exit; + end; + + Success := true; + + while (CurPos < FileSize) do + begin + if (TextPtr[CurPos] in [#10, #13]) then + begin + // copy text line + Result := CopyMemString(fStream.Position, CurPos); + + // handle windows style #13#10 (\r\n) newlines + if (TextPtr[CurPos] = #13) and + (CurPos+1 < FileSize) and + (TextPtr[CurPos+1] = #10) then + begin + Inc(CurPos); + end; + + // update stream pos + fStream.Position := CurPos+1; + + Exit; + end; + Inc(CurPos); + end; + + Result := CopyMemString(fStream.Position, CurPos); + fStream.Position := FileSize; +end; + +{ TUnicodeMemoryStream } + +procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath); +var + Stream: TStream; +begin + Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite); + try + LoadFromStream(Stream); + finally + Stream.Free; + end; +end; + +procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath); +var + Stream: TStream; +begin + Stream := TBinaryFileStream.Create(FileName, fmCreate); + try + SaveToStream(Stream); + finally + Stream.Free; + end; +end; + +{ TUnicodeMemIniFile } + +constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean); +var + List: TStringList; + Stream: TBinaryFileStream; + BOMBuf: array[0..2] of AnsiChar; +begin + inherited Create(''); + FFilename := FileName; + FUTF8Encoded := UTF8Encoded; + + if FileName.Exists() then + begin + List := nil; + Stream := nil; + try + List := TStringList.Create; + Stream := TBinaryFileStream.Create(FileName, fmOpenRead); + if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and + (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then + begin + // truncate BOM + FUTF8Encoded := true; + end + else + begin + // rewind file + Stream.Seek(0, soBeginning); + end; + List.LoadFromStream(Stream); + SetStrings(List); + finally + Stream.Free; + List.Free; + end; + end; +end; + +procedure TUnicodeMemIniFile.UpdateFile; +var + List: TStringList; + Stream: TBinaryFileStream; +begin + List := nil; + Stream := nil; + try + List := TStringList.Create; + GetStrings(List); + Stream := TBinaryFileStream.Create(FFileName, fmCreate); + if UTF8Encoded then + Stream.Write(UTF8_BOM, Length(UTF8_BOM)); + List.SaveToStream(Stream); + finally + List.Free; + Stream.Free; + end; +end; + + +var + PATH_NONE_Singelton: IPath; + +function PATH_NONE(): IPath; +begin + Result := PATH_NONE_Singelton; +end; + +initialization + {$IFDEF HAVE_REFCNTBUG} + GarbageList := TInterfaceList.Create(); + GarbageList.Capacity := GarbageMaxCount; + {$ENDIF} + PATH_NONE_Singelton := Path(''); + +finalization + PATH_NONE_Singelton := nil; + +end. -- cgit v1.2.3 From d89662dbff77b0608fb752f40b20def74839bfd1 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 6 Apr 2010 19:05:25 +0000 Subject: addition to previous commit: - cast to RawByteString instead of string to avoid ambiguity git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2219 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPath.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPath.pas b/src/base/UPath.pas index 79045486..3d4804d7 100644 --- a/src/base/UPath.pas +++ b/src/base/UPath.pas @@ -563,7 +563,7 @@ end; function Path(PathName: PChar; DelimOption: TPathDelimOption): IPath; begin - Result := Path(string(PathName)); + Result := Path(RawByteString(PathName)); end; function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath; -- cgit v1.2.3 From 5ccfc5107ed4006fad3253dfd9041a42049a90d4 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 7 Apr 2010 11:49:45 +0000 Subject: swap textures of statics colorized to playercolor in score screen so ticket #1 should finally be fixed git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2221 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 582f34e8..11598207 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -397,6 +397,7 @@ type StaticBackLevelRound: array[1..6] of TThemeStatic; StaticLevel: array[1..6] of TThemeStatic; StaticLevelRound: array[1..6] of TThemeStatic; + StaticPlayerIdBox: array[1..6] of TThemeStatic; // Description: array[0..5] of string;} end; @@ -1171,6 +1172,7 @@ begin ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); + ThemeLoadStatic(Score.StaticPlayerIdBox[I], 'ScoreStaticPlayerIdBox' + IntToStr(I)); ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I)); end; -- cgit v1.2.3 From 55726dad18659155342a538b51ed82a1b0fcb291 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 7 Apr 2010 11:55:38 +0000 Subject: center usdx window git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2222 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 45befc46..2b9a16fe 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -483,6 +483,9 @@ begin SDL_WM_SetCaption(PChar(Title), nil); + { center window } + SDL_putenv('SDL_VIDEO_WINDOW_POS=center'); + //Log.BenchmarkStart(2); InitializeScreen; -- cgit v1.2.3 From 8a3039ff7c074fe7d2491b765156f56f3c1940b8 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 7 Apr 2010 12:22:27 +0000 Subject: write log files to writable user directory git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2223 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformWindows.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index 30bad264..8c4469cf 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -150,7 +150,7 @@ end; function TPlatformWindows.GetLogPath: IPath; begin - Result := GetExecutionDir(); + Result := GetGameUserPath; end; function TPlatformWindows.GetGameSharedPath: IPath; -- cgit v1.2.3 From 8f55d79635ea77d486affc7efc157917e2c04e49 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 11 Apr 2010 11:01:18 +0000 Subject: - added own procedure ConvertFrom101To110(): conversion from 1.01 to 1.10 - added unicode conversion for all affected colums - added support for challenge-mod db (Date) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2226 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 138 +++++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 122 insertions(+), 16 deletions(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index 85b4b8e8..cccedc69 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -38,7 +38,8 @@ uses SQLiteTable3, UPath, USong, - USongs; + USongs, + UTextEncoding; //-------------------- //DataBaseSystem - Class including all DB methods @@ -100,6 +101,7 @@ type destructor Destroy; override; procedure Init(const Filename: IPath); + procedure ConvertFrom101To110(); procedure ReadScore(Song: TSong); procedure AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer); procedure WriteScore(Song: TSong); @@ -207,17 +209,11 @@ begin '[Rating] INTEGER NULL' + ');'); - // convert data from 1.01 to 1.1 - // part #2 - accomplishment - if finalizeConversion then + //add column date to cUS-Scores + if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') then begin - Log.LogInfo('Outdated song database found - begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Init'); - // insert old values into new db-schemes (/tables) - ScoreDB.ExecSQL('INSERT INTO ' + cUS_Scores + ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); - ScoreDB.ExecSQL('INSERT INTO ' + cUS_Songs + ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); - //now drop old tables - ScoreDB.ExecSQL('DROP TABLE us_scores_101;'); - ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); + Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init'); + ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL'); end; // add column rating to cUS_Songs @@ -228,12 +224,13 @@ begin ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN [Rating] INTEGER NULL'); end; - - //add column date to cUS-Scores - if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') then + // convert data from previous versions + // part #2 - accomplishment + if finalizeConversion then begin - Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init'); - ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL'); + //convert data from 1.01 to 1.1 + if ScoreDB.TableExists('us_scores_101') then + ConvertFrom101To110(); end; except @@ -246,6 +243,115 @@ begin end; +(** + * Convert Database from 1.01 to 1.1 + *) +procedure TDataBaseSystem.ConvertFrom101To110(); +var + TableData: TSQLiteUniTable; + tempUTF8String: UTF8String; +begin + if not ScoreDB.ContainsColumn('us_scores_101', 'Date') then + begin + Log.LogInfo( + 'Outdated song database found - ' + + 'begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Convert101To110'); + + // insert old values into new db-schemes (/tables) + ScoreDB.ExecSQL( + 'INSERT INTO ' + cUS_Scores + + ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); + end else + begin + Log.LogInfo( + 'Outdated song database found - ' + + 'begin conversion from V1.01 Challenge Mod to V1.1', 'TDataBaseSystem.Convert101To110'); + + // insert old values into new db-schemes (/tables) + ScoreDB.ExecSQL( + 'INSERT INTO ' + cUS_Scores + + ' SELECT SongID, Difficulty, Player, Score, Date FROM us_scores_101;'); + end; + + ScoreDB.ExecSQL( + 'INSERT INTO ' + cUS_Songs + + ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); + + // now we have to convert all the texts for unicode support: + + // player names + TableData := nil; + try + TableData := ScoreDB.GetUniTable( + 'SELECT [rowid], [Player] ' + + 'FROM [' + cUS_Scores + '];'); + + // Go through all Entrys + while (not TableData.EOF) do + begin + // Convert name into UTF8 and alter all entrys + DecodeStringUTF8(TableData.FieldByName['Player'], tempUTF8String, encCP1252); + ScoreDB.ExecSQL( + 'UPDATE [' + cUS_Scores + '] ' + + 'SET [Player] = ? ' + + 'WHERE [rowid] = ? ', + [tempUTF8String, + TableData.FieldAsInteger(TableData.FieldIndex['rowid'])]); + + TableData.Next; + end; // while + + except + on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110'); + end; + + TableData.Free; + + // song artist and song title + TableData := nil; + try + TableData := ScoreDB.GetUniTable( + 'SELECT [ID], [Artist], [Title] ' + + 'FROM [' + cUS_Songs + '];'); + + // Go through all Entrys + while (not TableData.EOF) do + begin + // Convert Artist into UTF8 and alter all entrys + DecodeStringUTF8(TableData.FieldByName['Artist'], tempUTF8String, encCP1252); + //Log.LogError(TableData.FieldByName['Artist']+' -> '+tempUTF8String+' (encCP1252)'); + ScoreDB.ExecSQL( + 'UPDATE [' + cUS_Songs + '] ' + + 'SET [Artist] = ? ' + + 'WHERE [ID] = ?', + [tempUTF8String, + TableData.FieldAsInteger(TableData.FieldIndex['ID'])]); + + // Convert Title into UTF8 and alter all entrys + DecodeStringUTF8(TableData.FieldByName['Title'], tempUTF8String, encCP1252); + ScoreDB.ExecSQL( + 'UPDATE [' + cUS_Songs + '] ' + + 'SET [Title] = ? ' + + 'WHERE [ID] = ? ', + [tempUTF8String, + TableData.FieldAsInteger(TableData.FieldIndex['ID'])]); + + TableData.Next; + end; // while + + except + on E: Exception do + Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110'); + end; + + TableData.Free; + + //now drop old tables + ScoreDB.ExecSQL('DROP TABLE us_scores_101;'); + ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); +end; + (** * Frees Database *) -- cgit v1.2.3 From f1566a45ac7de81f31a1b419d88e1742089ae56d Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 13 Apr 2010 16:23:14 +0000 Subject: =?UTF-8?q?-=20save=20input=20device=20names=20as=20UTF8Strings=20?= =?UTF-8?q?-=20device=20names=20of=20basslib=20are=20assumed=20to=20be=20i?= =?UTF-8?q?n=20local=20encoding=20-=20device=20names=20of=20portaudio=20ar?= =?UTF-8?q?e=20assumed=20to=20be=20in=20utf-8=20fixes:=20display=20of=20de?= =?UTF-8?q?vice=20names=20w/=20special=20characters=20w/=20basslib=20('?= =?UTF-8?q?=C3=A4'=20for=20me)=20to-do:=20proof=20encoding=20of=20device?= =?UTF-8?q?=20names=20for=20basslib=20and=20portaudio?= MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2234 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index a3f665e5..c4612adb 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -102,7 +102,7 @@ type TAudioInputDevice = class public CfgIndex: integer; // index of this device in Ini.InputDeviceConfig - Name: string; // soundcard name + Name: UTF8String; // soundcard name Source: array of TAudioInputSource; // soundcard input-sources SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) MicSource: integer; // source-index of mic (-1: none detected) @@ -143,7 +143,7 @@ type private Started: boolean; protected - function UnifyDeviceName(const name: string; deviceIndex: integer): string; + function UnifyDeviceName(const name: UTF8String; deviceIndex: integer): UTF8String; public function GetName: String; virtual; abstract; function InitializeRecord: boolean; virtual; abstract; @@ -741,7 +741,7 @@ begin Started := false; end; -function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; +function TAudioInputBase.UnifyDeviceName(const name: UTF8String; deviceIndex: integer): UTF8String; var count: integer; // count of devices with this name -- cgit v1.2.3 From ca12fbb41e2886ee23e95617f434742bb8be2dd1 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 13 Apr 2010 17:16:32 +0000 Subject: load type and typesbg from theme ini for selects added type definitions to deluxe themes selects git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2235 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 4 ++++ 1 file changed, 4 insertions(+) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 11598207..aa89af43 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -170,7 +170,9 @@ type TThemeSelectSlide = record Tex: string; + Typ: TTextureType; TexSBG: string; + TypSBG: TTextureType; X: integer; Y: integer; W: integer; @@ -1790,7 +1792,9 @@ begin ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); + ThemeSelectS.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); + ThemeSelectS.TypSBG := ParseTextureType(ThemeIni.ReadString(Name, 'TypeSBG', ''), TEXTURE_TYPE_PLAIN); ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0); ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0); -- cgit v1.2.3 From 52cc4b6e5416c1bcd4e94abcec2e9532e4f66403 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 14 Apr 2010 11:45:52 +0000 Subject: completly remove solmization new default values: - bgmusic = on - lyriceffect = shift git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2237 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 18 ++---------------- src/base/USong.pas | 46 ---------------------------------------------- 2 files changed, 2 insertions(+), 62 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 1ba47251..6f875e50 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -134,7 +134,6 @@ type // Lyrics LyricsFont: integer; LyricsEffect: integer; - Solmization: integer; NoteLines: integer; // Themes @@ -233,7 +232,6 @@ const ILyricsFont: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2'); ILyricsEffect: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmization: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); INoteLines: array[0..1] of UTF8String = ('Off', 'On'); IColor: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); @@ -298,7 +296,6 @@ var ILyricsFontTranslated: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2'); ILyricsEffectTranslated: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmizationTranslated: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); INoteLinesTranslated: array[0..1] of UTF8String = ('Off', 'On'); IColorTranslated: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); @@ -420,11 +417,6 @@ begin ILyricsEffectTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_BALL'); ILyricsEffectTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_SHIFT'); - ISolmizationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ISolmizationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_EURO'); - ISolmizationTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_JAPAN'); - ISolmizationTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_AMERICAN'); - INoteLinesTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); INoteLinesTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); @@ -981,10 +973,7 @@ begin LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[0])); // Lyrics Effect - LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[2])); - - // Solmization - Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0])); + LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[4])); // NoteLines NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); @@ -1013,7 +1002,7 @@ begin {** * Background music *} - BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off')); + BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'On')); // EffectSing EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On')); @@ -1136,9 +1125,6 @@ begin // Lyrics Effect IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]); - // Solmization - IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]); - // NoteLines IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); diff --git a/src/base/USong.pas b/src/base/USong.pas index 705206c4..07b1a6b5 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -90,7 +90,6 @@ type FileLineNo : integer; // line, which is read last, for error reporting function DecodeFilename(Filename: RawByteString): IPath; - function Solmizate(Note: integer; Type_: integer): string; procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); @@ -1135,53 +1134,8 @@ begin Result := -1; end; -function TSong.Solmizate(Note: integer; Type_: integer): string; -begin - case (Type_) of - 1: // european - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' sol '; - 9..10: Result := ' la '; - 11: Result := ' si '; - end; - end; - 2: // japanese - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' so '; - 9..10: Result := ' la '; - 11: Result := ' shi '; - end; - end; - 3: // american - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' sol '; - 9..10: Result := ' la '; - 11: Result := ' ti '; - end; - end; - end; // case -end; - procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); begin - if (Ini.Solmization <> 0) then - LyricS := Solmizate(NoteP, Ini.Solmization); - with Lines[LineNumber].Line[Lines[LineNumber].High] do begin SetLength(Note, Length(Note) + 1); -- cgit v1.2.3 From 74b2872c860073f7e30dc651da013c16d19ba6c6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Wed, 14 Apr 2010 13:15:14 +0000 Subject: - fix crash when not existing skin is selected in config file - restrict loading of themes w/o correct version tag 'USD 110' - remove version tag from classic theme because it causes a crash on load due to missing statics and or texts that some screens assume to be there, e.g. score screen git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2239 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 17 ++++++++++++++++- 1 file changed, 16 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 6f875e50..6e86c558 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -721,6 +721,7 @@ var SearchResult: TSearchRec; ThemeIni: TMemIniFile; ThemeName: string; + ThemeVersion: string; I: integer; Iter: IFileIterator; FileInfo: TFileInfo; @@ -737,10 +738,18 @@ begin Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme'); //Read Themename from Theme - ThemeIni := TMemIniFile.Create(FileInfo.Name.ToNative); + ThemeIni := TMemIniFile.Create(ThemePath.Append(FileInfo.Name).ToNative); ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', FileInfo.Name.SetExtension('').ToNative)); + ThemeVersion := Trim(UpperCase(ThemeIni.ReadString('Theme','US_Version', 'no version tag'))); ThemeIni.Free; + // don't load theme with wrong version tag + if ThemeVersion <> 'USD 110' then + begin + Log.LogWarn('Wrong Version (' + ThemeVersion + ') in Theme : ' + ThemeName, 'Theme'); + Continue; + end; + //Search for Skins for this Theme for I := Low(Skin.Skin) to High(Skin.Skin) do begin @@ -767,6 +776,12 @@ begin Skin.onThemeChange; SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); + + { there may be a not existing skin in the ini file + e.g. due to manual edit or corrupted file. + in this case we load the first Skin } + if SkinNo = -1 then + SkinNo := 0; end; procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); -- cgit v1.2.3 From 962f21e84feb128c650c0478a6f7af337dacaee6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 15 Apr 2010 17:57:15 +0000 Subject: - port theme detection code from UIni to UThemes - load new value DefaultSkin from themefiles - load value Color (skins default color) from skinfiles - use default skin and color on first start - use default skin and color on theme/skin change git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2241 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCommon.pas | 25 +++++++++++ src/base/UIni.pas | 85 +++++-------------------------------- src/base/UMain.pas | 12 ++++-- src/base/USkins.pas | 70 +++++++++++++++++++++--------- src/base/UThemes.pas | 118 ++++++++++++++++++++++++++++++++++++++++++--------- 5 files changed, 192 insertions(+), 118 deletions(-) (limited to 'src/base') diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas index fa0faf3c..18022337 100644 --- a/src/base/UCommon.pas +++ b/src/base/UCommon.pas @@ -45,6 +45,7 @@ uses type TStringDynArray = array of string; + TUTF8StringDynArray = array of UTF8String; const SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space @@ -88,6 +89,8 @@ procedure MergeSort(List: TList; CompareFunc: TListSortCompare); function GetAlignedMem(Size: cardinal; Alignment: integer): pointer; procedure FreeAlignedMem(P: pointer); +function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer; + implementation @@ -514,6 +517,28 @@ begin TempList.Free; end; +(** + * Returns the index of Value in SearchArray + * or -1 if Value is not in SearchArray. + *) +function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; + CaseInsensitiv: boolean = false): integer; +var + i: integer; +begin + Result := -1; + + for i := 0 to High(SearchArray) do + begin + if (SearchArray[i] = Value) or + (CaseInsensitiv and (CompareText(SearchArray[i], Value) = 0)) then + begin + Result := i; + Break; + end; + end; +end; + type // stores the unaligned pointer of data allocated by GetAlignedMem() diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 6e86c558..36c3cce0 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -37,6 +37,7 @@ uses Classes, IniFiles, SysUtils, + UCommon, ULog, UTextEncoding, UFilesystem, @@ -75,7 +76,6 @@ type private function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer; function ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile; IniSection: string; IniProperty: string; Default: integer): integer; @@ -166,10 +166,10 @@ type var Ini: TIni; - IResolution: array of UTF8String; - ILanguage: array of UTF8String; - ITheme: array of UTF8String; - ISkin: array of UTF8String; + IResolution: TUTF8StringDynArray; + ILanguage: TUTF8StringDynArray; + ITheme: TUTF8StringDynArray; + ISkin: TUTF8StringDynArray; const IPlayers: array[0..4] of UTF8String = ('1', '2', '3', '4', '6'); @@ -327,6 +327,7 @@ uses UMain, URecord, USkins, + UThemes, UPathUtils, UUnicodeUtils; @@ -566,28 +567,6 @@ begin end; end; -(** - * Returns the index of Value in SearchArray - * or -1 if Value is not in SearchArray. - *) -function TIni.GetArrayIndex(const SearchArray: array of UTF8String; Value: string; - CaseInsensitiv: boolean = false): integer; -var - i: integer; -begin - Result := -1; - - for i := 0 to High(SearchArray) do - begin - if (SearchArray[i] = Value) or - (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then - begin - Result := i; - Break; - end; - end; -end; - (** * Reads the property IniSeaction:IniProperty from IniFile and * finds its corresponding index in SearchArray. @@ -717,51 +696,7 @@ begin end; procedure TIni.LoadThemes(IniFile: TCustomIniFile); -var - SearchResult: TSearchRec; - ThemeIni: TMemIniFile; - ThemeName: string; - ThemeVersion: string; - I: integer; - Iter: IFileIterator; - FileInfo: TFileInfo; begin - // Theme - SetLength(ITheme, 0); - Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme'); - - - Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0); - while (Iter.HasNext) do - begin - FileInfo := Iter.Next; - Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme'); - - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(ThemePath.Append(FileInfo.Name).ToNative); - ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', FileInfo.Name.SetExtension('').ToNative)); - ThemeVersion := Trim(UpperCase(ThemeIni.ReadString('Theme','US_Version', 'no version tag'))); - ThemeIni.Free; - - // don't load theme with wrong version tag - if ThemeVersion <> 'USD 110' then - begin - Log.LogWarn('Wrong Version (' + ThemeVersion + ') in Theme : ' + ThemeName, 'Theme'); - Continue; - end; - - //Search for Skins for this Theme - for I := Low(Skin.Skin) to High(Skin.Skin) do - begin - if UpperCase(Skin.Skin[I].Theme) = ThemeName then - begin - SetLength(ITheme, Length(ITheme)+1); - ITheme[High(ITheme)] := FileInfo.Name.SetExtension('').ToNative; - break; - end; - end; - end; - // No Theme Found if (Length(ITheme) = 0) then begin @@ -775,13 +710,16 @@ begin // Skin Skin.onThemeChange; - SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); + SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[UThemes.Theme.Themes[Theme].DefaultSkin])); { there may be a not existing skin in the ini file e.g. due to manual edit or corrupted file. in this case we load the first Skin } if SkinNo = -1 then SkinNo := 0; + + // Color + Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[Skin.GetDefaultColor(SkinNo)])); end; procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); @@ -995,9 +933,6 @@ begin LoadThemes(IniFile); - // Color - Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0])); - LoadInputDeviceCfg(IniFile); // LoadAnimation diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 0de8ddeb..550fe9cd 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -171,6 +171,12 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Skin List', 1); + Log.BenchmarkStart(1); + Log.LogStatus('Loading Theme List', 'Initialization'); + Theme := TTheme.Create; + Log.BenchmarkEnd(1); + Log.LogBenchmark('Loading Theme List', 1); + // Ini + Paths Log.BenchmarkStart(1); Log.LogStatus('Load Ini', 'Initialization'); @@ -196,10 +202,10 @@ begin // Theme Log.BenchmarkStart(1); - Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create(ThemePath.Append(ITheme[Ini.Theme] + '.ini'), Ini.Color); + Log.LogStatus('Load Theme', 'Initialization'); + Theme.LoadTheme(Ini.Theme, Ini.Color); Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Themes', 1); + Log.LogBenchmark('Loading Theme', 1); // Covers Cache Log.BenchmarkStart(1); diff --git a/src/base/USkins.pas b/src/base/USkins.pas index 6ef5c596..a909b081 100644 --- a/src/base/USkins.pas +++ b/src/base/USkins.pas @@ -34,7 +34,8 @@ interface {$I switches.inc} uses - UPath; + UPath, + UCommon; type TSkinTexture = record @@ -47,6 +48,8 @@ type Name: string; Path: IPath; FileName: IPath; + + DefaultColor: integer; Creator: string; // not used yet end; @@ -62,6 +65,10 @@ type procedure LoadSkin(Name: string); function GetTextureFileName(TextureName: string): IPath; function GetSkinNumber(Name: string): integer; + function GetDefaultColor(SkinNo: integer): integer; + + procedure GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray); + procedure onThemeChange; end; @@ -74,6 +81,7 @@ uses IniFiles, Classes, SysUtils, + Math, UIni, ULog, UMain, @@ -130,6 +138,7 @@ begin Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', ''); Skin[S].Name := SkinIni.ReadString('Skin', 'Name', ''); Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', ''); + Skin[S].DefaultColor := Max(0, GetArrayIndex(IColor, SkinIni.ReadString('Skin', 'Color', ''), true)); SkinIni.Free; end; @@ -180,14 +189,6 @@ begin //Log.LogError('', '-----------------------------------------'); //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName'); end; - -{ Result := SkinPath + 'Bar.jpg'; - if TextureName = 'Ball' then - Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 4) = 'Gray' then - Result := SkinPath + 'Ball.bmp'; - if Copy(TextureName, 1, 6) = 'NoteBG' then - Result := SkinPath + 'Ball.bmp';} end; function TSkin.GetSkinNumber(Name: string): integer; @@ -196,25 +197,52 @@ var begin Result := 0; // set default to the first available skin for S := 0 to High(Skin) do - if Skin[S].Name = Name then + if CompareText(Skin[S].Name, Name) = 0 then Result := S; end; -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; +procedure TSkin.GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray); + var + I: Integer; + Len: integer; begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then + SetLength(Skins, 0); + Len := 0; + + for I := 0 to High(Skin) do + if CompareText(Theme, Skin[I].Theme) = 0 then begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; + SetLength(Skins, Len + 1); + Skins[Len] := Skin[I].Name; + Inc(Len); end; +end; +{ returns number of default color for skin with + index SkinNo in ISkin (not in the actual skin array) } +function TSkin.GetDefaultColor(SkinNo: integer): integer; + var + I: Integer; +begin + Result := 0; + + for I := 0 to High(Skin) do + if CompareText(ITheme[Ini.Theme], Skin[I].Theme) = 0 then + begin + if SkinNo > 0 then + Dec(SkinNo) + else + begin + Result := Skin[I].DefaultColor; + Break; + end; + end; +end; + +procedure TSkin.onThemeChange; +begin + Ini.SkinNo:=0; + GetSkinsByTheme(ITheme[Ini.Theme], ISkin); end; end. diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index aa89af43..f8b2d8fd 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -721,6 +721,13 @@ type CatText: UTF8String; end; + TThemeEntry = record + Name: string; + Filename: IPath; + DefaultSkin: integer; + Creator: string; + end; + TTheme = class private {$IFDEF THEMESAVE} @@ -731,8 +738,9 @@ type LastThemeBasic: TThemeBasic; procedure CreateThemeObjects(); - + procedure LoadHeader(FileName: IPath); public + Themes: array of TThemeEntry; Loading: TThemeLoading; Main: TThemeMain; Name: TThemeName; @@ -774,9 +782,11 @@ type ILevel: array[0..2] of UTF8String; - constructor Create(const FileName: IPath); overload; // Initialize theme system - constructor Create(const FileName: IPath; Color: integer); overload; // Initialize theme system with color - function LoadTheme(const FileName: IPath; sColor: integer): boolean; // Load some theme settings from file + constructor Create; + + procedure LoadList; + + function LoadTheme(ThemeNum: integer; sColor: integer): boolean; // Load some theme settings from file procedure LoadColors; @@ -829,9 +839,12 @@ uses ULanguage, USkins, UIni, + UPathUtils, + UFileSystem, gl, glext, - math; + math, + StrUtils; //----------- //Helper procs to use TRGB in Opengl ...maybe this should be somewhere else @@ -856,12 +869,7 @@ begin glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); end; -constructor TTheme.Create(const FileName: IPath); -begin - Create(FileName, 0); -end; - -constructor TTheme.Create(const FileName: IPath; Color: integer); +constructor TTheme.Create; begin inherited Create(); @@ -901,11 +909,83 @@ begin StatMain := TThemeStatMain.Create; StatDetail := TThemeStatDetail.Create; - LoadTheme(FileName, Color); + //LoadTheme(FileName, Color); + LoadList; +end; + +procedure TTheme.LoadHeader(FileName: IPath); + var + Entry: TThemeEntry; + Ini: TMemIniFile; + SkinName: string; + SkinsFound: boolean; + ThemeVersion: string; + I: integer; + Len: integer; + Skins: TUTF8StringDynArray; +begin + Entry.Filename := ThemePath.Append(FileName); + //read info from theme header + Ini := TMemIniFile.Create(Entry.Filename.ToNative); + + Entry.Name := Ini.ReadString('Theme', 'Name', FileName.SetExtension('').ToNative); + ThemeVersion := Trim(UpperCase(Ini.ReadString('Theme', 'US_Version', 'no version tag'))); + Entry.Creator := Ini.ReadString('Theme', 'Creator', 'Unknown'); + SkinName := Ini.ReadString('Theme', 'DefaultSkin', FileName.SetExtension('').ToNative); + + Ini.Free; + + // don't load theme with wrong version tag + if ThemeVersion <> 'USD 110' then + begin + Log.LogWarn('Wrong Version (' + ThemeVersion + ') in Theme : ' + Entry.Name, 'Theme.LoadHeader'); + end + else + begin + //Search for Skins for this Theme + SkinsFound := false; + for I := Low(Skin.Skin) to High(Skin.Skin) do + begin + if (CompareText(Skin.Skin[I].Theme, Entry.Name) = 0) then + begin + SkinsFound := true; + break; + end; + end; + + if SkinsFound then + begin + { found a valid Theme } + // set correct default skin + Skin.GetSkinsByTheme(Entry.Name, Skins); + Entry.DefaultSkin := max(0, GetArrayIndex(Skins, SkinName, true)); + + Len := Length(Themes); + SetLength(Themes, Len + 1); + SetLength(ITheme, Len + 1); + Themes[Len] := Entry; + ITheme[Len] := Entry.Name; + end; + end; +end; +procedure TTheme.LoadList; + var + Iter: IFileIterator; + FileInfo: TFileInfo; +begin + Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme.LoadList'); + + Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0); + while (Iter.HasNext) do + begin + FileInfo := Iter.Next; + Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme.LoadList'); + LoadHeader(Fileinfo.Name); + end; end; -function TTheme.LoadTheme(const FileName: IPath; sColor: integer): boolean; +function TTheme.LoadTheme(ThemeNum: integer; sColor: integer): boolean; var I: integer; begin @@ -913,21 +993,21 @@ begin CreateThemeObjects(); - Log.LogStatus('Loading: '+ FileName.ToNative, 'TTheme.LoadTheme'); + Log.LogStatus('Loading: '+ Themes[ThemeNum].FileName.ToNative, 'TTheme.LoadTheme'); - if not FileName.IsFile() then + if not Themes[ThemeNum].FileName.IsFile() then begin - Log.LogError('Theme does not exist ('+ FileName.ToNative +')', 'TTheme.LoadTheme'); + Log.LogError('Theme does not exist ('+ Themes[ThemeNum].FileName.ToNative +')', 'TTheme.LoadTheme'); end; - if FileName.IsFile() then + if Themes[ThemeNum].FileName.IsFile() then begin Result := true; {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName.ToNative); + ThemeIni := TIniFile.Create(Themes[ThemeNum].FileName.ToNative); {$ELSE} - ThemeIni := TMemIniFile.Create(FileName.ToNative); + ThemeIni := TMemIniFile.Create(Themes[ThemeNum].FileName.ToNative); {$ENDIF} if ThemeIni.ReadString('Theme', 'Name', '') <> '' then -- cgit v1.2.3 From 4b502e678735fe19ccc7bd140b4ff34ac1406628 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sat, 17 Apr 2010 15:50:43 +0000 Subject: some parts recoded more simply, maybe this will fix infinite score raise bug can't reproduce it anyway :P git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2245 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USingScores.pas | 31 +++++++++++++++---------------- 1 file changed, 15 insertions(+), 16 deletions(-) (limited to 'src/base') diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 6fdfaeb6..71389f32 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -571,19 +571,14 @@ function TSingScores.GetPopUpPoints(const Index: integer): integer; begin Result := 0; - // only check points if there is a difference between actual - // and displayed points - if (Players[Index].Score > Players[Index].ScoreDisplayed) then + CurPopUp := FirstPopUp; + while (CurPopUp <> nil) do begin - CurPopUp := FirstPopUp; - while (CurPopUp <> nil) do - begin - if (CurPopUp.Player = Index) then - begin // add points left "in" popup to result - Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven); - end; - CurPopUp := CurPopUp.Next; + if (CurPopUp.Player = Index) then + begin // add points left "in" popup to result + Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven); end; + CurPopUp := CurPopUp.Next; end; end; @@ -754,12 +749,16 @@ begin if (S <> 0) then begin - if (S > 0) then - Diff := Min(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S) - else - Diff := Max(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S); + Diff := Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)); + + { minimal raise per frame = 1 } + if Abs(Diff) < 1 then + Diff := Sign(S); - Inc(aPlayers[Index].ScoreDisplayed, Diff); + if (Abs(Diff) < Abs(S)) then + Inc(aPlayers[Index].ScoreDisplayed, Diff) + else + Inc(aPlayers[Index].ScoreDisplayed, S); end; end; -- cgit v1.2.3 From f761eb20ce8d3b5ef718be4a305b78712641248d Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 18 Apr 2010 13:43:36 +0000 Subject: change variable names "static" to "statics" - "static" is a reserved name and should not be used - code-completion in lazarus does not work as it is not able to cope with variables that are named "static" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2246 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index f8b2d8fd..45e85af5 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -218,7 +218,7 @@ type TThemeBasic = class Background: TThemeBackground; Text: AThemeText; - Static: AThemeStatic; + Statics: AThemeStatic; //Button Collection Mod ButtonCollection: AThemeButtonCollection; @@ -1623,7 +1623,7 @@ procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; const Name: string); begin ThemeLoadBackground(Theme.Background, Name); ThemeLoadTexts(Theme.Text, Name + 'Text'); - ThemeLoadStatics(Theme.Static, Name + 'Static'); + ThemeLoadStatics(Theme.Statics, Name + 'Static'); ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection'); LastThemeBasic := Theme; @@ -2297,7 +2297,7 @@ begin ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); ThemeSaveBackground(Theme.Background, Name + 'Background'); - ThemeSaveStatics(Theme.Static, Name + 'Static'); + ThemeSaveStatics(Theme.Statics, Name + 'Static'); ThemeSaveTexts(Theme.Text, Name + 'Text'); end; -- cgit v1.2.3 From 698dff10499ff6bd08a7a23da3c50903216a5384 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 19 Apr 2010 16:12:18 +0000 Subject: reduced verbose output on missing theme and song tags (info instead of warn) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2250 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 2 +- src/base/UTexture.pas | 3 ++- 2 files changed, 3 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 07b1a6b5..597bcb46 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -931,7 +931,7 @@ begin //Check the Identifier (If Value is given) if (Length(Value) = 0) then begin - Log.LogWarn('Empty field "'+Identifier+'" in file ' + FullFileName, + Log.LogInfo('Empty field "'+Identifier+'" in file ' + FullFileName, 'TSong.ReadTXTHeader'); AddCustomTag(Identifier, ''); end diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas index e477dbb1..c1334dd7 100644 --- a/src/base/UTexture.pas +++ b/src/base/UTexture.pas @@ -540,7 +540,8 @@ begin Exit; end; end; - Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType'); + Log.LogInfo('Unknown texture type: "' + TypeStr + '". Using default texture type "' + + TextureTypeToStr(Default) + '"', 'UTexture.ParseTextureType'); Result := Default; end; -- cgit v1.2.3 From aecd412bef5a839a34617f11ba2fdf247d086584 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 19 Apr 2010 17:43:55 +0000 Subject: changed THandle to TFileHandle in UPath/UFilesystem as THandle (cardinal in delphi) does not allow -1. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2251 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFilesystem.pas | 16 ++++++++-------- src/base/UPath.pas | 22 +++++++++++++++------- 2 files changed, 23 insertions(+), 15 deletions(-) (limited to 'src/base') diff --git a/src/base/UFilesystem.pas b/src/base/UFilesystem.pas index d4972df5..805bcfe5 100644 --- a/src/base/UFilesystem.pas +++ b/src/base/UFilesystem.pas @@ -73,9 +73,9 @@ type *} IFileSystem = interface function ExpandFileName(const FileName: IPath): IPath; - function FileCreate(const FileName: IPath): THandle; + function FileCreate(const FileName: IPath): TFileHandle; function DirectoryCreate(const Dir: IPath): boolean; - function FileOpen(const FileName: IPath; Mode: longword): THandle; + function FileOpen(const FileName: IPath; Mode: longword): TFileHandle; function FileAge(const FileName: IPath): integer; overload; function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload; @@ -151,9 +151,9 @@ type TFileSystemImpl = class(TInterfacedObject, IFileSystem) public function ExpandFileName(const FileName: IPath): IPath; - function FileCreate(const FileName: IPath): THandle; + function FileCreate(const FileName: IPath): TFileHandle; function DirectoryCreate(const Dir: IPath): boolean; - function FileOpen(const FileName: IPath; Mode: longword): THandle; + function FileOpen(const FileName: IPath; Mode: longword): TFileHandle; function FileAge(const FileName: IPath): integer; overload; function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload; function DirectoryExists(const Name: IPath): boolean; @@ -259,7 +259,7 @@ begin Result := Path(WideExpandFileName(FileName.ToWide())); end; -function TFileSystemImpl.FileCreate(const FileName: IPath): THandle; +function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle; begin Result := WideFileCreate(FileName.ToWide()); end; @@ -269,7 +269,7 @@ begin Result := WideCreateDir(Dir.ToWide()); end; -function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle; +function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle; begin Result := WideFileOpen(FileName.ToWide(), Mode); end; @@ -431,7 +431,7 @@ begin Result := Path(SysUtils.ExpandFileName(FileName.ToNative())); end; -function TFileSystemImpl.FileCreate(const FileName: IPath): THandle; +function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle; begin Result := SysUtils.FileCreate(FileName.ToNative()); end; @@ -441,7 +441,7 @@ begin Result := SysUtils.CreateDir(Dir.ToNative()); end; -function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): THandle; +function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle; begin Result := SysUtils.FileOpen(FileName.ToNative(), Mode); end; diff --git a/src/base/UPath.pas b/src/base/UPath.pas index 3d4804d7..7c00e7b1 100644 --- a/src/base/UPath.pas +++ b/src/base/UPath.pas @@ -46,6 +46,12 @@ uses type IPath = interface; + {$IFDEF FPC} + TFileHandle = THandle; + {$ELSE} + TFileHandle = Longint; + {$ENDIF} + {** * TUnicodeMemoryStream *} @@ -219,7 +225,7 @@ type * Note: File must be closed with FileClose(Handle) after usage * @seealso SysUtils.FileOpen() *} - function Open(Mode: longword): THandle; + function Open(Mode: longword): TFileHandle; {** @seealso SysUtils.ExtractFileDrive() *} function GetDrive(): IPath; @@ -340,8 +346,10 @@ type *} function FileSearch(const DirList: IPath): IPath; - {** File must be closed with FileClose(Handle) after usage } - function CreateFile(): THandle; + {** + * File must be closed with FileClose(Handle) after usage + *} + function CreateFile(): TFileHandle; function DeleteFile(): boolean; function CreateDirectory(Force: boolean = false): boolean; function DeleteEmptyDir(): boolean; @@ -493,7 +501,7 @@ type function ToWide(UseNativeDelim: boolean): WideString; function ToNative(): RawByteString; - function Open(Mode: longword): THandle; + function Open(Mode: longword): TFileHandle; function GetDrive(): IPath; function GetPath(): IPath; @@ -541,7 +549,7 @@ type function FileSearch(const DirList: IPath): IPath; - function CreateFile(): THandle; + function CreateFile(): TFileHandle; function DeleteFile(): boolean; function CreateDirectory(Force: boolean): boolean; function DeleteEmptyDir(): boolean; @@ -964,7 +972,7 @@ begin Result := FileSystem.ExcludeTrailingPathDelimiter(Self); end; -function TPathImpl.CreateFile(): THandle; +function TPathImpl.CreateFile(): TFileHandle; begin Result := FileSystem.FileCreate(Self); end; @@ -977,7 +985,7 @@ begin Result := FileSystem.DirectoryCreate(Self); end; -function TPathImpl.Open(Mode: longword): THandle; +function TPathImpl.Open(Mode: longword): TFileHandle; begin Result := FileSystem.FileOpen(Self, Mode); end; -- cgit v1.2.3 From ec49bde7e1919e5a460c05903b6ccafc00be0455 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 19 Apr 2010 21:40:23 +0000 Subject: bugfix for crash with portaudio (all platforms): - UAudioInput_Portaudio: UnifyDeviceNames was called with the wrong index further changes: - BASS input source-names seem to be encoded with local encoding and are converted to UTF8 - Portaudio source and device names encoding is auto-detected and converted to UTF8 - some clean-up git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2252 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index c4612adb..09ac92de 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -95,7 +95,7 @@ const type TAudioInputSource = record - Name: string; + Name: UTF8String; end; // soundcard input-devices information @@ -745,7 +745,7 @@ function TAudioInputBase.UnifyDeviceName(const name: UTF8String; deviceIndex: in var count: integer; // count of devices with this name - function IsDuplicate(const name: string): boolean; + function IsDuplicate(const name: UTF8String): boolean; var i: integer; begin @@ -754,11 +754,13 @@ var for i := 0 to deviceIndex-1 do begin if (AudioInputProcessor.DeviceList[i] <> nil) then - if (AudioInputProcessor.DeviceList[i].Name = name) then - begin - Result := true; - Break; - end; + begin + if (AudioInputProcessor.DeviceList[i].Name = name) then + begin + Result := true; + Break; + end; + end; end; end; -- cgit v1.2.3 From 39cff2441c45040c9260a6f5eba5b8debd66604e Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 20 Apr 2010 18:58:10 +0000 Subject: do not handle txt file format errors that strict git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2253 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index 597bcb46..a441fe40 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -377,19 +377,20 @@ var begin OldLinePos := LinePos; Str := ParseLyricStringParam(Line, LinePos); - if (Length(Str) <> 1) then + + if (Length(Str) < 1) then begin - { to-do : decide what to do here - usdx < 1.1 does not nead a whitespace after a char param - so we may just write a warning to error.log and use the - first non whitespace character instead of raising an - exception that causes the song not to load. So the more - error resistant code is: - LinePos := OldLinePos + 1; - // raise EUSDXParseException.Create('Character expected'); } LinePos := OldLinePos; raise EUSDXParseException.Create('Character expected'); + end + else if (Length(Str) > 1) then + begin + Log.LogWarn(Format('"%s" in line %d: %s', + [FileName.ToNative, FileLineNo, 'character expected but found "' + Str + '"']), + 'TSong.ParseLyricCharParam'); end; + + LinePos := OldLinePos + 1; Result := Str[1]; end; -- cgit v1.2.3 From 868ce765441473e7d1fec9b3ad22a707f121a637 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 21 Apr 2010 18:27:36 +0000 Subject: - add video loop option - allow multiple instances of a video git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2260 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 39 +++++++++++++++++++++++++-------------- 1 file changed, 25 insertions(+), 14 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 5d816c9a..e349bd1f 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -324,28 +324,33 @@ type IGenericPlayback = Interface ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] function GetName: String; + end; - function Open(const Filename: IPath): boolean; // true if succeed - procedure Close; - + IVideo = interface + ['{58DFC674-9168-41EA-B59D-A61307242B80}'] procedure Play; procedure Pause; procedure Stop; + procedure SetLoop(Enable: boolean); + function GetLoop(): boolean; + procedure SetPosition(Time: real); function GetPosition: real; + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + + property Loop: boolean read GetLoop write SetLoop; property Position: real read GetPosition write SetPosition; end; IVideoPlayback = Interface( IGenericPlayback ) ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] - function Init(): boolean; - function Finalize: boolean; - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC + function Init(): boolean; + function Finalize: boolean; + function Open(const FileName : IPath): IVideo; end; IVideoVisualization = Interface( IVideoPlayback ) @@ -370,6 +375,18 @@ type function Finished: boolean; function Length: real; + function Open(const Filename: IPath): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + property Position: real read GetPosition write SetPosition; + // Sounds // TODO: // add a TMediaDummyPlaybackStream implementation that will @@ -814,12 +831,6 @@ begin if (AudioInput <> nil) then AudioInput.CaptureStop; - if (VideoPlayback <> nil) then - VideoPlayback.Close; - - if (Visualization <> nil) then - Visualization.Close; - UnloadMediaModules(); end; -- cgit v1.2.3 From 8be69a4b6a53c84e0e19c7c0ec8dde9a96f03bc0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 21 Apr 2010 18:45:47 +0000 Subject: - better lyric <-> video sync - fixed glTexEnv() bug: GL_TEXTURE_2D is not valid here - pixel buffer test - some cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2261 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 10 ++++++++++ 1 file changed, 10 insertions(+) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 2b9a16fe..33e862f2 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -206,6 +206,10 @@ var // textures for software mouse cursor Tex_Cursor_Unpressed: TTexture; Tex_Cursor_Pressed: TTexture; + + + PboSupported: boolean; + const Skin_BGColorR = 1; Skin_BGColorG = 1; @@ -461,6 +465,12 @@ begin // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here // ... //Load_GL_EXT_framebuffer_object(); + + // PBO functions are loaded with VBO + //PboSupported := Load_GL_ARB_pixel_buffer_object() + // and Load_GL_ARB_vertex_buffer_object(); + //Log.LogWarn('PBOSupported: ' + BoolToStr(PboSupported, true), 'LoadOpenGLExtensions'); + PboSupported := false; end; const -- cgit v1.2.3 From fa2da67af8cd9acda89bc5f1fe008c5c8160055e Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 21 Apr 2010 20:26:46 +0000 Subject: improved audio synching with lyrics as master clock git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2264 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 74 ++++++++++++++++++++++++++++++++++------------------- 1 file changed, 47 insertions(+), 27 deletions(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index e349bd1f..03d20740 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -250,8 +250,8 @@ type TAudioPlaybackStream = class(TAudioProcessingStream) protected + AvgSyncDiff: double; //** average difference between stream and sync clock SyncSource: TSyncSource; - AvgSyncDiff: double; SourceStream: TAudioSourceStream; function GetLatency(): double; virtual; abstract; @@ -260,7 +260,7 @@ type procedure SetVolume(Volume: single); virtual; abstract; function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); - public + public (** * Opens a SourceStream for playback. * Note that the caller (not the TAudioPlaybackStream) is responsible to @@ -995,6 +995,8 @@ begin AvgSyncDiff := -1; end; +{.$DEFINE LOG_SYNC} + (* * Results an adjusted size of the input buffer size to keep the stream in sync * with the SyncSource. If no SyncSource was assigned to this stream, the @@ -1011,11 +1013,15 @@ end; function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; var TimeDiff: double; - TimeCorrectionFactor: double; + FrameDiff: double; + FrameSkip: integer; + ReqFrames: integer; + MasterClock: real; + CurPosition: real; const - AVG_HISTORY_FACTOR = 0.9; - SYNC_THRESHOLD = 0.045; - MAX_SYNC_DIFF_TIME = 0.002; + AVG_HISTORY_FACTOR = 0.7; + SYNC_REPOS_THRESHOLD = 5.000; + SYNC_SOFT_THRESHOLD = 0.010; begin Result := BufferSize; @@ -1025,9 +1031,12 @@ begin if (BufferSize <= 0) then Exit; + CurPosition := Position; + MasterClock := SyncSource.GetClock(); + // difference between sync-source and stream position // (negative if the music-stream's position is ahead of the master clock) - TimeDiff := SyncSource.GetClock() - (Position - GetLatency()); + TimeDiff := MasterClock - CurPosition; // calculate average time difference (some sort of weighted mean). // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. @@ -1042,35 +1051,46 @@ begin AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + AvgSyncDiff * AVG_HISTORY_FACTOR; - // check if sync needed - if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then + {$IFDEF LOG_SYNC} + //Log.LogError(Format('c:%.3f | p:%.3f | d:%.3f | a:%.3f', + // [MasterClock, CurPosition, TimeDiff, AvgSyncDiff]), 'Synch'); + {$ENDIF} + + // check if we are out of sync + if (Abs(AvgSyncDiff) >= SYNC_REPOS_THRESHOLD) then begin - // TODO: use SetPosition if diff is too large (>5s) - if (TimeDiff < 1) then - TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff - else - TimeCorrectionFactor := TimeDiff; - - // calculate adapted buffer size - // reduce size of data to fetch if music is ahead, increase otherwise - Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize; + {$IFDEF LOG_SYNC} + Log.LogError(Format('ReposSynch: %.3f > %.3f', + [Abs(AvgSyncDiff), SYNC_REPOS_THRESHOLD]), 'Synch'); + {$ENDIF} + + // diff far is too large -> reposition stream + // (resulting position might still be out of sync) + SetPosition(CurPosition + AvgSyncDiff); + + // reset sync info + AvgSyncDiff := -1; + end + else if (Abs(AvgSyncDiff) >= SYNC_SOFT_THRESHOLD) then + begin + {$IFDEF LOG_SYNC} + Log.LogError(Format('SoftSynch: %.3f > %.3f', + [Abs(AvgSyncDiff), SYNC_SOFT_THRESHOLD]), 'Synch'); + {$ENDIF} + + // hard sync: directly jump to the current position + FrameSkip := Round(AvgSyncDiff * FormatInfo.SampleRate); + Result := BufferSize + FrameSkip * FormatInfo.FrameSize; if (Result < 0) then Result := 0; - // reset average + // reset sync info AvgSyncDiff := -1; end; - - (* - DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) + - '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) + - '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) + - '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3)); - *) end; (* - * Fills a buffer with copies of the given frame or with 0 if frame. + * Fills a buffer with copies of the given Frame or with 0 if Frame is nil. *) procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); var -- cgit v1.2.3 From dc3c42586733e84bc5d92c037f837f5a83e96bd9 Mon Sep 17 00:00:00 2001 From: tobigun Date: Wed, 21 Apr 2010 23:58:40 +0000 Subject: - cleanup - made TSortingType an enum git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2271 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCatCovers.pas | 7 ++++--- src/base/UIni.pas | 19 ++++++++++++------- src/base/USongs.pas | 10 +++++----- 3 files changed, 21 insertions(+), 15 deletions(-) (limited to 'src/base') diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index d33bbbe1..433763d8 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -92,6 +92,7 @@ var Ini: TMemIniFile; List: TStringlist; I, J: Integer; + SortType: TSortingType; Filename: IPath; Name, TmpName: UTF8String; CatCover: IPath; @@ -131,12 +132,12 @@ begin Filename := CoversPath.Append(FileInfo.Name); Name := FileInfo.Name.SetExtension('').ToUTF8; - for I := 0 to high(ISorting) do + for SortType := Low(TSortingType) to High(TSortingType) do begin TmpName := Name; - if (I = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then + if (SortType = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5) - else if (I = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then + else if (SortType = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6); if not CoverExists(I, TmpName) then diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 36c3cce0..6b93d7ba 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -171,6 +171,10 @@ var ITheme: TUTF8StringDynArray; ISkin: TUTF8StringDynArray; +{* + * Options + *} + const IPlayers: array[0..4] of UTF8String = ('1', '2', '3', '4', '6'); IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 ); @@ -178,15 +182,12 @@ const IDifficulty: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); ITabs: array[0..1] of UTF8String = ('Off', 'On'); +const ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sArtist2 = 6; +type + TSortingType = (sEdition, sGenre, sLanguage, sFolder, sTitle, sArtist, sArtist2); +const IDebug: array[0..1] of UTF8String = ('Off', 'On'); IScreens: array[0..1] of UTF8String = ('1', '2'); @@ -256,6 +257,10 @@ const IChannelPlayer: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6'); IMicBoost: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB'); +{* + * Translated options + *} + var ILanguageTranslated: array of UTF8String; diff --git a/src/base/USongs.pas b/src/base/USongs.pas index baeec13a..0056d75b 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -61,6 +61,7 @@ uses {$ENDIF} UPath, USong, + UIni, UCatCovers; type @@ -111,7 +112,7 @@ type procedure BrowseDir(Dir: IPath); // should return number of songs in the future procedure BrowseTXTFiles(Dir: IPath); procedure BrowseXMLFiles(Dir: IPath); - procedure Sort(Order: integer); + procedure Sort(Order: TSortingType); property Processing: boolean read fProcessing; end; @@ -162,7 +163,6 @@ uses UFiles, UGraphic, UMain, - UIni, UPathUtils, UNote, UFilesystem, @@ -394,7 +394,7 @@ begin Result := UTF8CompareText(TSong(Song1).Language, TSong(Song2).Language); end; -procedure TSongs.Sort(Order: integer); +procedure TSongs.Sort(Order: TSortingType); var CompareFunc: TListSortCompare; begin @@ -428,7 +428,7 @@ end; procedure TCatSongs.SortSongs(); begin - case Ini.Sorting of + case TSortingType(Ini.Sorting) of sEdition: begin Songs.Sort(sTitle); Songs.Sort(sArtist); @@ -528,7 +528,7 @@ begin // if tabs are on, add section buttons for each new section if (Ini.Tabs = 1) then begin - case (Ini.Sorting) of + case (TSortingType(Ini.Sorting)) of sEdition: begin if (CompareText(CurCategory, CurSong.Edition) <> 0) then begin -- cgit v1.2.3 From 776e4ffb42b0cc5f32c2dcc54745a3537e3bcc15 Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 22 Apr 2010 00:43:55 +0000 Subject: fixed regression of last commit - now all catcover accesses are type-safe git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2272 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCatCovers.pas | 32 ++++++++++++++++---------------- src/base/USongs.pas | 2 +- 2 files changed, 17 insertions(+), 17 deletions(-) (limited to 'src/base') diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index 433763d8..55f07daf 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -44,15 +44,15 @@ uses type TCatCovers = class protected - cNames: array [0..high(ISorting)] of array of UTF8String; - cFiles: array [0..high(ISorting)] of array of IPath; + cNames: array [TSortingType] of array of UTF8String; + cFiles: array [TSortingType] of array of IPath; public constructor Create; procedure Load; //Load Cover aus Cover.ini and Cover Folder procedure LoadPath(const CoversPath: IPath); - procedure Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); //Add a Cover - function CoverExists(Sorting: integer; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists - function GetCover(Sorting: integer; const Name: UTF8String): IPath; //Returns the Filename of a Cover + procedure Add(Sorting: TSortingType; const Name: UTF8String; const Filename: IPath); //Add a Cover + function CoverExists(Sorting: TSortingType; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists + function GetCover(Sorting: TSortingType; const Name: UTF8String): IPath; //Returns the Filename of a Cover end; var @@ -91,7 +91,7 @@ procedure TCatCovers.LoadPath(const CoversPath: IPath); var Ini: TMemIniFile; List: TStringlist; - I, J: Integer; + I: Integer; SortType: TSortingType; Filename: IPath; Name, TmpName: UTF8String; @@ -107,14 +107,14 @@ begin List := TStringlist.Create; //Add every Cover in Covers Ini for Every Sorting option - for I := 0 to High(ISorting) do + for SortType := Low(TSortingType) to High(TSortingType) do begin - Ini.ReadSection(ISorting[I], List); + Ini.ReadSection(ISorting[Ord(SortType)], List); - for J := 0 to List.Count - 1 do + for I := 0 to List.Count - 1 do begin - CatCover := Path(Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); - Add(I, List.Strings[J], CoversPath.Append(CatCover)); + CatCover := Path(Ini.ReadString(ISorting[Ord(SortType)], List.Strings[I], 'NoCover.jpg')); + Add(SortType, List.Strings[I], CoversPath.Append(CatCover)); end; end; finally @@ -140,14 +140,14 @@ begin else if (SortType = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6); - if not CoverExists(I, TmpName) then - Add(I, TmpName, Filename); + if not CoverExists(SortType, TmpName) then + Add(SortType, TmpName, Filename); end; end; end; //Add a Cover -procedure TCatCovers.Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); +procedure TCatCovers.Add(Sorting: TSortingType; const Name: UTF8String; const Filename: IPath); begin if Filename.IsFile then //If Exists -> Add begin @@ -160,7 +160,7 @@ begin end; //Returns True when a cover with the given Name exists -function TCatCovers.CoverExists(Sorting: integer; const Name: UTF8String): boolean; +function TCatCovers.CoverExists(Sorting: TSortingType; const Name: UTF8String): boolean; var I: Integer; UpperName: UTF8String; @@ -179,7 +179,7 @@ begin end; //Returns the Filename of a Cover -function TCatCovers.GetCover(Sorting: integer; const Name: UTF8String): IPath; +function TCatCovers.GetCover(Sorting: TSortingType; const Name: UTF8String): IPath; var I: Integer; UpperName: UTF8String; diff --git a/src/base/USongs.pas b/src/base/USongs.pas index 0056d75b..cfc32a99 100644 --- a/src/base/USongs.pas +++ b/src/base/USongs.pas @@ -486,7 +486,7 @@ var Song[CatIndex].Main := true; Song[CatIndex].OrderTyp := 0; Song[CatIndex].OrderNum := Order; - Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); + Song[CatIndex].Cover := CatCovers.GetCover(TSortingType(Ini.Sorting), CategoryName); Song[CatIndex].Visible := true; // set number of songs in previous category -- cgit v1.2.3 From edfc692c991e08af0163aa6812e5972478d7191b Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 22 Apr 2010 01:04:24 +0000 Subject: - now it is possible to sync lyrics to audio - ini option SyncTo added - lyric to audio is default now (instead of sync audio to lyrics) - modified RelativeTimer (hopefully easier to use and more self-explanatory) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2273 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UBeatTimer.pas | 159 +++++++++++++++++++++++++++++++++++++++++++----- src/base/UIni.pas | 22 ++++++- src/base/UMusic.pas | 4 -- src/base/UTime.pas | 158 ++++++++++++++++++++++++++++------------------- 4 files changed, 262 insertions(+), 81 deletions(-) (limited to 'src/base') diff --git a/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas index 310a49cd..bc03de76 100644 --- a/src/base/UBeatTimer.pas +++ b/src/base/UBeatTimer.pas @@ -43,7 +43,15 @@ type *) TLyricsState = class private - Timer: TRelativeTimer; // keeps track of the current time + fTimer: TRelativeTimer; // keeps track of the current time + fSyncSource: TSyncSource; + fAvgSyncDiff: real; + fLastClock: real; // last master clock value + // Note: do not use Timer.GetState() to check if lyrics are paused as + // Timer.Pause() is used for synching. + fPaused: boolean; + + function Synchronize(LyricTime: real): real; public OldBeat: integer; // previous discovered beat CurrentBeat: integer; // current beat (rounded) @@ -68,28 +76,61 @@ type TotalTime: real; // total song time constructor Create(); - procedure Pause(); - procedure Resume(); + {** + * Resets the LyricsState state. + *} procedure Reset(); + procedure UpdateBeats(); + {** + * Sets a master clock for this LyricsState. If no sync-source is set + * or SyncSource is nil the internal timer is used. + *} + procedure SetSyncSource(SyncSource: TSyncSource); + + {** + * Starts the timer. This is either done + * - immediately if WaitForTrigger is false or + * - after the first call to GetCurrentTime()/SetCurrentTime() or Start(false) + *} + procedure Start(WaitForTrigger: boolean = false); + + {** + * Pauses the timer. + * The counter is preserved and can be resumed by a call to Start(). + *} + procedure Pause(); + + {** + * Stops the timer. + * The counter is reset to 0. + *} + procedure Stop(); + (** - * current song time (in seconds) used as base-timer for lyrics etc. + * Returns/Sets the current song time (in seconds) used as base-timer for lyrics etc. + * If GetCurrentTime()/SetCurrentTime() if Start() was called *) function GetCurrentTime(): real; procedure SetCurrentTime(Time: real); end; implementation -uses UNote, Math; + +uses + UNote, + ULog, + SysUtils, + Math; constructor TLyricsState.Create(); begin // create a triggered timer, so we can Pause() it, set the time // and Resume() it afterwards for better synching. - Timer := TRelativeTimer.Create(true); + fTimer := TRelativeTimer.Create(); // reset state Reset(); @@ -97,24 +138,110 @@ end; procedure TLyricsState.Pause(); begin - Timer.Pause(); + fTimer.Pause(); + fPaused := true; end; -procedure TLyricsState.Resume(); +procedure TLyricsState.Start(WaitForTrigger: boolean); begin - Timer.Resume(); + fTimer.Start(WaitForTrigger); + fPaused := false; + fLastClock := -1; + fAvgSyncDiff := -1; +end; + +procedure TLyricsState.Stop(); +begin + fTimer.Stop(); + fPaused := false; end; procedure TLyricsState.SetCurrentTime(Time: real); begin - // do not start the timer (if not started already), - // after setting the current time - Timer.SetTime(Time, false); + fTimer.SetTime(Time); + fLastClock := -1; + fAvgSyncDiff := -1; end; +{.$DEFINE LOG_SYNC} + +function TLyricsState.Synchronize(LyricTime: real): real; +var + MasterClock: real; + TimeDiff: real; +const + AVG_HISTORY_FACTOR = 0.7; + PAUSE_THRESHOLD = 0.010; // 10ms + FORWARD_THRESHOLD = 0.010; // 10ms +begin + MasterClock := fSyncSource.GetClock(); + Result := LyricTime; + + // do not sync if lyrics are paused externally or if the timestamp is old + if (fPaused or (MasterClock = fLastClock)) then + Exit; + + // calculate average time difference (some sort of weighted mean). + // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. + // This is done as some timestamps might be wrong or even lower + // than their predecessor. + TimeDiff := MasterClock - LyricTime; + if (fAvgSyncDiff = -1) then + fAvgSyncDiff := TimeDiff + else + fAvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + + fAvgSyncDiff * AVG_HISTORY_FACTOR; + + {$IFDEF LOG_SYNC} + //Log.LogError(Format('TimeDiff: %.3f', [TimeDiff])); + {$ENDIF} + + // do not go backwards in time as this could mess up the score + if (fAvgSyncDiff > FORWARD_THRESHOLD) then + begin + {$IFDEF LOG_SYNC} + Log.LogError('Sync: ' + floatToStr(MasterClock) + ' > ' + floatToStr(LyricTime)); + {$ENDIF} + + Result := LyricTime + fAvgSyncDiff; + fTimer.SetTime(Result); + fTimer.Start(); + fAvgSyncDiff := -1; + end + else if (fAvgSyncDiff < -PAUSE_THRESHOLD) then + begin + // wait until timer and master clock are in sync (> 10ms) + fTimer.Pause(); + + {$IFDEF LOG_SYNC} + Log.LogError('Pause: ' + floatToStr(MasterClock) + ' < ' + floatToStr(LyricTime)); + {$ENDIF} + end + else if (fTimer.GetState = rtsPaused) and (fAvgSyncDiff >= 0) then + begin + fTimer.Start(); + + {$IFDEF LOG_SYNC} + Log.LogError('Unpause: ' + floatToStr(LyricTime)); + {$ENDIF} + end; + fLastClock := MasterClock; +end; + function TLyricsState.GetCurrentTime(): real; +var + LyricTime: real; +begin + LyricTime := fTimer.GetTime(); + if Assigned(fSyncSource) then + Result := Synchronize(LyricTime) + else + Result := LyricTime; +end; + +procedure TLyricsState.SetSyncSource(SyncSource: TSyncSource); begin - Result := Timer.GetTime(); + fSyncSource := SyncSource; end; (** @@ -124,8 +251,10 @@ end; *) procedure TLyricsState.Reset(); begin - Pause(); - SetCurrentTime(0); + Stop(); + fPaused := false; + + fSyncSource := nil; StartTime := 0; TotalTime := 0; diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 6b93d7ba..d809c790 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -127,6 +127,8 @@ type AudioOutputBufferSizeIndex: integer; VoicePassthrough: integer; + SyncTo: integer; + //Song Preview PreviewVolume: integer; PreviewFading: integer; @@ -218,6 +220,12 @@ const IVoicePassthrough: array[0..1] of UTF8String = ('Off', 'On'); +const + ISyncTo: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off'); +type + TSyncToType = (stMusic, stLyrics, stOff); + +const IAudioOutputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536'); IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 ); @@ -290,6 +298,8 @@ var IVoicePassthroughTranslated: array[0..1] of UTF8String = ('Off', 'On'); + ISyncToTranslated: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off'); + //Song Preview IPreviewVolumeTranslated: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); @@ -413,6 +423,10 @@ begin IVoicePassthroughTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); IVoicePassthroughTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + ISyncToTranslated[Ord(stMusic)] := ULanguage.Language.Translate('OPTION_VALUE_MUSIC'); + ISyncToTranslated[Ord(stLyrics)] := ULanguage.Language.Translate('OPTION_VALUE_LYRICS'); + ISyncToTranslated[Ord(stOff)] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN'); ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1'); ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2'); @@ -881,7 +895,7 @@ begin TabsAtStartup := Tabs; //Tabs at Startup fix // Song Sorting - Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0])); + Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[Ord(sEdition)])); // Debug Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); @@ -974,6 +988,9 @@ begin // PartyPopup PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); + // SyncTo + SyncTo := GetArrayIndex(ISyncTo, IniFile.ReadString('Advanced', 'SyncTo', ISyncTo[Ord(stMusic)])); + // Joypad Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); @@ -1115,6 +1132,9 @@ begin //Party Popup IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]); + //SyncTo + IniFile.WriteString('Advanced', 'SyncTo', ISyncTo[SyncTo]); + // Joypad IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 03d20740..7f2b3e30 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -188,10 +188,6 @@ type end; type - TSyncSource = class - function GetClock(): real; virtual; abstract; - end; - TAudioProcessingStream = class; TOnCloseHandler = procedure(Stream: TAudioProcessingStream); diff --git a/src/base/UTime.pas b/src/base/UTime.pas index 83844cb5..0610ef59 100644 --- a/src/base/UTime.pas +++ b/src/base/UTime.pas @@ -40,20 +40,26 @@ type function GetTime(): real; end; + TRelativeTimerState = (rtsStopped, rtsWait, rtsPaused, rtsRunning); + TRelativeTimer = class private AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime - RelativeTimeOffset: real; - Paused: boolean; + RelativeTime: real; TriggerMode: boolean; + State: TRelativeTimerState; public - constructor Create(TriggerMode: boolean = false); + constructor Create(); + procedure Start(WaitForTrigger: boolean = false); procedure Pause(); - procedure Resume(); + procedure Stop(); function GetTime(): real; - function GetAndResetTime(): real; - procedure SetTime(Time: real; Trigger: boolean = true); - procedure Reset(); + procedure SetTime(Time: real); + function GetState(): TRelativeTimerState; + end; + + TSyncSource = class + function GetClock(): real; virtual; abstract; end; procedure CountSkipTimeSet; @@ -126,85 +132,115 @@ end; * TRelativeTimer **} -(* - * creates a new timer. - * if triggermode is false (default), the timer - * will immediately begin with counting. - * if triggermode is true, it will wait until get/settime() or pause() is called - * for the first time. +(** + * Creates a new relative timer. + * A relative timer works like a stop-watch. It can be paused and + * resumed afterwards, continuing with the counter it had when it was paused. *) -constructor TRelativeTimer.Create(TriggerMode: boolean); +constructor TRelativeTimer.Create(); begin - inherited Create(); - Self.TriggerMode := TriggerMode; - Reset(); - Paused := false; + State := rtsStopped; + AbsoluteTime := 0; + RelativeTime := 0; end; -procedure TRelativeTimer.Pause(); +(** + * Starts the timer. + * If WaitForTrigger is false the timer will be started immediately. + * If WaitForTrigger is true the timer will be started when a trigger event + * occurs. A trigger event is a call of one of the Get-/SetTime() methods. + * In addition the timer can be started by calling this method again with + * WaitForTrigger set to false. + *) +procedure TRelativeTimer.Start(WaitForTrigger: boolean = false); begin - RelativeTimeOffset := GetTime(); - Paused := true; + case (State) of + rtsStopped, rtsPaused: begin + if (WaitForTrigger) then + begin + State := rtsWait; + end + else + begin + State := rtsRunning; + AbsoluteTime := SDL_GetTicks(); + end; + end; + + rtsWait: begin + if (not WaitForTrigger) then + begin + State := rtsRunning; + AbsoluteTime := SDL_GetTicks(); + RelativeTime := 0; + end; + end; + end; end; -procedure TRelativeTimer.Resume(); +(** + * Pauses the timer and leaves the counter untouched. + *) +procedure TRelativeTimer.Pause(); begin - AbsoluteTime := SDL_GetTicks(); - Paused := false; + if (State = rtsRunning) then + begin + // Important: GetTime() must be called in running state + RelativeTime := GetTime(); + State := rtsPaused; + end; end; -(* - * Returns the counter of the timer. - * If in TriggerMode it will return 0 and start the counter on the first call. +(** + * Stops the timer and sets its counter to 0. *) -function TRelativeTimer.GetTime: real; +procedure TRelativeTimer.Stop(); begin - // initialize absolute time on first call in triggered mode - if (TriggerMode and (AbsoluteTime = 0)) then + if (State <> rtsStopped) then begin - AbsoluteTime := SDL_GetTicks(); - Result := RelativeTimeOffset; - Exit; + State := rtsStopped; + RelativeTime := 0; end; - - if Paused then - Result := RelativeTimeOffset - else - Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio; end; -(* - * Returns the counter of the timer and resets the counter to 0 afterwards. - * Note: In TriggerMode the counter will not be stopped as with Reset(). +(** + * Returns the current counter of the timer. + * If WaitForTrigger was true in Start() the timer will be started + * if it was not already running. *) -function TRelativeTimer.GetAndResetTime(): real; +function TRelativeTimer.GetTime(): real; begin - Result := GetTime(); - SetTime(0); + case (State) of + rtsStopped, rtsPaused: + Result := RelativeTime; + rtsRunning: + Result := RelativeTime + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio; + rtsWait: begin + // start triggered + State := rtsRunning; + AbsoluteTime := SDL_GetTicks(); + Result := RelativeTime; + end; + end; end; -(* - * Sets the timer to the given time. This will trigger in TriggerMode if - * Trigger is set to true. Otherwise the counter's state will not change. +(** + * Sets the counter of the timer. + * If WaitForTrigger was true in Start() the timer will be started + * if it was not already running. *) -procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean); +procedure TRelativeTimer.SetTime(Time: real); begin - RelativeTimeOffset := Time; - if ((not TriggerMode) or Trigger) then - AbsoluteTime := SDL_GetTicks(); + RelativeTime := Time; + AbsoluteTime := SDL_GetTicks(); + // start triggered + if (State = rtsWait) then + State := rtsRunning; end; -(* - * Resets the counter of the timer to 0. - * If in TriggerMode the timer will not start counting until it is triggered again. - *) -procedure TRelativeTimer.Reset(); +function TRelativeTimer.GetState(): TRelativeTimerState; begin - RelativeTimeOffset := 0; - if (TriggerMode) then - AbsoluteTime := 0 - else - AbsoluteTime := SDL_GetTicks(); + Result := State; end; end. -- cgit v1.2.3 From d7f333d3b729b61eeeb70c2480afa516a1d459ff Mon Sep 17 00:00:00 2001 From: tobigun Date: Thu, 22 Apr 2010 01:16:33 +0000 Subject: TextureSize (=CachedCoverSize) default set back to 128. - a default cached cover size of 128 pixels is big enough - 256 pixels are already noticeably slow with 180 covers in the song-screen displayed at once. In additon the covers.db will be too big. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2274 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index d809c790..3ed3f3d5 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -902,8 +902,11 @@ begin LoadScreenModes(IniFile); - // TextureSize - TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[2])); + // TextureSize (aka CachedCoverSize) + // Note: a default cached cover size of 128 pixels is big enough, + // 256 pixels are already noticeably slow with 180 covers in the song-screen + // displayed at once. In additon the covers.db will be too big. + TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', '128')); // SingWindow SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); -- cgit v1.2.3 From 886be275efb6f3177e6e30791740f2bd0429e2b5 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 22 Apr 2010 11:07:24 +0000 Subject: removed old comment from the days of ultrastar.dl.am mod git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2276 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UCatCovers.pas | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas index 55f07daf..85cb850f 100644 --- a/src/base/UCatCovers.pas +++ b/src/base/UCatCovers.pas @@ -24,10 +24,6 @@ *} unit UCatCovers; -///////////////////////////////////////////////////////////////////////// -// UCatCovers by Whiteshark // -// Class for listing and managing the Category Covers // -///////////////////////////////////////////////////////////////////////// interface @@ -183,7 +179,7 @@ function TCatCovers.GetCover(Sorting: TSortingType; const Name: UTF8String): IPa var I: Integer; UpperName: UTF8String; - NoCoverPath: IPath; + NoCoverPath: IPath; begin Result := PATH_NONE; UpperName := UTF8Uppercase(Name); @@ -212,4 +208,4 @@ begin end; end; -end. +end. \ No newline at end of file -- cgit v1.2.3 From 73762f705d161b00946c454cc28b02bfdc1bcd09 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 22 Apr 2010 11:36:00 +0000 Subject: changed violet and orange color for better shades when used in theme git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2277 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UThemes.pas | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index 45e85af5..fa7a6029 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -2127,15 +2127,15 @@ begin //New Theme-Color Patch 4: begin // violet - Result.R := 230/255; - Result.G := 63/255; - Result.B := 230/255; + Result.R := 212/255; + Result.G := 71/255; + Result.B := 247/255; end; 5: begin // orange - Result.R := 255/255; + Result.R := 247/255; Result.G := 144/255; - Result.B := 0; + Result.B := 71/255; end; 6: begin // yellow -- cgit v1.2.3 From c9a13f8923d1cc8798bcb07a0808855380d083c8 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 23 Apr 2010 12:16:36 +0000 Subject: reverted revision 2278 - Auto.inc: Log.LogError is not possible as ULog is not loaded at this point -> used ConsoleWriteLn instead git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2279 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UTextEncoding.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'src/base') diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas index 148cd5d4..0c9ba4cc 100644 --- a/src/base/UTextEncoding.pas +++ b/src/base/UTextEncoding.pas @@ -92,6 +92,7 @@ implementation uses StrUtils, pcre, + UCommon, ULog; type -- cgit v1.2.3 From 69cf82185e7f559d8858b44fa76379c771acc6b6 Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 23 Apr 2010 22:39:26 +0000 Subject: - font fallback added - more configurable fonts.ini - ftNormal/ftBold/ftOutline1/2 added git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2293 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 104 +++++++++++---- src/base/UFont.pas | 335 ++++++++++++++++++++++++++++++++++------------- src/base/USingScores.pas | 2 +- src/base/UThemes.pas | 3 +- 4 files changed, 326 insertions(+), 118 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 7fe98d29..0f4159d6 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -47,9 +47,16 @@ type PGLFont = ^TGLFont; TGLFont = record Font: TScalableFont; + Outlined: boolean; X, Y, Z: real; end; +const + ftNormal = 0; + ftBold = 1; + ftOutline1 = 2; + ftOutline2 = 3; + var Fonts: array of TGLFont; ActFont: integer; @@ -76,50 +83,93 @@ uses UMain, UPathUtils; -function FindFontFile(FontIni: TCustomIniFile; Font: string): IPath; -var - Filename: IPath; +{** + * Returns either Filename if it is absolute or a path relative to FontPath. + *} +function FindFontFile(const Filename: string): IPath; begin - Filename := Path(FontIni.ReadString(Font, 'File', '')); Result := FontPath.Append(Filename); // if path does not exist, try as an absolute path if (not Result.IsFile) then - Result := Filename; + Result := Path(Filename); +end; + +procedure AddFontFallbacks(FontIni: TMemIniFile; Font: TFont); +var + FallbackFont: IPath; + IdentName: string; + I: Integer; +begin + // evaluate the ini-file's 'Fallbacks' section + for I := 1 to 10 do + begin + IdentName := 'File' + IntToStr(I); + FallbackFont := FindFontFile(FontIni.ReadString('Fallbacks', IdentName, '')); + if (FallbackFont.Equals(PATH_NONE)) then + Continue; + try + Font.AddFallback(FallbackFont); + except + on E: EFontError do + Log.LogError('Setting font fallback ''' + FallbackFont.ToNative() + ''' failed: ' + E.Message); + end; + end; end; +const + FONT_NAMES: array [0..3] of string = ( + 'Normal', 'Bold', 'Outline1', 'Outline2' + ); + procedure BuildFont; var + I: integer; FontIni: TMemIniFile; FontFile: IPath; + Outline: single; + Embolden: single; + OutlineFont: TFTScalableOutlineFont; begin ActFont := 0; - SetLength(Fonts, 4); + SetLength(Fonts, Length(FONT_NAMES)); FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative); try - - // Normal - FontFile := FindFontFile(FontIni, 'Normal'); - Fonts[0].Font := TFTScalableFont.Create(FontFile, 64); - //Fonts[0].Font.GlyphSpacing := 1.4; - //Fonts[0].Font.Aspect := 1.2; - - // Bold - FontFile := FindFontFile(FontIni, 'Bold'); - Fonts[1].Font := TFTScalableFont.Create(FontFile, 64); - - // Outline1 - FontFile := FindFontFile(FontIni, 'Outline1'); - Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06); - //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3); - - // Outline2 - FontFile := FindFontFile(FontIni, 'Outline2'); - Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08); - + for I := 0 to High(FONT_NAMES) do + begin + FontFile := FindFontFile(FontIni.ReadString('Font_'+FONT_NAMES[I], 'File', '')); + + // create either outlined or normal font + Outline := FontIni.ReadFloat(FONT_NAMES[I], 'Outline', 0.0); + if (Outline > 0.0) then + begin + // outlined font + OutlineFont := TFTScalableOutlineFont.Create(FontFile, 64, Outline); + OutlineFont.SetOutlineColor( + FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorR', 0.0), + FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorG', 0.0), + FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorB', 0.0), + FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorA', -1.0) + ); + Fonts[I].Font := OutlineFont; + Fonts[I].Outlined := true; + end + else + begin + // normal font + Embolden := FontIni.ReadFloat(FONT_NAMES[I], 'Embolden', 0.0); + Fonts[I].Font := TFTScalableFont.Create(FontFile, 64, Embolden); + Fonts[I].Outlined := false; + end; + + Fonts[I].Font.GlyphSpacing := FontIni.ReadFloat(FONT_NAMES[I], 'GlyphSpacing', 0.0); + Fonts[I].Font.Stretch := FontIni.ReadFloat(FONT_NAMES[I], 'Stretch', 1.0); + + AddFontFallbacks(FontIni, Fonts[I].Font); + end; except - on E: Exception do + on E: EFontError do Log.LogCritical(E.Message, 'BuildFont'); end; diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 03918e3b..72b1d8d8 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -88,6 +88,8 @@ type Width, Height: integer; end; + EFontError = class(Exception); + {** * Abstract base class representing a glyph. *} @@ -119,6 +121,7 @@ type procedure ResetIntern(); protected + fFilename: IPath; fStyle: TFontStyle; fUseKerning: boolean; fLineSpacing: single; // must be inited by subclass @@ -184,7 +187,7 @@ type property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; public - constructor Create(); + constructor Create(const Filename: IPath); destructor Destroy(); override; {** @@ -213,6 +216,12 @@ type {** UTF-8 version of @link(BBox) } function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload; + {** + * Adds a new font that is used if the default font misses a glyph + * @raises EFontError if the fallback could not be initialized + *} + procedure AddFallback(const Filename: IPath); virtual; abstract; + {** Font height } property Height: single read GetHeight; {** Vertical distance from baseline to top of glyph } @@ -229,6 +238,8 @@ type property Style: TFontStyle read GetStyle write SetStyle; {** If set to true (default) kerning will be used if available } property UseKerning: boolean read GetUseKerning write SetUseKerning; + {** Filename } + property Filename: IPath read fFilename; end; const @@ -248,8 +259,8 @@ type procedure ResetIntern(); protected - fScale: single; //**< current height to base-font height ratio - fAspect: single; //**< width to height aspect + fScale: single; //**< current height to base-font height ratio + fStretch: single; //**< stretch factor for width (Width * fStretch) fBaseFont: TFont; //**< shortcut for fMipmapFonts[0] fUseMipmaps: boolean; //**< true if mipmap fonts are generated /// Mipmap fonts (size[level+1] = size[level]/2) @@ -286,8 +297,8 @@ type procedure SetHeight(Height: single); virtual; function GetHeight(): single; override; - procedure SetAspect(Aspect: single); virtual; - function GetAspect(): single; virtual; + procedure SetStretch(Stretch: single); virtual; + function GetStretch(): single; virtual; function GetAscender(): single; override; function GetDescender(): single; override; procedure SetLineSpacing(Spacing: single); override; @@ -322,8 +333,8 @@ type {** Font height } property Height: single read GetHeight write SetHeight; - {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default } - property Aspect: single read GetAspect write SetAspect; + {** Factor for font stretching (NewWidth = Width*Stretch), 1.0 by default } + property Stretch: single read GetStretch write SetStretch; end; {** @@ -423,7 +434,7 @@ type function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract; public - constructor Create(); + constructor Create(const Filename: IPath); destructor Destroy(); override; {** @@ -436,6 +447,28 @@ type TFTFont = class; + {** + * Freetype font face class. + *} + TFTFontFace = class + strict private + fFilename: IPath; //**< filename of the font-file + fFace: FT_Face; //**< Holds the height of the font + fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + + public + {** + * @raises EFontError if the glyph could not be initialized + *} + constructor Create(const Filename: IPath; Size: integer); + + destructor Destroy(); override; + + property Filename: IPath read fFilename; + property Data: FT_Face read fFace; + property FontUnitScale: TPositionDbl read fFontUnitScale; + end; + {** * Freetype glyph. * Each glyph stores a texture with the glyph's image. @@ -443,6 +476,7 @@ type TFTGlyph = class(TGlyph) private fCharCode: UCS4Char; //**< Char code + fFace: TFTFontFace; //**< Freetype face used for this glyph fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) fDisplayList: GLuint; //**< Display-list ID fTexture: GLuint; //**< Texture ID @@ -471,7 +505,7 @@ type * Creates an OpenGL texture (and display list) for the glyph. * The glyph's and bitmap's metrics are set correspondingly. * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the glyph could not be initialized + * @raises EFontError if the glyph could not be initialized *} procedure CreateTexture(LoadFlags: FT_Int32); @@ -495,9 +529,13 @@ type {** Freetype specific char-index (<> char-code) } property CharIndex: FT_UInt read fCharIndex; + + {** Freetype face used for this glyph } + property Face: TFTFontFace read fFace; end; TFontPart = ( fpNone, fpInner, fpOutline ); + TFTFontFaceArray = array of TFTFontFace; {** * Freetype font class. @@ -506,15 +544,14 @@ type private procedure ResetIntern(); - protected - fFilename: IPath; //**< filename of the font-file + strict protected + fFace: TFTFontFace; //**< Default font face fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) - fFace: FT_Face; //**< Holds the height of the font fLoadFlags: FT_Int32; //**< FT glpyh load-flags - fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing fPart: TFontPart; //**< indicates the part of an outline font + fFallbackFaces: TFTFontFaceArray; //**< available fallback faces, ordered by priority {** @seealso TCachedFont.LoadGlyph } function LoadGlyph(ch: UCS4Char): TGlyph; override; @@ -528,15 +565,13 @@ type function GetUnderlinePosition(): single; override; function GetUnderlineThickness(): single; override; - property Face: FT_Face read fFace; - public {** * Creates a font of size Size (in pixels) from the file Filename. * If Outset (in pixels) is set to a value > 0 the glyphs will be extruded * at their borders. Use it for e.g. a bold effect. * @param LoadFlags flags passed to FT_Load_Glyph() - * @raises Exception if the font-file could not be loaded + * @raises EFontError if the font-file could not be loaded *} constructor Create(const Filename: IPath; Size: integer; Outset: single = 0.0; @@ -549,11 +584,19 @@ type {** @seealso TFont.Reset } procedure Reset(); override; - + + procedure AddFallback(const Filename: IPath); override; + {** Size of the base font } property Size: integer read fSize; {** Outset size } property Outset: single read fOutset; + {** The part (inner/outline/none) this font represents in a composite font } + property Part: TFontPart read fPart write fPart; + {** Freetype face of this font } + property DefaultFace: TFTFontFace read fFace; + {** Available freetype fallback faces, ordered by priority } + property FallbackFaces: TFTFontFaceArray read fFallbackFaces; end; TFTScalableFont = class(TScalableFont) @@ -567,11 +610,27 @@ type * OutsetAmount is the ratio of the glyph extrusion. * The extrusion in pixels is Size*OutsetAmount * (0.0 -> no extrusion, 0.1 -> 10%). + * + * The memory size (in bytes) consumed by a scalable font + * - with UseMipmaps=false: + * mem = size^2 * #cached_glyphs + * - with UseMipmaps=true (all mipmap levels): + * mem = size^2 * #cached_glyphs * Sum[i=1..cMaxMipmapLevel](1/i^2) + * - with UseMipmaps=true (5 <= cMaxMipmapLevel <= 10): + * mem ~= size^2 * #cached_glyphs * 1.5 + * + * Examples (for 128 cached glyphs): + * - Size: 64 pixels: 768 KB (mipmapped) or 512 KB (non-mipmapped). + * - Size 128 pixels: 3 MB (mipmapped) or 2 MB (non-mipmapped) + * + * Note: once a glyph is cached there will *} constructor Create(const Filename: IPath; Size: integer; OutsetAmount: single = 0.0; UseMipmaps: boolean = true); + procedure AddFallback(const Filename: IPath); override; + {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); @@ -586,7 +645,6 @@ type *} TFTOutlineFont = class(TFont) private - fFilename: IPath; fSize: integer; fOutset: single; fInnerFont, fOutlineFont: TFTFont; @@ -628,6 +686,8 @@ type {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); + procedure AddFallback(const Filename: IPath); override; + {** @seealso TFont.Reset } procedure Reset(); override; @@ -657,6 +717,8 @@ type {** @seealso TGlyphCache.FlushCache } procedure FlushCache(KeepBaseSet: boolean); + procedure AddFallback(const Filename: IPath); override; + {** Outset size } property Outset: single read GetOutset; end; @@ -687,7 +749,7 @@ type {** * Load font widths from an info file. * @param InfoFile the name of the info (.dat) file - * @raises Exception if the file is corrupted + * @raises EFontError if the file is corrupted *} procedure LoadFontInfo(const InfoFile: IPath); @@ -721,6 +783,8 @@ type {** @seealso TFont.Reset } procedure Reset(); override; + + procedure AddFallback(const Filename: IPath); override; end; {$ENDIF BITMAP_FONT} @@ -730,7 +794,7 @@ type {** * Returns a pointer to the freetype library singleton. * If non exists, freetype will be initialized. - * @raises Exception if initialization failed + * @raises EFontError if initialization failed *} class function GetLibrary(): FT_Library; class procedure FreeLibrary(); @@ -783,9 +847,10 @@ end; * TFont *} -constructor TFont.Create(); +constructor TFont.Create(const Filename: IPath); begin - inherited; + inherited Create(); + fFilename := Filename; ResetIntern(); end; @@ -1040,7 +1105,7 @@ constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); var MipmapLevel: integer; begin - inherited Create(); + inherited Create(Font.Filename); fBaseFont := Font; fMipmapFonts[0] := Font; @@ -1072,7 +1137,7 @@ end; procedure TScalableFont.ResetIntern(); begin fScale := 1.0; - fAspect := 1.0; + fStretch := 1.0; end; procedure TScalableFont.Reset(); @@ -1088,7 +1153,7 @@ end; {** * Returns the mipmap level to use with regard to the current projection - * and modelview matrix, font scale and aspect. + * and modelview matrix, font scale and stretch. * * Note: * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise @@ -1250,7 +1315,7 @@ begin glPushMatrix(); // set scale and stretching - glScalef(fScale * fAspect, fScale, 0); + glScalef(fScale * fStretch, fScale, 0); // print text if (fUseMipmaps) then @@ -1269,8 +1334,8 @@ end; function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fBaseFont.BBox(Text, Advance); - Result.Left := Result.Left * fScale * fAspect; - Result.Right := Result.Right * fScale * fAspect; + Result.Left := Result.Left * fScale * fStretch; + Result.Right := Result.Right * fScale * fStretch; Result.Top := Result.Top * fScale; Result.Bottom := Result.Bottom * fScale; end; @@ -1285,14 +1350,14 @@ begin Result := fBaseFont.GetHeight() * fScale; end; -procedure TScalableFont.SetAspect(Aspect: single); +procedure TScalableFont.SetStretch(Stretch: single); begin - fAspect := Aspect; + fStretch := Stretch; end; -function TScalableFont.GetAspect(): single; +function TScalableFont.GetStretch(): single; begin - Result := fAspect; + Result := fStretch; end; function TScalableFont.GetAscender(): single; @@ -1385,9 +1450,9 @@ end; * TCachedFont *} -constructor TCachedFont.Create(); +constructor TCachedFont.Create(const Filename: IPath); begin - inherited; + inherited Create(Filename); fCache := TGlyphCache.Create(); end; @@ -1413,41 +1478,60 @@ begin fCache.FlushCache(KeepBaseSet); end; - {* - * TFTFont + * TFTFontFace *} -constructor TFTFont.Create( - const Filename: IPath; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -var - ch: UCS4Char; +constructor TFTFontFace.Create(const Filename: IPath; Size: integer); begin inherited Create(); fFilename := Filename; - fSize := Size; - fOutset := Outset; - fLoadFlags := LoadFlags; - fUseDisplayLists := true; - fPart := fpNone; // load font information if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then - raise Exception.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); + raise EFontError.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + ''''); // support scalable fonts only if (not FT_IS_SCALABLE(fFace)) then - raise Exception.Create('Font is not scalable'); + raise EFontError.Create('Font is not scalable'); if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then - raise Exception.Create('FT_Set_Pixel_Sizes failes'); + raise EFontError.Create('FT_Set_Pixel_Sizes failes'); // get scale factor for font-unit to pixel-size transformation fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM; fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM; +end; + +destructor TFTFontFace.Destroy(); +begin + // free face data + FT_Done_Face(fFace); + inherited; +end; + + +{* + * TFTFont + *} + +constructor TFTFont.Create( + const Filename: IPath; + Size: integer; Outset: single; + LoadFlags: FT_Int32); +var + ch: UCS4Char; +begin + inherited Create(Filename); + + fSize := Size; + fOutset := Outset; + fLoadFlags := LoadFlags; + fUseDisplayLists := true; + fPart := fpNone; + + fFace := TFTFontFace.Create(Filename, Size); ResetIntern(); @@ -1457,17 +1541,22 @@ begin end; destructor TFTFont.Destroy(); +var + I: integer; begin - // free face - FT_Done_Face(fFace); + // free faces + fFace.Free; + for I := 0 to High(fFallbackFaces) do + fFallbackFaces[I].Free; + inherited; end; procedure TFTFont.ResetIntern(); begin // Note: outset and non outset fonts use same spacing - fLineSpacing := fFace.height * fFontUnitScale.Y; - fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y; + fLineSpacing := fFace.Data.height * fFace.FontUnitScale.Y; + fReflectionSpacing := -2*fFace.Data.descender * fFace.FontUnitScale.Y; end; procedure TFTFont.Reset(); @@ -1476,6 +1565,15 @@ begin ResetIntern(); end; +procedure TFTFont.AddFallback(const Filename: IPath); +var + FontFace: TFTFontFace; +begin + FontFace := TFTFontFace.Create(Filename, Size); + SetLength(fFallbackFaces, Length(fFallbackFaces) + 1); + fFallbackFaces[High(fFallbackFaces)] := FontFace; +end; + function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph; begin Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); @@ -1520,11 +1618,11 @@ begin if (Glyph <> nil) then begin // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex, FT_KERNING_UNSCALED, KernDelta); - LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; + LineBounds.Right := LineBounds.Right + KernDelta.x * fFace.FontUnitScale.X; end; // update left bound (must be done before right bound is updated) @@ -1608,11 +1706,11 @@ begin if (Assigned(Glyph)) then begin // get kerning - if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then + if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, + FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex, FT_KERNING_UNSCALED, KernDelta); - glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); + glTranslatef(KernDelta.x * fFace.FontUnitScale.X, 0, 0); end; if (ReflectionPass) then @@ -1634,23 +1732,23 @@ end; function TFTFont.GetAscender(): single; begin - Result := fFace.ascender * fFontUnitScale.Y + Outset*2; + Result := fFace.Data.ascender * fFace.FontUnitScale.Y + Outset*2; end; function TFTFont.GetDescender(): single; begin // Note: outset is not part of the descender as the baseline is lifted - Result := fFace.descender * fFontUnitScale.Y; + Result := fFace.Data.descender * fFace.FontUnitScale.Y; end; function TFTFont.GetUnderlinePosition(): single; begin - Result := fFace.underline_position * fFontUnitScale.Y - Outset; + Result := fFace.Data.underline_position * fFace.FontUnitScale.Y - Outset; end; function TFTFont.GetUnderlineThickness(): single; begin - Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; + Result := fFace.Data.underline_thickness * fFace.FontUnitScale.Y + Outset*2; end; @@ -1689,8 +1787,8 @@ begin // do not create mipmap fonts < 8 pixels if (ScaledSize < 8) then Exit; - Result := TFTFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset * Scale, + Result := TFTFont.Create(BaseFont.Filename, + ScaledSize, BaseFont.Outset * Scale, FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); end; @@ -1699,6 +1797,15 @@ begin Result := TFTFont(fBaseFont).Outset * fScale; end; +procedure TFTScalableFont.AddFallback(const Filename: IPath); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTFont(fMipmapFonts[Level]).AddFallback(Filename); +end; + procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); var Level: integer; @@ -1718,16 +1825,15 @@ constructor TFTOutlineFont.Create( Size: integer; Outset: single; LoadFlags: FT_Int32); begin - inherited Create(); + inherited Create(Filename); - fFilename := Filename; fSize := Size; fOutset := Outset; fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); - fInnerFont.fPart := fpInner; + fInnerFont.Part := fpInner; fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); - fOutlineFont.fPart := fpOutline; + fOutlineFont.Part := fpOutline; ResetIntern(); end; @@ -1824,6 +1930,12 @@ begin fInnerFont.FlushCache(KeepBaseSet); end; +procedure TFTOutlineFont.AddFallback(const Filename: IPath); +begin + fOutlineFont.AddFallback(Filename); + fInnerFont.AddFallback(Filename); +end; + function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; begin Result := fOutlineFont.BBox(Text, Advance); @@ -1960,6 +2072,15 @@ begin TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); end; +procedure TFTScalableOutlineFont.AddFallback(const Filename: IPath); +var + Level: integer; +begin + for Level := 0 to High(fMipmapFonts) do + if (fMipmapFonts[Level] <> nil) then + TFTOutlineFont(fMipmapFonts[Level]).AddFallback(Filename); +end; + {* * TFTGlyph @@ -2019,10 +2140,16 @@ begin // The second one is used as a stencil for the first one, clearing the // interiour of the glyph. // The stencil is not needed to create bold fonts. - UseStencil := (fFont.fPart = fpInner); + UseStencil := (fFont.Part = fpInner); - Outline := @FT_OutlineGlyph(Glyph).outline; + // we cannot extrude bitmaps, only vector based glyphs. + // Check for FT_GLYPH_FORMAT_OUTLINE otherwise a cast to FT_OutlineGlyph is + // invalid and FT_Stroker_ParseOutline() will crash + if (Glyph.format <> FT_GLYPH_FORMAT_OUTLINE) then + Exit; + Outline := @FT_OutlineGlyph(Glyph).outline; + OuterBorder := FT_Outline_GetOutsideBorder(Outline); if (OuterBorder = FT_STROKER_BORDER_LEFT) then InnerBorder := FT_STROKER_BORDER_RIGHT @@ -2032,7 +2159,7 @@ begin { extrude outer border } if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then - raise Exception.Create('FT_Stroker_New failed!'); + raise EFontError.Create('FT_Stroker_New failed!'); FT_Stroker_Set( OuterStroker, Round(fOutset * 64), @@ -2043,7 +2170,7 @@ begin // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then - raise Exception.Create('FT_Stroker_ParseOutline failed!'); + raise EFontError.Create('FT_Stroker_ParseOutline failed!'); FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours); @@ -2052,7 +2179,7 @@ begin if (UseStencil) then begin if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then - raise Exception.Create('FT_Stroker_New failed!'); + raise EFontError.Create('FT_Stroker_New failed!'); FT_Stroker_Set( InnerStroker, 63, // extrude at most one pixel to avoid a black border @@ -2061,7 +2188,7 @@ begin 0); if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then - raise Exception.Create('FT_Stroker_ParseOutline failed!'); + raise EFontError.Create('FT_Stroker_ParseOutline failed!'); FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours); end else begin @@ -2080,7 +2207,7 @@ begin // resize glyph outline to hold inner and outer border FT_Outline_Done(Glyph.Library_, Outline); if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then - raise Exception.Create('FT_Outline_New failed!'); + raise EFontError.Create('FT_Outline_New failed!'); Outline.n_points := 0; Outline.n_contours := 0; @@ -2090,7 +2217,7 @@ begin if (UseStencil) then FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline); if (FT_Outline_Check(outline) <> 0) then - raise Exception.Create('FT_Stroker_ExportBorder failed!'); + raise EFontError.Create('FT_Stroker_ExportBorder failed!'); if (InnerStroker <> nil) then FT_Stroker_Done(InnerStroker); @@ -2110,20 +2237,26 @@ var TexLine: PGLubyteArray; CBox: FT_BBox; begin + // we need vector data for outlined glyphs so do not load bitmaps. + // This is necessary for mixed fonts that contain bitmap versions of smaller + // glyphs, for example in CJK fonts. + if (fOutset > 0) then + LoadFlags := LoadFlags or FT_LOAD_NO_BITMAP; + // load the Glyph for our character - if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then - raise Exception.Create('FT_Load_Glyph failed'); + if (FT_Load_Glyph(fFace.Data, fCharIndex, LoadFlags) <> 0) then + raise EFontError.Create('FT_Load_Glyph failed'); // move the face's glyph into a Glyph object - if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then - raise Exception.Create('FT_Get_Glyph failed'); + if (FT_Get_Glyph(fFace.Data^.glyph, Glyph) <> 0) then + raise EFontError.Create('FT_Get_Glyph failed'); if (fOutset > 0) then StrokeBorder(Glyph); // store scaled advance width/height in glyph-object - fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2; - fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2; + fAdvance.X := fFace.Data^.glyph^.advance.x / 64 + fOutset*2; + fAdvance.Y := fFace.Data^.glyph^.advance.y / 64 + fOutset*2; // get the contour's bounding box (in 1/64th pixels, not font-units) FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); @@ -2238,6 +2371,8 @@ end; constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single; LoadFlags: FT_Int32); +var + I: integer; begin inherited Create(); @@ -2245,8 +2380,25 @@ begin fOutset := Outset; fCharCode := ch; - // get the Freetype char-index (use default UNICODE charmap) - fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch)); + // Note: the default face is also used if no face (neither default nor fallback) + // contains a glyph for the given char. + fFace := Font.DefaultFace; + + // search the Freetype char-index (use default UNICODE charmap) in the default face + fCharIndex := FT_Get_Char_Index(fFace.Data, FT_ULONG(ch)); + if (fCharIndex = 0) then + begin + // glyph not in default font, search in fallback font faces + for I := 0 to High(Font.FallbackFaces) do + begin + fCharIndex := FT_Get_Char_Index(Font.FallbackFaces[I].Data, FT_ULONG(ch)); + if (fCharIndex <> 0) then + begin + fFace := Font.FallbackFaces[I]; + Break; + end; + end; + end; CreateTexture(LoadFlags); end; @@ -2550,7 +2702,7 @@ begin begin // initialize freetype if (FT_Init_FreeType(LibraryInst) <> 0) then - raise Exception.Create('FT_Init_FreeType failed'); + raise EFontError.Create('FT_Init_FreeType failed'); end; Result := LibraryInst; end; @@ -2571,7 +2723,7 @@ end; constructor TBitmapFont.Create(const Filename: IPath; Outline: integer; Baseline, Ascender, Descender: integer); begin - inherited Create(); + inherited Create(Filename); fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); fTexSize := 1024; @@ -2602,6 +2754,11 @@ begin ResetIntern(); end; +procedure TBitmapFont.AddFallback(const Filename: IPath); +begin + // no support for fallbacks +end; + procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); var Count: integer; @@ -2621,7 +2778,7 @@ begin Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead); Stream.Read(fWidths, 256); except - raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); + raise EFontError.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); end; Stream.Free; end; diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas index 71389f32..26c5dfe8 100644 --- a/src/base/USingScores.pas +++ b/src/base/USingScores.pas @@ -383,7 +383,7 @@ var nPosition.PUW := nPosition.BGW; nPosition.PUH := nPosition.BGH; - nPosition.PUFont := 2; + nPosition.PUFont := ftOutline1; nPosition.PUFontSize := 18; nPosition.PUStartX := nPosition.BGX; diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas index fa7a6029..b385406f 100644 --- a/src/base/UThemes.pas +++ b/src/base/UThemes.pas @@ -841,6 +841,7 @@ uses UIni, UPathUtils, UFileSystem, + TextGL, gl, glext, math, @@ -1667,7 +1668,7 @@ begin ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0); ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); - ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); + ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', ftNormal); ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); -- cgit v1.2.3 From b99460b47145de0ebbd1b9e6effe71cf91c056ec Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 24 Apr 2010 00:21:33 +0000 Subject: removed "strict protected/private" git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2296 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 72b1d8d8..79873272 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -451,7 +451,7 @@ type * Freetype font face class. *} TFTFontFace = class - strict private + private fFilename: IPath; //**< filename of the font-file fFace: FT_Face; //**< Holds the height of the font fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio @@ -544,7 +544,7 @@ type private procedure ResetIntern(); - strict protected + protected fFace: TFTFontFace; //**< Default font face fSize: integer; //**< Font base size (in pixels) fOutset: single; //**< size of outset extrusion (in pixels) -- cgit v1.2.3 From ae8022d7ddf4c222e77447de46a5bf3f97c86493 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 24 Apr 2010 14:15:35 +0000 Subject: - wrong section names in TextGL fixed - TODO: loading fallbacks for each font takes a lot of time (white screen on start), maybe load them once for all fonts. - reduced outline of Outline2 font git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2298 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 22 +++++++++++++--------- 1 file changed, 13 insertions(+), 9 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 0f4159d6..7ee574c3 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -129,28 +129,32 @@ var Outline: single; Embolden: single; OutlineFont: TFTScalableOutlineFont; + SectionName: string; begin ActFont := 0; SetLength(Fonts, Length(FONT_NAMES)); + FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative); try for I := 0 to High(FONT_NAMES) do begin - FontFile := FindFontFile(FontIni.ReadString('Font_'+FONT_NAMES[I], 'File', '')); + SectionName := 'Font_'+FONT_NAMES[I]; + + FontFile := FindFontFile(FontIni.ReadString(SectionName , 'File', '')); // create either outlined or normal font - Outline := FontIni.ReadFloat(FONT_NAMES[I], 'Outline', 0.0); + Outline := FontIni.ReadFloat(SectionName, 'Outline', 0.0); if (Outline > 0.0) then begin // outlined font OutlineFont := TFTScalableOutlineFont.Create(FontFile, 64, Outline); OutlineFont.SetOutlineColor( - FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorR', 0.0), - FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorG', 0.0), - FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorB', 0.0), - FontIni.ReadFloat(FONT_NAMES[I], 'OutlineColorA', -1.0) + FontIni.ReadFloat(SectionName, 'OutlineColorR', 0.0), + FontIni.ReadFloat(SectionName, 'OutlineColorG', 0.0), + FontIni.ReadFloat(SectionName, 'OutlineColorB', 0.0), + FontIni.ReadFloat(SectionName, 'OutlineColorA', -1.0) ); Fonts[I].Font := OutlineFont; Fonts[I].Outlined := true; @@ -158,13 +162,13 @@ begin else begin // normal font - Embolden := FontIni.ReadFloat(FONT_NAMES[I], 'Embolden', 0.0); + Embolden := FontIni.ReadFloat(SectionName, 'Embolden', 0.0); Fonts[I].Font := TFTScalableFont.Create(FontFile, 64, Embolden); Fonts[I].Outlined := false; end; - Fonts[I].Font.GlyphSpacing := FontIni.ReadFloat(FONT_NAMES[I], 'GlyphSpacing', 0.0); - Fonts[I].Font.Stretch := FontIni.ReadFloat(FONT_NAMES[I], 'Stretch', 1.0); + Fonts[I].Font.GlyphSpacing := FontIni.ReadFloat(SectionName, 'GlyphSpacing', 0.0); + Fonts[I].Font.Stretch := FontIni.ReadFloat(SectionName, 'Stretch', 1.0); AddFontFallbacks(FontIni, Fonts[I].Font); end; -- cgit v1.2.3 From 461a3645025cb950c3c69bc555e25a135065bb71 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 25 Apr 2010 07:44:43 +0000 Subject: - added font face cache -> loading all fonts now takes 1.5 secs instead of 7 secs - without the CJK font it takes only 600 ms - with wqy-zenhei.ttc replaced by the simsun.ttc windows font it takes only 800 ms instead of 1.5 secs so it is font related -> another CJK font might be better suited git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2305 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFont.pas | 102 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 98 insertions(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UFont.pas b/src/base/UFont.pas index 79873272..49a19a1a 100644 --- a/src/base/UFont.pas +++ b/src/base/UFont.pas @@ -41,6 +41,9 @@ interface {$DEFINE BITMAP_FONT} {$ENDIF} +// Enables the Freetype font cache +{$DEFINE ENABLE_FT_FACE_CACHE} + uses FreeType, gl, @@ -455,6 +458,7 @@ type fFilename: IPath; //**< filename of the font-file fFace: FT_Face; //**< Holds the height of the font fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio + fSize: integer; public {** @@ -467,6 +471,25 @@ type property Filename: IPath read fFilename; property Data: FT_Face read fFace; property FontUnitScale: TPositionDbl read fFontUnitScale; + property Size: integer read fSize; + end; + + {** + * Loading font faces with freetype is a slow process. + * Especially loading a font (e.g. fallback fonts) more than once is a waste + * of time. Just cache already loaded faces here. + *} + TFTFontFaceCache = class + private + fFaces: array of TFTFontFace; + fFacesRefCnt: array of integer; + public + {** + * @raises EFontError if the font could not be initialized + *} + function LoadFace(const Filename: IPath; Size: integer): TFTFontFace; + + procedure UnloadFace(Face: TFTFontFace); end; {** @@ -543,6 +566,7 @@ type TFTFont = class(TCachedFont) private procedure ResetIntern(); + class function GetFaceCache(): TFTFontFaceCache; protected fFace: TFTFontFace; //**< Default font face @@ -1478,6 +1502,10 @@ begin fCache.FlushCache(KeepBaseSet); end; +{* + * TFTFontFaceCache + *} + {* * TFTFontFace *} @@ -1487,6 +1515,7 @@ begin inherited Create(); fFilename := Filename; + fSize := Size; // load font information if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then @@ -1512,6 +1541,61 @@ begin end; +{* + * TFTFontFaceCache + *} + +function TFTFontFaceCache.LoadFace(const Filename: IPath; Size: integer): TFTFontFace; +var + I: Integer; + Face: TFTFontFace; +begin + {$IFDEF ENABLE_FT_FACE_CACHE} + for I := 0 to High(fFaces) do + begin + Face := fFaces[I]; + // check if we have this file in our cache + if ((Face.Filename.Equals(Filename)) and (Face.Size = Size)) then + begin + // true -> return cached face and increment ref-count + Inc(fFacesRefCnt[I]); + Result := Face; + Exit; + end; + end; + {$ENDIF} + + // face not in cache -> load it + Face := TFTFontFace.Create(Filename, Size); + + // add face to cache + SetLength(fFaces, Length(fFaces)+1); + SetLength(fFacesRefCnt, Length(fFaces)+1); + fFaces[High(fFaces)] := Face; + fFacesRefCnt[High(fFaces)] := 1; + + Result := Face; +end; + +procedure TFTFontFaceCache.UnloadFace(Face: TFTFontFace); +var + I: Integer; +begin + for I := 0 to High(fFaces) do + begin + // search face in cache + if (fFaces[I] = Face) then + begin + // decrement ref-count and free face if ref-count is 0 + Dec(fFacesRefCnt[I]); + if (fFacesRefCnt[I] <= 0) then + fFaces[I].Free; + Exit; + end; + end; +end; + + {* * TFTFont *} @@ -1531,7 +1615,7 @@ begin fUseDisplayLists := true; fPart := fpNone; - fFace := TFTFontFace.Create(Filename, Size); + fFace := GetFaceCache.LoadFace(Filename, Size); ResetIntern(); @@ -1545,13 +1629,23 @@ var I: integer; begin // free faces - fFace.Free; + GetFaceCache.UnloadFace(fFace); for I := 0 to High(fFallbackFaces) do - fFallbackFaces[I].Free; + GetFaceCache.UnloadFace(fFallbackFaces[I]); inherited; end; +var + FontFaceCache: TFTFontFaceCache = nil; + +class function TFTFont.GetFaceCache(): TFTFontFaceCache; +begin + if (FontFaceCache = nil) then + FontFaceCache := TFTFontFaceCache.Create; + Result := FontFaceCache; +end; + procedure TFTFont.ResetIntern(); begin // Note: outset and non outset fonts use same spacing @@ -1569,7 +1663,7 @@ procedure TFTFont.AddFallback(const Filename: IPath); var FontFace: TFTFontFace; begin - FontFace := TFTFontFace.Create(Filename, Size); + FontFace := GetFaceCache.LoadFace(Filename, Size); SetLength(fFallbackFaces, Length(fFallbackFaces) + 1); fFallbackFaces[High(fFallbackFaces)] := FontFace; end; -- cgit v1.2.3 From 1b294eb6cf1faaea874d5521f1d93f8d870180e6 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 25 Apr 2010 09:07:50 +0000 Subject: added Finalize3D finalization as opponent for Initialize3D and for a clean finalization git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2307 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/TextGL.pas | 14 ++++++++------ src/base/UGraphic.pas | 16 +++++++++++++++- src/base/UMain.pas | 22 +++++++--------------- 3 files changed, 30 insertions(+), 22 deletions(-) (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas index 7ee574c3..c354a500 100644 --- a/src/base/TextGL.pas +++ b/src/base/TextGL.pas @@ -61,8 +61,8 @@ var Fonts: array of TGLFont; ActFont: integer; -procedure BuildFont; // build our bitmap font -procedure KillFont; // delete the font +procedure BuildFonts; // builds all fonts +procedure KillFonts; // deletes all font function glTextWidth(const text: UTF8String): real; // returns text width procedure glPrint(const text: UTF8String); // custom GL "Print" routine procedure ResetFont(); // reset font settings of active font @@ -121,7 +121,7 @@ const 'Normal', 'Bold', 'Outline1', 'Outline2' ); -procedure BuildFont; +procedure BuildFonts; var I: integer; FontIni: TMemIniFile; @@ -183,10 +183,12 @@ end; // Deletes the font -procedure KillFont; +procedure KillFonts; +var + I: integer; begin - // delete all characters - //glDeleteLists(..., 256); + for I := 0 to High(Fonts) do + Fonts[I].Font.Free; end; function glTextWidth(const text: UTF8String): real; diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 33e862f2..d22744db 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -265,6 +265,7 @@ const Skin_P2_ScoreL = 640; procedure Initialize3D (Title: string); +procedure Finalize3D; procedure Reinitialize3D; procedure SwapBuffers; @@ -290,7 +291,13 @@ uses procedure LoadFontTextures; begin Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; + BuildFonts; +end; + +procedure UnloadFontTextures; +begin + Log.LogStatus('Kill Fonts', 'UnloadFontTextures'); + KillFonts; end; procedure LoadTextures; @@ -599,6 +606,13 @@ begin glMatrixMode(GL_MODELVIEW); end; +procedure Finalize3D; +begin + // TODO: finalize other stuff + UnloadFontTextures; + SDL_QuitSubSystem(SDL_INIT_VIDEO); +end; + procedure Reinitialize3D; begin InitializeScreen; diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 550fe9cd..ca14525f 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -155,15 +155,6 @@ begin Log.BenchmarkEnd(1); Log.LogBenchmark('Loading Language', 1); -{ - // SDL_ttf (Not used yet, maybe in version 1.5) - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL_ttf', 'Initialization'); - TTF_Init(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL_ttf', 1); -} - // Skin Log.BenchmarkStart(1); Log.LogStatus('Loading Skin List', 'Initialization'); @@ -320,16 +311,17 @@ begin // call an uninitialize routine for every initialize step // or at least use the corresponding Free methods + Log.LogStatus('Finalize Media', 'Finalization'); FinalizeMedia(); - //TTF_Quit(); + Log.LogStatus('Uninitialize 3D', 'Finalization'); + Finalize3D(); + + Log.LogStatus('Finalize SDL', 'Finalization'); SDL_Quit(); - if assigned(Log) then - begin - Log.LogStatus('Main Loop', 'Finished'); - Log.Free; - end; + Log.LogStatus('Finalize Log', 'Finalization'); + Log.Free; {$IFNDEF Debug} end; {$ENDIF} -- cgit v1.2.3 From 27b3e332076162b37a7a53f059004d23ad69f9d2 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 27 Apr 2010 19:09:40 +0000 Subject: - device input latency is now configurable via config.ini - latency[i] determines the latency for device i in milliseconds or -1 for autodetection (default) - this is necessary as mic capturing with portaudio (on linux) gets stuck if latency is too low. Either because portaudio's latency autodetection does not work or because the mic capture callback takes too long before it returns. In both cases the user should set the latency to a value of 100 (ms). - better input device test, it should not remove working devices anymore. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2313 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 7 +++++++ src/base/URecord.pas | 1 + 2 files changed, 8 insertions(+) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 3ed3f3d5..ec229c54 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -63,9 +63,13 @@ type TInputDeviceConfig = record Name: string; Input: integer; + Latency: integer; //**< latency in ms, or LATENCY_AUTODETECT for default ChannelToPlayerMap: array of integer; end; +const + LATENCY_AUTODETECT = -1; + type //Options @@ -640,6 +644,7 @@ begin DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)]; DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), ''); DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0); + DeviceCfg.Latency := IniFile.ReadInteger('Record', Format('Latency[%d]', [DeviceIndex]), LATENCY_AUTODETECT); // find the largest channel-number of the current device in the ini-file ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex])); @@ -678,6 +683,8 @@ begin InputDeviceConfig[DeviceIndex].Name); IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), InputDeviceConfig[DeviceIndex].Input); + IniFile.WriteInteger('Record', Format('Latency[%d]', [DeviceIndex+1]), + InputDeviceConfig[DeviceIndex].Latency); // Channel-to-Player Mapping for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 09ac92de..245d85a6 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -577,6 +577,7 @@ begin deviceCfg.Name := Trim(device.Name); deviceCfg.Input := 0; + deviceCfg.Latency := LATENCY_AUTODETECT; channelCount := device.AudioFormat.Channels; SetLength(deviceCfg.ChannelToPlayerMap, channelCount); -- cgit v1.2.3 From 01060a707820907091de02348cabe193ae1ae3dd Mon Sep 17 00:00:00 2001 From: tobigun Date: Fri, 30 Apr 2010 20:38:19 +0000 Subject: - configure recreated with autogen.sh - cleanup git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2323 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UConfig.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index a24242e8..ef08827b 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -130,7 +130,7 @@ const USDX_VERSION_MAJOR = 1; USDX_VERSION_MINOR = 1; USDX_VERSION_RELEASE = 0; - USDX_VERSION_STATE = 'Alpha'; + USDX_VERSION_STATE = 'Beta'; USDX_STRING = 'UltraStar Deluxe'; (* -- cgit v1.2.3 From 0d66d9b6b30777f3e2e99e5d7dbddb6a0c904c35 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 2 May 2010 07:13:49 +0000 Subject: - Fix for "Wrong mouse position after screen-resize" bug reported here (http://forum.ultra-star.de/viewtopic.php?f=65&t=7768&p=57151#p57151) - Note: Screen.w and Screen.h are not updated after a resize as SDL_SetVideoMode is not called on windows on a resize event. Previously SDL_SetVideoMode invalidated all OpenGL textures resulting in most textures white. Using SDL_SetVideoMode at a resize seems to work now at least with SDL 1.2.14 and Win7. Maybe we should switch it on again. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2328 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 10 ++++++++-- 1 file changed, 8 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index ca14525f..53518d1e 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -426,8 +426,8 @@ begin end; end; - Display.MoveCursor(Event.button.X * 800 * Screens / Screen.w, - Event.button.Y * 600 / Screen.h); + Display.MoveCursor(Event.button.X * 800 * Screens / ScreenW, + Event.button.Y * 600 / ScreenH); if not Assigned(Display.NextScreen) then begin //drop input when changing screens @@ -456,6 +456,12 @@ begin // This would create a new OpenGL render-context and all texture data // would be invalidated. // On Linux the mode MUST be reset, otherwise graphics will be corrupted. + // Update: It seems to work now without creating a new OpenGL context. At least + // with Win7 and SDL 1.2.14. Maybe it generally works now with SDL 1.2.14 and we + // can switch it on for windows. + // Important: Unless SDL_SetVideoMode() is called (it is not on Windows), Screen.w + // and Screen.h are not valid after a resize and still contain the old size. Use + // ScreenW and ScreenH instead. {$IF Defined(Linux) or Defined(FreeBSD)} if boolean( Ini.FullScreen ) then SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) -- cgit v1.2.3 From cb9c992abfc5c003b020f97f1384bc7c0e346534 Mon Sep 17 00:00:00 2001 From: tobigun Date: Mon, 3 May 2010 16:36:52 +0000 Subject: - Free Statics/Buttons/Texts if a screen is destroyed (Textures used by those components are not unloaded yet) - Use Free() instead of Destroy() as it checks for nil by default git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2334 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 70 +++++++++++++++++++++++++-------------------------- 1 file changed, 35 insertions(+), 35 deletions(-) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index d22744db..92256f80 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -273,7 +273,7 @@ procedure LoadTextures; procedure InitializeScreen; procedure LoadLoadingScreen; procedure LoadScreens; -procedure UnLoadScreens; +procedure UnloadScreens; function LoadingThreadFunction: integer; @@ -810,41 +810,41 @@ begin Result:= 1; end; -procedure UnLoadScreens; +procedure UnloadScreens; begin - ScreenMain.Destroy; - ScreenName.Destroy; - ScreenLevel.Destroy; - ScreenSong.Destroy; - ScreenSing.Destroy; - ScreenScore.Destroy; - ScreenTop5.Destroy; - ScreenOptions.Destroy; - ScreenOptionsGame.Destroy; - ScreenOptionsGraphics.Destroy; - ScreenOptionsSound.Destroy; - ScreenOptionsLyrics.Destroy; -// ScreenOptionsThemes.Destroy; - ScreenOptionsRecord.Destroy; - ScreenOptionsAdvanced.Destroy; - ScreenEditSub.Destroy; - ScreenEdit.Destroy; - ScreenEditConvert.Destroy; - ScreenOpen.Destroy; - //ScreenSingModi.Destroy; - ScreenSongMenu.Destroy; - ScreenSongJumpto.Destroy; - ScreenPopupCheck.Destroy; - ScreenPopupError.Destroy; - ScreenPopupInfo.Destroy; - ScreenPartyNewRound.Destroy; - ScreenPartyScore.Destroy; - ScreenPartyWin.Destroy; - ScreenPartyOptions.Destroy; - ScreenPartyPlayer.Destroy; - ScreenPartyRounds.Destroy; - ScreenStatMain.Destroy; - ScreenStatDetail.Destroy; + ScreenMain.Free; + ScreenName.Free; + ScreenLevel.Free; + ScreenSong.Free; + ScreenSing.Free; + ScreenScore.Free; + ScreenTop5.Free; + ScreenOptions.Free; + ScreenOptionsGame.Free; + ScreenOptionsGraphics.Free; + ScreenOptionsSound.Free; + ScreenOptionsLyrics.Free; +// ScreenOptionsThemes.Free; + ScreenOptionsRecord.Free; + ScreenOptionsAdvanced.Free; + ScreenEditSub.Free; + ScreenEdit.Free; + ScreenEditConvert.Free; + ScreenOpen.Free; + //ScreenSingModi.Free; + ScreenSongMenu.Free; + ScreenSongJumpto.Free; + ScreenPopupCheck.Free; + ScreenPopupError.Free; + ScreenPopupInfo.Free; + ScreenPartyNewRound.Free; + ScreenPartyScore.Free; + ScreenPartyWin.Free; + ScreenPartyOptions.Free; + ScreenPartyPlayer.Free; + ScreenPartyRounds.Free; + ScreenStatMain.Free; + ScreenStatDetail.Free; end; end. -- cgit v1.2.3 From 0b4921154485953384c026918d6615ed79a7da9d Mon Sep 17 00:00:00 2001 From: canni0 Date: Wed, 5 May 2010 07:22:17 +0000 Subject: - workaround by tobydox for buggy Intel 3D driver on Linux through deactivating texture tiling applied to UGraphic (thx!) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2339 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UGraphic.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/base') diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas index 92256f80..4f0c8c77 100644 --- a/src/base/UGraphic.pas +++ b/src/base/UGraphic.pas @@ -502,6 +502,8 @@ begin { center window } SDL_putenv('SDL_VIDEO_WINDOW_POS=center'); + { workaround for buggy Intel 3D driver on Linux } + SDL_putenv('texture_tiling=false'); //Log.BenchmarkStart(2); -- cgit v1.2.3 From f59682f2109f72d100234fb65efe225090cd700e Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 8 May 2010 15:02:05 +0000 Subject: changed local/global execution detection: * Detects whether the was executed locally or globally. * - Local mode: * - Condition: * - config.ini is writable or creatable in the directory of the executable. * - Examples: * - The USDX zip-archive has been unpacked to a directory with write. * permissions * - XP: USDX was installed to %ProgramFiles% and the user is an admin. * - USDX is started from an external HD- or flash-drive * - Behavior: * Config files like config.ini or score db reside in the directory of the * executable. This is useful to enable windows users to have a portable * installation e.g. on an external hdd. * This is also the default behaviour of usdx prior to version 1.1 * - Global mode: * - Condition: * - config.ini is not writable. * - Examples: * - Vista/7: USDX was installed to %ProgramFiles%. * - XP: USDX was installed to %ProgramFiles% and the user is not an admin. * - USDX is started from CD * - Behavior: * - The config files are in a separate folder (e.g. %APPDATA%\ultrastardx) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2344 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformWindows.pas | 70 +++++++++++++++++++++++++++++++++---------- 1 file changed, 55 insertions(+), 15 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas index 8c4469cf..91d3cce6 100644 --- a/src/base/UPlatformWindows.pas +++ b/src/base/UPlatformWindows.pas @@ -120,16 +120,30 @@ begin end; {** - * Detects whether the game was executed locally or globally. - * - It is local if config.ini exists in the directory of the - * executable. Config files like config.ini or score db - * reside in the directory of the executable. This is useful - * to enable windows users to have a portable installation - * e.g. on an external hdd. This is also the default behaviour - * of usdx prior to version 1.1 - * - It is global if no config.ini exists in the directory of the - * executable. The config files are in a separate folder - * (e.g. %APPDATA%\ultrastardx) + * Detects whether the was executed locally or globally. + * - Local mode: + * - Condition: + * - config.ini is writable or creatable in the directory of the executable. + * - Examples: + * - The USDX zip-archive has been unpacked to a directory with write. + * permissions + * - XP: USDX was installed to %ProgramFiles% and the user is an admin. + * - USDX is started from an external HD- or flash-drive + * - Behavior: + * Config files like config.ini or score db reside in the directory of the + * executable. This is useful to enable windows users to have a portable + * installation e.g. on an external hdd. + * This is also the default behaviour of usdx prior to version 1.1 + * - Global mode: + * - Condition: + * - config.ini is not writable. + * - Examples: + * - Vista/7: USDX was installed to %ProgramFiles%. + * - XP: USDX was installed to %ProgramFiles% and the user is not an admin. + * - USDX is started from CD + * - Behavior: + * - The config files are in a separate folder (e.g. %APPDATA%\ultrastardx) + * * On windows, resources (themes, language-files) * reside in the directory of the executable in any case * @@ -138,14 +152,40 @@ end; procedure TPlatformWindows.DetectLocalExecution(); var LocalDir, ConfigIni: IPath; + Handle: TFileHandle; begin - // we just check if 'config.ini' exists in the - // directory of the executable or if the windows version - // is less than Windows Vista (major version = 6). - // If so -> local execution. LocalDir := GetExecutionDir(); ConfigIni := LocalDir.Append('config.ini'); - UseLocalDirs := (ConfigIni.IsFile and ConfigIni.Exists and (Win32MajorVersion < 6)); + + // check if config.ini is writable or creatable, if so use local dirs + UseLocalDirs := false; + if (ConfigIni.Exists()) then + begin + // do not use a read-only config file + if (not ConfigIni.IsReadOnly()) then + begin + // Just open the file in read-write mode to be sure that we have access + // rights for it. + // Note: Do not use IsReadOnly() as it does not check file privileges, so + // a non-read-only file might not be writable for us. + Handle := ConfigIni.Open(fmOpenReadWrite); + if (Handle <> -1) then + begin + FileClose(Handle); + UseLocalDirs := true; + end; + end; + end + else // config.ini does not exist + begin + // try to create config.ini + Handle := ConfigIni.CreateFile(); + if (Handle <> -1) then + begin + FileClose(Handle); + UseLocalDirs := true; + end; + end; end; function TPlatformWindows.GetLogPath: IPath; -- cgit v1.2.3 From 69cd34b1a50914fad7e5befaa848a6a2c537b4ac Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 8 May 2010 22:46:29 +0000 Subject: validate microphone settings when leaving the record options and when USDX is started: - check if a user is assigned to multiple devices. If this is the case either do not leave the record options (if we already are there) or enter the record options (if USDX was started) - the check is performed by calling TAudioInputProcessor.ValidateSettings() git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2346 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 2 +- src/base/UMain.pas | 5 +++++ src/base/URecord.pas | 47 +++++++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 53 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index ec229c54..a4c85a3b 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -632,7 +632,7 @@ begin if (DeviceIndex >= 0) then begin if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then - break; + Continue; // resize list SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 53518d1e..8e938e52 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -78,6 +78,7 @@ uses UPathUtils, UPlaylist, UMusic, + URecord, UBeatTimer, UPlatform, USkins, @@ -294,6 +295,10 @@ begin Log.BenchmarkEnd(0); Log.LogBenchmark('Loading Time', 0); + // check microphone settings, goto record options if they are corrupt + if (not AudioInputProcessor.ValidateSettings) then + Display.CurrentScreen^.FadeTo( @ScreenOptionsRecord ); + //------------------------------ // Start Mainloop //------------------------------ diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 245d85a6..c183875c 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -133,6 +133,7 @@ type destructor Destroy; override; procedure UpdateInputDeviceConfig; + function ValidateSettings: boolean; // handle microphone input procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer; @@ -162,6 +163,8 @@ implementation uses ULog, + UGraphic, + ULanguage, UNote; var @@ -594,6 +597,50 @@ begin end; end; +function TAudioInputProcessor.ValidateSettings: boolean; +const + MAX_PLAYER_COUNT = 6; // FIXME: there should be a global variable for this +var + I, J: integer; + PlayerID: integer; + PlayerMap: array [0 .. MAX_PLAYER_COUNT] of boolean; + InputDevice: TAudioInputDevice; + InputDeviceCfg: PInputDeviceConfig; +begin + // mark all players as unassigned + for I := 0 to High(PlayerMap) do + PlayerMap[I] := false; + + // iterate over all active devices + for I := 0 to High(DeviceList) do + begin + InputDevice := DeviceList[I]; + InputDeviceCfg := @Ini.InputDeviceConfig[InputDevice.CfgIndex]; + // iterate over all channels of the current devices + for J := 0 to High(InputDeviceCfg.ChannelToPlayerMap) do + begin + // get player that was mapped to the current device channel + PlayerID := InputDeviceCfg.ChannelToPlayerMap[J]; + if (PlayerID <> 0) then + begin + // check if player is already assigned to another device/channel + if (PlayerMap[PlayerID]) then + begin + ScreenPopupError.ShowPopup( + Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'), + [PlayerID])); + Result := false; + Exit; + end; + + // mark player as assigned to a device + PlayerMap[PlayerID] := true; + end; + end; + end; + Result := true; +end; + {* * Handles captured microphone input data. * Params: -- cgit v1.2.3 From 32fc762cbb4482c58a29e3b0438949a6c003316b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 18 May 2010 16:18:50 +0000 Subject: move software cursor initialization and bg music start from ScreenMain.OnShow to Main procedure to fix bugs with the new dialog on wrong mic configuration git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2380 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 8 ++++++++ 1 file changed, 8 insertions(+) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 8e938e52..0d479420 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -295,6 +295,14 @@ begin Log.BenchmarkEnd(0); Log.LogBenchmark('Loading Time', 0); + { prepare software cursor } + Display.SetCursor; + + {** + * Start background music + *} + SoundLib.StartBgMusic; + // check microphone settings, goto record options if they are corrupt if (not AudioInputProcessor.ValidateSettings) then Display.CurrentScreen^.FadeTo( @ScreenOptionsRecord ); -- cgit v1.2.3 From 7d7011bd7b2eeac58d660f267abfc62df0dad8f6 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 23 May 2010 13:17:45 +0000 Subject: zero-length notes will no longer be ignored. they will be converted into freestyle notes. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2407 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/USong.pas | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/USong.pas b/src/base/USong.pas index a441fe40..43251f8f 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -510,22 +510,25 @@ begin //Check for ZeroNote if Param2 = 0 then + begin Log.LogWarn(Format('"%s" in line %d: %s', - [FileNamePath.ToNative, FileLineNo, 'found note with length zero -> note ignored']), 'TSong.LoadSong') + [FileNamePath.ToNative, FileLineNo, + 'found note with length zero -> converted to FreeStyle']), + 'TSong.LoadSong'); //Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!') + Param0 := 'F'; + end; + + // add notes + if not Both then + // P1 + ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric) else begin - // add notes - if not Both then - // P1 - ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric) - else - begin - // P1 + P2 - ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric); - ParseNote(1, Param0, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamLyric); - end; - end; //Zeronote check + // P1 + P2 + ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric); + ParseNote(1, Param0, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamLyric); + end; end // if else if Param0 = '-' then -- cgit v1.2.3 From 88f143268a1ad7bd2af9fbb721ca9045f857ca1b Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 28 May 2010 06:54:05 +0000 Subject: move LogPath to "~/Library/Logs/UltraStar Deluxe" on Mac OS X git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2423 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPlatformMacOSX.pas | 14 ++++++-------- 1 file changed, 6 insertions(+), 8 deletions(-) (limited to 'src/base') diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index d55e8bea..6f718bcd 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -121,7 +121,7 @@ type {** * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/log. + * $HOME/Library/Logs/UltraStar Deluxe/. *} function GetLogPath: IPath; override; @@ -251,21 +251,19 @@ begin Result := GetExecutionDir().GetParent().GetParent(); end; -function TPlatformMacOSX.GetApplicationSupportPath: IPath; -const - PathName: string = 'Library/Application Support/UltraStarDeluxe'; +function TPlatformMacOSX.GetHomeDir(): IPath; begin - Result := GetHomeDir().Append(PathName, pdAppend); + Result := Path(GetEnvironmentVariable('HOME')); end; -function TPlatformMacOSX.GetHomeDir(): IPath; +function TPlatformMacOSX.GetApplicationSupportPath: IPath; begin - Result := Path(GetEnvironmentVariable('HOME')); + Result := GetHomeDir().Append('Library/Application Support/UltraStarDeluxe', pdAppend); end; function TPlatformMacOSX.GetLogPath: IPath; begin - Result := GetApplicationSupportPath.Append('logs'); + Result := GetHomeDir().Append('Library/Logs/UltraStar Deluxe', pdAppend); end; function TPlatformMacOSX.GetGameSharedPath: IPath; -- cgit v1.2.3 From cafa9b8034cbff7f7c3507f3f1b0b03a2e5455f7 Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 28 May 2010 22:35:34 +0000 Subject: add Music/Ultrastar Deluxe as a song folder. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2424 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPathUtils.pas | 5 +++++ src/base/UPlatform.pas | 1 + src/base/UPlatformMacOSX.pas | 26 ++++++++++++++++++++------ 3 files changed, 26 insertions(+), 6 deletions(-) (limited to 'src/base') diff --git a/src/base/UPathUtils.pas b/src/base/UPathUtils.pas index c2bcdd4b..eb98302e 100644 --- a/src/base/UPathUtils.pas +++ b/src/base/UPathUtils.pas @@ -154,6 +154,7 @@ end; procedure InitializePaths; var SharedPath, UserPath: IPath; + MacOSXSongPath: IPath; begin // Log directory (must be writable) if (not FindPath(LogPath, Platform.GetLogPath, true)) then @@ -185,8 +186,12 @@ begin // Add song paths AddSongPath(Params.SongPath); +{$IF Defined(DARWIN)} + AddSongPath(Platform.GetMusicPath); +{$ELSE} AddSongPath(SharedPath.Append('songs')); AddSongPath(UserPath.Append('songs')); +{$IFEND} // Add category cover paths AddCoverPath(SharedPath.Append('covers')); diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas index 11c67fa7..6d884979 100644 --- a/src/base/UPlatform.pas +++ b/src/base/UPlatform.pas @@ -51,6 +51,7 @@ type procedure Halt; virtual; function GetLogPath: IPath; virtual; abstract; + function GetMusicPath: IPath; virtual; abstract; function GetGameSharedPath: IPath; virtual; abstract; function GetGameUserPath: IPath; virtual; abstract; end; diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas index 6f718bcd..7115a6b0 100644 --- a/src/base/UPlatformMacOSX.pas +++ b/src/base/UPlatformMacOSX.pas @@ -108,7 +108,10 @@ type *} procedure CreateUserFolders(); - function GetHomeDir(): IPath; + {** + * GetHomeDir returns the path to $HOME. + *} + function GetHomeDir: IPath; public {** @@ -125,9 +128,15 @@ type *} function GetLogPath: IPath; override; + {** + * GetMusicPath returns the path for music. Currently it is set to + * $HOME/Music/UltraStar Deluxe/. + *} + function GetMusicPath: IPath; override; + {** * GetGameSharedPath returns the path for shared resources. Currently it - * is set to /Library/Application Support/UltraStarDeluxe. + * is also set to $HOME/Library/Application Support/UltraStarDeluxe. * However it is not used. *} function GetGameSharedPath: IPath; override; @@ -135,7 +144,7 @@ type {** * GetGameUserPath returns the path for user resources. Currently it is * set to $HOME/Library/Application Support/UltraStarDeluxe. - * This is where a user can add songs, themes, .... + * This is where a user can add themes, .... *} function GetGameUserPath: IPath; override; end; @@ -251,19 +260,24 @@ begin Result := GetExecutionDir().GetParent().GetParent(); end; -function TPlatformMacOSX.GetHomeDir(): IPath; +function TPlatformMacOSX.GetHomeDir: IPath; begin Result := Path(GetEnvironmentVariable('HOME')); end; function TPlatformMacOSX.GetApplicationSupportPath: IPath; begin - Result := GetHomeDir().Append('Library/Application Support/UltraStarDeluxe', pdAppend); + Result := GetHomeDir.Append('Library/Application Support/UltraStarDeluxe', pdAppend); end; function TPlatformMacOSX.GetLogPath: IPath; begin - Result := GetHomeDir().Append('Library/Logs/UltraStar Deluxe', pdAppend); + Result := GetHomeDir.Append('Library/Logs/UltraStar Deluxe', pdAppend); +end; + +function TPlatformMacOSX.GetMusicPath: IPath; +begin + Result := GetHomeDir.Append('Music/UltraStar Deluxe', pdAppend); end; function TPlatformMacOSX.GetGameSharedPath: IPath; -- cgit v1.2.3 From 30454df1f1b18fc672daf2f5498691266040fbca Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 6 Jun 2010 08:29:04 +0000 Subject: - cleanup - added comments - added CHANNEL_OFF (=0) for ChannelToPlayerMap git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2448 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 44 ++++++++++++++++++++++++-------------------- src/base/UNote.pas | 17 ++++++++++++++--- 2 files changed, 38 insertions(+), 23 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index a4c85a3b..d7676f51 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -44,31 +44,34 @@ uses UPath; type - // TInputDeviceConfig stores the configuration for an input device. - // Configurations will be stored in the InputDeviceConfig array. - // Note that not all devices listed in InputDeviceConfig are active devices. - // Some might be unplugged and hence unavailable. - // Available devices are held in TAudioInputProcessor.DeviceList. Each - // TAudioInputDevice listed there has a CfgIndex field which is the index to - // its configuration in the InputDeviceConfig array. - // Name: - // the name of the input device - // Input: - // the index of the input source to use for recording - // ChannelToPlayerMap: - // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 - // maps the channel 0 (left) to player 2. A player index of 0 means that - // the channel is not assigned to a player. + {** + * TInputDeviceConfig stores the configuration for an input device. + * Configurations will be stored in the InputDeviceConfig array. + * Note that not all devices listed in InputDeviceConfig are active devices. + * Some might be unplugged and hence unavailable. + * Available devices are held in TAudioInputProcessor.DeviceList. Each + * TAudioInputDevice listed there has a CfgIndex field which is the index to + * its configuration in the InputDeviceConfig array. + *} PInputDeviceConfig = ^TInputDeviceConfig; TInputDeviceConfig = record - Name: string; - Input: integer; - Latency: integer; //**< latency in ms, or LATENCY_AUTODETECT for default + Name: string; //**< Name of the input device + Input: integer; //**< Index of the input source to use for recording + Latency: integer; //**< Latency in ms, or LATENCY_AUTODETECT for default + + {** + * Mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 + * maps the channel 0 (left) to player 2. + * A player index of 0 (CHANNEL_OFF) means that the channel is not assigned + * to any player (the channel is off). + *} ChannelToPlayerMap: array of integer; end; +{* Constants for TInputDeviceConfig *} const - LATENCY_AUTODETECT = -1; + CHANNEL_OFF = 0; // for field ChannelToPlayerMap + LATENCY_AUTODETECT = -1; // for field Latency type @@ -87,6 +90,7 @@ type procedure LoadInputDeviceCfg(IniFile: TMemIniFile); procedure SaveInputDeviceCfg(IniFile: TIniFile); procedure LoadThemes(IniFile: TCustomIniFile); + procedure LoadPaths(IniFile: TCustomIniFile); procedure LoadScreenModes(IniFile: TCustomIniFile); @@ -658,7 +662,7 @@ begin for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do begin DeviceCfg.ChannelToPlayerMap[ChannelIndex] := - IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0); + IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), CHANNEL_OFF); end; end; end; diff --git a/src/base/UNote.pas b/src/base/UNote.pas index 6eb99df9..d6fdcb13 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -88,12 +88,23 @@ type Note: array of TPlayerNote; end; +{* Player and music info *} var - - // player and music info - Player: array of TPlayer; + {** + * Player info and state for each player. + * The amount of players is given by PlayersPlay. + *} + Player: array of TPlayer; + + {** + * Number of players or teams playing. + * Possible values: 1 - 6 + *} PlayersPlay: integer; + {** + * Selected song for singing. + *} CurrentSong: TSong; const -- cgit v1.2.3 From b272c672d0fb3857f760bf39d3571028919c14b0 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 6 Jun 2010 08:41:02 +0000 Subject: - Now on sing-screen entry a check is performed if mics are assigned to all players. If not an error popup is displayed (but the sing-screen does not abort). - Player 1 is not assigned to the first detected audio device anymore - Previously the auto-detected one might have been a non-mic port of the internal sound card like mono or stereo mix - If the user has singstar mics he does not have to check for other automatically assigned devices for player 1 what caused many problems in the past -> Providing no default might be better (and the user can check the input volume, too) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2449 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/URecord.pas | 93 ++++++++++++++++++++++++++++++++++++++++++++-------- 1 file changed, 80 insertions(+), 13 deletions(-) (limited to 'src/base') diff --git a/src/base/URecord.pas b/src/base/URecord.pas index c183875c..5d2b4666 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -124,6 +124,8 @@ type procedure SetVolume(Volume: single); virtual; abstract; end; + TBooleanDynArray = array of boolean; + TAudioInputProcessor = class public Sound: array of TCaptureBuffer; // sound-buffers for every player @@ -133,9 +135,29 @@ type destructor Destroy; override; procedure UpdateInputDeviceConfig; + + {** + * Validates the mic settings. + * If a player was assigned to multiple mics a popup will be displayed + * with the ID of the player and the return value will be false. + *} function ValidateSettings: boolean; - // handle microphone input + {** + * Checks if players 1 to PlayerCount are configured correctly. + * A player is configured if a device's channel is assigned to him. + * For each player (up to PlayerCount) the state will be in PlayerState. + * If a player's state is true the player is configured, otherwise not. + * The return value is the player number of the first player that is not + * configured correctly or 0 if all players are correct. + * The PlayerState array is zero based (index 0 for player 1). + *} + function CheckPlayersConfig(PlayerCount: cardinal; + var PlayerState: TBooleanDynArray): integer; + + {** + * Handle microphone input + *} procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice); end; @@ -555,10 +577,10 @@ begin channelIndex := High(deviceCfg.ChannelToPlayerMap); // add missing channels or remove non-existing ones SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels); - // initialize added channels to 0 + // assign added channels to no player for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do begin - deviceCfg.ChannelToPlayerMap[i] := 0; + deviceCfg.ChannelToPlayerMap[i] := CHANNEL_OFF; end; // associate ini-index with device @@ -587,11 +609,11 @@ begin for channelIndex := 0 to channelCount-1 do begin - // set default at first start of USDX (1st device, 1st channel -> player1) - if ((channelIndex = 0) and (device.CfgIndex = 0)) then - deviceCfg.ChannelToPlayerMap[0] := 1 - else - deviceCfg.ChannelToPlayerMap[channelIndex] := 0; + // Do not set any default on first start of USDX. + // Otherwise most probably the wrong device (internal sound card) + // will be selected. + // It is better to force the user to configure the mics himself. + deviceCfg.ChannelToPlayerMap[channelIndex] := CHANNEL_OFF; end; end; end; @@ -603,7 +625,7 @@ const var I, J: integer; PlayerID: integer; - PlayerMap: array [0 .. MAX_PLAYER_COUNT] of boolean; + PlayerMap: array [0 .. MAX_PLAYER_COUNT - 1] of boolean; InputDevice: TAudioInputDevice; InputDeviceCfg: PInputDeviceConfig; begin @@ -621,10 +643,10 @@ begin begin // get player that was mapped to the current device channel PlayerID := InputDeviceCfg.ChannelToPlayerMap[J]; - if (PlayerID <> 0) then + if (PlayerID <> CHANNEL_OFF) then begin // check if player is already assigned to another device/channel - if (PlayerMap[PlayerID]) then + if (PlayerMap[PlayerID - 1]) then begin ScreenPopupError.ShowPopup( Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'), @@ -634,13 +656,58 @@ begin end; // mark player as assigned to a device - PlayerMap[PlayerID] := true; + PlayerMap[PlayerID - 1] := true; end; end; end; Result := true; end; +function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal; + var PlayerState: TBooleanDynArray): integer; +var + DeviceIndex: integer; + ChannelIndex: integer; + Device: TAudioInputDevice; + DeviceCfg: PInputDeviceConfig; + PlayerIndex: integer; + I: integer; +begin + SetLength(PlayerState, PlayerCount); + // set all entries to "not configured" + for I := 0 to High(PlayerState) do + begin + PlayerState[I] := false; + end; + + // check each used device + for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do + begin + Device := AudioInputProcessor.DeviceList[DeviceIndex]; + if not assigned(Device) then + continue; + DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; + + // check if device is used + for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do + begin + PlayerIndex := DeviceCfg.ChannelToPlayerMap[ChannelIndex] - 1; + if (PlayerIndex >= 0) and (PlayerIndex < PlayerCount) then + PlayerState[PlayerIndex] := true; + end; + end; + + Result := 0; + for I := 0 to High(PlayerState) do + begin + if (PlayerState[I] = false) then + begin + Result := I + 1; + Break; + end; + end; +end; + {* * Handles captured microphone input data. * Params: @@ -737,7 +804,7 @@ begin // check if device is used for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do begin - Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; + Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex] - 1; if (Player < 0) or (Player >= PlayersPlay) then begin Device.LinkCaptureBuffer(ChannelIndex, nil); -- cgit v1.2.3 From 81945c399590c1bd2c6837bdae0091f6b649b3a1 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 6 Jun 2010 10:08:25 +0000 Subject: - URecord.ValidateSettings should not display the popup itself - Array free version of CheckPlayersConfig git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2450 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 9 ++++++++- src/base/URecord.pas | 31 ++++++++++++++++++++----------- 2 files changed, 28 insertions(+), 12 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 0d479420..1d924d56 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -98,6 +98,7 @@ uses procedure Main; var WindowTitle: string; + BadPlayer: integer; begin {$IFNDEF Debug} try @@ -304,8 +305,14 @@ begin SoundLib.StartBgMusic; // check microphone settings, goto record options if they are corrupt - if (not AudioInputProcessor.ValidateSettings) then + BadPlayer := AudioInputProcessor.ValidateSettings; + if (BadPlayer <> 0) then + begin + ScreenPopupError.ShowPopup( + Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'), + [BadPlayer])); Display.CurrentScreen^.FadeTo( @ScreenOptionsRecord ); + end; //------------------------------ // Start Mainloop diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 5d2b4666..6b8ba8cf 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -139,9 +139,11 @@ type {** * Validates the mic settings. * If a player was assigned to multiple mics a popup will be displayed - * with the ID of the player and the return value will be false. + * with the ID of the player. + * The return value is the player number of the first player that is not + * configured correctly or 0 if all players are correct. *} - function ValidateSettings: boolean; + function ValidateSettings: integer; {** * Checks if players 1 to PlayerCount are configured correctly. @@ -153,7 +155,12 @@ type * The PlayerState array is zero based (index 0 for player 1). *} function CheckPlayersConfig(PlayerCount: cardinal; - var PlayerState: TBooleanDynArray): integer; + var PlayerState: TBooleanDynArray): integer; overload; + + {** + * Same as the array version but it does not output a state for each player. + *} + function CheckPlayersConfig(PlayerCount: cardinal): integer; overload; {** * Handle microphone input @@ -185,8 +192,6 @@ implementation uses ULog, - UGraphic, - ULanguage, UNote; var @@ -619,7 +624,7 @@ begin end; end; -function TAudioInputProcessor.ValidateSettings: boolean; +function TAudioInputProcessor.ValidateSettings: integer; const MAX_PLAYER_COUNT = 6; // FIXME: there should be a global variable for this var @@ -648,10 +653,7 @@ begin // check if player is already assigned to another device/channel if (PlayerMap[PlayerID - 1]) then begin - ScreenPopupError.ShowPopup( - Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'), - [PlayerID])); - Result := false; + Result := PlayerID; Exit; end; @@ -660,7 +662,7 @@ begin end; end; end; - Result := true; + Result := 0; end; function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal; @@ -708,6 +710,13 @@ begin end; end; +function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal): integer; +var + PlayerState: TBooleanDynArray; +begin + CheckPlayersConfig(PlayerCount, PlayerState); +end; + {* * Handles captured microphone input data. * Params: -- cgit v1.2.3 From f0f0d4b3f9c1e343edf6dfddc04cf25d3b52b496 Mon Sep 17 00:00:00 2001 From: tobigun Date: Tue, 8 Jun 2010 18:27:37 +0000 Subject: string update git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2456 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UConfig.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index ef08827b..74415f4d 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -130,7 +130,7 @@ const USDX_VERSION_MAJOR = 1; USDX_VERSION_MINOR = 1; USDX_VERSION_RELEASE = 0; - USDX_VERSION_STATE = 'Beta'; + USDX_VERSION_STATE = 'RC'; USDX_STRING = 'UltraStar Deluxe'; (* -- cgit v1.2.3 From 93d1393f84afd4b06551440d8aca5a480c82f57f Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Wed, 9 Jun 2010 21:48:04 +0000 Subject: add the path of Library/Application Support/UltraStarDeluxe again. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2471 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPathUtils.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPathUtils.pas b/src/base/UPathUtils.pas index eb98302e..2bfcde42 100644 --- a/src/base/UPathUtils.pas +++ b/src/base/UPathUtils.pas @@ -154,7 +154,6 @@ end; procedure InitializePaths; var SharedPath, UserPath: IPath; - MacOSXSongPath: IPath; begin // Log directory (must be writable) if (not FindPath(LogPath, Platform.GetLogPath, true)) then @@ -188,6 +187,7 @@ begin AddSongPath(Params.SongPath); {$IF Defined(DARWIN)} AddSongPath(Platform.GetMusicPath); + AddSongPath(UserPath.Append('songs')); {$ELSE} AddSongPath(SharedPath.Append('songs')); AddSongPath(UserPath.Append('songs')); -- cgit v1.2.3 From f261cd24db299daee8a0d8e470ff7d173f1a1c75 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Thu, 10 Jun 2010 18:27:53 +0000 Subject: merge of VideoPreview branch into trunk git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2475 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 24 +++++++++++++++++ src/base/UMusic.pas | 75 ++++++++++++++++++++++++++++++++++++++++++++++++++--- 2 files changed, 96 insertions(+), 3 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index d7676f51..6d01ddc1 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -125,6 +125,8 @@ type Spectrum: integer; Spectrograph: integer; MovieSize: integer; + VideoPreview: integer; + VideoEnabled: integer; // Sound MicBoost: integer; @@ -218,6 +220,8 @@ const ISpectrum: array[0..1] of UTF8String = ('Off', 'On'); ISpectrograph: array[0..1] of UTF8String = ('Off', 'On'); IMovieSize: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + IVideoPreview: array[0..1] of UTF8String = ('Off', 'On'); + IVideoEnabled: array[0..1] of UTF8String = ('Off', 'On'); IClickAssist: array[0..1] of UTF8String = ('Off', 'On'); IBeatClick: array[0..1] of UTF8String = ('Off', 'On'); @@ -299,6 +303,8 @@ var ISpectrumTranslated: array[0..1] of UTF8String = ('Off', 'On'); ISpectrographTranslated: array[0..1] of UTF8String = ('Off', 'On'); IMovieSizeTranslated: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]'); + IVideoPreviewTranslated: array[0..1] of UTF8String = ('Off', 'On'); + IVideoEnabledTranslated: array[0..1] of UTF8String = ('Off', 'On'); IClickAssistTranslated: array[0..1] of UTF8String = ('Off', 'On'); IBeatClickTranslated: array[0..1] of UTF8String = ('Off', 'On'); @@ -419,6 +425,12 @@ begin IMovieSizeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID'); IMovieSizeTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID_BG'); + IVideoPreviewTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IVideoPreviewTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + + IVideoEnabledTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); + IVideoEnabledTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); + IClickAssistTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); IClickAssistTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); @@ -934,6 +946,12 @@ begin // MovieSize MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2])); + // VideoPreview + VideoPreview := GetArrayIndex(IVideoPreview, IniFile.ReadString('Graphics', 'VideoPreview', IVideoPreview[1])); + + // VideoEnabled + VideoEnabled := GetArrayIndex(IVideoEnabled, IniFile.ReadString('Graphics', 'VideoEnabled', IVideoEnabled[1])); + // ClickAssist ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off')); @@ -1081,6 +1099,12 @@ begin // Movie Size IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]); + // VideoPreview + IniFile.WriteString('Graphics', 'VideoPreview', IVideoPreview[VideoPreview]); + + // VideoEnabled + IniFile.WriteString('Graphics', 'VideoEnabled', IVideoEnabled[VideoEnabled]); + // ClickAssist IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]); diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 7f2b3e30..41d6e80c 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -43,6 +43,27 @@ uses type TNoteType = (ntFreestyle, ntNormal, ntGolden); + {** + * acoStretch: Stretch to screen width and height + * - ignores aspect + * + no borders + * + no image data loss + * acoCrop: Stretch to screen width or height, crop the other dimension + * + keeps aspect + * + no borders + * - frame borders are cropped (image data loss) + * acoLetterBox: Stretch to screen width, add bars at or crop top and bottom + * + keeps aspect + * - borders at top and bottom + * o top/bottom is cropped if width < height (unusual) + *} + TAspectCorrection = (acoStretch, acoCrop, acoLetterBox); + + TRectCoords = record + Left, Right: double; + Upper, Lower: double; + end; + const // ScoreFactor defines how a notehit of a specified notetype is // measured in comparison to the other types @@ -334,9 +355,49 @@ type procedure SetPosition(Time: real); function GetPosition: real; - procedure GetFrame(Time: Extended); - procedure DrawGL(Screen: integer); + procedure SetScreen(Screen: integer); + function GetScreen(): integer; + + procedure SetScreenPosition(X, Y: double; Z: double = 0.0); + procedure GetScreenPosition(var X, Y, Z: double); + + procedure SetWidth(Width: double); + function GetWidth(): double; + + procedure SetHeight(Height: double); + function GetHeight(): double; + + {** + * Sub-image of the video frame to draw. + * This can be used for zooming or similar purposes. + *} + procedure SetFrameRange(Range: TRectCoords); + function GetFrameRange(): TRectCoords; + + function GetFrameAspect(): real; + + procedure SetAspectCorrection(AspectCorrection: TAspectCorrection); + function GetAspectCorrection(): TAspectCorrection; + + + procedure SetAlpha(Alpha: double); + function GetAlpha(): double; + + procedure SetReflectionSpacing(Spacing: double); + function GetReflectionSpacing(): double; + procedure GetFrame(Time: Extended); + procedure Draw(); + procedure DrawReflection(); + + + property Screen: integer read GetScreen; + property Width: double read GetWidth write SetWidth; + property Height: double read GetHeight write SetHeight; + property Alpha: double read GetAlpha write SetAlpha; + property ReflectionSpacing: double read GetReflectionSpacing write SetReflectionSpacing; + property FrameAspect: real read GetFrameAspect; + property AspectCorrection: TAspectCorrection read GetAspectCorrection write SetAspectCorrection; property Loop: boolean read GetLoop write SetLoop; property Position: real read GetPosition write SetPosition; end; @@ -414,7 +475,15 @@ type (* IVideoDecoder = Interface( IGenericDecoder ) ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] - function Open(const Filename: IPath): TVideoDecodeStream; + function Open(const Filename: IPath): TVideoDecodeStream; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure UpdateTexture(Texture: glUint); + + property Loop: boolean read GetLoop write SetLoop; + property Position: real read GetPosition write SetPosition; end; *) -- cgit v1.2.3 From 1d0359f2c24867091e969b644ecc27b44ad8d96e Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Thu, 10 Jun 2010 19:36:56 +0000 Subject: - added missing Result assignment in TAudioInputProcessor.CheckPlayersConfig - replaced "continue" var with "Done" in UMain - CheckEvents is now a procedure and not a function git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2477 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 35 ++++++++++++++++++----------------- src/base/URecord.pas | 2 +- 2 files changed, 19 insertions(+), 18 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 1d924d56..a2e43fc8 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -39,7 +39,7 @@ uses procedure Main; procedure MainLoop; -function CheckEvents: boolean; +procedure CheckEvents; type TMainThreadExecProc = procedure(Data: Pointer); @@ -354,12 +354,12 @@ var Delay: integer; TicksCurrent: cardinal; TicksBeforeFrame: cardinal; - Continue: boolean; + Done: boolean; begin SDL_EnableKeyRepeat(125, 125); CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - while Continue do + while not Done do begin TicksBeforeFrame := SDL_GetTicks; @@ -368,10 +368,10 @@ begin Joy.Update; // keyboard events - Continue := CheckEvents; + CheckEvents; // display - Continue := Display.Draw; + Done := not Display.Draw; SwapBuffers; // FPS limiter @@ -401,13 +401,14 @@ begin end; end; -function CheckEvents: boolean; +procedure CheckEvents; var Event: TSDL_event; mouseDown: boolean; mouseBtn: integer; + Done: boolean; begin - Result := true; + Done := true; while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -452,17 +453,17 @@ begin if not Assigned(Display.NextScreen) then begin //drop input when changing screens if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Result := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Done := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Result := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Done := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Result := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + Done := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else begin - Result := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); + Done := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); // if screen wants to exit - if not Result then + if not Done then DoQuit; end; end; @@ -542,18 +543,18 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Result := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Done := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Result := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Done := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Result := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + Done := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin // check if screen wants to exit - Result := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); + Done := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit - if not Result then + if not Done then DoQuit; end; diff --git a/src/base/URecord.pas b/src/base/URecord.pas index 6b8ba8cf..5cddcc77 100644 --- a/src/base/URecord.pas +++ b/src/base/URecord.pas @@ -714,7 +714,7 @@ function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal): integer var PlayerState: TBooleanDynArray; begin - CheckPlayersConfig(PlayerCount, PlayerState); + Result := CheckPlayersConfig(PlayerCount, PlayerState); end; {* -- cgit v1.2.3 From e670f3532376dd6aec2bc7b47d2052216be98516 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 10 Jun 2010 19:57:05 +0000 Subject: fixed main loop initialization should fix the close w/o error message after loading that some people reported git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2478 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 ++ 1 file changed, 2 insertions(+) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index a2e43fc8..7bf091ef 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -358,6 +358,8 @@ var begin SDL_EnableKeyRepeat(125, 125); + Continue := true; + CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. while not Done do begin -- cgit v1.2.3 From b3e66eb439491bdc0f8ccdbb0963d34ad1412b30 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 10 Jun 2010 20:12:08 +0000 Subject: fix compiling after r2478 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2480 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 7bf091ef..d951bab1 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -358,7 +358,7 @@ var begin SDL_EnableKeyRepeat(125, 125); - Continue := true; + Done := true; CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. while not Done do -- cgit v1.2.3 From c6977960a37aac90a4ed10164c47d7f5adc5f334 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Thu, 10 Jun 2010 20:31:05 +0000 Subject: finally fixing r2478 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2481 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index d951bab1..57fa5805 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -358,7 +358,7 @@ var begin SDL_EnableKeyRepeat(125, 125); - Done := true; + Done := false; CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. while not Done do -- cgit v1.2.3 From e35df329c61fbda571bc4dc493d22c0815e24a6c Mon Sep 17 00:00:00 2001 From: k-m_schindler Date: Fri, 11 Jun 2010 08:13:10 +0000 Subject: Readability improvement: Rename local variable Done to KeepGoing. Convert While loop to repeat loop in MainLoop. no change in logic. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2485 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 29 ++++++++++++++--------------- 1 file changed, 14 insertions(+), 15 deletions(-) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 57fa5805..174ef162 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -361,8 +361,7 @@ begin Done := false; CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions. - while not Done do - begin + repeat TicksBeforeFrame := SDL_GetTicks; // joypad @@ -385,7 +384,7 @@ begin CountSkipTime; - end; + until Done; end; procedure DoQuit; @@ -408,9 +407,9 @@ var Event: TSDL_event; mouseDown: boolean; mouseBtn: integer; - Done: boolean; + KeepGoing: boolean; begin - Done := true; + KeepGoing := true; while (SDL_PollEvent(@Event) <> 0) do begin case Event.type_ of @@ -455,17 +454,17 @@ begin if not Assigned(Display.NextScreen) then begin //drop input when changing screens if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Done := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + KeepGoing := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Done := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + KeepGoing := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) + KeepGoing := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) else begin - Done := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); + KeepGoing := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y); // if screen wants to exit - if not Done then + if not KeepGoing then DoQuit; end; end; @@ -545,18 +544,18 @@ begin // if there is a visible popup then let it handle input instead of underlying screen // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check) else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - Done := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + KeepGoing := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Done := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + KeepGoing := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) + KeepGoing := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) else begin // check if screen wants to exit - Done := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); + KeepGoing := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); // if screen wants to exit - if not Done then + if not KeepGoing then DoQuit; end; -- cgit v1.2.3 From cb8cc3c455ade321861e92829498cdf4f2c26a9b Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Fri, 11 Jun 2010 15:54:50 +0000 Subject: fix wrong lyric spacing in editor after editing a sentence whose last syllable is freestyle git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2488 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UEditorLyrics.pas | 1 + 1 file changed, 1 insertion(+) (limited to 'src/base') diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas index 0eacd1f9..5030eff5 100644 --- a/src/base/UEditorLyrics.pas +++ b/src/base/UEditorLyrics.pas @@ -195,6 +195,7 @@ begin Word[WordNum].FontStyle := FontStyleI; SetFontStyle(FontStyleI); SetFontSize(SizeR); + SetFontItalic(Italic); Word[WordNum].Width := glTextWidth(Text); Word[WordNum].Text := Text; Word[WordNum].ColR := ColR; -- cgit v1.2.3 From 9033f7e98be7a2bc9221af9903ac5b8b1d098782 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 12 Jun 2010 19:07:39 +0000 Subject: Previously removed option Lyrics:Encoding now back in config.ini: - Possible values: Auto/CP1250/CP1252/UTF8/Locale - Default: Auto - Recommended: Auto or UTF8 - IMPORTANT: CP1250(old US default), CP1252 (old USDX default) and Locale (country specific) are only for backwards compatibility and should not be used as they break portability git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2507 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 9 +++++++++ src/base/USong.pas | 7 ++----- 2 files changed, 11 insertions(+), 5 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 6d01ddc1..b198f22c 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -170,6 +170,9 @@ type Joypad: integer; Mouse: integer; + // default encoding for texts (lyrics, song-name, ...) + DefaultEncoding: TEncoding; + procedure Load(); procedure Save(); procedure SaveNames; @@ -982,6 +985,9 @@ begin // NoteLines NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); + // DefaultEncoding + DefaultEncoding := ParseEncoding(IniFile.ReadString('Lyrics', 'Encoding', ''), encAuto); + LoadThemes(IniFile); LoadInputDeviceCfg(IniFile); @@ -1138,6 +1144,9 @@ begin // NoteLines IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); + //Encoding default + IniFile.WriteString('Lyrics', 'Encoding', EncodingName(DefaultEncoding)); + // Theme IniFile.WriteString('Themes', 'Theme', ITheme[Theme]); diff --git a/src/base/USong.pas b/src/base/USong.pas index 43251f8f..e92c5b45 100644 --- a/src/base/USong.pas +++ b/src/base/USong.pas @@ -179,9 +179,6 @@ uses UMusic, //needed for Lines UNote; //needed for Player -const - DEFAULT_ENCODING = encAuto; - constructor TSong.Create(); begin inherited; @@ -1090,7 +1087,7 @@ begin // File encoding else if (Identifier = 'ENCODING') then begin - self.Encoding := ParseEncoding(Value, DEFAULT_ENCODING); + self.Encoding := ParseEncoding(Value, Ini.DefaultEncoding); end // unsupported tag @@ -1239,7 +1236,7 @@ begin Year := 0; // set to default encoding - Encoding := DEFAULT_ENCODING; + Encoding := Ini.DefaultEncoding; // clear custom header tags SetLength(CustomTags, 0); -- cgit v1.2.3 From ca61aa0c12be9240881108e72bc6c3e928924f1c Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 13 Jun 2010 09:03:10 +0000 Subject: do not save "auto" encoding tag git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2510 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UFiles.pas | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas index 5a258e3e..1a7ca8f8 100644 --- a/src/base/UFiles.pas +++ b/src/base/UFiles.pas @@ -131,7 +131,9 @@ begin if (Song.Encoding = encUTF8) then SongFile.WriteString(UTF8_BOM); - SongFile.WriteLine('#ENCODING:' + EncodingName(Song.Encoding)); + // do not save "auto" encoding tag + if (Song.Encoding <> encAuto) then + SongFile.WriteLine('#ENCODING:' + EncodingName(Song.Encoding)); SongFile.WriteLine('#TITLE:' + EncodeToken(Song.Title)); SongFile.WriteLine('#ARTIST:' + EncodeToken(Song.Artist)); -- cgit v1.2.3 From 46c22d2ccdcfccc8174c34751f63c6a4ca1f022f Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 13 Jun 2010 10:57:33 +0000 Subject: avoid time bar overflows by restricting its range git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2514 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDraw.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas index 308526b8..5bec3eab 100644 --- a/src/base/UDraw.pas +++ b/src/base/UDraw.pas @@ -1140,6 +1140,9 @@ begin (LyricsState.TotalTime > 0) then begin LyricsProgress := CurLyricsTime / LyricsState.TotalTime; + // avoid that the bar "overflows" for inaccurate song lengths + if (LyricsProgress > 1.0) then + LyricsProgress := 1.0; glTexCoord2f((width * LyricsProgress) / 8, 0); glVertex2f(x + width * LyricsProgress, y); -- cgit v1.2.3 From 11ab83b9460c672ba4a6eb27a79315d9dda71ff6 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Tue, 15 Jun 2010 16:24:50 +0000 Subject: move check for OnSentenceEnd call from NewNote to NewBeatDetect - fix rating popup for lines that end with a freestyle note - better handling of songs with bad line breaks this may need some additional testing! git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2528 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UNote.pas | 45 +++++++++++++++++++++++++++++++-------------- 1 file changed, 31 insertions(+), 14 deletions(-) (limited to 'src/base') diff --git a/src/base/UNote.pas b/src/base/UNote.pas index d6fdcb13..d800d30e 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -351,8 +351,39 @@ begin end; procedure NewBeatDetect(Screen: TScreenSing); + var + SentenceEnd: integer; + I: cardinal; begin NewNote(Screen); + + // check for sentence end + // we check all lines here because a new sentence may + // have been started even before the old one finishes + // due to corrupt lien breaks + // checking only current line works to, but may lead to + // weird ratings for the song files w/ the mentioned + // errors + // To-Do Philipp : check current and last line should + // do it for most corrupt txt and for lines in + // non-corrupt txts that start immediatly after the prev. + // line ends + if (assigned(Screen)) then + begin + for I := 0 to Lines[0].High do + begin + with Lines[0].Line[I] do + begin + if (HighNote > 0) then + begin + SentenceEnd := Note[HighNote].Start + Note[HighNote].Length; + + if (LyricsState.OldBeatD < SentenceEnd) and (LyricsState.CurrentBeatD >= SentenceEnd) then + Screen.OnSentenceEnd(I); + end; + end; + end; + end; end; procedure NewNote(Screen: TScreenSing); @@ -582,20 +613,6 @@ begin end; // for PlayerIndex //Log.LogStatus('EndBeat', 'NewBeat'); - - // on sentence end -> for LineBonus and display of SingBar (rating pop-up) - if (SentenceDetected >= Low(Lines[0].Line)) and - (SentenceDetected <= High(Lines[0].Line)) then - begin - Line := @Lines[0].Line[SentenceDetected]; - CurrentLineFragment := @Line.Note[Line.HighNote]; - if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then - begin - if assigned(Screen) then - Screen.OnSentenceEnd(SentenceDetected); - end; - end; - end; end. -- cgit v1.2.3 From 008c58c6ac1cdbe0fdb01ce79567b7f0e815b83a Mon Sep 17 00:00:00 2001 From: tobigun Date: Sat, 19 Jun 2010 16:36:25 +0000 Subject: Bugfix: do not call Inc() on PByteArray pointers. It will not increment by one byte, but by SizeOf(ByteArray) bytes which is some KB. As a result the pointer will point to an illegal memory address. git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2549 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index 41d6e80c..ff0fad04 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -1006,7 +1006,7 @@ begin Sample[0] := Value; Sample[1] := Value; // increase to next frame - Inc(Buffer, FrameSize); + Inc(PByte(Buffer), FrameSize); end; end; -- cgit v1.2.3 From 6731fad709d6ae924c15b0781d8debadaaf4840c Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sun, 4 Jul 2010 15:16:46 +0000 Subject: - divide ScreenW by 2 in modi list if screens=2 and fullscreen (UIni) - fixed crash after singing (with screens=2) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2572 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index b198f22c..6dd2956d 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -841,7 +841,7 @@ begin begin Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video'); SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); + IResolution[High(IResolution)] := IntToStr(Modes^.w div (Screens+1)) + 'x' + IntToStr(Modes^.h); Inc(Modes); end; -- cgit v1.2.3 From 9eced6874025048ffa680a87625797dd6b605d80 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Wed, 7 Jul 2010 19:52:32 +0000 Subject: fixed conversion of ultrastar.db from 1.0.1a to 1.1 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2574 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UDataBase.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas index cccedc69..5cb15182 100644 --- a/src/base/UDataBase.pas +++ b/src/base/UDataBase.pas @@ -260,7 +260,7 @@ begin // insert old values into new db-schemes (/tables) ScoreDB.ExecSQL( 'INSERT INTO ' + cUS_Scores + - ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); + ' SELECT SongID, Difficulty, Player, Score, ''NULL'' FROM us_scores_101;'); end else begin Log.LogInfo( -- cgit v1.2.3 From 1e38a5b1aeaef43c4807113251705a5cc1099ae7 Mon Sep 17 00:00:00 2001 From: whiteshark0 Date: Sun, 18 Jul 2010 10:33:05 +0000 Subject: fix party player selection git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2581 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UParty.pas | 16 +++++++++++++++- 1 file changed, 15 insertions(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UParty.pas b/src/base/UParty.pas index 2f89afd6..bc485dca 100644 --- a/src/base/UParty.pas +++ b/src/base/UParty.pas @@ -174,6 +174,9 @@ type returns true on success } function SetRanking(Ranking: AParty_TeamRanking): Boolean; + { increases players TimesPlayed value } + procedure IncTimesPlayed; + { increases round counter by 1 and clears all round specific information; returns the number of the current round or -1 if last round has already been played } @@ -210,7 +213,7 @@ type { returns a string like "Team 1 (and Team 2) win" } function GetWinnerString(Round: integer): UTF8String; - destructor Destroy; + destructor Destroy; override; end; const @@ -713,6 +716,15 @@ begin SetRanking(Ranking); end; +{ increases players TimesPlayed value } +procedure TPartyGame.IncTimesPlayed; + var I: Integer; +begin + for I := 0 to High(Teams) do + with Teams[I] do + Inc(Players[NextPlayer].TimesPlayed); +end; + { increases round counter by 1 and clears all round specific information; returns the number of the current round or -1 if last round has already been played } @@ -722,6 +734,8 @@ begin // some lines concerning the previous round if (CurRound >= 0) then begin + IncTimesPlayed; + Rounds[CurRound].AlreadyPlayed := true; GenScores; -- cgit v1.2.3 From 0ad3fcc7db20508948d5c80158ab6ba4bd4079e6 Mon Sep 17 00:00:00 2001 From: davidus01 Date: Thu, 22 Jul 2010 22:50:31 +0000 Subject: bug: if in first sentence is one note than not execute onsentence procedure git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2605 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UNote.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UNote.pas b/src/base/UNote.pas index d800d30e..ff9c6b57 100644 --- a/src/base/UNote.pas +++ b/src/base/UNote.pas @@ -374,7 +374,7 @@ begin begin with Lines[0].Line[I] do begin - if (HighNote > 0) then + if (HighNote >= 0) then begin SentenceEnd := Note[HighNote].Start + Note[HighNote].Length; -- cgit v1.2.3 From 310d127b07240e75aa29798cb1b024cede03cbf6 Mon Sep 17 00:00:00 2001 From: canni0 Date: Sun, 15 Aug 2010 18:23:25 +0000 Subject: - fixed absolute path function (thx to the anonymous irc guy) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2612 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UPath.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UPath.pas b/src/base/UPath.pas index 7c00e7b1..7cb2f649 100644 --- a/src/base/UPath.pas +++ b/src/base/UPath.pas @@ -1028,7 +1028,7 @@ end; function TPathImpl.IsAbsolute(): boolean; begin AssertRefCount; - Result := FileSystem.FileIsReadOnly(Self); + Result := FileSystem.FileIsAbsolute(Self); end; function TPathImpl.GetAttr(): cardinal; -- cgit v1.2.3 From 4ae2434da8aafa5c92ebc4c0db99557a11789ff0 Mon Sep 17 00:00:00 2001 From: brunzelchen Date: Sat, 4 Sep 2010 10:18:40 +0000 Subject: changed default cover cache size from 128 to 256 pixels git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2630 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UIni.pas | 5 +---- 1 file changed, 1 insertion(+), 4 deletions(-) (limited to 'src/base') diff --git a/src/base/UIni.pas b/src/base/UIni.pas index 6dd2956d..beb9faa8 100644 --- a/src/base/UIni.pas +++ b/src/base/UIni.pas @@ -929,10 +929,7 @@ begin LoadScreenModes(IniFile); // TextureSize (aka CachedCoverSize) - // Note: a default cached cover size of 128 pixels is big enough, - // 256 pixels are already noticeably slow with 180 covers in the song-screen - // displayed at once. In additon the covers.db will be too big. - TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', '128')); + TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', '256')); // SingWindow SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); -- cgit v1.2.3 From b73d02583e3bab78ee70e2d7af311553b8bbdea2 Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 5 Sep 2010 15:26:08 +0000 Subject: fix resize-bug in SDL < 1.2.14 git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2631 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMain.pas | 3 +++ 1 file changed, 3 insertions(+) (limited to 'src/base') diff --git a/src/base/UMain.pas b/src/base/UMain.pas index 174ef162..14a543d1 100644 --- a/src/base/UMain.pas +++ b/src/base/UMain.pas @@ -489,6 +489,9 @@ begin SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) else SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); + {$ELSE} + Screen.W := ScreenW; + Screen.H := ScreenH; {$IFEND} end; SDL_KEYDOWN: -- cgit v1.2.3 From 9ac239239c6f2c2131d62b151a45cc9dd895ccc9 Mon Sep 17 00:00:00 2001 From: canni0 Date: Wed, 29 Sep 2010 13:42:56 +0000 Subject: - removed hardcoded bebeto loop git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2636 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UMusic.pas | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'src/base') diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas index ff0fad04..c775fd51 100644 --- a/src/base/UMusic.pas +++ b/src/base/UMusic.pas @@ -939,7 +939,7 @@ begin Option := AudioPlayback.OpenSound(SoundPath.Append('option change col.mp3')); Click := AudioPlayback.OpenSound(SoundPath.Append('rimshot022b.mp3')); - BGMusic := AudioPlayback.OpenSound(SoundPath.Append('Bebeto_-_Loop010.mp3')); + BGMusic := AudioPlayback.OpenSound(SoundPath.Append('background track.mp3')); if (BGMusic <> nil) then BGMusic.Loop := True; -- cgit v1.2.3 From 5e13354bb1fcee732a92c89d6d0ac9888f43daeb Mon Sep 17 00:00:00 2001 From: tobigun Date: Sun, 10 Oct 2010 18:55:31 +0000 Subject: strings adjusted (removed 'RC'-parts) git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@2656 b956fd51-792f-4845-bead-9b4dfca2ff2c --- src/base/UConfig.pas | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) (limited to 'src/base') diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas index 74415f4d..e48b5493 100644 --- a/src/base/UConfig.pas +++ b/src/base/UConfig.pas @@ -130,7 +130,7 @@ const USDX_VERSION_MAJOR = 1; USDX_VERSION_MINOR = 1; USDX_VERSION_RELEASE = 0; - USDX_VERSION_STATE = 'RC'; + USDX_VERSION_STATE = ''; USDX_STRING = 'UltraStar Deluxe'; (* @@ -229,4 +229,4 @@ begin ' Build'; end; -end. \ No newline at end of file +end. -- cgit v1.2.3