diff options
Diffstat (limited to 'Game/Code/Classes')
56 files changed, 26151 insertions, 0 deletions
diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas new file mode 100644 index 00000000..0bd61fa7 --- /dev/null +++ b/Game/Code/Classes/TextGL.pas @@ -0,0 +1,562 @@ +unit TextGL;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses OpenGL12,
+ SDL,
+ UTexture,
+ Classes,
+ dialogs,
+ SDL_ttf,
+ ULog;
+
+procedure BuildFont; // Build Our Bitmap Font
+procedure KillFont; // Delete The Font
+function glTextWidth(text: pchar): real; // Returns Text Width
+procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
+procedure glPrintLetter(letter: char);
+procedure glPrintLetterCut(letter: char; Start, Finish: real);
+procedure glPrint(text: pchar); // Custom GL "Print" Routine
+procedure glPrintCut(text: pchar);
+procedure SetFontPos(X, Y: real); // Sets X And Y
+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);
+
+// Start of SDL_ttf
+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;
+procedure printrandomtext();
+// End of SDL_ttf
+
+type
+ TTextGL = record
+ X: real;
+ Y: real;
+ Text: string;
+ Size: real;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ end;
+
+ TFont = record
+ Tex: TTexture;
+ Width: array[0..255] of byte;
+ AspectW: real;
+ Centered: boolean;
+ Done: real;
+ Outline: real;
+ Italic: boolean;
+ end;
+
+
+var
+ base: GLuint; // Base Display List For The Font Set
+ Fonts: array of TFont;
+ ActFont: integer;
+ PColR: real; // temps for glPrintDone
+ PColG: real;
+ PColB: real;
+
+implementation
+
+uses UMain,
+ UCommon,
+ {$IFDEF win32}
+ windows,
+ {$ELSE}
+ lclintf,
+ lcltype,
+ {$ENDIF}
+ SysUtils,
+ {$IFDEF LAZARUS}
+ LResources,
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ MacResources,
+ {$ENDIF}
+ UGraphic;
+
+procedure BuildFont; // Build Our Bitmap Font
+
+ procedure loadfont( aID : integer; aType, aResourceName : String);
+ {$IFDEF LAZARUS}
+ var
+ lLazRes : TLResource;
+ lResData : TStringStream;
+ begin
+ try
+ lLazRes := LazFindResource( aResourceName, aType );
+ if lLazRes <> nil then
+ begin
+ lResData := TStringStream.create( lLazRes.value );
+ try
+ lResData.position := 0;
+ lResData.Read(Fonts[ aID ].Width, 256);
+ finally
+ freeandnil( lResData );
+ end;
+ end;
+
+ {$ELSE}
+ var
+ Rejestr: TResourceStream;
+ begin
+ try
+ Rejestr := TResourceStream.Create(HInstance, aResourceName , pchar( aType ) );
+ try
+ Rejestr.Read(Fonts[ aID ].Width, 256);
+ finally
+ Rejestr.Free;
+ end;
+ {$ENDIF}
+
+ except
+ Log.LogStatus( 'Could not load font : loadfont( '+ inttostr( aID ) +' , '+aType+' )' , 'ERROR');
+ end;
+ end;
+
+var
+ font: HFONT; // Windows Font ID
+ h_dc: hdc;
+ Pet: integer;
+begin
+ ActFont := 0;
+
+ Log.LogStatus( '' , '---------------------------');
+
+ Log.LogStatus( 'Font' , '---------------------------');
+ SetLength(Fonts, 5);
+ Fonts[0].Tex := Texture.LoadTexture(true, 'Font', 'PNG', 'Transparent', 0);
+ Fonts[0].Tex.H := 30;
+ Fonts[0].AspectW := 0.9;
+ Fonts[0].Done := -1;
+ Fonts[0].Outline := 0;
+
+ Log.LogStatus( 'FontB' , '---------------------------');
+
+ Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', 'PNG', 'Transparent', 0);
+ Fonts[1].Tex.H := 30;
+ Fonts[1].AspectW := 1;
+ Fonts[1].Done := -1;
+ Fonts[1].Outline := 0;
+
+ Log.LogStatus( 'FontO' , '---------------------------');
+ Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', 'PNG', 'Transparent', 0);
+ Fonts[2].Tex.H := 30;
+ Fonts[2].AspectW := 0.95;
+ Fonts[2].Done := -1;
+ Fonts[2].Outline := 5;
+
+ Log.LogStatus( 'FontO2' , '---------------------------');
+ Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', 'PNG', 'Transparent', 0);
+ Fonts[3].Tex.H := 30;
+ Fonts[3].AspectW := 0.95;
+ Fonts[3].Done := -1;
+ Fonts[3].Outline := 4;
+
+{ Fonts[4].Tex := Texture.LoadTexture('FontO', 'BMP', 'Arrow', 0); // for score screen
+ Fonts[4].Tex.H := 30;
+ Fonts[4].AspectW := 0.95;
+ Fonts[4].Done := -1;
+ Fonts[4].Outline := 5;}
+
+
+
+ loadfont( 0, 'FNT', 'Font' );
+ loadfont( 1, 'FNT', 'FontB' );
+ loadfont( 2, 'FNT', 'FontO' );
+ loadfont( 3, 'FNT', 'FontO2' );
+
+{ Rejestr := TResourceStream.Create(HInstance, 'FontO', 'FNT');
+ Rejestr.Read(Fonts[4].Width, 256);
+ Rejestr.Free;}
+
+ for Pet := 0 to 255 do
+ Fonts[1].Width[Pet] := Fonts[1].Width[Pet] div 2;
+
+ for Pet := 0 to 255 do
+ Fonts[2].Width[Pet] := Fonts[2].Width[Pet] div 2 + 2;
+
+ for Pet := 0 to 255 do
+ Fonts[3].Width[Pet] := Fonts[3].Width[Pet] + 1;
+
+{ for Pet := 0 to 255 do
+ Fonts[4].Width[Pet] := Fonts[4].Width[Pet] div 2 + 2;}
+
+end;
+
+procedure KillFont; // Delete The Font
+begin
+// glDeleteLists(base, 256); // Delete All 96 Characters
+end;
+
+function glTextWidth(text: pchar): real;
+var
+ Letter: char;
+ i: integer;
+begin
+// Log.LogStatus(Text, 'glTextWidth');
+ Result := 0;
+ for i := 0 to Length(text) do
+ begin
+ Letter := Text[i];
+ // Bugfix: does not work with FPC, probably because a part of text is assigned to itself
+ //text := pchar(Copy(text, 2, Length(text)-1));
+ Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
+ end;
+end;
+
+procedure glPrintDone(text: pchar; Done: real; ColR, ColG, ColB: real);
+begin
+ Fonts[ActFont].Done := Done;
+ PColR := ColR;
+ PColG := ColG;
+ PColB := ColB;
+ glPrintCut(text);
+ Fonts[ActFont].Done := -1;
+end;
+
+procedure glPrintLetter(Letter: char);
+var
+ TexX, TexY: real;
+ TexR, TexB: real;
+ FWidth: real;
+ PL, PT: real;
+ PR, PB: real;
+ XItal: real; // X shift for italic type letter
+begin
+ with Fonts[ActFont].Tex do
+ begin
+ FWidth := Fonts[ActFont].Width[Ord(Letter)];
+
+ W := FWidth * (H/30) * Fonts[ActFont].AspectW;
+ // H := 30;
+
+ // set texture positions
+ TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
+ TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024
+ TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
+ TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
+
+ // set vector positions
+ PL := X - Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW /2;
+ PT := Y;
+ PR := PL + W + Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
+ PB := PT + H;
+
+ if Fonts[ActFont].Italic = false then
+ XItal := 0
+ else
+ XItal := 12;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, TexNum);
+
+ glBegin(GL_QUADS);
+ try
+ 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);
+ finally
+ glEnd;
+ end;
+
+ X := X + W;
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end; // with
+end;
+
+procedure glPrintLetterCut(letter: char; Start, Finish: real);
+var
+ TexX, TexY: real;
+ TexR, TexB: real;
+ TexTemp: real;
+ FWidth: real;
+ PL, PT: real;
+ PR, PB: real;
+ OutTemp: real;
+ XItal: real;
+begin
+ with Fonts[ActFont].Tex do begin
+ FWidth := Fonts[ActFont].Width[Ord(Letter)];
+
+ W := FWidth * (H/30) * Fonts[ActFont].AspectW;
+// H := 30;
+ OutTemp := Fonts[ActFont].Outline * (H/30) * Fonts[ActFont].AspectW;
+
+ // set texture positions
+ TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Fonts[ActFont].Outline/1024;
+ TexY := (ord(Letter) div 16) * 1/16 + 2/1024; // 2/1024
+ TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Fonts[ActFont].Outline/1024;
+ TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
+
+ TexTemp := TexX + Start * (TexR - TexX);
+ TexR := TexX + Finish * (TexR - TexX);
+ TexX := TexTemp;
+
+ // set vector positions
+ PL := X - OutTemp / 2 + OutTemp * Start;
+ PT := Y;
+ PR := PL + (W + OutTemp) * (Finish - Start);
+ PB := PT + H;
+ if Fonts[ActFont].Italic = false then
+ XItal := 0
+ else
+ XItal := 12;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, 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); // not tested with XItal
+ glEnd;
+ X := X + W * (Finish - Start);
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end; // with
+
+end;
+
+procedure glPrint(text: pchar); // Custom GL "Print" Routine
+var
+// Letter : char;
+ iPos : Integer;
+
+begin
+ if (Text = '') then // If There's No Text
+ Exit; // Do Nothing
+
+(*
+ while (length(text) > 0) do
+ begin
+ // cut
+ Letter := Text[0];
+ Text := pchar(Copy(Text, 2, Length(Text)-1));
+
+ // print
+ glPrintLetter(Letter);
+ end; // while
+*)
+
+ // This code is better, because doing a Copy of for every
+ // letter in a string is a waste of CPU & Memory resources.
+ // Copy operations are quite memory intensive, and this simple
+ // code achieves the same result.
+ for iPos := 0 to length( text ) - 1 do
+ begin
+ glPrintLetter( Text[iPos] );
+ end;
+
+end;
+
+function NextPowerOfTwo(Value: Integer): Integer;
+// tyty to Asphyre
+begin
+ Result:= 1;
+ asm
+ xor ecx, ecx
+ bsr ecx, Value
+ inc ecx
+ shl Result, cl
+ end;
+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 );
+ 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, 0, intermediary, 0);
+
+ 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;
+
+procedure glPrintCut(text: pchar);
+var
+ Letter: char;
+ PToDo: real;
+ PTotWidth: real;
+ PDoingNow: real;
+ S: string;
+begin
+ if (Text = '') then // If There's No Text
+ Exit; // Do Nothing
+
+ PTotWidth := glTextWidth(Text);
+ PToDo := Fonts[ActFont].Done;
+
+ while (length(text) > 0) do begin
+ // cut
+ Letter := Text[0];
+ Text := pchar(Copy(Text, 2, Length(Text)-1));
+
+ // analyze
+ S := Letter;
+ PDoingNow := glTextWidth(pchar(S)) / PTotWidth;
+
+ // drawing
+ if (PToDo > 0) and (PDoingNow <= PToDo) then
+ glPrintLetter(Letter);
+
+ if (PToDo > 0) and (PDoingNow > PToDo) then begin
+ glPrintLetterCut(Letter, 0, PToDo / PDoingNow);
+ glColor3f(PColR, PColG, PColB);
+ glPrintLetterCut(Letter, PToDo / PDoingNow, 1);
+ end;
+
+ if (PToDo <= 0) then
+ glPrintLetter(Letter);
+
+ PToDo := PToDo - PDoingNow;
+
+ end; // while
+end;
+
+
+procedure SetFontPos(X, Y: real);
+begin
+ Fonts[ActFont].Tex.X := X;
+ Fonts[ActFont].Tex.Y := Y;
+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;
+
+
+{$IFDEF LAZARUS}
+{$IFDEF win32}
+initialization
+ {$I UltraStar.lrs}
+{$ENDIF}
+{$ENDIF}
+
+
+end.
+
+
diff --git a/Game/Code/Classes/UAudioCore_Bass.pas b/Game/Code/Classes/UAudioCore_Bass.pas new file mode 100644 index 00000000..55148f95 --- /dev/null +++ b/Game/Code/Classes/UAudioCore_Bass.pas @@ -0,0 +1,116 @@ +unit UAudioCore_Bass;
+ +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + Classes, + SysUtils; + +type + TAudioCore_Bass = class + private + public + class function ErrorGetString(): string; overload; + class function ErrorGetString(errCode: integer): string; overload; + end; + + +implementation + +uses + UMain, + ULog, + bass; + +class function TAudioCore_Bass.ErrorGetString(): string; +begin + ErrorGetString(BASS_ErrorGetCode()); +end; + +class 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_NOPAUSE:
+ result := 'No pause';
+ 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_PLAYING:
+ result := 'Channel is playing';
+ 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_UNKNOWN:
+ result := 'Unknown error'; + else + result := 'Unknown error'; + end; +end; +
+end.
\ No newline at end of file diff --git a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas new file mode 100644 index 00000000..646e9eef --- /dev/null +++ b/Game/Code/Classes/UAudioDecoder_FFMpeg.pas @@ -0,0 +1,771 @@ +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} + + +uses + Classes, + {$IFDEF win32} + windows, + {$ENDIF} + SysUtils, + UMusic; + +implementation + +uses + {$ifndef win32} + libc, + {$endif} + UIni, + UMain, + avcodec, // FFMpeg Audio file decoding + avformat, + avutil, + avio, // used for url_ferror + mathematics, // used for av_rescale_q + SDL, + ULog, + UConfig; + + +type + PPacketQueue = ^TPacketQueue; + TPacketQueue = class + private + firstPkt, + lastPkt : PAVPacketList; + nbPackets : integer; + size : integer; + mutex : PSDL_Mutex; + cond : PSDL_Cond; + quit : boolean; + + public + constructor Create(); + destructor Destroy(); override; + + function Put(pkt : PAVPacket): integer; + function Get(var pkt: TAVPacket; block: boolean): integer; + procedure Flush(); + end; + +const + MAX_AUDIOQ_SIZE = (5 * 16 * 1024); + +var + EOFPacket: TAVPacket; + FlushPacket: TAVPacket; + +type + PAudioBuffer = ^TAudioBuffer; + TAudioBuffer = array[0 .. (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3 div 2)-1] of byte; + +type + TFFMpegDecodeStream = class(TAudioDecodeStream) + private + _EOF: boolean; // end-of-stream flag + _EOF_lock : PSDL_Mutex; + + lock : PSDL_Mutex; + resumeCond : PSDL_Cond; + + quitRequest : boolean; + + seekRequest: boolean; + seekFlags : integer; + seekPos : int64; + + parseThread: PSDL_Thread; + packetQueue: TPacketQueue; + + // FFMpeg internal data + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamIndex : Integer; + ffmpegStream : PAVStream; + + // state-vars for DecodeFrame + pkt : TAVPacket; + audio_pkt_data : PChar; + audio_pkt_size : integer; + + // state-vars for AudioCallback + audio_buf_index : cardinal; + audio_buf_size : cardinal; + audio_buf : TAudioBuffer; + + function DecodeFrame(var buffer: TAudioBuffer; bufSize: integer): integer; + procedure SetEOF(state: boolean); + public + constructor Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); + destructor Destroy(); override; + + procedure Close(); override; + + function GetLength(): real; override; + function GetAudioFormatInfo(): TAudioFormatInfo; override; + function GetPosition: real; override; + procedure SetPosition(Time: real); override; + function IsEOF(): boolean; override; + + function ReadData(Buffer: PChar; BufSize: integer): integer; override; + end; + +type + TAudioDecoder_FFMpeg = class( TInterfacedObject, IAudioDecoder ) + private + class function FindAudioStreamIndex(pFormatCtx : PAVFormatContext): integer; + public + function GetName: String; + + function InitializeDecoder(): boolean; + function Open(const Filename: string): TAudioDecodeStream; + end; + +function ParseAudio(streamPtr: Pointer): integer; cdecl; forward; + +var + singleton_AudioDecoderFFMpeg : IAudioDecoder; + + +{ TFFMpegDecodeStream } + +constructor TFFMpegDecodeStream.Create(pFormatCtx: PAVFormatContext; + pCodecCtx: PAVCodecContext; pCodec: PAVCodec; + ffmpegStreamID : Integer; ffmpegStream: PAVStream); +begin + inherited Create(); + + packetQueue := TPacketQueue.Create(); + + audio_pkt_data := nil; + audio_pkt_size := 0; + + audio_buf_index := 0; + audio_buf_size := 0; + + FillChar(pkt, sizeof(TAVPacket), 0); + + Self.pFormatCtx := pFormatCtx; + Self.pCodecCtx := pCodecCtx; + Self.pCodec := pCodec; + Self.ffmpegStreamIndex := ffmpegStreamIndex; + Self.ffmpegStream := ffmpegStream; + + _EOF := false; + _EOF_lock := SDL_CreateMutex(); + + lock := SDL_CreateMutex(); + resumeCond := SDL_CreateCond(); + + parseThread := SDL_CreateThread(@ParseAudio, Self); +end; + +destructor TFFMpegDecodeStream.Destroy(); +begin + //Close(); + //packetQueue.Free(); + inherited; +end; + +procedure TFFMpegDecodeStream.Close(); +begin + // TODO: abort thread + //quitRequest := true; + //SDL_WaitThread(parseThread, nil); + + (* + // Close the codec + if (pCodecCtx <> nil) then + begin + avcodec_close(pCodecCtx); + pCodecCtx := nil; + end; + + // Close the video file + if (pFormatCtx <> nil) then + begin + av_close_input_file(pFormatCtx); + pFormatCtx := nil; + end; + *) +end; + +function TFFMpegDecodeStream.GetLength(): real; +begin + result := pFormatCtx^.duration / AV_TIME_BASE; +end; + +function TFFMpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo; +begin + result.Channels := pCodecCtx^.channels; + result.SampleRate := pCodecCtx^.sample_rate; + //result.Format := pCodecCtx^.sample_fmt; // sample_fmt not yet used by FFMpeg + result.Format := asfS16; // use FFMpeg's standard format +end; + +function TFFMpegDecodeStream.IsEOF(): boolean; +begin + SDL_mutexP(_EOF_lock); + result := _EOF; + SDL_mutexV(_EOF_lock); +end; + +procedure TFFMpegDecodeStream.SetEOF(state: boolean); +begin + SDL_mutexP(_EOF_lock); + _EOF := state; + SDL_mutexV(_EOF_lock); +end; + +function TFFMpegDecodeStream.GetPosition(): real; +var + bytes: integer; +begin + // see: tutorial on synching (audio-clock) + Result := 0; +end; + +procedure TFFMpegDecodeStream.SetPosition(Time: real); +var + bytes: integer; +begin + SDL_mutexP(lock); + seekPos := Trunc(Time * AV_TIME_BASE); + // FIXME: seek_flags = rel < 0 ? AVSEEK_FLAG_BACKWARD : 0 + seekFlags := 0;//AVSEEK_FLAG_BACKWARD; + seekRequest := true; + SDL_CondSignal(resumeCond); + SDL_mutexV(lock); +end; + +function ParseAudio(streamPtr: Pointer): integer; cdecl; +var + packet: TAVPacket; + stream: TFFMpegDecodeStream; + seekTarget: int64; + eofState: boolean; + pbIOCtx: PByteIOContext; +begin + stream := TFFMpegDecodeStream(streamPtr); + eofState := false; + + while (true) do + begin + //SafeWriteLn('Hallo'); + + SDL_mutexP(stream.lock); + // wait if end-of-file reached + if (eofState) then + begin + if (not (stream.seekRequest or stream.quitRequest)) then + begin + // signal end-of-file + stream.packetQueue.put(@EOFPacket); + // wait for reuse or destruction of stream + repeat + SDL_CondWait(stream.resumeCond, stream.lock); + until (stream.seekRequest or stream.quitRequest); + end; + eofState := false; + stream.SetEOF(false); + end; + + if (stream.quitRequest) then + begin + break; + end; + + // handle seek-request + if(stream.seekRequest) then + begin + // TODO: Do we need this? + // The position is converted to AV_TIME_BASE and then to the stream-specific base. + // Why not convert to the stream-specific one from the beginning. + seekTarget := av_rescale_q(stream.seekPos, AV_TIME_BASE_Q, stream.ffmpegStream^.time_base); + if(av_seek_frame(stream.pFormatCtx, stream.ffmpegStreamIndex, + seekTarget, stream.seekFlags) < 0) then + begin + // this will crash in FPC due to a bug + //Log.LogStatus({stream.pFormatCtx^.filename +} ': error while seeking', 'UAudioDecoder_FFMpeg'); + end + else + begin + stream.packetQueue.Flush(); + stream.packetQueue.Put(@FlushPacket); + end; + stream.seekRequest := false; + end; + + SDL_mutexV(stream.lock); + + + if(stream.packetQueue.size > MAX_AUDIOQ_SIZE) then + begin + SDL_Delay(10); + continue; + end; + + if(av_read_frame(stream.pFormatCtx, packet) < 0) then + begin + // check for end-of-file (eof is not an error) + {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)} + pbIOCtx := stream.pFormatCtx^.pb; + {$ELSE} + pbIOCtx := @stream.pFormatCtx^.pb; + {$IFEND} + + if(url_feof(pbIOCtx) <> 0) then + begin + SafeWriteLn('feof'); + eofState := true; + continue; + end; + + // check for errors + if(url_ferror(pbIOCtx) = 0) then + begin + SafeWriteLn('Errorf'); + // no error -> wait for user input + SDL_Delay(100); + continue; + end + else + begin + // an error occured -> abort + // TODO: eof or quit? + eofState := true; + continue; + end; + end; + + //SafeWriteLn( 'ffmpeg - av_read_frame' ); + + if(packet.stream_index = stream.ffmpegStreamIndex) then + begin + //SafeWriteLn( 'packet_queue_put' ); + stream.packetQueue.put(@packet); + end + else + begin + av_free_packet(@packet); + end; + end; + + SafeWriteLn('Done: ' + inttostr(stream.packetQueue.nbPackets)); + + result := 0; +end; + +function TFFMpegDecodeStream.DecodeFrame(var buffer: TAudioBuffer; bufSize: integer): integer; +var + len1, + data_size: integer; +begin + result := -1; + + if EOF then + exit; + + while(true) do + begin + while (audio_pkt_size > 0) do + begin + //SafeWriteLn( 'got audio packet' ); + data_size := bufSize; + + {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0 + len1 := avcodec_decode_audio2(pCodecCtx, @buffer, + data_size, audio_pkt_data, audio_pkt_size); + {$ELSE} + // FIXME: with avcodec_decode_audio a package could contain several frames + // this is not handled yet + len1 := avcodec_decode_audio(pCodecCtx, @buffer, + data_size, audio_pkt_data, audio_pkt_size); + {$IFEND} + + //SafeWriteLn('avcodec_decode_audio : ' + inttostr( len1 )); + + if(len1 < 0) then + begin + // if error, skip frame + SafeWriteLn( 'Skip audio frame' ); + audio_pkt_size := 0; + break; + end; + + Inc(audio_pkt_data, len1); + Dec(audio_pkt_size, len1); + + if (data_size <= 0) then + begin + // No data yet, get more frames + continue; + end; + + // We have data, return it and come back for more later + result := data_size; + exit; + end; + + if (pkt.data <> nil) then + begin + av_free_packet(@pkt); + end; + + if (packetQueue.quit) then + exit; + + if (packetQueue.Get(pkt, true) < 0) then + exit; + + audio_pkt_data := PChar(pkt.data); + audio_pkt_size := pkt.size; + + if (audio_pkt_data = PChar(FlushPacket.data)) then + begin + avcodec_flush_buffers(pCodecCtx); + SafeWriteLn('Flush'); + continue; + end; + + // check for end-of-file + if (audio_pkt_data = PChar(EOFPacket.data)) then + begin + // end-of-file reached -> set EOF-flag + SetEOF(true); + SafeWriteLn('EOF'); + // note: buffer is not (even partially) filled -> no data to return + exit; + end; + + //SafeWriteLn( 'Audio Packet Size - ' + inttostr(audio_pkt_size) ); + end; +end; + +function TFFMpegDecodeStream.ReadData(Buffer : PChar; BufSize: integer): integer; +var + outStream : TFFMpegDecodeStream; + len1, + audio_size : integer; + pSrc : Pointer; + len : integer; +begin + len := BufSize; + result := -1; + + // end-of-file reached + if EOF then + exit; + + while (len > 0) do begin + if (audio_buf_index >= audio_buf_size) then + begin + // We have already sent all our data; get more + audio_size := DecodeFrame(audio_buf, sizeof(TAudioBuffer)); + //SafeWriteLn('audio_decode_frame : '+ inttostr(audio_size)); + + if(audio_size < 0) then + begin + // If error, output silence + audio_buf_size := 1024; + FillChar(audio_buf, audio_buf_size, #0); + //SafeWriteLn( 'Silence' ); + end + else + begin + audio_buf_size := audio_size; + end; + audio_buf_index := 0; + end; + + len1 := audio_buf_size - audio_buf_index; + if (len1 > len) then + len1 := len; + + pSrc := PChar(@audio_buf) + audio_buf_index; + {$ifdef WIN32} + CopyMemory(Buffer, pSrc , len1); + {$else} + memcpy(Buffer, pSrc , len1); + {$endif} + + Dec(len, len1); + Inc(PChar(Buffer), len1); + Inc(audio_buf_index, len1); + end; + + result := BufSize; +end; + + +{ TAudioDecoder_FFMpeg } + +function TAudioDecoder_FFMpeg.GetName: String; +begin + result := 'FFMpeg_Decoder'; +end; + +function TAudioDecoder_FFMpeg.InitializeDecoder: boolean; +begin + //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFMpeg'); + + av_register_all(); + + // init end-of-file package + av_init_packet(EOFPacket); + EOFPacket.data := Pointer(PChar('EOF')); + + // init flush package + av_init_packet(FlushPacket); + FlushPacket.data := Pointer(PChar('FLUSH')); + + result := true; +end; + +class function TAudioDecoder_FFMpeg.FindAudioStreamIndex(pFormatCtx : PAVFormatContext): integer; +var + i : integer; + streamIndex: integer; + stream : PAVStream; +begin + // Find the first audio stream + streamIndex := -1; + + for i := 0 to pFormatCtx^.nb_streams-1 do + begin + //Log.LogStatus('aFormatCtx.streams[i] : ' + inttostr(i), 'UAudio_FFMpeg'); + stream := pFormatCtx^.streams[i]; + + if ( stream.codec^.codec_type = CODEC_TYPE_AUDIO ) then + begin + //Log.LogStatus('Found Audio Stream', 'UAudio_FFMpeg'); + streamIndex := i; + break; + end; + end; + + result := streamIndex; +end; + +function TAudioDecoder_FFMpeg.Open(const Filename: string): TAudioDecodeStream; +var + pFormatCtx : PAVFormatContext; + pCodecCtx : PAVCodecContext; + pCodec : PAVCodec; + ffmpegStreamID : Integer; + ffmpegStream : PAVStream; + wanted_spec, + csIndex : integer; + stream : TFFMpegDecodeStream; +begin + result := nil; + + if (not FileExists(Filename)) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudio_FFMpeg'); + exit; + end; + + // Open audio file + if (av_open_input_file(pFormatCtx, PChar(Filename), nil, 0, nil) > 0) then + exit; + + // Retrieve stream information + if (av_find_stream_info(pFormatCtx) < 0) then + exit; + + dump_format(pFormatCtx, 0, pchar(Filename), 0); + + ffmpegStreamID := FindAudioStreamIndex(pFormatCtx); + if (ffmpegStreamID < 0) then + exit; + + //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFMpeg'); + + ffmpegStream := pFormatCtx.streams[ffmpegStreamID]; + pCodecCtx := ffmpegStream^.codec; + + pCodec := avcodec_find_decoder(pCodecCtx^.codec_id); + if (pCodec = nil) then + begin + Log.LogStatus('Unsupported codec!', 'UAudio_FFMpeg'); + exit; + end; + + avcodec_open(pCodecCtx, pCodec); + //WriteLn( 'Opened the codec' ); + + stream := TFFMpegDecodeStream.Create(pFormatCtx, pCodecCtx, pCodec, + ffmpegStreamID, ffmpegStream); + + result := stream; +end; + + +{ TPacketQueue } + +constructor TPacketQueue.Create(); +begin + inherited; + + firstPkt := nil; + lastPkt := nil; + nbPackets := 0; + size := 0; + + mutex := SDL_CreateMutex(); + cond := SDL_CreateCond(); +end; + +destructor TPacketQueue.Destroy(); +begin + SDL_DestroyMutex(mutex); + SDL_DestroyCond(cond); + inherited; +end; + +function TPacketQueue.Put(pkt : PAVPacket): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + if ((pkt <> @EOFPacket) and (pkt <> @FlushPacket)) then + if (av_dup_packet(pkt) < 0) then + exit; + + pkt1 := av_malloc(sizeof(TAVPacketList)); + if (pkt1 = nil) then + exit; + + pkt1^.pkt := pkt^; + pkt1^.next := nil; + + + SDL_LockMutex(Self.mutex); + try + + if (Self.lastPkt = nil) then + Self.firstPkt := pkt1 + else + Self.lastPkt^.next := pkt1; + + Self.lastPkt := pkt1; + inc(Self.nbPackets); + + //SafeWriteLn('Put: ' + inttostr(nbPackets)); + + Self.size := Self.size + pkt1^.pkt.size; + SDL_CondSignal(Self.cond); + + finally + SDL_UnlockMutex(Self.mutex); + end; + + result := 0; +end; + +function TPacketQueue.Get(var pkt: TAVPacket; block: boolean): integer; +var + pkt1 : PAVPacketList; +begin + result := -1; + + SDL_LockMutex(Self.mutex); + try + while true do + begin + if (quit) then + exit; + + pkt1 := Self.firstPkt; + + if (pkt1 <> nil) then + begin + Self.firstPkt := pkt1.next; + if (Self.firstPkt = nil) then + Self.lastPkt := nil; + dec(Self.nbPackets); + + //SafeWriteLn('Get: ' + inttostr(nbPackets)); + + Self.size := Self.size - pkt1^.pkt.size; + pkt := pkt1^.pkt; + av_free(pkt1); + + result := 1; + break; + end + else + if (not block) then + begin + result := 0; + break; + end + else + begin + SDL_CondWait(Self.cond, Self.mutex); + end; + end; + finally + SDL_UnlockMutex(Self.mutex); + end; +end; + +procedure TPacketQueue.Flush(); +var + pkt, pkt1: PAVPacketList; +begin + SDL_LockMutex(Self.mutex); + + pkt := Self.firstPkt; + while(pkt <> nil) do + begin + pkt1 := pkt^.next; + av_free_packet(@pkt^.pkt); + // Note: param must be a pointer to a pointer! + av_freep(@pkt); + pkt := pkt1; + end; + Self.lastPkt := nil; + Self.firstPkt := nil; + Self.nbPackets := 0; + Self.size := 0; + + SDL_UnlockMutex(Self.mutex); +end; + + +initialization + singleton_AudioDecoderFFMpeg := TAudioDecoder_FFMpeg.create(); + + //writeln( 'UAudioDecoder_FFMpeg - Register Decoder' ); + AudioManager.add( singleton_AudioDecoderFFMpeg ); + +finalization + AudioManager.Remove( singleton_AudioDecoderFFMpeg ); + + +end. diff --git a/Game/Code/Classes/UAudioInput_Bass.pas b/Game/Code/Classes/UAudioInput_Bass.pas new file mode 100644 index 00000000..6d661258 --- /dev/null +++ b/Game/Code/Classes/UAudioInput_Bass.pas @@ -0,0 +1,203 @@ +unit UAudioInput_Bass;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ URecord,
+ UMusic;
+
+implementation
+
+uses
+ UMain,
+ UIni,
+ ULog,
+ UAudioCore_Bass,
+ Windows,
+ bass;
+
+type
+ TAudioInput_Bass = class(TAudioInputBase)
+ public
+ function GetName: String; override;
+ function InitializeRecord: boolean; override;
+ destructor Destroy; override;
+ end;
+
+ TBassInputDevice = class(TAudioInputDevice)
+ public
+ DeviceIndex: integer; // index in TAudioInputProcessor.Device[]
+ BassDeviceID: integer; // DeviceID used by BASS
+ RecordStream: HSTREAM;
+
+ procedure Start(); override;
+ procedure Stop(); override;
+ end;
+
+var
+ singleton_AudioInputBass : IAudioInput;
+
+
+{ 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; Card: Cardinal): boolean; stdcall;
+begin
+ AudioInputProcessor.HandleMicrophoneData(buffer, len,
+ AudioInputProcessor.Device[Card]);
+ Result := true;
+end;
+
+
+{ TBassInputDevice }
+
+{*
+ * Start input-capturing on this device.
+ * TODO: call BASS_RecordInit only once
+ *}
+procedure TBassInputDevice.Start();
+const
+ captureFreq = 44100;
+begin
+ // recording already started -> stop first
+ if (RecordStream <> 0) then
+ Stop();
+
+ // TODO: Call once. Otherwise it's to slow
+ if not BASS_RecordInit(BassDeviceID) then
+ begin
+ Log.LogError('TBassInputDevice.Start: Error initializing device['+IntToStr(DeviceIndex)+']: ' +
+ TAudioCore_Bass.ErrorGetString());
+ Exit;
+ end;
+
+ SampleRate := captureFreq;
+
+ // capture in 44.1kHz/stereo/16bit and a 20ms callback period
+ RecordStream := BASS_RecordStart(captureFreq, 2, MakeLong(0, 20),
+ @MicrophoneCallback, DeviceIndex);
+ if (RecordStream = 0) then
+ begin
+ BASS_RecordFree;
+ Exit;
+ end;
+end;
+
+{*
+ * Stop input-capturing on this device.
+ *}
+procedure TBassInputDevice.Stop();
+begin
+ if (RecordStream = 0) then
+ Exit;
+ // TODO: Don't free the device. Do this on close
+ if (BASS_RecordSetDevice(BassDeviceID)) then
+ BASS_RecordFree;
+ RecordStream := 0;
+end;
+
+
+{ TAudioInput_Bass }
+
+function TAudioInput_Bass.GetName: String;
+begin
+ result := 'BASS_Input';
+end;
+
+function TAudioInput_Bass.InitializeRecord(): boolean;
+var
+ Descr: PChar;
+ SourceName: PChar;
+ Flags: integer;
+ BassDeviceID: integer;
+ BassDevice: TBassInputDevice;
+ DeviceIndex: integer;
+ SourceIndex: integer;
+begin
+ result := false;
+
+ DeviceIndex := 0;
+ BassDeviceID := 0;
+ SetLength(AudioInputProcessor.Device, 0);
+
+ // checks for recording devices and puts them into an array
+ while true do
+ begin
+ Descr := BASS_RecordGetDeviceDescription(BassDeviceID);
+ if (Descr = nil) then
+ break;
+
+ SetLength(AudioInputProcessor.Device, DeviceIndex+1);
+
+ // TODO: free object on termination
+ BassDevice := TBassInputDevice.Create();
+ AudioInputProcessor.Device[DeviceIndex] := BassDevice;
+
+ BassDevice.DeviceIndex := DeviceIndex;
+ BassDevice.BassDeviceID := BassDeviceID;
+ BassDevice.Description := UnifyDeviceName(Descr, DeviceIndex);
+
+ // get input sources
+ SourceIndex := 0;
+ BASS_RecordInit(BassDeviceID);
+ BassDevice.MicInput := 0;
+
+ // process each input
+ while true do
+ begin
+ SourceName := BASS_RecordGetInputName(SourceIndex);
+ if (SourceName = nil) then
+ break;
+
+ SetLength(BassDevice.Source, SourceIndex+1);
+ BassDevice.Source[SourceIndex].Name :=
+ UnifyDeviceSourceName(SourceName, BassDevice.Description);
+
+ // set mic index
+ Flags := BASS_RecordGetInput(SourceIndex);
+ if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then
+ BassDevice.MicInput := SourceIndex;
+
+ Inc(SourceIndex);
+ end;
+
+ BASS_RecordFree;
+
+ Inc(DeviceIndex);
+ Inc(BassDeviceID);
+ end;
+
+ result := true;
+end;
+
+destructor TAudioInput_Bass.Destroy;
+begin
+ inherited;
+end;
+
+
+initialization
+ singleton_AudioInputBass := TAudioInput_Bass.create();
+ AudioManager.add( singleton_AudioInputBass );
+
+finalization
+ AudioManager.Remove( singleton_AudioInputBass );
+
+end.
diff --git a/Game/Code/Classes/UAudioInput_Portaudio.pas b/Game/Code/Classes/UAudioInput_Portaudio.pas new file mode 100644 index 00000000..753c69f6 --- /dev/null +++ b/Game/Code/Classes/UAudioInput_Portaudio.pas @@ -0,0 +1,347 @@ +unit UAudioInput_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I ../switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + URecord, + UIni, + ULog, + UMain, + {$IFDEF UsePortmixer} + portmixer, + {$ENDIF} + portaudio; + +type + TAudioInput_Portaudio = class(TAudioInputBase) + private + function GetPreferredApiIndex(): TPaHostApiIndex; + public + function GetName: String; override; + function InitializeRecord: boolean; override; + destructor Destroy; override; + end; + + TPortaudioInputDevice = class(TAudioInputDevice) + public + RecordStream: PPaStream; + PaDeviceIndex: TPaDeviceIndex; + + procedure Start(); override; + procedure Stop(); override; + end; + +function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + inputDevice: Pointer): Integer; cdecl; forward; + +var + singleton_AudioInputPortaudio : IAudioInput; + +{* the default API used by Portaudio is the least common denominator + * and might lack efficiency. ApiPreferenceOrder defines the order of + * preferred APIs to use. The first API-type in the list is tried first. If it's + * not available the next is tried, ... + * If none of the preferred APIs was found the default API is used. + * Pascal doesn't permit zero-length static arrays, so you can use paDefaultApi + * as an array's only member if you do not have any preferences. + * paDefaultApi also terminates a preferences list but this is optional. + *} +const + paDefaultApi = -1; +var + ApiPreferenceOrder: +{$IF Defined(WIN32)} + // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment + // Note2: Windows Default-API is MME + //array[0..0] of TPaHostApiTypeId = ( paDirectSound, paMME ); + array[0..0] of TPaHostApiTypeId = ( paDirectSound ); +{$ELSEIF Defined(LINUX)} + // Note1: Portmixer has no mixer support for paJACK at the moment + // Note2: Not tested, but ALSA might be better than OSS. + array[0..1] of TPaHostApiTypeId = ( paALSA, paOSS ); +{$ELSEIF Defined(DARWIN)} + // Note: Not tested. + //array[0..0] of TPaHostApiTypeId = ( paCoreAudio ); + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$ELSE} + array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); +{$IFEND} + + +{ TPortaudioInputDevice } + +procedure TPortaudioInputDevice.Start(); +var + Error: TPaError; + ErrorMsg: string; + inputParams: TPaStreamParameters; + deviceInfo: PPaDeviceInfo; +begin + // get input latency info + deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex); + + // set input stream parameters + with inputParams do begin + device := PaDeviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + Log.LogStatus(inttostr(PaDeviceIndex), 'Portaudio'); + Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio'); + + // open input stream + Error := Pa_OpenStream(RecordStream, @inputParams, nil, SampleRate, + paFramesPerBufferUnspecified, paNoFlag, + @MicrophoneCallback, Pointer(Self)); + if(Error <> paNoError) then begin + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TPortaudioInputDevice.Start(): Error opening stream: ' + ErrorMsg); + //Halt; + end; + + // start capture + Error := Pa_StartStream(RecordStream); + if(Error <> paNoError) then begin + Pa_CloseStream(RecordStream); + ErrorMsg := Pa_GetErrorText(Error); + Log.CriticalError('TPortaudioInputDevice.Start(): Error starting stream: ' + ErrorMsg); + //Halt; + end; +end; + +procedure TPortaudioInputDevice.Stop(); +begin + if assigned(RecordStream) then begin + Pa_StopStream(RecordStream); + Pa_CloseStream(RecordStream); + end; +end; + + +{ TAudioInput_Portaudio } + +function TAudioInput_Portaudio.GetName: String; +begin + result := 'Portaudio'; +end; + +function TAudioInput_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex; +var + i: integer; +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 + result := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]); + if(result >= 0) then + break; + end; + end; + + // None of the preferred APIs is available -> use default + if(result < 0) then begin + result := Pa_GetDefaultHostApi(); + end; +end; + +function TAudioInput_Portaudio.InitializeRecord(): boolean; +var + i: integer; + apiIndex: TPaHostApiIndex; + apiInfo: PPaHostApiInfo; + deviceName: string; + deviceIndex: TPaDeviceIndex; + deviceInfo: PPaDeviceInfo; + sourceCnt: integer; + sourceName: string; + SC: integer; // soundcard + SCI: integer; // soundcard source + err: TPaError; + errMsg: string; + paDevice: TPortaudioInputDevice; + inputParams: TPaStreamParameters; + stream: PPaStream; + {$IFDEF UsePortmixer} + mixer: PPxMixer; + {$ENDIF} +const + captureFreq = 44100; +begin + result := false; + + err := Pa_Initialize(); + if(err <> paNoError) then begin + Log.LogError('Portaudio.InitializeRecord: ' + Pa_GetErrorText(err)); + Exit; + end; + apiIndex := GetPreferredApiIndex(); + apiInfo := Pa_GetHostApiInfo(apiIndex); + + SC := 0; + + // init array-size to max. input-devices count + SetLength(AudioInputProcessor.Device, apiInfo^.deviceCount); + for i:= 0 to High(AudioInputProcessor.Device) do + begin + // convert API-specific device-index to global index + deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(apiIndex, i); + deviceInfo := Pa_GetDeviceInfo(deviceIndex); + + // current device is no input device -> skip + if(deviceInfo^.maxInputChannels <= 0) then + continue; + + paDevice := TPortaudioInputDevice.Create(); + AudioInputProcessor.Device[SC] := paDevice; + + // retrieve device-name + deviceName := deviceInfo^.name; + paDevice.Description := deviceName; + paDevice.PaDeviceIndex := deviceIndex; + + // setup desired input parameters + with inputParams do begin + device := deviceIndex; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := deviceInfo^.defaultLowInputLatency; + hostApiSpecificStreamInfo := nil; + end; + + paDevice.SampleRate := captureFreq; + + // check if device supports our input-format + err := Pa_IsFormatSupported(@inputParams, nil, paDevice.SampleRate); + if(err <> 0) then begin + // format not supported -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paDevice.Free(); + continue; + end; + + // TODO: retry with mono if stereo is not supported + // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might + // not be set correctly in OSS) + // use TPaDeviceInfo.defaultSampleRate + + err := Pa_OpenStream(stream, @inputParams, nil, paDevice.SampleRate, + paFramesPerBufferUnspecified, paNoFlag, @MicrophoneCallback, nil); + if(err <> paNoError) then begin + // unable to open device -> skip + errMsg := Pa_GetErrorText(err); + Log.LogError('Portaudio.InitializeRecord, device: "'+ deviceName +'" ' + + '('+ errMsg +')'); + paDevice.Free(); + continue; + end; + + + {$IFDEF UsePortmixer} + + // use default mixer + mixer := Px_OpenMixer(stream, 0); + + // get input count + sourceCnt := Px_GetNumInputSources(mixer); + SetLength(paDevice.Source, sourceCnt); + + // get input names + for SCI := 0 to sourceCnt-1 do + begin + sourceName := Px_GetInputSourceName(mixer, SCI); + paDevice.Source[SCI].Name := sourceName; + end; + + Px_CloseMixer(mixer); + + {$ELSE} // !UsePortmixer + + //Pa_StartStream(stream); + // TODO: check if callback was called (this problem may occur on some devices) + //Pa_StopStream(stream); + + // create a standard input source + SetLength(paDevice.Source, 1); + paDevice.Source[0].Name := 'Standard'; + + {$ENDIF} + + // close test-stream + Pa_CloseStream(stream); + + // use default input source + paDevice.SourceSelected := 0; + + Inc(SC); + end; + + // adjust size to actual input-device count + SetLength(AudioInputProcessor.Device, SC); + + Log.LogStatus('#Soundcards: ' + inttostr(SC), 'Portaudio'); + + { + SoundCard[SC].InputSelected := Mic[Device]; + } + result := true; +end; + +destructor TAudioInput_Portaudio.Destroy; +var + i: integer; + paSoundCard: TPortaudioInputDevice; +begin + Pa_Terminate(); + for i := 0 to High(AudioInputProcessor.Device) do + begin + AudioInputProcessor.Device[i].Free(); + end; + AudioInputProcessor.Device := nil; + + inherited Destroy; +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; + + +initialization + singleton_AudioInputPortaudio := TAudioInput_Portaudio.create(); + AudioManager.add( singleton_AudioInputPortaudio ); + +finalization + AudioManager.Remove( singleton_AudioInputPortaudio ); + +end. diff --git a/Game/Code/Classes/UAudioPlayback_Bass.pas b/Game/Code/Classes/UAudioPlayback_Bass.pas new file mode 100644 index 00000000..266a5ec3 --- /dev/null +++ b/Game/Code/Classes/UAudioPlayback_Bass.pas @@ -0,0 +1,430 @@ +unit UAudioPlayback_Bass; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + UIni, + UMain, + ULog, + UAudioCore_Bass, + bass; + +type + TBassPlaybackStream = class(TAudioPlaybackStream) + private + Handle: HSTREAM; + Loop: boolean; + public + constructor Create(); overload; + constructor Create(stream: HSTREAM); overload; + + procedure Reset(); + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure Close(); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; + function GetVolume(): integer; override; + procedure SetVolume(volume: integer); override; + + function GetPosition: real; + procedure SetPosition(Time: real); + + function IsLoaded(): boolean; + end; + +type + TAudioPlayback_Bass = class( TInterfacedObject, IAudioPlayback) + private + MusicStream: TBassPlaybackStream; + + function Load(Filename: string): TBassPlaybackStream; + public + function GetName: String; + + {IAudioOutput interface} + + function InitializePlayback(): boolean; + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + + function Open(Filename: string): boolean; // true if succeed + + procedure Rewind; + procedure Play; + procedure Pause; //Pause Mod + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function GetPosition: real; + procedure SetPosition(Time: real); + + //Equalizer + procedure GetFFTData(var data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + // Sounds + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(stream: TAudioPlaybackStream);
+ procedure StopSound(stream: TAudioPlaybackStream); + end; + +var + singleton_AudioPlaybackBass : IAudioPlayback; + + +constructor TBassPlaybackStream.Create(); +begin + inherited; + Reset(); +end; + +constructor TBassPlaybackStream.Create(stream: HSTREAM); +begin + Create(); + Handle := stream; +end; + +procedure TBassPlaybackStream.Reset(); +begin + Loop := false; + if (Handle <> 0) then + Bass_StreamFree(Handle); + Handle := 0; +end; + +procedure TBassPlaybackStream.Play(); +begin + BASS_ChannelPlay(Handle, Loop); +end; + +procedure TBassPlaybackStream.Pause(); +begin + BASS_ChannelPause(Handle); +end; + +procedure TBassPlaybackStream.Stop(); +begin + BASS_ChannelStop(Handle); +end; + +procedure TBassPlaybackStream.Close(); +begin + Reset(); +end; + +function TBassPlaybackStream.GetVolume(): integer; +begin + Result := 0; + BASS_ChannelSetAttributes(Handle, PInteger(nil)^, Result, PInteger(nil)^); +end; + +procedure TBassPlaybackStream.SetVolume(volume: integer); +begin + // clamp volume + if volume < 0 then + volume := 0; + if volume > 100 then + volume := 100; + // set volume + BASS_ChannelSetAttributes(Handle, -1, volume, -101); +end; + +function TBassPlaybackStream.GetPosition: real; +var + bytes: integer; +begin + bytes := BASS_ChannelGetPosition(Handle); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +procedure TBassPlaybackStream.SetPosition(Time: real); +var + bytes: integer; +begin + bytes := BASS_ChannelSeconds2Bytes(Handle, Time); + BASS_ChannelSetPosition(Handle, bytes); +end; + +function TBassPlaybackStream.GetLoop(): boolean; +begin + result := Loop; +end; + +procedure TBassPlaybackStream.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TBassPlaybackStream.GetLength(): real; +var + bytes: integer; +begin + bytes := BASS_ChannelGetLength(Handle); + Result := BASS_ChannelBytes2Seconds(Handle, bytes); +end; + +function TBassPlaybackStream.GetStatus(): TStreamStatus; +var + state: DWORD; +begin + state := BASS_ChannelIsActive(Handle); + case state of + BASS_ACTIVE_PLAYING: + result := ssPlaying; + BASS_ACTIVE_PAUSED: + result := ssPaused; + BASS_ACTIVE_STALLED: + result := ssBlocked; + BASS_ACTIVE_STOPPED: + result := ssStopped; + else + result := ssUnknown; + end; +end; + +function TBassPlaybackStream.IsLoaded(): boolean; +begin + Result := (Handle <> 0); +end; + + +function TAudioPlayback_Bass.GetName: String; +begin + result := 'BASS_Playback'; +end; + +function TAudioPlayback_Bass.InitializePlayback(): boolean; +var + Pet: integer; + S: integer; +begin + result := false; + + //Log.BenchmarkStart(4); + //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize'); + + if not BASS_Init(1, 44100, 0, 0, nil) then + begin + Log.LogError('Could not initialize BASS', 'Error'); + 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.Load(Filename: string): TBassPlaybackStream; +var + L: Integer; + stream: HSTREAM; +begin + Result := nil; + + //Log.LogStatus('Loading Sound: "' + Filename + '"', 'LoadSoundFromFile'); + stream := BASS_StreamCreateFile(False, pchar(Filename), 0, 0, 0); + if (stream = 0) then + begin + Log.LogError('Failed to open "' + Filename + '", ' + + TAudioCore_Bass.ErrorGetString(BASS_ErrorGetCode()), 'TAudioPlayback_Bass.Load'); + Exit; + end; + + Result := TBassPlaybackStream.Create(stream); +end; + +procedure TAudioPlayback_Bass.SetVolume(Volume: integer); +begin + //Old Sets Wave Volume + //BASS_SetVolume(Volume); + //New: Sets Volume only for this Application + BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume); + BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume); +end; + +procedure TAudioPlayback_Bass.SetMusicVolume(Volume: Integer); +begin + if assigned(MusicStream) then + MusicStream.SetVolume(Volume); +end; + +procedure TAudioPlayback_Bass.SetLoop(Enabled: boolean); +begin + if assigned(MusicStream) then + MusicStream.Loop := Enabled; +end; + +function TAudioPlayback_Bass.Open(Filename: string): boolean; +var + stream: HSTREAM; +begin + Result := false; + + // free old MusicStream + if assigned(MusicStream) then + MusicStream.Free; + + MusicStream := Load(Filename); + if not assigned(MusicStream) then + Exit; + + //Set Max Volume + SetMusicVolume(100); + + Result := true; +end; + +procedure TAudioPlayback_Bass.Rewind; +begin + SetPosition(0); +end; + +procedure TAudioPlayback_Bass.Play; +begin + if assigned(MusicStream) then + MusicStream.Play(); +end; + +procedure TAudioPlayback_Bass.Pause; +begin + if assigned(MusicStream) then + MusicStream.Pause(); +end; + +procedure TAudioPlayback_Bass.Stop; +begin + if assigned(MusicStream) then + MusicStream.Stop(); +end; + +procedure TAudioPlayback_Bass.Close; +begin + if assigned(MusicStream) then + MusicStream.Close(); +end; + +function TAudioPlayback_Bass.Length: real; +var + bytes: integer; +begin + if assigned(MusicStream) then + Result := MusicStream.GetLength() + else + Result := -1; +end; + +function TAudioPlayback_Bass.GetPosition: real; +begin + if assigned(MusicStream) then + Result := MusicStream.GetPosition() + else + Result := -1; +end; + +procedure TAudioPlayback_Bass.SetPosition(Time: real); +begin + if assigned(MusicStream) then + MusicStream.SetPosition(Time); +end; + +function TAudioPlayback_Bass.Finished: boolean; +begin + if assigned(MusicStream) then + Result := (MusicStream.GetStatus() = ssStopped) + else + Result := true; +end; + +//Equalizer +procedure TAudioPlayback_Bass.GetFFTData(var data: TFFTData); +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetData(MusicStream.Handle, @data, BASS_DATA_FFT512); +end; + +{* + * Copies interleaved PCM 16bit uint (maybe fake) stereo samples into data. + * Returns the number of frames (= stereo/mono sample) + *} +function TAudioPlayback_Bass.GetPCMData(var data: TPCMData): Cardinal; +var + info: BASS_CHANNELINFO; + nBytes: DWORD; +begin + //Get Channel Data Mono and 256 Values + BASS_ChannelGetInfo(MusicStream.Handle, info); + FillChar(data, sizeof(TPCMData), 0); + + if (info.chans = 1) then + begin + // mono file -> add stereo channel + nBytes := 0;//BASS_ChannelGetData(Bass, @data[0], samples*sizeof(Smallint)); + // interleave data + //CopyMemory(@data[1], @data[0], samples*sizeof(Smallint)); + result := 0; + end + else + begin + // stereo file + nBytes := BASS_ChannelGetData(MusicStream.Handle, @data, sizeof(TPCMData)); + end; + if(nBytes <= 0) then + result := 0 + else + result := nBytes div sizeof(TPCMStereoSample); +end; + +function TAudioPlayback_Bass.OpenSound(const Filename: string): TAudioPlaybackStream; +begin + result := Load(Filename); +end; + +procedure TAudioPlayback_Bass.PlaySound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Play(); +end; + +procedure TAudioPlayback_Bass.StopSound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Stop(); +end; + + +initialization + singleton_AudioPlaybackBass := TAudioPlayback_Bass.create(); + AudioManager.add( singleton_AudioPlaybackBass ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackBass ); + +end. diff --git a/Game/Code/Classes/UAudioPlayback_Portaudio.pas b/Game/Code/Classes/UAudioPlayback_Portaudio.pas new file mode 100644 index 00000000..59571d3d --- /dev/null +++ b/Game/Code/Classes/UAudioPlayback_Portaudio.pas @@ -0,0 +1,728 @@ +unit UAudioPlayback_Portaudio; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +uses + Classes, + SysUtils, + UMusic; + +implementation + +uses + {$IFNDEF Win32} + libc, + {$ENDIF} + sdl, + portaudio, + ULog, + UIni, + UMain; + +type + TPortaudioPlaybackStream = class(TAudioPlaybackStream) + private + Status: TStreamStatus; + Loop: boolean; + + _volume: integer; + + procedure Reset(); + public + DecodeStream: TAudioDecodeStream; + + constructor Create(); + destructor Destroy(); override; + + function SetDecodeStream(decodeStream: TAudioDecodeStream): boolean; + + procedure Play(); override; + procedure Pause(); override; + procedure Stop(); override; + procedure Close(); override; + function GetLoop(): boolean; override; + procedure SetLoop(Enabled: boolean); override; + function GetLength(): real; override; + function GetStatus(): TStreamStatus; override; + + function IsLoaded(): boolean; + + function GetVolume(): integer; override; + procedure SetVolume(volume: integer); override; + + // functions delegated to the decode stream + function GetPosition: real; + procedure SetPosition(Time: real); + function ReadData(Buffer: PChar; BufSize: integer): integer; + end; + +type + TAudioMixerStream = class + private + activeStreams: TList; + mixerBuffer: PChar; + internalLock: PSDL_Mutex; + + _volume: integer; + + procedure Lock(); inline; + procedure Unlock(); inline; + + function GetVolume(): integer; + procedure SetVolume(volume: integer); + public + constructor Create(); + destructor Destroy(); override; + procedure AddStream(stream: TAudioPlaybackStream); + procedure RemoveStream(stream: TAudioPlaybackStream); + function ReadData(Buffer: PChar; BufSize: integer): integer; + + property Volume: integer READ GetVolume WRITE SetVolume; + end; + +type + TAudioPlayback_Portaudio = class( TInterfacedObject, IAudioPlayback ) + private + MusicStream: TPortaudioPlaybackStream; + + MixerStream: TAudioMixerStream; + paStream: PPaStream; + + FrameSize: integer; + + function InitializePortaudio(): boolean; + function StartPortaudioStream(): boolean; + + function InitializeSDLAudio(): boolean; + function StartSDLAudioStream(): boolean; + procedure StopSDLAudioStream(); + public + function GetName: String; + + function InitializePlayback(): boolean; + destructor Destroy; override; + + function Load(const Filename: String): TPortaudioPlaybackStream; + + procedure SetVolume(Volume: integer); + procedure SetMusicVolume(Volume: integer); + procedure SetLoop(Enabled: boolean); + function Open(Filename: string): boolean; // true if succeed + procedure Rewind; + procedure SetPosition(Time: real); + procedure Play; + procedure Pause; + + procedure Stop; + procedure Close; + function Finished: boolean; + function Length: real; + function GetPosition: real; + + // Equalizer + procedure GetFFTData(var data: TFFTData); + + // Interface for Visualizer + function GetPCMData(var data: TPCMData): Cardinal; + + // Sounds + function OpenSound(const Filename: String): TAudioPlaybackStream; + procedure PlaySound(stream: TAudioPlaybackStream); + procedure StopSound(stream: TAudioPlaybackStream); + end; + + +function AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; forward; + +var + singleton_AudioPlaybackPortaudio : IAudioPlayback; + + +{ TAudioMixerStream } + +constructor TAudioMixerStream.Create(); +begin + activeStreams := TList.Create; + internalLock := SDL_CreateMutex(); + _volume := 100; +end; + +destructor TAudioMixerStream.Destroy(); +begin + if assigned(mixerBuffer) then + Freemem(mixerBuffer); + activeStreams.Free; + SDL_DestroyMutex(internalLock); +end; + +procedure TAudioMixerStream.Lock(); +begin + SDL_mutexP(internalLock); +end; + +procedure TAudioMixerStream.Unlock(); +begin + SDL_mutexV(internalLock); +end; + +function TAudioMixerStream.GetVolume(): integer; +begin + Lock(); + result := _volume; + Unlock(); +end; + +procedure TAudioMixerStream.SetVolume(volume: integer); +begin + Lock(); + _volume := 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; + +procedure TAudioMixerStream.RemoveStream(stream: TAudioPlaybackStream); +begin + Lock(); + activeStreams.Remove(Pointer(stream)); + Unlock(); +end; + +function TAudioMixerStream.ReadData(Buffer: PChar; BufSize: integer): integer; +var + i: integer; + size: integer; + stream: TPortaudioPlaybackStream; + appVolume: single; +begin + result := BufSize; + + // zero target-buffer (silence) + FillChar(Buffer^, BufSize, 0); + + // resize mixer-buffer if necessary + ReallocMem(mixerBuffer, BufSize); + if not assigned(mixerBuffer) then + Exit; + + Lock(); + + //writeln('Mix: ' + inttostr(activeStreams.Count)); + + // use _volume instead of Volume to prevent recursive locking + appVolume := _volume / 100 * SDL_MIX_MAXVOLUME; + + for i := 0 to activeStreams.Count-1 do + begin + stream := TPortaudioPlaybackStream(activeStreams[i]); + if (stream.GetStatus() = ssPlaying) then + begin + // fetch data from current stream + size := stream.ReadData(mixerBuffer, BufSize); + if (size > 0) then + begin + SDL_MixAudio(PUInt8(Buffer), PUInt8(mixerBuffer), size, + Trunc(appVolume * stream.Volume / 100)); + end; + end; + end; + + Unlock(); +end; + + +{ TPortaudioPlaybackStream } + +constructor TPortaudioPlaybackStream.Create(); +begin + inherited Create(); + Reset(); +end; + +destructor TPortaudioPlaybackStream.Destroy(); +begin + Close(); + inherited Destroy(); +end; + +procedure TPortaudioPlaybackStream.Reset(); +begin + Status := ssStopped; + Loop := false; + DecodeStream := nil; + _volume := 0; +end; + +function TPortaudioPlaybackStream.SetDecodeStream(decodeStream: TAudioDecodeStream): boolean; +begin + result := false; + + Reset(); + + if not assigned(decodeStream) then + Exit; + Self.DecodeStream := decodeStream; + + _volume := 100; + + result := true; +end; + +procedure TPortaudioPlaybackStream.Close(); +begin + Reset(); +end; + +procedure TPortaudioPlaybackStream.Play(); +begin + if (status <> ssPaused) then + begin + // rewind + if assigned(DecodeStream) then + DecodeStream.Position := 0; + end; + status := ssPlaying; + //MixerStream.AddStream(Self); +end; + +procedure TPortaudioPlaybackStream.Pause(); +begin + status := ssPaused; +end; + +procedure TPortaudioPlaybackStream.Stop(); +begin + status := ssStopped; +end; + +function TPortaudioPlaybackStream.IsLoaded(): boolean; +begin + result := assigned(DecodeStream); +end; + +function TPortaudioPlaybackStream.GetLoop(): boolean; +begin + result := Loop; +end; + +procedure TPortaudioPlaybackStream.SetLoop(Enabled: boolean); +begin + Loop := Enabled; +end; + +function TPortaudioPlaybackStream.GetLength(): real; +begin + if assigned(DecodeStream) then + result := DecodeStream.Length + else + result := -1; +end; + +function TPortaudioPlaybackStream.GetStatus(): TStreamStatus; +begin + result := status; +end; + +function TPortaudioPlaybackStream.ReadData(Buffer: PChar; BufSize: integer): integer; +begin + if not assigned(DecodeStream) then + begin + result := -1; + Exit; + end; + result := DecodeStream.ReadData(Buffer, BufSize); + // end-of-file reached -> stop playback + if (DecodeStream.EOF) then + begin + status := ssStopped; + end; +end; + +function TPortaudioPlaybackStream.GetPosition: real; +begin + if assigned(DecodeStream) then + result := DecodeStream.Position + else + result := -1; +end; + +procedure TPortaudioPlaybackStream.SetPosition(Time: real); +begin + if assigned(DecodeStream) then + DecodeStream.Position := Time; +end; + +function TPortaudioPlaybackStream.GetVolume(): integer; +begin + result := _volume; +end; + +procedure TPortaudioPlaybackStream.SetVolume(volume: integer); +begin + // clamp volume + if (volume > 100) then + _volume := 100 + else if (volume < 0) then + _volume := 0 + else + _volume := volume; +end; + + +{ TAudioPlayback_Portaudio } + +function AudioCallback(input: Pointer; output: Pointer; frameCount: Longword; + timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags; + userData: Pointer): Integer; cdecl; +var + playback: TAudioPlayback_Portaudio; +begin + playback := TAudioPlayback_Portaudio(userData); + with playback do + begin + MixerStream.ReadData(output, frameCount * FrameSize); + end; + result := paContinue; +end; + +procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl; +var + playback: TAudioPlayback_Portaudio; +begin + playback := TAudioPlayback_Portaudio(userdata); + with playback do + begin + MixerStream.ReadData(stream, len); + end; +end; + +function TAudioPlayback_Portaudio.GetName: String; +begin + result := 'Portaudio_Playback'; +end; + +function TAudioPlayback_Portaudio.InitializePortaudio(): boolean; +var + paApi : TPaHostApiIndex; + paApiInfo : PPaHostApiInfo; + paOutParams : TPaStreamParameters; + paOutDevice : TPaDeviceIndex; + paOutDeviceInfo : PPaDeviceInfo; + err : TPaError; +begin + result := false; + + Pa_Initialize(); + + // FIXME: determine automatically + {$IFDEF WIN32} + paApi := Pa_HostApiTypeIdToHostApiIndex(paDirectSound); + {$ELSE} + paApi := Pa_HostApiTypeIdToHostApiIndex(paALSA); + {$ENDIF} + if (paApi < 0) then + begin + Log.LogStatus('Pa_HostApiTypeIdToHostApiIndex: '+Pa_GetErrorText(paApi), 'UAudioPlayback_Portaudio'); + exit; + end; + + paApiInfo := Pa_GetHostApiInfo(paApi); + paOutDevice := paApiInfo^.defaultOutputDevice; + paOutDeviceInfo := Pa_GetDeviceInfo(paOutDevice); + + with paOutParams do begin + device := paOutDevice; + channelCount := 2; + sampleFormat := paInt16; + suggestedLatency := paOutDeviceInfo^.defaultHighOutputLatency; + hostApiSpecificStreamInfo := nil; + end; + + // set the size of one audio frame (2channel 16bit uint sample) + FrameSize := 2 * sizeof(Smallint); + + err := Pa_OpenStream(paStream, nil, @paOutParams, 44100, + paFramesPerBufferUnspecified, + paNoFlag, @AudioCallback, Self); + if(err <> paNoError) then begin + Log.LogStatus('Pa_OpenStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); + exit; + end; + + Log.LogStatus('Opened audio device', 'UAudioPlayback_Portaudio'); + + result := true; +end; + +function TAudioPlayback_Portaudio.StartPortaudioStream(): boolean; +var + err: TPaError; +begin + result := false; + + err := Pa_StartStream(paStream); + if(err <> paNoError) then + begin + Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio'); + exit; + end; + + result := true; +end; + +function TAudioPlayback_Portaudio.InitializeSDLAudio(): boolean; +var + desiredAudioSpec, obtainedAudioSpec: TSDL_AudioSpec; + err: integer; +begin + result := false; + + SDL_InitSubSystem(SDL_INIT_AUDIO); + + FillChar(desiredAudioSpec, sizeof(desiredAudioSpec), 0); + with desiredAudioSpec do + begin + freq := 44100; + format := AUDIO_S16SYS; + channels := 2; + samples := 1024; // latency: 23 ms + callback := @SDLAudioCallback; + userdata := Self; + end; + + // set the size of one audio frame (2channel 16bit uint sample) + FrameSize := 2 * sizeof(Smallint); + + if(SDL_OpenAudio(@desiredAudioSpec, @obtainedAudioSpec) = -1) then + begin + Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'UAudioPlayback_SDL'); + exit; + end; + + Log.LogStatus('Opened audio device', 'UAudioPlayback_SDL'); + + result := true; +end; + +function TAudioPlayback_Portaudio.StartSDLAudioStream(): boolean; +begin + SDL_PauseAudio(0); + result := true; +end; + +procedure TAudioPlayback_Portaudio.StopSDLAudioStream(); +begin + SDL_CloseAudio(); +end; + +function TAudioPlayback_Portaudio.InitializePlayback: boolean; +begin + result := false; + + //Log.LogStatus('InitializePlayback', 'UAudioPlayback_Portaudio'); + + //if(not InitializePortaudio()) then + if(not InitializeSDLAudio()) then + Exit; + + MixerStream := TAudioMixerStream.Create; + + //if(not StartPortaudioStream()) then; + if(not StartSDLAudioStream()) then + Exit; + + result := true; +end; + +destructor TAudioPlayback_Portaudio.Destroy; +begin + StopSDLAudioStream(); + + MixerStream.Free(); + MusicStream.Free(); + + inherited Destroy(); +end; + +function TAudioPlayback_Portaudio.Load(const Filename: String): TPortaudioPlaybackStream; +var + decodeStream: TAudioDecodeStream; + playbackStream: TPortaudioPlaybackStream; +begin + Result := nil; + + decodeStream := AudioDecoder.Open(Filename); + if not assigned(decodeStream) then + begin + Log.LogStatus('LoadSoundFromFile: Sound not found "' + Filename + '"', 'UAudioPlayback_Portaudio'); + Exit; + end; + + playbackStream := TPortaudioPlaybackStream.Create(); + if (not playbackStream.SetDecodeStream(decodeStream)) then + Exit; + + // FIXME: remove this line + MixerStream.AddStream(playbackStream); + + result := playbackStream; +end; + +procedure TAudioPlayback_Portaudio.SetVolume(Volume: integer); +begin + // sets volume only for this application + MixerStream.Volume := Volume; +end; + +procedure TAudioPlayback_Portaudio.SetMusicVolume(Volume: Integer); +begin + if assigned(MusicStream) then + MusicStream.Volume := Volume; +end; + +procedure TAudioPlayback_Portaudio.SetLoop(Enabled: boolean); +begin + if assigned(MusicStream) then + MusicStream.SetLoop(Enabled); +end; + +function TAudioPlayback_Portaudio.Open(Filename: string): boolean; +var + decodeStream: TAudioDecodeStream; +begin + Result := false; + + // free old MusicStream + MusicStream.Free(); + + MusicStream := Load(Filename); + if not assigned(MusicStream) then + Exit; + + //Set Max Volume + SetMusicVolume(100); + + Result := true; +end; + +procedure TAudioPlayback_Portaudio.Rewind; +begin + SetPosition(0); +end; + +procedure TAudioPlayback_Portaudio.SetPosition(Time: real); +begin + if assigned(MusicStream) then + MusicStream.SetPosition(Time); +end; + +function TAudioPlayback_Portaudio.GetPosition: real; +begin + if assigned(MusicStream) then + Result := MusicStream.GetPosition() + else + Result := -1; +end; + +function TAudioPlayback_Portaudio.Length: real; +begin + if assigned(MusicStream) then + Result := MusicStream.GetLength() + else + Result := -1; +end; + +procedure TAudioPlayback_Portaudio.Play; +begin + if assigned(MusicStream) then + MusicStream.Play(); +end; + +procedure TAudioPlayback_Portaudio.Pause; +begin + if assigned(MusicStream) then + MusicStream.Pause(); +end; + +procedure TAudioPlayback_Portaudio.Stop; +begin + if assigned(MusicStream) then + MusicStream.Stop(); +end; + +procedure TAudioPlayback_Portaudio.Close; +begin + if assigned(MusicStream) then + begin + MixerStream.RemoveStream(MusicStream); + MusicStream.Close(); + end; +end; + +function TAudioPlayback_Portaudio.Finished: boolean; +begin + if assigned(MusicStream) then + Result := (MusicStream.GetStatus() = ssStopped) + else + Result := true; +end; + +//Equalizer +procedure TAudioPlayback_Portaudio.GetFFTData(var data: TFFTData); +begin + //Get Channel Data Mono and 256 Values +// BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512); +end; + +// Interface for Visualizer +function TAudioPlayback_Portaudio.GetPCMData(var data: TPCMData): Cardinal; +begin + result := 0; +end; + +function TAudioPlayback_Portaudio.OpenSound(const Filename: String): TAudioPlaybackStream; +begin + result := Load(Filename); +end; + +procedure TAudioPlayback_Portaudio.PlaySound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Play(); +end; + +procedure TAudioPlayback_Portaudio.StopSound(stream: TAudioPlaybackStream); +begin + if assigned(stream) then + stream.Stop(); +end; + + +initialization + singleton_AudioPlaybackPortaudio := TAudioPlayback_Portaudio.create(); + AudioManager.add( singleton_AudioPlaybackPortaudio ); + +finalization + AudioManager.Remove( singleton_AudioPlaybackPortaudio ); + + +end. diff --git a/Game/Code/Classes/UCatCovers.pas b/Game/Code/Classes/UCatCovers.pas new file mode 100644 index 00000000..516544be --- /dev/null +++ b/Game/Code/Classes/UCatCovers.pas @@ -0,0 +1,151 @@ +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 [low(ISorting)..high(ISorting)] of array of string;
+ cFiles: array [low(ISorting)..high(ISorting)] of array of string;
+ public
+ constructor Create;
+ procedure Load; //Load Cover aus Cover.ini and Cover Folder
+ 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
+ Load;
+end;
+
+ //Load Cover aus Cover.ini and Cover Folder
+procedure TCatCovers.Load;
+var
+ Ini: TMemIniFile;
+ SR: TSearchRec;
+ List: TStringlist;
+ I, J: Integer;
+ Name, Filename, Temp: string;
+begin
+try
+ Ini := TMemIniFile.Create(CoversPath + 'covers.ini');
+ List := TStringlist.Create;
+
+ //Add every Cover in Covers Ini for Every Sorting option
+ for I := low(ISorting) 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 := low(ISorting) 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 := low(cNames[Sorting]) 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 := low(cNames[Sorting]) to high(cNames[Sorting]) do
+begin
+ if cNames[Sorting][I] = Name then
+ begin
+ Result := cFiles[Sorting][I];
+ Break;
+ end;
+end;
+
+//No Cover
+if (Result = '') AND (FileExists(CoversPath + 'NoCover.jpg')) then
+ Result := CoversPath + 'NoCover.jpg';
+
+end;
+
+end.
diff --git a/Game/Code/Classes/UCommandLine.pas b/Game/Code/Classes/UCommandLine.pas new file mode 100644 index 00000000..55dfc6ce --- /dev/null +++ b/Game/Code/Classes/UCommandLine.pas @@ -0,0 +1,332 @@ +unit UCommandLine; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + + +type + //----------- + // TCMDParams - Class Reaads 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'; + cMediaInterfaces = 'showinterfaces'; + cUseLocalPaths = 'localpaths'; + + +implementation + +uses SysUtils, + uPlatform; +// uINI -- Nasty requirement... ( removed with permission of blindy ) + + +//------------- +// Constructor - Create class, Reset Variables and Read Infos +//------------- +Constructor TCMDParams.Create; +begin + + if FindCmdLineSwitch( cHelp ) 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( cUseLocalPaths ) + #9 + ' : Use relative paths' ); + + 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 = '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/Game/Code/Classes/UCommon.pas b/Game/Code/Classes/UCommon.pas new file mode 100644 index 00000000..fb74af0b --- /dev/null +++ b/Game/Code/Classes/UCommon.pas @@ -0,0 +1,215 @@ +unit UCommon;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+{$IFDEF LAZARUS}
+ lResources,
+{$ENDIF}
+ ULog,
+{$IFDEF DARWIN}
+ messages,
+{$ENDIF}
+{$IFDEF win32}
+ windows;
+{$ELSE}
+ lcltype,
+ messages;
+{$ENDIF}
+
+{$IFNDEF win32}
+type
+ hStream = THandle;
+ HGLRC = THandle;
+ TLargeInteger = Int64;
+ TWin32FindData = LongInt;
+{$ENDIF}
+
+{$IFDEF LAZARUS}
+ function LazFindResource( const aName, aType : String ): TLResource;
+{$ENDIF}
+
+{$IFDEF FPC}
+
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+
+function MaxValue(const Data: array of Double): Double;
+function MinValue(const Data: array of Double): Double;
+
+ {$IFDEF WIN32}
+ type
+ TWndMethod = procedure(var Message: TMessage) of object;
+ function AllocateHWnd(Method: TWndMethod): HWND;
+ procedure DeallocateHWnd(Wnd: HWND);
+ {$ENDIF} // Win32
+
+{$ENDIF} // FPC Only
+
+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
+function AdaptFilePaths( const aPath : widestring ): widestring;
+
+
+{$IFNDEF win32}
+(*
+ function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
+ function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
+*)
+ procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+{$ENDIF}
+
+// eddie: FindFirstW etc are now in UPlatformWindows.pas
+
+implementation
+
+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 := 0 to length( result ) - 1 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 win32}
+procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+begin
+ FillChar( Destination^, Length, 0 );
+end; //ZeroMemory
+
+(*
+function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
+
+ // From http://en.wikipedia.org/wiki/RDTSC
+ function RDTSC: Int64; register;
+ asm
+ rdtsc
+ end;
+
+begin
+ // Use clock_gettime here maybe ... from libc
+ lpPerformanceCount := RDTSC();
+ result := true;
+end;
+
+function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
+begin
+ lpFrequency := 0;
+ result := true;
+end;
+*)
+{$ENDIF}
+
+
+{$IFDEF LAZARUS}
+
+function LazFindResource( const aName, aType : String ): TLResource;
+var
+ iCount : Integer;
+begin
+ result := nil;
+
+ for iCount := 0 to LazarusResources.count -1 do
+ begin
+ if ( LazarusResources.items[ iCount ].Name = aName ) AND
+ ( LazarusResources.items[ iCount ].ValueType = aType ) THEN
+ begin
+ result := LazarusResources.items[ iCount ];
+ exit;
+ end;
+ end;
+end;
+{$ENDIF}
+
+{$IFDEF FPC}
+function MaxValue(const Data: array of Double): Double;
+var
+ I: Integer;
+begin
+ Result := Data[Low(Data)];
+ for I := Low(Data) + 1 to High(Data) do
+ if Result < Data[I] then
+ Result := Data[I];
+end;
+
+function MinValue(const Data: array of Double): Double;
+var
+ I: Integer;
+begin
+ Result := Data[Low(Data)];
+ for I := Low(Data) + 1 to High(Data) do
+ if Result > Data[I] then
+ Result := Data[I];
+end;
+
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+begin
+RandomRange := Random(aMax-aMin) + aMin ;
+end;
+
+
+// NOTE !!!!!!!!!!
+// AllocateHWnd is in lclintfh.inc
+
+{$IFDEF MSWINDOWS}
+// TODO : JB this is dodgey and bad... find a REAL solution !
+function AllocateHWnd(Method: TWndMethod): HWND;
+var
+ TempClass: TWndClass;
+ ClassRegistered: Boolean;
+begin
+ Result := CreateWindowEx(WS_EX_TOOLWINDOW, '', '', WS_POPUP , 0, 0, 0, 0, 0, 0, HInstance, nil);
+end;
+
+procedure DeallocateHWnd(Wnd: HWND);
+var
+ Instance: Pointer;
+begin
+ Instance := Pointer(GetWindowLong(Wnd, GWL_WNDPROC));
+ DestroyWindow(Wnd);
+end;
+{$ENDIF}
+{$IFDEF DARWIN}
+// TODO : Situation for the mac isn't better !
+function AllocateHWnd(Method: TWndMethod): HWND;
+begin
+end;
+
+procedure DeallocateHWnd(Wnd: HWND);
+begin
+end;
+{$ENDIF} // IFDEF DARWIN
+
+{$ENDIF} // IFDEF FPC
+
+end.
diff --git a/Game/Code/Classes/UConfig.pas b/Game/Code/Classes/UConfig.pas new file mode 100644 index 00000000..a7b0f328 --- /dev/null +++ b/Game/Code/Classes/UConfig.pas @@ -0,0 +1,175 @@ +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} +{$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-macosx.inc} + {$ELSE} + {$MESSAGE Fatal 'Unknown OS'} + {$IFEND} + +{* Libraries *} + + VERSION_MAJOR = 1000000; + VERSION_MINOR = 1000; + VERSION_RELEASE = 1; + + (* + * FPC_VERSION is already defined as a macro by FPC itself. + * You should use the built-in macros + * FPC_VERSION (=PPC_MAJOR) + * FPC_RELEASE (=PPC_MINOR) + * FPC_PATCH (=PPC_RELEASE) + * instead of the PPC_* ones defined here. + * This way Windows users do not need to set this. + * + * Note: It might be necessary to enable macros ({$MACRO ON} or -Sm) + * first if you want to use the FPC_* macros. + * In FPC 2.2.0 they work even without macros being enabled but + * this might be different in other versions. + * + * Example (Check for version >= 2.0.1): + * {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and + * ( (FPC_RELEASE > 0) or ((FPC_RELEASE = 0) and + * (FPC_PATCH >= 1)) ))} + * {$DEFINE FPC_VER_201_PLUS} + * {$ENDIF} + * + * IMPORTANT: do NOT check this way: + * {$IF (FPC_VERSION >= 2) and (FPC_RELEASE >= 0) and (FPC_PATCH >= 1)} + * ... + * In this case version 3.0.0 does not match because Patch 0 is less than 1. + *) + + //PPC_VERSION_MAJOR = @PPC_VERSION_MAJOR@; + //PPC_VERSION_MINOR = @PPC_VERSION_MINOR@; + //PPC_VERSION_RELEASE = @PPC_VERSION_RELEASE@; + //PPC_VERSION = (PPC_VERSION_MAJOR * VERSION_MAJOR) + + // (PPC_VERSION_MINOR * VERSION_MINOR) + + // (PPC_VERSION_RELEASE * VERSION_RELEASE); + + {$IFDEF LAZARUS} + LAZARUS_VERSION = (LAZARUS_VERSION_MAJOR * VERSION_MAJOR) + + (LAZARUS_VERSION_MINOR * VERSION_MINOR) + + (LAZARUS_VERSION_RELEASE * VERSION_RELEASE); + {$ENDIF} + + {$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} + +implementation + +end. diff --git a/Game/Code/Classes/UCore.pas b/Game/Code/Classes/UCore.pas new file mode 100644 index 00000000..7e76c9c4 --- /dev/null +++ b/Game/Code/Classes/UCore.pas @@ -0,0 +1,523 @@ +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
+ 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
+ noError: Boolean;
+begin
+ //Get Modules
+ Try
+ noError := GetModules;
+ Except
+ noError := False;
+ end;
+
+ //Loading
+ if (noError) then
+ begin
+ Try
+ noError := Load;
+ Except
+ noError := False;
+ end;
+
+ if (noError) then
+ begin //Init
+ Try
+ noError := Init;
+ Except
+ noError := False;
+ end;
+
+ If noError then
+ begin
+ //Call Translate Hook
+ noError := (Hooks.CallEventChain(hTranslate, 0, 0) = 0);
+
+ If noError then
+ begin //Calls LoadTextures Hook
+ noError := (Hooks.CallEventChain(hLoadTextures, 0, 0) = 0);
+
+ if noError then
+ begin //Calls Loading Finished Hook
+ noError := (Hooks.CallEventChain(hLoadingFinished, 0, 0) = 0);
+
+ If noError then
+ begin
+ //Start MainLoop
+ While noError do
+ begin
+ noError := MainLoop;
+ // to-do : Call Display Draw here
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error calling LoadingFinished Hook: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error calling LoadingFinished Hook'));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading textures: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading textures'));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error translating: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error translating'));
+ end;
+
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error initing Modules: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error initing Modules'));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading Modules: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error loading Modules'));
+ end;
+ end
+ else
+ begin
+ If (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error Getting Modules: ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar('Error Getting Modules'));
+ end;
+
+ //DeInit
+ DeInit;
+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;
+ try
+ For I := 0 to high(Modules) do
+ begin
+ Modules[I].NeedsDeInit := False;
+ Modules[I].Module := CORE_MODULES_TO_LOAD[I].Create;
+ Modules[I].Module.Info(@Modules[I].Info);
+ end;
+ Result := True;
+ except
+ ReportError(Integer(PChar('Can''t get module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core'));
+ end;
+end;
+
+//-------------
+//Loads Core and all Modules
+//-------------
+Function TCore.Load: Boolean;
+var
+ I: Integer;
+begin
+ Result := LoadCore;
+
+ I := 0;
+ While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
+ begin
+ try
+ Result := Modules[I].Module.Load;
+ except
+ Result := False;
+ ReportError(Integer(PChar('Error loading module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core'));
+ end;
+
+ Inc(I);
+ end;
+end;
+
+//-------------
+//Inits Core and all Modules
+//-------------
+Function TCore.Init: Boolean;
+var
+ I: Integer;
+begin
+ Result := InitCore;
+
+ I := 0;
+ While ((Result = True) AND (I <= High(CORE_MODULES_TO_LOAD))) do
+ begin
+ try
+ Result := Modules[I].Module.Init;
+ except
+ Result := False;
+ ReportError(Integer(PChar('Error initing module #' + InttoStr(I) + ' "' + Modules[I].Info.Name + '"')), PChar('Core'));
+ end;
+
+ Modules[I].NeedsDeInit := Result;
+ Inc(I);
+ end;
+end;
+
+//-------------
+//DeInits Core and all Modules
+//-------------
+Function TCore.DeInit: Boolean;
+var
+ I: Integer;
+label Continue;
+begin
+ I := High(CORE_MODULES_TO_LOAD);
+
+ Continue:
+ Try
+ While (I >= 0) do
+ begin
+ If (Modules[I].NeedsDeInit) then
+ Modules[I].Module.DeInit;
+
+ Dec(I);
+ end;
+ Except
+
+
+ end;
+ If (I >= 0) then
+ GoTo Continue;
+
+ DeInitCore;
+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
+ //Dont Init s.th. atm.
+ result := true;
+end;
+
+//-------------
+//DeInit the Core
+//-------------
+Function TCore.DeInitCore: Boolean;
+begin
+
+
+ // to-do : write TService-/HookManager.Free and call it here
+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
+ If (Modules[I].Info.Name = Name) then
+ begin
+ Result := @Modules[I].Module;
+ Break;
+ end;
+end;
+
+//-------------
+// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
+//-------------
+Function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
+var Params: Cardinal;
+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;
+
+ //Anzeigen:
+ Result := Messagebox(0, lParam, PChar(Name), Params);
+ end;
+ {$ENDIF}
+
+ // to-do : 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);
+end;
+
+//-------------
+// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
+//-------------
+Function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hDebug, wParam, lParam);
+end;
+
+//-------------
+// Calls Translate hook
+//-------------
+Function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hTranslate, 1, nil);
+end;
+
+//-------------
+// Calls LoadTextures hook
+//-------------
+Function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hLoadTextures, 1, nil);
+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;
+begin
+ if (Pointer(lParam) = nil) then
+ begin
+ Result := Length(Modules);
+ end
+ else
+ begin
+ Try
+ For Result := 0 to High(Modules) do
+ begin
+ AModuleInfo(Pointer(lParam))[Result].Name := Modules[Result].Info.Name;
+ AModuleInfo(Pointer(lParam))[Result].Version := Modules[Result].Info.Version;
+ AModuleInfo(Pointer(lParam))[Result].Description := Modules[Result].Info.Description;
+ end;
+ 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/Game/Code/Classes/UCoreModule.pas b/Game/Code/Classes/UCoreModule.pas new file mode 100644 index 00000000..c8c54161 --- /dev/null +++ b/Game/Code/Classes/UCoreModule.pas @@ -0,0 +1,126 @@ +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 + Procedure Free; virtual; + end; + cCoreModule = class of TCoreModule; + +implementation + +//------------- +// Just the Constructor +//------------- +Constructor TCoreModule.Create; +begin + //Dummy maaaan ;) +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 +//------------- +Procedure TCoreModule.Free; +begin + //Dummy ftw!! +end; + +end. diff --git a/Game/Code/Classes/UCovers.pas b/Game/Code/Classes/UCovers.pas new file mode 100644 index 00000000..9cc2a5e9 --- /dev/null +++ b/Game/Code/Classes/UCovers.pas @@ -0,0 +1,265 @@ +unit UCovers; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + {$IFNDEF FPC} + Graphics, + {$ENDIF} + UThemes, + UTexture; + +type + TCover = record + Name: string; + W: word; + H: word; + Size: integer; + Position: integer; // position of picture in the cache file +// Data: array of byte; + end; + + TCovers = class + Cover: array of TCover; + W: word; + H: word; + Size: integer; + Data: array of byte; + WritetoFile: Boolean; + + constructor Create; + procedure Load; + procedure Save; + procedure AddCover(Name: string); + function CoverExists(Name: string): boolean; + function CoverNumber(Name: string): integer; + procedure PrepareData(Name: string); + end; + +var + Covers: TCovers; + +implementation + +uses UMain, + // UFiles, + ULog, + DateUtils; + +constructor TCovers.Create; +begin + W := 128; + H := 128; + Size := W*H*3; + Load; + WritetoFile := True; +end; + +procedure TCovers.Load; +var + F: File; + C: integer; // cover number + W: word; + H: word; + Bits: byte; + NLen: word; + Name: string; +// Data: array of byte; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + WritetoFile := not FileIsReadOnly(GamePath + 'covers.cache'); + + SetLength(Cover, 0); + + while not EOF(F) do + begin + SetLength(Cover, Length(Cover)+1); + + BlockRead(F, W, 2); + Cover[High(Cover)].W := W; + + BlockRead(F, H, 2); + Cover[High(Cover)].H := H; + + BlockRead(F, Bits, 1); + + Cover[High(Cover)].Size := W * H * (Bits div 8); + + // test + // W := 128; + // H := 128; + // Bits := 24; + // Seek(F, FilePos(F) + 3); + + BlockRead(F, NLen, 2); + SetLength(Name, NLen); + + BlockRead(F, Name[1], NLen); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].Position := FilePos(F); + Seek(F, FilePos(F) + W*H*(Bits div 8)); + + // SetLength(Cover[High(Cover)].Data, W*H*(Bits div 8)); + // BlockRead(F, Cover[High(Cover)].Data[0], W*H*(Bits div 8)); + + end; // While + + CloseFile(F); + end; // fileexists +end; + +procedure TCovers.Save; +var + F: File; + C: integer; // cover number + W: word; + H: word; + NLen: word; + Bits: byte; +begin +{ AssignFile(F, GamePath + 'covers.cache'); + Rewrite(F, 1); + + Bits := 24; + for C := 0 to High(Cover) do begin + W := Cover[C].W; + H := Cover[C].H; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Cover[C].Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Cover[C].Name[1], NLen); + BlockWrite(F, Cover[C].Data[0], W*H*(Bits div 8)); + end; + + CloseFile(F);} +end; + +procedure TCovers.AddCover(Name: string); +var + B: integer; + F: File; + C: integer; // cover number + NLen: word; + Bits: byte; +begin + if not CoverExists(Name) then + begin + SetLength(Cover, Length(Cover)+1); + Cover[High(Cover)].Name := Name; + + Cover[High(Cover)].W := W; + Cover[High(Cover)].H := H; + Cover[High(Cover)].Size := Size; + + // do not copy data. write them directly to file +// SetLength(Cover[High(Cover)].Data, Size); +// for B := 0 to Size-1 do +// Cover[High(Cover)].Data[B] := CacheMipmap[B]; + + if WritetoFile then + begin + AssignFile(F, GamePath + 'covers.cache'); + + if FileExists(GamePath + 'covers.cache') then + begin + Reset(F, 1); + Seek(F, FileSize(F)); + end + else + begin + Rewrite(F, 1); + end; + + Bits := 24; + + BlockWrite(F, W, 2); + BlockWrite(F, H, 2); + BlockWrite(F, Bits, 1); + + NLen := Length(Name); + BlockWrite(F, NLen, 2); + BlockWrite(F, Name[1], NLen); + + Cover[High(Cover)].Position := FilePos(F); + BlockWrite(F, CacheMipmap[0], W*H*(Bits div 8)); + + CloseFile(F); + end; + end + else + Cover[High(Cover)].Position := 0; +end; + +function TCovers.CoverExists(Name: string): boolean; +var + C: integer; // cover +begin + Result := false; + C := 0; + + while (C <= High(Cover)) and (Result = false) do + begin + if Cover[C].Name = Name then + Result := true; + + Inc(C); + end; +end; + +function TCovers.CoverNumber(Name: string): integer; +var + C: integer; +begin + Result := -1; + C := 0; + + while (C <= High(Cover)) and (Result = -1) do + begin + if Cover[C].Name = Name then + Result := C; + + Inc(C); + end; +end; + +procedure TCovers.PrepareData(Name: string); +var + F: File; + C: integer; +begin + if FileExists(GamePath + 'covers.cache') then + begin + AssignFile(F, GamePath + 'covers.cache'); + Reset(F, 1); + + C := CoverNumber(Name); + SetLength(Data, Cover[C].Size); + if Length(Data) < 6 then beep; + Seek(F, Cover[C].Position); + BlockRead(F, Data[0], Cover[C].Size); + CloseFile(F); + end; +end; + +end. diff --git a/Game/Code/Classes/UDLLManager.pas b/Game/Code/Classes/UDLLManager.pas new file mode 100644 index 00000000..cbe79c3c --- /dev/null +++ b/Game/Code/Classes/UDLLManager.pas @@ -0,0 +1,252 @@ +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 + 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/Game/Code/Classes/UDataBase.pas b/Game/Code/Classes/UDataBase.pas new file mode 100644 index 00000000..b5636d52 --- /dev/null +++ b/Game/Code/Classes/UDataBase.pas @@ -0,0 +1,363 @@ +unit UDataBase; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses USongs, + USong, + SQLiteTable3; + +//-------------------- +//DataBaseSystem - Class including all DB Methods +//-------------------- +type + TStatResult = record + Case Typ: Byte of + 0: (Singer: ShortString; + Score: Word; + Difficulty: Byte; + SongArtist: ShortString; + SongTitle: ShortString); + + 1: (Player: ShortString; + AverageScore: Word); + + 2: (Artist: ShortString; + Title: ShortString; + TimesSung: Word); + + 3: (ArtistName: ShortString; + TimesSungtot: Word); + end; + AStatResult = Array of TStatResult; + + TDataBaseSystem = class + private + ScoreDB: TSqliteDatabase; + sFilename: string; + + public + + + property Filename: String read sFilename; + + Destructor Free; + + Procedure Init(const Filename: string); + procedure ReadScore(var Song: TSong); + procedure AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); + procedure WriteScore(var Song: TSong); + + Function GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; + Function GetTotalEntrys(const Typ: Byte): Cardinal; + end; + +var + DataBase: TDataBaseSystem; + +implementation + +uses IniFiles, SysUtils; + +const + cUS_Scores = 'us_scores'; + cUS_Songs = 'us_songs'; + +//-------------------- +//Create - Opens Database and Create Tables if not Exist +//-------------------- + +Procedure TDataBaseSystem.Init(const Filename: string); +begin + writeln( 'TDataBaseSystem.Init' ); + + //Open Database + ScoreDB := TSqliteDatabase.Create( Filename ); + sFilename := Filename; + + try + //Look for Tables => When not exist Create them + if not ScoreDB.TableExists( cUS_Scores ) then + begin + ScoreDB.execsql('CREATE TABLE `'+cUS_Scores+'` (`SongID` INT( 11 ) NOT NULL , `Difficulty` INT( 1 ) NOT NULL , `Player` VARCHAR( 150 ) NOT NULL , `Score` INT( 5 ) NOT NULL );'); + writeln( 'TDataBaseSystem.Init - CREATED US_Scores' ); + end; + + if not ScoreDB.TableExists( cUS_Songs ) then + begin + ScoreDB.execsql('CREATE TABLE `'+cUS_Songs+'` (`ID` INTEGER PRIMARY KEY, `Artist` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `TimesPlayed` int(5) NOT NULL );'); + writeln( 'TDataBaseSystem.Init - CREATED US_Songs' ); + end; + + //Not possible because of String Limitation to 255 Chars //Need to rewrite Wrapper + {if not ScoreDB.TableExists('US_SongCache') then + ScoreDB.ExecSQL('CREATE TABLE `US_SongCache` (`Path` VARCHAR( 255 ) NOT NULL , `Filename` VARCHAR( 255 ) NOT NULL , `Title` VARCHAR( 255 ) NOT NULL , `Artist` VARCHAR( 255 ) NOT NULL , `Folder` VARCHAR( 255 ) NOT NULL , `Genre` VARCHAR( 255 ) NOT NULL , `Edition` VARCHAR( 255 ) NOT NULL , `Language` VARCHAR( 255 ) NOT NULL , `Creator` VARCHAR( 255 ) NOT NULL , `Cover` VARCHAR( 255 ) NOT NULL , `Background` VARCHAR( 255 ) NOT NULL , `Video` VARCHAR( 255 ) NOT NULL , `VideoGap` FLOAT NOT NULL , `Gap` FLOAT NOT NULL , `Start` FLOAT NOT NULL , `Finish` INT( 11 ) NOT NULL , `BPM` INT( 5 ) NOT NULL , `Relative` BOOLEAN NOT NULL , `NotesGap` INT( 11 ) NOT NULL);');} + + + finally + writeln( cUS_Songs +' Exist : ' + inttostr( integer(ScoreDB.TableExists( cUS_Songs )) ) ); + writeln( cUS_Scores +' Exist : ' + inttostr( integer(ScoreDB.TableExists( cUS_Scores )) ) ); + //ScoreDB.Free; + end; + +end; + +//-------------------- +//Free - Frees Database +//-------------------- +Destructor TDataBaseSystem.Free; +begin + writeln( 'TDataBaseSystem.Free' ); + + freeandnil( ScoreDB ); +end; + +//-------------------- +//ReadScore - Read Scores into SongArray +//-------------------- +procedure TDataBaseSystem.ReadScore(var Song: TSong); +var + TableData: TSqliteTable; + Dif: Byte; +begin + if not assigned( ScoreDB ) then + exit; + + + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + try + //Search Song in DB + TableData := ScoreDB.GetTable('SELECT `Difficulty`, `Player`, `Score` FROM `'+cUS_Scores+'` WHERE `SongID` = (SELECT `ID` FROM `us_songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '" LIMIT 1) ORDER BY `Score` DESC LIMIT 15'); + + //Empty Old Scores + SetLength (Song.Score[0], 0); + SetLength (Song.Score[1], 0); + SetLength (Song.Score[2], 0); + + while not TableData.Eof do//Go through all Entrys + begin//Add one Entry to Array + Dif := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Difficulty'])); + if (Dif>=0) AND (Dif<=2) then + begin + SetLength(Song.Score[Dif], Length(Song.Score[Dif]) + 1); + + Song.Score[Dif, high(Song.Score[Dif])].Name := TableData.FieldAsString(TableData.FieldIndex['Player']); + Song.Score[Dif, high(Song.Score[Dif])].Score := StrtoInt(TableData.FieldAsString(TableData.FieldIndex['Score'])); + end; + TableData.Next; + + end; // While not TableData.EOF + + except //Im Fehlerfall + for Dif := 0 to 2 do + begin + SetLength(Song.Score[Dif], 1); + Song.Score[Dif, 1].Name := 'Error Reading ScoreDB'; + end; + end; + + finally // Try Finally + //ScoreDb.Free; + end; +end; + +//-------------------- +//AddScore - Add one new Score to DB +//-------------------- +procedure TDataBaseSystem.AddScore(var Song: TSong; Level: integer; Name: string; Score: integer); +var +ID: Integer; +TableData: TSqliteTable; +begin + if not assigned( ScoreDB ) then + exit; + + //ScoreDB := TSqliteDatabase.Create(sFilename); + try + //Prevent 0 Scores from being added + if (Score > 0) then + begin + + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `'+cUS_Songs+'` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Song doesn't exist -> Create + begin + ScoreDB.ExecSQL ('INSERT INTO `'+cUS_Songs+'` ( `ID` , `Artist` , `Title` , `TimesPlayed` ) VALUES (NULL , "' + Song.Artist + '", "' + Song.Title + '", "0");'); + ID := ScoreDB.GetTableValue('SELECT `ID` FROM `US_Songs` WHERE `Artist` = "' + Song.Artist + '" AND `Title` = "' + Song.Title + '"'); + if ID = 0 then //Could not Create Table + exit; + end; + //Create new Entry + ScoreDB.ExecSQL('INSERT INTO `'+cUS_Scores+'` ( `SongID` , `Difficulty` , `Player` , `Score` ) VALUES ("' + InttoStr(ID) + '", "' + InttoStr(Level) + '", "' + Name + '", "' + InttoStr(Score) + '");'); + + //Delete Last Position when there are more than 5 Entrys + if ScoreDB.GetTableValue('SELECT COUNT(`SongID`) FROM `'+cUS_Scores+'` WHERE `SongID` = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'"') > 5 then + begin + TableData := ScoreDB.GetTable('SELECT `Player`, `Score` FROM `'+cUS_Scores+'` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" ORDER BY `Score` ASC LIMIT 1'); + ScoreDB.ExecSQL('DELETE FROM `US_Scores` WHERE SongID = "' + InttoStr(ID) + '" AND `Difficulty` = "' + InttoStr(Level) +'" AND `Player` = "' + TableData.FieldAsString(TableData.FieldIndex['Player']) + '" AND `Score` = "' + TableData.FieldAsString(TableData.FieldIndex['Score']) + '"'); + end; + + end; + finally + //ScoreDB.Free; + end; +end; + +//-------------------- +//WriteScore - Not needed with new System; But used for Increment Played Count +//-------------------- +procedure TDataBaseSystem.WriteScore(var Song: TSong); +begin + if not assigned( ScoreDB ) then + exit; + + try + //Increase TimesPlayed + ScoreDB.ExecSQL ('UPDATE `'+cUS_Songs+'` SET `TimesPlayed` = `TimesPlayed` + "1" WHERE `Title` = "' + Song.Title + '" AND `Artist` = "' + Song.Artist + '";'); + except + + end; +end; + +//-------------------- +//GetStats - Write some Stats to Array, Returns True if Chossen Page has Entrys +//Case Typ of +//0 - Best Scores +//1 - Best Singers +//2 - Most sung Songs +//3 - Most popular Band +//-------------------- +Function TDataBaseSystem.GetStats(var Stats: AStatResult; const Typ, Count: Byte; const Page: Cardinal; const Reversed: Boolean): Boolean; +var + Query: String; + TableData: TSqliteTable; +begin + Result := False; + + if not assigned( ScoreDB ) then + exit; + + if (Length(Stats) < Count) then + Exit; + + {Todo: Add Prevention that only Players with more than 5 Scores are Selected at Typ 2} + + //Create Query + Case Typ of + 0: Query := 'SELECT `Player` , `Difficulty` , `Score` , `Artist` , `Title` FROM `'+cUS_Scores+'` INNER JOIN `US_Songs` ON (`SongID` = `ID`) ORDER BY `Score`'; + 1: Query := 'SELECT `Player` , ROUND (Sum(`Score`) / COUNT(`Score`)) FROM `'+cUS_Scores+'` GROUP BY `Player` ORDER BY (Sum(`Score`) / COUNT(`Score`))'; + 2: Query := 'SELECT `Artist` , `Title` , `TimesPlayed` FROM `'+cUS_Scores+'` ORDER BY `TimesPlayed`'; + 3: Query := 'SELECT `Artist` , Sum(`TimesPlayed`) FROM `'+cUS_Scores+'` GROUP BY `Artist` ORDER BY Sum(`TimesPlayed`)'; + end; + + //Add Order Direction + If Reversed then + Query := Query + ' ASC' + else + Query := Query + ' DESC'; + + //Add Limit + Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; + + //Execute Query + //try + TableData := ScoreDB.GetTable(Query); + {except + exit; + end;} + + //if Result empty -> Exit + if (TableData.RowCount < 1) then + exit; + + //Copy Result to Stats Array + while not TableData.Eof do + begin + Stats[TableData.Row].Typ := Typ; + + Case Typ of + 0:begin + Stats[TableData.Row].Singer := TableData.Fields[0]; + + Stats[TableData.Row].Difficulty := StrtoIntDef(TableData.Fields[1], 0); + + Stats[TableData.Row].Score := StrtoIntDef(TableData.Fields[2], 0){TableData.FieldAsInteger(2)}; + Stats[TableData.Row].SongArtist := TableData.Fields[3]; + Stats[TableData.Row].SongTitle := TableData.Fields[4]; + end; + + 1:begin + Stats[TableData.Row].Player := TableData.Fields[0]; + Stats[TableData.Row].AverageScore := StrtoIntDef(TableData.Fields[1], 0); + end; + + 2:begin + Stats[TableData.Row].Artist := TableData.Fields[0]; + Stats[TableData.Row].Title := TableData.Fields[1]; + Stats[TableData.Row].TimesSung := StrtoIntDef(TableData.Fields[2], 0); + end; + + 3:begin + Stats[TableData.Row].ArtistName := TableData.Fields[0]; + Stats[TableData.Row].TimesSungtot := StrtoIntDef(TableData.Fields[1], 0); + end; + + end; + + TableData.Next; + end; + + Result := True; +end; + +//-------------------- +//GetTotalEntrys - Get Total Num of entrys for a Stats Query +//-------------------- +Function TDataBaseSystem.GetTotalEntrys(const Typ: Byte): Cardinal; +var Query: String; +begin + if not assigned( ScoreDB ) then + exit; + try + //Create Query + Case Typ of + 0: begin + Query := 'SELECT COUNT(`SongID`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Scores ) then + exit; + end; + 1: begin + Query := 'SELECT COUNT(DISTINCT `Player`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Scores ) then + exit; + end; + 2: begin + Query := 'SELECT COUNT(`ID`) FROM `'+cUS_Scores+'`;'; + if not ScoreDB.TableExists( cUS_Songs ) then + exit; + end; + 3: begin + Query := 'SELECT COUNT(DISTINCT `Artist`) FROM `'+cUS_Songs+'`;'; + if not ScoreDB.TableExists( cUS_Songs ) then + exit; + end; + end; + + Result := ScoreDB.GetTableValue(Query); + except + // TODO : JB_Linux - Why do we get these exceptions on linux !! + on E:ESQLiteException DO // used to handle : Could not retrieve data "SELECT COUNT(`ID`) FROM `US_Songs`;" : SQL logic error or missing database + // however, we should pre-empt this error... and make sure the database DOES exist. + begin + result := 0; + end; + end; + +end; + +end. diff --git a/Game/Code/Classes/UDraw.pas b/Game/Code/Classes/UDraw.pas new file mode 100644 index 00000000..a81aa93b --- /dev/null +++ b/Game/Code/Classes/UDraw.pas @@ -0,0 +1,1353 @@ +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 SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +procedure SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); + +// TimeBar +procedure SingDrawTimeBar(); + +//Draw Editor NoteLines +procedure EditDrawCzesc(Left, Top, Right: real; NrCzesci: 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 {$IFDEF Win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGL12, + 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 >= 1 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: TSound; + 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; + + glBegin(GL_LINE_STRIP); + for SampleIndex := 0 to High(Sound.BufferArray) do + begin + glVertex2f(X + MaxX * SampleIndex/High(Sound.BufferArray), + Y + MaxY * (1 - Sound.BufferArray[SampleIndex]/-Low(Smallint))); + end; + glEnd; +end; + + + +procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); +var + Pet: integer; +begin + glEnable(GL_BLEND); + glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); + glBegin(GL_LINES); + for Pet := 0 to 9 do begin + glVertex2f(Left, Top + Pet * Space); + glVertex2f(Right, Top + Pet * Space); + end; + glEnd; + glDisable(GL_BLEND); +end; + +procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrCzesci: integer); +var + Pet: integer; + TempR: real; +begin + TempR := (Right-Left) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + glEnable(GL_BLEND); + glBegin(GL_LINES); + for Pet := Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote to Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec do begin + if (Pet mod Czesci[NrCzesci].Resolution) = Czesci[NrCzesci].NotesGAP then + glColor4f(0, 0, 0, 1) + else + glColor4f(0, 0, 0, 0.3); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top); + glVertex2f(Left + TempR * (Pet - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote), Top + 135); + end; + glEnd; + glDisable(GL_BLEND); +end; + +// draw blank Notebars +procedure SingDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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 NrCzesci - but it's always set to zero +// So we exploit this behavior a bit - we give NrCzesci the playernumber, keep it in playernumber - and then we set NrCzesci 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 := NrCzesci + 1; // Player 1 is 0 + NrCzesci := 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + {$IFDEF LAZARUS} +(* + writeln( 'UDRAW (Right-Left) : ' + floattostr( lTmpA ) ); + writeln( 'UDRAW : ' + floattostr( lTmpB ) ); + writeln( '' ); +*) + {$ENDIF} + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + + + if Ini.EffectSing = 0 then + // If Golden note Effect of then Change not Color + begin + case Wartosc of + 1: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself + 2: 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 == ende, schluss + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == länge + + 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 (Wartosc = 2) 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 SingDrawPlayerCzesc(X, Y, W: real; NrGracza: integer; Space: integer); +var + TempR: real; + Rec: TRecR; + N: integer; + R: real; + G: real; + B: real; + 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].IlNut > 0 then + begin + TempR := W / (Czesci[0].Czesc[Czesci[0].Akt].Koniec - Czesci[0].Czesc[Czesci[0].Akt].StartNote); + for N := 0 to Player[NrGracza].HighNut do + begin + with Player[NrGracza].Nuta[N] do + begin + // Left part of note + Rec.Left := X + (Start-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * 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 - (Ton-Czesci[0].Czesc[Czesci[0].Akt].BaseNote)*Space/2 - NotesH2; + Rec.Bottom := Rec.Top + 2 *NotesH2; + + // draw the left part + glColor3f(1, 1, 1); + glBindTexture(GL_TEXTURE_2D, Tex_Left[NrGracza+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+Dlugosc-Czesci[0].Czesc[Czesci[0].Akt].StartNote) * TempR - NotesW - 0.5 + 10*ScreenX; + + // (nowe) - dunno + if (Start+Dlugosc-1 = Czas.AktBeatD) then + Rec.Right := Rec.Right - (1-Frac(Czas.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[NrGracza+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[NrGracza+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*(Czas.Teraz - GetTimeFromBeat(Start+Dlugosc)); + if not (Start+Dlugosc-1 = Czas.AktBeatD) then + + //Star animation counter + //inc(Starfr); + //Starfr := Starfr mod 128; + GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); + end; + end; // with + end; // for + // eigentlich brauchen wir hier einen vergleich, um festzustellen, ob wir mit + // singen schon weiter wären, als bei Rec.Right, _auch, wenn nicht gesungen wird_ + + // passing on NrGracza... hope this is really something like the player-number, not only + // some kind of weird index into a colour-table + + if (Ini.EffectSing=1) then + GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, NrGracza); + end; // if +end; + +//draw Note glow +procedure SingDrawPlayerBGCzesc(Left, Top, Right: real; NrCzesci, NrGracza: integer; Space: integer); +var + Rec: TRecR; + Pet: integer; + TempR: real; + R,G,B: real; + X1, X2, X3, X4: real; + W, H: real; + + lTmpA , + lTmpB : real; +begin + if (Player[NrGracza].ScoreTotalI >= 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 := (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + + + if ( lTmpA > 0 ) AND + ( lTmpB > 0 ) THEN + begin + TempR := lTmpA / lTmpB; + end + else + begin + TempR := 0; + end; + + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + if not FreeStyle then begin + // begin: 14, 20 + // easy: 6, 11 + W := NotesW * 2 + 2; + H := NotesH * 1.5 + 3.5; + + X2 := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie + X1 := X2-W; + + X3 := (Start+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie + X4 := X3+W; + + // left + Rec.Left := X1; + Rec.Right := X2; + Rec.Top := Top - (Ton-BaseNote)*Space/2 - H; + Rec.Bottom := Rec.Top + 2 * H; + + glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[NrGracza+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[NrGracza+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[NrGracza+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 1 + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D); + end; +end; + +procedure SingDraw; +var + Pet: 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; + + // background //BG Fullsize Mod + //SingDrawBackground; + + //TimeBar mod + SingDrawTimeBar(); + //eoa TimeBar mod + + // rysuje paski pod nutami + 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; + + // Draw Lyrics + ScreenSing.Lyrics.Draw(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].StartNote - BarFrom)) / BarFrom; + Rec.Left := NR.Left + BarWspol * +// (NR.WMid - Czesci[0].Czesc[Czesci[0].Akt].LyricWidth / 2 * FS - 50); + (ScreenSing.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; +{ // zapalanie + BarAlpha := (BarWspol*10) * 0.5; + if BarAlpha > 0.5 then BarAlpha := 0.5; + + // gaszenie + if BarWspol > 0.95 then BarAlpha := 0.5 * (1 - (BarWspol - 0.95) * 20);}{ + + //Change fuer Crazy Joker + + 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 + 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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes + end; + + if (PlayersPlay = 2) then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(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; + + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); + end; + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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 + Pet: 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(Czas.MidBeat); + + // todo: Lyrics +{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie + FS := 1.3; + BarFrom := Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start; + if BarFrom > 40 then BarFrom := 40; + if (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czesci[0].Czesc[Czesci[0].Akt].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat > 0) and // przed tekstem + (Czesci[0].Czesc[Czesci[0].Akt].StartNote - Czas.MidBeat < 40) then begin // ale nie za wczesnie + BarWspol := (Czas.MidBeat - (Czesci[0].Czesc[Czesci[0].Akt].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 + SingDrawPlayerBGCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); + end; + + if (PlayersPlay = 2) then begin + if PlayerInfo.Playerinfo[0].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + end; + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + end; + + if PlayerInfo.Playerinfo[1].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + end; + + if PlayerInfo.Playerinfo[2].Enabled then + begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + end; + + if PlayersPlay = 4 then begin + if ScreenAct = 1 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15); + SingDrawPlayerBGCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15); + end; + + SingDrawCzesc(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); + SingDrawCzesc(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15); + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15); + SingDrawPlayerCzesc(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 + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerBGCzesc(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12); + SingDrawPlayerBGCzesc(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12); + end; + + SingDrawCzesc(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 245+95, NR.Right - 20, 0, 12); + SingDrawCzesc(NR.Left + 20, 370+95, NR.Right - 20, 0, 12); + + if ScreenAct = 1 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12); + end; + if ScreenAct = 2 then begin + SingDrawPlayerCzesc(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12); + SingDrawPlayerCzesc(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12); + SingDrawPlayerCzesc(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: +// 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 EditDrawCzesc(Left, Top, Right: real; NrCzesci: integer; Space: integer); +var + Rec: TRecR; + Pet: 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) / (Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].Koniec - Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote); + with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt] do begin + for Pet := 0 to HighNut do begin + with Nuta[Pet] do begin + + // Golden Note Patch + case Wartosc of + 0: glColor4f(1, 1, 1, 0.35); + 1: glColor4f(1, 1, 1, 0.85); + 2: glColor4f(1, 1, 0.3, 0.85); + end; // case + + + + // lewa czesc - left part + Rec.Left := (Start-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * TempR + Left + 0.5 + 10*ScreenX; + Rec.Right := Rec.Left + NotesW; + Rec.Top := Top - (Ton-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+Dlugosc-Czesci[NrCzesci].Czesc[Czesci[NrCzesci].Akt].StartNote) * 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; + lTmp : 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); + try + glTexCoord2f(0, 0); + glVertex2f(x,y); + + if ( Czas.Teraz > 0 ) AND + ( Czas.Razem > 0 ) THEN + BEGIN + lTmp := Czas.Teraz/Czas.Razem; + glTexCoord2f((width*Czas.Teraz/Czas.Razem)/8, 0); + glVertex2f(x+width*Czas.Teraz/Czas.Razem, y); + + glTexCoord2f((width*Czas.Teraz/Czas.Razem)/8, 1); + glVertex2f(x+width*Czas.Teraz/Czas.Razem, y+height); + END; + + glTexCoord2f(0, 1); + glVertex2f(x, y+height); + finally + glEnd; + end; + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + glcolor4f(1,1,1,1); +end; + +end. + diff --git a/Game/Code/Classes/UFiles.pas b/Game/Code/Classes/UFiles.pas new file mode 100644 index 00000000..495e8a4a --- /dev/null +++ b/Game/Code/Classes/UFiles.pas @@ -0,0 +1,148 @@ +unit UFiles; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +{$I switches.inc} + +uses SysUtils, + ULog, + UMusic, + USongs, + USong; + +procedure ResetSingTemp; +function SaveSong(Song: TSong; Czesc: TCzesci; 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 + Pet: integer; +begin + SetLength(Czesci, Length(Player)); + for Pet := 0 to High(Player) do begin + SetLength(Czesci[Pet].Czesc, 1); + SetLength(Czesci[Pet].Czesc[0].Nuta, 0); + Czesci[Pet].Czesc[0].Lyric := ''; + Czesci[Pet].Czesc[0].LyricWidth := 0; + Player[pet].Score := 0; + Player[pet].IlNut := 0; + Player[pet].HighNut := -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; Czesc: TCzesci; 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 Czesc.High do begin + for N := 0 to Czesc.Czesc[C].HighNut do begin + with Czesc.Czesc[C].Nuta[N] do begin + + + //Golden + Freestyle Note Patch + case Czesc.Czesc[C].Nuta[N].Wartosc of + 0: NoteState := 'F '; + 1: NoteState := ': '; + 2: NoteState := '* '; + end; // case + S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst; + + + WriteLn(SongFile, S); + end; // with + end; // N + + if C < Czesc.High then begin // don't write end of last sentence + if not Relative then + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start) + else begin + S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) + + ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime); + RelativeSubTime := Czesc.Czesc[C+1].Start; + end; + WriteLn(SongFile, S); + end; + + end; // C + + + WriteLn(SongFile, 'E'); + CloseFile(SongFile); +end; + +end. diff --git a/Game/Code/Classes/UGraphic.pas b/Game/Code/Classes/UGraphic.pas new file mode 100644 index 00000000..fcda137c --- /dev/null +++ b/Game/Code/Classes/UGraphic.pas @@ -0,0 +1,789 @@ +unit UGraphic;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ OpenGL12,
+ UTexture,
+ TextGL,
+ ULog,
+ SysUtils,
+ ULyrics,
+ UScreenLoading,
+ UScreenWelcome,
+ UScreenMain,
+ UScreenName,
+ UScreenLevel,
+ UScreenOptions,
+ UScreenOptionsGame,
+ UScreenOptionsGraphics,
+ UScreenOptionsSound,
+ UScreenOptionsLyrics,
+ UScreenOptionsThemes,
+ UScreenOptionsRecord,
+ UScreenOptionsAdvanced,
+ UScreenSong,
+ UScreenSing,
+ UScreenScore,
+ UScreenTop5,
+ UScreenEditSub,
+ UScreenEdit,
+ UScreenEditConvert,
+ UScreenEditHeader,
+ UScreenOpen,
+ UThemes,
+ USkins,
+ UScreenSongMenu,
+ UScreenSongJumpto,
+ {Party Screens}
+ UScreenSingModi,
+ UScreenPartyNewRound,
+ UScreenPartyScore,
+ UScreenPartyOptions,
+ UScreenPartyWin,
+ UScreenPartyPlayer,
+ {Stats Screens}
+ UScreenStatMain,
+ UScreenStatDetail,
+ {CreditsScreen}
+ UScreenCredits,
+ {Popup for errors, etc.}
+ UScreenPopup;
+
+type
+ TRecR = record
+ Top: real;
+ Left: real;
+ Right: real;
+ Bottom: real;
+ end;
+
+var
+ Screen: PSDL_Surface;
+ LoadingThread: PSDL_Thread;
+ Mutex: PSDL_Mutex;
+
+ RenderW: integer;
+ RenderH: integer;
+ ScreenW: integer;
+ ScreenH: integer;
+ Screens: integer;
+ ScreenAct: integer;
+ ScreenX: integer;
+
+ ScreenLoading: TScreenLoading;
+ ScreenWelcome: TScreenWelcome;
+ ScreenMain: TScreenMain;
+ ScreenName: TScreenName;
+ ScreenLevel: TScreenLevel;
+ ScreenSong: TScreenSong;
+ ScreenSing: TScreenSing;
+ ScreenScore: TScreenScore;
+ ScreenTop5: TScreenTop5;
+ ScreenOptions: TScreenOptions;
+ ScreenOptionsGame: TScreenOptionsGame;
+ ScreenOptionsGraphics: TScreenOptionsGraphics;
+ ScreenOptionsSound: TScreenOptionsSound;
+ ScreenOptionsLyrics: TScreenOptionsLyrics;
+ ScreenOptionsThemes: TScreenOptionsThemes;
+ ScreenOptionsRecord: TScreenOptionsRecord;
+ ScreenOptionsAdvanced: TScreenOptionsAdvanced;
+ ScreenEditSub: TScreenEditSub;
+ ScreenEdit: TScreenEdit;
+ ScreenEditConvert: TScreenEditConvert;
+ ScreenEditHeader: TScreenEditHeader;
+ ScreenOpen: TScreenOpen;
+
+ ScreenSongMenu: TScreenSongMenu;
+ ScreenSongJumpto: TScreenSongJumpto;
+
+ //Party Screens
+ ScreenSingModi: TScreenSingModi;
+ ScreenPartyNewRound: TScreenPartyNewRound;
+ ScreenPartyScore: TScreenPartyScore;
+ ScreenPartyWin: TScreenPartyWin;
+ ScreenPartyOptions: TScreenPartyOptions;
+ ScreenPartyPlayer: TScreenPartyPlayer;
+
+ //StatsScreens
+ ScreenStatMain: TScreenStatMain;
+ ScreenStatDetail: TScreenStatDetail;
+
+ //CreditsScreen
+ ScreenCredits: TScreenCredits;
+
+ //popup mod
+ ScreenPopupCheck: TScreenPopupCheck;
+ ScreenPopupError: TScreenPopupError;
+
+ //Notes
+ Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
+ Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
+ Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
+
+ Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
+ Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
+ Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
+
+ Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
+ Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
+ Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
+
+ Tex_Note_Star: TTexture;
+ Tex_Note_Perfect_Star: TTexture;
+
+
+ Tex_Ball: TTexture;
+ Tex_Lyric_Help_Bar: TTexture;
+ FullScreen: boolean;
+
+ Tex_TimeProgress: TTexture;
+
+ //Sing Bar Mod
+ Tex_SingBar_Back: TTexture;
+ Tex_SingBar_Bar: TTexture;
+ Tex_SingBar_Front: TTexture;
+ //end Singbar Mod
+
+ //PhrasenBonus - Line Bonus Mod
+ Tex_SingLineBonusBack: array[0..8] of TTexture;
+ //End PhrasenBonus - Line Bonus Mod
+
+ //ScoreBG Texs
+ Tex_ScoreBG: array [0..5] of TTexture;
+
+ //Score Screen Textures
+ Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
+
+ Tex_Score_Ratings : array [0..6] of TTexture;
+
+const
+ Skin_BGColorR = 1;
+ Skin_BGColorG = 1;
+ Skin_BGColorB = 1;
+
+ Skin_SpectrumR = 0;
+ Skin_SpectrumG = 0;
+ Skin_SpectrumB = 0;
+
+ Skin_Spectograph1R = 0.6;
+ Skin_Spectograph1G = 0.8;
+ Skin_Spectograph1B = 1;
+
+ Skin_Spectograph2R = 0;
+ Skin_Spectograph2G = 0;
+ Skin_Spectograph2B = 0.2;
+
+ Skin_SzczytR = 0.8;
+ Skin_SzczytG = 0;
+ Skin_SzczytB = 0;
+
+ Skin_SzczytLimitR = 0;
+ Skin_SzczytLimitG = 0.8;
+ Skin_SzczytLimitB = 0;
+
+ Skin_FontR = 0;
+ Skin_FontG = 0;
+ Skin_FontB = 0;
+
+ Skin_FontHighlightR = 0.3; // 0.3
+ Skin_FontHighlightG = 0.3; // 0.3
+ Skin_FontHighlightB = 1; // 1
+
+ Skin_TimeR = 0.25; //0,0,0
+ Skin_TimeG = 0.25;
+ Skin_TimeB = 0.25;
+
+ Skin_OscR = 0;
+ Skin_OscG = 0;
+ Skin_OscB = 0;
+
+ Skin_LyricsT = 494; // 500 / 510 / 400
+ Skin_SpectrumT = 470;
+ Skin_SpectrumBot = 570;
+ Skin_SpectrumH = 100;
+
+ Skin_P1_LinesR = 0.5; // 0.6 0.6 1
+ Skin_P1_LinesG = 0.5;
+ Skin_P1_LinesB = 0.5;
+
+ Skin_P2_LinesR = 0.5; // 1 0.6 0.6
+ Skin_P2_LinesG = 0.5;
+ Skin_P2_LinesB = 0.5;
+
+ Skin_P1_NotesB = 250;
+ Skin_P2_NotesB = 430; // 430 / 300
+
+ Skin_P1_ScoreT = 50;
+ Skin_P1_ScoreL = 20;
+
+ Skin_P2_ScoreT = 50;
+ Skin_P2_ScoreL = 640;
+
+procedure Initialize3D (Title: string);
+procedure Reinitialize3D;
+procedure SwapBuffers;
+
+procedure LoadTextures;
+procedure InitializeScreen;
+procedure LoadLoadingScreen;
+procedure LoadScreens;
+procedure UnLoadScreens;
+
+function LoadingThreadFunction: integer;
+
+
+implementation
+
+uses UMain,
+ UIni,
+ UDisplay,
+ UCommandLine,
+ {$IFNDEF FPC}
+ Graphics,
+ {$ENDIF}
+ {$IFDEF win32}
+ windows,
+ {$ENDIF}
+ Classes;
+
+procedure LoadFontTextures;
+begin
+ Log.LogStatus('Building Fonts', 'LoadTextures');
+ BuildFont;
+end;
+
+procedure LoadTextures;
+
+
+var
+ P: integer;
+ R, G, B: real;
+ Col: integer;
+begin
+ // zaladowanie tekstur
+ Log.LogStatus('Loading Textures', 'LoadTextures');
+
+ Tex_Left[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'BMP', 'Transparent', 0); //brauch man die noch?
+ Tex_Mid[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'BMP', 'Plain', 0); //brauch man die noch?
+ Tex_Right[0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'BMP', 'Transparent', 0); //brauch man die noch?
+
+ Log.LogStatus('Loading Textures - A', 'LoadTextures');
+
+ // P1-6
+ // TODO... do it once for each player... this is a bit crappy !!
+ // can we make it any better !?
+ for P := 1 to 6 do
+ begin
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+
+ Tex_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayLeft')), 'PNG', 'Colorized', Col);
+ Tex_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayMid')), 'PNG', 'Colorized', Col);
+ Tex_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('GrayRight')), 'PNG', 'Colorized', Col);
+
+ Tex_plain_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainLeft')), 'PNG', 'Colorized', Col);
+ Tex_plain_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainMid')), 'PNG', 'Colorized', Col);
+ Tex_plain_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePlainRight')), 'PNG', 'Colorized', Col);
+
+ Tex_BG_Left[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGLeft')), 'PNG', 'Colorized', Col);
+ Tex_BG_Mid[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGMid')), 'PNG', 'Colorized', Col);
+ Tex_BG_Right[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteBGRight')), 'PNG', 'Colorized', Col);
+ end;
+
+ Log.LogStatus('Loading Textures - B', 'LoadTextures');
+
+ Tex_Note_Perfect_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NotePerfectStar')), 'PNG', 'Transparent', 0);
+ Tex_Note_Star := Texture.LoadTexture(pchar(Skin.GetTextureFileName('NoteStar')) , 'PNG', 'Transparent', $FFFFFF);
+ Tex_Ball := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF);
+ Tex_Lyric_Help_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF);
+
+
+ //TimeBar mod
+ Tex_TimeProgress := Texture.LoadTexture(pchar(Skin.GetTextureFileName('TimeBar')));
+ //eoa TimeBar mod
+
+ //SingBar Mod
+ Tex_SingBar_Back := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBack')), 'JPG', 'Plain', 0);
+ Tex_SingBar_Bar := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarBar')), 'JPG', 'Plain', 0);
+ Tex_SingBar_Front := Texture.LoadTexture(pchar(Skin.GetTextureFileName('SingBarFront')), 'JPG', 'Font', 0);
+ //end Singbar Mod
+
+ Log.LogStatus('Loading Textures - C', 'LoadTextures');
+
+ //Line Bonus PopUp
+ for P := 0 to 8 do
+ begin
+ Case P of
+ 0: begin
+ R := 1;
+ G := 0;
+ B := 0;
+ end;
+ 1..3: begin
+ R := 1;
+ G := (P * 0.25);
+ B := 0;
+ end;
+ 4: begin
+ R := 1;
+ G := 1;
+ B := 0;
+ end;
+ 5..7: begin
+ R := 1-((P-4)*0.25);
+ G := 1;
+ B := 0;
+ end;
+ 8: begin
+ R := 0;
+ G := 1;
+ B := 0;
+ end;
+ End;
+
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), 'PNG', 'Colorized', Col);
+ end;
+
+//## backgrounds for the scores ##
+ for P := 0 to 5 do begin
+ LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), 'PNG', 'Colorized', Col);
+ end;
+
+
+ Log.LogStatus('Loading Textures - D', 'LoadTextures');
+
+// ######################
+// Score screen textures
+// ######################
+
+//## the bars that visualize the score ##
+ for P := 1 to 6 do begin
+//NoteBar ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), 'PNG', 'Colorized', Col);
+//LineBonus ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), 'PNG', 'Colorized', Col);
+//GoldenNotes ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), 'PNG', 'Colorized', Col);
+ Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), 'PNG', 'Colorized', Col);
+ end;
+
+//## rating pictures that show a picture according to your rate ##
+ for P := 0 to 6 do begin
+ Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), 'PNG', 'Transparent', 0);
+ end;
+
+ Log.LogStatus('Loading Textures - Done', 'LoadTextures');
+end;
+
+procedure Initialize3D (Title: string);
+var
+// Icon: TIcon;
+// Res: TResourceStream;
+ ISurface: PSDL_Surface;
+ Pixel: PByteArray;
+ I: Integer;
+begin
+ Log.LogStatus('LoadOpenGL', 'UGraphic.Initialize3D');
+// Log.BenchmarkStart(2);
+
+ LoadOpenGL;
+
+ Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
+ if ( SDL_Init(SDL_INIT_VIDEO)= -1 ) then
+ begin
+ Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
+ exit;
+ end;
+
+ { //Load Icon
+ Res := TResourceStream.CreateFromID(HInstance, 3, RT_ICON);
+ Icon := TIcon.Create;
+ Icon.LoadFromStream(Res);
+ Res.Free;
+ Icon.
+ //Create icon Surface
+ SDL_CreateRGBSurfaceFrom (
+ SDL_SWSURFACE,
+ Icon.Width,
+ Icon.Height,
+ 32,
+ 128 or 64,
+ 32 or 16,
+ 8 or 4,
+ 2 or 1);
+ //SDL_BlitSurface(
+
+
+ SDL_WM_SetIcon(SDL_LoadBMP('DEFAULT_WINDOW_ICON'), 0); //}
+
+ SDL_WM_SetCaption(PChar(Title), nil);
+
+ InitializeScreen;
+
+// Log.BenchmarkEnd(2);
+// Log.LogBenchmark('--> Setting Screen', 2);
+
+ // ladowanie tekstur
+// Log.BenchmarkStart(2);
+ Texture := TTextureUnit.Create;
+ Texture.Limit := 1024*1024;
+
+// LoadTextures;
+// Log.BenchmarkEnd(2);
+// Log.LogBenchmark('--> Loading Textures', 2);
+
+{ Log.BenchmarkStart(2);
+ Lyric:= TLyric.Create;
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Fonts', 2);
+}
+
+// Log.BenchmarkStart(2);
+
+ Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
+ Display := TDisplay.Create;
+
+ Log.LogStatus('SDL_EnableUnicode', 'UGraphic.Initialize3D');
+ SDL_EnableUnicode(1);
+// Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
+
+// Log.LogStatus('Loading Screens', 'Initialize3D');
+// Log.BenchmarkStart(3);
+
+ Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
+ LoadFontTextures();
+
+ // Show the Loading Screen -------------
+ Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
+ LoadLoadingScreen;
+
+
+ Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
+ LoadTextures; // jb
+
+
+
+ // now that we have something to display while loading,
+ // start thread that loads the rest of ultrastar
+// Mutex := SDL_CreateMutex;
+// SDL_UnLockMutex(Mutex);
+
+ // funktioniert so noch nicht, da der ladethread unverändert auf opengl zugreifen will
+ // siehe dazu kommentar unten
+ //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
+
+ // das hier würde dann im ladethread ausgeführt
+ Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
+ LoadScreens;
+
+
+ // TODO!!!!!!1
+ // hier käme jetzt eine schleife, die
+ // * den ladescreen malt (ab und zu)
+ // * den "fortschritt" des ladescreens steuert
+ // * zwischendrin schaut, ob der ladethread texturen geladen hat (mutex prüfen) und
+ // * die texturen in die opengl lädt, sowie
+ // * dem ladethread signalisiert, dass der speicher für die textur
+ // zum laden der nächsten textur weiterverwendet werden kann (über weiteren mutex)
+ // * über einen 3. mutex so lange läuft, bis der ladethread signalisiert,
+ // dass er alles geladen hat fertig ist
+ //
+ // dafür muss loadtexture so umgeschrieben werden, dass es, statt selbst irgendwelche
+ // opengl funktionen aufzurufen, entsprechend mutexe verändert
+ // der hauptthread muss auch irgendwoher erfahren, was an opengl funktionen auszuführen ist,
+ // mit welchen parametern (texturtyp, entspr. texturobjekt, textur-zwischenspeicher-adresse, ...
+
+
+ //wait for loading thread to finish
+ // funktioniert so auch noch nicht
+ //SDL_WaitThread(LoadingThread, I);
+// SDL_DestroyMutex(Mutex);
+
+ Display.ActualScreen^.FadeTo( @ScreenMain );
+
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Screens', 2);
+
+ Log.LogStatus('Finish', 'Initialize3D');
+end;
+
+procedure SwapBuffers;
+begin
+ SDL_GL_SwapBuffers;
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, RenderW, RenderH, 0, -1, 100);
+ glMatrixMode(GL_MODELVIEW);
+end;
+
+procedure Reinitialize3D;
+begin
+// InitializeScreen;
+// LoadTextures;
+// LoadScreens;
+end;
+
+procedure InitializeScreen;
+var
+ S: string;
+ I: integer;
+ W, H: integer;
+ Depth: Integer;
+begin
+ if (Params.Screens <> -1) then
+ Screens := Params.Screens + 1
+ else
+ Screens := Ini.Screens + 1;
+
+ SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16);
+ SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
+
+ // If there is a resolution in Parameters, use it, else use the Ini value
+ I := Params.Resolution;
+ if (I <> -1) then
+ S := IResolution[I]
+ else
+ S := IResolution[Ini.Resolution];
+
+ I := Pos('x', S);
+ W := StrToInt(Copy(S, 1, I-1)) * Screens;
+ H := StrToInt(Copy(S, I+1, 1000));
+
+ {if ParamStr(1) = '-fsblack' then begin
+ W := 800;
+ H := 600;
+ end;
+ if ParamStr(1) = '-320x240' then begin
+ W := 320;
+ H := 240;
+ end; }
+
+ If (Params.Depth <> -1) then
+ Depth := Params.Depth
+ else
+ Depth := Ini.Depth;
+
+
+ Log.LogStatus('SDL_SetVideoMode', 'Set Window Icon');
+
+// Okay it's possible to set the title bar / taskbar icon here
+// it's working this way, but just if the bmp is in your exe folder
+ SDL_WM_SetIcon(SDL_LoadBMP('ustar-icon.bmp'), 0);
+
+ Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
+// SDL_SetRefreshrate(85);
+// SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
+
+ {$ifndef win32}
+ // Todo : jb_linux remove this for linux... but helps for debugging
+ Ini.FullScreen := 0;
+ W := 800;
+ H := 600;
+ {$endif}
+
+ {$IFDEF DARWIN}
+ // Todo : eddie: remove before realease
+ Ini.FullScreen := 0;
+ {$ENDIF}
+
+ if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL)
+ end
+ else
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
+ SDL_ShowCursor(0);
+ end;
+
+ if (screen = nil) then
+ begin
+ Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
+ exit;
+ end;
+
+ // clear screen once window is being shown
+ glClearColor(1, 1, 1, 1);
+ glClear(GL_COLOR_BUFFER_BIT);
+ SwapBuffers;
+
+ // zmienne
+ RenderW := 800;
+ RenderH := 600;
+ ScreenW := W;
+ ScreenH := H;
+end;
+
+procedure LoadLoadingScreen;
+begin
+ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+
+ Display.ActualScreen := @ScreenLoading;
+
+ swapbuffers;
+
+ ScreenLoading.Draw;
+ Display.Draw;
+
+ SwapBuffers;
+end;
+
+procedure LoadScreens;
+begin
+{ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+ Display.ActualScreen := @ScreenLoading;
+ ScreenLoading.Draw;
+ Display.Draw;
+ SwapBuffers;
+}
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
+{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
+ ScreenMain := TScreenMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
+ ScreenName := TScreenName.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
+ ScreenLevel := TScreenLevel.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
+ ScreenSong := TScreenSong.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
+ ScreenSing := TScreenSing.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
+ ScreenScore := TScreenScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
+ ScreenTop5 := TScreenTop5.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
+ ScreenOptions := TScreenOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGame := TScreenOptionsGame.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsSound := TScreenOptionsSound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
+ ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsThemes := TScreenOptionsThemes.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
+ ScreenOptionsRecord := TScreenOptionsRecord.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
+ ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
+ ScreenEditSub := TScreenEditSub.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
+ ScreenEdit := TScreenEdit.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
+ ScreenEditConvert := TScreenEditConvert.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
+// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
+// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
+ ScreenOpen := TScreenOpen.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
+ ScreenSingModi := TScreenSingModi.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
+ ScreenSongJumpto := TScreenSongJumpto.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
+ ScreenPopupCheck := TScreenPopupCheck.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
+ ScreenPopupError := TScreenPopupError.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
+ ScreenPartyNewRound := TScreenPartyNewRound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
+ ScreenPartyScore := TScreenPartyScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
+ ScreenPartyWin := TScreenPartyWin.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
+ ScreenPartyOptions := TScreenPartyOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
+ ScreenPartyPlayer := TScreenPartyPlayer.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
+ ScreenStatMain := TScreenStatMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
+ ScreenStatDetail := TScreenStatDetail.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
+ ScreenCredits := TScreenCredits.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
+
+end;
+
+function LoadingThreadFunction: integer;
+begin
+ LoadScreens;
+ Result:= 1;
+end;
+
+procedure UnLoadScreens;
+begin
+ freeandnil( ScreenMain );
+ freeandnil( ScreenName );
+ freeandnil( ScreenLevel);
+ freeandnil( ScreenSong );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSing );
+ freeandnil( ScreenScore);
+ freeandnil( ScreenTop5 );
+ freeandnil( ScreenOptions );
+ freeandnil( ScreenOptionsGame );
+ freeandnil( ScreenOptionsGraphics );
+ freeandnil( ScreenOptionsSound );
+ freeandnil( ScreenOptionsLyrics );
+// freeandnil( ScreenOptionsThemes );
+ freeandnil( ScreenOptionsRecord );
+ freeandnil( ScreenOptionsAdvanced );
+ freeandnil( ScreenEditSub );
+ freeandnil( ScreenEdit );
+ freeandnil( ScreenEditConvert );
+ freeandnil( ScreenOpen );
+ freeandnil( ScreenSingModi );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSongJumpto);
+ freeandnil( ScreenPopupCheck );
+ freeandnil( ScreenPopupError );
+ freeandnil( ScreenPartyNewRound );
+ freeandnil( ScreenPartyScore );
+ freeandnil( ScreenPartyWin );
+ freeandnil( ScreenPartyOptions );
+ freeandnil( ScreenPartyPlayer );
+ freeandnil( ScreenStatMain );
+ freeandnil( ScreenStatDetail );
+end;
+
+end.
diff --git a/Game/Code/Classes/UGraphicClasses.pas b/Game/Code/Classes/UGraphicClasses.pas new file mode 100644 index 00000000..4dfc66ce --- /dev/null +++ b/Game/Code/Classes/UGraphicClasses.pas @@ -0,0 +1,678 @@ +// notes: +unit UGraphicClasses; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UTexture; + +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, + {$IFDEF win32} + windows, + {$ELSE} + lclintf, + {$ENDIF} + OpenGl12, + 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 <blindy> ?? die werden doch aber im Manager bei Draw getötet, wenns 0 is + 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 := GetTickCount; + 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 := GetTickCount; + //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/Game/Code/Classes/UHooks.pas b/Game/Code/Classes/UHooks.pas new file mode 100644 index 00000000..8b33959d --- /dev/null +++ b/Game/Code/Classes/UHooks.pas @@ -0,0 +1,430 @@ +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 UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +constructor THookManager.Create(const SpacetoAllocate: Word); +var I: Integer; +begin + //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} + WriteLn('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} + WriteLn('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} + WriteLn('HookManager: Add Event succesful: ''' + EventName + ''); + {$ENDIF} + end + {$IFDEF DEBUG} + else + WriteLn('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} + WriteLn('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 + WriteLn('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} + WriteLn('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} + WriteLn('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} + WriteLn('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/Game/Code/Classes/UIni.pas b/Game/Code/Classes/UIni.pas new file mode 100644 index 00000000..4ac67cda --- /dev/null +++ b/Game/Code/Classes/UIni.pas @@ -0,0 +1,801 @@ +unit UIni;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses IniFiles, ULog, SysUtils;
+
+type
+ PInputDeviceConfig = ^TInputDeviceConfig;
+ TInputDeviceConfig = record
+ Name: string;
+ Input: integer;
+ ChannelToPlayerMap: array[0..1] of integer;
+ end;
+
+type
+ TIni = class
+ 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;
+ FullScreen: integer;
+ TextureSize: integer;
+ SingWindow: integer;
+ Oscilloscope: integer;
+ Spectrum: integer;
+ Spectrograph: integer;
+ MovieSize: integer;
+
+ // Sound
+ MicBoost: integer;
+ ClickAssist: integer;
+ BeatClick: integer;
+ SavePlayback: integer;
+ Threshold: integer;
+
+ //Song Preview
+ PreviewVolume: integer;
+ PreviewFading: integer;
+
+ // Lyrics
+ LyricsFont: integer;
+ LyricsEffect: integer;
+ Solmization: integer;
+
+ // Themes
+ Theme: integer;
+ SkinNo: integer;
+ Color: integer;
+
+ // Record
+ InputDeviceConfig: array of TInputDeviceConfig;
+
+ // Advanced
+ LoadAnimation: integer;
+ EffectSing: integer;
+ ScreenFade: integer;
+ AskbeforeDel: integer;
+ OnSongClick: integer;
+ LineBonus: integer;
+ PartyPopup: integer;
+
+ // Controller
+ Joypad: integer;
+
+ // Soundcards
+ SoundCard: array[0..7, 1..2] of integer;
+
+ // Devices
+ LPT: 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;
+ ICard: array of string;
+ IInput: array of string;
+
+const
+ IPlayers: array[0..4] of string = ('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');
+ ITextureSize: array[0..2] of string = ('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]');
+
+ IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB');
+ 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%');
+ //Song Preview
+ IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
+ IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
+
+
+ ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2');
+ ILyricsEffect: array[0..3] of string = ('Simple', 'Zoom', 'Slide', 'Ball');
+ ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American');
+
+ 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');
+ ILPT: array[0..2] of string = ('Off', 'LCD', 'Lights');
+
+ IChannel: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6');
+
+implementation
+
+uses //UFiles,
+ UMain,
+ SDL,
+ ULanguage,
+ UPlatform,
+ USkins,
+ URecord,
+ UCommandLine;
+
+procedure TIni.Load;
+var
+ IniFile: TMemIniFile;
+ ThemeIni: TMemIniFile;
+ Tekst: string;
+ Pet: integer;
+ B: boolean;
+ I, I2, I3: integer;
+ S: string;
+ Modes: PPSDL_Rect;
+ SR: TSearchRec; //Skin List Patch
+
+ function GetFileName (S: String):String;
+ begin
+ //Result := copy (S,0,StrRScan (PChar(S),char('.'))+1);
+ Result := copy (S,0,Pos ('.ini',S)-1);
+ end;
+
+begin
+ GamePath := Platform.GetGameUserPath;
+
+ if (Params.ConfigFile <> '') then
+ try
+ IniFile := TMemIniFile.Create(Params.ConfigFile);
+ except
+ IniFile := TMemIniFile.Create(GamePath + 'config.ini');
+ end
+ else
+ IniFile := TMemIniFile.Create(GamePath + 'config.ini');
+
+
+ // Name
+ for I := 0 to 11 do
+ Ini.Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1));
+
+
+ // Templates for Names Mod
+ for I := 0 to 2 do
+ Ini.NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1));
+ for I := 0 to 11 do
+ Ini.NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1));
+
+ // Players
+ Tekst := IniFile.ReadString('Game', 'Players', IPlayers[0]);
+ for Pet := 0 to High(IPlayers) do
+ if Tekst = IPlayers[Pet] then Ini.Players := Pet;
+
+ // Difficulty
+ Tekst := IniFile.ReadString('Game', 'Difficulty', 'Easy');
+ for Pet := 0 to High(IDifficulty) do
+ if Tekst = IDifficulty[Pet] then Ini.Difficulty := Pet;
+
+ // Language
+ Tekst := IniFile.ReadString('Game', 'Language', 'English');
+ for Pet := 0 to High(ILanguage) do
+ if Tekst = ILanguage[Pet] then Ini.Language := Pet;
+
+// Language.ChangeLanguage(ILanguage[Ini.Language]);
+
+ // Tabs
+ Tekst := IniFile.ReadString('Game', 'Tabs', ITabs[0]);
+ for Pet := 0 to High(ITabs) do
+ if Tekst = ITabs[Pet] then Ini.Tabs := Pet;
+
+ //Tabs at Startup fix
+ Ini.Tabs_at_startup := Ini.Tabs;
+
+ // Sorting
+ Tekst := IniFile.ReadString('Game', 'Sorting', ISorting[0]);
+ for Pet := 0 to High(ISorting) do
+ if Tekst = ISorting[Pet] then Ini.Sorting := Pet;
+
+ // Debug
+ Tekst := IniFile.ReadString('Game', 'Debug', IDebug[0]);
+ for Pet := 0 to High(IDebug) do
+ if Tekst = IDebug[Pet] then Ini.Debug := Pet;
+
+ //if Ini.Debug = 1 then SongPath := 'E:\UltraStar 03\Songs\';
+
+ // Screens
+ Tekst := IniFile.ReadString('Graphics', 'Screens', IScreens[0]);
+ for Pet := 0 to High(IScreens) do
+ if Tekst = IScreens[Pet] then Ini.Screens := Pet;
+
+ // FullScreen
+ Tekst := IniFile.ReadString('Graphics', 'FullScreen', 'On');
+ for Pet := 0 to High(IFullScreen) do
+ if Tekst = IFullScreen[Pet] then Ini.FullScreen := Pet;
+
+
+ // Resolution
+ SetLength(IResolution, 0);
+
+ Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN); // Check if there are any modes available
+ while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07)
+ begin
+ SetLength(IResolution, Length(IResolution) + 1);
+ IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h);
+ Inc(Modes);
+ 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
+ SetLength(IResolution, Length(IResolution) + 1);
+ IResolution[High(IResolution)] := IntToStr(800) + 'x' + IntToStr(600);
+ Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[High(IResolution)] , 'Graphics - Resolutions');
+
+ // Default to fullscreen OFF, in this case !
+ Ini.FullScreen := 0;
+ end;
+
+ // reverse order
+ for I := 0 to (Length(IResolution) div 2) - 1 do begin
+ S := IResolution[I];
+ IResolution[I] := IResolution[High(IResolution)-I];
+ IResolution[High(IResolution)-I] := S;
+ end;
+
+ Tekst := IniFile.ReadString('Graphics', 'Resolution', '800x600');
+ for Pet := 0 to High(IResolution) do
+ if Tekst = IResolution[Pet] then Ini.Resolution := Pet;
+
+
+ // Resolution
+ Tekst := IniFile.ReadString('Graphics', 'Depth', '32 bit');
+ for Pet := 0 to High(IDepth) do
+ if Tekst = IDepth[Pet] then Ini.Depth := Pet;
+
+ // Texture Size
+ Tekst := IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]);
+ for Pet := 0 to High(ITextureSize) do
+ if Tekst = ITextureSize[Pet] then Ini.TextureSize := Pet;
+
+ // SingWindow
+ Tekst := IniFile.ReadString('Graphics', 'SingWindow', 'Big');
+ for Pet := 0 to High(ISingWindow) do
+ if Tekst = ISingWindow[Pet] then Ini.SingWindow := Pet;
+
+ // Oscilloscope
+ Tekst := IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar');
+ for Pet := 0 to High(IOscilloscope) do
+ if Tekst = IOscilloscope[Pet] then Ini.Oscilloscope := Pet;
+
+ // Spectrum
+ Tekst := IniFile.ReadString('Graphics', 'Spectrum', 'Off');
+ for Pet := 0 to High(ISpectrum) do
+ if Tekst = ISpectrum[Pet] then Ini.Spectrum := Pet;
+
+ // Spectrograph
+ Tekst := IniFile.ReadString('Graphics', 'Spectrograph', 'Off');
+ for Pet := 0 to High(ISpectrograph) do
+ if Tekst = ISpectrograph[Pet] then Ini.Spectrograph := Pet;
+
+ // MovieSize
+ Tekst := IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]);
+ for Pet := 0 to High(IMovieSize) do
+ if Tekst = IMovieSize[Pet] then Ini.MovieSize := Pet;
+
+ // MicBoost
+ Tekst := IniFile.ReadString('Sound', 'MicBoost', 'Off');
+ for Pet := 0 to High(IMicBoost) do
+ if Tekst = IMicBoost[Pet] then Ini.MicBoost := Pet;
+
+ // ClickAssist
+ Tekst := IniFile.ReadString('Sound', 'ClickAssist', 'Off');
+ for Pet := 0 to High(IClickAssist) do
+ if Tekst = IClickAssist[Pet] then Ini.ClickAssist := Pet;
+
+ // BeatClick
+ Tekst := IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]);
+ for Pet := 0 to High(IBeatClick) do
+ if Tekst = IBeatClick[Pet] then Ini.BeatClick := Pet;
+
+ // SavePlayback
+ Tekst := IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]);
+ for Pet := 0 to High(ISavePlayback) do
+ if Tekst = ISavePlayback[Pet] then Ini.SavePlayback := Pet;
+
+ // Threshold
+ Tekst := IniFile.ReadString('Sound', 'Threshold', IThreshold[2]);
+ for Pet := 0 to High(IThreshold) do
+ if Tekst = IThreshold[Pet] then Ini.Threshold := Pet;
+
+ //Song Preview
+ Tekst := IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]);
+ for Pet := 0 to High(IPreviewVolume) do
+ if Tekst = IPreviewVolume[Pet] then Ini.PreviewVolume := Pet;
+
+ Tekst := IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]);
+ for Pet := 0 to High(IPreviewFading) do
+ if Tekst = IPreviewFading[Pet] then Ini.PreviewFading := Pet;
+
+ // Lyrics Font
+ Tekst := IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]);
+ for Pet := 0 to High(ILyricsFont) do
+ if Tekst = ILyricsFont[Pet] then Ini.LyricsFont := Pet;
+
+ // Lyrics Effect
+ Tekst := IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]);
+ for Pet := 0 to High(ILyricsEffect) do
+ if Tekst = ILyricsEffect[Pet] then Ini.LyricsEffect := Pet;
+
+ // Solmization
+ Tekst := IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]);
+ for Pet := 0 to High(ISolmization) do
+ if Tekst = ISolmization[Pet] then Ini.Solmization := Pet;
+
+ // Theme
+
+ //Theme List Patch
+
+ //I2 Saves the no of the Deluxe (Standard-) Theme
+ I2 := 0;
+ //I counts is the cur. Theme no
+ I := 0;
+
+ SetLength(ITheme, 0);
+ writeln( 'Searching for Theme : '+ ThemePath + '*.ini' );
+ FindFirst(ThemePath + '*.ini',faAnyFile,SR);
+ Repeat
+ writeln( SR.Name );
+
+ //Read Themename from Theme
+ ThemeIni := TMemIniFile.Create(SR.Name);
+ Tekst := UpperCase(ThemeIni.ReadString('Theme','Name',GetFileName(SR.Name)));
+ ThemeIni.Free;
+
+ //if Deluxe Theme then save Themeno to I2
+ if (Tekst = 'DELUXE') then
+ I2 := I;
+
+ //Search for Skins for this Theme
+ for Pet := low(Skin.Skin) to high(Skin.Skin) do
+ begin
+ if UpperCase(Skin.Skin[Pet].Theme) = Tekst then
+ begin
+ SetLength(ITheme, Length(ITheme)+1);
+ ITheme[High(ITheme)] := GetFileName(SR.Name);
+ break;
+ end;
+ end;
+
+ Inc(I);
+ Until FindNext(SR) <> 0;
+ FindClose(SR);
+ //Theme List Patch End }
+
+ //No Theme Found
+ if (Length(ITheme)=0) then
+ begin
+ Log.CriticalError('Could not find any valid Themes.');
+ end;
+
+
+ Tekst := IniFile.ReadString('Themes', 'Theme', ITheme[I2]);
+ Ini.Theme := 0;
+ for Pet := 0 to High(ITheme) do
+ if Uppercase(Tekst) = Uppercase(ITheme[Pet]) then Ini.Theme := Pet;
+
+ // Skin
+ Skin.onThemeChange;
+ Ini.SkinNo := 0;
+
+ Tekst := IniFile.ReadString('Themes', 'Skin', ISkin[0]);
+ for Pet := 0 to High(ISkin) do
+ if Tekst = ISkin[Pet] then Ini.SkinNo := Pet;
+
+ // Color
+ Tekst := IniFile.ReadString('Themes', 'Color', IColor[0]);
+ for Pet := 0 to High(IColor) do
+ if Tekst = IColor[Pet] then Ini.Color := Pet;
+
+ // Input devices - load ini list
+ SetLength(InputDeviceConfig, 0);
+ I := 1;
+ while (IniFile.ValueExists('Record', 'DeviceName'+IntToStr(I))) do begin
+ // resize list
+ SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
+ I2 := High(InputDeviceConfig);
+
+ // 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).
+ InputDeviceConfig[I2].Name :=
+ IniFile.ReadString('Record', 'DeviceName'+IntToStr(I), '');
+ InputDeviceConfig[I2].Input :=
+ IniFile.ReadInteger('Record', 'Input'+IntToStr(I), 0);
+ InputDeviceConfig[I2].ChannelToPlayerMap[0] :=
+ IniFile.ReadInteger('Record', 'ChannelL'+IntToStr(I), 0);
+ InputDeviceConfig[I2].ChannelToPlayerMap[1] :=
+ IniFile.ReadInteger('Record', 'ChannelR'+IntToStr(I), 0);
+
+ Inc(I);
+ end;
+
+ // Input devices - append detected soundcards
+ for I := 0 to High(AudioInputProcessor.Device) do
+ begin
+ B := False;
+ For I2 := 0 to High(InputDeviceConfig) do
+ begin //Search for Card in List
+ if (InputDeviceConfig[I2].Name = Trim(AudioInputProcessor.Device[I].Description)) then
+ begin
+ B := True;
+ // associate ini-index with device
+ AudioInputProcessor.Device[I].CfgIndex := I2;
+ Break;
+ end;
+ end;
+
+ //If not in List -> Add
+ If not B then
+ begin
+ // resize list
+ SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
+ I2 := High(InputDeviceConfig);
+
+ InputDeviceConfig[I2].Name := Trim(AudioInputProcessor.Device[I].Description);
+ InputDeviceConfig[I2].Input := 0;
+ InputDeviceConfig[I2].ChannelToPlayerMap[0] := 0;
+ InputDeviceConfig[I2].ChannelToPlayerMap[1] := 0;
+
+ // associate ini-index with device
+ AudioInputProcessor.Device[I].CfgIndex := I2;
+
+ // set default at first start of USDX (1st device, 1st channel -> player1)
+ if (I2 = 0) then
+ InputDeviceConfig[I2].ChannelToPlayerMap[0] := 1;
+ end;
+ end;
+
+ //Advanced Settings
+
+ // LoadAnimation
+ Tekst := IniFile.ReadString('Advanced', 'LoadAnimation', 'On');
+ for Pet := 0 to High(ILoadAnimation) do
+ if Tekst = ILoadAnimation[Pet] then Ini.LoadAnimation := Pet;
+
+ // ScreenFade
+ Tekst := IniFile.ReadString('Advanced', 'ScreenFade', 'On');
+ for Pet := 0 to High(IScreenFade) do
+ if Tekst = IScreenFade[Pet] then Ini.ScreenFade := Pet;
+
+ // EffectSing
+ Tekst := IniFile.ReadString('Advanced', 'EffectSing', 'On');
+ for Pet := 0 to High(IEffectSing) do
+ if Tekst = IEffectSing[Pet] then Ini.EffectSing := Pet;
+
+ // AskbeforeDel
+ Tekst := IniFile.ReadString('Advanced', 'AskbeforeDel', 'On');
+ for Pet := 0 to High(IAskbeforeDel) do
+ if Tekst = IAskbeforeDel[Pet] then Ini.AskbeforeDel := Pet;
+
+ // OnSongClick
+ Tekst := IniFile.ReadString('Advanced', 'OnSongClick', 'Sing');
+ for Pet := 0 to High(IOnSongClick) do
+ if Tekst = IOnSongClick[Pet] then Ini.OnSongClick := Pet;
+
+ // Linebonus
+ Tekst := IniFile.ReadString('Advanced', 'LineBonus', 'At Score');
+ for Pet := 0 to High(ILineBonus) do
+ if Tekst = ILineBonus[Pet] then Ini.LineBonus := Pet;
+
+ // PartyPopup
+ Tekst := IniFile.ReadString('Advanced', 'PartyPopup', 'On');
+ for Pet := 0 to High(IPartyPopup) do
+ if Tekst = IPartyPopup[Pet] then Ini.PartyPopup := Pet;
+
+
+ // Joypad
+ Tekst := IniFile.ReadString('Controller', 'Joypad', IJoypad[0]);
+ for Pet := 0 to High(IJoypad) do
+ if Tekst = IJoypad[Pet] then Ini.Joypad := Pet;
+
+ // LCD
+ Tekst := IniFile.ReadString('Devices', 'LPT', ILPT[0]);
+ for Pet := 0 to High(ILPT) do
+ if Tekst = ILPT[Pet] then Ini.LPT := Pet;
+
+
+ // SongPath
+ if (Params.SongPath <> '') then
+ SongPath := IncludeTrailingPathDelimiter(Params.SongPath)
+ else
+ SongPath := IncludeTrailingPathDelimiter(IniFile.ReadString('Path', 'Songs', SongPath));
+
+ Filename := IniFile.FileName;
+ IniFile.Free;
+end;
+
+procedure TIni.Save;
+var
+ IniFile: TIniFile;
+ Tekst: string;
+ I: Integer;
+ S: String;
+begin
+ //if not (FileExists(GamePath + 'config.ini') and FileIsReadOnly(GamePath + 'config.ini')) then begin
+ if not (FileExists(Filename) and FileIsReadOnly(Filename)) then begin
+
+ IniFile := TIniFile.Create(Filename);
+
+ // Players
+ Tekst := IPlayers[Ini.Players];
+ IniFile.WriteString('Game', 'Players', Tekst);
+
+ // Difficulty
+ Tekst := IDifficulty[Ini.Difficulty];
+ IniFile.WriteString('Game', 'Difficulty', Tekst);
+
+ // Language
+ Tekst := ILanguage[Ini.Language];
+ IniFile.WriteString('Game', 'Language', Tekst);
+
+ // Tabs
+ Tekst := ITabs[Ini.Tabs];
+ IniFile.WriteString('Game', 'Tabs', Tekst);
+
+ // Sorting
+ Tekst := ISorting[Ini.Sorting];
+ IniFile.WriteString('Game', 'Sorting', Tekst);
+
+ // Debug
+ Tekst := IDebug[Ini.Debug];
+ IniFile.WriteString('Game', 'Debug', Tekst);
+
+ // Screens
+ Tekst := IScreens[Ini.Screens];
+ IniFile.WriteString('Graphics', 'Screens', Tekst);
+
+ // FullScreen
+ Tekst := IFullScreen[Ini.FullScreen];
+ IniFile.WriteString('Graphics', 'FullScreen', Tekst);
+
+ // Resolution
+ Tekst := IResolution[Ini.Resolution];
+ IniFile.WriteString('Graphics', 'Resolution', Tekst);
+
+ // Depth
+ Tekst := IDepth[Ini.Depth];
+ IniFile.WriteString('Graphics', 'Depth', Tekst);
+
+ // Resolution
+ Tekst := ITextureSize[Ini.TextureSize];
+ IniFile.WriteString('Graphics', 'TextureSize', Tekst);
+
+ // Sing Window
+ Tekst := ISingWindow[Ini.SingWindow];
+ IniFile.WriteString('Graphics', 'SingWindow', Tekst);
+
+ // Oscilloscope
+ Tekst := IOscilloscope[Ini.Oscilloscope];
+ IniFile.WriteString('Graphics', 'Oscilloscope', Tekst);
+
+ // Spectrum
+ Tekst := ISpectrum[Ini.Spectrum];
+ IniFile.WriteString('Graphics', 'Spectrum', Tekst);
+
+ // Spectrograph
+ Tekst := ISpectrograph[Ini.Spectrograph];
+ IniFile.WriteString('Graphics', 'Spectrograph', Tekst);
+
+ // Movie Size
+ Tekst := IMovieSize[Ini.MovieSize];
+ IniFile.WriteString('Graphics', 'MovieSize', Tekst);
+
+ // MicBoost
+ Tekst := IMicBoost[Ini.MicBoost];
+ IniFile.WriteString('Sound', 'MicBoost', Tekst);
+
+ // ClickAssist
+ Tekst := IClickAssist[Ini.ClickAssist];
+ IniFile.WriteString('Sound', 'ClickAssist', Tekst);
+
+ // BeatClick
+ Tekst := IBeatClick[Ini.BeatClick];
+ IniFile.WriteString('Sound', 'BeatClick', Tekst);
+
+ // Threshold
+ Tekst := IThreshold[Ini.Threshold];
+ IniFile.WriteString('Sound', 'Threshold', Tekst);
+
+ // Song Preview
+ Tekst := IPreviewVolume[Ini.PreviewVolume];
+ IniFile.WriteString('Sound', 'PreviewVolume', Tekst);
+
+ Tekst := IPreviewFading[Ini.PreviewFading];
+ IniFile.WriteString('Sound', 'PreviewFading', Tekst);
+
+ // SavePlayback
+ Tekst := ISavePlayback[Ini.SavePlayback];
+ IniFile.WriteString('Sound', 'SavePlayback', Tekst);
+
+ // Lyrics Font
+ Tekst := ILyricsFont[Ini.LyricsFont];
+ IniFile.WriteString('Lyrics', 'LyricsFont', Tekst);
+
+ // Lyrics Effect
+ Tekst := ILyricsEffect[Ini.LyricsEffect];
+ IniFile.WriteString('Lyrics', 'LyricsEffect', Tekst);
+
+ // Solmization
+ Tekst := ISolmization[Ini.Solmization];
+ IniFile.WriteString('Lyrics', 'Solmization', Tekst);
+
+ // Theme
+ Tekst := ITheme[Ini.Theme];
+ IniFile.WriteString('Themes', 'Theme', Tekst);
+
+ // Skin
+ Tekst := ISkin[Ini.SkinNo];
+ IniFile.WriteString('Themes', 'Skin', Tekst);
+
+ // Color
+ Tekst := IColor[Ini.Color];
+ IniFile.WriteString('Themes', 'Color', Tekst);
+
+ // Record
+ for I := 0 to High(InputDeviceConfig) do begin
+ S := IntToStr(I+1);
+
+ Tekst := InputDeviceConfig[I].Name;
+ IniFile.WriteString('Record', 'DeviceName' + S, Tekst);
+
+ Tekst := IntToStr(InputDeviceConfig[I].Input);
+ IniFile.WriteString('Record', 'Input' + S, Tekst);
+
+ Tekst := IntToStr(InputDeviceConfig[I].ChannelToPlayerMap[0]);
+ IniFile.WriteString('Record', 'ChannelL' + S, Tekst);
+
+ Tekst := IntToStr(InputDeviceConfig[I].ChannelToPlayerMap[1]);
+ IniFile.WriteString('Record', 'ChannelR' + S, Tekst);
+ end;
+
+ //Log.LogError(InttoStr(Length(CardList)) + ' Cards Saved');
+
+ //Advanced Settings
+
+ //LoadAnimation
+ Tekst := ILoadAnimation[Ini.LoadAnimation];
+ IniFile.WriteString('Advanced', 'LoadAnimation', Tekst);
+
+ //EffectSing
+ Tekst := IEffectSing[Ini.EffectSing];
+ IniFile.WriteString('Advanced', 'EffectSing', Tekst);
+
+ //ScreenFade
+ Tekst := IScreenFade[Ini.ScreenFade];
+ IniFile.WriteString('Advanced', 'ScreenFade', Tekst);
+
+ //AskbeforeDel
+ Tekst := IAskbeforeDel[Ini.AskbeforeDel];
+ IniFile.WriteString('Advanced', 'AskbeforeDel', Tekst);
+
+ //OnSongClick
+ Tekst := IOnSongClick[Ini.OnSongClick];
+ IniFile.WriteString('Advanced', 'OnSongClick', Tekst);
+
+ //Line Bonus
+ Tekst := ILineBonus[Ini.LineBonus];
+ IniFile.WriteString('Advanced', 'LineBonus', Tekst);
+
+ //Party Popup
+ Tekst := IPartyPopup[Ini.PartyPopup];
+ IniFile.WriteString('Advanced', 'PartyPopup', Tekst);
+
+ // Joypad
+ Tekst := IJoypad[Ini.Joypad];
+ IniFile.WriteString('Controller', 'Joypad', Tekst);
+
+ IniFile.Free;
+ end;
+end;
+
+procedure TIni.SaveNames;
+var
+ IniFile: TIniFile;
+ I: integer;
+begin
+ //if not FileIsReadOnly(GamePath + 'config.ini') then begin
+ //IniFile := TIniFile.Create(GamePath + 'config.ini');
+ 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), Ini.Name[I-1]);
+ for I := 1 to 3 do
+ IniFile.WriteString('NameTeam', 'T' + IntToStr(I), Ini.NameTeam[I-1]);
+ for I := 1 to 12 do
+ IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), Ini.NameTemplate[I-1]);
+
+ IniFile.Free;
+ end;
+end;
+
+procedure TIni.SaveLevel;
+var
+ IniFile: TIniFile;
+ I: integer;
+begin
+ //if not FileIsReadOnly(GamePath + 'config.ini') then begin
+ //IniFile := TIniFile.Create(GamePath + 'config.ini');
+ if not FileIsReadOnly(Filename) then begin
+ IniFile := TIniFile.Create(Filename);
+
+ // Difficulty
+ IniFile.WriteString('Game', 'Difficulty', IDifficulty[Ini.Difficulty]);
+
+ IniFile.Free;
+ end;
+end;
+
+end.
diff --git a/Game/Code/Classes/UJoystick.pas b/Game/Code/Classes/UJoystick.pas new file mode 100644 index 00000000..6b4ea63f --- /dev/null +++ b/Game/Code/Classes/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, + {$IFDEF win32} + windows, + {$ELSE} + LCLIntf, + {$ENDIF} + ULog; + +constructor TJoy.Create; +var + B, N: integer; +begin + //Old Corvus5 Method + {// joystick support + SDL_JoystickEventState(SDL_IGNORE); + SDL_InitSubSystem(SDL_INIT_JOYSTICK); + if SDL_NumJoysticks <> 1 then beep; + + SDL_Joy := SDL_JoystickOpen(0); + if SDL_Joy = nil then beep; + + if SDL_JoystickNumButtons(SDL_Joy) <> 16 then beep; + +// 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 beep; + + 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 := Gettickcount; + + //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/Game/Code/Classes/ULCD.pas b/Game/Code/Classes/ULCD.pas new file mode 100644 index 00000000..13736729 --- /dev/null +++ b/Game/Code/Classes/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
+//
+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/Game/Code/Classes/ULanguage.pas b/Game/Code/Classes/ULanguage.pas new file mode 100644 index 00000000..dc07c298 --- /dev/null +++ b/Game/Code/Classes/ULanguage.pas @@ -0,0 +1,238 @@ +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 + 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/Game/Code/Classes/ULight.pas b/Game/Code/Classes/ULight.pas new file mode 100644 index 00000000..b0ff9d6b --- /dev/null +++ b/Game/Code/Classes/ULight.pas @@ -0,0 +1,166 @@ +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} + {$IFNDEF win32} + libc, + {$ENDIF} + UTime; + +{$IFDEF FPC} + + function GetTime: TDateTime; + {$IFDEF win32} + var + SystemTime: TSystemTime; + begin + GetLocalTime(SystemTime); + with SystemTime do +{$IFDEF DARWIN} + Result := EncodeTime(Hour, Minute, Second, MilliSecond); +{$ELSE} + Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds); +{$ENDIF} + end; + {$ELSE} + Type + Time_t = longint; + TTime_T = Time_t; + var + T : TTime_T; + TV: TTimeVal; + UT: TUnixTime; + begin + gettimeofday(TV, nil); + T := TV.tv_sec; + localtime_r(@T, @UT); + Result := EncodeTime(UT.tm_hour, UT.tm_min, UT.tm_sec, TV.tv_usec div 1000); + end; + {$ENDIF} + +{$ENDIF} + + +constructor TLight.Create; +begin + 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; +// TimeSkip: real; + L: integer; +begin + if Enabled then begin + Time := GetTime; +// TimeSkip := Time - LastTime; + for L := 0 to 7 do begin + if Light[L] = true then begin + if LightTime[L] > Time then begin + // jest jeszcze zapas - bez zmian + //LightTime[L] := LightTime[L] - TimeSkip; + end else begin + // czas minal + Light[L] := false; + end; + end; + end; + LastTime := Time; + AutoSetState; + end; +end; + +end. + + diff --git a/Game/Code/Classes/ULog.pas b/Game/Code/Classes/ULog.pas new file mode 100644 index 00000000..542fa0b3 --- /dev/null +++ b/Game/Code/Classes/ULog.pas @@ -0,0 +1,364 @@ +unit ULog;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes;
+
+type
+ TLog = class
+ public
+ BenchmarkTimeStart: array[0..7] of real;
+ BenchmarkTimeLength: array[0..7] of real;//TDateTime;
+
+ FileBenchmark: TextFile;
+ FileBenchmarkO: boolean; // opened
+ FileError: TextFile;
+ FileErrorO: boolean; // opened
+
+ Title: String; //Application Title
+
+ //Should Log Files be written
+ Enabled: Boolean;
+
+ constructor Create;
+
+ // destuctor
+ destructor Destroy; override;
+
+ // benchmark
+ procedure BenchmarkStart(Number: integer);
+ procedure BenchmarkEnd(Number: integer);
+ procedure LogBenchmark(Text: string; Number: integer);
+
+ // error
+ procedure LogError(Text: string); overload;
+
+ //Critical Error (Halt + MessageBox)
+ procedure CriticalError(Text: string);
+
+ // voice
+ procedure LogVoice(SoundNr: integer);
+
+ // compability
+ procedure LogStatus(Log1, Log2: string);
+ procedure LogError(Log1, Log2: string); overload;
+ procedure LogBuffer(const buf : Pointer; const bufLength : Integer; filename : string);
+ end;
+
+procedure SafeWriteLn(const msg: string); inline;
+
+var
+ Log: TLog;
+
+implementation
+
+uses
+ {$IFDEF win32}
+ windows,
+ {$ENDIF}
+ SysUtils,
+ DateUtils,
+//UFiles,
+ UMain,
+ URecord,
+ UTime,
+//UIni, // JB - Seems to not be needed.
+ {$IFDEF FPC}
+ sdl,
+ {$ENDIF}
+ UCommandLine;
+
+{$IFDEF FPC}
+var
+ MessageList: TStringList;
+ ConsoleHandler: TThreadID;
+ ConsoleMutex: PSDL_Mutex;
+ ConsoleCond: PSDL_Cond;
+{$ENDIF}
+
+{$IFDEF FPC}
+{*
+ * The console-handlers main-function.
+ * TODO: create a quit-event on closing.
+ *}
+function ConsoleHandlerFunc(param: pointer): PtrInt;
+var
+ i: integer;
+begin
+ while true do
+ begin
+ SDL_mutexP(ConsoleMutex);
+ while (MessageList.Count = 0) do
+ SDL_CondWait(ConsoleCond, ConsoleMutex);
+ for i := 0 to MessageList.Count-1 do
+ begin
+ WriteLn(MessageList[i]);
+ end;
+ MessageList.Clear();
+ SDL_mutexV(ConsoleMutex);
+ end;
+ result := 0;
+end;
+{$ENDIF}
+
+{*
+ * 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
+ * - Use TEvent and TCriticalSection instead of the SDL equivalents.
+ * Note: If those two objects use TLS they might crash FPC too.
+ *}
+procedure SafeWriteLn(const msg: string);
+begin
+{$IFDEF FPC}
+ SDL_mutexP(ConsoleMutex);
+ MessageList.Add(msg);
+ SDL_CondSignal(ConsoleCond);
+ SDL_mutexV(ConsoleMutex);
+{$ELSE}
+ WriteLn(msg);
+{$ENDIF}
+end;
+
+constructor TLog.Create;
+begin
+{$IFDEF FPC}
+ // TODO: check for the main-thread?
+ //GetCurrentThreadThreadId();
+ MessageList := TStringList.Create();
+ ConsoleMutex := SDL_CreateMutex();
+ ConsoleCond := SDL_CreateCond();
+ ConsoleHandler := BeginThread(@ConsoleHandlerFunc);
+{$ENDIF}
+end;
+
+destructor TLog.Destroy;
+begin
+ if FileBenchmarkO then CloseFile(FileBenchmark);
+// if FileAnalyzeO then CloseFile(FileAnalyze);
+ if FileErrorO then CloseFile(FileError);
+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(Text: string; Number: integer);
+var
+ Minutes: integer;
+ Seconds: integer;
+ Miliseconds: integer;
+
+ MinutesS: string;
+ SecondsS: string;
+ MilisecondsS: string;
+
+ ValueText: string;
+begin
+ if Enabled AND (Params.Benchmark) then begin
+ if not FileBenchmarkO then begin
+ FileBenchmarkO := true;
+ AssignFile(FileBenchmark, LogPath + 'Benchmark.log');
+ {$I-}
+ Rewrite(FileBenchmark);
+ if IOResult = 0 then FileBenchmarkO := true;
+ {$I+}
+
+ //If File is opened write Date to Benchmark File
+ If (FileBenchmarkO) then
+ begin
+ WriteLn(FileBenchmark, Title + ' Benchmark File');
+ WriteLn(FileBenchmark, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
+ WriteLn(FileBenchmark, '-------------------');
+
+ Flush(FileBenchmark);
+ end;
+ end;
+
+ if FileBenchmarkO 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(FileBenchmark, Text + ': ' + ValueText);
+ Flush(FileBenchmark);
+ end;
+ end;
+end;
+
+procedure TLog.LogError(Text: string);
+begin
+ if Enabled AND (not FileErrorO) then begin
+ //FileErrorO := true;
+ AssignFile(FileError, LogPath + 'Error.log');
+ {$I-}
+ Rewrite(FileError);
+ if IOResult = 0 then FileErrorO := true;
+ {$I+}
+
+ //If File is opened write Date to Error File
+ If (FileErrorO) then
+ begin
+ WriteLn(FileError, Title + ' Error Log');
+ WriteLn(FileError, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
+ WriteLn(FileError, '-------------------');
+
+ Flush(FileError);
+ end;
+ end;
+
+ if FileErrorO then begin
+ try
+ WriteLn(FileError, Text);
+ Flush(FileError);
+ except
+ FileErrorO := false;
+ end;
+ end;
+ {$IFDEF DEBUG}
+ SafeWriteLn('Error: ' + Text);
+ {$ENDIF}
+end;
+
+procedure TLog.LogVoice(SoundNr: integer);
+var
+ FileVoice: File;
+ FS: TFileStream;
+ FileName: string;
+ Num: integer;
+ BL: 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);
+
+ for BL := 0 to High(AudioInputProcessor.Sound[SoundNr].BufferLong) do begin
+ AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Seek(0, soBeginning);
+ FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].BufferLong[BL], AudioInputProcessor.Sound[SoundNr].BufferLong[BL].Size);
+ end;
+
+ FS.Free;
+end;
+
+procedure TLog.LogStatus(Log1, Log2: string);
+begin
+ //Just for Debugging
+ //Comment for Release
+ //LogError(Log2 + ': ' + Log1);
+
+ //If Debug => Write to Console Output
+ {$IFDEF DEBUG}
+ // SafeWriteLn(Log2 + ': ' + Log1);
+ {$ENDIF}
+end;
+
+procedure TLog.LogError(Log1, Log2: string);
+begin
+ LogError(Log1 + ' ['+Log2+']');
+end;
+
+procedure TLog.CriticalError(Text: string);
+begin
+ //Write Error to Logfile:
+ LogError (Text);
+
+ {$IFDEF MSWINDOWS}
+ //Show Errormessage
+ Messagebox(0, PChar(Text), PChar(Title), MB_ICONERROR or MB_OK);
+ {$ELSE}
+ // TODO - JB_Linux handle critical error so user can see message.
+ SafeWriteLn( 'Critical ERROR :' );
+ SafeWriteLn( Text );
+ {$ENDIF}
+
+ //Exit Application
+ Halt;
+end;
+
+procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; 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/Game/Code/Classes/ULyrics.pas b/Game/Code/Classes/ULyrics.pas new file mode 100644 index 00000000..165084a8 --- /dev/null +++ b/Game/Code/Classes/ULyrics.pas @@ -0,0 +1,715 @@ +unit ULyrics; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + UTexture, + UThemes, + UMusic; + +type + TLyricWord = record + X: Real; //X Pos of the Word + Width: Real; //Width of the Text + TexPos: Real; //Pos of the Word (0 to 1) in the Sentence Texture + TexWidth: Real; //width of the Word in Sentence Texture (0 to 1) + Start: Cardinal; //Start of the Words in Quarters (Beats) + Length: Cardinal; //Length of the Word in Quarters + Text: String; //Text of this Word + Freestyle: Boolean; //Is this Word Freestyle + end; + ALyricWord = array of TLyricWord; + + PLyricLine = ^TLyricLine; + TLyricLine = record + Text: String; //Text of the Line + Tex: glUInt; //Texture of the Text from this Line + Width: Real; //Width of the Lyricline in Tex + Size: Byte; //Size of the Font in the Texture + Words: ALyricWord; //Words from this Line + CurWord: Integer; //current active word (only valid if line is active) + Start: Cardinal; //Start in Quarters of teh Line + Length: Cardinal; //Length in Quarters (From Start of First Note to the End of Last Note) + Freestyle: Boolean; //Complete Line is Freestyle ? + Players: Byte; //Which Players Sing this Line (1: Player1; 2: Player2; 4: Player3; [..]) + Done: Boolean; //Is Sentence Sung + end; + + TLyricEngine = class + private + EoLastSentence: Real; //When did the Last Sentence End (in Beats) + LastDrawBeat: Real; + UpperLine: TLyricLine; //Line in the Upper Part of the Lyric Display + LowerLine: TLyricLine; //Line in the Lower Part of teh Lyric Display + QueueLine: TLyricLine; //Line that is in Queue and will be added when next Line is Finished + PUpperLine, PLowerLine, PQueueLine: PLyricLine; + + IndicatorTex: TTexture; //Texture for Lyric Indikator(Bar that indicates when the Line start) + BallTex: TTexture; //Texture of the Ball for cur. Word hover in Ballmode + PlayerIconTex: array[0..5] of //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + array [0..1] of + TTexture; + + inQueue: Boolean; + LCounter: Word; + + //Some helper Procedures for Lyric Drawing + procedure DrawLyrics (Beat: Real); + procedure DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); + procedure DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, 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 + + HoverEffekt: Byte; //Effekt of Hovering active Word: 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FadeInEffekt: Byte; //Effekt for Line Fading in: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards from Bottom to Pos + FadeOutEffekt: Byte; //Effekt for Line Fading out: 0: No Effekt; 1: Fade Effekt; 2: Move Upwards + + UseLinearFilter:Boolean; //Should Linear Tex Filter be used + + //Song specific Settings + BPM: Real; + Resolution: Integer; + + + //properties to easily update this Class within other Parts of Code + property LineinQueue: Boolean read inQueue; //True when there is a Line in Queue + property LineCounter: Word read LCounter; //Lines that was Progressed so far (after last Clear) + + Constructor Create; overload; //Constructor, just get Memory + Constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real); overload; + Procedure LoadTextures; //Load Player Textures and Create + + Procedure AddLine(Line: PLine); //Adds a Line to the Queue if there is Space + Procedure Draw (Beat: Real); //Procedure Draws Lyrics; Beat is curent Beat in Quarters + Procedure Clear (const cBPM: Real = 0; const cResolution: Integer = 0); //Clears all cached Song specific Information + + Destructor Free; //Frees Memory + end; + +const LyricTexStart = 2/512; + +implementation + +uses SysUtils, + USkins, + TextGL, + UGraphic, + UDisplay, + dialogs, + 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: TRGBA); overload; +begin + glColor4f(Color.R, Color.G, Color.B, Color.A); +end; + + + +//--------------- +// Create - Constructor, just get Memory +//--------------- +Constructor TLyricEngine.Create; +begin + BPM := 0; + Resolution := 0; + LCounter := 0; + inQueue := False; + + UpperLine.Done := True; + LowerLine.Done := True; + QueueLine.Done := True; + PUpperline:=@UpperLine; + PLowerLine:=@LowerLine; + PQueueLine:=@QueueLine; + + UseLinearFilter := True; + {$IFDEF DARWIN} + // eddie: Getting range check error with NAN on OS X: + LastDrawBeat:=0; + {$ELSE} + LastDrawBeat:=NAN; + {$ENDIF} +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; + + +//--------------- +// Free - Frees Memory +//--------------- +Destructor TLyricEngine.Free; +begin + +end; + +//--------------- +// Clear - Clears all cached Song specific Information +//--------------- +Procedure TLyricEngine.Clear (const cBPM: Real; const cResolution: Integer); +begin + BPM := cBPM; + Resolution := cResolution; + LCounter := 0; + inQueue := False; + + UpperLine.Done := True; + LowerLine.Done := True; + QueueLine.Done := True; + + PUpperline:=@UpperLine; + PLowerLine:=@LowerLine; + PQueueLine:=@QueueLine; + {$IFDEF DARWIN} + // eddie: Getting range check error with NAN on OS X: + LastDrawBeat:=0; + {$ELSE} + LastDrawBeat:=NAN; + {$ENDIF} +end; + + +//--------------- +// LoadTextures - Load Player Textures and Create Lyric Textures +//--------------- +Procedure TLyricEngine.LoadTextures; +var + I: Integer; + PTexData: Pointer; + + function CreateLineTex: glUint; + begin + GetMem(pTexData, 1024*64*4); //get Memory to save Tex in + + //generate and bind Texture + glGenTextures(1, @Result); + glBindTexture(GL_TEXTURE_2D, Result); + + //Get Memory + glTexImage2D(GL_TEXTURE_2D, 0, 4, 1024, 64, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); + + 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; + + //Free now unused Memory + FreeMem(pTexData); + end; +begin + //Load Texture for Lyric Indikator(Bar that indicates when the Line start) + IndicatorTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricHelpBar')), 'BMP', 'Transparent', $FF00FF); + + //Load Texture of the Ball for cur. Word hover in Ballmode + BallTex := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Ball')), 'BMP', 'Transparent', $FF00FF); + + //Load PlayerTexs + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + + //atm just unset other texs + For I := 2 to 5 do + begin + PlayerIconTex[I][0].TexNum := high(Cardinal); //Set to C's -1 + PlayerIconTex[I][1].TexNum := high(Cardinal); + end; + + //Create LineTexs + UpperLine.Tex := CreateLineTex; + LowerLine.Tex := CreateLineTex; + QueueLine.Tex := CreateLineTex; +end; + + +//--------------- +// AddLine - Adds LyricLine to queue +//--------------- +Procedure TLyricEngine.AddLine(Line: PLine); +var + LyricLine: PLyricLine; + I: Integer; + countNotes: Cardinal; + PosX: Real; + Viewport: Array[0..3] of Integer; +begin + //Only Add Lines if there is enough space + If not LineinQueue then + begin + //Set Pointer to Line to Write + If (LineCounter = 0) then + LyricLine := PUpperLine //Set Upper Line + else if (LineCounter = 1) then + LyricLine := PLowerLine //Set Lower Line + else + begin + LyricLine := PQueueLine; //Set Queue Line + inQueue := True; //now there is a Queued Line + end; + end + else + begin // rotate lines (round-robin-like) + LyricLine:=PUpperLine; + PUpperLine:=PLowerLine; + PLowerLine:=PQueueLine; + PQueueLine:=LyricLine; + end; + + //Check if Sentence has Notes + If (Length(Line.Nuta) > 0) then + begin + //Copy Values from SongLine to LyricLine + CountNotes := high(Line.Nuta); + LyricLine.Start := Line.Nuta[0].Start; + LyricLine.Length := Line.Nuta[CountNotes].Start + Line.Nuta[CountNotes].Dlugosc - LyricLine.Start; + LyricLine.Freestyle := True; //is set by And Notes Freestyle while copying Notes + LyricLine.Text := ''; //Also Set while copying Notes + LyricLine.Players := 127; //All Players for now, no Duett Mode available + LyricLine.CurWord:=-1; // inactive line - so no word active atm + //Copy Words + SetLength(LyricLine.Words, CountNotes + 1); + For I := 0 to CountNotes do + begin + LyricLine.Freestyle := LyricLine.Freestyle AND Line.Nuta[I].FreeStyle; + LyricLine.Words[I].Start := Line.Nuta[I].Start; + LyricLine.Words[I].Length := Line.Nuta[I].Dlugosc; + LyricLine.Words[I].Text := Line.Nuta[I].Tekst; + LyricLine.Words[I].Freestyle := Line.Nuta[I].FreeStyle; + LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text + end; + + //Set Font Params + SetFontStyle(FontStyle); + SetFontPos(0, 0); + LyricLine.Size := UpperLineSize; + SetFontSize(LyricLine.Size); + SetFontItalic(False); + glColor4f(1, 1, 1, 1); + + //Change Fontsize to Fit the Screen + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + While (LyricLine.Width > UpperLineW) do + begin + Dec(LyricLine.Size); + + if (LyricLine.Size <=1) then + Break; + + SetFontSize(LyricLine.Size); + LyricLine.Width := glTextWidth(PChar(LyricLine.Text)); + end; + + //Set Word Positions and Line Size + PosX := 0 {LowerLineX + LowerLineW/2 + 80 - LyricLine.Width/2}; + For I := 0 to High(LyricLine.Words) do + begin + LyricLine.Words[I].X := PosX; + LyricLine.Words[I].Width := glTextWidth(PChar(LyricLine.Words[I].Text)); + LyricLine.Words[I].TexPos := (PosX+1) / 1024; + LyricLine.Words[I].TexWidth := (LyricLine.Words[I].Width-1) / 1024; + + PosX := PosX + LyricLine.Words[I].Width; + end; + + + //Create LyricTexture + //Prepare Ogl + glGetIntegerv(GL_VIEWPORT, @ViewPort); + glClearColor(0.0,0.0,0.0,0.0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + glViewPort(0,0,800,600); + + //Draw Lyrics + SetFontPos(0, 0); + glPrint(PChar(LyricLine.Text)); + + Display.ScreenShot; + //Copy to Texture + glEnable(GL_ALPHA); + glBindTexture(GL_TEXTURE_2D, LyricLine.Tex); + glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0); + glDisable(GL_ALPHA); + //Clear Buffer + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + + glViewPort(ViewPort[0], ViewPort[1], ViewPort[2], ViewPort[3]); + + 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); +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, PUpperline, Beat); + DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, PLowerline, Beat); +end; + +//--------------- +// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon +//--------------- +procedure TLyricEngine.DrawPlayerIcon(const Player: Byte; const Enabled: Boolean; const X, Y, Size, Alpha: Real); +var IEnabled: Byte; +begin + Case Enabled of + True: IEnabled := 0; + False: IEnabled:= 1; + end; + + 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; +//--------------- +// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine +//--------------- +procedure TLyricEngine.DrawLyricsLine(const X, W, Y: Real; Size: Byte; const Line: PLyricLine; Beat: Real); +var + I: Integer; +// CurWord: Integer; + CurWordStartTx, + CurWordEndTx: Real; // texture-coordinates of start and end of current word + CurWordStart, + CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence + Progress: Real; + LyricX: Real; //Left Corner on X Axis + LyricX2: Real;//Right Corner " " + LyricScale: Real; //Up or Downscale the Lyrics need <- ??? + IconSize: Real; + IconAlpha: Real; + + mybeat:string; + mywidth:real; + realfontsize:real; +begin +{ SetFontStyle(FontStyle); + SetFontSize(Size); + glColor4f(1, 1, 1, 1); + + // line start beat + SetFontPos(50, Y-500); + mybeat:=inttostr(trunc(line^.start*100)); + glPrint(addr(mybeat[1])); + + // current beat + SetFontPos(250, Y-500); + mybeat:=inttostr(trunc(beat*100)); + glPrint(addr(mybeat[1])); + + // current beat + SetFontPos(450, Y-500); + mybeat:=inttostr(trunc((line^.start+line^.length)*100)); + glPrint(addr(mybeat[1])); +} + + // what is this for? + LyricScale := Size / Line.Size; + + //Draw Icons + IconSize := (2 * Size); + //IconAlpha := 1; + IconAlpha := Frac(Beat/(Resolution*4)); + + {DrawPlayerIcon (0, True, X, Y, IconSize, IconAlpha); + DrawPlayerIcon (1, True, X + IconSize + 1, Y, IconSize, IconAlpha); + DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y, IconSize, IconAlpha);} + + //Check if a Word in the Sentence is active + if ((Line^.Start < Beat) and (Beat < Line^.Start + Line^.Length)) then + begin + // if this line just got active, then CurWord is still -1 + // this means, we should try to make the first word active + // then we check if the current active word is still meant to be active + // if not, we proceed to the next word + if Line^.CurWord = -1 then + Line^.CurWord:=0; + if not ((Beat < (Line^.Words[Line^.CurWord].Start+Line^.Words[Line^.CurWord].Length))) then + Line^.CurWord:=Line^.CurWord+1; + +// !!TODO: make sure, it works if the sentence is still enabled, after last word was active +// if Line^.CurWord > high(Line^.Words) then Line^.CurWord:=-2; + + with Line^.Words[Line^.CurWord] do + begin + Progress:=(Beat-Start)/Length; + CurWordStartTx:=TexPos; + CurWordEndTx:=TexPos+TexWidth; + CurWordStart:=X; + CurWordEnd:=X+Width; + end; + + //Get Start Position: + { Start of Line - Width of all Icons + LineWidth/2 (Center} +// LyricX := X + {(W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3) +} (W/2); + LyricX:=X+W/2; + LyricX2 := LyricX + Line^.Width/2; + LyricX:=LyricX - Line^.Width/2; + + //Draw complete Sentence + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + +{ glColor4f(0,1,0.1,0.1); + glBegin(GL_QUADS); + glVertex2f(X+W/2, Y); + glVertex2f(X+W/2, Y + line^.size*3.5); + glVertex2f(X+W/2+line^.width/2, Y + line^.size*3.5); + glVertex2f(X+W/2+line^.width/2, Y); + glEnd; + glColor4f(0,1,0,0.1); + glBegin(GL_QUADS); + glVertex2f(X+W/2-line^.width/2, Y); + glVertex2f(X+W/2-line^.width/2, Y + line^.size*3.5); + glVertex2f(X+W/2, Y + line^.size*3.5); + glVertex2f(X+W/2, Y); + glEnd; + + // draw whole sentence + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + 64); + glTexCoord2f(Line^.Width/512, 0); glVertex2f(LyricX2, Y + 64); + glTexCoord2f(Line^.Width/512, 1); glVertex2f(LyricX2, Y); + glEnd; +} + + // this is actually a bit more than the real font size + // it helps adjusting the "zoom-center" + realfontsize:=30 * (Line^.Size/10)+16; + // draw sentence up to current word + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); + + glColorRGB(LineColor_act); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 1-realfontsize/64); glVertex2f(LyricX, Y + realfontsize); + glTexCoord2f(CurWordStartTx, 1-realfontsize/64); glVertex2f(LyricX+CurWordStart, Y + realfontsize); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glEnd; + +{ // draw active word - type 1: farbwechsel - HoverEffect=3 oder so? + glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glEnd; + glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx, 1); glVertex2f(LyricX+CurWordStart, Y); + glTexCoord2f(CurWordStartTx, 0); glVertex2f(LyricX+CurWordStart, Y + 64); + glTexCoord2f(CurWordEndTx, 0); glVertex2f(LyricX+CurWordEnd, Y + 64); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glEnd; +} + + // draw active word - type 2: zoom + farbwechsel - HoverEffect=4 ??? + glPushMatrix; + glTranslatef(LyricX+CurWordStart+(CurWordEnd-CurWordStart)/2,Y+realfontsize/2,0); + glScalef(1.0+(1-progress)/2,1.0+(1-progress)/2,1.0); + glColor4f(LineColor_en.r,LineColor_en.g,LineColor_en.b,1-progress); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -realfontsize/2); + glTexCoord2f(CurWordStartTx+0.0001, 1-realfontsize/64); glVertex2f(-(CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1-realfontsize/64); glVertex2f((CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -realfontsize/2); + glEnd; + glColor4f(LineColor_act.r,LineColor_act.g,LineColor_act.b,1); + glBegin(GL_QUADS); + glTexCoord2f(CurWordStartTx+0.0001, 1); glVertex2f(-(CurWordEnd-CurWordStart)/2, -realfontsize/2); + glTexCoord2f(CurWordStartTx+0.0001, 1-realfontsize/64); glVertex2f(-(CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1-realfontsize/64); glVertex2f((CurWordEnd-CurWordStart)/2, + realfontsize/2); + glTexCoord2f(CurWordEndTx-0.0001, 1); glVertex2f((CurWordEnd-CurWordStart)/2, -realfontsize/2); + glEnd; + glPopMatrix; + + // draw rest of sentence + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(CurWordEndTx, 1); glVertex2f(LyricX+CurWordEnd, Y); + glTexCoord2f(CurWordEndTx, 1-realfontsize/64); glVertex2f(LyricX+CurWordEnd, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1-realfontsize/64); glVertex2f(LyricX2, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); + glEnd; + + + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{ SetFontPos(50, Y); + SetFontSize(9); + mybeat:=line^.words[line^.CurWord].text; + mybeat:=inttostr(trunc(Fonts[actfont].Tex.H)); + glPrint(addr(mybeat[1])); +} + end + else + begin + //Get Start Position: + { Start of Line - Width of all Icons + LineWidth/2 (Center} +// LyricX := X + {(W - ((IconSize + 1) * 6))/2 + ((IconSize + 1) * 3) +} (W/2); + LyricX:=X+W/2; + LyricX2 := LyricX + Line^.Width/2; + LyricX:=LyricX - Line^.Width/2; + + //Draw complete Sentence + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glBindTexture(GL_TEXTURE_2D, Line^.Tex); + + realfontsize:=30 * (Line^.Size/10)+16; + + glColorRGB(LineColor_dis); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 1-realfontsize/64); glVertex2f(LyricX, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1-realfontsize/64); glVertex2f(LyricX2, Y + realfontsize); + glTexCoord2f(Line^.Width/1024, 1); glVertex2f(LyricX2, Y); + glEnd; + + glDisable(GL_TEXTURE_2D); +{ glColor4f(0,0,0,0.1); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(LyricX, Y); + glTexCoord2f(0, 0); glVertex2f(LyricX, Y + line^.size*3.5); + glTexCoord2f(Line^.Width/512, 0); glVertex2f(LyricX2, Y + line^.size*3.5); + glTexCoord2f(Line^.Width/512, 1); glVertex2f(LyricX2, Y); + glEnd; +} + + glDisable(GL_BLEND); +// glDisable(GL_TEXTURE_2D); +{ SetFontPos(0, Y); + SetFontSize(9); + glColor4f(1,1,0,1); + mybeat:=inttostr(line^.size); + glPrint(addr(mybeat[1])); +{ mywidth:=gltextwidth(addr(mybeat[1])); + glEnable(GL_BLEND); + glColor4f(0,0,1,0.1); + glBegin(GL_QUADS); + glVertex2f(0,y); + glVertex2f(0,y+64); + glVertex2f(0+mywidth,y+64); + glVertex2f(0+mywidth,y); + glEnd; + glDisable(GL_BLEND); +} + + end; + + {//Search for active Word + For I := 0 to High(Line.Words) do + if (Line.Words[I].Start < Beat) then + begin + CurWord := I - 1; + end; + + if (CurWord < 0) then Exit; + + //Draw Part until cur Word + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_COLOR {GL_ONE_MINUS_SRC_COLOR}{, GL_ONE_MINUS_SRC_COLOR); + glBindTexture(GL_TEXTURE_2D, Line.Tex); + + glColorRGB(LineColor_en); + glBegin(GL_QUADS); + glTexCoord2f(0, 1); glVertex2f(X, Y); + glTexCoord2f(0, 0); glVertex2f(X, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 0); glVertex2f(X + W, Y + 64 * W / 512); + glTexCoord2f(Line.Words[CurWord].TexPos, 1); glVertex2f(X + W, Y); + glEnd; + + + glDisable(GL_BLEND); + glDisable(GL_TEXTURE_2D);} +end; + + +end. + diff --git a/Game/Code/Classes/ULyrics_bak.pas b/Game/Code/Classes/ULyrics_bak.pas new file mode 100644 index 00000000..703ee270 --- /dev/null +++ b/Game/Code/Classes/ULyrics_bak.pas @@ -0,0 +1,428 @@ +unit ULyrics_bak; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses SysUtils, + OpenGL12, + UMusic, + UTexture; + +type + TWord = record + X: real; + Y: real; + Size: real; + Width: real; + Text: string; + ColR: real; + ColG: real; + ColB: real; + Scale: real; + Done: real; + FontStyle: integer; + Italic: boolean; + Selected: boolean; + end; + + TLyric = class + private + AlignI: integer; + XR: real; + YR: real; + SizeR: real; + SelectedI: integer; + ScaleR: real; + StyleI: integer; // 0 - one selection, 1 - long selection, 2 - one selection with fade to normal text, 3 - long selection with fade with color from left + FontStyleI: integer; // font number + Word: array of TWord; + + //Textures for PlayerIcon Index: Playernum; Index2: Enabled/Disabled + PlayerIconTex: array[0..5] of array [0..1] of TTexture; + + 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 SetDone(Value: real); + procedure SetScale(Value: real); + procedure SetStyle(Value: integer); + procedure SetFStyle(Value: integer); + procedure Refresh; + + procedure DrawNormal(W: integer); + procedure DrawPlain(W: integer); + procedure DrawScaled(W: integer); + procedure DrawSlide(W: integer); + + procedure DrawPlayerIcons; + public + //Array containing Players Singing the Next Sentence + // 1: Player 1 Active + // 2: Player 2 Active + // 3: Player 3 Active + PlayersActive: Byte; + + //Dark or Light Colors + Enabled: Boolean; + + ColR: real; + ColG: real; + ColB: real; + ColSR: real; + ColSG: real; + ColSB: real; + Italic: boolean; + Text: string; // LCD + + constructor Create; + + procedure AddWord(Text: string); + procedure AddCzesc(NrCzesci: integer); + + function SelectedLetter: integer; // LCD + function SelectedLength: integer; // LCD + + 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 Done: real write SetDone; + property Scale: real write SetScale; + property Style: integer write SetStyle; + property FontStyle: integer write SetFStyle; + end; + +var + Lyric: TLyric; + +implementation +uses TextGL, UGraphic, UDrawTexture, Math, USkins; + +Constructor TLyric.Create; +var + I: Integer; +begin + //Only 2 Players for now + For I := 0 to 1 do + begin + PlayerIconTex[I][0] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + PlayerIconTex[I][1] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1))), 'PNG', 'Transparent', 0); + end; + PlayersActive := Trunc(Power(2, 1)) + 1; +end; + +procedure TLyric.SetX(Value: real); +begin + XR := Value; +end; + +procedure TLyric.SetY(Value: real); +begin + YR := Value; +end; + +function TLyric.GetClientX: real; +begin + Result := Word[0].X; +end; + +procedure TLyric.SetAlign(Value: integer); +begin + AlignI := Value; +// if AlignInt = 0 then beep; +end; + +function TLyric.GetSize: real; +begin + Result := SizeR; +end; + +procedure TLyric.SetSize(Value: real); +begin + SizeR := Value; +end; + +procedure TLyric.SetSelected(Value: integer); +var + W: integer; +begin + if (StyleI = 0) or (StyleI = 2) or (StyleI = 4) then 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; + Word[SelectedI].Done := 0; + 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; + Word[Value].Scale := ScaleR; + end; + end; + + if (StyleI = 1) or (StyleI = 3) then begin + if (SelectedI > -1) and (SelectedI <= High(Word)) then begin + for W := SelectedI to High(Word) do begin + Word[W].Selected := false; + Word[W].ColR := ColR; + Word[W].ColG := ColG; + Word[W].ColB := ColB; + Word[W].Done := 0; + end; + end; + + SelectedI := Value; + if (Value > -1) and (Value <= High(Word)) then begin + for W := 0 to Value do begin + Word[W].Selected := true; + Word[W].ColR := ColSR; + Word[W].ColG := ColSG; + Word[W].ColB := ColSB; + Word[W].Scale := ScaleR; + Word[W].Done := 1; + end; + end; + end; + + Refresh; +end; + +procedure TLyric.SetDone(Value: real); +var + W: integer; +begin + W := SelectedI; + if W > -1 then + Word[W].Done := Value; +end; + +procedure TLyric.SetScale(Value: real); +begin + ScaleR := Value; +end; + +procedure TLyric.SetStyle(Value: integer); +begin + StyleI := Value; +end; + +procedure TLyric.SetFStyle(Value: integer); +begin + FontStyleI := Value; +end; + +procedure TLyric.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; // new + 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].Scale := 1; + Word[WordNum].Done := 0; + Word[WordNum].Italic := Italic; + + Refresh; +end; + +procedure TLyric.AddCzesc(NrCzesci: integer); +var + N: integer; +begin + Clear; + for N := 0 to Czesci[0].Czesc[NrCzesci].HighNut do begin + Italic := Czesci[0].Czesc[NrCzesci].Nuta[N].FreeStyle; + AddWord(Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst); + Text := Text + Czesci[0].Czesc[NrCzesci].Nuta[N].Tekst; + end; + Selected := -1; +end; + +procedure TLyric.Clear; +begin +{ ColR := Skin_FontR; + ColG := Skin_FontG; + ColB := Skin_FontB;} + SetLength(Word, 0); + Text := ''; + SelectedI := -1; +end; + +procedure TLyric.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 TLyric.DrawPlayerIcons; +begin + +end; + +procedure TLyric.Draw; +var + W: integer; +begin + case StyleI of + 0: + begin + for W := 0 to High(Word) do + DrawNormal(W); + end; + 1: + begin + for W := 0 to High(Word) do + DrawPlain(W); + end; + 2: // zoom + begin + for W := 0 to High(Word) do + if not Word[W].Selected then + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then + DrawScaled(W); + end; + 3: // slide + begin + for W := 0 to High(Word) do begin + if not Word[W].Selected then + DrawNormal(W) + else + DrawSlide(W); + end; + end; + 4: // ball + begin + for W := 0 to High(Word) do + DrawNormal(W); + + for W := 0 to High(Word) do + if Word[W].Selected then begin + Tex_Ball.X := (Word[W].X - 10) + Word[W].Done * Word[W].Width; + Tex_Ball.Y := 480 - 10*sin(Word[W].Done * pi); + Tex_Ball.W := 20; + Tex_Ball.H := 20; + DrawTexture(Tex_Ball); + end; + end; + end; // case +end; + +procedure TLyric.DrawNormal(W: integer); +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; + +procedure TLyric.DrawPlain(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + + if D = 0 then + glColor3f(ColR, ColG, ColB) + else + glColor3f(ColSR, ColSG, ColSB); + + glPrint(pchar(Word[W].Text)); +end; + +procedure TLyric.DrawScaled(W: integer); +var + D: real; +begin + // previous plus dynamic scaling effect + D := 1-Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X - D * Word[W].Width * (Word[W].Scale - 1) / 2 + (D+1)*10*ScreenX, Word[W].Y - D * 1.5 * Word[W].Size *(Word[W].Scale - 1)); + SetFontSize(Word[W].Size + D * (Word[W].Size * Word[W].Scale - Word[W].Size)); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrint(pchar(Word[W].Text)) +end; + +procedure TLyric.DrawSlide(W: integer); +var + D: real; +begin + D := Word[W].Done; // przyrost + SetFontStyle(Word[W].FontStyle); + SetFontPos(Word[W].X, Word[W].Y); + SetFontSize(Word[W].Size); + SetFontItalic(Word[W].Italic); + glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB); + glPrintDone(pchar(Word[W].Text), D, ColR, ColG, ColB); +end; + +function TLyric.SelectedLetter; // LCD +var + W: integer; +begin + Result := 1; + + for W := 0 to SelectedI-1 do + Result := Result + Length(Word[W].Text); +end; + +function TLyric.SelectedLength: integer; // LCD +begin + Result := Length(Word[SelectedI].Text); +end; + +end. diff --git a/Game/Code/Classes/UMain.pas b/Game/Code/Classes/UMain.pas new file mode 100644 index 00000000..bbd4a5ee --- /dev/null +++ b/Game/Code/Classes/UMain.pas @@ -0,0 +1,1059 @@ +unit UMain;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ UGraphic,
+ UMusic,
+ URecord,
+ UTime,
+ SysUtils,
+ UDisplay,
+ UIni,
+ ULog,
+ ULyrics,
+ UScreenSing,
+ USong,
+ OpenGL12,
+ {$IFDEF UseSerialPort}
+ zlportio {you can disable it and all PortWriteB calls},
+ {$ENDIF}
+ ULCD,
+ ULight,
+ UThemes;
+
+type
+ TPlayer = record
+ Name: string;
+
+ //Index in Teaminfo record
+ TeamID: Byte;
+ PlayerID: Byte;
+
+ //Scores
+ Score: real;
+ ScoreLine: real;
+ ScoreGolden: real;
+
+ ScoreI: integer;
+ ScoreLineI: integer;
+ ScoreGoldenI: integer;
+ ScoreTotalI: integer;
+
+
+
+ //LineBonus Mod
+ ScoreLast: Real;//Last Line Score
+
+ //PerfectLineTwinkle Mod (effect)
+ LastSentencePerfect: Boolean;
+ //PerfectLineTwinkle Mod end
+
+
+// Meter: real;
+
+ HighNut: integer;
+ IlNut: integer;
+ Nuta: array of record
+ Start: integer;
+ Dlugosc: integer;
+ Detekt: real; // dokladne miejsce, w ktorym wykryto ta nute
+ Ton: real;
+ Perfect: boolean; // true if the note matches the original one, lit the star
+
+
+
+ // Half size Notes Patch
+ Hit: boolean; // true if the note Hits the Line
+ //end Half size Notes Patch
+
+
+
+ end;
+ end;
+
+
+var
+ //Absolute Paths
+ GamePath: string;
+ SoundPath: string;
+ SongPath: string;
+ LogPath: string;
+ ThemePath: string;
+ SkinsPath: string;
+ ScreenshotsPath: string;
+ CoversPath: string;
+ LanguagesPath: string;
+ PluginPath: string;
+ VisualsPath: string;
+ PlayListPath: string;
+
+ UserSongPath: string = '';
+ UserCoversPath: string = '';
+ UserPlaylistPath: string = '';
+
+ OGL: Boolean;
+ Done: Boolean;
+ Event: TSDL_event;
+ FileName: string;
+ Restart: boolean;
+
+ // gracz i jego nuty
+ Player: array of TPlayer;
+ PlayersPlay: integer;
+
+ CurrentSong : TSong;
+
+procedure InitializePaths;
+
+Procedure Main;
+procedure MainLoop;
+procedure CheckEvents;
+procedure Sing(Sender: TScreenSing);
+procedure NewSentence(Sender: TScreenSing);
+procedure NewBeat(Sender: TScreenSing); // executed when on then new beat
+procedure NewBeatC(Sender: TScreenSing); // executed when on then new beat for click
+procedure NewBeatD(Sender: TScreenSing); // executed when on then new beat for detection
+//procedure NewHalf; // executed when in the half between beats
+procedure NewNote(Sender: TScreenSing); // detect note
+function GetMidBeat(Time: real): real;
+function GetTimeFromBeat(Beat: integer): real;
+procedure ClearScores(PlayerNum: integer);
+
+implementation
+
+uses USongs,
+ UJoystick,
+ math,
+ UCommandLine, ULanguage, SDL_ttf,
+ USkins, UCovers, UCatCovers, UDataBase, UPlaylist, UDLLManager,
+ UParty, UCore, UGraphicClasses, UPluginDefs, UPlatform;
+
+const
+ Version = 'UltraStar Deluxe V 1.10 Alpha Build';
+
+Procedure Main;
+var
+ WndTitle: string;
+begin
+ try
+
+ WndTitle := Version;
+
+ if Platform.TerminateIfAlreadyRunning( {var} WndTitle) then
+ Exit;
+
+ //------------------------------
+ //StartUp - Create Classes and Load Files
+ //------------------------------
+ USTime := TTime.Create;
+
+ // Commandline Parameter Parser
+ Params := TCMDParams.Create;
+
+ // Log + Benchmark
+ Log := TLog.Create;
+ Log.Title := WndTitle;
+ Log.Enabled := 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', Version);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Language', 1);
+
+ // SDL
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize SDL', 'Initialization');
+ SDL_Init(SDL_INIT_VIDEO);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing SDL', 1);
+
+ // SDL_ttf
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize SDL_ttf', 'Initialization');
+ TTF_Init(); //ttf_quit();
+ 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);
+
+ // Sound
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Sound', 'Initialization');
+ InitializeSound();
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Sound', 1);
+
+ // Ini + Paths (depends on Sound)
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Ini', 'Initialization');
+ Ini := TIni.Create;
+ Ini.Load;
+
+ //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);
+
+
+ // LCD
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load LCD', 'Initialization');
+ LCD := TLCD.Create;
+ if Ini.LPT = 1 then begin
+ // LCD.HalfInterface := true;
+ LCD.Enable;
+ LCD.Clear;
+ LCD.WriteText(1, ' UltraStar ');
+ LCD.WriteText(2, ' Loading... ');
+ end;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading LCD', 1);
+
+ // Light
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Light', 'Initialization');
+ Light := TLight.Create;
+ if Ini.LPT = 2 then begin
+ Light.Enable;
+ end;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Light', 1);
+
+
+
+ // 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 := TCovers.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 ('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 Particel 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.LogError('Creating Core');
+ Core := TCore.Create('Ultrastar Deluxe Beta', MakeVersion(1,1,0, chr(0)));
+
+ Log.LogError('Running Core');
+ Core.Run;
+
+ //------------------------------
+ //Start- Mainloop
+ //------------------------------
+ //Music.SetLoop(true);
+ //Music.SetVolume(50);
+ //Music.Open(SkinPath + 'Menu Music 3.mp3');
+ //Music.Play;
+ Log.LogStatus('Main Loop', 'Initialization');
+ MainLoop;
+
+ finally
+ //------------------------------
+ //Finish Application
+ //------------------------------
+
+ {$ifdef WIN32}
+ if Ini.LPT = 1 then LCD.Clear;
+ if Ini.LPT = 2 then Light.TurnOff;
+ {$endif}
+
+ Log.LogStatus('Main Loop', 'Finished');
+ Log.Free;
+ end;
+end;
+
+procedure MainLoop;
+var
+ Delay: integer;
+begin
+ try
+ 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;
+
+ // light
+ Light.Refresh;
+
+ // delay
+ CountMidTime;
+
+ Delay := Floor(1000 / 100 - 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;
+
+ finally
+ UnloadOpenGL;
+ end;
+End;
+
+Procedure CheckEvents;
+//var
+// p: pointer;
+Begin
+ if not Assigned(Display.NextScreen) then
+ While SDL_PollEvent( @event ) = 1 Do
+ Begin
+// beep;
+ 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; // With}
+ 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;
+
+ //ScreenShot hack. If Print is pressed-> Make screenshot and Save to Screenshots Path
+ if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then
+ Display.ScreenShot
+
+ // popup hack... 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 (ScreenPopupCheck <> NIL) AND (ScreenPopupCheck.Visible) then
+ done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)
+ // end of popup hack
+
+ else
+ begin
+ // check for Screen want to Exit
+ done := Not Display.ActualScreen^.ParseInput(Event.key.keysym.sym, 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.ActualScreen^.CheckFadeTo(NIL,'MSG_QUIT_USDX');
+ end
+ else //When asking for exit is disabled then simply exit
+ begin
+ Display.Fade := 0;
+ Display.NextScreenWithCheck := nil;
+ Display.CheckOK := True;
+ end;
+ end;
+
+ end; // if (Not Display.ActualScreen^.ParseInput(Event.key.keysym.scancode, True)) then
+ end;
+// SDL_JOYAXISMOTION:
+// begin
+// beep
+// end;
+ SDL_JOYBUTTONDOWN:
+ begin
+ beep
+ end;
+ End; // Case Event.type_
+ End; // While
+End; // CheckEvents
+
+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;
+// TopBeat: real;
+// TempBeat: real;
+// TempTime: real;
+begin
+ Result := 0;
+ if Length(CurrentSong.BPM) = 1 then Result := Time * CurrentSong.BPM[0].BPM / 60;
+
+ (* 2 BPMs *)
+{ if Length(CurrentSong.BPM) > 1 then begin
+ (* new system *)
+ CurBeat := 0;
+ TopBeat := GetBeats(CurrentSong.BPM[0].BPM, Time);
+ if TopBeat > CurrentSong.BPM[1].StartBeat then begin
+ // analyze second BPM
+ Time := Time - GetTimeForBeats(CurrentSong.BPM[0].BPM, CurrentSong.BPM[1].StartBeat - CurBeat);
+ CurBeat := CurrentSong.BPM[1].StartBeat;
+ TopBeat := GetBeats(CurrentSong.BPM[1].BPM, Time);
+ Result := CurBeat + TopBeat;
+
+ end else begin
+ (* pierwszy przedzial *)
+ Result := TopBeat;
+ end;
+ end; // if}
+
+ (* more BPMs *)
+ 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; // if
+end;
+
+function GetTimeFromBeat(Beat: integer): real;
+var
+ CurBPM: integer;
+begin
+ Result := 0;
+ if Length(CurrentSong.BPM) = 1 then Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
+
+ (* more BPMs *)
+ 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; // if}
+end;
+
+procedure Sing(Sender: TScreenSing);
+var
+ Pet: integer;
+ PetGr: integer;
+ CP: integer;
+ Done: real;
+ N: integer;
+begin
+ Czas.Teraz := Czas.Teraz + TimeSkip;
+
+ Czas.OldBeat := Czas.AktBeat;
+ Czas.MidBeat := GetMidBeat(Czas.Teraz - (CurrentSong.Gap{ + 90 I've forgotten for what it is}) / 1000); // new system with variable BPM in function
+ Czas.AktBeat := Floor(Czas.MidBeat);
+
+// Czas.OldHalf := Czas.AktHalf;
+// Czas.MidHalf := Czas.MidBeat + 0.5;
+// Czas.AktHalf := Floor(Czas.MidHalf);
+
+ Czas.OldBeatC := Czas.AktBeatC;
+ Czas.MidBeatC := GetMidBeat(Czas.Teraz - (CurrentSong.Gap) / 1000);
+ Czas.AktBeatC := Floor(Czas.MidBeatC);
+
+ Czas.OldBeatD := Czas.AktBeatD;
+ Czas.MidBeatD := -0.5+GetMidBeat(Czas.Teraz - (CurrentSong.Gap + 120 + 20) / 1000); // MidBeat with addition GAP
+ Czas.AktBeatD := Floor(Czas.MidBeatD);
+ Czas.FracBeatD := Frac(Czas.MidBeatD);
+
+ // sentences routines
+ for PetGr := 0 to 0 do begin;//High(Gracz) do begin
+ CP := PetGr;
+ // ustawianie starej czesci
+ Czas.OldCzesc := Czesci[CP].Akt;
+
+ // wybieranie aktualnej czesci
+ for Pet := 0 to Czesci[CP].High do
+ if Czas.AktBeat >= Czesci[CP].Czesc[Pet].Start then Czesci[CP].Akt := Pet;
+
+ // czysczenie nut gracza, gdy to jest nowa plansza
+ // (optymizacja raz na halfbeat jest zla)
+ if Czesci[CP].Akt <> Czas.OldCzesc then NewSentence(Sender);
+
+ end; // for PetGr
+
+ // wykonuje operacje raz na beat
+ if (Czas.AktBeat >= 0) and (Czas.OldBeat <> Czas.AktBeat) then
+ NewBeat(Sender);
+
+ // make some operations on clicks
+ if {(Czas.AktBeatC >= 0) and }(Czas.OldBeatC <> Czas.AktBeatC) then
+ NewBeatC(Sender);
+
+ // make some operations when detecting new voice pitch
+ if (Czas.AktBeatD >= 0) and (Czas.OldBeatD <> Czas.AktBeatD) then
+ NewBeatD(Sender);
+
+ // wykonuje operacje w polowie beatu
+// if (Czas.AktHalf >= 1) and (Czas.OldHalf <> Czas.AktHalf) then
+// NewHalf;
+
+ // plynnie przesuwa text
+ Done := 1;
+ for N := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do
+ if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start <= Czas.MidBeat)
+ and (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc >= Czas.MidBeat) then
+ Done := (Czas.MidBeat - Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start) / (Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc);
+
+ N := Czesci[0].Czesc[Czesci[0].Akt].HighNut;
+
+ // wylacza ostatnia nute po przejsciu
+ {// todo: Lyrics
+ if (Ini.LyricsEffect = 1) and (Done = 1) and
+ (Czas.MidBeat > Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Start + Czesci[0].Czesc[Czesci[0].Akt].Nuta[N].Dlugosc)
+ then Sender.LyricMain.Selected := -1;
+
+ if Done > 1 then Done := 1;
+ Sender.LyricMain.Done := Done; }
+
+ // use Done with LCD
+{ with ScreenSing do begin
+ if LyricMain.Selected >= 0 then begin
+ LCD.MoveCursor(1, LyricMain.SelectedLetter + Round((LyricMain.SelectedLength-1) * Done));
+ LCD.ShowCursor;
+ end;
+ end;}
+
+
+end;
+
+procedure NewSentence(Sender: TScreenSing);
+var
+G: Integer;
+begin
+ // czyszczenie nut graczy
+ for G := 0 to High(Player) do begin
+ Player[G].IlNut := 0;
+ Player[G].HighNut := -1;
+ SetLength(Player[G].Nuta, 0);
+ end;
+
+ // Add Words to Lyrics
+ with Sender do begin
+ {LyricMain.AddCzesc(Czesci[0].Akt);
+ if Czesci[0].Akt < Czesci[0].High then
+ LyricSub.AddCzesc(Czesci[0].Akt+1)
+ else
+ LyricSub.Clear;}
+ while (not Lyrics.LineinQueue) AND (Lyrics.LineCounter <= High(Czesci[0].Czesc)) do
+ Lyrics.AddLine(@Czesci[0].Czesc[Lyrics.LineCounter]);
+ end;
+
+ Sender.UpdateLCD;
+
+ //On Sentence Change...
+ Sender.onSentenceChange(Czesci[0].Akt);
+end;
+
+procedure NewBeat(Sender: TScreenSing);
+var
+ Pet: integer;
+// TempBeat: integer;
+begin
+ // ustawia zaznaczenie tekstu
+// SingScreen.LyricMain.Selected := -1;
+ for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do
+ if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeat) then begin
+ // operates on currently beated note
+ //Todo: Lyrics
+ //Sender.LyricMain.Selected := Pet;
+
+// LCD.MoveCursor(1, ScreenSing.LyricMain.SelectedLetter);
+// LCD.ShowCursor;
+
+ //LCD.MoveCursorBR(Sender.LyricMain.SelectedLetter);
+ LCD.ShowCursor;
+
+ end;
+end;
+
+procedure NewBeatC;
+var
+ Pet: integer;
+// LPT_1: integer;
+// LPT_2: integer;
+begin
+// LPT_1 := 1;
+// LPT_2 := 1;
+
+ // beat click
+ if (Ini.BeatClick = 1) and ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then
+ AudioPlayback.PlaySound(SoundLib.Click);
+
+ // debug system on LPT
+ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod Czesci[0].Resolution = 0) then begin
+ //LPT_1 := 0;
+// Light.LightOne(0, 150);
+
+ Light.LightOne(1, 200); // beat light
+ if ParamStr(1) = '-doublelights' then
+ Light.LightOne(0, 200); // beat light
+
+
+{ if ((Czas.AktBeatC + Czesci[0].Resolution + Czesci[0].NotesGAP) mod (Czesci[0].Resolution * 2) = 0) then
+ Light.LightOne(0, 150)
+ else
+ Light.LightOne(1, 150)}
+ end;
+
+ for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do
+ if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = Czas.AktBeatC) then begin
+ // click assist
+ if Ini.ClickAssist = 1 then
+ AudioPlayback.PlaySound(SoundLib.Click);
+
+ //LPT_2 := 0;
+ if ParamStr(1) <> '-doublelights' then
+ Light.LightOne(0, 150); //125
+
+
+ // drum machine
+(* TempBeat := Czas.AktBeat;// + 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;
+
+ {$IFDEF UseSerialPort}
+ // PortWriteB($378, LPT_1 + LPT_2 * 2); // 0 zapala
+ {$ENDIF}
+end;
+
+procedure NewBeatD(Sender: TScreenSing);
+begin
+ NewNote(Sender);
+end;
+
+//procedure NewHalf;
+//begin
+// NewNote;
+//end;
+
+procedure NewNote(Sender: TScreenSing);
+var
+ CP: integer; // current player
+ S: integer; // sentence
+ SMin: integer;
+ SMax: integer;
+ SDet: integer; // temporary: sentence of detected note
+ Pet: integer;
+ Mozna: boolean;
+ Nowa: boolean;
+ Range: integer;
+ NoteHit:boolean;
+begin
+// Log.LogStatus('Beat ' + IntToStr(Czas.AktBeat) + ' HalfBeat ' + IntToStr(Czas.AktHalf), 'NewBeat');
+// beep;
+
+ // On linux we get an AV @ NEWNOTE, line 600 of Classes/UMain.pas
+ if not assigned( AudioInputProcessor.Sound ) then // TODO : JB_Linux ... why is this now not assigned... it was fine a few hours ago..
+ exit;
+
+ // analizuje dla obu graczy ten sam sygnal (Sound.OneSrcForBoth)
+ // albo juz lepiej nie
+ for CP := 0 to PlayersPlay-1 do
+ begin
+
+ // analyze buffer
+ AudioInputProcessor.Sound[CP].AnalyzeBuffer;
+
+ // adds some noise
+// Czas.Ton := Czas.Ton + Round(Random(3)) - 1;
+
+ // 0.5.0: count min and max sentence range for checking (detection is delayed to the notes we see on the screen)
+ SMin := Czesci[0].Akt-1;
+ if SMin < 0 then SMin := 0;
+ SMax := Czesci[0].Akt;
+
+ // check if we can add new note
+ Mozna := false;
+ SDet:=SMin;
+ for S := SMin to SMax do
+ for Pet := 0 to Czesci[0].Czesc[S].HighNut do
+ if ((Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.AktBeatD)
+ and (Czesci[0].Czesc[S].Nuta[Pet].Start + Czesci[0].Czesc[S].Nuta[Pet].Dlugosc - 1 >= Czas.AktBeatD))
+ and (not Czesci[0].Czesc[S].Nuta[Pet].FreeStyle) // but don't allow when it's FreeStyle note
+ and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > 0) // and make sure the note lenghts is at least 1
+ then begin
+ SDet := S;
+ Mozna := true;
+ Break;
+ end;
+
+ S := SDet;
+
+
+
+
+
+// Czas.SzczytJest := true;
+// Czas.Ton := 27;
+
+ // gdy moze, to dodaje nute
+ if (AudioInputProcessor.Sound[CP].ToneValid) and (Mozna) then begin
+ // operowanie na ostatniej nucie
+ for Pet := 0 to Czesci[0].Czesc[S].HighNut do
+ if (Czesci[0].Czesc[S].Nuta[Pet].Start <= Czas.OldBeatD+1)
+ and (Czesci[0].Czesc[S].Nuta[Pet].Start +
+ Czesci[0].Czesc[S].Nuta[Pet].Dlugosc > Czas.OldBeatD+1) then begin
+ // to robi, tylko dla pary nut (oryginalnej i gracza)
+
+ // przesuwanie tonu w odpowiednia game
+ while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton > 6) do
+ AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].Tone - 12;
+
+ while (AudioInputProcessor.Sound[CP].Tone - Czesci[0].Czesc[S].Nuta[Pet].Ton < -6) do
+ AudioInputProcessor.Sound[CP].Tone := AudioInputProcessor.Sound[CP].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;
+
+ if abs(Czesci[0].Czesc[S].Nuta[Pet].Ton - AudioInputProcessor.Sound[CP].Tone) <= Range then begin
+ AudioInputProcessor.Sound[CP].Tone := Czesci[0].Czesc[S].Nuta[Pet].Ton;
+
+
+ // Half size Notes Patch
+ NoteHit := true;
+
+
+ if (Ini.LineBonus = 0) then
+ begin
+ // add points without LineBonus
+ case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of
+ 1: Player[CP].Score := Player[CP].Score + 10000 / Czesci[0].Wartosc *
+ Czesci[0].Czesc[S].Nuta[Pet].Wartosc;
+ 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 10000 / Czesci[0].Wartosc *
+ Czesci[0].Czesc[S].Nuta[Pet].Wartosc;
+ end;
+ end
+ else
+ begin
+ // add points with Line Bonus
+ case Czesci[0].Czesc[S].Nuta[Pet].Wartosc of
+ 1: Player[CP].Score := Player[CP].Score + 9000 / Czesci[0].Wartosc *
+ Czesci[0].Czesc[S].Nuta[Pet].Wartosc;
+ 2: Player[CP].ScoreGolden := Player[CP].ScoreGolden + 9000 / Czesci[0].Wartosc *
+ Czesci[0].Czesc[S].Nuta[Pet].Wartosc;
+ end;
+ end;
+
+ Player[CP].ScoreI := Floor(Player[CP].Score / 10) * 10;
+ Player[CP].ScoreGoldenI := Floor(Player[CP].ScoreGolden / 10) * 10;
+
+ Player[CP].ScoreTotalI := Player[CP].ScoreI + Player[CP].ScoreGoldenI + Player[CP].ScoreLineI;
+ end;
+
+ end; // operowanie
+
+ // sprawdzanie czy to nowa nuta, czy przedluzenie
+ if S = SMax then begin
+ Nowa := true;
+ // jezeli ostatnia ma ten sam ton
+ if (Player[CP].IlNut > 0 )
+ and (Player[CP].Nuta[Player[CP].HighNut].Ton = AudioInputProcessor.Sound[CP].Tone)
+ and (Player[CP].Nuta[Player[CP].HighNut].Start + Player[CP].Nuta[Player[CP].HighNut].Dlugosc = Czas.AktBeatD)
+ then Nowa := false;
+ // jezeli jest jakas nowa nuta na sprawdzanym beacie
+ for Pet := 0 to Czesci[0].Czesc[S].HighNut do
+ if (Czesci[0].Czesc[S].Nuta[Pet].Start = Czas.AktBeatD) then
+ Nowa := true;
+
+ // dodawanie nowej nuty
+ if Nowa then begin
+ // nowa nuta
+ Player[CP].IlNut := Player[CP].IlNut + 1;
+ Player[CP].HighNut := Player[CP].HighNut + 1;
+ SetLength(Player[CP].Nuta, Player[CP].IlNut);
+ Player[CP].Nuta[Player[CP].HighNut].Start := Czas.AktBeatD;
+ Player[CP].Nuta[Player[CP].HighNut].Dlugosc := 1;
+ Player[CP].Nuta[Player[CP].HighNut].Ton := AudioInputProcessor.Sound[CP].Tone; // Ton || TonDokl
+ Player[CP].Nuta[Player[CP].HighNut].Detekt := Czas.MidBeat;
+
+
+ // Half Note Patch
+ Player[CP].Nuta[Player[CP].HighNut].Hit := NoteHit;
+
+
+ // Log.LogStatus('Nowa Nuta ' + IntToStr(Gracz.Nuta[Gracz.HighNut].Start), 'NewBeat');
+
+ end else begin
+ // przedluzenie nuty
+ Player[CP].Nuta[Player[CP].HighNut].Dlugosc := Player[CP].Nuta[Player[CP].HighNut].Dlugosc + 1;
+ end;
+
+
+ // check for perfect note and then lit the star (on Draw)
+ for Pet := 0 to Czesci[0].Czesc[S].HighNut do
+ if (Czesci[0].Czesc[S].Nuta[Pet].Start = Player[CP].Nuta[Player[CP].HighNut].Start)
+ and (Czesci[0].Czesc[S].Nuta[Pet].Dlugosc = Player[CP].Nuta[Player[CP].HighNut].Dlugosc)
+ and (Czesci[0].Czesc[S].Nuta[Pet].Ton = Player[CP].Nuta[Player[CP].HighNut].Ton) then begin
+ Player[CP].Nuta[Player[CP].HighNut].Perfect := true;
+ end;
+
+ end;// else beep; // if S = SMax
+
+ end; // if moze
+ end; // for CP
+// Log.LogStatus('EndBeat', 'NewBeat');
+
+//On Sentence End -> For LineBonus + SingBar
+if (sDet >= low(Czesci[0].Czesc)) AND (sDet <= high(Czesci[0].Czesc)) then
+if assigned( Sender ) AND
+ ((Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Start + Czesci[0].Czesc[SDet].Nuta[Czesci[0].Czesc[SDet].HighNut].Dlugosc - 1) = Czas.AktBeatD) then
+ Sender.onSentenceEnd(sDet);
+
+end;
+
+procedure ClearScores(PlayerNum: integer);
+begin
+ Player[PlayerNum].Score := 0;
+ Player[PlayerNum].ScoreI := 0;
+ Player[PlayerNum].ScoreLine := 0;
+ Player[PlayerNum].ScoreLineI := 0;
+ Player[PlayerNum].ScoreGolden := 0;
+ Player[PlayerNum].ScoreGoldenI := 0;
+ Player[PlayerNum].ScoreTotalI := 0;
+end;
+
+
+//--------------------
+// Function sets all Absolute Paths e.g. Song Path and makes sure the Directorys exist
+//--------------------
+procedure InitializePaths;
+
+ // Initialize a Path Variable
+ // After Setting Paths, make sure that Paths exist
+ function initialize_path( out aPathVar : String; const aLocation : String ): boolean;
+ var
+ lWriteable: Boolean;
+ lAttrib : integer;
+ begin
+ lWriteable := false;
+ aPathVar := aLocation;
+
+ // Make sure the directory is needex
+ ForceDirectories(aPathVar);
+
+ If DirectoryExists(aPathVar) then
+ begin
+ lAttrib := fileGetAttr(aPathVar);
+
+ lWriteable := ( lAttrib and faDirectory <> 0 ) AND
+ NOT ( lAttrib and faReadOnly <> 0 )
+ end;
+
+ if not lWriteable then
+ Log.LogError('Error: Dir ('+ aLocation +') is Readonly');
+
+ result := lWriteable;
+ end;
+
+begin
+
+ initialize_path( LogPath , Platform.GetLogPath );
+ initialize_path( SoundPath , Platform.GetGameSharedPath + 'Sounds' + PathDelim );
+ initialize_path( ThemePath , Platform.GetGameSharedPath + 'Themes' + PathDelim );
+ initialize_path( SkinsPath , Platform.GetGameSharedPath + 'Skins' + PathDelim );
+ initialize_path( LanguagesPath , Platform.GetGameSharedPath + 'Languages' + PathDelim );
+ initialize_path( PluginPath , Platform.GetGameSharedPath + 'Plugins' + PathDelim );
+ initialize_path( VisualsPath , Platform.GetGameSharedPath + 'Visuals' + PathDelim );
+
+ initialize_path( ScreenshotsPath , Platform.GetGameUserPath + 'Screenshots' + PathDelim );
+
+ // Users Song Path ....
+ initialize_path( UserSongPath , Platform.GetGameUserPath + 'Songs' + PathDelim );
+ initialize_path( UserCoversPath , Platform.GetGameUserPath + 'Covers' + PathDelim );
+ initialize_path( UserPlaylistPath , Platform.GetGameUserPath + 'Playlists' + PathDelim );
+
+ // Shared Song Path ....
+ initialize_path( SongPath , Platform.GetGameSharedPath + 'Songs' + PathDelim );
+ initialize_path( CoversPath , Platform.GetGameSharedPath + 'Covers' + PathDelim );
+ initialize_path( PlaylistPath , Platform.GetGameSharedPath + 'Playlists' + PathDelim );
+
+ DecimalSeparator := ',';
+end;
+
+end.
+
diff --git a/Game/Code/Classes/UMedia_dummy.pas b/Game/Code/Classes/UMedia_dummy.pas new file mode 100644 index 00000000..cd62dc51 --- /dev/null +++ b/Game/Code/Classes/UMedia_dummy.pas @@ -0,0 +1,206 @@ +unit UMedia_dummy;
+{< #############################################################################
+# FFmpeg support for UltraStar deluxe #
+# #
+# Created by b1indy #
+# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
+# #
+# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
+# http://www.nabble.com/file/p11795857/mpegpas01.zip #
+# #
+############################################################################## }
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+implementation
+
+uses
+ SysUtils,
+ math,
+ UMusic;
+
+
+var
+ singleton_dummy : IVideoPlayback;
+
+type
+ Tmedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput )
+ private
+ public
+ constructor create();
+ function GetName: String;
+
+ procedure init();
+
+ function Open( 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);
+
+ // IAudioInput
+ function InitializeRecord: boolean;
+ procedure CaptureStart;
+ procedure CaptureStop;
+ procedure GetFFTData(var data: TFFTData);
+ function GetPCMData(var data: TPCMData): Cardinal;
+
+ // IAudioPlayback
+ function InitializePlayback: boolean;
+ procedure SetVolume(Volume: integer);
+ procedure SetMusicVolume(Volume: integer);
+ procedure SetLoop(Enabled: boolean);
+ procedure Rewind;
+
+ function Finished: boolean;
+ function Length: real;
+
+ function OpenSound(const Filename: String): TAudioPlaybackStream;
+ procedure PlaySound(stream: TAudioPlaybackStream);
+ procedure StopSound(stream: TAudioPlaybackStream);
+ 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
+end;
+
+procedure Tmedia_dummy.init();
+begin
+end;
+
+
+function Tmedia_dummy.Open( 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;
+
+// IAudioInput
+function Tmedia_dummy.InitializeRecord: 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
+ result := true;
+end;
+
+procedure Tmedia_dummy.SetVolume(Volume: integer);
+begin
+end;
+
+procedure Tmedia_dummy.SetMusicVolume(Volume: integer);
+begin
+end;
+
+procedure Tmedia_dummy.SetLoop(Enabled: boolean);
+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.PlaySound(stream: TAudioPlaybackStream);
+begin
+end;
+
+procedure Tmedia_dummy.StopSound(stream: TAudioPlaybackStream);
+begin
+end;
+
+initialization
+ singleton_dummy := Tmedia_dummy.create();
+ AudioManager.add( singleton_dummy );
+
+finalization
+ AudioManager.Remove( singleton_dummy );
+
+end.
diff --git a/Game/Code/Classes/UModules.pas b/Game/Code/Classes/UModules.pas new file mode 100644 index 00000000..fe623343 --- /dev/null +++ b/Game/Code/Classes/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/Game/Code/Classes/UMusic.pas b/Game/Code/Classes/UMusic.pas new file mode 100644 index 00000000..8bbd297a --- /dev/null +++ b/Game/Code/Classes/UMusic.pas @@ -0,0 +1,515 @@ +unit UMusic;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes;
+
+type
+ TNoteType = (ntFreestyle, ntNormal, ntGolden);
+
+ //http://paste.ubuntu-nl.org/51892/
+
+ TMuzyka = record // (TODO: rename to TMusic/TMelody?)
+ Path: string;
+ Start: integer; // start of song in ms
+ IlNut: integer; // (TODO: Il = tone, Nut(a) = Note)
+ DlugoscNut: integer; // (TODO: Dlugosc = length, Nut(a) = Note)
+ end;
+
+ PLine = ^TLine;
+ TLine = record // (TODO: rename to TSentence?)
+ Start: integer;
+ StartNote: integer;
+ Lyric: string;
+ LyricWidth: real;
+ Koniec: integer; // (TODO: rename to End_/Ending?)
+ BaseNote: integer;
+ HighNut: integer; // (TODO: rename to HighNote)
+ IlNut: integer; // (TODO: Il = tone, Nut(a) = Note)
+ TotalNotes: integer;
+ Nuta: array of record // (TODO: rename to Note)
+ Color: integer;
+ Start: integer;
+ Dlugosc: integer; // (TODO: rename to Length)
+ Ton: integer; // full range tone (TODO: rename to Tone)
+ TonGamy: integer; // tone unified to one octave (TODO: rename to something meaningful, ToneGamus)
+ Tekst: string; // (TODO: rename to Text)
+ FreeStyle: boolean;
+ Wartosc: integer; // normal-note: 1, golden-note: 2 (TODO: wartosc=value, rename to Type_ or Kind?)
+ end;
+ end;
+ ALine = array of TLine; // (TODO: rename to TLineArray)
+
+ // (TCzesci = TSentences)
+ TCzesci = record
+ Akt: integer; // for drawing of current line (Akt = Current)
+ High: integer;
+ Ilosc: integer; // (TODO: Ilosc = Number/Count)
+ Resolution: integer;
+ NotesGAP: integer;
+ Wartosc: integer; // TODO: rename (wartosc=value)
+ Czesc: ALine; // TODO: rename to Sentence or Line
+ end;
+
+ // (TODO: rename TCzas to something like T(Line/Sentence)Time/TLinePosition/TLineState)
+ // (Czas = time)
+ TCzas = record // all that concerns the current frames
+ OldBeat: integer; // previous discovered beat
+ AktBeat: integer; // current beat (TODO: rename)
+ MidBeat: real; // like AktBeat
+
+ // now we use this for super synchronization!
+ // only used when analyzing voice
+ OldBeatD: integer; // previous discovered beat
+ AktBeatD: integer; // current beat (TODO: rename)
+ MidBeatD: real; // like AktBeatD
+ FracBeatD: real; // fractional part of MidBeatD
+
+ // we use this for audible clicks
+ OldBeatC: integer; // previous discovered beat
+ AktBeatC: integer; // current beat (TODO: rename)
+ MidBeatC: real; // like AktBeatC
+ FracBeatC: real; // fractional part of MidBeatC
+
+
+ OldCzesc: integer; // previous displayed sentence (Czesc = part (here: sentence/line))
+
+ Teraz: real; // (TODO: Teraz = current time)
+ Razem: real; // (TODO: Razem = total time)
+ end;
+
+
+type
+ TFFTData = array[0..255] of Single;
+
+ TPCMStereoSample = array[0..1] of Smallint;
+ TPCMData = array[0..511] of TPCMStereoSample;
+
+type
+ TStreamStatus = (ssStopped, ssPlaying, ssPaused, ssBlocked, ssUnknown);
+const
+ StreamStatusStr: array[TStreamStatus] of string =
+ ('Stopped', 'Playing', 'Paused', 'Blocked', 'Unknown');
+
+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
+ );
+
+ TAudioFormatInfo = record
+ Channels: byte;
+ SampleRate: integer;
+ Format: TAudioSampleFormat;
+ end;
+
+type
+ TAudioProcessingStream = class
+ public
+ procedure Close(); virtual; abstract;
+ end;
+
+ TAudioPlaybackStream = class(TAudioProcessingStream)
+ protected
+ function GetLoop(): boolean; virtual; abstract;
+ procedure SetLoop(Enabled: boolean); virtual; abstract;
+ function GetLength(): real; virtual; abstract;
+ function GetStatus(): TStreamStatus; virtual; abstract;
+ function GetVolume(): integer; virtual; abstract;
+ procedure SetVolume(volume: integer); virtual; abstract;
+ public
+ procedure Play(); virtual; abstract;
+ procedure Pause(); virtual; abstract;
+ procedure Stop(); virtual; abstract;
+
+ property Loop: boolean READ GetLoop WRITE SetLoop;
+ property Length: real READ GetLength;
+ property Status: TStreamStatus READ GetStatus;
+ property Volume: integer READ GetVolume WRITE SetVolume;
+ end;
+
+ (*
+ TAudioMixerStream = class(TAudioProcessingStream)
+ procedure AddStream(stream: TAudioProcessingStream);
+ procedure RemoveStream(stream: TAudioProcessingStream);
+ procedure SetMasterVolume(volume: cardinal);
+ function GetMasterVolume(): cardinal;
+ procedure SetStreamVolume(stream: TAudioProcessingStream; volume: cardinal);
+ function GetStreamVolume(stream: TAudioProcessingStream): cardinal;
+ end;
+ *)
+
+ TAudioDecodeStream = class(TAudioProcessingStream)
+ protected
+ function GetLength(): real; virtual; abstract;
+ function GetPosition(): real; virtual; abstract;
+ procedure SetPosition(Time: real); virtual; abstract;
+ function IsEOF(): boolean; virtual; abstract;
+ public
+ function ReadData(Buffer: PChar; BufSize: integer): integer; virtual; abstract;
+ function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract;
+
+ property Length: real READ GetLength;
+ property Position: real READ GetPosition WRITE SetPosition;
+ property EOF: boolean READ IsEOF;
+ end;
+
+type
+ IGenericPlayback = Interface
+ ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}']
+ function GetName: String;
+
+ function Open(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}']
+ procedure init();
+
+ 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;
+ procedure SetVolume(Volume: integer);
+ procedure SetMusicVolume(Volume: integer);
+ 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;
+ end;
+
+ IGenericDecoder = Interface
+ ['{557B0E9A-604D-47E4-B826-13769F3E10B7}']
+ function InitializeDecoder(): 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;
+
+ procedure CaptureStart;
+ procedure CaptureStop;
+ end;
+
+type
+ TSoundLibrary = class
+ public
+ Start: TAudioPlaybackStream;
+ Back: TAudioPlaybackStream;
+ Swoosh: TAudioPlaybackStream;
+ Change: TAudioPlaybackStream;
+ Option: TAudioPlaybackStream;
+ Click: TAudioPlaybackStream;
+ Drum: TAudioPlaybackStream;
+ Hihat: TAudioPlaybackStream;
+ Clap: TAudioPlaybackStream;
+ Shuffle: TAudioPlaybackStream;
+
+ constructor Create();
+ destructor Destroy(); override;
+ end;
+
+var // TODO : JB --- THESE SHOULD NOT BE GLOBAL
+ // music
+ Muzyka: TMuzyka; // TODO: rename
+
+ // czesci z nutami;
+ Czesci: array of TCzesci; // TODO: rename to Sentences/Lines
+
+ // czas
+ Czas: TCzas; // TODO: rename
+
+ SoundLib: TSoundLibrary;
+
+
+procedure InitializeSound;
+
+function Visualization(): IVideoPlayback;
+function VideoPlayback(): IVideoPlayback;
+function AudioPlayback(): IAudioPlayback;
+function AudioInput(): IAudioInput;
+function AudioDecoder(): IAudioDecoder;
+
+function AudioManager: TInterfaceList;
+
+
+implementation
+
+uses
+ sysutils,
+ UMain,
+ UCommandLine;
+// uLog;
+
+var
+ singleton_VideoPlayback : IVideoPlayback = nil;
+ singleton_Visualization : IVideoPlayback = nil;
+ singleton_AudioPlayback : IAudioPlayback = nil;
+ singleton_AudioInput : IAudioInput = nil;
+ singleton_AudioDecoder : IAudioDecoder = nil;
+
+ singleton_AudioManager : TInterfaceList = nil;
+
+
+function AudioManager: TInterfaceList;
+begin
+ if singleton_AudioManager = nil then
+ singleton_AudioManager := TInterfaceList.Create();
+
+ Result := singleton_AudioManager;
+end; //CompressionPluginManager
+
+
+function VideoPlayback(): IVideoPlayback;
+begin
+ result := singleton_VideoPlayback;
+end;
+
+function Visualization(): IVideoPlayback;
+begin
+ result := singleton_Visualization;
+end;
+
+function AudioPlayback(): IAudioPlayback;
+begin
+ result := singleton_AudioPlayback;
+end;
+
+function AudioInput(): IAudioInput;
+begin
+ result := singleton_AudioInput;
+end;
+
+function AudioDecoder(): IAudioDecoder;
+begin
+ result := singleton_AudioDecoder;
+end;
+
+procedure AssignSingletonObjects();
+var
+ lTmpInterface : IInterface;
+ iCount : Integer;
+begin
+ lTmpInterface := nil;
+
+
+
+ for iCount := 0 to AudioManager.Count - 1 do
+ begin
+ if assigned( AudioManager[iCount] ) then
+ begin
+ // if this interface is a Playback, then set it as the default used
+
+ if ( AudioManager[iCount].QueryInterface( IAudioPlayback, lTmpInterface ) = 0 ) AND
+ ( true ) then //not assigned( singleton_AudioPlayback ) ) then
+ begin
+ singleton_AudioPlayback := IAudioPlayback( lTmpInterface );
+ end;
+
+ // if this interface is a Input, then set it as the default used
+ if ( AudioManager[iCount].QueryInterface( IAudioInput, lTmpInterface ) = 0 ) AND
+ ( true ) then //not assigned( singleton_AudioInput ) ) then
+ begin
+ singleton_AudioInput := IAudioInput( lTmpInterface );
+ end;
+
+ // if this interface is a Decoder, then set it as the default used
+ if ( AudioManager[iCount].QueryInterface( IAudioDecoder, lTmpInterface ) = 0 ) AND
+ ( true ) then //not assigned( singleton_AudioDecoder ) ) then
+ begin
+ singleton_AudioDecoder := IAudioDecoder( lTmpInterface );
+ end;
+
+ // if this interface is a Input, then set it as the default used
+ if ( AudioManager[iCount].QueryInterface( IVideoPlayback, lTmpInterface ) = 0 ) AND
+ ( true ) then //not assigned( singleton_VideoPlayback ) ) then
+ begin
+ singleton_VideoPlayback := IVideoPlayback( lTmpInterface );
+ end;
+
+ if ( AudioManager[iCount].QueryInterface( IVideoVisualization, lTmpInterface ) = 0 ) AND
+ ( true ) then //not assigned( singleton_Visualization ) ) then
+ begin
+ singleton_Visualization := IVideoPlayback( lTmpInterface );
+ end;
+
+ end;
+ end;
+
+end;
+
+procedure InitializeSound;
+begin
+ singleton_AudioPlayback := nil;
+ singleton_AudioInput := nil;
+ singleton_AudioDecoder := nil;
+ singleton_VideoPlayback := nil;
+ singleton_Visualization := nil;
+
+ AssignSingletonObjects();
+
+
+ if VideoPlayback <> nil then
+ begin
+ end;
+
+ if AudioDecoder <> nil then
+ begin
+ while not AudioDecoder.InitializeDecoder do
+ begin
+ //writeln('Initialize failed, Removing - '+ AudioDecoder.GetName );
+ AudioManager.remove( AudioDecoder );
+ singleton_AudioDecoder := nil;
+ AssignSingletonObjects();
+ end;
+ end;
+
+ if AudioPlayback <> nil then
+ begin
+ while not AudioPlayback.InitializePlayback do
+ begin
+ writeln('Initialize failed, Removing - '+ AudioPlayback.GetName );
+ AudioManager.remove( AudioPlayback );
+ singleton_AudioPlayback := nil;
+ AssignSingletonObjects();
+ end;
+ end;
+
+ if AudioInput <> nil then
+ begin
+ while not AudioInput.InitializeRecord do
+ begin
+ writeln('Initialize failed, Removing - '+ AudioInput.GetName );
+ AudioManager.remove( AudioInput );
+ singleton_AudioInput := nil;
+ AssignSingletonObjects();
+ end;
+ end;
+
+ // Load in-game sounds
+ SoundLib := TSoundLibrary.Create;
+
+ if FindCmdLineSwitch( cMediaInterfaces ) then
+ 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( '' );
+
+ halt;
+ end;
+end;
+
+constructor TSoundLibrary.Create();
+begin
+ //Log.LogStatus('Loading Sounds', 'Music Initialize');
+
+ //Log.BenchmarkStart(4);
+
+ 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');
+
+ //Drum := AudioPlayback.OpenSound(SoundPath + 'bassdrumhard076b.mp3');
+ //Hihat := AudioPlayback.OpenSound(SoundPath + 'hihatclosed068b.mp3');
+ //Clap := AudioPlayback.OpenSound(SoundPath + 'claps050b.mp3');
+
+ //Shuffle := AudioPlayback.OpenSound(SoundPath + 'Shuffle.mp3');
+
+ //Log.BenchmarkEnd(4);
+ //Log.LogBenchmark('--> Loading Sounds', 4);
+end;
+
+destructor TSoundLibrary.Destroy();
+begin
+ Start.Free;
+ Back.Free;
+ Swoosh.Free;
+ Change.Free;
+ Option.Free;
+ Click.Free;
+
+ //Drum.Free;
+ //Hihat.Free;
+ //Clap.Free;
+
+ //Shuffle.Free;
+end;
+
+
+initialization
+begin
+ singleton_AudioManager := TInterfaceList.Create();
+
+end;
+
+finalization
+ singleton_AudioManager.clear;
+ FreeAndNil( singleton_AudioManager );
+
+end.
diff --git a/Game/Code/Classes/UParty.pas b/Game/Code/Classes/UParty.pas new file mode 100644 index 00000000..b0b400db --- /dev/null +++ b/Game/Code/Classes/UParty.pas @@ -0,0 +1,616 @@ +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;
+ Procedure Free; 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
+ //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
+//-------------
+Procedure TPartySession.Free;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Modis, 0);
+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'));
+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);
+ 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;
+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].ScoreTotalI > MaxScore) then
+ begin
+ MaxScore := Player[I].ScoreTotalI;
+ Rounds[CurRound].Winner := 1 shl I;
+ end
+ else if (Player[I].ScoreTotalI = MaxScore) AND (Player[I].ScoreTotalI <> 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);
+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/Game/Code/Classes/UPlatform.pas b/Game/Code/Classes/UPlatform.pas new file mode 100644 index 00000000..bfb03d54 --- /dev/null +++ b/Game/Code/Classes/UPlatform.pas @@ -0,0 +1,80 @@ +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 UPlatformWindows. + +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; + + IPlatform = Interface + ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCA23DF}'] + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + function FindSongFile(Dir, Mask: widestring): widestring; + procedure halt; + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + end; + + function Platform : IPlatform; + +implementation + +uses + SysUtils, + {$IFDEF MSWINDOWS} + UPlatformWindows; + {$ENDIF} + {$IFDEF LINUX} + UPlatformLinux; + {$ENDIF} + {$IFDEF DARWIN} + UPlatformMacOSX; + {$ENDIF} + + +// 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 : IPlatform; + +function Platform : IPlatform; +begin + result := Platform_singleton;
+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 := nil; +end. diff --git a/Game/Code/Classes/UPlatformLinux.pas b/Game/Code/Classes/UPlatformLinux.pas new file mode 100644 index 00000000..0883b0f8 --- /dev/null +++ b/Game/Code/Classes/UPlatformLinux.pas @@ -0,0 +1,214 @@ +unit UPlatformLinux; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatformLinux = class(TInterfacedObject, IPlatform) + function get_homedir(): string; + public + function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + function FindSongFile(Dir, Mask: widestring): widestring; + + procedure Halt; + + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + end; + +implementation + +// check for version of FPC >= 2.2.0 +{$IFDEF FPC} + {$IF (FPC_VERSION > 2) or ((FPC_VERSION = 2) and (FPC_RELEASE >= 2))} + {$DEFINE FPC_VERSION_2_2_0_PLUS} + {$IFEND} +{$ENDIF} + +uses + libc, + uCommandLine, +{$IFDEF FPC_VERSION_2_2_0_PLUS} + BaseUnix, +{$ELSE} + oldlinux, +{$ENDIF} + SysUtils, + UConfig; + +{$IFDEF FPC_VERSION_2_2_0_PLUS} +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : pDir; + ADirent : pDirent; + Entry : Longint; + //info : oldlinux.stat; + 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; +{$ELSE} +Function TPlatformLinux.DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; +var + i : Integer; + TheDir : oldlinux.pdir; + ADirent : oldlinux.pDirent; + Entry : Longint; + info : oldlinux.stat; + lAttrib : integer; +begin + i := 0; + Filter := LowerCase(Filter); + + TheDir := oldlinux.opendir( Dir ); + if Assigned(TheDir) then + repeat + ADirent := oldlinux.ReadDir(TheDir); + + If Assigned(ADirent) and (ADirent^.name <> '.') and (ADirent^.name <> '..') then + begin + lAttrib := FileGetAttr(Dir + ADirent^.name); + if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.name; + Result[i].IsDirectory := true; + Result[i].IsFile := false; + i := i + 1; + end + else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.name)) > 0) then + begin + SetLength( Result, i + 1); + Result[i].Name := ADirent^.name; + Result[i].IsDirectory := false; + Result[i].IsFile := true; + i := i + 1; + end; + end; + Until ADirent = nil; + + oldlinux.CloseDir(TheDir); +end; +{$ENDIF} + + +function TPlatformLinux.GetLogPath : WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + result := ExtractFilePath(ParamStr(0)) + else +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := LogPath+'/'; +{$ENDIF} + + forcedirectories( result ); + +end; + +function TPlatformLinux.GetGameSharedPath : WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + result := ExtractFilePath(ParamStr(0)) + else +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := SharedPath+'/'; +{$ENDIF} +end; + +function TPlatformLinux.GetGameUserPath : WideString; +begin + if FindCmdLineSwitch( cUseLocalPaths ) then + result := ExtractFilePath(ParamStr(0)) + else +{$IFDEF UseLocalDirs} + result := ExtractFilePath(ParamStr(0)) +{$ELSE} + result := get_homedir()+'/.'+PathSuffix+'/'; +{$ENDIF} +end; + +function TPlatformLinux.get_homedir(): string; +var + pPasswdEntry : Ppasswd; + lUserName : String; +begin + pPasswdEntry := getpwuid( getuid() ); + result := pPasswdEntry^.pw_dir; +end; + +// FIXME: just a dirty-fix to make the linux build work again. +// This i the same as the corresponding function for MacOSX. +// Maybe this should be TPlatformBase.Halt() +procedure TPlatformLinux.Halt; +begin + halt(); +end; + +function TPlatformLinux.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; +begin + // Linux and Mac don't check for running apps at the moment + Result := false; +end; + +// FIXME: just a dirty-fix to make the linux build work again. +// This i the same as the corresponding function for windows +// (and MacOSX?). +// Maybe this should be TPlatformBase.FindSongFile() +function TPlatformLinux.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; // if + SysUtils.FindClose(SR); +end; + +end. diff --git a/Game/Code/Classes/UPlatformMacOSX.pas b/Game/Code/Classes/UPlatformMacOSX.pas new file mode 100644 index 00000000..7b081607 --- /dev/null +++ b/Game/Code/Classes/UPlatformMacOSX.pas @@ -0,0 +1,142 @@ +unit UPlatformMacOSX; + +// Note on directories (by eddie): +// We use subfolders of the application directory on tha mac, because: +// 1. Installation 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. If we would use subfolders of the home directory we would have to spread our +// files to many directories - these directories are defined by Apple, but the +// average user doesn't know them, beacuse he or she doesn't need to know them. +// But for UltraStar the user must at least know the songs directory... +// +// Creating a subfolder directly under the home directory is not acceptable. +// + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses Classes, UPlatform; + +type + + TPlatformMacOSX = class( TInterfacedObject, IPlatform) + public + Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray; + function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; + procedure halt(); + function GetLogPath : WideString; + function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + function FindSongFile(Dir, Mask: widestring): widestring; + end; + +implementation + +uses SysUtils, baseunix; + +// Mac applications are packaged in directories. +// We have to cut the last two directories +// to get the application directory. +Function GetBundlePath : WideString; +var + x, + i : integer; +begin + Result := ExtractFilePath(ParamStr(0)); + for x := 0 to 2 do begin + i := Length(Result); + repeat + Delete( Result, i, 1); + i := Length(Result); + until (i = 0) or (Result[i] = '/'); + end; +end; + +function TPlatformMacOSX.GetLogPath : WideString; +begin + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. + Result := GetBundlePath + '/Logs'; +end; + +function TPlatformMacOSX.GetGameSharedPath : WideString; +begin + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. + Result := GetBundlePath; +end; + +function TPlatformMacOSX.GetGameUserPath : WideString; +begin + // eddie: Please read the note at the top of this file, why we use the application directory and not the user directory. + Result := GetBundlePath; +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; + +function TPlatformMacOSX.TerminateIfAlreadyRunning(var WndTitle : String) : Boolean; +begin + result := false; +end; + + +procedure TPlatformMacOSX.halt; +begin + halt; +end; + +function TPlatformMacOSX.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; // if + SysUtils.FindClose(SR); +end; + + +end. diff --git a/Game/Code/Classes/UPlatformWindows.pas b/Game/Code/Classes/UPlatformWindows.pas new file mode 100644 index 00000000..d4ba757a --- /dev/null +++ b/Game/Code/Classes/UPlatformWindows.pas @@ -0,0 +1,227 @@ +unit UPlatformWindows;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses Classes,
+ UPlatform;
+
+type
+
+ TPlatformWindows = class( TInterfacedObject, IPlatform)
+ public
+ Function DirectoryFindFiles(Dir, Filter : WideString; ReturnAllSubDirs : Boolean) : TDirectoryEntryArray;
+ function TerminateIfAlreadyRunning(var WndTitle : String) : Boolean;
+ function GetGamePath: WideString;
+ function FindSongFile(Dir, Mask: widestring): widestring;
+
+ procedure halt;
+
+ function GetLogPath : WideString;
+ function GetGameSharedPath : WideString; + function GetGameUserPath : WideString; + end;
+
+implementation
+
+uses SysUtils,
+ Windows,
+ Forms;
+
+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;
+ lAttrib : 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
+ lAttrib := FileGetAttr(Dir + SR.name);
+ if ReturnAllSubDirs and ((lAttrib 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;
+
+function TPlatformWindows.GetGamePath: WideString;
+begin
+ // Windows and Linux use this:
+ Result := ExtractFilePath(ParamStr(0));
+end;
+
+procedure TPlatformWindows.halt;
+begin
+ application.terminate;
+end;
+
+function TPlatformWindows.GetLogPath : WideString;
+begin + result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.GetGameSharedPath : WideString; +begin + result := ExtractFilePath(ParamStr(0)); +end; + +function TPlatformWindows.GetGameUserPath : WideString; +begin + result := ExtractFilePath(ParamStr(0)); +end; +
+
function TPlatformWindows.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; // if + SysUtils.FindClose(SR); +end; +
+
+end.
diff --git a/Game/Code/Classes/UPlaylist.pas b/Game/Code/Classes/UPlaylist.pas new file mode 100644 index 00000000..2c09c493 --- /dev/null +++ b/Game/Code/Classes/UPlaylist.pas @@ -0,0 +1,470 @@ +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 + LoadPlayLists; +end; + +//---------- +//LoadPlayLists - Load list of Playlists from PlayList Folder +//---------- +Procedure TPlayListManager.LoadPlayLists; +var + SR: TSearchRec; + Len: Integer; +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); + + 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 (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); + + 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 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 (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 (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 + if iPlaylist = -1 then + P := CurPlaylist + else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then + P := iPlaylist + else + exit; + + Result := -1; + + For I := 0 to high(Playlists[P].Items) do + begin + if (Playlists[P].Items[I].SongID = SongID) then + begin + Result := I; + Break; + end; + end; +end; + +end. diff --git a/Game/Code/Classes/UPliki.pas b/Game/Code/Classes/UPliki.pas new file mode 100644 index 00000000..f4e8ff97 --- /dev/null +++ b/Game/Code/Classes/UPliki.pas @@ -0,0 +1,835 @@ +unit UPliki;
+
+interface
+
+{$I switches.inc}
+
+uses USongs, SysUtils, ULog, UMusic;
+
+procedure InitializePaths;
+function ReadHeader(var Song: TSong): boolean;
+function SkanujPlik(var Song: TSong): boolean;
+procedure CzyscNuty;
+function WczytajCzesci(Name: string): boolean;
+function SaveSong(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean;
+function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean;
+
+var
+ GamePath: string;
+ SoundPath: string;
+ SongPath: string;
+ LogPath: string;
+ ThemePath: string;
+ ScreenshotsPath: string;
+ CoversPath: string;
+ LanguagesPath: string;
+ PluginPath: string;
+ PlayListPath: string;
+
+ Plik: TextFile; // all procedures in this unit operates on this file
+ PlikC: char;
+ Lineno: integer;
+
+ // variables available for all procedures
+ Base: array[0..1] of integer;
+ Rel: array[0..1] of integer;
+ Mult: integer;
+ MultBPM: integer;
+
+implementation
+uses TextGL, UIni, UMain, math;
+
+procedure InitializePaths;
+begin
+ GamePath := ExtractFilePath(ParamStr(0));
+ SoundPath := GamePath + 'Sounds\';
+ SongPath := GamePath + 'Songs\';
+ LogPath := GamePath;
+ ThemePath := GamePath + 'Themes\';
+ ScreenshotsPath := GamePath + 'Screenshots\';
+ CoversPath := GamePath + 'Covers\';
+ LanguagesPath := GamePath + 'Languages\';
+ //Modi Loader
+ PluginPath := GamePath + 'Plugins\';
+
+ PlaylistPath := GamePath + 'Playlists\';
+
+ DecimalSeparator := ',';
+end;
+
+function ReadHeader(var Song: TSong): boolean;
+var
+ TempC: char;
+ Tekst: string;
+ Done: integer;
+begin
+ // clear
+ Song.Title := '';
+ Song.Artist := '';
+ Song.Genre := 'Unknown';
+ Song.Edition := 'Unknown';
+ Song.Language := 'Unknown'; //Language Patch
+ Song.Mp3 := '';
+ Song.BPM := 0;
+ Song.GAP := 0;
+ Song.Start := 0;
+ Song.Finish := 0;
+ Song.Background := '';
+ Song.Video := '';
+ Song.VideoGAP := 0;
+ Song.NotesGAP := 0;
+ Song.Resolution := 4;
+
+ //Creator Patch
+ Song.Creator := '';
+
+ Done := 0;
+
+ //Editor Error Reporting Hack
+ LineNo := 0;
+ try
+
+ // read
+ Read(Plik, PlikC);
+ while (PlikC = '#') do begin
+ ReadLn(Plik, Tekst);
+
+ //Editor Error Reporting Hack
+ Inc (LineNo);
+
+ //Header Improvements Patch
+
+ if UpperCase(Copy(Tekst, 1, 6)) = 'TITLE:' then begin
+ Delete(Tekst, 1, 6);
+ Song.Title := Trim(Tekst);
+ Tekst := '';
+ Done := Done or 1;
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 7)) = 'ARTIST:' then begin
+ Delete(Tekst, 1, 7);
+ Song.Artist := Trim(Tekst);
+ Tekst := '';
+ Done := Done or 2;
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 4)) = 'MP3:' then begin
+ Delete(Tekst, 1, 4);
+ Song.Mp3 := Trim(Tekst);
+ Tekst := '';
+ Done := Done or 4;
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 8)) = 'CREATOR:' then begin // this goes for edit
+ Delete(Tekst, 1, 8);
+ Song.Creator := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 6)) = 'GENRE:' then begin // this goes for edit
+ Delete(Tekst, 1, 6);
+ Song.Genre := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 8)) = 'EDITION:' then begin // this goes for edit
+ Delete(Tekst, 1, 8);
+ Song.Edition := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 9)) = 'LANGUAGE:' then begin // this goes for edit
+ Delete(Tekst, 1, 9);
+ Song.Language := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 6)) = 'COVER:' then begin
+ Delete(Tekst, 1, 6);
+ Song.Cover := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 11)) = 'BACKGROUND:' then begin
+ Delete(Tekst, 1, 11);
+ Song.Background := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 6)) = 'VIDEO:' then begin
+ Delete(Tekst, 1, 6);
+ Song.Video := Trim(Tekst);
+ Tekst := '';
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 9)) = 'VIDEOGAP:' then begin
+ Delete(Tekst, 1, 9);
+
+ //Change . to , Mod by Whiteshark :P
+ if (Pos('.',Tekst) <> 0) then
+ begin
+ Tekst[Pos('.',Tekst)] := ',';
+ //Little Annonce for the User
+ Log.LogError('VideoGap Seperator wrong in SongHeader: ' + Song.FileName + ' [Corrected for this Session]');
+ end;
+
+ Song.VideoGAP := StrToFloat(Tekst);
+ Tekst := ''
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 9)) = 'NOTESGAP:' then begin
+ Delete(Tekst, 1, 9);
+ Song.NotesGAP := StrToInt(Tekst);
+ Tekst := ''
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 9)) = 'RELATIVE:' then begin
+ Delete(Tekst, 1, 9);
+ if LowerCase(Tekst) = 'yes' then Song.Relative := true;
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 6)) = 'START:' then begin
+ Delete(Tekst, 1, 6);
+ Song.Start := StrToFloat(Tekst);
+// Muzyka.Start := StrToInt(Tekst);
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 4)) = 'END:' then begin
+ Delete(Tekst, 1, 4);
+ Song.Finish := StrToInt(Tekst);
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 11)) = 'RESOLUTION:' then begin
+ Delete(Tekst, 1, 11);
+ Song.Resolution := StrToInt(Tekst);
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 4)) = 'BPM:' then begin
+ Delete(Tekst, 1, 4);
+
+// Muzyka.BPMOld := StrToFloat(Tekst) * Mult * MultBPM; // old system
+
+ (* new system with variable BPM *)
+// Muzyka.BPMOld := 50;
+
+ //Change . to , Mod by Whiteshark :P
+ if (Pos('.',Tekst) <> 0) then
+ begin
+ Tekst[Pos('.',Tekst)] := ',';
+ //Little Annonce for the User
+ Log.LogError('BPM Seperator wrong in SongHeader: ' + Song.FileName + ' [Corrected for this Session]');
+ end;
+
+ SetLength(Song.BPM, 1);
+ Song.BPM[0].StartBeat := 0;
+ Song.BPM[0].BPM := StrToFloat(Tekst) * Mult * MultBPM;
+ Tekst := '';
+ Done := Done or 8;
+ end
+
+ else if UpperCase(Copy(Tekst, 1, 4)) = 'GAP:' then begin
+ Delete(Tekst, 1, 4);
+ Song.GAP := StrToFloat(Tekst);
+ Tekst := '';
+// Muzyka.GAP := StrToFloat(Tekst);
+// Done := Done or 16;
+ end;
+
+ //Header Improvements Patch Ende
+
+ Read(Plik, PlikC);
+ end;
+
+ //Editor Error Reporting Hack
+ except //An Error happened<- bad english :P
+ Log.LogError('An Error occured reading Line ' + inttostr(LineNo) + ' from SongHeader: ' + Song.FileName);
+ Halt;
+ end;
+ //Editor Error Reporting Hack End
+
+ if Song.Background = '' then begin
+ Song.Background := Songs.FindSongFile(Song.Path, '*[BG].jpg');
+ end;
+
+ if (Done and 15) = 15 then Result := true
+ else Result := false;
+end;
+
+function SkanujPlik(var Song: TSong): boolean;
+var
+ Done: integer;
+ Tekst: string;
+ C: integer; // category
+ P: integer; // position
+begin
+// try
+ AssignFile(Plik, Song.Path + Song.FileName);
+ Reset(Plik);
+
+ Result := ReadHeader(Song);
+
+{ ReadLn(Plik, Tekst);
+ while (Copy(Tekst, 1, 1) = '#') do begin
+ if Copy(Tekst, 1, 10) = '#CATEGORY:' then begin
+ Delete(Tekst, 1, 10);
+
+ Trim(Tekst);
+ while (Length(Tekst) > 0) do begin
+ C := Length(Song.Category);
+ SetLength(Song.Category, C+1);
+
+ P := Pos(',', Tekst);
+ if P = 0 then P := Length(Tekst);
+ Song.Category[C] := Copy(Tekst, 1, P);
+
+ Delete(Tekst, 1, P);
+ Trim(Tekst);
+ end;
+
+ end;}
+
+
+end;
+
+procedure CzyscNuty;
+var
+ Pet: integer;
+begin
+ SetLength(Czesci, Length(Player));
+ SetLength(AktSong.BPM, 0);
+ for Pet := 0 to High(Player) do begin
+ SetLength(Czesci[Pet].Czesc, 1);
+ SetLength(Czesci[Pet].Czesc[0].Nuta, 0);
+ Czesci[Pet].Czesc[0].Lyric := '';
+ Czesci[Pet].Czesc[0].LyricWidth := 0;
+ Player[pet].Score := 0;
+ Player[pet].IlNut := 0;
+ Player[pet].HighNut := -1;
+ end;
+end;
+
+procedure DodajNute(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+var
+ Space: boolean;
+begin
+ case Ini.Solmization of
+ 1: // european
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' si ';
+ end;
+ end;
+ 2: // japanese
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' so ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' shi ';
+ end;
+ end;
+ 3: // american
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' ti ';
+ end;
+ end;
+ end; // case
+
+// Log.LogStatus('Czesc: ' + IntToStr(Czesci[NrCzesci].High), 'DodajNute');
+// Log.LogStatus('Dodano: [' + IntToStr(NrCzesci) + '] ' + IntToStr(StartP) + ' '
+// + IntToStr(DurationP) + ' '+ IntToStr(NoteP) + ' ' + LyricS, 'DodajNute');
+
+{ Delete(LyricS, 1, 1);
+ Space := false;
+ if Copy(LyricS, Length(LyricS), 1) = ' ' then begin
+ Space := true;
+ Delete(LyricS, Length(LyricS), 1);
+ end;
+ if LyricS = 'a' then LyricS := chr($B1);
+ if LyricS = 'i' then LyricS := chr($B2);
+ if LyricS = 'u' then LyricS := chr($B3);
+ if LyricS = 'e' then LyricS := chr($B4);
+ if LyricS = 'o' then LyricS := chr($B5);
+
+ if LyricS = 'ka' then LyricS := chr($B6);
+ if LyricS = 'ki' then LyricS := chr($B7);
+ if LyricS = 'ku' then LyricS := chr($B8);
+ if LyricS = 'ke' then LyricS := chr($B9);
+ if LyricS = 'ko' then LyricS := chr($BA);
+
+ if LyricS = 'ga' then LyricS := chr($B6) + chr($DE);
+ if LyricS = 'gi' then LyricS := chr($B7) + chr($DE);
+ if LyricS = 'gu' then LyricS := chr($B8) + chr($DE);
+ if LyricS = 'ge' then LyricS := chr($B9) + chr($DE);
+ if LyricS = 'go' then LyricS := chr($BA) + chr($DE);
+
+ if LyricS = 'sa' then LyricS := chr($BB);
+ if LyricS = 'shi' then LyricS := chr($BC);
+ if LyricS = 'su' then LyricS := chr($BD);
+ if LyricS = 'se' then LyricS := chr($BE);
+ if LyricS = 'so' then LyricS := chr($BF);
+
+ if LyricS = 'za' then LyricS := chr($BB) + chr($DE);
+ if LyricS = 'ji' then LyricS := chr($BC) + chr($DE);
+ if LyricS = 'zu' then LyricS := chr($BD) + chr($DE);
+ if LyricS = 'ze' then LyricS := chr($BE) + chr($DE);
+ if LyricS = 'zo' then LyricS := chr($BF) + chr($DE);
+
+ if LyricS = 'ta' then LyricS := chr($C0);
+ if LyricS = 'chi' then LyricS := chr($C1);
+ if LyricS = 'tsu' then LyricS := chr($C2);
+ if LyricS = 'te' then LyricS := chr($C3);
+ if LyricS = 'to' then LyricS := chr($C4);
+
+ if LyricS = 'da' then LyricS := chr($C0) + chr($DE);
+// if LyricS = 'ji' then LyricS := chr($C1) + chr($DE);
+// if LyricS = 'zu' then LyricS := chr($C2) + chr($DE);
+ if LyricS = 'de' then LyricS := chr($C3) + chr($DE);
+ if LyricS = 'do' then LyricS := chr($C4) + chr($DE);
+
+ if LyricS = 'na' then LyricS := chr($C5);
+ if LyricS = 'ni' then LyricS := chr($C6);
+ if LyricS = 'nu' then LyricS := chr($C7);
+ if LyricS = 'ne' then LyricS := chr($C8);
+ if LyricS = 'no' then LyricS := chr($C9);
+
+ if LyricS = 'ha' then LyricS := chr($CA);
+ if LyricS = 'hi' then LyricS := chr($CB);
+ if LyricS = 'hu' then LyricS := chr($CC);
+ if LyricS = 'he' then LyricS := chr($CD);
+ if LyricS = 'ho' then LyricS := chr($CE);
+
+ if LyricS = 'ba' then LyricS := chr($CA) + chr($DE);
+ if LyricS = 'bi' then LyricS := chr($CB) + chr($DE);
+ if LyricS = 'bu' then LyricS := chr($CC) + chr($DE);
+ if LyricS = 'be' then LyricS := chr($CD) + chr($DE);
+ if LyricS = 'bo' then LyricS := chr($CE) + chr($DE);
+
+ if LyricS = 'pa' then LyricS := chr($CA) + chr($DF);
+ if LyricS = 'pi' then LyricS := chr($CB) + chr($DF);
+ if LyricS = 'pu' then LyricS := chr($CC) + chr($DF);
+ if LyricS = 'pe' then LyricS := chr($CD) + chr($DF);
+ if LyricS = 'po' then LyricS := chr($CE) + chr($DF);
+
+ if LyricS = 'ma' then LyricS := chr($CF);
+ if LyricS = 'mi' then LyricS := chr($D0);
+ if LyricS = 'mu' then LyricS := chr($D1);
+ if LyricS = 'me' then LyricS := chr($D2);
+ if LyricS = 'mo' then LyricS := chr($D3);
+
+ if LyricS = 'ya' then LyricS := chr($D4);
+ if LyricS = 'yu' then LyricS := chr($D5);
+ if LyricS = 'yo' then LyricS := chr($D6);
+
+ if LyricS = 'ra' then LyricS := chr($D7);
+ if LyricS = 'ri' then LyricS := chr($D8);
+ if LyricS = 'ru' then LyricS := chr($D9);
+ if LyricS = 're' then LyricS := chr($DA);
+ if LyricS = 'ro' then LyricS := chr($DB);
+
+ if LyricS = 'wa' then LyricS := chr($DC);
+ if LyricS = 'n' then LyricS := chr($DD);
+
+ LyricS := ' ' + LyricS;
+ if Space then LyricS := LyricS + ' ';}
+
+
+
+ with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin
+ SetLength(Nuta, Length(Nuta) + 1);
+ IlNut := IlNut + 1;
+ HighNut := HighNut + 1;
+ Muzyka.IlNut := Muzyka.IlNut + 1;
+
+ Nuta[HighNut].Start := StartP;
+ if IlNut = 1 then begin
+ StartNote := Nuta[HighNut].Start;
+ if Czesci[NrCzesci].Ilosc = 1 then
+ Start := -100;
+// Start := Nuta[HighNut].Start;
+ end;
+
+ Nuta[HighNut].Dlugosc := DurationP;
+ Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc;
+
+ // back to the normal system with normal, golden and now freestyle notes
+ case TypeP of
+ 'F': Nuta[HighNut].Wartosc := 0;
+ ':': Nuta[HighNut].Wartosc := 1;
+ '*': Nuta[HighNut].Wartosc := 2;
+ end;
+ Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc;
+
+ Nuta[HighNut].Ton := NoteP;
+ if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton;
+ Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12;
+
+ Nuta[HighNut].Tekst := Copy(LyricS, 2, 100);
+ Lyric := Lyric + Nuta[HighNut].Tekst;
+
+ if TypeP = 'F' then
+ Nuta[HighNut].FreeStyle := true;
+
+ Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc;
+ end; // with
+end;
+
+procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer);
+var
+I: Integer;
+begin
+// Log.LogStatus('IlCzesci: ' + IntToStr(Czesci[NrCzesciP].Ilosc), 'NewSentece');
+// Log.LogStatus('Dane: ' + IntToStr(NrCzesciP) + ' ' + IntToStr(Param1) + ' ' + IntToStr(Param2) , 'NewSentece');
+
+ // stara czesc //Alter Satz //Update Old Part
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP];
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric));
+
+ //Total Notes Patch
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0;
+ for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do
+ begin
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc;
+ end;
+ //Log.LogError('Total Notes(' + inttostr(Czesci[NrCzesciP].High) +'): ' + inttostr(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes));
+ //Total Notes Patch End
+
+
+ // nowa czesc //Neuer Satz //Update New Part
+ SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1);
+ Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1;
+ Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1;
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1;
+
+ if not AktSong.Relative then
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1;
+
+ if AktSong.Relative then begin
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1;
+ Rel[NrCzesciP] := Rel[NrCzesciP] + Param2;
+ end;
+
+ Base[NrCzesciP] := 100; // high number
+end;
+
+function WczytajCzesci(Name: string): boolean;
+var
+ TempC: char;
+ Tekst: string;
+ CP: integer; // Current Player (0 or 1)
+ Pet: integer;
+ Both: boolean;
+ Param1: integer;
+ Param2: integer;
+ Param3: integer;
+ ParamS: string;
+ I: Integer;
+begin
+ Result := false;
+
+ if not FileExists(Name) then begin
+ Log.LogError('File not found: "' + Name + '"', 'WczytajCzesci');
+ exit;
+ end;
+
+ try
+ MultBPM := 4; // 4 - mnoznik dla czasu nut
+ Mult := 1; // 4 - dokladnosc pomiaru nut
+ Base[0] := 100; // high number
+// Base[1] := 100; // high number
+ Czesci[0].Wartosc := 0;
+// Czesci[1].Wartosc := 0; // here was the error in 0.3.2
+ AktSong.Relative := false;
+
+ Rel[0] := 0;
+// Rel[1] := 0;
+ CP := 0;
+ Both := false;
+ if Length(Player) = 2 then Both := true;
+
+ FileMode := fmOpenRead;
+ AssignFile(Plik, Name);
+ Reset(Plik);
+
+ ReadHeader(AktSong);
+(* if AktSong.Title = 'Hubba Hubba Zoot Zoot' then begin
+ Mult := 2;
+ AktSong.BPM[0].BPM := AktSong.BPM[0].BPM * 2;
+ end;*)
+
+ SetLength(Czesci, 2);
+ for Pet := 0 to High(Czesci) do begin
+ SetLength(Czesci[Pet].Czesc, 1);
+ Czesci[Pet].High := 0;
+ Czesci[Pet].Ilosc := 1;
+ Czesci[Pet].Akt := 0;
+ Czesci[Pet].Resolution := AktSong.Resolution;
+ Czesci[Pet].NotesGAP := AktSong.NotesGAP;
+ Czesci[Pet].Czesc[0].IlNut := 0;
+ Czesci[Pet].Czesc[0].HighNut := -1;
+ end;
+
+// TempC := ':';
+ TempC := PlikC; // read from backup variable, don't use default ':' value
+
+ while (TempC <> 'E') do begin
+ Inc(LineNo);
+ if (TempC = ':') or (TempC = '*') or (TempC = 'F') then begin
+ // wczytuje nute
+ Read(Plik, Param1);
+ Read(Plik, Param2);
+ Read(Plik, Param3);
+ Read(Plik, ParamS);
+
+ // dodaje nute
+ if not Both then
+ // P1
+ DodajNute(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
+ else begin
+ // P1 + P2
+ DodajNute(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
+ DodajNute(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
+ end;
+ end; // if
+ if TempC = '-' then begin
+ // reads sentence
+ Read(Plik, Param1);
+ if AktSong.Relative then Read(Plik, 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(AktSong.BPM, Length(AktSong.BPM) + 1);
+ Read(Plik, AktSong.BPM[High(AktSong.BPM)].StartBeat);
+ AktSong.BPM[High(AktSong.BPM)].StartBeat := AktSong.BPM[High(AktSong.BPM)].StartBeat + Rel[0];
+
+ Read(Plik, Tekst);
+ AktSong.BPM[High(AktSong.BPM)].BPM := StrToFloat(Tekst);
+ AktSong.BPM[High(AktSong.BPM)].BPM := AktSong.BPM[High(AktSong.BPM)].BPM * Mult * MultBPM;
+ end;
+
+
+ if not Both then begin
+ Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP];
+ Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric));
+ //Total Notes Patch
+ Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0;
+ for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do
+ begin
+ Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc;
+ end;
+ //Total Notes Patch End
+ end else begin
+ for Pet := 0 to High(Czesci) do begin
+ Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet];
+ Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric));
+ //Total Notes Patch
+ Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0;
+ for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do
+ begin
+ Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc;
+ end;
+ //Total Notes Patch End
+ end;
+ end;
+
+ Read(Plik, TempC);
+ end; // while}
+
+ CloseFile(Plik);
+ except
+ Log.LogError('Error Loading File: "' + Name + '" in Line ' + inttostr(LineNo));
+ exit;
+ end;
+
+ Result := true;
+end;
+
+function SaveSong(Song: TSong; Czesc: TCzesci; 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(Plik, Name);
+ Rewrite(Plik);
+
+ WriteLn(Plik, '#TITLE:' + Song.Title + '');
+ WriteLn(Plik, '#ARTIST:' + Song.Artist);
+
+ if Song.Creator <> '' then WriteLn(Plik, '#CREATOR:' + Song.Creator);
+ if Song.Edition <> 'Unknown' then WriteLn(Plik, '#EDITION:' + Song.Edition);
+ if Song.Genre <> 'Unknown' then WriteLn(Plik, '#GENRE:' + Song.Genre);
+ if Song.Language <> 'Unknown' then WriteLn(Plik, '#LANGUAGE:' + Song.Language);
+ if Song.Cover <> '' then WriteLn(Plik, '#COVER:' + Song.Cover);
+
+ WriteLn(Plik, '#MP3:' + Song.Mp3);
+
+ if Song.Background <> '' then WriteLn(Plik, '#BACKGROUND:' + Song.Background);
+ if Song.Video <> '' then WriteLn(Plik, '#VIDEO:' + Song.Video);
+ if Song.VideoGAP <> 0 then WriteLn(Plik, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP));
+ if Song.Resolution <> 4 then WriteLn(Plik, '#RESOLUTION:' + IntToStr(Song.Resolution));
+ if Song.NotesGAP <> 0 then WriteLn(Plik, '#NOTESGAP:' + IntToStr(Song.NotesGAP));
+ if Song.Start <> 0 then WriteLn(Plik, '#START:' + FloatToStr(Song.Start));
+ if Song.Finish <> 0 then WriteLn(Plik, '#END:' + IntToStr(Song.Finish));
+ if Relative then WriteLn(Plik, '#RELATIVE:yes');
+
+ WriteLn(Plik, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4));
+ WriteLn(Plik, '#GAP:' + FloatToStr(Song.GAP));
+
+ RelativeSubTime := 0;
+ for B := 1 to High(AktSong.BPM) do
+ WriteLn(Plik, 'B ' + FloatToStr(AktSong.BPM[B].StartBeat) + ' ' + FloatToStr(AktSong.BPM[B].BPM/4));
+
+ for C := 0 to Czesc.High do begin
+ for N := 0 to Czesc.Czesc[C].HighNut do begin
+ with Czesc.Czesc[C].Nuta[N] do begin
+
+
+ //Golden + Freestyle Note Patch
+ case Czesc.Czesc[C].Nuta[N].Wartosc of
+ 0: NoteState := 'F ';
+ 1: NoteState := ': ';
+ 2: NoteState := '* ';
+ end; // case
+ S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Dlugosc) + ' ' + IntToStr(Ton) + ' ' + Tekst;
+
+
+ WriteLn(Plik, S);
+ end; // with
+ end; // N
+
+ if C < Czesc.High then begin // don't write end of last sentence
+ if not Relative then
+ S := '- ' + IntToStr(Czesc.Czesc[C+1].Start)
+ else begin
+ S := '- ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime) +
+ ' ' + IntToStr(Czesc.Czesc[C+1].Start - RelativeSubTime);
+ RelativeSubTime := Czesc.Czesc[C+1].Start;
+ end;
+ WriteLn(Plik, S);
+ end;
+
+ end; // C
+
+
+ WriteLn(Plik, 'E');
+ CloseFile(Plik);
+end;
+
+function SaveSongDebug(Song: TSong; Czesc: TCzesci; Name: string; Relative: boolean): boolean;
+var
+ C: integer;
+ N: integer;
+ S: string;
+ STon: integer;
+ SLen: integer;
+ NTot: integer;
+ PlikB: TextFile;
+ LastTime: integer;
+begin
+ AssignFile(Plik, Name);
+ Rewrite(Plik);
+
+ AssignFile(PlikB, 'C:\song db.asm');
+ Rewrite(PlikB);
+
+ NTot := 0;
+ LastTime := 0;
+
+ for C := 0 to Czesc.High do begin
+ WriteLn(Plik, '; ' + IntToStr(C));
+
+ for N := 0 to Czesc.Czesc[C].HighNut do begin
+ with Czesc.Czesc[C].Nuta[N] do begin
+
+ // timespace
+ if LastTime < Start then begin
+ STon := 0;
+ SLen := Round((Start - LastTime) * 16320 / 255 / 12);
+ WriteLn(PlikB, ' .dw ' + IntToStr(STon + SLen*256) + ' ; timespace (0, ' + IntToStr(SLen) + ')');
+
+ end;
+
+
+
+ // ton
+ STon := Round(98940/(2*261.62*Power(1.05946309436, Ton)));
+ S := ' ldi R18, ' + IntToStr(STon);
+ if STon > 255 then begin
+ beep;
+ S := '!!!!' + S;
+ end;
+ WriteLn(Plik, S);
+
+ // length
+ //ldi R19, 43
+ SLen := Round(Dlugosc * 16320 / STon / 12);
+ S := ' ldi R19, ' + IntToStr(SLen);
+ if SLen > 255 then begin
+ beep;
+ S := '!!!!' + S;
+ end;
+ WriteLn(Plik, S);
+
+ // function
+ S := ' rcall playtone';
+ WriteLn(Plik, S);
+
+ // song dw
+ WriteLn(PlikB, ' .dw ' + IntToStr(STon + SLen*256));
+
+
+ LastTime := Start + Dlugosc;
+ Inc(NTot);
+
+ end; // with
+ end; // N
+ WriteLn(Plik, '');
+ WriteLn(PlikB, '');
+ end; // C
+
+ WriteLn(Plik, '; nut ' + IntToStr(NTot));
+ WriteLn(Plik, '; bajtów ' + IntToStr(8*NTot));
+
+ WriteLn(PlikB, ' .dw 0');
+ WriteLn(PlikB, '; nut ' + IntToStr(NTot));
+ WriteLn(PlikB, '; bajtów ' + IntToStr(2*NTot));
+
+
+ CloseFile(Plik);
+ CloseFile(PlikB);
+end;
+
+end.
diff --git a/Game/Code/Classes/UPluginInterface.pas b/Game/Code/Classes/UPluginInterface.pas new file mode 100644 index 00000000..6a83d7c3 --- /dev/null +++ b/Game/Code/Classes/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/Game/Code/Classes/URecord.pas b/Game/Code/Classes/URecord.pas new file mode 100644 index 00000000..8ae0978a --- /dev/null +++ b/Game/Code/Classes/URecord.pas @@ -0,0 +1,535 @@ +unit URecord;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses Classes,
+ Math,
+ SysUtils,
+ UCommon,
+ UMusic,
+ UIni;
+
+type
+ TSound = class
+ private
+ BufferNew: TMemoryStream; // buffer for newest samples
+ public
+ BufferArray: array[0..4095] of smallint; // newest 4096 samples
+ BufferLong: array of TMemoryStream; // full buffer
+
+ Index: integer; // index in TAudioInputProcessor.Sound[] (TODO: Remove if not used)
+
+ AnalysisBufferSize: integer; // number of samples to analyze
+
+ // pitch detection
+ ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
+ //Peak: integer; // position of peak on horizontal pivot (TODO: Remove if not used)
+ //ToneAccuracy: real; // tone accuracy (TODO: Remove if not used)
+ Tone: integer; // TODO: should be a non-unified full range tone (e.g. C2<>C3). Range: 0..NumHalftones-1
+ // Note: at the moment it is the same as ToneUnified
+ ToneUnified: integer; // tone unified to one octave (e.g. C2=C3=C4). Range: 0-11
+ //Scale: real; // FFT scale (TODO: Remove if not used)
+
+ // procedures
+ procedure ProcessNewBuffer;
+ procedure AnalyzeBuffer; // use to analyze sound from buffers to get new pitch
+ procedure AnalyzeByAutocorrelation; // we call it to analyze sound by checking Autocorrelation
+ function AnalyzeAutocorrelationFreq(Freq: real): real; // use this to check one frequency by Autocorrelation
+ end;
+
+ TAudioInputDeviceSource = record
+ Name: string;
+ end;
+
+ // soundcard input-devices information
+ TAudioInputDevice = class
+ public
+ CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
+ Description: string; // soundcard name/description
+ Source: array of TAudioInputDeviceSource; // soundcard input(-source)s
+ SourceSelected: integer; // unused. What is this good for?
+ MicInput: integer; // unused. What is this good for?
+ SampleRate: integer; // capture sample-rate (e.g. 44.1kHz -> 44100)
+ CaptureChannel: array[0..1] of TSound; // sound(-buffers) used for left/right channel's capture data
+
+ procedure Start(); virtual; abstract;
+ procedure Stop(); virtual; abstract;
+
+ destructor Destroy; override;
+ end;
+
+ TAudioInputProcessor = class
+ Sound: array of TSound;
+ Device: array of TAudioInputDevice;
+
+ constructor Create;
+
+ // handle microphone input
+ procedure HandleMicrophoneData(Buffer: Pointer; Size: Cardinal;
+ InputDevice: TAudioInputDevice);
+
+ function Volume( aChannel : byte ): byte;
+ end;
+
+ TAudioInputBase = class( TInterfacedObject, IAudioInput )
+ private
+ Started: boolean;
+ protected
+ function UnifyDeviceName(const name: string; deviceIndex: integer): string;
+ function UnifyDeviceSourceName(const name: string; const deviceName: string): string;
+ public
+ function GetName: String; virtual; abstract;
+ function InitializeRecord: boolean; virtual; abstract;
+
+ procedure CaptureStart;
+ procedure CaptureStop;
+ end;
+
+
+ SmallIntArray = array [0..maxInt shr 1-1] of smallInt;
+ PSmallIntArray = ^SmallIntArray;
+
+ function AudioInputProcessor(): TAudioInputProcessor;
+
+implementation
+
+uses
+ ULog,
+ UMain;
+
+const
+ CaptureFreq = 44100;
+ BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
+ NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
+
+var
+ singleton_AudioInputProcessor : TAudioInputProcessor = nil;
+
+
+// FIXME: Race-Conditions between Callback-thread and main-thread
+// on BufferArray (maybe BufferNew also).
+// Use SDL-mutexes to solve this problem.
+
+
+{ Global }
+
+function AudioInputProcessor(): TAudioInputProcessor;
+begin
+ if singleton_AudioInputProcessor = nil then
+ singleton_AudioInputProcessor := TAudioInputProcessor.create();
+
+ result := singleton_AudioInputProcessor;
+end;
+
+
+{ TAudioInputDevice }
+
+destructor TAudioInputDevice.Destroy;
+var
+ i: integer;
+begin
+ Stop();
+ Source := nil;
+ for i := 0 to High(CaptureChannel) do
+ CaptureChannel[i] := nil;
+ inherited Destroy;
+end;
+
+
+{ TSound }
+
+procedure TSound.ProcessNewBuffer;
+var
+ SkipCount: integer;
+ NumSamples: integer;
+ SampleIndex: integer;
+begin
+ // process BufferArray
+ SkipCount := 0;
+ NumSamples := BufferNew.Size div 2;
+
+ // check if we have more new samples than we can store
+ if NumSamples > Length(BufferArray) then
+ begin
+ // discard the oldest of the new samples
+ SkipCount := NumSamples - Length(BufferArray);
+ NumSamples := Length(BufferArray);
+ end;
+
+ // move old samples to the beginning of the array (if necessary)
+ for SampleIndex := NumSamples to High(BufferArray) do
+ BufferArray[SampleIndex-NumSamples] := BufferArray[SampleIndex];
+
+ // skip samples if necessary
+ BufferNew.Seek(2*SkipCount, soBeginning);
+ // copy samples
+ BufferNew.ReadBuffer(BufferArray[Length(BufferArray)-NumSamples], 2*NumSamples);
+
+ // save capture-data to BufferLong if neccessary
+ if Ini.SavePlayback = 1 then
+ begin
+ BufferNew.Seek(0, soBeginning);
+ BufferLong[0].CopyFrom(BufferNew, BufferNew.Size);
+ end;
+end;
+
+procedure TSound.AnalyzeBuffer;
+begin
+ AnalyzeByAutocorrelation;
+end;
+
+procedure TSound.AnalyzeByAutocorrelation;
+var
+ ToneIndex: integer;
+ Freq: real;
+ Wages: array[0..NumHalftones-1] of real;
+ MaxTone: integer;
+ MaxWage: real;
+ Volume: real;
+ MaxVolume: real;
+ SampleIndex: integer;
+ Threshold: real;
+const
+ HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
+begin
+ ToneValid := false;
+
+ // find maximum volume of first 1024 samples
+ MaxVolume := 0;
+ for SampleIndex := 0 to 1023 do
+ begin
+ Volume := Abs(BufferArray[SampleIndex]) /
+ -Low(Smallint); // was $10000 (65536) before but must be 32768
+
+ if Volume > MaxVolume then
+ MaxVolume := Volume;
+ end;
+
+ // prepare to analyze
+ MaxWage := 0;
+
+ // analyze halftones
+ for ToneIndex := 0 to NumHalftones-1 do
+ begin
+ Freq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
+ Wages[ToneIndex] := AnalyzeAutocorrelationFreq(Freq);
+
+ if Wages[ToneIndex] > MaxWage then
+ begin
+ // this frequency has better wage
+ MaxWage := Wages[ToneIndex];
+ MaxTone := ToneIndex;
+ end;
+ end;
+
+ Threshold := 0.2;
+ case Ini.Threshold of
+ 0: Threshold := 0.1;
+ 1: Threshold := 0.2;
+ 2: Threshold := 0.3;
+ 3: Threshold := 0.4;
+ end;
+
+ // check if signal has an acceptable volume (ignore background-noise)
+ if MaxVolume >= Threshold then
+ begin
+ ToneValid := true;
+ ToneUnified := MaxTone mod 12;
+ Tone := MaxTone mod 12;
+ end;
+
+end;
+
+function TSound.AnalyzeAutocorrelationFreq(Freq: real): real; // result medium difference
+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(CaptureFreq/Freq);
+ CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
+
+ AccumDist := 0;
+
+ // compare correlating samples
+ while (CorrelatingSampleIndex < AnalysisBufferSize) do
+ begin
+ // calc distance (correlation: 1-dist) to corresponding sample in next period
+ Dist := Abs(BufferArray[SampleIndex] - BufferArray[CorrelatingSampleIndex]) /
+ High(Word); // was $10000 (65536) before but must be 65535
+ AccumDist := AccumDist + Dist;
+ Inc(SampleIndex);
+ Inc(CorrelatingSampleIndex);
+ end;
+
+ // return "inverse" average distance (=correlation)
+ Result := 1 - AccumDist / AnalysisBufferSize;
+end;
+
+
+{ TAudioInputProcessor }
+
+{*
+ * Handle captured microphone input data.
+ * Params:
+ * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
+ * Interleaved means that a right-channel sample follows a left-
+ * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
+ * Length - number of bytes in Buffer
+ * Input - Soundcard-Input used for capture
+ *}
+procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: Pointer; Size: Cardinal; InputDevice: TAudioInputDevice);
+var
+ NumSamples: integer; // number of samples
+ SampleIndex: integer;
+ Value: integer;
+ ByteBuffer: PByteArray; // buffer handled as array of bytes
+ SampleBuffer: PSmallIntArray; // buffer handled as array of samples
+ Offset: integer;
+ Boost: byte;
+ ChannelCount: integer;
+ ChannelIndex: integer;
+ CaptureChannel: TSound;
+ SampleSize: integer;
+begin
+ // set boost
+ case Ini.MicBoost of
+ 0: Boost := 1;
+ 1: Boost := 2;
+ 2: Boost := 4;
+ 3: Boost := 8;
+ end;
+
+ // boost buffer
+ NumSamples := Size div 2;
+ SampleBuffer := Buffer;
+ for SampleIndex := 0 to NumSamples-1 do
+ begin
+ Value := SampleBuffer^[SampleIndex] * 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^[SampleIndex] := Value;
+ end;
+
+ // number of channels
+ ChannelCount := Length(InputDevice.CaptureChannel);
+ // size of one sample
+ SampleSize := ChannelCount * SizeOf(SmallInt);
+ // samples per channel
+ NumSamples := Size div SampleSize;
+
+ // interpret buffer as buffer of bytes
+ ByteBuffer := Buffer;
+
+ // process channels
+ for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
+ begin
+ CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
+ if (CaptureChannel <> nil) then
+ begin
+ Offset := ChannelIndex * SizeOf(SmallInt);
+
+ // TODO: remove BufferNew and write to BufferArray directly
+
+ CaptureChannel.BufferNew.Clear;
+ for SampleIndex := 0 to NumSamples-1 do
+ begin
+ CaptureChannel.BufferNew.Write(ByteBuffer^[Offset + SampleIndex*SampleSize],
+ SizeOf(SmallInt));
+ end;
+ CaptureChannel.ProcessNewBuffer();
+ end;
+ end;
+end;
+
+constructor TAudioInputProcessor.Create;
+var
+ i: integer;
+begin
+ SetLength(Sound, 6 {max players});//Ini.Players+1);
+ for i := 0 to High(Sound) do
+ begin
+ Sound[i] := TSound.Create;
+ Sound[i].Index := i;
+ Sound[i].BufferNew := TMemoryStream.Create;
+ SetLength(Sound[i].BufferLong, 1);
+ Sound[i].BufferLong[0] := TMemoryStream.Create;
+ Sound[i].AnalysisBufferSize := Min(4*1024, Length(Sound[i].BufferArray));
+ end;
+end;
+
+function TAudioInputProcessor.Volume( aChannel : byte ): byte;
+var
+ lSampleIndex: Integer;
+ lMaxVol : Word;
+begin;
+ with AudioInputProcessor.Sound[aChannel] do
+ begin
+ lMaxVol := BufferArray[0];
+ for lSampleIndex := 1 to High(BufferArray) do
+ begin
+ if Abs(BufferArray[lSampleIndex]) > lMaxVol then
+ lMaxVol := Abs(BufferArray[lSampleIndex]);
+ end;
+ end;
+
+ result := trunc( ( 255 / -Low(Smallint) ) * lMaxVol );
+end;
+
+
+{ TAudioInputBase }
+
+{*
+ * Start capturing on all used input-device.
+ *}
+procedure TAudioInputBase.CaptureStart;
+var
+ S: integer;
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+ DeviceUsed: boolean;
+ Player: integer;
+begin
+ if (Started) then
+ CaptureStop();
+
+ Log.BenchmarkStart(1);
+
+ // reset buffers
+ for S := 0 to High(AudioInputProcessor.Sound) do
+ AudioInputProcessor.Sound[S].BufferLong[0].Clear;
+
+ // start capturing on each used device
+ for DeviceIndex := 0 to High(AudioInputProcessor.Device) do begin
+ Device := AudioInputProcessor.Device[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+ DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
+
+ DeviceUsed := false;
+
+ // check if device is used
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ begin
+ Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
+ if (Player < 0) or (Player >= PlayersPlay) then
+ begin
+ Device.CaptureChannel[ChannelIndex] := nil;
+ end
+ else
+ begin
+ Device.CaptureChannel[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;
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('CaptureStart', 1) ; +
+ Started := true;
+end;
+
+{*
+ * Stop input-capturing on all soundcards.
+ *}
+procedure TAudioInputBase.CaptureStop;
+var
+ DeviceIndex: integer;
+ Player: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+begin
+ for DeviceIndex := 0 to High(AudioInputProcessor.Device) do begin
+ Device := AudioInputProcessor.Device[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+ Device.Stop();
+ end;
+
+ Started := false;
+end;
+
+function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
+var
+ count: integer; // count of devices with this name
+
+ function IsDuplicate(const name: string): boolean;
+ var
+ i: integer;
+ begin
+ Result := False;
+ // search devices with same description
+ For i := 0 to deviceIndex-1 do
+ begin
+ if (AudioInputProcessor.Device[i].Description = name) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+ end;
+begin
+ count := 1;
+ result := name;
+
+ // if there is another device with the same ID, search for an available name
+ while (IsDuplicate(result)) do
+ begin
+ Inc(count);
+ // set description
+ result := name + ' ('+IntToStr(count)+')';
+ end;
+end;
+
+{*
+ * Unifies an input-device's source name.
+ * Note: the description member of the device must already be set when
+ * calling this function.
+ *}
+function TAudioInputBase.UnifyDeviceSourceName(const name: string; const deviceName: string): string;
+var
+ Descr: string;
+begin
+ result := name;
+
+ {$IFDEF DARWIN}
+ // Under MacOSX the SingStar Mics have an empty
+ // InputName. So, we have to add a hard coded
+ // Workaround for this problem
+ if (name = '') and (Pos( 'USBMIC Serial#', deviceName) > 0) then
+ begin
+ result := 'Microphone';
+ end;
+ {$ENDIF}
+end;
+
+end.
+
+
+
diff --git a/Game/Code/Classes/UServices.pas b/Game/Code/Classes/UServices.pas new file mode 100644 index 00000000..be1fcf2c --- /dev/null +++ b/Game/Code/Classes/UServices.pas @@ -0,0 +1,326 @@ +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 UCore; + +//------------ +// Create - Creates Class and Set Standard Values +//------------ +Constructor TServiceManager.Create; +begin + FirstService := nil; + LastService := nil; + + ServiceCache[0] := nil; + ServiceCache[1] := nil; + ServiceCache[2] := nil; + ServiceCache[3] := nil; + + NextCacheItem := 0; + + NextHandle := 1; + + {$IFDEF DEBUG} + WriteLn('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} + WriteLn('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self)); + {$ENDIF} + + //Inc Next Handle + Inc(NextHandle); + end + {$IFDEF DEBUG} + else WriteLn('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} + WriteLn('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} + WriteLn('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result)); + {$ENDIF} +end; + +//------------ +// Generates the Hash for the given Name +//------------ +Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer; +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; + + +//------------ +// 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} + WriteLn('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} + WriteLn('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/Game/Code/Classes/USingNotes.pas b/Game/Code/Classes/USingNotes.pas new file mode 100644 index 00000000..f0754105 --- /dev/null +++ b/Game/Code/Classes/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/Game/Code/Classes/USingScores.pas b/Game/Code/Classes/USingScores.pas new file mode 100644 index 00000000..894f5782 --- /dev/null +++ b/Game/Code/Classes/USingScores.pas @@ -0,0 +1,990 @@ +unit USingScores; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses UThemes, + OpenGl12, + 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 Constances 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 + //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 := High(gluInt); + Settings.PopUpTex[1].TexNum := High(gluInt); + Settings.PopUpTex[2].TexNum := High(gluInt); + Settings.PopUpTex[3].TexNum := High(gluInt); + Settings.PopUpTex[4].TexNum := High(gluInt); + Settings.PopUpTex[5].TexNum := High(gluInt); + Settings.PopUpTex[6].TexNum := High(gluInt); + Settings.PopUpTex[7].TexNum := High(gluInt); + Settings.PopUpTex[8].TexNum := High(gluInt); + + Settings.RatingBar_BG_Tex.TexNum := High(gluInt); + Settings.RatingBar_FG_Tex.TexNum := High(gluInt); + Settings.RatingBar_Bar_Tex.TexNum := High(gluInt); +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 + + // TODO : JB_Lazarus - Exception=Invalid floating point operation + // AT THIS LINE ! + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-aPlayers[Cur.Player].RBTarget : ' + floattostr( aPlayers[Cur.Player].RBTarget ) ); + writeln( 'USINGSCORES-(Cur.ScoreDiff - Cur.ScoreGiven) : ' + floattostr( (Cur.ScoreDiff - Cur.ScoreGiven) ) ); + writeln( 'USINGSCORES-Cur.ScoreDiff : ' + floattostr( Cur.ScoreDiff ) ); + writeln( 'USINGSCORES-(Cur.Rating / 20 - 0.26) : ' + floattostr( (Cur.Rating / 20 - 0.26) ) ); + writeln( '' ); +*) + {$ENDIF} + + lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) ); + lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) ); + + {$IFDEF LAZARUS} +(* + writeln( 'USINGSCORES-lTempA : ' + floattostr( lTempA ) ); + writeln( 'USINGSCORES-lTempB : ' + floattostr( lTempB ) ); + writeln( '----------------------------------------------------------' ); +*) + {$ENDIF} + + 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 + + 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/Game/Code/Classes/USkins.pas b/Game/Code/Classes/USkins.pas new file mode 100644 index 00000000..e6056ee4 --- /dev/null +++ b/Game/Code/Classes/USkins.pas @@ -0,0 +1,184 @@ +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 + 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 := IncludeTrailingBackslash(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/Game/Code/Classes/USong.pas b/Game/Code/Classes/USong.pas new file mode 100644 index 00000000..39220f1c --- /dev/null +++ b/Game/Code/Classes/USong.pas @@ -0,0 +1,726 @@ +unit USong;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ELSE}
+ {$IFNDEF DARWIN}
+ syscall,
+ {$ENDIF}
+ baseunix,
+ UnixType,
+ {$ENDIF}
+ SysUtils,
+ Classes,
+ UPlatform,
+ ULog,
+ UTexture,
+ UCommon,
+ {$IFDEF DARWIN}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF USE_PSEUDO_THREAD}
+ PseudoThread,
+ {$ENDIF}
+ UCatCovers;
+
+type
+
+ TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
+
+ TBPM = record
+ BPM: real;
+ StartBeat: real;
+ end;
+
+ TScore = record
+ Name: widestring;
+ Score: integer;
+ Length: string;
+ end;
+
+ TSong = class
+ FileLineNo : integer; //Line which is readed at Last, for error reporting
+
+ procedure ParseNote(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+ procedure NewSentence(NrCzesciP: integer; Param1, Param2: integer);
+
+ function ReadTXTHeader( const aFileName : WideString ): boolean;
+ public
+ Path: widestring;
+ Folder: widestring; // for sorting by folder
+ fFileName,
+ FileName: widestring;
+
+ // sorting methods
+ Category: array of widestring; // I think I won't need this
+ Genre: widestring;
+ Edition: widestring;
+ Language: widestring; // 0.5.0: new
+
+ Title: widestring;
+ Artist: widestring;
+
+ Text: widestring;
+ Creator: widestring;
+
+ Cover: widestring;
+ CoverTex: TTexture;
+ Mp3: widestring;
+ Background: widestring;
+ Video: widestring;
+ VideoGAP: real;
+ VideoLoaded: boolean; // 0.5.0: true if the video has been loaded
+ NotesGAP: integer;
+ Start: real; // in seconds
+ Finish: integer; // in miliseconds
+ Relative: boolean;
+ Resolution: integer;
+ BPM: array of TBPM;
+ GAP: real; // in miliseconds
+
+ Score: array[0..2] of array of TScore;
+
+ // these are used when sorting is enabled
+ Visible: boolean; // false if hidden, true if visible
+ Main: boolean; // false for songs, true for category buttons
+ OrderNum: integer; // has a number of category for category buttons and songs
+ OrderTyp: integer; // type of sorting for this button (0=name)
+ CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
+
+ SongFile: TextFile; // all procedures in this unit operates on this file
+
+ Base : array[0..1] of integer;
+ Rel : array[0..1] of integer;
+ Mult : integer;
+ MultBPM : integer;
+
+ constructor create ( const aFileName : WideString );
+ function LoadSong: boolean;
+ function Analyse(): boolean;
+ procedure clear();
+ end;
+
+implementation
+
+uses
+ TextGL,
+ UIni,
+ UMusic, // needed for Czesci .. ( whatever that is )
+ UMain; //needed for Player
+
+constructor TSong.create( const aFileName : WideString );
+begin
+
+ Mult := 1;
+
+ MultBPM := 4;
+
+
+ fFileName := aFileName;
+
+
+ if fileexists( aFileName ) then
+
+ begin
+
+ self.Path := ExtractFilePath( aFileName );
+ self.Folder := ExtractFilePath( aFileName );
+ self.FileName := ExtractFileName( aFileName );
+
+(*
+
+ if ReadTXTHeader( aFileName ) then
+
+ begin
+
+ LoadSong();
+
+ end
+ else
+ begin
+ Log.LogError('Error Loading SongHeader, abort Song Loading');
+ Exit;
+ end;
+*)
+ end;
+
+end;
+
+
+function TSong.LoadSong(): boolean;
+
+var
+ TempC: char;
+ Tekst: string;
+ CP: integer; // Current Player (0 or 1)
+ Pet: 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
+ Czesci[0].Wartosc := 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, Tekst);
+ 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(Czesci, 2);
+ for Pet := 0 to High(Czesci) do begin
+ SetLength(Czesci[Pet].Czesc, 1);
+ Czesci[Pet].High := 0;
+ Czesci[Pet].Ilosc := 1;
+ Czesci[Pet].Akt := 0;
+ Czesci[Pet].Resolution := self.Resolution;
+ Czesci[Pet].NotesGAP := self.NotesGAP;
+ Czesci[Pet].Czesc[0].IlNut := 0;
+ Czesci[Pet].Czesc[0].HighNut := -1;
+ end;
+
+ // TempC := ':';
+ // TempC := Tekst[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);
+
+ // 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; // 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, Tekst);
+ self.BPM[High(self.BPM)].BPM := StrToFloat(Tekst);
+ self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
+ end;
+
+
+ if not Both then
+ begin
+ Czesci[CP].Czesc[Czesci[CP].High].BaseNote := Base[CP];
+ Czesci[CP].Czesc[Czesci[CP].High].LyricWidth := glTextWidth(PChar(Czesci[CP].Czesc[Czesci[CP].High].Lyric));
+ //Total Notes Patch
+ Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := 0;
+ for I := low(Czesci[CP].Czesc[Czesci[CP].High].Nuta) to high(Czesci[CP].Czesc[Czesci[CP].High].Nuta) do
+ begin
+ Czesci[CP].Czesc[Czesci[CP].High].TotalNotes := Czesci[CP].Czesc[Czesci[CP].High].TotalNotes + Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Dlugosc * Czesci[CP].Czesc[Czesci[CP].High].Nuta[I].Wartosc;
+ end;
+ //Total Notes Patch End
+ end else begin
+ for Pet := 0 to High(Czesci) do begin
+ Czesci[Pet].Czesc[Czesci[Pet].High].BaseNote := Base[Pet];
+ Czesci[Pet].Czesc[Czesci[Pet].High].LyricWidth := glTextWidth(PChar(Czesci[Pet].Czesc[Czesci[Pet].High].Lyric));
+ //Total Notes Patch
+ Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := 0;
+ for I := low(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) to high(Czesci[Pet].Czesc[Czesci[Pet].High].Nuta) do
+ begin
+ Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes := Czesci[Pet].Czesc[Czesci[Pet].High].TotalNotes + Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Dlugosc * Czesci[Pet].Czesc[Czesci[Pet].High].Nuta[I].Wartosc;
+ end;
+ //Total Notes Patch End
+ end;
+ end;
+
+ Read(SongFile, TempC);
+ Inc(FileLineNo);
+ end; // while}
+
+ CloseFile(SongFile);
+ except
+ try
+ CloseFile(SongFile);
+ except
+
+ end;
+
+ Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
+ exit;
+ end;
+
+ Result := true;
+end;
+
+
+function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
+
+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
+ // Replace . with ,
+ if (Pos('.', Value) <> 0) then
+ Value[Pos('.', Value)] := ',';
+
+ SetLength(self.BPM, 1);
+ self.BPM[0].StartBeat := 0;
+
+ self.BPM[0].BPM := StrtoFloatDef(Value, 0) * Mult * MultBPM;
+
+ if self.BPM[0].BPM <> 0 then
+ begin
+ //Add BPM Flag to Done
+ Done := Done or 8;
+ end;
+ end
+
+ //---------
+ //Additional Header Information
+ //---------
+
+ // Video Gap
+ else if (Identifier = 'GAP') then
+ begin
+ // Replace . with ,
+ if (Pos('.', Value) <> 0) then
+ Value[Pos('.', Value)] := ',';
+
+ self.GAP := StrtoFloatDef (Value, 0);
+ end
+
+ //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
+ begin
+ // Replace . with ,
+ if (Pos('.', Value) <> 0) then
+ Value[Pos('.', Value)] := ',';
+
+ self.VideoGAP := StrtoFloatDef (Value, 0);
+ end
+
+ //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
+ begin
+ // Replace . with ,
+ if (Pos('.', Value) <> 0) then
+ Value[Pos('.', Value)] := ',';
+
+ self.Start := StrtoFloatDef(Value, 0);
+ end
+
+ // 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(NrCzesci: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+var
+ Space: boolean;
+begin
+ case Ini.Solmization of
+ 1: // european
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' si ';
+ end;
+ end;
+ 2: // japanese
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' so ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' shi ';
+ end;
+ end;
+ 3: // american
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' ti ';
+ end;
+ end;
+ end; // case
+
+ with Czesci[NrCzesci].Czesc[Czesci[NrCzesci].High] do begin
+ SetLength(Nuta, Length(Nuta) + 1);
+ IlNut := IlNut + 1;
+ HighNut := HighNut + 1;
+ Muzyka.IlNut := Muzyka.IlNut + 1;
+
+ Nuta[HighNut].Start := StartP;
+ if IlNut = 1 then begin
+ StartNote := Nuta[HighNut].Start;
+ if Czesci[NrCzesci].Ilosc = 1 then
+ Start := -100;
+// Start := Nuta[HighNut].Start;
+ end;
+
+ Nuta[HighNut].Dlugosc := DurationP;
+ Muzyka.DlugoscNut := Muzyka.DlugoscNut + Nuta[HighNut].Dlugosc;
+
+ // back to the normal system with normal, golden and now freestyle notes
+ case TypeP of
+ 'F': Nuta[HighNut].Wartosc := 0;
+ ':': Nuta[HighNut].Wartosc := 1;
+ '*': Nuta[HighNut].Wartosc := 2;
+ end;
+
+ Czesci[NrCzesci].Wartosc := Czesci[NrCzesci].Wartosc + Nuta[HighNut].Dlugosc * Nuta[HighNut].Wartosc;
+
+ Nuta[HighNut].Ton := NoteP;
+ if Nuta[HighNut].Ton < Base[NrCzesci] then Base[NrCzesci] := Nuta[HighNut].Ton;
+ Nuta[HighNut].TonGamy := Nuta[HighNut].TonGamy mod 12;
+
+ Nuta[HighNut].Tekst := Copy(LyricS, 2, 100);
+ Lyric := Lyric + Nuta[HighNut].Tekst;
+
+ if TypeP = 'F' then
+ Nuta[HighNut].FreeStyle := true;
+
+ Koniec := Nuta[HighNut].Start + Nuta[HighNut].Dlugosc;
+ end; // with
+end;
+
+procedure TSong.NewSentence(NrCzesciP: integer; Param1, Param2: integer);
+var
+I: Integer;
+begin
+
+ // stara czesc //Alter Satz //Update Old Part
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].BaseNote := Base[NrCzesciP];
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].LyricWidth := glTextWidth(PChar(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Lyric));
+
+ //Total Notes Patch
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := 0;
+ for I := low(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) to high(Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta) do
+ begin
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes := Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].TotalNotes + Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Dlugosc * Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Nuta[I].Wartosc;
+ end;
+ //Total Notes Patch End
+
+
+ // nowa czesc //Neuer Satz //Update New Part
+ SetLength(Czesci[NrCzesciP].Czesc, Czesci[NrCzesciP].Ilosc + 1);
+ Czesci[NrCzesciP].High := Czesci[NrCzesciP].High + 1;
+ Czesci[NrCzesciP].Ilosc := Czesci[NrCzesciP].Ilosc + 1;
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].HighNut := -1;
+
+ if self.Relative then
+ begin
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1;
+ Rel[NrCzesciP] := Rel[NrCzesciP] + Param2;
+ end
+ else
+ Czesci[NrCzesciP].Czesc[Czesci[NrCzesciP].High].Start := Param1;
+
+ Base[NrCzesciP] := 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 := 0;
+ {$ENDIF}
+
+ GAP := 0;
+ Start := 0;
+ Finish := 0;
+
+ //Additional Information
+ Background := '';
+ Cover := '';
+ Video := '';
+ VideoGAP := 0;
+ NotesGAP := 0;
+ Resolution := 4;
+ Creator := '';
+
+end;
+
+function TSong.Analyse(): boolean;
+begin
+ Result := False;
+
+ //Reset LineNo
+ FileLineNo := 0;
+
+ //Open File and set File Pointer to the beginning
+ AssignFile(SongFile, self.Path + self.FileName);
+
+ try
+ Reset(SongFile);
+
+ //Clear old Song Header
+ self.clear;
+
+ //Read Header
+ Result := self.ReadTxTHeader( FileName )
+
+ //And Close File
+ finally
+ CloseFile(SongFile);
+ end;
+end;
+
+
+
+end.
diff --git a/Game/Code/Classes/USongs.pas b/Game/Code/Classes/USongs.pas new file mode 100644 index 00000000..b502f703 --- /dev/null +++ b/Game/Code/Classes/USongs.pas @@ -0,0 +1,893 @@ +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 +// Song : array of TSong; // array of songs + 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 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 Refresh; // refreshes arrays by recreating them from Songs array +// procedure Sort(Order: integer); + 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; + +{$IFDEF DARWIN} +function AnsiContainsText(const AText, ASubText: string): Boolean; +begin + Result := AnsiPos(AnsiUppercase(ASubText), AnsiUppercase(AText)) > 0; +end; +{$ENDIF} + +constructor TSongs.create(); +begin + // do not start thread BEFORE initialization (suspended = true) + inherited create( true ); + self.freeonterminate := true; + + SongList := TList.create(); + + {$ifdef MSWINDOWS} + fDirWatch := TDirectoryWatch.create(nil); + fDirWatch.OnChange := DoDirChanged; + fDirWatch.Directory := SongPath; + fDirWatch.WatchSubDirs := true; + fDirWatch.active := true; + {$ENDIF} + + {$IFDEF linux} + (* + Thankyou to : http://www.linuxjournal.com/article/8478 + http://www.tin.org/bin/man.cgi?section=2&topic=inotify_add_watch + *) +(* + fNotify := -1; + fWatch := -1; + + writeln( 'Calling inotify_init' ); + fNotify := Do_SysCall( syscall_nr_inotify_init ); + if ( fNotify < 0 ) then + writeln( 'Filesystem change notification - disabled' ); + writeln( 'Calling inotify_init : '+ inttostr(fNotify) ); + + writeln( 'Calling syscall_nr_inotify_init ('+SongPath+')' ); + fWatch := Do_SysCall( syscall_nr_inotify_init , TSysParam( fNotify ), longint( pchar( SongPath ) ) , IN_MODIFY AND IN_CREATE AND IN_DELETE ); + + if (fWatch < 0) then + writeln ('inotify_add_watch'); + writeln( 'Calling syscall_nr_inotify_init : '+ inttostr(fWatch) ); +*) + {$endif} + + // now we can start the thread + Resume(); +end; + +destructor TSongs.destroy(); +begin + freeandnil( SongList ); +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 self.terminated do + begin + + if fParseSongDirectory then + begin + writeln( 'int_LoadSongList' ); + int_LoadSongList(); + end; + + self.suspend; + end; +{$ENDIF} +end; + +procedure TSongs.int_LoadSongList; +const + cUSNGPath = '/usr/share/games/ultrastar-ng/songs'; +begin + try + fProcessing := true; + + Log.LogError('SongList', 'Searching For Songs'); + + // browse directories + BrowseDir(SongPath); + + if UserSongPath <> SongPath then + BrowseDir(UserSongPath); + + if ( cUSNGPath <> SongPath ) AND + ( cUSNGPath <> UserSongPath ) then + BrowseDir( cUSNGPath ); // todo : JB this is REAL messy, + // we should have some sort of path manager that lets us specify X number of extra paths to search + + 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.LogError('SongList', 'Search Complete'); + + fParseSongDirectory := false; + fProcessing := false; + end; +end; + + +procedure TSongs.LoadSongList; +begin + fParseSongDirectory := true; + self.resume; +end; + +procedure TSongs.BrowseDir(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 + BrowseDir( Dir + Files[i].Name + PathDelim ); + end + else + begin + lSong := TSong.create( Dir + Files[i].Name ); + + if NOT lSong.Analyse then + begin + Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".'); + freeandnil( lSong ); + end + else + begin + SongList.add( lSong ); + end; + + end; + end; + SetLength( Files, 0); +end; + +procedure TSongs.Sort(Order: integer); +var + S: integer; + S2: integer; + TempSong: TSong; +begin + case Order of + sEdition: // by edition + begin + for S2 := 0 to SongList.Count -1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Edition, TSong( SongList[S-1] ).Edition) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sGenre: // by genre + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Genre, TSong( SongList[S-1] ).Genre) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle: // by title + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist: // by artist + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sFolder: // by folder + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Folder, TSong( SongList[S-1] ).Folder) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sTitle2: // by title2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Title, TSong( SongList[S-1] ).Title) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + + end; + sArtist2: // by artist2 + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Artist, TSong( SongList[S-1] ).Artist) < 0 then + begin + // zamiana miejscami + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + sLanguage: // by Language + begin + for S2 := 0 to SongList.Count-1 do + for S := 1 to SongList.Count-1 do + if CompareText(TSong( SongList[S] ).Language, TSong( SongList[S-1] ).Language) < 0 then + begin + TempSong := SongList[S-1]; + SongList[S-1] := SongList[S]; + SongList[S] := TempSong; + end; + end; + + end; // case +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.Refresh; +var + S: integer; // temporary song index + CatLen: integer; // length of CatSongs.Song + Letter: char; // current letter for sorting using letter + SS: string; // current edition for sorting using edition, genre etc. + Order: integer; // number used for ordernum + Letter2: char; // + CatNumber:integer; // Number of Song in Category +begin + CatNumShow := -1; +// Songs.Sort(0); // by title + +case Ini.Sorting of + sEdition: begin + Songs.Sort(sArtist); + Songs.Sort(sEdition); + end; + sGenre: begin + Songs.Sort(sArtist); + Songs.Sort(sGenre); + end; + sLanguage: begin + Songs.Sort(sArtist); + Songs.Sort(sLanguage); + end; + sFolder: begin + Songs.Sort(sArtist); + Songs.Sort(sFolder); + end; + sTitle: Songs.Sort(sTitle); + sArtist: Songs.Sort(sArtist); + sTitle2: Songs.Sort(sTitle2); // by title2 + sArtist2: Songs.Sort(sArtist2); // by artist2 + + end; // case + + + Letter := ' '; + SS := ''; + Order := 0; + CatNumber := 0; + + //Songs leeren + SetLength (Song, 0); + + for S := 0 to Songs.SongList.Count-1 do + begin + if (Ini.Tabs = 1) then + if (Ini.Sorting = sEdition) and (CompareText(SS, TSong( Songs.SongList[S] ).Edition) <> 0) then begin + // add Category Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Edition; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + SS + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + + + // 0.4.3 + // if SS = 'Singstar' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Part 2' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar German' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Spanish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Italian' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar French' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar.jpg'; + // if SS = 'Singstar Party' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Party.jpg'; + // if SS = 'Singstar Popworld' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Popworld.jpg'; + // if SS = 'Singstar 80s' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar 80s Polish' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar 80s.jpg'; + // if SS = 'Singstar Rocks' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Rocks.jpg'; + // if SS = 'Singstar Anthems' then CatSongs.Song[CatLen].Cover := CoversPath + 'Singstar Anthems.jpg'; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';//} + + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sGenre) and (CompareText(SS, TSong( Songs.SongList[S] ).Genre) <> 0) then begin + // add Genre Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Genre; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sLanguage) and (CompareText(SS, TSong( Songs.SongList[S] ).Language) <> 0) then begin + // add Language Button + Inc(Order); + SS := TSong( Songs.SongList[S] ).Language; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle) and + (Length(TSong( Songs.SongList[S] ).Title)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Title)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := Uppercase(TSong( Songs.SongList[S] ).Title)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sArtist) and (Length(TSong( Songs.SongList[S] ).Artist)>=1) and + (Letter <> UpperCase(TSong( Songs.SongList[S] ).Artist)[1]) then begin + // add a letter Category Button + Inc(Order); + Letter := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sFolder) and (CompareText(SS, TSong( Songs.SongList[S] ).Folder) <> 0) then begin + // 0.5.0: add folder tab + Inc(Order); + SS := TSong( Songs.SongList[S] ).Folder; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := SS; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + SS + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + SS + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, SS); + + //CatNumber Patch + if (SS <> '') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end + + else if (Ini.Sorting = sTitle2) AND (Length(TSong( Songs.SongList[S] ).Title)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Title[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Title[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Title)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Title' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Title' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end + + else if (Ini.Sorting = sArtist2) AND (Length(TSong( Songs.SongList[S] ).Artist)>=1) then begin + if (ord(TSong( Songs.SongList[S] ).Artist[1]) > 47) and (ord(TSong( Songs.SongList[S] ).Artist[1]) < 58) then Letter2 := '#' else Letter2 := UpperCase(TSong( Songs.SongList[S] ).Artist)[1]; + if (Letter <> Letter2) then begin + // add a letter Category Button + Inc(Order); + Letter := Letter2; + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + CatSongs.Song[CatLen].Artist := '[' + Letter + ']'; + CatSongs.Song[CatLen].Main := true; + CatSongs.Song[CatLen].OrderTyp := 0; +// Order := ord(Letter); + CatSongs.Song[CatLen].OrderNum := Order; + + {// cover-patch + if FileExists(CoversPath + 'Artist' + Letter + '.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'Artist' + Letter + '.jpg' + else if FileExists(CoversPath + 'NoCover.jpg') then CatSongs.Song[CatLen].Cover := CoversPath + 'NoCover.jpg';} + CatSongs.Song[CatLen].Cover := CatCovers.GetCover(Ini.Sorting, Letter); + + //CatNumber Patch + if (Letter <> ' ') then + begin + Song[CatLen - CatNumber - 1].CatNumber := CatNumber;//Set CatNumber of Categroy + CatNumber := 0; + end; + + CatSongs.Song[CatLen].Visible := true; + end; + end; + + + CatLen := Length(CatSongs.Song); + SetLength(CatSongs.Song, CatLen+1); + + Inc (CatNumber); //Increase Number in Cat + + CatSongs.Song[CatLen] := TSong( Songs.SongList[S] ); + CatSongs.Song[CatLen].OrderNum := Order; // assigns category + CatSongs.Song[CatLen].CatNumber := CatNumber; + + if (Ini.Tabs = 0) then CatSongs.Song[CatLen].Visible := true + else if (Ini.Tabs = 1) then CatSongs.Song[CatLen].Visible := false; +// if (Ini.Tabs = 1) and (Order = 1) then CatSongs.Song[CatLen].Visible := true; // open first tab +//CatSongs.Song[CatLen].Visible := true; + + end; +//CatNumber Patch - Set CatNumber of Last Category +if (ini.Tabs_at_startup = 1) And (high(Song) >=1) then + Song[CatLen - CatNumber].CatNumber := CatNumber;//Set CatNumber of Categroy +//CatCount Patch +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; + 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 begin + if CatSongs.Song[S].Main then + CatSongs.Song[S].Visible := true + else + CatSongs.Song[S].Visible := false + end; + 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 + +function TCatSongs.VisibleSongs: integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to high(CatSongs.Song) do + if CatSongs.Song[S].Visible = true then Inc(Result); +end; + +function TCatSongs.VisibleIndex(Index: integer): integer; +var + S: integer; // song +begin + Result := 0; + for S := 0 to Index-1 do + if CatSongs.Song[S].Visible = true then Inc(Result); +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/Game/Code/Classes/UTextClasses.pas b/Game/Code/Classes/UTextClasses.pas new file mode 100644 index 00000000..a09456b8 --- /dev/null +++ b/Game/Code/Classes/UTextClasses.pas @@ -0,0 +1,60 @@ +unit UTextClasses;
+
+interface
+
+{$I switches.inc}
+
+uses OpenGL12,
+ SDL,
+ UTexture,
+ Classes,
+ dialogs,
+ 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/Game/Code/Classes/UTexture.pas b/Game/Code/Classes/UTexture.pas new file mode 100644 index 00000000..deff8b94 --- /dev/null +++ b/Game/Code/Classes/UTexture.pas @@ -0,0 +1,1174 @@ +unit UTexture; +// added for easier debug disabling +{$undef blindydebug} + +// Plain (alpha = 1) +// Transparent +// Colorized + +// obsolete? +// Transparent Range +// Font (white is drawn, black is transparent) +// Font Outline (Font with darker outline) +// Font Outline 2 (Font with darker outline) +// Font Black (black is drawn, white is transparent) +// Font Gray (gray is drawn, white is transparent) +// Arrow (for arrows, white is white, gray has color, black is transparent); + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses OpenGL12, + {$IFDEF win32} + windows, + {$ENDIF} + Math, + Classes, + SysUtils, + Graphics, + UCommon, + UThemes, + SDL, + sdlutils, + SDL_Image; + +type + TTexture = record + TexNum: integer; + X: real; + Y: real; + Z: real; // new + 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; // used? + TexH: real; // used? + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + Alpha: real; + Name: string; // 0.5.0: experimental for handling cache images. maybe it's useful for dynamic skins + end; + + TTextureEntry = record + Name: string; + Typ: string; + + // we use normal TTexture, it's easier to implement and if needed - we copy ready data + Texture: TTexture; + TextureCache: TTexture; // 0.5.0 + end; + + TTextureDatabase = record + Texture: array of TTextureEntry; + end; + + TTextureUnit = class + + private + function LoadImage(Identifier: PChar): PSDL_Surface; + function pixfmt_eq(fmt1,fmt2: PSDL_Pixelformat): boolean; + procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); + function GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; + procedure ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); + procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + + public + Limit: integer; + CreateCacheMipmap: boolean; + +// function GetNumberFor + function GetTexture(Name, Typ: string): TTexture; overload; + function GetTexture(Name, Typ: string; FromCache: boolean): TTexture; overload; + function FindTexture(Name: string): integer; + function LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; overload; + function LoadTexture(Identifier: string): TTexture; overload; + function CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; + procedure UnloadTexture(Name: string; FromCache: boolean); + Constructor Create; + Destructor Destroy; override; + end; + +var + Texture: TTextureUnit; + TextureDatabase: TTextureDatabase; + + // this should be in UDisplay?! + PrintScreenData: array[0..1024*768-1] of longword; + + ActTex: GLuint;//integer; + +// TextureD8: array[1..1024*1024] of byte; // 1MB + TextureD16: array[1..1024*1024, 1..2] of byte; // luminance/alpha tex (2MB) +// TextureD24: array[1..1024*1024, 1..3] of byte; // normal 24-bit tex (3MB) +// TextureD242: array[1..512*512, 1..3] of byte; // normal 24-bit tex (0,75MB) +// TextureD32: array[1..1024*1024, 1..4] of byte; // transparent 32-bit tex (4MB) + // total 40MB at 2048*2048 + // total 10MB at 1024*1024 + + Mipmapping: Boolean; + + CacheMipmap: array[0..256*256*3-1] of byte; // 3KB + CacheMipmapSurface: PSDL_Surface; + + +implementation + +uses ULog, + DateUtils, + UCovers, + {$ifdef FPC} + fileutil, + {$endif} + {$IFDEF LAZARUS} + LResources, + {$ENDIF} + {$IFDEF DARWIN} + MacResources, + {$ENDIF} + StrUtils, dialogs; + +const + fmt_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); + fmt_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); + + +Constructor TTextureUnit.Create; +begin + inherited Create; +end; + +Destructor TTextureUnit.Destroy; +begin + inherited Destroy; +end; + +function TTextureUnit.pixfmt_eq(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; + +// +++++++++++++++++++++ helpers for loadimage +++++++++++++++ + 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; +// ----------------------------------------------- + +function TTextureUnit.LoadImage(Identifier: PChar): PSDL_Surface; + + function FileExistsInsensative( var aFileName : PChar ): boolean; + begin +{$IFDEF fpc} + result := true; + + if FileExists( aFileName ) then + exit; + + aFileName := pchar( FindDiskFileCaseInsensitive( aFileName ) ); + result := FileExists( aFileName ); +{$ELSE} + result := FileExists( aFileName ); +{$ENDIF} + end; + +var + + TexRWops: PSDL_RWops; + dHandle: THandle; + + {$IFDEF LAZARUS} + lLazRes : TLResource; + lResData : TStringStream; + {$ELSE} + TexStream: TStream; + {$ENDIF} + + lFileName : pchar; + +begin + Result := nil; + TexRWops := nil; + + if Identifier = '' then + exit; + + lFileName := Identifier; + +// Log.LogStatus( Identifier, 'LoadImage' ); + + Log.LogStatus( 'Looking for File ( Loading : '+Identifier+' - '+ FindDiskFileCaseInsensitive(Identifier) +')', ' LoadImage' ); + + if ( FileExistsInsensative(lFileName) ) then + begin + // load from file + Log.LogStatus( 'Is File ( Loading : '+lFileName+')', ' LoadImage' ); + try + Result:=IMG_Load(lFileName); + Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' ); + except + Log.LogStatus( 'ERROR Could not load from file' , Identifier); + beep; + Exit; + end; + end + else + begin + Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' ); + + // load from resource stream + {$IFDEF LAZARUS} + lLazRes := LazFindResource( Identifier, 'TEX' ); + if lLazRes <> nil then + begin + lResData := TStringStream.create( lLazRes.value ); + try + lResData.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown( lResData ); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource ('+Identifier+')' , Identifier); + beep; + Exit; + end; + + Result := IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + finally + freeandnil( lResData ); + end; + end + else + begin + Log.LogStatus( 'NOT found in Resource ('+Identifier+')', ' LoadImage' ); + end; + {$ELSE} + dHandle := FindResource(hInstance, Identifier, 'TEX'); + if dHandle=0 then + begin + Log.LogStatus( 'ERROR Could not find resource' , ' '+ Identifier); + beep; + Exit; + end; + + + TexStream := nil; + try + TexStream := TResourceStream.Create(HInstance, Identifier, 'TEX'); + except + Log.LogStatus( 'ERROR Could not load from resource' , Identifier); + beep; + Exit; + end; + + try + TexStream.position := 0; + try + TexRWops := SDL_AllocRW; + TexRWops.unknown := TUnknown(TexStream); + TexRWops.seek := SDLStreamSeek; + TexRWops.read := SDLStreamRead; + TexRWops.write := nil; + TexRWops.close := SDLStreamClose; + TexRWops.type_ := 2; + except + Log.LogStatus( 'ERROR Could not assign resource' , Identifier); + beep; + Exit; + end; + + Log.LogStatus( 'resource Assigned....' , Identifier); + Result:=IMG_Load_RW(TexRWops,0); + SDL_FreeRW(TexRWops); + + finally + if assigned( TexStream ) then + freeandnil( TexStream ); + end; + {$ENDIF} + end; +end; + +procedure TTextureUnit.AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: PChar); +var + TempSurface: PSDL_Surface; + NeededPixFmt: PSDL_Pixelformat; +begin + NeededPixFmt:=@fmt_rgba; + if Typ= 'Plain' then NeededPixFmt:=@fmt_rgb + else + if (Typ='Transparent') or + (Typ='Colorized') + then NeededPixFmt:=@fmt_rgba + else + NeededPixFmt:=@fmt_rgb; + + + if not pixfmt_eq(TexSurface^.format, NeededPixFmt) then + begin + TempSurface:=TexSurface; + TexSurface:=SDL_ConvertSurface(TempSurface,NeededPixFmt,SDL_SWSURFACE); + SDL_FreeSurface(TempSurface); + end; +end; + +function TTextureUnit.GetScaledTexture(TexSurface: PSDL_Surface; W,H: Cardinal): PSDL_Surface; +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + Result:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); +end; + +procedure TTextureUnit.ScaleTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + TexSurface:=SDL_ScaleSurfaceRect(TempSurface, + 0,0,TempSurface^.W,TempSurface^.H, + W,H); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.FitTexture(var TexSurface: PSDL_Surface; W,H: Cardinal); +var + TempSurface: PSDL_Surface; +begin + TempSurface:=TexSurface; + with TempSurface^.format^ do + TexSurface:=SDL_CreateRGBSurface(SDL_SWSURFACE,W,H,BitsPerPixel,RMask, GMask, BMask, AMask); + SDL_SetAlpha(TexSurface, 0, 255); + SDL_SetAlpha(TempSurface, 0, 255); + SDL_BlitSurface(TempSurface,nil,TexSurface,nil); + SDL_FreeSurface(TempSurface); +end; + +procedure TTextureUnit.ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal); + //returns hue within range [0.0-6.0) + function col2h(Color:Cardinal):double; + var + clr,hls: array[0..2] of double; + delta: double; + begin + clr[0]:=((Color and $ff0000) shr 16)/255; + clr[1]:=((Color and $ff00) shr 8)/255; + clr[2]:=(Color and $ff)/255; + hls[1]:=maxvalue(clr); + delta:=hls[1]-minvalue(clr); + // this is for safety reasons + if delta = 0.0 then delta:=0.000000000001; + if clr[0]=hls[1] then hls[0]:=(clr[1]-clr[2])/delta + else if clr[1]=hls[1] then hls[0]:=2.0+(clr[2]-clr[0])/delta + else if clr[2]=hls[1] then hls[0]:=4.0+(clr[0]-clr[1])/delta; + if hls[0]<0.0 then hls[0]:=hls[0]+6.0; + if hls[0]=6.0 then hls[0]:=0.0; + col2h:=hls[0]; + end; + procedure ColorizePixel(Pix: PByteArray; hue: Double); + var + i,j,k: Cardinal; + clr, hls: array[0..2] of Double; + delta, f, p, q, t: Double; + begin + hls[0]:=hue; + + clr[0] := Pix[0]/255; + clr[1] := Pix[1]/255; + clr[2] := Pix[2]/255; + + //calculate luminance and saturation from rgb + hls[1] := maxvalue(clr); //l:=... + delta := hls[1] - minvalue(clr); + + if hls[1] = 0.0 then + hls[2] := 0.0 + else + hls[2] := delta/hls[1]; //v:=... + + // calc new rgb from our hls (h from color, l ans s from pixel) + // if (hls[1]<>0.0) and (hls[2]<>0.0) then // only if colorizing makes sense + begin + k:=trunc(hls[0]); + f:=hls[0]-k; + p:=hls[1]*(1.0-hls[2]); + q:=hls[1]*(1.0-(hls[2]*f)); + t:=hls[1]*(1.0-(hls[2]*(1.0-f))); + case k of + 0: begin clr[0]:=hls[1]; clr[1]:=t; clr[2]:=p; end; + 1: begin clr[0]:=q; clr[1]:=hls[1]; clr[2]:=p; end; + 2: begin clr[0]:=p; clr[1]:=hls[1]; clr[2]:=t; end; + 3: begin clr[0]:=p; clr[1]:=q; clr[2]:=hls[1]; end; + 4: begin clr[0]:=t; clr[1]:=p; clr[2]:=hls[1]; end; + 5: begin clr[0]:=hls[1]; clr[1]:=p; clr[2]:=q; end; + end; + // and store new rgb back into the image + Pix[0]:=floor(255*clr[0]); + Pix[1]:=floor(255*clr[1]); + Pix[2]:=floor(255*clr[2]); + end; + end; + +var + DestinationHue: Double; + PixelIndex: Cardinal; +begin + DestinationHue:=col2h(Col); + for PixelIndex:=0 to (TexSurface^.W*TexSurface^.H -1) do + ColorizePixel(@(PByteArray(TexSurface^.Pixels)[PixelIndex*TexSurface^.format.BytesPerPixel]),DestinationHue); +end; + +function TTextureUnit.LoadTexture(FromRegistry: boolean; Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +var + TexSurface: PSDL_Surface; + MipmapSurface: PSDL_Surface; + newWidth, newHeight: Cardinal; + oldWidth, oldHeight: Cardinal; + kopierindex: Cardinal; +begin + Log.BenchmarkStart(4); + Mipmapping := true; +(* + Log.LogStatus( '', '' ); + + if Identifier = nil then + Log.LogStatus(' ERROR unknown Identifier', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+'''') + else + Log.LogStatus(' should be ok - trying to load', 'Id:'''+Identifier+''' Fmt:'''+Format+''' Typ:'''+Typ+''''); +*) + + // load texture data into memory + {$ifdef blindydebug} + Log.LogStatus('',' ----------------------------------------------------'); + Log.LogStatus('',' LoadImage('''+Identifier+''') (called by '+Format+')'); + {$endif} + TexSurface := LoadImage(Identifier); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + if not assigned(TexSurface) then + begin + Log.LogStatus( 'ERROR Could not load texture' , Identifier +' '+ Format +' '+ Typ ); + beep; + Exit; + end; + + // convert pixel format as needed + {$ifdef blindydebug} + Log.LogStatus('',' AdjustPixelFormat'); + {$endif} + AdjustPixelFormat(TexSurface, Typ); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + // 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 + begin + {$ifdef blindydebug} + Log.LogStatus('',' ScaleTexture'); + {$endif} + ScaleTexture(TexSurface,newWidth,newHeight); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : typ='+Typ); + {$endif} + + + + // don't actually understand, if this is needed... + // this should definately be changed... together with all this + // cover cache stuff + if (CreateCacheMipmap) and (Typ='Plain') then + begin + {$ifdef blindydebug} + Log.LogStatus('',' JB-1 : Minimap'); + {$endif} + + if (Covers.W <= 256) and (Covers.H <= 256) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' GetScaledTexture('''+inttostr(Covers.W)+''','''+inttostr(Covers.H)+''') (for CacheMipmap)'); + {$endif} + MipmapSurface:=GetScaledTexture(TexSurface,Covers.W, Covers.H); + if assigned(MipmapSurface) then + begin + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' BlitSurface Stuff'); + {$endif} + // creating and freeing the surface could be done once, if Cover.W and Cover.H don't change + CacheMipmapSurface:=SDL_CreateRGBSurfaceFrom(@CacheMipmap[0], Covers.W, Covers.H, 24, Covers.W*3, $000000ff, $0000ff00, $00ff0000, 0); + SDL_BlitSurface(MipMapSurface,nil,CacheMipmapSurface,nil); + SDL_FreeSurface(CacheMipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + Log.LogStatus('',' SDL_FreeSurface (CacheMipmap)'); + {$endif} + SDL_FreeSurface(MipmapSurface); + {$ifdef blindydebug} + Log.LogStatus('',' ok'); + {$endif} + end + else + begin + Log.LogStatus(' Error creating CacheMipmap',' LoadTexture('''+Identifier+''')'); + end; + end; + // should i create a cache texture, if Covers.W/H are larger? + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-2'); + {$endif} + + + // now we might colorize the whole thing + if Typ='Colorized' then + ColorizeTexture(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 + FitTexture(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 + + {$ifdef blindydebug} + Log.LogStatus('',' JB-3'); + {$endif} + + + // 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 + + // JB_linux : this is causing AV's on linux... ActText seems to be nil ! +// {$IFnDEF win32} +// if pointer(ActTex) = nil then +// exit; +// {$endif} + + 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 = 'Transparent') or + (Typ='Colorized') then + begin + glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); + end + {if Typ = 'Plain' then} else + begin + glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); + end; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-4'); + {$endif} + +{ + if Typ = 'Transparent Range' then + // set alpha to 256-green-component (not sure) + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TexNewW + Position2+1, 1] := Pix; + TextureD32[Position*TexNewW + Position2+1, 2] := Pix div 256; + TextureD32[Position*TexNewW + Position2+1, 3] := Pix div (256*256); + TextureD32[Position*TexNewW + Position2+1, 4] := 256 - Pix div 256; +} +{ + if Typ = 'Font' then + // either create luminance-alpha texture + // or use transparency from differently saved file + // or do something totally different (text engine with ttf) + Pix := PPix[Position2 * 3]; + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := Pix; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); +} +{ + if Typ = 'Font Outline' then + // no idea... + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 127 then Col := 127; + + TempA := Pix; + if TempA >= 95 then TempA := 255; + if TempA >= 31 then TempA := 255; + if Pix < 95 then TempA := (Pix * 256) div 96; + + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + end; +} +{ + if Typ = 'Font Outline 2' then + // same as above + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + Col := Pix; + if Col < 31 then Col := 31; + + TempA := Pix; + if TempA >= 31 then TempA := 255; + if Pix < 31 then TempA := Pix * (256 div 32); + + TextureD16[Position*TextureB.Width + Position2 + 1, 1] := Col; + TextureD16[Position*TextureB.Width + Position2 + 1, 2] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 2, TextureB.Width, TextureB.Height, 0, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 2, TextureB.Width, TextureB.Height, GL_LUMINANCE_ALPHA, GL_UNSIGNED_BYTE, @TextureD16); + if Error > 0 then beep; + end; + end; + + if Typ = 'Font Black' then + // and so on + begin + // normalnie 0,125s bez niczego 0,015s - 0,030s z pix 0,125s <-- ??? + // dimensions + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 255; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Alpha Black Colored' then + // ... hope, noone needs this + begin + TextureB.PixelFormat := pf24bit; + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2*3]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := (Col div $10000) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Col div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Col and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Font Gray' then + begin + // dimensions + TexOrigW := TextureB.Width; + TexOrigH := TextureB.Height; + TexNewW := Round(Power(2, Ceil(Log2(TexOrigW)))); + TexNewH := Round(Power(2, Ceil(Log2(TexOrigH)))); + TextureB.Width := TexNewW; + TextureB.Height := TexNewH; + // copy and process pixeldata + for Position := 0 to TextureB.Height-1 do begin + for Position2 := 0 to TextureB.Width-1 do begin + Pix := TextureB.Canvas.Pixels[Position2, Position]; + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := 127; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := 255 - (Pix mod 256); + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; + + if Typ = 'Arrow' then + begin + TextureB.PixelFormat := pf24bit; + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + Pix := PPix[Position2 * 3]; + + // transparency + if Pix >= 127 then TempA := 255; + if Pix < 127 then TempA := Pix * 2; + + // ColInt = color intensity + if Pix < 127 then ColInt := 1; + if Pix >= 127 then ColInt := 2 - Pix / 128; + //0.75, 0.6, 0.25 + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Round(ColInt * 0.75 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := Round(ColInt * 0.6 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Round(ColInt * 0.25 * 255 + (1 - ColInt) * 255); + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + + if Mipmapping then glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR_MIPMAP_LINEAR); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 4, TextureB.Width, TextureB.Height, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + if Error > 0 then beep; + end; + end; + + if Typ = 'Note Plain' then + begin + for Position := 0 to TextureB.Height-1 do + begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do + begin + + + + // Skin Patch + // 0-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0. Original +// case PPix[Position2*3] of +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + + TextureD24[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD24[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD24[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 3, TextureB.Width, TextureB.Height, 0, GL_RGB, GL_UNSIGNED_BYTE, @TextureD24); + end; + + if Typ = 'Note Transparent' then + begin + for Position := 0 to TextureB.Height-1 do begin + PPix := TextureB.ScanLine[Position]; + for Position2 := 0 to TextureB.Width-1 do begin + TempA := 255; + + + + //Skin Patch + // 0= Transparent, 1-191= Fade Black to Col, 192= Col, 193-254 Fade Col to White, 255= White + case PPix[Position2*3] of + 0: TempA := 0; + 1..191: Pix := $10000 * ((((Col div $10000) and $FF) * PPix[Position2*3]) div $Bf) + $100 * ((((Col div $100) and $FF) * PPix[Position2*3]) div $Bf) + (((Col and $FF) * PPix[Position2*3]) div $Bf); + 192: Pix := Col; + 193..254: Pix := Col + ($10000 * ((($FF - ((Col div $10000) and $FF)) * ((PPix[Position2*3] - $C0) * 4) ) div $FF) + $100 * ((($FF - ((Col div $100) and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF) + ((($FF - (Col and $FF)) * ((PPix[Position2*3] - $C0) * 4)) div $FF)); + 255: Pix := $FFFFFF; + end; +// 0.5.0 Original +// case PPix[Position2*3] of +// 0: TempA := 0; +// 128: Pix := $10000 * ((Col div $10000) div 2) + $100 * (((Col div $100) and $FF) div 2) + (Col and $FF) div 2; +// 192: Pix := Col; +// 255: Pix := $FFFFFF; +// end; + + + + + TextureD32[Position*TextureB.Width + Position2 + 1, 1] := Pix div $10000; + TextureD32[Position*TextureB.Width + Position2 + 1, 2] := (Pix div $100) and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 3] := Pix and $FF; + TextureD32[Position*TextureB.Width + Position2 + 1, 4] := TempA; + end; + end; + glTexImage2D(GL_TEXTURE_2D, 0, 4, TextureB.Width, TextureB.Height, 0, GL_RGBA, GL_UNSIGNED_BYTE, @TextureD32); + end; +} + + {$ifdef blindydebug} + Log.LogStatus('',' JB-5'); + {$endif} + + + 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 := oldWidth / newWidth; + Result.TexH := oldHeight / newHeight; + + Result.Int := 1; + Result.ColR := 1; + Result.ColG := 1; + Result.ColB := 1; + Result.Alpha := 1; + + // 0.4.2 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; + + {$ifdef blindydebug} + Log.LogStatus('',' JB-6'); + {$endif} + + + // 0.5.0 + Result.Name := Identifier; + + SDL_FreeSurface(TexSurface); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-7'); + {$endif} + + + Log.BenchmarkEnd(4); + if Log.BenchmarkTimeLength[4] >= 1 then + Log.LogBenchmark('**********> Texture Load Time Warning - ' + Format + '/' + Identifier + '/' + Typ, 4); + + {$ifdef blindydebug} + Log.LogStatus('',' JB-8'); + {$endif} + +end; + + +function TTextureUnit.GetTexture(Name, Typ: string): TTexture; +begin + Result := GetTexture(Name, Typ, true); +end; + +function TTextureUnit.GetTexture(Name, Typ: string; FromCache: boolean): TTexture; +var + T: integer; // texture + C: integer; // cover + Data: array of byte; +begin + + if Name = '' then + exit; + + // find texture entry + T := FindTexture(Name); + + if T = -1 then + begin + // create texture entry + T := Length(TextureDatabase.Texture); + SetLength(TextureDatabase.Texture, T+1); + + TextureDatabase.Texture[T].Name := Name; + TextureDatabase.Texture[T].Typ := Typ; + + // inform database that no textures have been loaded into memory + TextureDatabase.Texture[T].Texture.TexNum := -1; + TextureDatabase.Texture[T].TextureCache.TexNum := -1; + end; + + // use preloaded texture + if (not FromCache) or (FromCache and not Covers.CoverExists(Name)) then + begin + // use full texture + if TextureDatabase.Texture[T].Texture.TexNum = -1 then + begin + // load texture + {$ifdef blindydebug} + Log.LogStatus('...', 'GetTexture('''+Name+''','''+Typ+''')'); + {$endif} + TextureDatabase.Texture[T].Texture := LoadTexture(false, pchar(Name), 'JPG', pchar(Typ), $0); + {$ifdef blindydebug} + Log.LogStatus('done',' '); + {$endif} + end; + + // use texture + Result := TextureDatabase.Texture[T].Texture; + end; + + if FromCache and Covers.CoverExists(Name) then + begin + // use cache texture + C := Covers.CoverNumber(Name); + + if TextureDatabase.Texture[T].TextureCache.TexNum = -1 then + begin + // load texture + Covers.PrepareData(Name); + TextureDatabase.Texture[T].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[C].W, Covers.Cover[C].H, 24); + end; + + // use texture + Result := TextureDatabase.Texture[T].TextureCache; + end; +end; + +function TTextureUnit.FindTexture(Name: string): integer; +var + T: integer; // texture +begin + Result := -1; + for T := 0 to high(TextureDatabase.Texture) do + if TextureDatabase.Texture[T].Name = Name then + Result := T; +end; + +function TTextureUnit.LoadTexture(Identifier, Format, Typ: PChar; Col: LongWord): TTexture; +begin + Result := LoadTexture(false, Identifier, Format, Typ, Col); +end; + +function TTextureUnit.LoadTexture(Identifier: string): TTexture; +begin + Result := LoadTexture(false, pchar(Identifier), 'JPG', 'Plain', 0); +end; + +function TTextureUnit.CreateTexture(var Data: array of byte; Name: string; W, H: word; Bits: byte): TTexture; +var + Position: integer; + Position2: integer; + Pix: integer; + ColInt: real; + PPix: PByteArray; + TempA: integer; + Error: integer; +begin + Mipmapping := false; + + 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, W, H, 0, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Mipmapping then begin + Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); + if Error > 0 then beep; + end; + + Result.X := 0; + Result.Y := 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; + + // 0.4.2 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; + + // 0.5.0 + Result.Name := Name; +end; + +procedure TTextureUnit.UnloadTexture(Name: string; FromCache: boolean); +var + T: integer; + TexNum: GLuint; +begin + T := FindTexture(Name); + + if not FromCache then begin + TexNum := TextureDatabase.Texture[T].Texture.TexNum; + if TexNum >= 0 then begin + glDeleteTextures(1, @TexNum); + TextureDatabase.Texture[T].Texture.TexNum := -1; +// 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 := -1; +// Log.LogError('Unload texture cache no '+IntToStr(TexNum)); + end; + end; +end; + +{$IFDEF LAZARUS} +initialization + {$I UltraStar.lrs} +{$ENDIF} + + +end. diff --git a/Game/Code/Classes/UThemes.pas b/Game/Code/Classes/UThemes.pas new file mode 100644 index 00000000..bfffb26a --- /dev/null +++ b/Game/Code/Classes/UThemes.pas @@ -0,0 +1,2313 @@ +unit UThemes; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +uses + ULog, + IniFiles, + SysUtils, + Classes; + +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: string; + TexX1: real; + TexY1: real; + TexX2: real; + TexY2: real; + //Reflection Mod + Reflection: boolean; + Reflectionspacing: Real; + end; + AThemeStatic = array of TThemeStatic; + + TThemeText = record + X: integer; + Y: integer; + W: integer; + Color: string; + ColR: real; + ColG: real; + ColB: real; + Font: integer; + Size: integer; + Align: integer; + Text: string; + 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: string; + + 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; + + TThemeSelect = record + Tex: string; + TexSBG: string; + X: integer; + Y: integer; + W: integer; + H: 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; + + 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; + 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: TThemeSelect; + SelectDifficulty: TThemeSelect; + SelectLanguage: TThemeSelectSlide; + SelectTabs: TThemeSelect; + SelectSorting: TThemeSelectSlide; + SelectDebug: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsGraphics = class(TThemeBasic) + SelectFullscreen: TThemeSelect; + SelectSlideResolution: TThemeSelectSlide; + SelectDepth: TThemeSelect; + SelectOscilloscope: TThemeSelect; + SelectLineBonus: TThemeSelect; + SelectMovieSize: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsSound = class(TThemeBasic) + SelectMicBoost: TThemeSelect; + SelectClickAssist: TThemeSelect; + SelectBeatClick: TThemeSelect; + SelectThreshold: TThemeSelect; + //Song Preview + SelectSlidePreviewVolume: TThemeSelectSlide; + SelectSlidePreviewFading: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsLyrics = class(TThemeBasic) + SelectLyricsFont: TThemeSelect; + SelectLyricsEffect: TThemeSelect; + SelectSolmization: TThemeSelect; + ButtonExit: TThemeButton; + end; + + TThemeOptionsThemes = class(TThemeBasic) + SelectTheme: TThemeSelectSlide; + SelectSkin: TThemeSelectSlide; + SelectColor: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsRecord = class(TThemeBasic) + SelectSlideCard: TThemeSelectSlide; + SelectSlideInput: TThemeSelectSlide; + SelectSlideChannelL: TThemeSelectSlide; + SelectSlideChannelR: TThemeSelectSlide; + ButtonExit: TThemeButton; + end; + + TThemeOptionsAdvanced = class(TThemeBasic) + SelectLoadAnimation: TThemeSelect; + SelectEffectSing: TThemeSelect; + SelectScreenFade: TThemeSelect; + SelectLineBonus: TThemeSelect; + SelectAskbeforeDel: TThemeSelect; + SelectOnSongClick: TThemeSelectSlide; + SelectPartyPopup: TThemeSelect; + 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: String; + FirstColor: String; + + SecondTexture: String; + SecondTyp: String; + SecondColor: String; + + ThirdTexture: String; + ThirdTyp: String; + 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 ThemeLoadSelect(var ThemeSelect: TThemeSelect; 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 + 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(); + + writeln( 'TTheme.LoadTheme : '+ FileName ); + + FileName := AdaptFilePaths( FileName ); + + if not FileExists(FileName) then + begin + {$ifndef win32} + writeln( 'ERROR !!! Theme does not exist ('+ FileName +')' ); + {$endif} + + Log.LogStatus( 'ERROR !!! 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 + + //{$IFDEF TRANSLATE} + 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'); + //{$ENDIF} + + //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'); + + // 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'); + + //{$IFDEF TRANSLATE} + Options.Description[0] := Language.Translate('SING_OPTIONS_GAME'); + Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS'); + Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND'); + Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS'); + Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES'); + Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD'); + Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED'); + Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); + //{$ENDIF} + + ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); + Options.TextDescription.Text := Options.Description[0]; + + // Options Game + ThemeLoadBasic(OptionsGame, 'OptionsGame'); + + ThemeLoadSelect(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); + ThemeLoadSelect(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); + ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); + ThemeLoadSelect(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); + ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); + ThemeLoadSelect(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); + ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); + + // Options Graphics + ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); + + ThemeLoadSelect(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); + ThemeLoadSelectSlide(OptionsGraphics.SelectSlideResolution, 'OptionsGraphicsSelectSlideResolution'); + ThemeLoadSelect(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); + ThemeLoadSelect(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); + ThemeLoadSelect(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); + ThemeLoadSelect(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); + ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); + + // Options Sound + ThemeLoadBasic(OptionsSound, 'OptionsSound'); + + ThemeLoadSelect(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); + ThemeLoadSelect(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); + ThemeLoadSelect(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); + ThemeLoadSelect(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); + //Song Preview + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); + ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); + + ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); + + // Options Lyrics + ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); + + ThemeLoadSelect(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); + ThemeLoadSelect(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); + ThemeLoadSelect(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); + 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.SelectSlideChannelL, 'OptionsRecordSelectSlideChannelL'); + ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannelR, 'OptionsRecordSelectSlideChannelR'); + ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); + + //Options Advanced + ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); + + ThemeLoadSelect (OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); + ThemeLoadSelect (OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); + ThemeLoadSelect (OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); + ThemeLoadSelect (OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); + ThemeLoadSelectSlide (OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); + ThemeLoadSelect (OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); + ThemeLoadSelect (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 := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', 'Note Black'); + PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); + + PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); + PartyScore.DecoTextures.SecondTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', 'Note Black'); + PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); + + PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); + PartyScore.DecoTextures.ThirdTyp := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', 'Note Black'); + 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 + DecimalSeparator := '.'; + + ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 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', ''); + + 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; + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + + 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 := ThemeIni.ReadString(Name, 'Type', ''); + 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); + + DecimalSeparator := ','; +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; + DecimalSeparator := '.'; + 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 := ThemeIni.ReadString(Name, 'Type', ''); + + //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)); + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelect(var ThemeSelect: TThemeSelect; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + //{$IFDEF TRANSLATE} + ThemeSelect.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + //{$ELSE}{ + //ThemeSelect.Text := ThemeIni.ReadString(Name, 'Text', ''); + //{$ENDIF} + + ThemeSelect.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); + ThemeSelect.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); + + ThemeSelect.X := ThemeIni.ReadInteger(Name, 'X', 0); + ThemeSelect.Y := ThemeIni.ReadInteger(Name, 'Y', 0); + ThemeSelect.W := ThemeIni.ReadInteger(Name, 'W', 0); + ThemeSelect.H := ThemeIni.ReadInteger(Name, 'H', 0); + ThemeSelect.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); + + + LoadColor(ThemeSelect.ColR, ThemeSelect.ColG, ThemeSelect.ColB, ThemeIni.ReadString(Name, 'Color', '')); + ThemeSelect.Int := ThemeIni.ReadFloat(Name, 'Int', 1); + LoadColor(ThemeSelect.DColR, ThemeSelect.DColG, ThemeSelect.DColB, ThemeIni.ReadString(Name, 'DColor', '')); + ThemeSelect.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); + + LoadColor(ThemeSelect.TColR, ThemeSelect.TColG, ThemeSelect.TColB, ThemeIni.ReadString(Name, 'TColor', '')); + ThemeSelect.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); + LoadColor(ThemeSelect.TDColR, ThemeSelect.TDColG, ThemeSelect.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); + ThemeSelect.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); + + LoadColor(ThemeSelect.SBGColR, ThemeSelect.SBGColG, ThemeSelect.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); + ThemeSelect.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); + LoadColor(ThemeSelect.SBGDColR, ThemeSelect.SBGDColG, ThemeSelect.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); + ThemeSelect.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); + + LoadColor(ThemeSelect.STColR, ThemeSelect.STColG, ThemeSelect.STColB, ThemeIni.ReadString(Name, 'STColor', '')); + ThemeSelect.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); + LoadColor(ThemeSelect.STDColR, ThemeSelect.STDColG, ThemeSelect.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); + ThemeSelect.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); + + + DecimalSeparator := ','; +end; + +procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string); +var + C: integer; +begin + DecimalSeparator := '.'; + + //{{$IFDEF TRANSLATE} + ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); + //{{$ELSE}{ + //ThemeSelectS.Text := ThemeIni.ReadString(Name, 'Text', ''); + //{$ENDIF} + + 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); + + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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', 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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); + + DecimalSeparator := ','; +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 + DecimalSeparator := '.'; + 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', 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)); + + DecimalSeparator := ','; +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/Game/Code/Classes/UTime.pas b/Game/Code/Classes/UTime.pas new file mode 100644 index 00000000..3b7749a2 --- /dev/null +++ b/Game/Code/Classes/UTime.pas @@ -0,0 +1,102 @@ +unit UTime; + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} +{$I switches.inc} + +{$UNDEF DebugDisplay} + +type + TTime = class + constructor Create; + function GetTime: real; + end; + +procedure CountSkipTimeSet; +procedure CountSkipTime; +procedure CountMidTime; + +var + USTime: TTime; + + TimeNew: int64; + TimeOld: int64; + TimeSkip: real; + TimeMid: real; + TimeMidTemp: int64; + +implementation + +uses +// sysutils, + 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 +*) + + +constructor TTime.Create; +begin + CountSkipTimeSet; +end; + + +procedure CountSkipTimeSet; +begin + TimeNew := SDL_GetTicks(); + + {$IFDEF DebugDisplay} + Writeln( 'CountSkipTimeSet : ' + inttostr(trunc(TimeNew)) ); + {$ENDIF} +end; + + +procedure CountSkipTime; +begin + TimeOld := TimeNew; + TimeNew := SDL_GetTicks(); + TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio; + + {$IFDEF DebugDisplay} + Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); + Writeln( 'CountSkipTime : ' + inttostr(trunc(TimeSkip)) ); + {$ENDIF} +end; + + +procedure CountMidTime; +begin + TimeMidTemp := SDL_GetTicks(); + TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio; + + {$IFDEF DebugDisplay} + Writeln( 'TimeNew : ' + inttostr(trunc(TimeNew)) ); + Writeln( 'CountMidTime : ' + inttostr(trunc(TimeMid)) ); + {$ENDIF} +end; + + +function TTime.GetTime: real; +begin + Result := SDL_GetTicks() / cSDLCorrectionRatio; + + {$IFDEF DebugDisplay} + Writeln( 'GetTime : ' + inttostr(trunc(Result)) ); + {$ENDIF} +end; + + +end. diff --git a/Game/Code/Classes/UVideo.pas b/Game/Code/Classes/UVideo.pas new file mode 100644 index 00000000..66c0c8e6 --- /dev/null +++ b/Game/Code/Classes/UVideo.pas @@ -0,0 +1,688 @@ +unit UVideo; +{< ############################################################################# +# FFmpeg support for UltraStar deluxe # +# # +# Created by b1indy # +# based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) # +# # +# http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html # +# http://www.nabble.com/file/p11795857/mpegpas01.zip # +# # +############################################################################## } + +//{$define DebugDisplay} // uncomment if u want to see the debug stuff +//{$define DebugFrames} +//{$define Info} + +interface + +{$IFDEF FPC} + {$MODE Delphi} +{$ENDIF} + +{$I switches.inc} + +(* + + look into + av_read_play + +*) + +implementation + +uses SDL, + UGraphicClasses, + textgl, + avcodec, + avformat, + avutil, + {$IFDEF UseSWScale} + swscale, + {$ENDIF} + math, + OpenGL12, + SysUtils, + {$ifdef DebugDisplay} + {$ifdef win32} + dialogs, + {$endif} + {$ENDIF} + (* FIXME + {$ifdef UseFFMpegAudio} + UAudioDecoder_FFMpeg, + {$endif} + *) + UIni, + UMusic, + UGraphic; + + +var + singleton_VideoFFMpeg : IVideoPlayback; + +type + TVideoPlayback_ffmpeg = class( TInterfacedObject, IVideoPlayback ) + private + fVideoOpened , + fVideoPaused : Boolean; + + fVideoTex : glUint; + fVideoSkipTime : Single; + + VideoFormatContext: PAVFormatContext; + + VideoStreamIndex , + AudioStreamIndex : Integer; + VideoCodecContext: PAVCodecContext; + VideoCodec: PAVCodec; + AVFrame: PAVFrame; + AVFrameRGB: PAVFrame; + myBuffer: pByte; + + {$IFDEF UseSWScale} + SoftwareScaleContext: PSwsContext; + {$ENDIF} + + TexX, TexY, dataX, dataY: Cardinal; + + ScaledVideoWidth, ScaledVideoHeight: Real; + VideoAspect: Real; + VideoTextureU, VideoTextureV: Real; + VideoTimeBase, VideoTime, LastFrameTime, TimeDifference: Extended; + + + WantedAudioCodecContext, + AudioCodecContext : PSDL_AudioSpec; + aCodecCtx : PAVCodecContext; + + function find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; + + public + constructor create(); + function GetName: String; + procedure init(); + + function Open( aFileName : string): boolean; // true if succeed + procedure Close; + + procedure Play; + procedure Pause; + procedure Stop; + + procedure SetPosition(Time: real); + function GetPosition: real; + + procedure GetFrame(Time: Extended); + procedure DrawGL(Screen: integer); + + end; + + const + SDL_AUDIO_BUFFER_SIZE = 1024; + +{$ifdef DebugDisplay} +//{$ifNdef win32} + +procedure showmessage( aMessage : String ); +begin + writeln( aMessage ); +end; + +//{$endif} +{$ENDIF} + +{ ------------------------------------------------------------------------------ +asdf +------------------------------------------------------------------------------ } + +function TVideoPlayback_ffmpeg.GetName: String; +begin + result := 'FFMpeg'; +end; + +{ + @author(Jay Binks <jaybinks@gmail.com>) + @created(2007-10-09) + @lastmod(2007-10-09) + + @param(aFormatCtx is a PAVFormatContext returned from av_open_input_file ) + @param(aFirstVideoStream is an OUT value of type integer, this is the index of the video stream) + @param(aFirstAudioStream is an OUT value of type integer, this is the index of the audio stream) + @returns(@true on success, @false otherwise) + + translated from "Setting Up the Audio" section at + http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html +} +function TVideoPlayback_ffmpeg.find_stream_ids( const aFormatCtx : PAVFormatContext; Out aFirstVideoStream, aFirstAudioStream : integer ): boolean; +var + i : integer; + st : pAVStream; +begin + // Find the first video stream + aFirstAudioStream := -1; + aFirstVideoStream := -1; + + writeln( ' aFormatCtx.nb_streams : ' + inttostr( aFormatCtx.nb_streams ) ); + writeln( ' length( aFormatCtx.streams ) : ' + inttostr( length(aFormatCtx.streams) ) ); + + i := 0; + while ( i < aFormatCtx.nb_streams ) do +// while ( i < length(aFormatCtx.streams)-1 ) do + begin + writeln( ' aFormatCtx.streams[i] : ' + inttostr( i ) ); + st := aFormatCtx.streams[i]; + + if(st.codec.codec_type = CODEC_TYPE_VIDEO ) AND + (aFirstVideoStream < 0) THEN + begin + aFirstVideoStream := i; + end; + + if ( st.codec.codec_type = CODEC_TYPE_AUDIO ) AND + ( aFirstAudioStream < 0) THEN + begin + aFirstAudioStream := i; + end; + + inc( i ); + end; // while + + result := (aFirstAudioStream > -1) OR + (aFirstVideoStream > -1) ; // Didn't find a video stream +end; + + + + +procedure TVideoPlayback_ffmpeg.GetFrame(Time: Extended); +var + FrameFinished: Integer; + AVPacket: TAVPacket; + errnum, x, y: Integer; + FrameDataPtr: PByteArray; + linesize: integer; + myTime: Extended; + DropFrame: Boolean; + droppedFrames: Integer; +const + FRAMEDROPCOUNT=3; +begin + if not fVideoOpened then Exit; + + if fVideoPaused then Exit; + + myTime := Time + fVideoSkipTime; + TimeDifference := myTime - VideoTime; + DropFrame := False; + +{$IFDEF DebugDisplay} + showmessage('Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +{$endif} + + if (VideoTime <> 0) and (TimeDifference <= VideoTimeBase) then + begin +{$ifdef DebugFrames} + // frame delay debug display + GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00); +{$endif} + +{$IFDEF DebugDisplay} + showmessage('not getting new frame'+#13#10+ + 'Time: '+inttostr(floor(Time*1000))+#13#10+ + 'VideoTime: '+inttostr(floor(VideoTime*1000))+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))); +{$endif} + + Exit;// we don't need a new frame now + end; + + VideoTime:=VideoTime+VideoTimeBase; + TimeDifference:=myTime-VideoTime; + if TimeDifference >= (FRAMEDROPCOUNT-1)*VideoTimeBase then // skip frames + begin +{$ifdef DebugFrames} + //frame drop debug display + GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000); +{$endif} +{$IFDEF DebugDisplay} + showmessage('skipping frames'+#13#10+ + 'TimeBase: '+inttostr(floor(VideoTimeBase*1000))+#13#10+ + 'TimeDiff: '+inttostr(floor(TimeDifference*1000))+#13#10+ + 'Time2Skip: '+inttostr(floor((Time-LastFrameTime)*1000))); +{$endif} + VideoTime:=VideoTime+FRAMEDROPCOUNT*VideoTimeBase; + DropFrame:=True; + end; + + AVPacket.data := nil; + av_init_packet( AVPacket ); // JB-ffmpeg + + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while ( FrameFinished = 0 ) do + begin + if ( av_read_frame(VideoFormatContext, AVPacket) < 0 ) then + break; + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + begin + errnum := avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + (* FIXME + {$ifdef UseFFMpegAudio} + end + else + if (AVPacket.stream_index = AudioStreamIndex ) then + begin + writeln('Encue Audio packet'); + audioq.put(AVPacket); + {$endif} + *) + end; + + try +// if AVPacket.data <> nil then + av_free_packet( @AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; + + end; + + if DropFrame then + for droppedFrames:=1 to FRAMEDROPCOUNT do begin + FrameFinished:=0; + // read packets until we have a finished frame (or there are no more packets) + while (FrameFinished=0) do + begin + if (av_read_frame(VideoFormatContext, AVPacket)<0) then + Break; + // if we got a packet from the video stream, then decode it + if (AVPacket.stream_index=VideoStreamIndex) then + errnum:=avcodec_decode_video(VideoCodecContext, AVFrame, frameFinished , AVPacket.data, AVPacket.size); // JB-ffmpeg + + // release internal packet structure created by av_read_frame + try +// if AVPacket.data <> nil then + av_free_packet( @AVPacket ); // JB-ffmpeg + except + // TODO : JB_FFMpeg ... why does this now AV sometimes ( or always !! ) + end; + end; + end; + + // if we did not get an new frame, there's nothing more to do + if Framefinished=0 then begin + Exit; + end; + + // otherwise we convert the pixeldata from YUV to RGB + {$IFDEF UseSWScale} + errnum:=sws_scale(SoftwareScaleContext,@(AVFrame.data),@(AVFrame.linesize), + 0,VideoCodecContext^.Height, + @(AVFrameRGB.data),@(AVFrameRGB.linesize)); + {$ELSE} + errnum:=img_convert(PAVPicture(AVFrameRGB), PIX_FMT_RGB24, + PAVPicture(AVFrame), VideoCodecContext^.pix_fmt, + VideoCodecContext^.width, VideoCodecContext^.height); + {$ENDIF} + + if errnum >=0 then + begin + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glTexImage2D(GL_TEXTURE_2D, 0, 3, dataX, dataY, 0, GL_RGB, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); + glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); +{$ifdef DebugFrames} + //frame decode debug display + GoldenRec.Spawn(200,35,1,16,0,-1,ColoredStar,$ffff00); +{$endif} + end; +end; + +procedure TVideoPlayback_ffmpeg.DrawGL(Screen: integer); +begin + // have a nice black background to draw on (even if there were errors opening the vid) + if Screen=1 then + begin + glClearColor(0,0,0,0); + glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); + end; + // exit if there's nothing to draw + if not fVideoOpened then Exit; + + glEnable(GL_TEXTURE_2D); + glEnable(GL_BLEND); + glColor4f(1, 1, 1, 1); + glBindTexture(GL_TEXTURE_2D, fVideoTex); + glbegin(gl_quads); + glTexCoord2f( 0, 0); glVertex2f(400-ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glTexCoord2f( 0, TexY/dataY); glVertex2f(400-ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, TexY/dataY); glVertex2f(400+ScaledVideoWidth/2, 300+ScaledVideoHeight/2); + glTexCoord2f(TexX/dataX, 0); glVertex2f(400+ScaledVideoWidth/2, 300-ScaledVideoHeight/2); + glEnd; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + +{$ifdef Info} + if VideoSkipTime+VideoTime+VideoTimeBase < 0 then + begin + glColor4f(0.7, 1, 0.3, 1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (300, 0); + glPrint('Delay due to negative VideoGap'); + glColor4f(1, 1, 1, 1); + end; +{$endif} + +{$ifdef DebugFrames} + glColor4f(0, 0, 0, 0.2); + glbegin(gl_quads); + glVertex2f(0, 0); + glVertex2f(0, 70); + glVertex2f(250, 70); + glVertex2f(250, 0); + glEnd; + + glColor4f(1,1,1,1); + SetFontStyle (1); + SetFontItalic(False); + SetFontSize(9); + SetFontPos (5, 0); + glPrint('delaying frame'); + SetFontPos (5, 20); + glPrint('fetching frame'); + SetFontPos (5, 40); + glPrint('dropping frame'); +{$endif} +end; + +constructor TVideoPlayback_ffmpeg.create(); +begin + av_register_all; + + fVideoOpened := False; + fVideoPaused := False; +end; + +procedure TVideoPlayback_ffmpeg.init(); +begin + glGenTextures(1, PglUint(@fVideoTex)); +end; + + +function TVideoPlayback_ffmpeg.Open( aFileName : string): boolean; // true if succeed +var + errnum, i, x,y: Integer; + lStreamsCount : Integer; + + wanted_spec , + spec : TSDL_AudioSpec; + aCodec : pAVCodec; + + sws_dst_w, sws_dst_h: Integer; + +begin + fVideoOpened := False; + fVideoPaused := False; + VideoTimeBase := 0; + VideoTime := 0; + LastFrameTime := 0; + TimeDifference := 0; + VideoFormatContext := nil; + +// writeln( aFileName ); + + errnum := av_open_input_file(VideoFormatContext, pchar( aFileName ), Nil, 0, Nil); +// writeln( 'Errnum : ' +inttostr( errnum )); + if(errnum <> 0) then + begin +{$ifdef DebugDisplay} + case errnum of + AVERROR_UNKNOWN: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_UNKNOWN'); + AVERROR_IO: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_IO'); + AVERROR_NUMEXPECTED: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NUMEXPECTED'); + AVERROR_INVALIDDATA: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_INVALIDDATA'); + AVERROR_NOMEM: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOMEM'); + AVERROR_NOFMT: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOFMT'); + AVERROR_NOTSUPP: showmessage('failed to open file '+aFileName+#13#10+'AVERROR_NOTSUPP'); + else showmessage('failed to open file '+aFileName+#13#10+'Error number: '+inttostr(Errnum)); + end; +{$ENDIF} + Exit; + end + else + begin + VideoStreamIndex := -1; + AudioStreamIndex := -1; + + // Find which stream contains the video + if( av_find_stream_info(VideoFormatContext) >= 0 ) then + begin + find_stream_ids( VideoFormatContext, VideoStreamIndex, AudioStreamIndex ); + + writeln( 'VideoStreamIndex : ' + inttostr(VideoStreamIndex) ); + writeln( 'AudioStreamIndex : ' + inttostr(AudioStreamIndex) ); + end; + // FIXME: AudioStreamIndex is -1 if video has no sound -> memory access error + // Just a temporary workaround for now + aCodecCtx := nil; + if( AudioStreamIndex >= 0) then + aCodecCtx := VideoFormatContext.streams[ AudioStreamIndex ].codec; + + (* FIXME + {$ifdef UseFFMpegAudio} + // This is the audio ffmpeg audio support Jay is working on. + if aCodecCtx <> nil then + begin + wanted_spec.freq := aCodecCtx.sample_rate; + wanted_spec.format := AUDIO_S16SYS; + wanted_spec.channels := aCodecCtx.channels; + wanted_spec.silence := 0; + wanted_spec.samples := SDL_AUDIO_BUFFER_SIZE; + wanted_spec.callback := UAudio_FFMpeg.audio_callback; + wanted_spec.userdata := aCodecCtx; + + + if (SDL_OpenAudio(@wanted_spec, @spec) < 0) then + begin + writeln('SDL_OpenAudio: '+SDL_GetError()); + exit; + end; + + writeln( 'SDL opened audio device' ); + + aCodec := avcodec_find_decoder(aCodecCtx.codec_id); + if (aCodec = nil) then + begin + writeln('Unsupported codec!'); + exit; + end; + + avcodec_open(aCodecCtx, aCodec); + + writeln( 'Opened the codec' ); + + packet_queue_init( audioq ); + SDL_PauseAudio(0); + + writeln( 'SDL_PauseAudio' ); + + + end; + {$endif} + *) + + if(VideoStreamIndex >= 0) then + begin + VideoCodecContext:=VideoFormatContext^.streams[VideoStreamIndex]^.codec; + VideoCodec:=avcodec_find_decoder(VideoCodecContext^.codec_id); + end + else + begin +{$ifdef DebugDisplay} + showmessage('found no video stream'); +{$ENDIF} + av_close_input_file(VideoFormatContext); + Exit; + end; + + if(VideoCodec<>Nil) then + begin + errnum:=avcodec_open(VideoCodecContext, VideoCodec); + end else begin +{$ifdef DebugDisplay} + showmessage('no matching codec found'); +{$ENDIF} + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + if(errnum >=0) then + begin + if (VideoCodecContext^.width >1024) or (VideoCodecContext^.height >1024) then + begin + ScreenPopupError.ShowPopup('Video dimensions\nmust not exceed\n1024 pixels\n\nvideo disabled'); //show error message + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; +{$ifdef DebugDisplay} + showmessage('Found a matching Codec: '+ VideoCodecContext^.Codec.Name +#13#10#13#10+ + ' Width = '+inttostr(VideoCodecContext^.width)+ ', Height='+inttostr(VideoCodecContext^.height)+#13#10+ + ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num)+'/'+inttostr(VideoCodecContext^.sample_aspect_ratio.den)+#13#10+ + ' Framerate : '+inttostr(VideoCodecContext^.time_base.num)+'/'+inttostr(VideoCodecContext^.time_base.den)); +{$endif} + // allocate space for decoded frame and rgb frame + AVFrame:=avcodec_alloc_frame; + AVFrameRGB:=avcodec_alloc_frame; + end; + + dataX := Round(Power(2, Ceil(Log2(VideoCodecContext^.width)))); + dataY := Round(Power(2, Ceil(Log2(VideoCodecContext^.height)))); + myBuffer:=Nil; + if(AVFrame <> Nil) and (AVFrameRGB <> Nil) then + begin + myBuffer:=av_malloc(avpicture_get_size(PIX_FMT_RGB24, dataX, dataY)); + end; + if myBuffer <> Nil then errnum:=avpicture_fill(PAVPicture(AVFrameRGB), myBuffer, PIX_FMT_RGB24, + dataX, dataY) + else begin + {$ifdef DebugDisplay} + showmessage('failed to allocate video buffer'); + {$endif} + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + + {$IFDEF UseSWScale} + SoftwareScaleContext:=sws_getContext(VideoCodecContext^.width,VideoCodecContext^.height,integer(VideoCodecContext^.pix_fmt), + dataX, dataY, integer(PIX_FMT_RGB24), + SWS_FAST_BILINEAR, nil, nil, nil); + if SoftwareScaleContext <> Nil then + writeln('got swscale context') + else begin + writeln('ERROR: didn´t get swscale context'); + av_free(AVFrameRGB); + av_free(AVFrame); + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + Exit; + end; + {$ENDIF} + + // this is the errnum from avpicture_fill + if errnum >=0 then + begin + fVideoOpened:=True; + + TexX := VideoCodecContext^.width; + TexY := VideoCodecContext^.height; + dataX := Round(Power(2, Ceil(Log2(TexX)))); + dataY := Round(Power(2, Ceil(Log2(TexY)))); + // calculate some information for video display + VideoAspect:=VideoCodecContext^.sample_aspect_ratio.num/VideoCodecContext^.sample_aspect_ratio.den; + if (VideoAspect = 0) then + VideoAspect:=VideoCodecContext^.width/VideoCodecContext^.height + else + VideoAspect:=VideoAspect*VideoCodecContext^.width/VideoCodecContext^.height; + ScaledVideoWidth:=800.0; + ScaledVideoHeight:=800.0/VideoAspect; + VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num; +{$ifdef DebugDisplay}
+ showmessage('framerate: '+inttostr(floor(1/videotimebase))+'fps');
+{$endif}
+ // hack to get reasonable timebase (for divx and others)
+ if VideoTimeBase < 0.02 then // 0.02 <-> 50 fps
+ begin
+ VideoTimeBase:=VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.num/VideoFormatContext^.streams[VideoStreamIndex]^.r_frame_rate.den;
+ while VideoTimeBase > 50 do VideoTimeBase:=VideoTimeBase/10;
+ VideoTimeBase:=1/VideoTimeBase;
+ end;
+ end;
+ end; +end; + +procedure TVideoPlayback_ffmpeg.Close; +begin + if fVideoOpened then + begin + av_free(myBuffer); + av_free(AVFrameRGB); + av_free(AVFrame); + + avcodec_close(VideoCodecContext); + av_close_input_file(VideoFormatContext); + + fVideoOpened:=False; + end; +end; + +procedure TVideoPlayback_ffmpeg.Play; +begin +end; + +procedure TVideoPlayback_ffmpeg.Pause; +begin + fVideoPaused := not fVideoPaused; +end; + +procedure TVideoPlayback_ffmpeg.Stop; +begin +end; + +procedure TVideoPlayback_ffmpeg.SetPosition(Time: real); +begin + fVideoSkipTime := Time; + + if fVideoSkipTime > 0 then + begin + av_seek_frame(VideoFormatContext,VideoStreamIndex,Floor(Time/VideoTimeBase),AVSEEK_FLAG_ANY); + + VideoTime := fVideoSkipTime; + end; +end; + +// what is this supposed to do? return VideoTime? +function TVideoPlayback_ffmpeg.GetPosition: real; +begin + result := 0; +end; + +initialization + singleton_VideoFFMpeg := TVideoPlayback_ffmpeg.create(); + AudioManager.add( singleton_VideoFFMpeg ); + +finalization + AudioManager.Remove( singleton_VideoFFMpeg ); + +end. diff --git a/Game/Code/Classes/UVisualizer.pas b/Game/Code/Classes/UVisualizer.pas new file mode 100644 index 00000000..2f584299 --- /dev/null +++ b/Game/Code/Classes/UVisualizer.pas @@ -0,0 +1,394 @@ +{############################################################################
+# Visualizer support for UltraStar deluxe #
+# #
+# Created by hennymcc #
+# Slight modifications by Jay Binks #
+# based on UVideo.pas #
+#############################################################################}
+
+unit UVisualizer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ UGraphicClasses,
+ textgl,
+ math,
+ OpenGL12,
+ SysUtils,
+ UIni,
+ {$ifdef DebugDisplay}
+ {$ifdef win32}
+ dialogs,
+ {$endif}
+ {$endif}
+ projectM,
+ UMusic;
+
+implementation
+
+uses
+ UGraphic,
+ UMain,
+ ULog;
+
+var
+ singleton_VideoProjectM : IVideoPlayback;
+
+const
+ gx = 32;
+ gy = 24;
+ fps = 30;
+ texsize = 512;
+
+var
+ ProjectMPath : string;
+ presetsDir : string;
+ fontsDir : string;
+
+ // FIXME: dirty fix needed because the init method is not
+ // called yet.
+ inited: boolean;
+
+type
+ TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization )
+ private
+ pm : TProjectM;
+
+ VisualizerStarted ,
+ 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
+ constructor Create();
+ procedure Init();
+ function GetName: String;
+
+ function Open( 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;
+
+
+constructor TVideoPlayback_ProjectM.Create();
+begin
+ RndPCMcount := 0;
+end;
+
+
+procedure TVideoPlayback_ProjectM.Init();
+begin
+ // FIXME: dirty fix needed because the init method is not
+ // called yet.
+ inited := true;
+
+ ProjectMPath := VisualsPath + 'projectM' + PathDelim;
+ presetsDir := ProjectMPath + 'presets';
+ fontsDir := ProjectMPath + 'fonts';
+
+ 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.GetName: String;
+begin
+ result := 'ProjectM';
+end;
+
+
+function TVideoPlayback_ProjectM.Open( aFileName : string): boolean; // true if succeed
+begin
+ VisualizerStart();
+ result := true;
+end;
+
+procedure TVideoPlayback_ProjectM.Close;
+begin
+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
+ pm.RandomPreset();
+end;
+
+function TVideoPlayback_ProjectM.GetPosition: real;
+begin
+ result := 0;
+end;
+
+procedure TVideoPlayback_ProjectM.SaveOpenGLState();
+begin
+ // save all OpenGL state-machine attributes
+ glPushAttrib(GL_ALL_ATTRIB_BITS);
+
+ // save projection-matrix
+ glMatrixMode(GL_PROJECTION);
+ // - WARNING: projection-matrix stack-depth is only 2!
+ // -> overflow might occur if glPopMatrix() is used for this matrix
+ // -> use glGet() instead of glPushMatrix()
+ glPushMatrix();
+ //glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix);
+
+ // save texture-matrix
+ glMatrixMode(GL_TEXTURE);
+ // - WARNING: texture-matrix stack-depth is only 2!
+ // -> overflow might occur if glPopMatrix() is used for this matrix
+ // -> use glGet() instead of glPushMatrix() if problems appear
+ glPushMatrix();
+ //glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix);
+
+ // save modelview-matrix
+ glMatrixMode(GL_MODELVIEW);
+ glPushMatrix();
+end;
+
+procedure TVideoPlayback_ProjectM.RestoreOpenGLState();
+begin
+ // restore projection-matrix
+ glMatrixMode(GL_PROJECTION);
+ // - WARNING: projection-matrix stack-depth is only 2!
+ // -> overflow _occurs_ if glPopMatrix() is used for this matrix
+ // -> use glLoadMatrix() instead of glPopMatrix()
+ glPopMatrix();
+ //glLoadMatrixd(@projMatrix);
+
+ // restore texture-matrix
+ // -> overflow might occur if glPopMatrix() is used for this matrix
+ glMatrixMode(GL_TEXTURE);
+ glPopMatrix();
+ //glLoadMatrixd(@texMatrix);
+
+ // restore modelview-matrix
+ glMatrixMode(GL_MODELVIEW);
+ glPopMatrix();
+
+ // restore all OpenGL state-machine attributes
+ glPopAttrib();
+end;
+
+procedure TVideoPlayback_ProjectM.VisualizerStart;
+var
+ initResult: Cardinal;
+begin
+ // FIXME: dirty fix needed because the init method is not
+ // called yet.
+ if (not inited) then
+ Init();
+
+ VisualizerStarted := True;
+
+ pm := TProjectM.Create(gx, gy, fps, texsize, ScreenW, ScreenH,
+ presetsDir, fontsDir);
+ //initResult := projectM_initRenderToTexture(pm);
+
+ SaveOpenGLState();
+ pm.ResetGL(ScreenW, ScreenH);
+ RestoreOpenGLState();
+end;
+
+procedure TVideoPlayback_ProjectM.VisualizerStop;
+begin
+ if VisualizerStarted then begin
+ VisualizerStarted := False;
+ pm.Free();
+ 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);
+
+ if nSamples = 0 then
+ nSamples := GetRandomPCMData(PcmData);
+
+ pm.AddPCM16Data(PSmallint(@PcmData), nSamples);
+
+ // store OpenGL state (might be messed up otherwise)
+ SaveOpenGLState();
+ pm.ResetGL(ScreenW, ScreenH);
+
+ //glGetIntegerv(GL_PROJECTION_STACK_DEPTH, @stackDepth);
+ //writeln('StackDepth0: ' + inttostr(stackDepth));
+
+ // let projectM render a frame
+ try
+ pm.RenderFrame();
+ except
+ // this may happen with some presets ( on linux ) if there is a div by zero
+ // in projectM's getBeatVals() function (file: beat_detect.cc)
+ Log.LogStatus('Div by zero!', 'Visualizer');
+ SetPosition( now );
+ end;
+
+ //glGetIntegerv(GL_PROJECTION_STACK_DEPTH, @stackDepth);
+ //writeln('StackDepth1: ' + inttostr(stackDepth));
+
+ {$IFDEF UseTexture}
+ glBindTexture(GL_TEXTURE_2D, VisualTex);
+ glFlush();
+ glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0);
+ {$ENDIF}
+
+ // restore USDX OpenGL state
+ RestoreOpenGLState();
+
+ // discard projectM's depth buffer information (avoid overlay)
+ glClear(GL_DEPTH_BUFFER_BIT);
+end;
+
+procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer);
+begin
+ {$IFDEF UseTexture}
+ // 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 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;
+
+function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal;
+var
+ i: integer;
+begin
+ // Produce some fake PCM data
+ if ( RndPCMcount mod 500 = 0 ) then
+ begin
+ for i := 0 to 511 do begin
+ data[0][i] := 0;
+ data[1][i] := 0;
+ end;
+ end
+ else begin
+ for i := 0 to 511 do begin
+ if ( i mod 2 = 0 ) then begin
+ data[0][i] := floor(Random * power(2.,14));
+ data[1][i] := floor(Random * power(2.,14));
+ end
+ else begin;
+ data[0][i] := floor(Random * power(2.,14));
+ data[1][i] := floor(Random * power(2.,14));
+ end;
+ if ( i mod 2 = 1 ) then begin
+ data[0][i] := -data[0][i];
+ data[1][i] := -data[1][i];
+ end;
+ end;
+ end;
+ Inc( RndPCMcount );
+ result := 512;
+end;
+
+
+initialization
+ singleton_VideoProjectM := TVideoPlayback_ProjectM.create();
+ AudioManager.add( singleton_VideoProjectM );
+
+finalization
+ AudioManager.Remove( singleton_VideoProjectM );
+
+
+
+end.
diff --git a/Game/Code/Classes/Ulazjpeg.pas b/Game/Code/Classes/Ulazjpeg.pas new file mode 100644 index 00000000..2414002c --- /dev/null +++ b/Game/Code/Classes/Ulazjpeg.pas @@ -0,0 +1,151 @@ +{ Copyright (C) 2003 Mattias Gaertner + + This library is free software; you can redistribute it and/or modify it + under the terms of the GNU Library 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 Library General Public License + for more details. + + You should have received a copy of the GNU Library General Public License + along with this library; if not, write to the Free Software Foundation, + Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. +} +unit Ulazjpeg; + +{$mode delphi} + +{$I switches.inc} + +interface + +uses + SysUtils, Classes, FPImage, IntfGraphics, Graphics, FPReadJPEG, FPWriteJPEG, + UConfig; + +type + TJPEGQualityRange = TFPJPEGCompressionQuality; + TJPEGPerformance = TJPEGReadPerformance; + + TJPEGImage = class(TFPImageBitmap) + private + FPerformance: TJPEGPerformance; + FProgressiveEncoding: boolean; + FQuality: TJPEGQualityRange; + protected +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + procedure InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); override; +{$ELSE} + procedure InitFPImageReader(ImgReader: TFPCustomImageReader); override; +{$IFEND} + procedure FinalizeFPImageReader(ImgReader: TFPCustomImageReader); override; +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + procedure InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); override; +{$ELSE} + procedure InitFPImageWriter(ImgWriter: TFPCustomImageWriter); override; +{$IFEND} + public + constructor Create; override; + class function GetFileExtensions: string; override; + class function GetDefaultFPReader: TFPCustomImageReaderClass; override; + class function GetDefaultFPWriter: TFPCustomImageWriterClass; override; + public + property CompressionQuality: TJPEGQualityRange read FQuality write FQuality; + property ProgressiveEncoding: boolean read FProgressiveEncoding; + property Performance: TJPEGPerformance read FPerformance write FPerformance; + end; + +const + DefaultJPEGMimeType = 'image/jpeg'; + + +implementation + + +{ TJPEGImage } + +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 +procedure TJPEGImage.InitFPImageReader(IntfImg: TLazIntfImage; ImgReader: TFPCustomImageReader); +{$ELSE} +procedure TJPEGImage.InitFPImageReader(ImgReader: TFPCustomImageReader); +{$IFEND} +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + JPEGReader.Performance:=Performance; +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + JPEGReader.OnProgress:=Progress; +{$IFEND} + end; +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + inherited InitFPImageReader(IntfImg, ImgReader); +{$ELSE} + inherited InitFPImageReader(ImgReader); +{$IFEND} +end; + +procedure TJPEGImage.FinalizeFPImageReader(ImgReader: TFPCustomImageReader); +var + JPEGReader: TFPReaderJPEG; +begin + if ImgReader is TFPReaderJPEG then begin + JPEGReader:=TFPReaderJPEG(ImgReader); + FProgressiveEncoding:=JPEGReader.ProgressiveEncoding; + end; + inherited FinalizeFPImageReader(ImgReader); +end; + +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 +procedure TJPEGImage.InitFPImageWriter(IntfImg: TLazIntfImage; ImgWriter: TFPCustomImageWriter); +{$ELSE} +procedure TJPEGImage.InitFPImageWriter(ImgWriter: TFPCustomImageWriter); +{$IFEND} +var + JPEGWriter: TFPWriterJPEG; +begin + if ImgWriter is TFPWriterJPEG then begin + JPEGWriter:=TFPWriterJPEG(ImgWriter); + if JPEGWriter<>nil then ; + JPEGWriter.ProgressiveEncoding:=ProgressiveEncoding; + JPEGWriter.CompressionQuality:=CompressionQuality; +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + JPEGWriter.OnProgress:=Progress; +{$IFEND} + end; +{$IF LAZARUS_VERSION >= 000009024} // 0.9.24 + inherited InitFPImageWriter(IntfImg, ImgWriter); +{$ELSE} + inherited InitFPImageWriter(ImgWriter); +{$IFEND} +end; + +class function TJPEGImage.GetDefaultFPReader: TFPCustomImageReaderClass; +begin + Result:=TFPReaderJPEG; +end; + +class function TJPEGImage.GetDefaultFPWriter: TFPCustomImageWriterClass; +begin + Result:=TFPWriterJPEG; +end; + +constructor TJPEGImage.Create; +begin + inherited Create; + FPerformance:=jpBestQuality; + FProgressiveEncoding:=false; + FQuality:=75; +end; + +class function TJPEGImage.GetFileExtensions: string; +begin + Result:='jpg;jpeg'; +end; + +end. + diff --git a/Game/Code/Classes/uPluginLoader.pas b/Game/Code/Classes/uPluginLoader.pas new file mode 100644 index 00000000..b018ccc2 --- /dev/null +++ b/Game/Code/Classes/uPluginLoader.pas @@ -0,0 +1,801 @@ +unit UPluginLoader;
+{*********************
+ UPluginLoader
+ Unit contains to Classes
+ TPluginLoader: Class Searching for and Loading the Plugins
+ TtehPlugins: Class that represents 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;
+ Procedure Free; 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
+ {$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
+ //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
+//-------------
+Procedure TPluginLoader.Free;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Plugins, 0);
+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
+ 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
+label Continue;
+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
+ I := 0;
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ Core.CurExecuted := -1 - I;
+
+ //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
+ Core.ReportDebug(Integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[I].Info.Name))), PChar('TtehPlugins'));
+
+ Inc(I);
+ 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'));
+
+
+ //don't forget to increase I
+ Inc(I);
+ end;
+ End;
+
+ If (I <= High(PluginLoader.Plugins)) then
+ Goto Continue;
+
+ //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
+label Continue;
+begin
+ Result := True;
+
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loading the Plugins
+ I := 0;
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ 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'));
+
+ //don't forget to increase I
+ Inc(I);
+ end;
+ 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'));
+
+ //don't forget to increase I
+ Inc(I);
+ End;
+
+ If (I <= High(PluginLoader.Plugins)) then
+ GoTo Continue;
+
+ //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
+label Continue;
+begin
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loop
+ I := 0;
+
+ Continue:
+ Try
+ While (I <= High(PluginLoader.Plugins)) do
+ begin
+ //DeInit Plugin
+ PluginLoader.CallDeInit(I);
+
+ Inc(I);
+ end;
+ Except
+ Inc(I);
+ End;
+
+ If I <= High(PluginLoader.Plugins) then
+ Goto Continue;
+
+ //Reset CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+end;
+
+end.
|