diff options
author | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-30 18:12:06 +0000 |
---|---|---|
committer | tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c> | 2008-08-30 18:12:06 +0000 |
commit | 5f11f9f3e328f6818a42f0a3405404612399c64e (patch) | |
tree | 66f4cfcde3c1d4b0564ba47aceeb2d04082a7dfb /Game/Code/Classes | |
parent | d4ec88adaa7a93d1970c116ae3d621ff05683681 (diff) | |
download | usdx-5f11f9f3e328f6818a42f0a3405404612399c64e.tar.gz usdx-5f11f9f3e328f6818a42f0a3405404612399c64e.tar.xz usdx-5f11f9f3e328f6818a42f0a3405404612399c64e.zip |
Removed outdated 1.1 branch contents
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/1.1@1331 b956fd51-792f-4845-bead-9b4dfca2ff2c
Diffstat (limited to 'Game/Code/Classes')
56 files changed, 0 insertions, 26151 deletions
diff --git a/Game/Code/Classes/TextGL.pas b/Game/Code/Classes/TextGL.pas deleted file mode 100644 index 0bd61fa7..00000000 --- a/Game/Code/Classes/TextGL.pas +++ /dev/null @@ -1,562 +0,0 @@ -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 deleted file mode 100644 index 55148f95..00000000 --- a/Game/Code/Classes/UAudioCore_Bass.pas +++ /dev/null @@ -1,116 +0,0 @@ -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 deleted file mode 100644 index 646e9eef..00000000 --- a/Game/Code/Classes/UAudioDecoder_FFMpeg.pas +++ /dev/null @@ -1,771 +0,0 @@ -unit UAudioDecoder_FFMpeg; - -(******************************************************************************* - -This unit is primarily based upon - - http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html - - and tutorial03.c - - http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html - -*******************************************************************************) - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I ../switches.inc} - - -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 deleted file mode 100644 index 6d661258..00000000 --- a/Game/Code/Classes/UAudioInput_Bass.pas +++ /dev/null @@ -1,203 +0,0 @@ -unit UAudioInput_Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- URecord,
- UMusic;
-
-implementation
-
-uses
- UMain,
- UIni,
- ULog,
- UAudioCore_Bass,
- 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 deleted file mode 100644 index 753c69f6..00000000 --- a/Game/Code/Classes/UAudioInput_Portaudio.pas +++ /dev/null @@ -1,347 +0,0 @@ -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 deleted file mode 100644 index 266a5ec3..00000000 --- a/Game/Code/Classes/UAudioPlayback_Bass.pas +++ /dev/null @@ -1,430 +0,0 @@ -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 deleted file mode 100644 index 59571d3d..00000000 --- a/Game/Code/Classes/UAudioPlayback_Portaudio.pas +++ /dev/null @@ -1,728 +0,0 @@ -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 deleted file mode 100644 index 516544be..00000000 --- a/Game/Code/Classes/UCatCovers.pas +++ /dev/null @@ -1,151 +0,0 @@ -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 deleted file mode 100644 index 55dfc6ce..00000000 --- a/Game/Code/Classes/UCommandLine.pas +++ /dev/null @@ -1,332 +0,0 @@ -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 deleted file mode 100644 index fb74af0b..00000000 --- a/Game/Code/Classes/UCommon.pas +++ /dev/null @@ -1,215 +0,0 @@ -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 deleted file mode 100644 index a7b0f328..00000000 --- a/Game/Code/Classes/UConfig.pas +++ /dev/null @@ -1,175 +0,0 @@ -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 deleted file mode 100644 index 7e76c9c4..00000000 --- a/Game/Code/Classes/UCore.pas +++ /dev/null @@ -1,523 +0,0 @@ -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 deleted file mode 100644 index c8c54161..00000000 --- a/Game/Code/Classes/UCoreModule.pas +++ /dev/null @@ -1,126 +0,0 @@ -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 deleted file mode 100644 index 9cc2a5e9..00000000 --- a/Game/Code/Classes/UCovers.pas +++ /dev/null @@ -1,265 +0,0 @@ -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 deleted file mode 100644 index cbe79c3c..00000000 --- a/Game/Code/Classes/UDLLManager.pas +++ /dev/null @@ -1,252 +0,0 @@ -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 deleted file mode 100644 index b5636d52..00000000 --- a/Game/Code/Classes/UDataBase.pas +++ /dev/null @@ -1,363 +0,0 @@ -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 deleted file mode 100644 index a81aa93b..00000000 --- a/Game/Code/Classes/UDraw.pas +++ /dev/null @@ -1,1353 +0,0 @@ -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 deleted file mode 100644 index 495e8a4a..00000000 --- a/Game/Code/Classes/UFiles.pas +++ /dev/null @@ -1,148 +0,0 @@ -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 deleted file mode 100644 index fcda137c..00000000 --- a/Game/Code/Classes/UGraphic.pas +++ /dev/null @@ -1,789 +0,0 @@ -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 deleted file mode 100644 index 4dfc66ce..00000000 --- a/Game/Code/Classes/UGraphicClasses.pas +++ /dev/null @@ -1,678 +0,0 @@ -// 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 deleted file mode 100644 index 8b33959d..00000000 --- a/Game/Code/Classes/UHooks.pas +++ /dev/null @@ -1,430 +0,0 @@ -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 deleted file mode 100644 index 4ac67cda..00000000 --- a/Game/Code/Classes/UIni.pas +++ /dev/null @@ -1,801 +0,0 @@ -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 deleted file mode 100644 index 6b4ea63f..00000000 --- a/Game/Code/Classes/UJoystick.pas +++ /dev/null @@ -1,282 +0,0 @@ -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 deleted file mode 100644 index 13736729..00000000 --- a/Game/Code/Classes/ULCD.pas +++ /dev/null @@ -1,304 +0,0 @@ -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 deleted file mode 100644 index dc07c298..00000000 --- a/Game/Code/Classes/ULanguage.pas +++ /dev/null @@ -1,238 +0,0 @@ -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 deleted file mode 100644 index b0ff9d6b..00000000 --- a/Game/Code/Classes/ULight.pas +++ /dev/null @@ -1,166 +0,0 @@ -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 deleted file mode 100644 index 542fa0b3..00000000 --- a/Game/Code/Classes/ULog.pas +++ /dev/null @@ -1,364 +0,0 @@ -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 deleted file mode 100644 index 165084a8..00000000 --- a/Game/Code/Classes/ULyrics.pas +++ /dev/null @@ -1,715 +0,0 @@ -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 deleted file mode 100644 index 703ee270..00000000 --- a/Game/Code/Classes/ULyrics_bak.pas +++ /dev/null @@ -1,428 +0,0 @@ -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 deleted file mode 100644 index bbd4a5ee..00000000 --- a/Game/Code/Classes/UMain.pas +++ /dev/null @@ -1,1059 +0,0 @@ -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 deleted file mode 100644 index cd62dc51..00000000 --- a/Game/Code/Classes/UMedia_dummy.pas +++ /dev/null @@ -1,206 +0,0 @@ -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 deleted file mode 100644 index fe623343..00000000 --- a/Game/Code/Classes/UModules.pas +++ /dev/null @@ -1,26 +0,0 @@ -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 deleted file mode 100644 index 8bbd297a..00000000 --- a/Game/Code/Classes/UMusic.pas +++ /dev/null @@ -1,515 +0,0 @@ -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 deleted file mode 100644 index b0b400db..00000000 --- a/Game/Code/Classes/UParty.pas +++ /dev/null @@ -1,616 +0,0 @@ -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 deleted file mode 100644 index bfb03d54..00000000 --- a/Game/Code/Classes/UPlatform.pas +++ /dev/null @@ -1,80 +0,0 @@ -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 deleted file mode 100644 index 0883b0f8..00000000 --- a/Game/Code/Classes/UPlatformLinux.pas +++ /dev/null @@ -1,214 +0,0 @@ -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 deleted file mode 100644 index 7b081607..00000000 --- a/Game/Code/Classes/UPlatformMacOSX.pas +++ /dev/null @@ -1,142 +0,0 @@ -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 deleted file mode 100644 index d4ba757a..00000000 --- a/Game/Code/Classes/UPlatformWindows.pas +++ /dev/null @@ -1,227 +0,0 @@ -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 deleted file mode 100644 index 2c09c493..00000000 --- a/Game/Code/Classes/UPlaylist.pas +++ /dev/null @@ -1,470 +0,0 @@ -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 deleted file mode 100644 index f4e8ff97..00000000 --- a/Game/Code/Classes/UPliki.pas +++ /dev/null @@ -1,835 +0,0 @@ -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 deleted file mode 100644 index 6a83d7c3..00000000 --- a/Game/Code/Classes/UPluginInterface.pas +++ /dev/null @@ -1,156 +0,0 @@ -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 deleted file mode 100644 index 8ae0978a..00000000 --- a/Game/Code/Classes/URecord.pas +++ /dev/null @@ -1,535 +0,0 @@ -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 deleted file mode 100644 index be1fcf2c..00000000 --- a/Game/Code/Classes/UServices.pas +++ /dev/null @@ -1,326 +0,0 @@ -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 deleted file mode 100644 index f0754105..00000000 --- a/Game/Code/Classes/USingNotes.pas +++ /dev/null @@ -1,13 +0,0 @@ -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 deleted file mode 100644 index 894f5782..00000000 --- a/Game/Code/Classes/USingScores.pas +++ /dev/null @@ -1,990 +0,0 @@ -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 deleted file mode 100644 index e6056ee4..00000000 --- a/Game/Code/Classes/USkins.pas +++ /dev/null @@ -1,184 +0,0 @@ -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 deleted file mode 100644 index 39220f1c..00000000 --- a/Game/Code/Classes/USong.pas +++ /dev/null @@ -1,726 +0,0 @@ -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 deleted file mode 100644 index b502f703..00000000 --- a/Game/Code/Classes/USongs.pas +++ /dev/null @@ -1,893 +0,0 @@ -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 deleted file mode 100644 index a09456b8..00000000 --- a/Game/Code/Classes/UTextClasses.pas +++ /dev/null @@ -1,60 +0,0 @@ -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 deleted file mode 100644 index deff8b94..00000000 --- a/Game/Code/Classes/UTexture.pas +++ /dev/null @@ -1,1174 +0,0 @@ -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 deleted file mode 100644 index bfffb26a..00000000 --- a/Game/Code/Classes/UThemes.pas +++ /dev/null @@ -1,2313 +0,0 @@ -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 deleted file mode 100644 index 3b7749a2..00000000 --- a/Game/Code/Classes/UTime.pas +++ /dev/null @@ -1,102 +0,0 @@ -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 deleted file mode 100644 index 66c0c8e6..00000000 --- a/Game/Code/Classes/UVideo.pas +++ /dev/null @@ -1,688 +0,0 @@ -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 deleted file mode 100644 index 2f584299..00000000 --- a/Game/Code/Classes/UVisualizer.pas +++ /dev/null @@ -1,394 +0,0 @@ -{############################################################################
-# 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 deleted file mode 100644 index 2414002c..00000000 --- a/Game/Code/Classes/Ulazjpeg.pas +++ /dev/null @@ -1,151 +0,0 @@ -{ 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 deleted file mode 100644 index b018ccc2..00000000 --- a/Game/Code/Classes/uPluginLoader.pas +++ /dev/null @@ -1,801 +0,0 @@ -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.
|