From: FGSFDSFGS Date: Tue, 5 Apr 2016 20:59:14 +0000 (+0300) Subject: initial commit: X-Git-Url: http://deadsoftware.ru/gitweb?p=d2df-sdl.git;a=commitdiff_plain;h=88ce644db1b40111bdb380f4357fa59bdb5173be initial commit: --- 88ce644db1b40111bdb380f4357fa59bdb5173be diff --git a/.gitattributes b/.gitattributes new file mode 100644 index 0000000..bdb0cab --- /dev/null +++ b/.gitattributes @@ -0,0 +1,17 @@ +# Auto detect text files and perform LF normalization +* text=auto + +# Custom for Visual Studio +*.cs diff=csharp + +# Standard to msysgit +*.doc diff=astextplain +*.DOC diff=astextplain +*.docx diff=astextplain +*.DOCX diff=astextplain +*.dot diff=astextplain +*.DOT diff=astextplain +*.pdf diff=astextplain +*.PDF diff=astextplain +*.rtf diff=astextplain +*.RTF diff=astextplain diff --git a/.gitignore b/.gitignore new file mode 100644 index 0000000..2689e70 --- /dev/null +++ b/.gitignore @@ -0,0 +1,23 @@ +# Precompiled and Delphi-specific files +# without *.res +*.exe +*.obj +*.dcu +*.cbk +*.dof +*.ddp +*.o +*.or + +# Commonly used temporary files +~* +*.~* +*.tmp +*.bak + +# Windows-specific +AppPackages/ +$RECYCLE.BIN/ +Thumbs.db +ehthumbs.db +Desktop.ini diff --git a/bin/.gitignore b/bin/.gitignore new file mode 100644 index 0000000..c96a04f --- /dev/null +++ b/bin/.gitignore @@ -0,0 +1,2 @@ +* +!.gitignore \ No newline at end of file diff --git a/build.bat b/build.bat new file mode 100644 index 0000000..4c682e8 --- /dev/null +++ b/build.bat @@ -0,0 +1,5 @@ +@echo off +cd "./src/game" +fpc -MDELPHI -O2 -FE../../bin -FU../../tmp Doom2DF.dpr +cd ".." +pause \ No newline at end of file diff --git a/clean.bat b/clean.bat new file mode 100644 index 0000000..310c2b0 --- /dev/null +++ b/clean.bat @@ -0,0 +1,13 @@ +@echo off +del /S "tmp\*.res" +del /S *.~* +del /S *.dcu +del /S *.ddp +del /S *.o +del /S *.ppu +del /S *.a +del /S *.or +del "src\game\CustomRes.obj" +del "src\game\*.exe" + +pause \ No newline at end of file diff --git a/src/engine/e_fixedbuffer.pas b/src/engine/e_fixedbuffer.pas new file mode 100644 index 0000000..63570f7 --- /dev/null +++ b/src/engine/e_fixedbuffer.pas @@ -0,0 +1,296 @@ +unit e_fixedbuffer; + +interface + +uses md5; + +const + BUF_SIZE = 65536; + +type + TBuffer = record + Data: array [0..BUF_SIZE] of Byte; // îäèí áàéò ñâåðõó íà âñÿêèé ñëó÷àé + ReadPos: Cardinal; + WritePos: Cardinal; + Len: Cardinal; + end; + pTBuffer = ^TBuffer; + +var + RawPos: Cardinal = 0; + +procedure e_Buffer_Clear(B: pTBuffer); + + +procedure e_Buffer_Write_Generic(B: pTBuffer; var V; N: Cardinal); +procedure e_Buffer_Read_Generic(B: pTBuffer; var V; N: Cardinal); + + +procedure e_Buffer_Write(B: pTBuffer; V: Char); overload; + +procedure e_Buffer_Write(B: pTBuffer; V: Byte); overload; +procedure e_Buffer_Write(B: pTBuffer; V: Word); overload; +procedure e_Buffer_Write(B: pTBuffer; V: LongWord); overload; + +procedure e_Buffer_Write(B: pTBuffer; V: ShortInt); overload; +procedure e_Buffer_Write(B: pTBuffer; V: SmallInt); overload; +procedure e_Buffer_Write(B: pTBuffer; V: LongInt); overload; + +procedure e_Buffer_Write(B: pTBuffer; V: string); overload; + +procedure e_Buffer_Write(B: pTBuffer; V: TMD5Digest); overload; + + +function e_Buffer_Read_Char(B: pTBuffer): Char; + +function e_Buffer_Read_Byte(B: pTBuffer): Byte; +function e_Buffer_Read_Word(B: pTBuffer): Word; +function e_Buffer_Read_LongWord(B: pTBuffer): LongWord; + +function e_Buffer_Read_ShortInt(B: pTBuffer): ShortInt; +function e_Buffer_Read_SmallInt(B: pTBuffer): SmallInt; +function e_Buffer_Read_LongInt(B: pTBuffer): LongInt; + +function e_Buffer_Read_String(B: pTBuffer): string; + +function e_Buffer_Read_MD5(B: pTBuffer): TMD5Digest; + + +procedure e_Raw_Read_Generic(P: Pointer; var V; N: Cardinal); + +function e_Raw_Read_Char(P: Pointer): Char; + +function e_Raw_Read_Byte(P: Pointer): Byte; +function e_Raw_Read_Word(P: Pointer): Word; +function e_Raw_Read_LongWord(P: Pointer): LongWord; + +function e_Raw_Read_ShortInt(P: Pointer): ShortInt; +function e_Raw_Read_SmallInt(P: Pointer): SmallInt; +function e_Raw_Read_LongInt(P: Pointer): LongInt; + +function e_Raw_Read_String(P: Pointer): string; + +function e_Raw_Read_MD5(P: Pointer): TMD5Digest; + +procedure e_Raw_Seek(I: Cardinal); + +implementation + +uses SysUtils, BinEditor; + +procedure e_Buffer_Clear(B: pTBuffer); +begin + B^.WritePos := 0; + B^.ReadPos := 0; + B^.Len := 0; +end; + + +procedure e_Buffer_Write_Generic(B: pTBuffer; var V; N: Cardinal); +begin + if (B^.WritePos + N >= BUF_SIZE) then Exit; + if (B^.WritePos + N > B^.Len) then + B^.Len := B^.WritePos + N + 1; + + CopyMemory(Pointer(Cardinal(Addr(B^.Data)) + B^.WritePos), + @V, N); + + B^.WritePos := B^.WritePos + N; +end; +procedure e_Buffer_Read_Generic(B: pTBuffer; var V; N: Cardinal); +begin + if (B^.ReadPos + N >= BUF_SIZE) then Exit; + + CopyMemory(@V, Pointer(Cardinal(Addr(B^.Data)) + B^.ReadPos), N); + + B^.ReadPos := B^.ReadPos + N; +end; + + +procedure e_Buffer_Write(B: pTBuffer; V: Char); overload; +begin + e_Buffer_Write_Generic(B, V, 1); +end; + +procedure e_Buffer_Write(B: pTBuffer; V: Byte); overload; +begin + e_Buffer_Write_Generic(B, V, 1); +end; +procedure e_Buffer_Write(B: pTBuffer; V: Word); overload; +begin + e_Buffer_Write_Generic(B, V, 2); +end; +procedure e_Buffer_Write(B: pTBuffer; V: LongWord); overload; +begin + e_Buffer_Write_Generic(B, V, 4); +end; + +procedure e_Buffer_Write(B: pTBuffer; V: ShortInt); overload; +begin + e_Buffer_Write_Generic(B, V, 1); +end; +procedure e_Buffer_Write(B: pTBuffer; V: SmallInt); overload; +begin + e_Buffer_Write_Generic(B, V, 2); +end; +procedure e_Buffer_Write(B: pTBuffer; V: LongInt); overload; +begin + e_Buffer_Write_Generic(B, V, 4); +end; + +procedure e_Buffer_Write(B: pTBuffer; V: string); overload; +var + Len: Byte; + P: Cardinal; +begin + Len := Length(V); + e_Buffer_Write_Generic(B, Len, 1); + + if (Len = 0) then Exit; + + P := B^.WritePos + Len; + if (P >= BUF_SIZE) then + begin + Len := BUF_SIZE - B^.WritePos; + P := BUF_SIZE; + end; + + if (P > B^.Len) then B^.Len := P; + + CopyMemory(Pointer(Cardinal(Addr(B^.Data)) + B^.WritePos), + @V[1], Len); + + B^.WritePos := P; +end; + +procedure e_Buffer_Write(B: pTBuffer; V: TMD5Digest); overload; +var + I: Integer; +begin + for I := 0 to 15 do + e_Buffer_Write(B, V[I]); +end; + + +function e_Buffer_Read_Char(B: pTBuffer): Char; +begin + e_Buffer_Read_Generic(B, Result, 1); +end; + +function e_Buffer_Read_Byte(B: pTBuffer): Byte; +begin + e_Buffer_Read_Generic(B, Result, 1); +end; +function e_Buffer_Read_Word(B: pTBuffer): Word; +begin + e_Buffer_Read_Generic(B, Result, 2); +end; +function e_Buffer_Read_LongWord(B: pTBuffer): LongWord; +begin + e_Buffer_Read_Generic(B, Result, 4); +end; + +function e_Buffer_Read_ShortInt(B: pTBuffer): ShortInt; +begin + e_Buffer_Read_Generic(B, Result, 1); +end; +function e_Buffer_Read_SmallInt(B: pTBuffer): SmallInt; +begin + e_Buffer_Read_Generic(B, Result, 2); +end; +function e_Buffer_Read_LongInt(B: pTBuffer): LongInt; +begin + e_Buffer_Read_Generic(B, Result, 4); +end; + +function e_Buffer_Read_String(B: pTBuffer): string; +var + Len: Byte; +begin + Len := e_Buffer_Read_Byte(B); + Result := ''; + if Len = 0 then Exit; + + if B^.ReadPos + Len > B^.Len then + Len := B^.Len - B^.ReadPos; + + SetLength(Result, Len); + CopyMemory(@Result[1], Pointer(Cardinal(Addr(B^.Data)) + B^.ReadPos), Len); + + B^.ReadPos := B^.ReadPos + Len; +end; + +function e_Buffer_Read_MD5(B: pTBuffer): TMD5Digest; +var + I: Integer; +begin + for I := 0 to 15 do + Result[I] := e_Buffer_Read_Byte(B); +end; + +procedure e_Raw_Read_Generic(P: Pointer; var V; N: Cardinal); +begin + CopyMemory(@V, Pointer(Cardinal(P) + RawPos), N); + + RawPos := RawPos + N; +end; + +function e_Raw_Read_Char(P: Pointer): Char; +begin + e_Raw_Read_Generic(P, Result, 1); +end; + +function e_Raw_Read_Byte(P: Pointer): Byte; +begin + e_Raw_Read_Generic(P, Result, 1); +end; +function e_Raw_Read_Word(P: Pointer): Word; +begin + e_Raw_Read_Generic(P, Result, 2); +end; +function e_Raw_Read_LongWord(P: Pointer): LongWord; +begin + e_Raw_Read_Generic(P, Result, 4); +end; + +function e_Raw_Read_ShortInt(P: Pointer): ShortInt; +begin + e_Raw_Read_Generic(P, Result, 1); +end; +function e_Raw_Read_SmallInt(P: Pointer): SmallInt; +begin + e_Raw_Read_Generic(P, Result, 2); +end; +function e_Raw_Read_LongInt(P: Pointer): LongInt; +begin + e_Raw_Read_Generic(P, Result, 4); +end; + +function e_Raw_Read_String(P: Pointer): string; +var + Len: Byte; +begin + Len := e_Raw_Read_Byte(P); + Result := ''; + if Len = 0 then Exit; + + SetLength(Result, Len); + CopyMemory(@Result[1], Pointer(Cardinal(P) + RawPos), Len); + + RawPos := RawPos + Len; +end; + +function e_Raw_Read_MD5(P: Pointer): TMD5Digest; +var + I: Integer; +begin + for I := 0 to 15 do + Result[I] := e_Raw_Read_Byte(P); +end; + +procedure e_Raw_Seek(I: Cardinal); +begin + RawPos := I; +end; + +end. diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas new file mode 100644 index 0000000..49bdaa6 --- /dev/null +++ b/src/engine/e_graphics.pas @@ -0,0 +1,1762 @@ +unit e_graphics; + +interface + +uses + SysUtils, Math, e_log, e_textures, SDL, GL, GLExt, MAPDEF; + +type + TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL); + TBlending=(B_NONE, B_BLEND, B_FILTER, B_INVERT); + + TPoint2i = record + X, Y: Integer; + end; + + TPoint = MAPDEF.TPoint; // TODO: create an utiltypes.pas or something + // for other types like rect as well + + TPoint2f = record + X, Y: Double; + end; + + TRect = record + Left, Top, Right, Bottom: Integer; + end; + + TRectWH = record + X, Y: Integer; + Width, Height: Word; + end; + + TRGB = packed record + R, G, B: Byte; + end; + + PPoint = ^TPoint; + PPoint2f = ^TPoint2f; + PRect = ^TRect; + PRectWH = ^TRectWH; + + +//------------------------------------------------------------------ +// ïðîòîòèïû ôóíêöèé +//------------------------------------------------------------------ +procedure e_InitGL(); +procedure e_SetViewPort(X, Y, Width, Height: Word); +procedure e_ResizeWindow(Width, Height: Integer); + +procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Mirror: TMirrorType = M_NONE); +procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Angle: Single; RC: PPoint; Mirror: TMirrorType = M_NONE); +procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE); +procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE); +procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer; + AlphaChannel: Boolean; Blending: Boolean); +procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte); +procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0); +procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0); +procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte; + Blending: TBlending = B_NONE); + +function e_CreateTexture(FileName: string; var ID: DWORD): Boolean; +function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean; +function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean; +function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean; +procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord); +function e_GetTextureSize2(ID: DWORD): TRectWH; +procedure e_DeleteTexture(ID: DWORD); +procedure e_RemoveAllTextures(); + +// CharFont +function e_CharFont_Create(sp: ShortInt=0): DWORD; +procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte); +procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string); +procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string; + Color: TRGB; Scale: Single = 1.0); +procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string); +procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word); +procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word); +function e_CharFont_GetMaxWidth(FontID: DWORD): Word; +function e_CharFont_GetMaxHeight(FontID: DWORD): Word; +procedure e_CharFont_Remove(FontID: DWORD); +procedure e_CharFont_RemoveAll(); + +// TextureFont +procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word; + Space: ShortInt=0); +procedure e_TextureFontKill(FontID: DWORD); +procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD); +procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green, + Blue: Byte; Scale: Single; Shadow: Boolean = False); +procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False); +procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte); +procedure e_RemoveAllTextureFont(); + +procedure e_ReleaseEngine(); +procedure e_BeginRender(); +procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload; +procedure e_Clear(); overload; +procedure e_EndRender(); + +procedure e_SaveGLContext(); +procedure e_RestoreGLContext(); + +function e_GetGamma(): Byte; +procedure e_SetGamma(Gamma: Byte); + +procedure e_MakeScreenshot(FileName: string; Width, Height: Word); + +function _RGB(Red, Green, Blue: Byte): TRGB; +function _Point(X, Y: Integer): TPoint2i; +function _Rect(X, Y: Integer; Width, Height: Word): TRectWH; +function _TRect(L, T, R, B: LongInt): TRect; + + +var + e_Colors: TRGB; + +implementation + +type + TTexture = record + ID: DWORD; + Width: Word; + Height: Word; + Fmt: Word; + end; + + TTextureFont = record + Texture: DWORD; + TextureID: DWORD; + Base: Uint32; + CharWidth: Byte; + CharHeight: Byte; + XC, YC, SPC: Word; + end; + + TCharFont = record + Chars: array[0..255] of + record + TextureID: Integer; + Width: Byte; + end; + Space: ShortInt; + Height: ShortInt; + Live: Boolean; + end; + + TSavedTexture = record + TexID: DWORD; + OldID: DWORD; + Pixels: Pointer; + end; + +var + e_Textures: array of TTexture = nil; + e_TextureFonts: array of TTextureFont = nil; + e_CharFonts: array of TCharFont; + e_SavedTextures: array of TSavedTexture; + +//------------------------------------------------------------------ +// Èíèöèàëèçèðóåò OpenGL +//------------------------------------------------------------------ +procedure e_InitGL(); +begin + glDisable(GL_DEPTH_TEST); + glEnable(GL_SCISSOR_TEST); + e_Colors.R := 255; + e_Colors.G := 255; + e_Colors.B := 255; + glClearColor(0, 0, 0, 0); +end; + +procedure e_SetViewPort(X, Y, Width, Height: Word); +var + mat: Array [0..15] of GLDouble; + +begin + glLoadIdentity(); + glScissor(X, Y, Width, Height); + glViewport(X, Y, Width, Height); + //gluOrtho2D(0, Width, Height, 0); + + glMatrixMode(GL_PROJECTION); + + mat[ 0] := 2.0 / Width; + mat[ 1] := 0.0; + mat[ 2] := 0.0; + mat[ 3] := 0.0; + + mat[ 4] := 0.0; + mat[ 5] := -2.0 / Height; + mat[ 6] := 0.0; + mat[ 7] := 0.0; + + mat[ 8] := 0.0; + mat[ 9] := 0.0; + mat[10] := 1.0; + mat[11] := 0.0; + + mat[12] := -1.0; + mat[13] := 1.0; + mat[14] := 0.0; + mat[15] := 1.0; + + glLoadMatrixd(@mat[0]); + + glMatrixMode(GL_MODELVIEW); + glLoadIdentity(); +end; + +//------------------------------------------------------------------ +// Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð +//------------------------------------------------------------------ +function FindTexture(): DWORD; +var + i: integer; +begin + if e_Textures <> nil then + for i := 0 to High(e_Textures) do + if e_Textures[i].Width = 0 then + begin + Result := i; + Exit; + end; + + if e_Textures = nil then + begin + SetLength(e_Textures, 32); + Result := 0; + end + else + begin + Result := High(e_Textures) + 1; + SetLength(e_Textures, Length(e_Textures) + 32); + end; +end; + +//------------------------------------------------------------------ +// Ñîçäàåò òåêñòóðó +//------------------------------------------------------------------ +function e_CreateTexture(FileName: String; var ID: DWORD): Boolean; +var + find_id: DWORD; + fmt: Word; +begin + Result := False; + + e_WriteLog('Loading texture from '+FileName, MSG_NOTIFY); + + find_id := FindTexture(); + + if not LoadTexture(FileName, e_Textures[find_id].ID, e_Textures[find_id].Width, + e_Textures[find_id].Height, @fmt) then Exit; + + ID := find_id; + e_Textures[ID].Fmt := fmt; + + Result := True; +end; + +function e_CreateTextureEx(FileName: String; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean; +var + find_id: DWORD; + fmt: Word; +begin + Result := False; + + find_id := FindTexture(); + + if not LoadTextureEx(FileName, e_Textures[find_id].ID, fX, fY, fWidth, fHeight, @fmt) then exit; + + e_Textures[find_id].Width := fWidth; + e_Textures[find_id].Height := fHeight; + e_Textures[find_id].Fmt := fmt; + + ID := find_id; + + Result := True; +end; + +function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean; +var + find_id: DWORD; + fmt: Word; +begin + Result := False; + + find_id := FindTexture; + + if not LoadTextureMem(pData, e_Textures[find_id].ID, e_Textures[find_id].Width, + e_Textures[find_id].Height, @fmt) then exit; + + id := find_id; + e_Textures[id].Fmt := fmt; + + Result := True; +end; + +function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean; +var + find_id: DWORD; + fmt: Word; +begin + Result := False; + + find_id := FindTexture(); + + if not LoadTextureMemEx(pData, e_Textures[find_id].ID, fX, fY, fWidth, fHeight, @fmt) then exit; + + e_Textures[find_id].Width := fWidth; + e_Textures[find_id].Height := fHeight; + e_Textures[find_id].Fmt := fmt; + + ID := find_id; + + Result := True; +end; + +procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord); +begin + if Width <> nil then Width^ := e_Textures[ID].Width; + if Height <> nil then Height^ := e_Textures[ID].Height; +end; + +function e_GetTextureSize2(ID: DWORD): TRectWH; +var + data: PChar; + x, y: Integer; + w, h: Word; + a: Boolean; + lastline: Integer; +begin + w := e_Textures[ID].Width; + h := e_Textures[ID].Height; + data := GetMemory(w*h*4); + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[ID].ID); + glGetTexImage(GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, data); + + Result.Y := 0; + Result.X := 0; + Result.Width := w; + Result.Height := h; + + for y := h-1 downto 0 do + begin + lastline := y; + a := True; + + for x := 1 to w-4 do + begin + a := Byte((data+y*w*4+x*4+3)^) <> 0; + if a then Break; + end; + + if a then + begin + Result.Y := h-lastline; + Break; + end; + end; + + for y := 0 to h-1 do + begin + lastline := y; + a := True; + + for x := 1 to w-4 do + begin + a := Byte((data+y*w*4+x*4+3)^) <> 0; + if a then Break; + end; + + if a then + begin + Result.Height := h-lastline-Result.Y; + Break; + end; + end; + + for x := 0 to w-1 do + begin + lastline := x; + a := True; + + for y := 1 to h-4 do + begin + a := Byte((data+y*w*4+x*4+3)^) <> 0; + if a then Break; + end; + + if a then + begin + Result.X := lastline+1; + Break; + end; + end; + + for x := w-1 downto 0 do + begin + lastline := x; + a := True; + + for y := 1 to h-4 do + begin + a := Byte((data+y*w*4+x*4+3)^) <> 0; + if a then Break; + end; + + if a then + begin + Result.Width := lastline-Result.X+1; + Break; + end; + end; + + FreeMemory(data); +end; + +procedure e_ResizeWindow(Width, Height: Integer); +begin + if Height = 0 then + Height := 1; + e_SetViewPort(0, 0, Width, Height); +end; + +procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Mirror: TMirrorType = M_NONE); +begin + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + if (Alpha > 0) or (AlphaChannel) or (Blending) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if (AlphaChannel) or (Alpha > 0) then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + if Alpha > 0 then + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha); + + if Blending then + glBlendFunc(GL_SRC_ALPHA, GL_ONE); + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[ID].ID); + glBegin(GL_QUADS); + + if Mirror = M_NONE then + begin + glTexCoord2i(1, 0); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y + e_Textures[id].Height); + glTexCoord2i(1, -1); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + end + else + if Mirror = M_HORIZONTAL then + begin + glTexCoord2i(1, 0); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, -1); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + glTexCoord2i(1, -1); glVertex2i(X, Y + e_Textures[id].Height); + end + else + if Mirror = M_VERTICAL then + begin + glTexCoord2i(1, -1); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y + e_Textures[id].Height); + glTexCoord2i(1, 0); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + end; + + glEnd(); + + glDisable(GL_BLEND); +end; + +procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE); +begin + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + if (Alpha > 0) or (AlphaChannel) or (Blending) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if (AlphaChannel) or (Alpha > 0) then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + if Alpha > 0 then + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha); + + if Blending then + glBlendFunc(GL_SRC_ALPHA, GL_ONE); + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[ID].ID); + + glBegin(GL_QUADS); + glTexCoord2i(0, 1); glVertex2i(X, Y); + glTexCoord2i(1, 1); glVertex2i(X + Width, Y); + glTexCoord2i(1, 0); glVertex2i(X + Width, Y + Height); + glTexCoord2i(0, 0); glVertex2i(X, Y + Height); + glEnd(); + + glDisable(GL_BLEND); +end; + +procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE); +begin + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + if (Alpha > 0) or (AlphaChannel) or (Blending) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if (AlphaChannel) or (Alpha > 0) then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + if Alpha > 0 then + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha); + + if Blending then + glBlendFunc(GL_SRC_ALPHA, GL_ONE); + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[ID].ID); + glBegin(GL_QUADS); + + if Mirror = M_NONE then + begin + glTexCoord2i(1, 0); glVertex2i(X + Width, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y + Height); + glTexCoord2i(1, -1); glVertex2i(X + Width, Y + Height); + end + else + if Mirror = M_HORIZONTAL then + begin + glTexCoord2i(1, 0); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X + Width, Y); + glTexCoord2i(0, -1); glVertex2i(X + Width, Y + Height); + glTexCoord2i(1, -1); glVertex2i(X, Y + Height); + end + else + if Mirror = M_VERTICAL then + begin + glTexCoord2i(1, -1); glVertex2i(X + Width, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y + Height); + glTexCoord2i(1, 0); glVertex2i(X + Width, Y + Height); + end; + + glEnd(); + + glDisable(GL_BLEND); +end; + +procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer; + AlphaChannel: Boolean; Blending: Boolean); +var + X2, Y2: Integer; + +begin + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + if (Alpha > 0) or (AlphaChannel) or (Blending) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if (AlphaChannel) or (Alpha > 0) then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + if Alpha > 0 then + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha); + + if Blending then + glBlendFunc(GL_SRC_ALPHA, GL_ONE); + + if XCount = 0 then + XCount := 1; + + if YCount = 0 then + YCount := 1; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[ID].ID); + + X2 := X + e_Textures[ID].Width * XCount; + Y2 := Y + e_Textures[ID].Height * YCount; + + glBegin(GL_QUADS); + glTexCoord2i(0, YCount); glVertex2i(X, Y); + glTexCoord2i(XCount, YCount); glVertex2i(X2, Y); + glTexCoord2i(XCount, 0); glVertex2i(X2, Y2); + glTexCoord2i(0, 0); glVertex2i(X, Y2); + glEnd(); + + glDisable(GL_BLEND); +end; + +procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean; + Blending: Boolean; Angle: Single; RC: PPoint; Mirror: TMirrorType = M_NONE); +begin + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + if (Alpha > 0) or (AlphaChannel) or (Blending) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if (AlphaChannel) or (Alpha > 0) then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + if Alpha > 0 then + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha); + + if Blending then + glBlendFunc(GL_SRC_ALPHA, GL_ONE); + + if (Angle <> 0) and (RC <> nil) then + begin + glPushMatrix(); + glTranslatef(X+RC.X, Y+RC.Y, 0); + glRotatef(Angle, 0, 0, 1); + glTranslatef(-(X+RC.X), -(Y+RC.Y), 0); + end; + + glEnable(GL_TEXTURE_2D); + glBindTexture(GL_TEXTURE_2D, e_Textures[id].ID); + glBegin(GL_QUADS); //0-1 1-1 + //00 10 + if Mirror = M_NONE then + begin + glTexCoord2i(1, 0); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y + e_Textures[id].Height); + glTexCoord2i(1, -1); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + end + else + if Mirror = M_HORIZONTAL then + begin + glTexCoord2i(1, 0); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, -1); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + glTexCoord2i(1, -1); glVertex2i(X, Y + e_Textures[id].Height); + end + else + if Mirror = M_VERTICAL then + begin + glTexCoord2i(1, -1); glVertex2i(X + e_Textures[id].Width, Y); + glTexCoord2i(0, -1); glVertex2i(X, Y); + glTexCoord2i(0, 0); glVertex2i(X, Y + e_Textures[id].Height); + glTexCoord2i(1, 0); glVertex2i(X + e_Textures[id].Width, Y + e_Textures[id].Height); + end; + + glEnd(); + + if Angle <> 0 then + glPopMatrix(); + + glDisable(GL_BLEND); +end; + +procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte); +begin + glDisable(GL_TEXTURE_2D); + glColor3ub(Red, Green, Blue); + glPointSize(Size); + + if (Size = 2) or (Size = 4) then + X := X + 1; + + glBegin(GL_POINTS); + glVertex2f(X+0.3, Y+1.0); + glEnd(); + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); +end; + +procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer); +begin + // Make lines only top-left/bottom-right and top-right/bottom-left + if Y2 < Y1 then + begin + X1 := X1 xor X2; + X2 := X1 xor X2; + X1 := X1 xor X2; + + Y1 := Y1 xor Y2; + Y2 := Y1 xor Y2; + Y1 := Y1 xor Y2; + end; + + // Pixel-perfect hack + if X1 < X2 then + Inc(X2) + else + Inc(X1); + Inc(Y2); +end; + +procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0); +var + nX1, nY1, nX2, nY2: Integer; +begin + // Only top-left/bottom-right quad + if X1 > X2 then + begin + X1 := X1 xor X2; + X2 := X1 xor X2; + X1 := X1 xor X2; + end; + if Y1 > Y2 then + begin + Y1 := Y1 xor Y2; + Y2 := Y1 xor Y2; + Y1 := Y1 xor Y2; + end; + + if Alpha > 0 then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end else + glDisable(GL_BLEND); + + glDisable(GL_TEXTURE_2D); + glColor4ub(Red, Green, Blue, 255-Alpha); + glLineWidth(1); + + glBegin(GL_LINES); + nX1 := X1; nY1 := Y1; + nX2 := X2; nY2 := Y1; + e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines + glVertex2i(nX1, nY1); + glVertex2i(nX2, nY2); + + nX1 := X2; nY1 := Y1; + nX2 := X2; nY2 := Y2; + e_LineCorrection(nX1, nY1, nX2, nY2); + glVertex2i(nX1, nY1); + glVertex2i(nX2, nY2); + + nX1 := X2; nY1 := Y2; + nX2 := X1; nY2 := Y2; + e_LineCorrection(nX1, nY1, nX2, nY2); + glVertex2i(nX1, nY1); + glVertex2i(nX2, nY2); + + nX1 := X1; nY1 := Y2; + nX2 := X1; nY2 := Y1; + e_LineCorrection(nX1, nY1, nX2, nY2); + glVertex2i(nX1, nY1); + glVertex2i(nX2, nY2); + glEnd(); + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + glDisable(GL_BLEND); +end; + +procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte; + Blending: TBlending = B_NONE); +begin + if (Alpha > 0) or (Blending <> B_NONE) then + glEnable(GL_BLEND) + else + glDisable(GL_BLEND); + + if Blending = B_BLEND then + glBlendFunc(GL_SRC_ALPHA, GL_ONE) + else + if Blending = B_FILTER then + glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR) + else + if Blending = B_INVERT then + glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO) + else + if Alpha > 0 then + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + + glDisable(GL_TEXTURE_2D); + glColor4ub(Red, Green, Blue, 255-Alpha); + + X2 := X2 + 1; + Y2 := Y2 + 1; + + glBegin(GL_QUADS); + glVertex2i(X1, Y1); + glVertex2i(X2, Y1); + glVertex2i(X2, Y2); + glVertex2i(X1, Y2); + glEnd(); + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + glDisable(GL_BLEND); +end; + +procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0); +begin + // Pixel-perfect lines + if Width = 1 then + e_LineCorrection(X1, Y1, X2, Y2); + + if Alpha > 0 then + begin + glEnable(GL_BLEND); + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + end else + glDisable(GL_BLEND); + + glDisable(GL_TEXTURE_2D); + glColor4ub(Red, Green, Blue, 255-Alpha); + glLineWidth(Width); + + glBegin(GL_LINES); + glVertex2i(X1, Y1); + glVertex2i(X2, Y2); + glEnd(); + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + glDisable(GL_BLEND); +end; + +//------------------------------------------------------------------ +// Óäàëÿåò òåêñòóðó èç ìàññèâà +//------------------------------------------------------------------ +procedure e_DeleteTexture(ID: DWORD); +begin + glDeleteTextures(1, @e_Textures[ID].ID); + e_Textures[ID].ID := 0; + e_Textures[ID].Width := 0; + e_Textures[ID].Height := 0; +end; + +//------------------------------------------------------------------ +// Óäàëÿåò âñå òåêñòóðû +//------------------------------------------------------------------ +procedure e_RemoveAllTextures(); +var + i: integer; +begin + if e_Textures = nil then Exit; + + for i := 0 to High(e_Textures) do + if e_Textures[i].Width <> 0 then e_DeleteTexture(i); + e_Textures := nil; +end; + +//------------------------------------------------------------------ +// Óäàëÿåò äâèæîê +//------------------------------------------------------------------ +procedure e_ReleaseEngine(); +begin + e_RemoveAllTextures; + e_RemoveAllTextureFont; +end; + +procedure e_BeginRender(); +begin + glEnable(GL_ALPHA_TEST); + glAlphaFunc(GL_GREATER, 0.0); +end; + +procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload; +begin + glClearColor(Red, Green, Blue, 0); + glClear(Mask); +end; + +procedure e_Clear(); overload; +begin + glClearColor(0, 0, 0, 0); + glClear(GL_COLOR_BUFFER_BIT); +end; + +procedure e_EndRender(); +begin + glPopMatrix(); +end; + +procedure e_MakeScreenshot(FileName: String; Width, Height: Word); +begin +end; + +{type + aRGB = Array [0..1] of TRGB; + PaRGB = ^aRGB; + + TByteArray = Array [0..1] of Byte; + PByteArray = ^TByteArray; + +var + FILEHEADER: BITMAPFILEHEADER; + INFOHEADER: BITMAPINFOHEADER; + pixels: PByteArray; + tmp: Byte; + i: Integer; + F: File of Byte; + +begin + if (Width mod 4) > 0 then + Width := Width + 4 - (Width mod 4); + + GetMem(pixels, Width*Height*3); + glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels); + + for i := 0 to Width * Height - 1 do + with PaRGB(pixels)[i] do + begin + tmp := R; + R := B; + B := tmp; + end; + + with FILEHEADER do + begin + bfType := $4D42; // "BM" + bfSize := Width*Height*3 + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER); + bfReserved1 := 0; + bfReserved2 := 0; + bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER); + end; + + with INFOHEADER do + begin + biSize := SizeOf(BITMAPINFOHEADER); + biWidth := Width; + biHeight := Height; + biPlanes := 1; + biBitCount := 24; + biCompression := 0; + biSizeImage := Width*Height*3; + biXPelsPerMeter := 0; + biYPelsPerMeter := 0; + biClrUsed := 0; + biClrImportant := 0; + end; + + AssignFile(F, FileName); + Rewrite(F); + + BlockWrite(F, FILEHEADER, SizeOf(FILEHEADER)); + BlockWrite(F, INFOHEADER, SizeOf(INFOHEADER)); + BlockWrite(F, pixels[0], Width*Height*3); + + CloseFile(F); + + FreeMem(pixels); +end;} + +function e_GetGamma(): Byte; +var + ramp: array [0..256*3-1] of Word; + rgb: array [0..2] of Double; + sum: double; + count: integer; + min: integer; + max: integer; + A, B: double; + i, j: integer; +begin + rgb[0] := 1.0; + rgb[1] := 1.0; + rgb[2] := 1.0; + + SDL_GetGammaRamp(@ramp[0], @ramp[256], @ramp[512]); + + for i := 0 to 2 do + begin + sum := 0; + count := 0; + min := 256 * i; + max := min + 256; + + for j := min to max - 1 do + if ramp[j] > 0 then + begin + B := (j mod 256)/256; + A := ramp[j]/65536; + sum := sum + ln(A)/ln(B); + inc(count); + end; + rgb[i] := sum / count; + end; + + Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23)); +end; + +procedure e_SetGamma(Gamma: Byte); +var + ramp: array [0..256*3-1] of Word; + i: integer; + r: double; + g: double; +begin + g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23; + + for i := 0 to 255 do + begin + r := Exp(g * ln(i/256))*65536; + if r < 0 then r := 0 + else if r > 65535 then r := 65535; + ramp[i] := trunc(r); + ramp[i + 256] := trunc(r); + ramp[i + 512] := trunc(r); + end; + + SDL_SetGammaRamp(@ramp[0], @ramp[256], @ramp[512]); +end; + +function e_CharFont_Create(sp: ShortInt=0): DWORD; +var + i, id: DWORD; +begin + e_WriteLog('Creating CharFont...', MSG_NOTIFY); + + id := DWORD(-1); + + if e_CharFonts <> nil then + for i := 0 to High(e_CharFonts) do + if not e_CharFonts[i].Live then + begin + id := i; + Break; + end; + + if id = DWORD(-1) then + begin + SetLength(e_CharFonts, Length(e_CharFonts) + 1); + id := High(e_CharFonts); + end; + + with e_CharFonts[id] do + begin + for i := 0 to High(Chars) do + with Chars[i] do + begin + TextureID := -1; + Width := 0; + end; + + Space := sp; + Live := True; + end; + + Result := id; +end; + +procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte); +begin + with e_CharFonts[FontID].Chars[Ord(c)] do + begin + TextureID := Texture; + Width := w; + end; +end; + +procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string); +var + a: Integer; +begin + if Text = '' then Exit; + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + with e_CharFonts[FontID] do + begin + for a := 1 to Length(Text) do + with Chars[Ord(Text[a])] do + if TextureID <> -1 then + begin + e_Draw(TextureID, X, Y, 0, True, False); + X := X+Width+IfThen(a = Length(Text), 0, Space); + end; + end; +end; + +procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string; + Color: TRGB; Scale: Single = 1.0); +var + a: Integer; + c: TRGB; +begin + if Text = '' then Exit; + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + with e_CharFonts[FontID] do + begin + for a := 1 to Length(Text) do + with Chars[Ord(Text[a])] do + if TextureID <> -1 then + begin + if Scale <> 1.0 then + begin + glPushMatrix; + glScalef(Scale, Scale, 0); + end; + + c := e_Colors; + e_Colors := Color; + e_Draw(TextureID, X, Y, 0, True, False); + e_Colors := c; + + if Scale <> 1.0 then glPopMatrix; + + X := X+Width+IfThen(a = Length(Text), 0, Space); + end; + end; +end; + +procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string); +var + a, TX, TY, len: Integer; + tc, c: TRGB; + w, h: Word; +begin + if Text = '' then Exit; + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + c.R := 255; + c.G := 255; + c.B := 255; + + TX := X; + TY := Y; + len := Length(Text); + + e_CharFont_GetSize(FontID, 'A', w, h); + + with e_CharFonts[FontID] do + begin + for a := 1 to len do + begin + case Text[a] of + #10: // line feed + begin + TX := X; + TY := TY + h; + continue; + end; + #1: // black + begin + c.R := 0; c.G := 0; c.B := 0; + continue; + end; + #2: // white + begin + c.R := 255; c.G := 255; c.B := 255; + continue; + end; + #3: // darker + begin + c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2; + continue; + end; + #4: // lighter + begin + c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255); + continue; + end; + #18: // red + begin + c.R := 255; c.G := 0; c.B := 0; + continue; + end; + #19: // green + begin + c.R := 0; c.G := 255; c.B := 0; + continue; + end; + #20: // blue + begin + c.R := 0; c.G := 0; c.B := 255; + continue; + end; + #21: // yellow + begin + c.R := 255; c.G := 255; c.B := 0; + continue; + end; + end; + + with Chars[Ord(Text[a])] do + if TextureID <> -1 then + begin + tc := e_Colors; + e_Colors := c; + e_Draw(TextureID, TX, TY, 0, True, False); + e_Colors := tc; + + TX := TX+Width+IfThen(a = Length(Text), 0, Space); + end; + end; + end; +end; + +procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word); +var + a: Integer; + h2: Word; +begin + w := 0; + h := 0; + + if Text = '' then Exit; + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + with e_CharFonts[FontID] do + begin + for a := 1 to Length(Text) do + with Chars[Ord(Text[a])] do + if TextureID <> -1 then + begin + w := w+Width+IfThen(a = Length(Text), 0, Space); + e_GetTextureSize(TextureID, nil, @h2); + if h2 > h then h := h2; + end; + end; +end; + +procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word); +var + a, lines, len: Integer; + h2, w2: Word; +begin + w2 := 0; + w := 0; + h := 0; + + if Text = '' then Exit; + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + lines := 1; + len := Length(Text); + + with e_CharFonts[FontID] do + begin + for a := 1 to len do + begin + if Text[a] = #10 then + begin + Inc(lines); + if w2 > w then + begin + w := w2; + w2 := 0; + end; + continue; + end + else if Text[a] in [#1, #2, #3, #4, #18, #19, #20, #21] then + continue; + + with Chars[Ord(Text[a])] do + if TextureID <> -1 then + begin + w2 := w2 + Width + IfThen(a = len, 0, Space); + e_GetTextureSize(TextureID, nil, @h2); + if h2 > h then h := h2; + end; + end; + end; + + if w2 > w then + w := w2; + h := h * lines; +end; + +function e_CharFont_GetMaxWidth(FontID: DWORD): Word; +var + a: Integer; +begin + Result := 0; + + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + for a := 0 to High(e_CharFonts[FontID].Chars) do + Result := Max(Result, e_CharFonts[FontID].Chars[a].Width); +end; + +function e_CharFont_GetMaxHeight(FontID: DWORD): Word; +var + a: Integer; + h2: Word; +begin + Result := 0; + + if e_CharFonts = nil then Exit; + if Integer(FontID) > High(e_CharFonts) then Exit; + + for a := 0 to High(e_CharFonts[FontID].Chars) do + begin + if e_CharFonts[FontID].Chars[a].TextureID <> -1 then + e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2) + else h2 := 0; + if h2 > Result then Result := h2; + end; +end; + +procedure e_CharFont_Remove(FontID: DWORD); +var + a: Integer; +begin + with e_CharFonts[FontID] do + for a := 0 to High(Chars) do + if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID); + + e_CharFonts[FontID].Live := False; +end; + +procedure e_CharFont_RemoveAll(); +var + a: Integer; +begin + if e_CharFonts = nil then Exit; + + for a := 0 to High(e_CharFonts) do + e_CharFont_Remove(a); + + e_CharFonts := nil; +end; + +procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word; + Space: ShortInt=0); +var + loop1 : GLuint; + cx, cy : real; + i, id: DWORD; +begin + e_WriteLog('Creating texture font...', MSG_NOTIFY); + + id := DWORD(-1); + + if e_TextureFonts <> nil then + for i := 0 to High(e_TextureFonts) do + if e_TextureFonts[i].Base = 0 then + begin + id := i; + Break; + end; + + if id = DWORD(-1) then + begin + SetLength(e_TextureFonts, Length(e_TextureFonts) + 1); + id := High(e_TextureFonts); + end; + + with e_TextureFonts[id] do + begin + Base := glGenLists(XCount*YCount); + TextureID := e_Textures[Tex].ID; + CharWidth := (e_Textures[Tex].Width div XCount)+Space; + CharHeight := e_Textures[Tex].Height div YCount; + XC := XCount; + YC := YCount; + Texture := Tex; + SPC := Space; + end; + + glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].ID); + for loop1 := 0 to XCount*YCount-1 do + begin + cx := (loop1 mod XCount)/XCount; + cy := (loop1 div YCount)/YCount; + + glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE); + glBegin(GL_QUADS); + glTexCoord2f(cx, 1.0-cy-1/YCount); + glVertex2d(0, e_Textures[Tex].Height div YCount); + + glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount); + glVertex2i(e_Textures[Tex].Width div XCount, e_Textures[Tex].Height div YCount); + + glTexCoord2f(cx+1/XCount, 1.0-cy); + glVertex2i(e_Textures[Tex].Width div XCount, 0); + + glTexCoord2f(cx, 1.0-cy); + glVertex2i(0, 0); + glEnd(); + glTranslated((e_Textures[Tex].Width div XCount)+Space, 0, 0); + glEndList(); + end; + + FontID := id; +end; + +procedure e_TextureFontBuildInPlace(id: DWORD); +var + loop1 : GLuint; + cx, cy : real; + XCount, YCount, Space: Integer; + {i,} Tex: DWORD; +begin + with e_TextureFonts[id] do + begin + Base := glGenLists(XC*YC); + TextureID := e_Textures[Texture].ID; + XCount := XC; + YCount := YC; + Space := SPC; + Tex := Texture; + end; + + glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].ID); + for loop1 := 0 to XCount*YCount-1 do + begin + cx := (loop1 mod XCount)/XCount; + cy := (loop1 div YCount)/YCount; + + glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE); + glBegin(GL_QUADS); + glTexCoord2f(cx, 1.0-cy-1/YCount); + glVertex2d(0, e_Textures[Tex].Height div YCount); + + glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount); + glVertex2i(e_Textures[Tex].Width div XCount, e_Textures[Tex].Height div YCount); + + glTexCoord2f(cx+1/XCount, 1.0-cy); + glVertex2i(e_Textures[Tex].Width div XCount, 0); + + glTexCoord2f(cx, 1.0-cy); + glVertex2i(0, 0); + glEnd(); + glTranslated((e_Textures[Tex].Width div XCount)+Space, 0, 0); + glEndList(); + end; +end; + +procedure e_TextureFontKill(FontID: DWORD); +begin + glDeleteLists(e_TextureFonts[FontID].Base, 256); + e_TextureFonts[FontID].Base := 0; +end; + +procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD); +begin + if Integer(FontID) > High(e_TextureFonts) then Exit; + if Text = '' then Exit; + + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + + glPushMatrix; + glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID); + glEnable(GL_TEXTURE_2D); + glTranslated(x, y, 0); + glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32)); + glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text)); + glDisable(GL_TEXTURE_2D); + glPopMatrix; + + glDisable(GL_BLEND); +end; + +// god forgive me for this, but i cannot figure out how to do it without lists +procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False); +begin + glPushMatrix; + + if Shadow then + begin + glColor4ub(0, 0, 0, 128); + glTranslated(X+1, Y+1, 0); + glCallLists(1, GL_UNSIGNED_BYTE, @Ch); + glPopMatrix; + glPushMatrix; + end; + + glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255); + glTranslated(X, Y, 0); + glCallLists(1, GL_UNSIGNED_BYTE, @Ch); + + glPopMatrix; +end; + +procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False); +var + a, TX, TY, len: Integer; + tc, c: TRGB; + w: Word; +begin + if Text = '' then Exit; + if e_TextureFonts = nil then Exit; + if Integer(FontID) > High(e_TextureFonts) then Exit; + + c.R := 255; + c.G := 255; + c.B := 255; + + TX := X; + TY := Y; + len := Length(Text); + + w := e_TextureFonts[FontID].CharWidth; + + with e_TextureFonts[FontID] do + begin + glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID); + glEnable(GL_TEXTURE_2D); + glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32)); + + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + for a := 1 to len do + begin + case Text[a] of + {#10: // line feed + begin + TX := X; + TY := TY + h; + continue; + end;} + #1: // black + begin + c.R := 0; c.G := 0; c.B := 0; + continue; + end; + #2: // white + begin + c.R := 255; c.G := 255; c.B := 255; + continue; + end; + #3: // darker + begin + c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2; + continue; + end; + #4: // lighter + begin + c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255); + continue; + end; + #18: // red + begin + c.R := 255; c.G := 0; c.B := 0; + continue; + end; + #19: // green + begin + c.R := 0; c.G := 255; c.B := 0; + continue; + end; + #20: // blue + begin + c.R := 0; c.G := 0; c.B := 255; + continue; + end; + #21: // yellow + begin + c.R := 255; c.G := 255; c.B := 0; + continue; + end; + end; + + tc := e_Colors; + e_Colors := c; + e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow); + e_Colors := tc; + + TX := TX+w; + end; + glDisable(GL_TEXTURE_2D); + glDisable(GL_BLEND); + end; +end; + +procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green, + Blue: Byte; Scale: Single; Shadow: Boolean = False); +begin + if Text = '' then Exit; + + glPushMatrix; + glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID); + glEnable(GL_TEXTURE_2D); + glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32)); + + glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); + glEnable(GL_BLEND); + + if Shadow then + begin + glColor4ub(0, 0, 0, 128); + glTranslated(x+1, y+1, 0); + glScalef(Scale, Scale, 0); + glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text)); + glPopMatrix; + glPushMatrix; + end; + + glColor4ub(Red, Green, Blue, 255); + glTranslated(x, y, 0); + glScalef(Scale, Scale, 0); + glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text)); + + glDisable(GL_TEXTURE_2D); + glPopMatrix; + glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B); + glDisable(GL_BLEND); +end; + +procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte); +begin + if Integer(ID) > High(e_TextureFonts) then + Exit; + CharWidth := e_TextureFonts[ID].CharWidth; + CharHeight := e_TextureFonts[ID].CharHeight; +end; + +procedure e_RemoveAllTextureFont(); +var + i: integer; +begin + if e_TextureFonts = nil then Exit; + + for i := 0 to High(e_TextureFonts) do + if e_TextureFonts[i].Base <> 0 then + begin + glDeleteLists(e_TextureFonts[i].Base, 256); + e_TextureFonts[i].Base := 0; + end; + + e_TextureFonts := nil; +end; + +procedure e_SaveGLContext(); +var + PxLen: Cardinal; + i: Integer; +begin + e_WriteLog('Backing up GL context:', MSG_NOTIFY); + + glPushAttrib(GL_ALL_ATTRIB_BITS); + glPushClientAttrib(GL_CLIENT_ALL_ATTRIB_BITS); + + if e_Textures <> nil then + begin + e_WriteLog(' Backing up textures...', MSG_NOTIFY); + SetLength(e_SavedTextures, Length(e_Textures)); + for i := Low(e_Textures) to High(e_Textures) do + begin + e_SavedTextures[i].Pixels := nil; + if e_Textures[i].Width > 0 then + begin + with e_SavedTextures[i] do + begin + PxLen := 3; + if e_Textures[i].Fmt = GL_RGBA then Inc(PxLen); + Pixels := GetMem(PxLen * e_Textures[i].Width * e_Textures[i].Height); + glBindTexture(GL_TEXTURE_2D, e_Textures[i].ID); + glGetTexImage(GL_TEXTURE_2D, 0, e_Textures[i].Fmt, GL_UNSIGNED_BYTE, Pixels); + glBindTexture(GL_TEXTURE_2D, 0); + OldID := e_Textures[i].ID; + TexId := i; + end; + end; + end; + end; + + if e_TextureFonts <> nil then + begin + e_WriteLog(' Releasing texturefonts...', MSG_NOTIFY); + for i := 0 to High(e_TextureFonts) do + if e_TextureFonts[i].Base <> 0 then + begin + glDeleteLists(e_TextureFonts[i].Base, 256); + e_TextureFonts[i].Base := 0; + end; + end; +end; + +procedure e_RestoreGLContext(); +var + GLID: GLuint; + i: Integer; +begin + e_WriteLog('Restoring GL context:', MSG_NOTIFY); + + glPopClientAttrib(); + glPopAttrib(); + + if e_SavedTextures <> nil then + begin + e_WriteLog(' Regenerating textures...', MSG_NOTIFY); + for i := Low(e_SavedTextures) to High(e_SavedTextures) do + begin + if e_SavedTextures[i].Pixels <> nil then + with e_SavedTextures[i] do + begin + GLID := CreateTexture(e_Textures[TexID].Width, e_Textures[TexID].Height, + e_Textures[TexID].Fmt, Pixels); + e_Textures[TexID].ID := GLID; + FreeMem(Pixels); + end; + end; + end; + + if e_TextureFonts <> nil then + begin + e_WriteLog(' Regenerating texturefonts...', MSG_NOTIFY); + for i := Low(e_TextureFonts) to High(e_TextureFonts) do + with e_TextureFonts[i] do + begin + TextureID := e_Textures[Texture].ID; + Base := 0; + e_TextureFontBuildInPlace(i); + end; + end; + + SetLength(e_SavedTextures, 0); +end; + + +function _RGB(Red, Green, Blue: Byte): TRGB; +begin + Result.R := Red; + Result.G := Green; + Result.B := Blue; +end; + +function _Point(X, Y: Integer): TPoint2i; +begin + Result.X := X; + Result.Y := Y; +end; + +function _Rect(X, Y: Integer; Width, Height: Word): TRectWH; +begin + Result.X := X; + Result.Y := Y; + Result.Width := Width; + Result.Height := Height; +end; + +function _TRect(L, T, R, B: LongInt): TRect; +begin + Result.Top := T; + Result.Left := L; + Result.Right := R; + Result.Bottom := B; +end; + +end. diff --git a/src/engine/e_input.pas b/src/engine/e_input.pas new file mode 100644 index 0000000..e8a03f7 --- /dev/null +++ b/src/engine/e_input.pas @@ -0,0 +1,459 @@ +unit e_input; + +interface + +uses + SysUtils, + e_log, + SDL; + +const + e_MaxKbdKeys = 321; + e_MaxJoys = 4; + e_MaxJoyBtns = 32; + e_MaxJoyAxes = 4; + e_MaxJoyHats = 4; + + e_MaxJoyKeys = e_MaxJoyBtns + e_MaxJoyAxes*2 + e_MaxJoyHats*4; + + e_MaxInputKeys = e_MaxKbdKeys + e_MaxJoys*e_MaxJoyKeys - 1; + // $$$..$$$ - 321 Keyboard buttons/keys + // $$$..$$$ - 4*32 Joystick buttons + // $$$..$$$ - 4*4 Joystick axes (- and +) + // $$$..$$$ - 4*4 Joystick hats (L U R D) + + // these are apparently used in g_gui and g_game and elsewhere + IK_UNKNOWN = SDLK_UNKNOWN; + IK_INVALID = 65535; + IK_ESCAPE = SDLK_ESCAPE; + IK_RETURN = SDLK_RETURN; + IK_ENTER = SDLK_RETURN; + IK_UP = SDLK_UP; + IK_DOWN = SDLK_DOWN; + IK_LEFT = SDLK_LEFT; + IK_RIGHT = SDLK_RIGHT; + IK_DELETE = SDLK_DELETE; + IK_HOME = SDLK_HOME; + IK_INSERT = SDLK_INSERT; + IK_SPACE = SDLK_SPACE; + IK_CONTROL = SDLK_LCTRL; + IK_SHIFT = SDLK_LSHIFT; + IK_TAB = SDLK_TAB; + IK_PAGEUP = SDLK_PAGEUP; + IK_PAGEDN = SDLK_PAGEDOWN; + IK_F2 = SDLK_F2; + IK_F3 = SDLK_F3; + IK_F4 = SDLK_F4; + IK_F5 = SDLK_F5; + IK_F6 = SDLK_F6; + IK_F7 = SDLK_F7; + IK_F8 = SDLK_F8; + IK_F9 = SDLK_F9; + IK_F10 = SDLK_F10; + IK_END = SDLK_END; + IK_BACKSPACE = SDLK_BACKSPACE; + IK_BACKQUOTE = SDLK_BACKQUOTE; + IK_PAUSE = SDLK_PAUSE; + // TODO: think of something better than this shit + IK_LASTKEY = 320; + + AX_MINUS = 0; + AX_PLUS = 1; + HAT_LEFT = 0; + HAT_UP = 1; + HAT_RIGHT = 2; + HAT_DOWN = 3; + +function e_InitInput(): Boolean; +procedure e_ReleaseInput(); +procedure e_ClearInputBuffer(); +function e_PollInput(): Boolean; +function e_KeyPressed(Key: Word): Boolean; +function e_AnyKeyPressed(): Boolean; +function e_GetFirstKeyPressed(): Word; +function e_JoystickStateToString(mode: Integer): String; +function e_JoyByHandle(handle: Word): Integer; +function e_JoyButtonToKey(id: Word; btn: Byte): Word; +function e_JoyAxisToKey(id: Word; ax: Byte; dir: Byte): Word; +function e_JoyHatToKey(id: Word; hat: Byte; dir: Byte): Word; +procedure e_SetKeyState(key: Word; state: Integer); + +var + {e_MouseInfo: TMouseInfo;} + e_EnableInput: Boolean = False; + e_JoysticksAvailable: Byte = 0; + e_JoystickDeadzones: array [0..e_MaxJoys-1] of Integer = (8192, 8192, 8192, 8192); + e_KeyNames: array [0..e_MaxInputKeys] of String; + +implementation + +uses Math; + +const + KBRD_END = e_MaxKbdKeys; + JOYK_BEG = KBRD_END; + JOYK_END = JOYK_BEG + e_MaxJoyBtns*e_MaxJoys; + JOYA_BEG = JOYK_END; + JOYA_END = JOYA_BEG + e_MaxJoyAxes*2*e_MaxJoys; + JOYH_BEG = JOYA_END; + JOYH_END = JOYH_BEG + e_MaxJoyHats*4*e_MaxJoys; + +type + TJoystick = record + ID: Byte; + Handle: PSDL_Joystick; + Axes: Byte; + Buttons: Byte; + Hats: Byte; + ButtBuf: array [0..e_MaxJoyBtns] of Boolean; + AxisBuf: array [0..e_MaxJoyAxes] of Integer; + HatBuf: array [0..e_MaxJoyHats] of array [HAT_LEFT..HAT_DOWN] of Boolean; + end; + +var + KeyBuffer: array [0..e_MaxKbdKeys] of Boolean; + Joysticks: array of TJoystick = nil; + +function OpenJoysticks(): Byte; +var + i, k, c: Integer; + joy: PSDL_Joystick; +begin + Result := 0; + k := Min(e_MaxJoys, SDL_NumJoysticks()); + if k = 0 then Exit; + c := 0; + for i := 0 to k do + begin + joy := SDL_JoystickOpen(i); + if joy <> nil then + begin + Inc(c); + e_WriteLog('Input: Opened SDL joystick ' + IntToStr(i) + ' as joystick ' + IntToStr(c) + ':', MSG_NOTIFY); + SetLength(Joysticks, c); + with Joysticks[c-1] do + begin + ID := i; + Handle := joy; + Axes := Min(e_MaxJoyAxes, SDL_JoystickNumAxes(joy)); + Buttons := Min(e_MaxJoyBtns, SDL_JoystickNumButtons(joy)); + Hats := Min(e_MaxJoyHats, SDL_JoystickNumHats(joy)); + e_WriteLog(' ' + IntToStr(Axes) + ' axes, ' + IntToStr(Buttons) + ' buttons, ' + + IntToStr(Hats) + ' hats.', MSG_NOTIFY); + end; + end; + end; + Result := c; +end; + +procedure ReleaseJoysticks(); +var + i: Integer; +begin + if (Joysticks = nil) or (e_JoysticksAvailable = 0) then Exit; + for i := Low(Joysticks) to High(Joysticks) do + with Joysticks[i] do + SDL_JoystickClose(Handle); + SetLength(Joysticks, 0); +end; + +function PollKeyboard(): Boolean; +var + Keys: PByte; + NKeys: Integer; + i: Cardinal; +begin + Result := False; + Keys := SDL_GetKeyState(@NKeys); + if (Keys = nil) or (NKeys < 1) then + Exit; + for i := 0 to NKeys do + KeyBuffer[i] := ((PByte(Cardinal(Keys) + i)^) <> 0); + for i := NKeys to High(KeyBuffer) do + KeyBuffer[i] := False; +end; + +function PollJoysticks(): Boolean; +var + i, j, d: Word; + hat: Byte; +begin + if (Joysticks = nil) or (e_JoysticksAvailable = 0) then Exit; + SDL_JoystickUpdate(); + for j := Low(Joysticks) to High(Joysticks) do + with Joysticks[j] do + begin + for i := 0 to Buttons do + ButtBuf[i] := SDL_JoystickGetButton(Handle, i) <> 0; + for i := 0 to Axes do + AxisBuf[i] := SDL_JoystickGetAxis(Handle, i); + for i := 0 to Hats do + begin + hat := SDL_JoystickGetHat(Handle, i); + HatBuf[i, HAT_UP] := LongBool(hat and SDL_HAT_UP); + HatBuf[i, HAT_DOWN] := LongBool(hat and SDL_HAT_DOWN); + HatBuf[i, HAT_LEFT] := LongBool(hat and SDL_HAT_LEFT); + HatBuf[i, HAT_RIGHT] := LongBool(hat and SDL_HAT_RIGHT); + end; + end; + Result := False; +end; + +procedure GenerateKeyNames(); +var + i, j, k: LongWord; +begin + // keyboard key names + for i := 0 to IK_LASTKEY do + begin + e_KeyNames[i] := SDL_GetKeyName(i); + if e_KeyNames[i] = 'unknown key' then + e_KeyNames[i] := ''; + end; + + // joysticks + for j := 0 to e_MaxJoys-1 do + begin + k := JOYK_BEG + j * e_MaxJoyBtns; + // buttons + for i := 0 to e_MaxJoyBtns-1 do + e_KeyNames[k + i] := Format('JOY%d B%d', [j, i]); + k := JOYA_BEG + j * e_MaxJoyAxes * 2; + // axes + for i := 0 to e_MaxJoyAxes-1 do + begin + e_KeyNames[k + i*2 ] := Format('JOY%d A%d+', [j, i]); + e_KeyNames[k + i*2 + 1] := Format('JOY%d A%d-', [j, i]); + end; + k := JOYH_BEG + j * e_MaxJoyHats * 4; + // hats + for i := 0 to e_MaxJoyHats-1 do + begin + e_KeyNames[k + i*4 ] := Format('JOY%d D%dL', [j, i]); + e_KeyNames[k + i*4 + 1] := Format('JOY%d D%dU', [j, i]); + e_KeyNames[k + i*4 + 2] := Format('JOY%d D%dR', [j, i]); + e_KeyNames[k + i*4 + 3] := Format('JOY%d D%dD', [j, i]); + end; + end; +end; + +function e_InitInput(): Boolean; +begin + Result := False; + + e_JoysticksAvailable := OpenJoysticks(); + e_EnableInput := True; + GenerateKeyNames(); + + Result := True; +end; + +procedure e_ReleaseInput(); +begin + ReleaseJoysticks(); + e_JoysticksAvailable := 0; +end; + +procedure e_ClearInputBuffer(); +var + i, j, d: Integer; +begin + for i := Low(KeyBuffer) to High(KeyBuffer) do + KeyBuffer[i] := False; + if (Joysticks = nil) or (e_JoysticksAvailable = 0) then + for i := Low(Joysticks) to High(Joysticks) do + begin + for j := Low(Joysticks[i].ButtBuf) to High(Joysticks[i].ButtBuf) do + Joysticks[i].ButtBuf[j] := False; + for j := Low(Joysticks[i].AxisBuf) to High(Joysticks[i].AxisBuf) do + Joysticks[i].AxisBuf[j] := 0; + for j := Low(Joysticks[i].HatBuf) to High(Joysticks[i].HatBuf) do + for d := Low(Joysticks[i].HatBuf[j]) to High(Joysticks[i].HatBuf[j]) do + Joysticks[i].HatBuf[j, d] := False; + end; +end; + +function e_PollInput(): Boolean; +var + kb, js: Boolean; +begin + kb := PollKeyboard(); + js := PollJoysticks(); + + Result := kb or js; +end; + +function e_KeyPressed(Key: Word): Boolean; +var + joyi, dir: Integer; +begin + Result := False; + if (Key = IK_INVALID) or (Key = 0) then Exit; + + if (Key < KBRD_END) then + begin // Keyboard buttons/keys + Result := KeyBuffer[Key]; + end + + else if (Key >= JOYK_BEG) and (Key < JOYK_END) then + begin // Joystick buttons + JoyI := (Key - JOYK_BEG) div e_MaxJoyBtns; + if JoyI >= e_JoysticksAvailable then + Result := False + else + begin + Key := (Key - JOYK_BEG) mod e_MaxJoyBtns; + Result := Joysticks[JoyI].ButtBuf[Key]; + end; + end + + else if (Key >= JOYA_BEG) and (Key < JOYA_END) then + begin // Joystick axes + JoyI := (Key - JOYA_BEG) div (e_MaxJoyAxes*2); + if JoyI >= e_JoysticksAvailable then + Result := False + else + begin + Key := (Key - JOYA_BEG) mod (e_MaxJoyAxes*2); + dir := Key mod 2; + if dir = AX_MINUS then + Result := Joysticks[JoyI].AxisBuf[Key div 2] < -e_JoystickDeadzones[JoyI] + else + Result := Joysticks[JoyI].AxisBuf[Key div 2] > e_JoystickDeadzones[JoyI] + end; + end + + else if (Key >= JOYH_BEG) and (Key < JOYH_END) then + begin // Joystick hats + JoyI := (Key - JOYH_BEG) div (e_MaxJoyHats*4); + if JoyI >= e_JoysticksAvailable then + Result := False + else + begin + Key := (Key - JOYH_BEG) mod (e_MaxJoyHats*4); + dir := Key mod 4; + Result := Joysticks[JoyI].HatBuf[Key div 4, dir]; + end; + end; +end; + +procedure e_SetKeyState(key: Word; state: Integer); +var + JoyI, dir: Integer; +begin + if (Key = IK_INVALID) or (Key = 0) then Exit; + + if (Key < KBRD_END) then + begin // Keyboard buttons/keys + keyBuffer[key] := (state <> 0); + end + + else if (Key >= JOYK_BEG) and (Key < JOYK_END) then + begin // Joystick buttons + JoyI := (Key - JOYK_BEG) div e_MaxJoyBtns; + if JoyI >= e_JoysticksAvailable then + Exit + else + begin + Key := (Key - JOYK_BEG) mod e_MaxJoyBtns; + Joysticks[JoyI].ButtBuf[Key] := (state <> 0); + end; + end + + else if (Key >= JOYA_BEG) and (Key < JOYA_END) then + begin // Joystick axes + JoyI := (Key - JOYA_BEG) div (e_MaxJoyAxes*2); + if JoyI >= e_JoysticksAvailable then + Exit + else + begin + Key := (Key - JOYA_BEG) mod (e_MaxJoyAxes*2); + Joysticks[JoyI].AxisBuf[Key div 2] := state; + end; + end + + else if (Key >= JOYH_BEG) and (Key < JOYH_END) then + begin // Joystick hats + JoyI := (Key - JOYH_BEG) div (e_MaxJoyHats*4); + if JoyI >= e_JoysticksAvailable then + Exit + else + begin + Key := (Key - JOYH_BEG) mod (e_MaxJoyHats*4); + dir := Key mod 4; + Joysticks[JoyI].HatBuf[Key div 4, dir] := (state <> 0); + end; + end; +end; + +function e_AnyKeyPressed(): Boolean; +var + k: Word; +begin + Result := False; + + for k := 1 to e_MaxInputKeys do + if e_KeyPressed(k) then + begin + Result := True; + Break; + end; +end; + +function e_GetFirstKeyPressed(): Word; +var + k: Word; +begin + Result := IK_INVALID; + + for k := 1 to e_MaxInputKeys do + if e_KeyPressed(k) then + begin + Result := k; + Break; + end; +end; + +//////////////////////////////////////////////////////////////////////////////// + +function e_JoystickStateToString(mode: Integer): String; +begin + Result := ''; +end; + +function e_JoyByHandle(handle: Word): Integer; +var + i: Integer; +begin + Result := -1; + if Joysticks = nil then Exit; + for i := Low(Joysticks) to High(Joysticks) do + if Joysticks[i].ID = handle then + begin + Result := i; + Exit; + end; +end; + +function e_JoyButtonToKey(id: Word; btn: Byte): Word; +begin + Result := 0; + if id >= Length(Joysticks) then Exit; + Result := JOYK_BEG + id*e_MaxJoyBtns + btn; +end; + +function e_JoyAxisToKey(id: Word; ax: Byte; dir: Byte): Word; +begin + Result := 0; + if id >= Length(Joysticks) then Exit; + Result := JOYA_BEG + id*e_MaxJoyAxes*2 + ax*2 + dir; +end; + +function e_JoyHatToKey(id: Word; hat: Byte; dir: Byte): Word; +begin + Result := 0; + if id >= Length(Joysticks) then Exit; + Result := JOYH_BEG + id*e_MaxJoyHats*4 + hat*4 + dir; +end; + +end. diff --git a/src/engine/e_log.pas b/src/engine/e_log.pas new file mode 100644 index 0000000..b8a1850 --- /dev/null +++ b/src/engine/e_log.pas @@ -0,0 +1,69 @@ +unit e_log; + +interface + +uses + SysUtils; + +type + TWriteMode=(WM_NEWFILE, WM_OLDFILE); + TRecordCategory=(MSG_FATALERROR, MSG_WARNING, MSG_NOTIFY); + +procedure e_InitLog(fFileName: String; fWriteMode: TWriteMode); +procedure e_WriteLog(TextLine: String; RecordCategory: TRecordCategory; + WriteTime: Boolean = True); +function DecodeIPV4(ip: LongWord): string; + +implementation + +var + FirstRecord: Boolean; + FileName: String; + +{ TLog } + +function DecodeIPV4(ip: LongWord): string; +begin + Result := Format('%d.%d.%d.%d', [ip and $FF, (ip shr 8) and $FF, (ip shr 16) and $FF, (ip shr 24)]); +end; + +procedure e_WriteLog(TextLine: String; RecordCategory: TRecordCategory; + WriteTime: Boolean = True); +var + LogFile: TextFile; + Prefix: ShortString; +begin + if FileName = '' then Exit; + + Assign(LogFile, FileName); + if FileExists(FileName) then + Append(LogFile) + else + Rewrite(LogFile); + if FirstRecord then + begin + Writeln(LogFile, '--- Log started at '+TimeToStr(Time)+' ---'); + FirstRecord := False; + end; + case RecordCategory of + MSG_FATALERROR: Prefix := '!!!'; + MSG_WARNING: Prefix := '! '; + MSG_NOTIFY: Prefix := '***'; + end; + if WriteTime then + Writeln(LogFile, '['+TimeToStr(Time)+'] '+Prefix+' '+TextLine) + else + Writeln(LogFile, Prefix+' '+TextLine); + Close(LogFile); +end; + +procedure e_InitLog(fFileName: String; fWriteMode: TWriteMode); +begin + FileName := fFileName; + if fWriteMode = WM_NEWFILE then + if FileExists(FileName) then + DeleteFile(FileName); + FirstRecord := True; +end; + +end. diff --git a/src/engine/e_sound.pas b/src/engine/e_sound.pas new file mode 100644 index 0000000..05bcb10 --- /dev/null +++ b/src/engine/e_sound.pas @@ -0,0 +1,1013 @@ +unit e_sound; + +interface + +uses + fmod, + fmodtypes, + fmoderrors, + e_log, + SysUtils; + +type + TSoundRec = record + Data: Pointer; + Sound: FMOD_SOUND; + Loop: Boolean; + nRefs: Integer; + end; + + TBasicSound = class (TObject) + private + FChannel: FMOD_CHANNEL; + + protected + FID: DWORD; + FLoop: Boolean; + FPosition: DWORD; + FPriority: Integer; + + function RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean; + + public + constructor Create(); + destructor Destroy(); override; + procedure SetID(ID: DWORD); + procedure FreeSound(); + function IsPlaying(): Boolean; + procedure Stop(); + function IsPaused(): Boolean; + procedure Pause(Enable: Boolean); + function GetVolume(): Single; + procedure SetVolume(Volume: Single); + function GetPan(): Single; + procedure SetPan(Pan: Single); + function IsMuted(): Boolean; + procedure Mute(Enable: Boolean); + function GetPosition(): DWORD; + procedure SetPosition(aPos: DWORD); + procedure SetPriority(priority: Integer); + end; + +const + NO_SOUND_ID = DWORD(-1); + +function e_InitSoundSystem(Freq: Integer; forceNoSound: Boolean): Boolean; + +function e_LoadSound(FileName: string; var ID: DWORD; bLoop: Boolean): Boolean; +function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean; + +function e_PlaySound(ID: DWORD): Boolean; +function e_PlaySoundPan(ID: DWORD; Pan: Single): Boolean; +function e_PlaySoundVolume(ID: DWORD; Volume: Single): Boolean; +function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Boolean; + +procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean); +procedure e_MuteChannels(Enable: Boolean); +procedure e_StopChannels(); + +procedure e_DeleteSound(ID: DWORD); +procedure e_RemoveAllSounds(); +procedure e_ReleaseSoundSystem(); +procedure e_SoundUpdate(); + +var + e_SoundsArray: array of TSoundRec = nil; + +implementation + +uses + g_window, g_options, BinEditor; + +const + N_CHANNELS = 512; + +var + F_System: FMOD_SYSTEM = nil; + SoundMuted: Boolean = False; + + +function Channel_Callback(channel: FMOD_CHANNEL; callbacktype: FMOD_CHANNEL_CALLBACKTYPE; + commanddata1: Pointer; commanddata2: Pointer): FMOD_RESULT; {$IFDEF WIN32} stdcall; {$ELSE} cdecl; {$ENDIF} +var + res: FMOD_RESULT; + sound: FMOD_SOUND; + ud: Pointer; + id: DWORD; + +begin + res := FMOD_OK; + + if callbacktype = FMOD_CHANNEL_CALLBACKTYPE_END then + begin + res := FMOD_Channel_GetCurrentSound(channel, sound); + if res = FMOD_OK then + begin + res := FMOD_Sound_GetUserData(sound, ud); + if res = FMOD_OK then + begin + id := DWORD(ud^); + if id < DWORD(Length(e_SoundsArray)) then + if e_SoundsArray[id].nRefs > 0 then + Dec(e_SoundsArray[id].nRefs); + end; + end; + end; + + Result := res; +end; + +function TryInitWithOutput(Output: FMOD_OUTPUTTYPE; OutputName: String): FMOD_RESULT; +begin + e_WriteLog('Trying with ' + OutputName + '...', MSG_WARNING); + Result := FMOD_System_SetOutput(F_System, Output); + if Result <> FMOD_OK then + begin + e_WriteLog('Error setting FMOD output to ' + OutputName + '!', MSG_WARNING); + e_WriteLog(FMOD_ErrorString(Result), MSG_WARNING); + Exit; + end; + Result := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil); + if Result <> FMOD_OK then + begin + e_WriteLog('Error initializing FMOD system!', MSG_WARNING); + e_WriteLog(FMOD_ErrorString(Result), MSG_WARNING); + Exit; + end; +end; + +function e_InitSoundSystem(Freq: Integer; forceNoSound: Boolean): Boolean; +var + res: FMOD_RESULT; + ver: Cardinal; + output: FMOD_OUTPUTTYPE; + drv: Integer; + +begin + Result := False; + + res := FMOD_System_Create(F_System); + if res <> FMOD_OK then + begin + e_WriteLog('Error creating FMOD system:', MSG_FATALERROR); + e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); + Exit; + end; + + res := FMOD_System_GetVersion(F_System, ver); + if res <> FMOD_OK then + begin + e_WriteLog('Error getting FMOD version:', MSG_FATALERROR); + e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); + Exit; + end; + + if ver < FMOD_VERSION then + begin + e_WriteLog('FMOD library version is too old! Need '+IntToStr(FMOD_VERSION), MSG_FATALERROR); + Exit; + end; + + res := FMOD_System_SetSoftwareFormat(F_System, Freq, + FMOD_SOUND_FORMAT_PCM16, 0, 0, FMOD_DSP_RESAMPLER_LINEAR); + if res <> FMOD_OK then + begin + e_WriteLog('Error setting FMOD software format!', MSG_FATALERROR); + e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); + Exit; + end; + + res := FMOD_System_Init(F_System, N_CHANNELS, FMOD_INIT_NORMAL, nil); + if res <> FMOD_OK then + begin + e_WriteLog('Error initializing FMOD system!', MSG_WARNING); + e_WriteLog(FMOD_ErrorString(res), MSG_WARNING); + + {$IFDEF LINUX} + res := TryInitWithOutput(FMOD_OUTPUTTYPE_ALSA, 'OUTPUTTYPE_ALSA'); + if res <> FMOD_OK then + res := TryInitWithOutput(FMOD_OUTPUTTYPE_OSS, 'OUTPUTTYPE_OSS'); + {$ENDIF} + if not forceNoSound then Exit; + if res <> FMOD_OK then + res := TryInitWithOutput(FMOD_OUTPUTTYPE_NOSOUND, 'OUTPUTTYPE_NOSOUND'); + if res <> FMOD_OK then + begin + e_WriteLog('FMOD: Giving up, can''t init any output.', MSG_FATALERROR); + Exit; + end; + end; + + res := FMOD_System_GetOutput(F_System, output); + if res <> FMOD_OK then + e_WriteLog('Error getting FMOD output!', MSG_WARNING) + else + case output of + FMOD_OUTPUTTYPE_NOSOUND: e_WriteLog('FMOD Output Method: NOSOUND', MSG_NOTIFY); + FMOD_OUTPUTTYPE_NOSOUND_NRT: e_WriteLog('FMOD Output Method: NOSOUND_NRT', MSG_NOTIFY); + FMOD_OUTPUTTYPE_DSOUND: e_WriteLog('FMOD Output Method: DSOUND', MSG_NOTIFY); + FMOD_OUTPUTTYPE_WINMM: e_WriteLog('FMOD Output Method: WINMM', MSG_NOTIFY); + FMOD_OUTPUTTYPE_OPENAL: e_WriteLog('FMOD Output Method: OPENAL', MSG_NOTIFY); + FMOD_OUTPUTTYPE_WASAPI: e_WriteLog('FMOD Output Method: WASAPI', MSG_NOTIFY); + FMOD_OUTPUTTYPE_ASIO: e_WriteLog('FMOD Output Method: ASIO', MSG_NOTIFY); + FMOD_OUTPUTTYPE_OSS: e_WriteLog('FMOD Output Method: OSS', MSG_NOTIFY); + FMOD_OUTPUTTYPE_ALSA: e_Writelog('FMOD Output Method: ALSA', MSG_NOTIFY); + else e_WriteLog('FMOD Output Method: Unknown', MSG_NOTIFY); + end; + + res := FMOD_System_GetDriver(F_System, drv); + if res <> FMOD_OK then + e_WriteLog('Error getting FMOD driver!', MSG_WARNING) + else + e_WriteLog('FMOD driver id: '+IntToStr(drv), MSG_NOTIFY); + + Result := True; +end; + +function FindESound(): DWORD; +var + i: Integer; + +begin + if e_SoundsArray <> nil then + for i := 0 to High(e_SoundsArray) do + if e_SoundsArray[i].Sound = nil then + begin + Result := i; + Exit; + end; + + if e_SoundsArray = nil then + begin + SetLength(e_SoundsArray, 16); + Result := 0; + end + else + begin + Result := High(e_SoundsArray) + 1; + SetLength(e_SoundsArray, Length(e_SoundsArray) + 16); + end; +end; + +function e_LoadSound(FileName: String; var ID: DWORD; bLoop: Boolean): Boolean; +var + find_id: DWORD; + res: FMOD_RESULT; + bt: Cardinal; + ud: Pointer; + +begin + Result := False; + + e_WriteLog('Loading sound '+FileName+'...', MSG_NOTIFY); + + find_id := FindESound(); + + if bLoop then + bt := FMOD_LOOP_NORMAL + else + bt := FMOD_LOOP_OFF; + + if not bLoop then + res := FMOD_System_CreateSound(F_System, PAnsiChar(FileName), + bt + FMOD_2D + FMOD_HARDWARE, + nil, e_SoundsArray[find_id].Sound) + else + res := FMOD_System_CreateStream(F_System, PAnsiChar(FileName), + bt + FMOD_2D + FMOD_HARDWARE, + nil, e_SoundsArray[find_id].Sound); + if res <> FMOD_OK then + begin + e_SoundsArray[find_id].Sound := nil; + Exit; + end; + + GetMem(ud, SizeOf(DWORD)); + DWORD(ud^) := find_id; + res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud); + if res <> FMOD_OK then + begin + e_SoundsArray[find_id].Sound := nil; + Exit; + end; + + e_SoundsArray[find_id].Data := nil; + e_SoundsArray[find_id].Loop := bLoop; + e_SoundsArray[find_id].nRefs := 0; + + ID := find_id; + + Result := True; +end; + +function e_LoadSoundMem(pData: Pointer; Length: Integer; var ID: DWORD; bLoop: Boolean): Boolean; +var + find_id: DWORD; + res: FMOD_RESULT; + sz: Integer; + bt: Cardinal; + soundExInfo: FMOD_CREATESOUNDEXINFO; + ud: Pointer; + +begin + Result := False; + + find_id := FindESound(); + + sz := SizeOf(FMOD_CREATESOUNDEXINFO); + FillMemory(@soundExInfo, sz, 0); + soundExInfo.cbsize := sz; + soundExInfo.length := Length; + + if bLoop then + bt := FMOD_LOOP_NORMAL + else + bt := FMOD_LOOP_OFF; + + if not bLoop then + res := FMOD_System_CreateSound(F_System, pData, + bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY, + @soundExInfo, e_SoundsArray[find_id].Sound) + else + res := FMOD_System_CreateStream(F_System, pData, + bt + FMOD_2D + FMOD_HARDWARE + FMOD_OPENMEMORY, + @soundExInfo, e_SoundsArray[find_id].Sound); + if res <> FMOD_OK then + begin + e_SoundsArray[find_id].Sound := nil; + Exit; + end; + + GetMem(ud, SizeOf(DWORD)); + DWORD(ud^) := find_id; + res := FMOD_Sound_SetUserData(e_SoundsArray[find_id].Sound, ud); + if res <> FMOD_OK then + begin + e_SoundsArray[find_id].Sound := nil; + Exit; + end; + + e_SoundsArray[find_id].Data := pData; + e_SoundsArray[find_id].Loop := bLoop; + e_SoundsArray[find_id].nRefs := 0; + + ID := find_id; + + Result := True; +end; + +function e_PlaySound(ID: DWORD): Boolean; +var + res: FMOD_RESULT; + Chan: FMOD_CHANNEL; + +begin + if e_SoundsArray[ID].nRefs >= gMaxSimSounds then + begin + Result := True; + Exit; + end; + + Result := False; + + res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, + e_SoundsArray[ID].Sound, False, Chan); + if res <> FMOD_OK then + begin + Exit; + end; + + res := FMOD_Channel_SetCallback(Chan, Channel_Callback); + if res <> FMOD_OK then + begin + end; + + if SoundMuted then + begin + res := FMOD_Channel_SetMute(Chan, True); + if res <> FMOD_OK then + begin + end; + end; + + Inc(e_SoundsArray[ID].nRefs); + Result := True; +end; + +function e_PlaySoundPan(ID: DWORD; Pan: Single): Boolean; +var + res: FMOD_RESULT; + Chan: FMOD_CHANNEL; + +begin + if e_SoundsArray[ID].nRefs >= gMaxSimSounds then + begin + Result := True; + Exit; + end; + + Result := False; + + res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, + e_SoundsArray[ID].Sound, False, Chan); + if res <> FMOD_OK then + begin + Exit; + end; + + res := FMOD_Channel_SetPan(Chan, Pan); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetCallback(Chan, Channel_Callback); + if res <> FMOD_OK then + begin + end; + + if SoundMuted then + begin + res := FMOD_Channel_SetMute(Chan, True); + if res <> FMOD_OK then + begin + end; + end; + + Inc(e_SoundsArray[ID].nRefs); + Result := True; +end; + +function e_PlaySoundVolume(ID: DWORD; Volume: Single): Boolean; +var + res: FMOD_RESULT; + Chan: FMOD_CHANNEL; + +begin + if e_SoundsArray[ID].nRefs >= gMaxSimSounds then + begin + Result := True; + Exit; + end; + + Result := False; + + res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, + e_SoundsArray[ID].Sound, False, Chan); + if res <> FMOD_OK then + begin + Exit; + end; + + res := FMOD_Channel_SetVolume(Chan, Volume); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetCallback(Chan, Channel_Callback); + if res <> FMOD_OK then + begin + end; + + if SoundMuted then + begin + res := FMOD_Channel_SetMute(Chan, True); + if res <> FMOD_OK then + begin + end; + end; + + Inc(e_SoundsArray[ID].nRefs); + Result := True; +end; + +function e_PlaySoundPanVolume(ID: DWORD; Pan, Volume: Single): Boolean; +var + res: FMOD_RESULT; + Chan: FMOD_CHANNEL; + +begin + if e_SoundsArray[ID].nRefs >= gMaxSimSounds then + begin + Result := True; + Exit; + end; + + Result := False; + + res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, + e_SoundsArray[ID].Sound, False, Chan); + if res <> FMOD_OK then + begin + Exit; + end; + + res := FMOD_Channel_SetPan(Chan, Pan); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetVolume(Chan, Volume); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetCallback(Chan, Channel_Callback); + if res <> FMOD_OK then + begin + end; + + if SoundMuted then + begin + res := FMOD_Channel_SetMute(Chan, True); + if res <> FMOD_OK then + begin + end; + end; + + Inc(e_SoundsArray[ID].nRefs); + Result := True; +end; + +procedure e_DeleteSound(ID: DWORD); +var + res: FMOD_RESULT; + ud: Pointer; + +begin + if e_SoundsArray[ID].Sound = nil then + Exit; + + if e_SoundsArray[ID].Data <> nil then + FreeMem(e_SoundsArray[ID].Data); + + res := FMOD_Sound_GetUserData(e_SoundsArray[ID].Sound, ud); + if res = FMOD_OK then + begin + FreeMem(ud); + end; + + res := FMOD_Sound_Release(e_SoundsArray[ID].Sound); + if res <> FMOD_OK then + begin + e_WriteLog('Error releasing sound:', MSG_WARNING); + e_WriteLog(FMOD_ErrorString(res), MSG_WARNING); + end; + + e_SoundsArray[ID].Sound := nil; + e_SoundsArray[ID].Data := nil; +end; + +procedure e_ModifyChannelsVolumes(SoundMod: Single; setMode: Boolean); +var + res: FMOD_RESULT; + i: Integer; + Chan: FMOD_CHANNEL; + vol: Single; + +begin + for i := 0 to N_CHANNELS-1 do + begin + Chan := nil; + res := FMOD_System_GetChannel(F_System, i, Chan); + + if (res = FMOD_OK) and (Chan <> nil) then + begin + res := FMOD_Channel_GetVolume(Chan, vol); + + if res = FMOD_OK then + begin + if setMode then + vol := SoundMod + else + vol := vol * SoundMod; + + res := FMOD_Channel_SetVolume(Chan, vol); + + if res <> FMOD_OK then + begin + end; + end; + end; + end; +end; + +procedure e_MuteChannels(Enable: Boolean); +var + res: FMOD_RESULT; + i: Integer; + Chan: FMOD_CHANNEL; + +begin + if Enable = SoundMuted then + Exit; + + SoundMuted := Enable; + + for i := 0 to N_CHANNELS-1 do + begin + Chan := nil; + res := FMOD_System_GetChannel(F_System, i, Chan); + + if (res = FMOD_OK) and (Chan <> nil) then + begin + res := FMOD_Channel_SetMute(Chan, Enable); + + if res <> FMOD_OK then + begin + end; + end; + end; +end; + +procedure e_StopChannels(); +var + res: FMOD_RESULT; + i: Integer; + Chan: FMOD_CHANNEL; + +begin + for i := 0 to N_CHANNELS-1 do + begin + Chan := nil; + res := FMOD_System_GetChannel(F_System, i, Chan); + + if (res = FMOD_OK) and (Chan <> nil) then + begin + res := FMOD_Channel_Stop(Chan); + + if res <> FMOD_OK then + begin + end; + end; + end; +end; + +procedure e_RemoveAllSounds(); +var + i: Integer; + +begin + for i := 0 to High(e_SoundsArray) do + if e_SoundsArray[i].Sound <> nil then + e_DeleteSound(i); + + SetLength(e_SoundsArray, 0); + e_SoundsArray := nil; +end; + +procedure e_ReleaseSoundSystem(); +var + res: FMOD_RESULT; + +begin + e_RemoveAllSounds(); + + res := FMOD_System_Close(F_System); + if res <> FMOD_OK then + begin + e_WriteLog('Error closing FMOD system!', MSG_FATALERROR); + e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); + Exit; + end; + + res := FMOD_System_Release(F_System); + if res <> FMOD_OK then + begin + e_WriteLog('Error releasing FMOD system!', MSG_FATALERROR); + e_WriteLog(FMOD_ErrorString(res), MSG_FATALERROR); + end; +end; + +procedure e_SoundUpdate(); +begin + FMOD_System_Update(F_System); +end; + +{ TBasicSound: } + +constructor TBasicSound.Create(); +begin + FID := NO_SOUND_ID; + FLoop := False; + FChannel := nil; + FPosition := 0; + FPriority := 128; +end; + +destructor TBasicSound.Destroy(); +begin + FreeSound(); + inherited; +end; + +procedure TBasicSound.FreeSound(); +begin + if FID = NO_SOUND_ID then + Exit; + + Stop(); + FID := NO_SOUND_ID; + FLoop := False; + FPosition := 0; +end; + +function TBasicSound.RawPlay(Pan: Single; Volume: Single; aPos: DWORD): Boolean; +var + res: FMOD_RESULT; + +begin + if e_SoundsArray[FID].nRefs >= gMaxSimSounds then + begin + Result := True; + Exit; + end; + + Result := False; + + if FID = NO_SOUND_ID then + Exit; + + res := FMOD_System_PlaySound(F_System, FMOD_CHANNEL_FREE, + e_SoundsArray[FID].Sound, False, FChannel); + if res <> FMOD_OK then + begin + FChannel := nil; + Exit; + end; + + res := FMOD_Channel_SetPosition(FChannel, aPos, FMOD_TIMEUNIT_MS); + if res <> FMOD_OK then + begin + FPosition := 0; + end + else + FPosition := aPos; + + res := FMOD_Channel_SetPan(FChannel, Pan); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetVolume(FChannel, Volume); + if res <> FMOD_OK then + begin + end; + + res := FMOD_Channel_SetCallback(FChannel, Channel_Callback); + if res <> FMOD_OK then + begin + end; + + if SoundMuted then + begin + res := FMOD_Channel_SetMute(FChannel, True); + if res <> FMOD_OK then + begin + end; + end; + + Inc(e_SoundsArray[FID].nRefs); + Result := True; +end; + +procedure TBasicSound.SetID(ID: DWORD); +begin + FreeSound(); + FID := ID; + FLoop := e_SoundsArray[ID].Loop; +end; + +function TBasicSound.IsPlaying(): Boolean; +var + res: FMOD_RESULT; + b: LongBool; + +begin + Result := False; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_IsPlaying(FChannel, b); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := b; +end; + +procedure TBasicSound.Stop(); +var + res: FMOD_RESULT; + +begin + if FChannel = nil then + Exit; + + GetPosition(); + + res := FMOD_Channel_Stop(FChannel); + if res <> FMOD_OK then + begin + end; + + FChannel := nil; +end; + +function TBasicSound.IsPaused(): Boolean; +var + res: FMOD_RESULT; + b: LongBool; + +begin + Result := False; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_GetPaused(FChannel, b); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := b; +end; + +procedure TBasicSound.Pause(Enable: Boolean); +var + res: FMOD_RESULT; + +begin + if FChannel = nil then + Exit; + + res := FMOD_Channel_SetPaused(FChannel, Enable); + if res <> FMOD_OK then + begin + end; + + if Enable then + begin + res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); + if res <> FMOD_OK then + begin + end; + end; +end; + +function TBasicSound.GetVolume(): Single; +var + res: FMOD_RESULT; + vol: Single; + +begin + Result := 0.0; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_GetVolume(FChannel, vol); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := vol; +end; + +procedure TBasicSound.SetVolume(Volume: Single); +var + res: FMOD_RESULT; + +begin + if FChannel = nil then + Exit; + + res := FMOD_Channel_SetVolume(FChannel, Volume); + if res <> FMOD_OK then + begin + end; +end; + +function TBasicSound.GetPan(): Single; +var + res: FMOD_RESULT; + pan: Single; + +begin + Result := 0.0; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_GetPan(FChannel, pan); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := pan; +end; + +procedure TBasicSound.SetPan(Pan: Single); +var + res: FMOD_RESULT; + +begin + if FChannel = nil then + Exit; + + res := FMOD_Channel_SetPan(FChannel, Pan); + if res <> FMOD_OK then + begin + end; +end; + +function TBasicSound.IsMuted(): Boolean; +var + res: FMOD_RESULT; + b: LongBool; + +begin + Result := False; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_GetMute(FChannel, b); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := b; +end; + +procedure TBasicSound.Mute(Enable: Boolean); +var + res: FMOD_RESULT; + +begin + if FChannel = nil then + Exit; + + res := FMOD_Channel_SetMute(FChannel, Enable); + if res <> FMOD_OK then + begin + end; +end; + +function TBasicSound.GetPosition(): DWORD; +var + res: FMOD_RESULT; + +begin + Result := 0; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_GetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); + if res <> FMOD_OK then + begin + Exit; + end; + + Result := FPosition; +end; + +procedure TBasicSound.SetPosition(aPos: DWORD); +var + res: FMOD_RESULT; + +begin + FPosition := aPos; + + if FChannel = nil then + Exit; + + res := FMOD_Channel_SetPosition(FChannel, FPosition, FMOD_TIMEUNIT_MS); + if res <> FMOD_OK then + begin + end; +end; + +procedure TBasicSound.SetPriority(priority: Integer); +var + res: FMOD_RESULT; + +begin + if (FChannel <> nil) and (FPriority <> priority) and + (priority >= 0) and (priority <= 256) then + begin + FPriority := priority; + res := FMOD_Channel_SetPriority(FChannel, priority); + if res <> FMOD_OK then + begin + end; + end; +end; + +end. diff --git a/src/engine/e_textures.pas b/src/engine/e_textures.pas new file mode 100644 index 0000000..504b3fb --- /dev/null +++ b/src/engine/e_textures.pas @@ -0,0 +1,453 @@ +unit e_textures; + +{ This unit provides interface to load 24-bit and 32-bit uncompressed images + from Truevision Targa (TGA) graphic files, and create OpenGL textures + from it's data. } + +interface + +uses + GL, GLExt, SysUtils, e_log; + +var + fUseMipmaps: Boolean = False; + TEXTUREFILTER: Integer = GL_NEAREST; + +function CreateTexture( Width, Height, Format: Word; pData: Pointer ): Integer; + +// Standard set of images loading functions +function LoadTexture( Filename: String; var Texture: GLuint; + var pWidth, pHeight: Word; Fmt: PWord = nil ): Boolean; + +function LoadTextureEx( Filename: String; var Texture: GLuint; + fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean; + +function LoadTextureMem( pData: Pointer; var Texture: GLuint; + var pWidth, pHeight: Word; Fmt: PWord = nil ): Boolean; + +function LoadTextureMemEx( pData: Pointer; var Texture: GLuint; + fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean; + +implementation + +uses BinEditor; + +type + TTGAHeader = packed record + FileType: Byte; + ColorMapType: Byte; + ImageType: Byte; + ColorMapSpec: array[0..4] of Byte; + OrigX: array[0..1] of Byte; + OrigY: array[0..1] of Byte; + Width: array[0..1] of Byte; + Height: array[0..1] of Byte; + BPP: Byte; + ImageInfo: Byte; + end; + +// This is auxiliary function that creates OpenGL texture from raw image data +function CreateTexture( Width, Height, Format: Word; pData: Pointer ): Integer; +var + Texture: GLuint; +begin + glGenTextures( 1, @Texture ); + glBindTexture( GL_TEXTURE_2D, Texture ); + + {Texture blends with object background} + glTexEnvi( GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_MODULATE ); + {Texture does NOT blend with object background} + // glTexEnvi(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_DECAL); + + { + Select a filtering type. + BiLinear filtering produces very good results with little performance impact + + GL_NEAREST - Basic texture (grainy looking texture) + GL_LINEAR - BiLinear filtering + GL_LINEAR_MIPMAP_NEAREST - Basic mipmapped texture + GL_LINEAR_MIPMAP_LINEAR - BiLinear Mipmapped texture + } + + // for GL_TEXTURE_MAG_FILTER only first two can be used + glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, TEXTUREFILTER ); + // for GL_TEXTURE_MIN_FILTER all of the above can be used + glTexParameteri( GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, TEXTUREFILTER ); + + if Format = GL_RGBA then + begin + glTexImage2D( GL_TEXTURE_2D, 0, 4, Width, Height, + 0, GL_RGBA, GL_UNSIGNED_BYTE, pData ); + end else + begin + glTexImage2D( GL_TEXTURE_2D, 0, 3, Width, Height, + 0, GL_RGB, GL_UNSIGNED_BYTE, pData ); + end; + + glBindTexture(GL_TEXTURE_2D, 0); + + Result := Texture; +end; + +function LoadTextureMem( pData: Pointer; var Texture: GLuint; + var pWidth, pHeight: Word; Fmt: PWord = nil ): Boolean; +var + TGAHeader: TTGAHeader; + image: Pointer; + Width, Height: Integer; + ImageSize: Integer; + i: Integer; + Front: ^Byte; + Back: ^Byte; + Temp: Byte; + BPP: Byte; + TFmt: Word; + +begin + Result := False; + pWidth := 0; + pHeight := 0; + + CopyMemory( @TGAHeader, pData, SizeOf(TGAHeader) ); + + if ( TGAHeader.ImageType <> 2 ) then + begin + e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.ColorMapType <> 0 ) then + begin + e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.BPP < 24 ) then + begin + e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING ); + Exit; + end; + + Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256; + Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256; + BPP := TGAHeader.BPP; + + ImageSize := Width * Height * (BPP div 8); + + GetMem( Image, ImageSize ); + CopyMemory( Image, PByte(pData) + SizeOf(TGAHeader), ImageSize ); + + for i := 0 to Width * Height - 1 do + begin + Front := PByte(Image) + i*(BPP div 8); + Back := PByte(Image) + i*(BPP div 8) + 2; + Temp := Front^; + Front^ := Back^; + Back^ := Temp; + end; + + if ( BPP = 24 ) then + TFmt := GL_RGB + else + TFmt := GL_RGBA; + + Texture := CreateTexture( Width, Height, TFmt, Image ); + + FreeMem( Image ); + + if Fmt <> nil then Fmt^ := TFmt; + + pWidth := Width; + pHeight := Height; + + Result := True; +end; + +function LoadTextureMemEx( pData: Pointer; var Texture: GLuint; + fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean; +var + TGAHeader: TTGAHeader; + image, image2: Pointer; + Width, Height: Integer; + ImageSize: Integer; + i, a, b: Integer; + Front: ^Byte; + Back: ^Byte; + Temp: Byte; + BPP: Byte; + Base: PByte; + TFmt: Word; + +begin + Result := False; + + CopyMemory( @TGAHeader, pData, SizeOf(TGAHeader) ); + + if ( TGAHeader.ImageType <> 2 ) then + begin + e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.ColorMapType <> 0 ) then + begin + e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.BPP < 24 ) then + begin + e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING ); + Exit; + end; + + Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256; + Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256; + BPP := TGAHeader.BPP; + + if fX > Width then Exit; + if fY > Height then Exit; + if fX+fWidth > Width then Exit; + if fY+fHeight > Height then Exit; + + ImageSize := Width * Height * (BPP div 8); + GetMem( Image2, ImageSize ); + CopyMemory( Image2, PByte(pData) + SizeOf(TGAHeader), ImageSize ); + + a := BPP div 8; + + for i := 0 to Width * Height - 1 do + begin + Front := PByte(Image2) + i * a; + Back := PByte(Image2) + i * a + 2; + Temp := Front^; + Front^ := Back^; + Back^ := Temp; + end; + + fY := Height - (fY + fHeight); + + ImageSize := fHeight * fWidth * (BPP div 8); + GetMem( Image, ImageSize ); + + Base := PByte( Image2 ) + fY * Width * (BPP div 8) + fX * (BPP div 8); + a := fWidth * (BPP div 8); + b := Width * (BPP div 8); + + for i := 0 to fHeight-1 do + CopyMemory( PByte(image) + a*i, Base + b*i, a ); + + if ( BPP = 24 ) then + TFmt := GL_RGB + else + TFmt := GL_RGBA; + + Texture := CreateTexture( fWidth, fHeight, TFmt, Image ); + + FreeMem( Image ); + FreeMem( Image2 ); + + if Fmt <> nil then Fmt^ := TFmt; + + Result := True; +end; + +function LoadTexture( Filename: String; var Texture: GLuint; + var pWidth, pHeight: Word; Fmt: PWord = nil ): Boolean; +var + TGAHeader: TTGAHeader; + TGAFile: File; + bytesRead: Integer; + image: Pointer; + Width, Height: Integer; + ImageSize: Integer; + i: Integer; + Front: ^Byte; + Back: ^Byte; + Temp: Byte; + BPP: Byte; + TFmt: Word; + +begin + Result := False; + pWidth := 0; + pHeight := 0; + + if not FileExists(Filename) then + begin + e_WriteLog('Texture ' + Filename + ' not found', MSG_WARNING); + Exit; + end; + + AssignFile( TGAFile, Filename ); + Reset( TGAFile, 1 ); + BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) ); + + if ( TGAHeader.ImageType <> 2 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.ColorMapType <> 0 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.BPP < 24 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING ); + Exit; + end; + + Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256; + Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256; + BPP := TGAHeader.BPP; + + ImageSize := Width * Height * (BPP div 8); + + GetMem( Image, ImageSize ); + + BlockRead( TGAFile, image^, ImageSize, bytesRead ); + if ( bytesRead <> ImageSize ) then + begin + CloseFile( TGAFile ); + Exit; + end; + + CloseFile( TGAFile ); + + for i := 0 to Width * Height - 1 do + begin + Front := PByte(Image) + i * (BPP div 8); + Back := PByte(Image) + i * (BPP div 8) + 2; + Temp := Front^; + Front^ := Back^; + Back^ := Temp; + end; + + if ( BPP = 24 ) then + TFmt := GL_RGB + else + TFmt := GL_RGBA; + + Texture := CreateTexture( Width, Height, TFmt, Image ); + + FreeMem( Image ); + + if Fmt <> nil then Fmt^ := TFmt; + + pWidth := Width; + pHeight := Height; + + Result := True; +end; + +function LoadTextureEx( Filename: String; var Texture: GLuint; + fX, fY, fWidth, fHeight: Word; Fmt: PWord = nil ): Boolean; +var + TGAHeader: TTGAHeader; + TGAFile: File; + image, image2: Pointer; + Width, Height: Integer; + ImageSize: Integer; + i: Integer; + Front: ^Byte; + Back: ^Byte; + Temp: Byte; + BPP: Byte; + Base: PByte; + TFmt: Word; + +begin + Result := False; + + if not FileExists(Filename) then + begin + e_WriteLog( 'Texture ' + Filename + ' not found', MSG_WARNING ); + Exit; + end; + + AssignFile( TGAFile, Filename ); + Reset( TGAFile, 1 ); + BlockRead( TGAFile, TGAHeader, SizeOf(TGAHeader) ); + + if ( TGAHeader.ImageType <> 2 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: Bad ImageType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.ColorMapType <> 0 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: Bad ColorMapType', MSG_WARNING ); + Exit; + end; + + if ( TGAHeader.BPP < 24 ) then + begin + CloseFile( TGAFile ); + e_WriteLog( 'Error loading texture: BPP less than 24', MSG_WARNING ); + Exit; + end; + + Width := TGAHeader.Width[0] + TGAHeader.Width[1] * 256; + Height := TGAHeader.Height[0] + TGAHeader.Height[1] * 256; + BPP := TGAHeader.BPP; + + if fX > Width then Exit; + if fY > Height then Exit; + if fX+fWidth > Width then Exit; + if fY+fHeight > Height then Exit; + + ImageSize := Width * Height * (BPP div 8); + GetMem( Image2, ImageSize ); + BlockRead( TGAFile, Image2^, ImageSize ); + + CloseFile( TGAFile ); + + for i := 0 to Width * Height - 1 do + begin + Front := PByte(Image2) + i * (BPP div 8); + Back := PByte(Image2) + i * (BPP div 8) + 2; + Temp := Front^; + Front^ := Back^; + Back^ := Temp; + end; + + fY := Height - (fY + fHeight); + + ImageSize := fHeight * fWidth * (BPP div 8); + GetMem( Image, ImageSize ); + + Base := PByte(Image2) + fY * Width * (BPP div 8) + fX * (BPP div 8); + + for i := 0 to fHeight-1 do + begin + CopyMemory( PByte(image) + fWidth * (BPP div 8) * i, + Base + Width * (BPP div 8) * i, fWidth * (BPP div 8) ); + end; + + if ( BPP = 24 ) then + TFmt := GL_RGB + else + TFmt := GL_RGBA; + + Texture := CreateTexture( fWidth, fHeight, TFmt, Image ); + + FreeMem( Image ); + FreeMem( Image2 ); + + if Fmt <> nil then Fmt^ := TFmt; + + Result := True; +end; + +end. + diff --git a/src/game/CustomRes.rc b/src/game/CustomRes.rc new file mode 100644 index 0000000..ddff531 --- /dev/null +++ b/src/game/CustomRes.rc @@ -0,0 +1 @@ +dficon ICON "Icon.ico" diff --git a/src/game/CustomRes.res b/src/game/CustomRes.res new file mode 100644 index 0000000..f5fbac3 Binary files /dev/null and b/src/game/CustomRes.res differ diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr new file mode 100644 index 0000000..e2dacc1 --- /dev/null +++ b/src/game/Doom2DF.dpr @@ -0,0 +1,74 @@ +program Doom2DF; +{$APPTYPE GUI} +{$HINTS OFF} + +uses + GL, + GLExt, + ENet in '../lib/enet/enet.pp', + ENetTypes in '../lib/enet/enettypes.pp', + ENetList in '../lib/enet/enetlist.pp', + ENetTime in '../lib/enet/enettime.pp', + ENetProtocol in '../lib/enet/enetprotocol.pp', + ENetCallbacks in '../lib/enet/enetcallbacks.pp', + ENetPlatform in '../lib/enet/enetplatform.pp', + e_graphics in '../engine/e_graphics.pas', + e_input in '../engine/e_input.pas', + e_log in '../engine/e_log.pas', + e_sound in '../engine/e_sound.pas', + e_textures in '../engine/e_textures.pas', + e_fixedbuffer in '../engine/e_fixedbuffer.pas', + WADEDITOR in '../shared/WADEDITOR.pas', + WADSTRUCT in '../shared/WADSTRUCT.pas', + MAPSTRUCT in '../shared/MAPSTRUCT.pas', + MAPREADER in '../shared/MAPREADER.pas', + MAPDEF in '../shared/MAPDEF.pas', + CONFIG in '../shared/CONFIG.pas', + g_basic in 'g_basic.pas', + g_console in 'g_console.pas', + g_net in 'g_net.pas', + g_netmsg in 'g_netmsg.pas', + g_nethandler in 'g_nethandler.pas', + g_netmaster in 'g_netmaster.pas', + g_res_downloader in 'g_res_downloader.pas', + g_game in 'g_game.pas', + g_gfx in 'g_gfx.pas', + g_gui in 'g_gui.pas', + g_items in 'g_items.pas', + g_main in 'g_main.pas', + g_map in 'g_map.pas', + g_menu in 'g_menu.pas', + g_monsters in 'g_monsters.pas', + g_options in 'g_options.pas', + g_phys in 'g_phys.pas', + g_player in 'g_player.pas', + g_playermodel in 'g_playermodel.pas', + g_saveload in 'g_saveload.pas', + g_sound in 'g_sound.pas', + g_textures in 'g_textures.pas', + g_triggers in 'g_triggers.pas', + g_weapons in 'g_weapons.pas', + g_window in 'g_window.pas', + sysutils, + fmod in '../lib/FMOD/fmod.pas', + fmoderrors in '../lib/FMOD/fmoderrors.pas', + fmodpresets in '../lib/FMOD/fmodpresets.pas', + fmodtypes in '../lib/FMOD/fmodtypes.pas', + BinEditor in '../shared/BinEditor.pas', + g_panel in 'g_panel.pas', + g_language in 'g_language.pas'; + +{$R *.res} +{$R CustomRes.res} + +begin + try + Main(); + e_WriteLog('Shutdown with no errors.', MSG_NOTIFY); + except + on E: Exception do + e_WriteLog(Format(_lc[I_SYSTEM_ERROR_MSG], [E.Message]), MSG_FATALERROR); + else + e_WriteLog(Format(_lc[I_SYSTEM_ERROR_UNKNOWN], [LongWord(ExceptAddr())]), MSG_FATALERROR); + end; +end. diff --git a/src/game/Doom2DF.rc b/src/game/Doom2DF.rc new file mode 100644 index 0000000..0473fb6 --- /dev/null +++ b/src/game/Doom2DF.rc @@ -0,0 +1,24 @@ +APPVERINFO VERSIONINFO +FILEVERSION 0,6,6,7 +PRODUCTVERSION 0,6,6,7 +FILETYPE VFT_APP +{ + BLOCK "StringFileInfo" + { + BLOCK "040904E4" + { + VALUE "CompanyName", "www.doom2d.org\0" + VALUE "FileDescription", "Doom 2D: Forever\0" + VALUE "FileVersion", "0.6.6.7\0" + VALUE "InternalName", "Doom 2D: Forever\0" + VALUE "LegalCopyright", "All rights reserved.\0" + VALUE "OriginalFilename", "Doom2DF.exe\0" + VALUE "ProductName", "Doom 2D: Forever\0" + VALUE "ProductVersion", "0.6.6.7\0" + } + } + BLOCK "VarFileInfo" + { + VALUE "Translation", LANG_RUSSIAN, 1251 + } +} diff --git a/src/game/Doom2DF.res b/src/game/Doom2DF.res new file mode 100644 index 0000000..497f06d Binary files /dev/null and b/src/game/Doom2DF.res differ diff --git a/src/game/Icon.ico b/src/game/Icon.ico new file mode 100644 index 0000000..9b80cb6 Binary files /dev/null and b/src/game/Icon.ico differ diff --git a/src/game/MakeRes.bat b/src/game/MakeRes.bat new file mode 100644 index 0000000..0a910e4 --- /dev/null +++ b/src/game/MakeRes.bat @@ -0,0 +1,3 @@ +gorc.exe CustomRes.rc +"C:\Program Files (x86)\Borland\Delphi7\Bin\brcc32.exe" Doom2DF.rc +pause \ No newline at end of file diff --git a/src/game/g_basic.pas b/src/game/g_basic.pas new file mode 100644 index 0000000..e1ce980 --- /dev/null +++ b/src/game/g_basic.pas @@ -0,0 +1,1173 @@ +unit g_basic; + +interface + +uses + WADEDITOR, g_phys; + +const + GAME_VERSION = '0.667'; + UID_GAME = 1; + UID_PLAYER = 2; + UID_MONSTER = 3; + UID_ITEM = 10; + UID_MAX_GAME = $10; + UID_MAX_PLAYER = $7FFF; + UID_MAX_MONSTER = $FFFF; + +type + TDirection = (D_LEFT, D_RIGHT); + WArray = array of Word; + DWArray = array of DWORD; + String20 = String[20]; + +function g_CreateUID(UIDType: Byte): Word; +function g_GetUIDType(UID: Word): Byte; +function g_Collide(X1, Y1: Integer; Width1, Height1: Word; + X2, Y2: Integer; Width2, Height2: Word): Boolean; +function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean; +function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; +function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; +function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word; + X2, Y2: Integer; Width2, Height2: Word): Boolean; +function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; +function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean; +function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean; +function g_PatchLength(X1, Y1, X2, Y2: Integer): Word; +function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; +function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte; +function g_Look(a, b: PObj; d: TDirection): Boolean; +procedure IncMax(var A: Integer; B, Max: Integer); overload; +procedure IncMax(var A: Single; B, Max: Single); overload; +procedure IncMax(var A: Integer; Max: Integer); overload; +procedure IncMax(var A: Single; Max: Single); overload; +procedure IncMax(var A: Word; B, Max: Word); overload; +procedure IncMax(var A: Word; Max: Word); overload; +procedure IncMax(var A: SmallInt; B, Max: SmallInt); overload; +procedure IncMax(var A: SmallInt; Max: SmallInt); overload; +procedure DecMin(var A: Integer; B, Min: Integer); overload; +procedure DecMin(var A: Single; B, Min: Single); overload; +procedure DecMin(var A: Integer; Min: Integer); overload; +procedure DecMin(var A: Single; Min: Single); overload; +procedure DecMin(var A: Word; B, Min: Word); overload; +procedure DecMin(var A: Word; Min: Word); overload; +procedure DecMin(var A: Byte; B, Min: Byte); overload; +procedure DecMin(var A: Byte; Min: Byte); overload; +function Sign(A: Integer): ShortInt; overload; +function Sign(A: Single): ShortInt; overload; +function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer; +function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt; +function GetAngle2(vx, vy: Integer): SmallInt; +function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray; +procedure Sort(var a: SArray); +function Sscanf(const s: string; const fmt: string; + const Pointers: array of Pointer): Integer; +function InDWArray(a: DWORD; arr: DWArray): Boolean; +function InWArray(a: Word; arr: WArray): Boolean; +function InSArray(a: string; arr: SArray): Boolean; +function GetPos(UID: Word; o: PObj): Boolean; +function parse(s: string): SArray; +function parse2(s: string; delim: Char): SArray; +function g_GetFileTime(fileName: String): Integer; +function g_SetFileTime(fileName: String; time: Integer): Boolean; +procedure SortSArray(var S: SArray); +function b_Text_Format(S: string): string; +function b_Text_Unformat(S: string): string; + +implementation + +uses + Math, g_map, g_gfx, g_player, SysUtils, MAPDEF, + StrUtils, e_graphics, g_monsters, g_items; + +function g_PatchLength(X1, Y1, X2, Y2: Integer): Word; +begin + Result := Min(Round(Hypot(Abs(X2-X1), Abs(Y2-Y1))), 65535); +end; + +function g_CollideLevel(X, Y: Integer; Width, Height: Word): Boolean; +var + a: Integer; +begin + Result := False; + + if gWalls = nil then + Exit; + + for a := 0 to High(gWalls) do + if gWalls[a].Enabled and + not ( ((Y + Height <= gWalls[a].Y) or + (Y >= gWalls[a].Y + gWalls[a].Height)) or + ((X + Width <= gWalls[a].X) or + (X >= gWalls[a].X + gWalls[a].Width)) ) then + begin + Result := True; + Exit; + end; +end; + +function g_CollidePlayer(X, Y: Integer; Width, Height: Word): Boolean; +var + a: Integer; +begin + Result := False; + + if gPlayers = nil then Exit; + + for a := 0 to High(gPlayers) do + if (gPlayers[a] <> nil) and gPlayers[a].Live then + if gPlayers[a].Collide(X, Y, Width, Height) then + begin + Result := True; + Exit; + end; +end; + +function g_CollideMonster(X, Y: Integer; Width, Height: Word): Boolean; +var + a: Integer; +begin + Result := False; + + if gMonsters = nil then Exit; + + for a := 0 to High(gMonsters) do + if (gMonsters[a] <> nil) and gMonsters[a].Live then + if g_Obj_Collide(X, Y, Width, Height, @gMonsters[a].Obj) then + begin + Result := True; + Exit; + end; +end; + +function g_CollideItem(X, Y: Integer; Width, Height: Word): Boolean; +var + a: Integer; +begin + Result := False; + + if gItems = nil then + Exit; + + for a := 0 to High(gItems) do + if gItems[a].Live then + if g_Obj_Collide(X, Y, Width, Height, @gItems[a].Obj) then + begin + Result := True; + Exit; + end; +end; + +function g_TraceVector(X1, Y1, X2, Y2: Integer): Boolean; +var + i: Integer; + dx, dy: Integer; + Xerr, Yerr, d: LongWord; + incX, incY: Integer; + x, y: Integer; +begin + Result := False; + + Assert(gCollideMap <> nil, 'g_TraceVector: gCollideMap = nil'); + + Xerr := 0; + Yerr := 0; + dx := X2-X1; + dy := Y2-Y1; + + if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0; + if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0; + + dx := abs(dx); + dy := abs(dy); + + if dx > dy then d := dx else d := dy; + + x := X1; + y := Y1; + + for i := 1 to d do + begin + Inc(Xerr, dx); + Inc(Yerr, dy); + if Xerr>d then + begin + Dec(Xerr, d); + Inc(x, incX); + end; + if Yerr > d then + begin + Dec(Yerr, d); + Inc(y, incY); + end; + + if (y > gMapInfo.Height-1) or + (y < 0) or (x > gMapInfo.Width-1) or (x < 0) then + Exit; + if ByteBool(gCollideMap[y, x] and MARK_BLOCKED) then + Exit; + end; + + Result := True; +end; + +function g_CreateUID(UIDType: Byte): Word; +var + ok: Boolean; + i: Integer; +begin + Result := $0; + + case UIDType of + UID_PLAYER: + begin + repeat + Result := UID_MAX_GAME+$1+Random(UID_MAX_PLAYER-UID_MAX_GAME+$1); + + ok := True; + if gPlayers <> nil then + for i := 0 to High(gPlayers) do + if gPlayers[i] <> nil then + if Result = gPlayers[i].UID then + begin + ok := False; + Break; + end; + until ok; + end; + + UID_MONSTER: + begin + repeat + Result := UID_MAX_PLAYER+$1+Random(UID_MAX_MONSTER-UID_MAX_GAME-UID_MAX_PLAYER+$1); + + ok := True; + if gMonsters <> nil then + for i := 0 to High(gMonsters) do + if gMonsters[i] <> nil then + if Result = gMonsters[i].UID then + begin + ok := False; + Break; + end; + until ok; + end; + end; +end; + +function g_GetUIDType(UID: Word): Byte; +begin + if UID <= UID_MAX_GAME then + Result := UID_GAME + else + if UID <= UID_MAX_PLAYER then + Result := UID_PLAYER + else + Result := UID_MONSTER; +end; + +function g_Collide(X1, Y1: Integer; Width1, Height1: Word; + X2, Y2: Integer; Width2, Height2: Word): Boolean; +begin + Result := not ( ((Y1 + Height1 <= Y2) or + (Y2 + Height2 <= Y1)) or + ((X1 + Width1 <= X2) or + (X2 + Width2 <= X1)) ); +end; + +function g_CollideAround(X1, Y1: Integer; Width1, Height1: Word; + X2, Y2: Integer; Width2, Height2: Word): Boolean; +begin + Result := g_Collide(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or + g_Collide(X1+1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or + g_Collide(X1-1, Y1, Width1, Height1, X2, Y2, Width2, Height2) or + g_Collide(X1, Y1+1, Width1, Height1, X2, Y2, Width2, Height2) or + g_Collide(X1, Y1-1, Width1, Height1, X2, Y2, Width2, Height2); +end; + +function c(X1, Y1, Width1, Height1, X2, Y2, Width2, Height2: Integer): Boolean; +begin + Result := not (((Y1 + Height1 <= Y2) or + (Y1 >= Y2 + Height2)) or + ((X1 + Width1 <= X2) or + (X1 >= X2 + Width2))); +end; + +function g_Collide2(X1, Y1, X2, Y2, X3, Y3, X4, Y4: Integer): Boolean; +begin + //Result := not (((Y2 <= Y3) or (Y1 >= Y4)) or ((X2 <= X3) or (X1 >= X4))); + Result := c(X1, Y1, X2-X1, Y2-Y1, X3, Y3, X4-X3, Y4-Y3); +end; + +function g_CollidePoint(X, Y, X2, Y2: Integer; Width, Height: Word): Boolean; +begin + X := X-X2; + Y := Y-Y2; + Result := (x >= 0) and (x <= Width) and + (y >= 0) and (y <= Height); +end; + +procedure IncMax(var A: Integer; B, Max: Integer); +begin + if A+B > Max then A := Max else A := A+B; +end; + +procedure IncMax(var A: Single; B, Max: Single); +begin + if A+B > Max then A := Max else A := A+B; +end; + +procedure DecMin(var A: Integer; B, Min: Integer); +begin + if A-B < Min then A := Min else A := A-B; +end; + +procedure DecMin(var A: Word; B, Min: Word); +begin + if A-B < Min then A := Min else A := A-B; +end; + +procedure DecMin(var A: Single; B, Min: Single); +begin + if A-B < Min then A := Min else A := A-B; +end; + +procedure IncMax(var A: Integer; Max: Integer); +begin + if A+1 > Max then A := Max else A := A+1; +end; + +procedure IncMax(var A: Single; Max: Single); +begin + if A+1 > Max then A := Max else A := A+1; +end; + +procedure IncMax(var A: Word; B, Max: Word); +begin + if A+B > Max then A := Max else A := A+B; +end; + +procedure IncMax(var A: Word; Max: Word); +begin + if A+1 > Max then A := Max else A := A+1; +end; + +procedure IncMax(var A: SmallInt; B, Max: SmallInt); +begin + if A+B > Max then A := Max else A := A+B; +end; + +procedure IncMax(var A: SmallInt; Max: SmallInt); +begin + if A+1 > Max then A := Max else A := A+1; +end; + +procedure DecMin(var A: Integer; Min: Integer); +begin + if A-1 < Min then A := Min else A := A-1; +end; + +procedure DecMin(var A: Single; Min: Single); +begin + if A-1 < Min then A := Min else A := A-1; +end; + +procedure DecMin(var A: Word; Min: Word); +begin + if A-1 < Min then A := Min else A := A-1; +end; + +procedure DecMin(var A: Byte; B, Min: Byte); +begin + if A-B < Min then A := Min else A := A-B; +end; + +procedure DecMin(var A: Byte; Min: Byte); overload; +begin + if A-1 < Min then A := Min else A := A-1; +end; + +function Sign(A: Integer): ShortInt; +begin + if A < 0 then Result := -1 + else if A > 0 then Result := 1 + else Result := 0; +end; + +function Sign(A: Single): ShortInt; +const + Eps = 1.0E-5; +begin + if Abs(A) < Eps then Result := 0 + else if A < 0 then Result := -1 + else Result := 1; +end; + +function PointToRect(X, Y, X1, Y1: Integer; Width, Height: Word): Integer; +begin + X := X-X1; // A(0;0) --- B(W;0) + Y := Y-Y1; // | | + // D(0;H) --- C(W;H) + if X < 0 then + begin // Ñëåâà + if Y < 0 then // Ñëåâà ñâåðõó: ðàññòîÿíèå äî A + Result := Round(Hypot(X, Y)) + else + if Y > Height then // Ñëåâà ñíèçó: ðàññòîÿíèå äî D + Result := Round(Hypot(X, Y-Height)) + else // Ñëåâà ïîñåðåäèíå: ðàññòîÿíèå äî AD + Result := -X; + end + else + if X > Width then + begin // Ñïðàâà + X := X-Width; + if y < 0 then // Ñïðàâà ñâåðõó: ðàññòîÿíèå äî B + Result := Round(Hypot(X, Y)) + else + if Y > Height then // Ñïðàâà ñíèçó: ðàññòîÿíèå äî C + Result := Round(Hypot(X, Y-Height)) + else // Ñïðàâà ïîñåðåäèíå: ðàññòîÿíèå äî BC + Result := X; + end + else // Ïîñåðåäèíå + begin + if Y < 0 then // Ïîñåðåäèíå ñâåðõó: ðàññòîÿíèå äî AB + Result := -Y + else + if Y > Height then // Ïîñåðåäèíå ñíèçó: ðàññòîÿíèå äî DC + Result := Y-Height + else // Âíóòðè ïðÿìîóãîëüíèêà: ðàññòîÿíèå 0 + Result := 0; + end; +end; + +function g_GetAcidHit(X, Y: Integer; Width, Height: Word): Byte; +const + tab: array[0..3] of Byte = (0, 5, 10, 20); +var + a: Byte; +begin + a := 0; + + if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID1, False) then a := a or 1; + if g_Map_CollidePanel(X, Y, Width, Height, PANEL_ACID2, False) then a := a or 2; + + Result := tab[a]; +end; + +function g_Look(a, b: PObj; d: TDirection): Boolean; +begin + if ((b^.X > a^.X) and (d = D_LEFT)) or + ((b^.X < a^.X) and (d = D_RIGHT)) then + begin + Result := False; + Exit; + end; + + Result := g_TraceVector(a^.X+a^.Rect.X+(a^.Rect.Width div 2), + a^.Y+a^.Rect.Y+(a^.Rect.Height div 2), + b^.X+b^.Rect.X+(b^.Rect.Width div 2), + b^.Y+b^.Rect.Y+(b^.Rect.Height div 2)); +end; + +function GetAngle(baseX, baseY, pointX, PointY: Integer): SmallInt; +var + c: Single; + a, b: Integer; +begin + a := abs(pointX-baseX); + b := abs(pointY-baseY); + + if a = 0 then c := 90 + else c := RadToDeg(ArcTan(b/a)); + + if pointY < baseY then c := -c; + if pointX > baseX then c := 180-c; + + Result := Round(c); +end; + +function GetAngle2(vx, vy: Integer): SmallInt; +var + c: Single; + a, b: Integer; +begin + a := abs(vx); + b := abs(vy); + + if a = 0 then + c := 0 + else + c := RadToDeg(ArcTan(b/a)); + + if vy < 0 then + c := -c; + if vx > 0 then + c := 180 - c; + + c := c + 180; + + Result := Round(c); +end; + +{function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean; +const + table: array[0..8, 0..8] of Byte = + ((0, 0, 3, 3, 1, 2, 2, 0, 1), + (0, 0, 0, 0, 4, 7, 2, 0, 1), + (3, 0, 0, 0, 4, 4, 1, 3, 1), + (3, 0, 0, 0, 0, 0, 5, 6, 1), + (1, 4, 4, 0, 0, 0, 5, 5, 1), + (2, 7, 4, 0, 0, 0, 0, 0, 1), + (2, 2, 1, 5, 5, 0, 0, 0, 1), + (0, 0, 3, 6, 5, 0, 0, 0, 1), + (1, 1, 1, 1, 1, 1, 1, 1, 1)); + +function GetClass(x, y: Integer): Byte; +begin + if y < rY then + begin + if x < rX then Result := 7 + else if x < rX+rWidth then Result := 0 + else Result := 1; + end + else if y < rY+rHeight then + begin + if x < rX then Result := 6 + else if x < rX+rWidth then Result := 8 + else Result := 2; + end + else + begin + if x < rX then Result := 5 + else if x < rX+rWidth then Result := 4 + else Result := 3; + end; +end; + +begin + case table[GetClass(x1, y1), GetClass(x2, y2)] of + 0: Result := False; + 1: Result := True; + 2: Result := Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1)); + 3: Result := Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1)); + 4: Result := Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1)); + 5: Result := Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1)); + 6: Result := (Abs((rY-y1))/Abs((rX+rWidth-x1)) <= Abs((y2-y1))/Abs((x2-x1))) and + (Abs((rY+rHeight-y1))/Abs((rX-x1)) >= Abs((y2-y1))/Abs((x2-x1))); + 7: Result := (Abs((rY+rHeight-y1))/Abs((rX+rWidth-x1)) >= Abs((y2-y1))/Abs((x2-x1))) and + (Abs((rY-y1))/Abs((rX-x1)) <= Abs((y2-y1))/Abs((x2-x1))); + else Result := False; + end; +end;} + +function g_CollideLine(x1, y1, x2, y2, rX, rY: Integer; rWidth, rHeight: Word): Boolean; +var + i: Integer; + dx, dy: Integer; + Xerr, Yerr: Integer; + incX, incY: Integer; + x, y, d: Integer; +begin + Result := True; + + Xerr := 0; + Yerr := 0; + dx := X2-X1; + dy := Y2-Y1; + + if dx > 0 then incX := 1 else if dx < 0 then incX := -1 else incX := 0; + if dy > 0 then incY := 1 else if dy < 0 then incY := -1 else incY := 0; + + dx := abs(dx); + dy := abs(dy); + + if dx > dy then d := dx else d := dy; + + x := X1; + y := Y1; + + for i := 1 to d+1 do + begin + Inc(Xerr, dx); + Inc(Yerr, dy); + if Xerr > d then + begin + Dec(Xerr, d); + Inc(x, incX); + end; + if Yerr > d then + begin + Dec(Yerr, d); + Inc(y, incY); + end; + + if (x >= rX) and (x <= (rX + rWidth - 1)) and + (y >= rY) and (y <= (rY + rHeight - 1)) then Exit; + end; + + Result := False; +end; + +function GetStr(var Str: string): string; +var + a: Integer; +begin + for a := 1 to Length(Str) do + if (a = Length(Str)) or (Str[a+1] = ' ') then + begin + Result := Copy(Str, 1, a); + Delete(Str, 1, a+1); + Str := Trim(Str); + Exit; + end; +end; + +{function GetLines(Text: string; MaxChars: Word): SArray; +var + a: Integer; + b: array of string; + str: string; +begin + Text := Trim(Text); + + while Pos(' ', Text) <> 0 do Text := AnsiReplaceStr(Text, ' ', ' '); + + while Text <> '' do + begin + SetLength(b, Length(b)+1); + b[High(b)] := GetStr(Text); + end; + + a := 0; + while True do + begin + if a > High(b) then Break; + + str := b[a]; + a := a+1; + + if Length(str) >= MaxChars then + begin + while str <> '' do + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := Copy(str, 1, MaxChars); + Delete(str, 1, MaxChars); + end; + + Continue; + end; + + while (a <= High(b)) and (Length(str+' '+b[a]) <= MaxChars) do + begin + str := str+' '+b[a]; + a := a+1; + end; + + SetLength(Result, Length(Result)+1); + Result[High(Result)] := str; + end; +end;} + +function GetLines(Text: string; FontID: DWORD; MaxWidth: Word): SArray; + +function TextLen(Text: string): Word; +var + h: Word; +begin + e_CharFont_GetSize(FontID, Text, Result, h); +end; + +var + a, c: Integer; + b: array of string; + str: string; +begin + SetLength(Result, 0); + SetLength(b, 0); + + Text := Trim(Text); + +// Óäàëÿåì ìíîæåñòâåííûå ïðîáåëû: + while Pos(' ', Text) <> 0 do + Text := AnsiReplaceStr(Text, ' ', ' '); + + while Text <> '' do + begin + SetLength(b, Length(b)+1); + b[High(b)] := GetStr(Text); + end; + + a := 0; + while True do + begin + if a > High(b) then + Break; + + str := b[a]; + a := a+1; + + if TextLen(str) > MaxWidth then + begin // Òåêóùàÿ ñòðîêà ñëèøêîì äëèííàÿ => ðàçáèâàåì + while str <> '' do + begin + SetLength(Result, Length(Result)+1); + + c := 0; + while (c < Length(str)) and + (TextLen(Copy(str, 1, c+1)) < MaxWidth) do + c := c+1; + + Result[High(Result)] := Copy(str, 1, c); + Delete(str, 1, c); + end; + end + else // Ñòðîêà íîðìàëüíîé äëèíû => ñîåäèíÿåì ñî ñëåäóþùèìè + begin + while (a <= High(b)) and + (TextLen(str+' '+b[a]) < MaxWidth) do + begin + str := str+' '+b[a]; + a := a + 1; + end; + + SetLength(Result, Length(Result)+1); + Result[High(Result)] := str; + end; + end; +end; + +procedure Sort(var a: SArray); +var + i, j: Integer; + s: string; +begin + if a = nil then Exit; + + for i := High(a) downto Low(a) do + for j := Low(a) to High(a)-1 do + if LowerCase(a[j]) > LowerCase(a[j+1]) then + begin + s := a[j]; + a[j] := a[j+1]; + a[j+1] := s; + end; +end; + +function Sscanf(const s: String; const fmt: String; + const Pointers: array of Pointer): Integer; +var + i, j, n, m: Integer; + s1: ShortString; + L: LongInt; + X: Extended; + + function GetInt(): Integer; + begin + s1 := ''; + while (n <= Length(s)) and (s[n] = ' ') do + Inc(n); + + while (n <= Length(s)) and (s[n] in ['0'..'9', '+', '-']) do + begin + s1 := s1 + s[n]; + Inc(n); + end; + + Result := Length(s1); + end; + + function GetFloat(): Integer; + begin + s1 := ''; + while (n <= Length(s)) and (s[n] = ' ') do + Inc(n); + + while (n <= Length(s)) and //jd >= rather than > + (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E']) do + begin + s1 := s1 + s[n]; + Inc(n); + end; + + Result := Length(s1); + end; + + function GetString(): Integer; + begin + s1 := ''; + while (n <= Length(s)) and (s[n] = ' ') do + Inc(n); + + while (n <= Length(s)) and (s[n] <> ' ') do + begin + s1 := s1 + s[n]; + Inc(n); + end; + + Result := Length(s1); + end; + + function ScanStr(c: Char): Boolean; + begin + while (n <= Length(s)) and (s[n] <> c) do + Inc(n); + Inc(n); + + Result := (n <= Length(s)); + end; + + function GetFmt(): Integer; + begin + Result := -1; + + while (True) do + begin + while (fmt[m] = ' ') and (m < Length(fmt)) do + Inc(m); + if (m >= Length(fmt)) then + Break; + + if (fmt[m] = '%') then + begin + Inc(m); + case fmt[m] of + 'd': Result := vtInteger; + 'f': Result := vtExtended; + 's': Result := vtString; + end; + Inc(m); + Break; + end; + + if (not ScanStr(fmt[m])) then + Break; + Inc(m); + end; + end; + +begin + n := 1; + m := 1; + Result := 0; + + for i := 0 to High(Pointers) do + begin + j := GetFmt(); + + case j of + vtInteger : + begin + if GetInt() > 0 then + begin + L := StrToIntDef(s1, 0); + Move(L, Pointers[i]^, SizeOf(LongInt)); + Inc(Result); + end + else + Break; + end; + + vtExtended : + begin + if GetFloat() > 0 then + begin + X := StrToFloatDef(s1, 0.0); + Move(X, Pointers[i]^, SizeOf(Extended)); + Inc(Result); + end + else + Break; + end; + + vtString : + begin + if GetString() > 0 then + begin + Move(s1, Pointers[i]^, Length(s1)+1); + Inc(Result); + end + else + Break; + end; + + else {case} + Break; + end; {case} + end; +end; + +function InDWArray(a: DWORD; arr: DWArray): Boolean; +var + b: Integer; +begin + Result := False; + + if arr = nil then Exit; + + for b := 0 to High(arr) do + if arr[b] = a then + begin + Result := True; + Exit; + end; +end; + +function InWArray(a: Word; arr: WArray): Boolean; +var + b: Integer; +begin + Result := False; + + if arr = nil then Exit; + + for b := 0 to High(arr) do + if arr[b] = a then + begin + Result := True; + Exit; + end; +end; + +function InSArray(a: string; arr: SArray): Boolean; +var + b: Integer; +begin + Result := False; + + if arr = nil then Exit; + + a := AnsiLowerCase(a); + + for b := 0 to High(arr) do + if AnsiLowerCase(arr[b]) = a then + begin + Result := True; + Exit; + end; +end; + +function GetPos(UID: Word; o: PObj): Boolean; +var + p: TPlayer; + m: TMonster; +begin + Result := False; + + case g_GetUIDType(UID) of + UID_PLAYER: + begin + p := g_Player_Get(UID); + if p = nil then Exit; + if not p.Live then Exit; + + o^ := p.Obj; + end; + + UID_MONSTER: + begin + m := g_Monsters_Get(UID); + if m = nil then Exit; + if not m.Live then Exit; + + o^ := m.Obj; + end; + else Exit; + end; + + Result := True; +end; + +function parse(s: String): SArray; +var + a: Integer; +begin + Result := nil; + if s = '' then + Exit; + + while s <> '' do + begin + for a := 1 to Length(s) do + if (s[a] = ',') or (a = Length(s)) then + begin + SetLength(Result, Length(Result)+1); + + if s[a] = ',' then + Result[High(Result)] := Copy(s, 1, a-1) + else // Êîíåö ñòðîêè + Result[High(Result)] := s; + + Delete(s, 1, a); + Break; + end; + end; +end; + +function parse2(s: string; delim: Char): SArray; +var + a: Integer; +begin + Result := nil; + if s = '' then Exit; + + while s <> '' do + begin + for a := 1 to Length(s) do + if (s[a] = delim) or (a = Length(s)) then + begin + SetLength(Result, Length(Result)+1); + + if s[a] = delim then Result[High(Result)] := Copy(s, 1, a-1) + else Result[High(Result)] := s; + + Delete(s, 1, a); + Break; + end; + end; +end; + +function g_GetFileTime(fileName: String): Integer; +var + F: File; +begin + if not FileExists(fileName) then + begin + Result := -1; + Exit; + end; + + AssignFile(F, fileName); + Reset(F); + Result := FileGetDate(TFileRec(F).Handle); + CloseFile(F); +end; + +function g_SetFileTime(fileName: String; time: Integer): Boolean; +var + F: File; +begin + if (not FileExists(fileName)) or (time < 0) then + begin + Result := False; + Exit; + end; + + AssignFile(F, fileName); + Reset(F); + Result := (FileSetDate(TFileRec(F).Handle, time) = 0); + CloseFile(F); +end; + +procedure SortSArray(var S: SArray); +var + b: Boolean; + i: Integer; + sw: ShortString; +begin + repeat + b := False; + for i := Low(S) to High(S) - 1 do + if S[i] > S[i + 1] then begin + sw := S[i]; + S[i] := S[i + 1]; + S[i + 1] := sw; + b := True; + end; + until not b; +end; + +function b_Text_Format(S: string): string; +var + Spec, Rst: Boolean; + I: Integer; +begin + Result := ''; + Spec := False; + Rst := False; + for I := 1 to Length(S) do + begin + if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then + begin + Spec := True; + Rst := True; + continue; + end; + if Spec then + begin + case S[I] of + 'n': // line feed + Result := Result + #10; + '0': // black + Result := Result + #1; + '1': // white + Result := Result + #2; + 'd': // darker + Result := Result + #3; + 'l': // lighter + Result := Result + #4; + 'r': // red + Result := Result + #18; + 'g': // green + Result := Result + #19; + 'b': // blue + Result := Result + #20; + 'y': // yellow + Result := Result + #21; + '\': // escape + Result := Result + '\'; + else + Result := Result + '\' + S[I]; + end; + Spec := False; + end else + Result := Result + S[I]; + end; + // reset to white at end + if Rst then Result := Result + #2; +end; + +function b_Text_Unformat(S: string): string; +var + Spec: Boolean; + I: Integer; +begin + Result := ''; + Spec := False; + for I := 1 to Length(S) do + begin + if S[I] in [#1, #2, #3, #4, #10, #18, #19, #20, #21] then + begin + Spec := False; + continue; + end; + if (not Spec) and (S[I] = '\') and (I + 1 <= Length(S)) then + begin + Spec := True; + continue; + end; + if Spec then + begin + case S[I] of + 'n': ; + '0': ; + '1': ; + 'd': ; + 'l': ; + 'r': ; + 'g': ; + 'b': ; + 'y': ; + '\': Result := Result + '\'; + else + Result := Result + '\' + S[I]; + end; + Spec := False; + end else + Result := Result + S[I]; + end; +end; + +end. diff --git a/src/game/g_console.pas b/src/game/g_console.pas new file mode 100644 index 0000000..3c16037 --- /dev/null +++ b/src/game/g_console.pas @@ -0,0 +1,903 @@ +unit g_console; + +interface + +procedure g_Console_Init(); +procedure g_Console_Update(); +procedure g_Console_Draw(); +procedure g_Console_Switch(); +procedure g_Console_Char(C: Char); +procedure g_Console_Control(K: Word); +procedure g_Console_Process(L: String; Quiet: Boolean = False); +procedure g_Console_Add(L: String; Show: Boolean = False); +procedure g_Console_Clear(); +function g_Console_CommandBlacklisted(C: String): Boolean; + +procedure g_Console_Chat_Switch(Team: Boolean = False); + +var + gConsoleShow: Boolean; // True - êîíñîëü îòêðûòà èëè îòêðûâàåòñÿ + gChatShow: Boolean; + gChatTeam: Boolean = False; + gAllowConsoleMessages: Boolean = True; + gChatEnter: Boolean = True; + gJustChatted: Boolean = False; // ÷òîáû àäìèí â èíòåðå ÷àòÿñü íå ïðîìàòûâàë ñòàòèñòèêó + +implementation + +uses + g_textures, g_main, e_graphics, e_input, g_game, + SysUtils, g_basic, g_options, WADEDITOR, Math, + g_menu, g_language, g_net, g_netmsg; + +type + TCmdProc = procedure (P: SArray); + + TCommand = record + Cmd: String; + Proc: TCmdProc; + end; + + TAlias = record + Name: String; + Commands: SArray; + end; + +const + Step = 32; + Alpha = 25; + MsgTime = 144; + MaxScriptRecursion = 16; + + DEBUG_STRING = 'DEBUG MODE'; + +var + ID: DWORD; + RecursionDepth: Word = 0; + RecursionLimitHit: Boolean = False; + Cons_Y: SmallInt; + Cons_Shown: Boolean; // Ðèñîâàòü ëè êîíñîëü? + Line: String; + CPos: Word; + ConsoleHistory: SArray; + CommandHistory: SArray; + Whitelist: SArray; + Commands: Array of TCommand; + Aliases: Array of TAlias; + CmdIndex: Word; + Offset: Word; + MsgArray: Array [0..4] of record + Msg: String; + Time: Word; + end; + +function GetStrACmd(var Str: String): String; +var + a: Integer; +begin + for a := 1 to Length(Str) do + if (a = Length(Str)) or (Str[a+1] = ';') then + begin + Result := Copy(Str, 1, a); + Delete(Str, 1, a+1); + Str := Trim(Str); + Exit; + end; +end; + +function ParseAlias(Str: String): SArray; +begin + Result := nil; + + Str := Trim(Str); + + if Str = '' then + Exit; + + while Str <> '' do + begin + SetLength(Result, Length(Result)+1); + Result[High(Result)] := GetStrACmd(Str); + end; +end; + +procedure ConsoleCommands(P: SArray); +var + Cmd, s: String; + a, b: Integer; + F: TextFile; +begin + Cmd := LowerCase(P[0]); + + if Cmd = 'clear' then + begin + ConsoleHistory := nil; + + for a := 0 to High(MsgArray) do + with MsgArray[a] do + begin + Msg := ''; + Time := 0; + end; + end; + + if Cmd = 'clearhistory' then + CommandHistory := nil; + + if Cmd = 'showhistory' then + if CommandHistory <> nil then + begin + g_Console_Add(''); + for a := 0 to High(CommandHistory) do + g_Console_Add(' '+CommandHistory[a]); + end; + + if Cmd = 'commands' then + begin + g_Console_Add(''); + g_Console_Add('Commands list:'); + for a := High(Commands) downto 0 do + g_Console_Add(' '+Commands[a].Cmd); + end; + + if Cmd = 'time' then + g_Console_Add(TimeToStr(Now), True); + + if Cmd = 'date' then + g_Console_Add(DateToStr(Now), True); + + if Cmd = 'echo' then + if Length(P) > 1 then + begin + if P[1] = 'ololo' then + gCheats := True + else + begin + s := ''; + for a := 1 to High(P) do + s := s + P[a] + ' '; + g_Console_Add(b_Text_Format(s), True); + end; + end + else + g_Console_Add(''); + + if Cmd = 'dump' then + begin + if ConsoleHistory <> nil then + begin + if Length(P) > 1 then + s := P[1] + else + s := GameDir+'/console.txt'; + + {$I-} + AssignFile(F, s); + Rewrite(F); + if IOResult <> 0 then + begin + g_Console_Add(Format(_lc[I_CONSOLE_ERROR_WRITE], [s])); + CloseFile(F); + Exit; + end; + + for a := 0 to High(ConsoleHistory) do + WriteLn(F, ConsoleHistory[a]); + + CloseFile(F); + g_Console_Add(Format(_lc[I_CONSOLE_DUMPED], [s])); + {$I+} + end; + end; + + if Cmd = 'exec' then + begin + // exec + if Length(P) > 1 then + begin + s := GameDir+'/'+P[1]; + + {$I-} + AssignFile(F, s); + Reset(F); + if IOResult <> 0 then + begin + g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s])); + CloseFile(F); + Exit; + end; + g_Console_Add(Format(_lc[I_CONSOLE_EXEC], [s])); + + while not EOF(F) do + begin + ReadLn(F, s); + if IOResult <> 0 then + begin + g_Console_Add(Format(_lc[I_CONSOLE_ERROR_READ], [s])); + CloseFile(F); + Exit; + end; + if Pos('#', s) <> 1 then // script comment + begin + // prevents endless loops + Inc(RecursionDepth); + RecursionLimitHit := (RecursionDepth > MaxScriptRecursion) or RecursionLimitHit; + if not RecursionLimitHit then + g_Console_Process(s, True); + Dec(RecursionDepth); + end; + end; + if (RecursionDepth = 0) and RecursionLimitHit then + begin + g_Console_Add(Format(_lc[I_CONSOLE_ERROR_CALL], [s])); + RecursionLimitHit := False; + end; + + CloseFile(F); + {$I+} + end + else + g_Console_Add('exec