unit UDisplay; interface {$IFDEF FPC} {$MODE Delphi} {$ENDIF} {$I switches.inc} uses {$IFDEF win32} windows, {$ELSE} LCLType, {$ENDIF} ucommon, SDL, UMenu, OpenGL12, SysUtils; type TDisplay = class private //fade-to-black-hack BlackScreen: Boolean; doFade : Boolean; canFade : Boolean; myFade : integer; lastTime : Cardinal; pTexData : Pointer; pTex : array[1..2] of glUInt; FPSCounter : Cardinal; LastFPS : Cardinal; NextFPSSwap : Cardinal; OSD_LastError : String; procedure DrawDebugInformation; public NextScreen : PMenu; CurrentScreen : PMenu; //popup hack NextScreenWithCheck: Pmenu; CheckOK : Boolean; Fade : Real; constructor Create; destructor Destroy; override; procedure PrintScreen; procedure ScreenShot; function Draw: Boolean; end; var Display: TDisplay; implementation uses {$IFDEF LAZARUS} ulazjpeg, {$ELSE} JPEG, {$ENDIF} {$IFNDEF win32} lclintf, {$ENDIF} graphics, TextGL, // ULog, UMain, UTexture, UIni, UGraphic, UTime, UCommandLine; constructor TDisplay.Create; var i: integer; begin inherited Create; //popup hack CheckOK := False; NextScreen := NIL; NextScreenWithCheck := NIL; BlackScreen := False; // fade mod myfade:=0; if Ini.ScreenFade=1 then doFade:=True else doFade:=False; canFade:=True; // generate texture for fading between screens GetMem(pTexData, 512*512*4); if pTexData <> NIL then for i:= 1 to 2 do begin glGenTextures(1, @pTex[i] ); if glGetError <> GL_NO_ERROR then canFade := False; glBindTexture(GL_TEXTURE_2D, pTex[i]); if glGetError <> GL_NO_ERROR then canFade := False; glTexImage2D(GL_TEXTURE_2D, 0, 4, 512, 512, 0, GL_RGBA, GL_UNSIGNED_BYTE, pTexData); if glGetError <> GL_NO_ERROR then canFade := False; glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); if glGetError <> GL_NO_ERROR then canFade := False; glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); if glGetError <> GL_NO_ERROR then canFade := False; end else begin canFade:=False; end; FreeMem(pTexData); //Set LastError for OSD to No Error OSD_LastError := 'No Errors'; end; destructor TDisplay.Destroy; begin if canFade then glDeleteTextures(1,@pTex); inherited Destroy; end; function TDisplay.Draw: Boolean; var S: integer; Col: Real; myFade2: Real; currentTime: Cardinal; glError: glEnum; glErrorStr: String; begin Result := True; Col := 1; {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then Col := 0; } glClearColor(Col, Col, Col , 0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); for S := 1 to Screens do begin ScreenAct := S; // if Screens = 1 then ScreenX := 0; // if (Screens = 2) and (S = 1) then ScreenX := -1; // if (Screens = 2) and (S = 2) then ScreenX := 1; ScreenX := 0; if S = 2 then TimeSkip := 0 else; glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH); //popup hack // check was successful... move on if CheckOK then begin if assigned (NextScreenWithCheck)then begin NextScreen:=NextScreenWithCheck; NextScreenWithCheck := NIL; CheckOk:=False; end else begin BlackScreen:=True; // end of game - fade to black before exit end; end; // CurrentScreen.SetAnimationProgress(1); if (not assigned (NextScreen)) and (not BlackScreen) then begin CurrentScreen.Draw; //popup mod if (ScreenPopupError <> NIL) and ScreenPopupError.Visible then ScreenPopupError.Draw else if (ScreenPopupCheck <> NIL) and ScreenPopupCheck.Visible then ScreenPopupCheck.Draw; // fade mod myfade:=0; if (Ini.ScreenFade=1) and canFade then doFade:=True else if Ini.ScreenFade=0 then doFade:=False; end else begin // check if we had an initialization error (canfade=false, dofade=true) if doFade and not canFade then begin doFade:=False; //disable fading // ScreenPopupError.ShowPopup('Error initializing\nfade texture\n\nfading\ndisabled'); //show error message end; if doFade and canFade then begin // fade mod //Create Fading texture if we're just starting if myfade = 0 then begin glViewPort(0, 0, 512, 512); CurrentScreen.Draw; glBindTexture(GL_TEXTURE_2D, pTex[S]); glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, 512, 512, 0); glError:=glGetError; if (glError <> GL_NO_ERROR) then begin canFade := False; glErrorStr := gluErrorString(glError); // ScreenPopupError.ShowPopup('Error copying\nfade texture\n('+glErrorStr+')\nfading\ndisabled'); //show error message end; glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH); // blackscreen-hack if not BlackScreen then NextScreen.onShow; lastTime:=GetTickCount; // TODO: use cross-plattform SDL_GetTicks() instead if (S=2) or (Screens = 1) then myfade:=myfade+1; end; // end texture creation in first fading step //do some time-based fading currentTime:=GetTickCount; // TODO: use cross-plattform SDL_GetTicks() instead if (currentTime > lastTime+30) and (S=1) then begin myfade:=myfade+4; lastTime:=currentTime; end; // LastFade := Fade; // whatever // Fade := Fade -0.999; // start fading out // CurrentScreen.ShowFinish := false; // no purpose? // CurrentScreen.SetAnimationProgress(Fade-1); // nop? // blackscreen-hack if not BlackScreen then NextScreen.Draw // draw next screen else if ScreenAct=1 then begin glClearColor(0, 0, 0 , 0); glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT); end; // and draw old screen over it... slowly fading out myfade2:=(myfade*myfade)/10000; glBindTexture(GL_TEXTURE_2D, pTex[S]); glColor4f(1, 1, 1, (1000-myfade*myfade)/1000); // strange calculation - alpha gets negative... but looks good this way glEnable(GL_TEXTURE_2D); glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); glEnable(GL_BLEND); glBegin(GL_QUADS); glTexCoord2f(0+myfade2,0+myfade2);glVertex2f(0, 600); glTexCoord2f(0+myfade2,1-myfade2);glVertex2f(0, 0); glTexCoord2f(1-myfade2,1-myfade2);glVertex2f(800, 0); glTexCoord2f(1-myfade2,0+myfade2);glVertex2f(800, 600); glEnd; glDisable(GL_BLEND); glDisable(GL_TEXTURE_2D); end // blackscreen hack else if not BlackScreen then begin NextScreen.OnShow; end; if ((myfade > 40) or (not doFade) or (not canFade)) And (S = 1) then begin // fade out complete... myFade:=0; CurrentScreen.onHide; CurrentScreen.ShowFinish:=False; CurrentScreen:=NextScreen; NextScreen := nil; if not blackscreen then begin CurrentScreen.onShowFinish; CurrentScreen.ShowFinish := true; end else begin Result:=False; Break; end; // end of fade mod end; end; // if //Draw OSD only on first Screen if Debug Mode is enabled if ((Ini.Debug = 1) or (Params.Debug)) and (S=1) then DrawDebugInformation; end; // for // SDL_GL_SwapBuffers(); end; {function TDisplay.Fade(FadeIn : Boolean; Steps : UInt8): UInt8; begin Self.FadeIn := FadeIn; FadeStep := (SizeOf(FadeStep) * $FF) div Steps; ActualStep := $FF; Result := $FF div FadeStep; end;} procedure TDisplay.PrintScreen; var Bitmap: TBitmap; Jpeg: TJpegImage; X, Y: integer; Num: integer; FileName: string; begin for Num := 1 to 9999 do begin FileName := IntToStr(Num); while Length(FileName) < 4 do FileName := '0' + FileName; FileName := ScreenshotsPath + 'screenshot' + FileName + '.jpg'; if not FileExists(FileName) then break end; glReadPixels(0, 0, ScreenW, ScreenH, GL_RGBA, GL_UNSIGNED_BYTE, @PrintScreenData[0]); Bitmap := TBitmap.Create; Bitmap.Width := ScreenW; Bitmap.Height := ScreenH; for Y := 0 to ScreenH-1 do for X := 0 to ScreenW-1 do Bitmap.Canvas.Pixels[X, Y] := PrintScreenData[(ScreenH-1-Y) * ScreenW + X] and $00FFFFFF; Jpeg := TJpegImage.Create; Jpeg.Assign(Bitmap); Bitmap.Free; Jpeg.CompressionQuality := 95;//90; Jpeg.SaveToFile(FileName); Jpeg.Free; end; procedure TDisplay.ScreenShot; var F : file; FileInfo: BITMAPINFOHEADER; FileHeader : BITMAPFILEHEADER; pPicData:Pointer; FileName: String; Num: Integer; begin // FIXME: something broken in here... quick fix... disabled it Exit; // search image-file for Num := 1 to 9999 do begin FileName := IntToStr(Num); while Length(FileName) < 4 do FileName := '0' + FileName; FileName := ScreenshotsPath + FileName + '.BMP'; if not FileExists(FileName) then break end; // prepare header memory ZeroMemory(@FileHeader, SizeOf(BITMAPFILEHEADER)); ZeroMemory(@FileInfo , SizeOf(BITMAPINFOHEADER)); // initialize header-data FileHeader.bfType := 19778; // $4D42 = 'BM' FileHeader.bfOffBits := SizeOf(BITMAPINFOHEADER)+SizeOf(BITMAPFILEHEADER); // write bitmap info FileInfo.biSize := SizeOf(BITMAPINFOHEADER); FileInfo.biWidth := ScreenW; FileInfo.biHeight := ScreenH; FileInfo.biPlanes := 1; FileInfo.biBitCount := 32; FileInfo.biSizeImage := FileInfo.biWidth*FileInfo.biHeight*(FileInfo.biBitCount div 8); // copy size-info to header FileHeader.bfSize := FileHeader.bfOffBits + FileInfo.biSizeImage; // reserve memory for image-data GetMem(pPicData, FileInfo.biSizeImage); try // retrieve image-data from OpenGL (see above) glReadPixels(0, 0, ScreenW, ScreenH, GL_BGRA, GL_UNSIGNED_BYTE, pPicData); // and move the whole stuff into the file ;-) // up-to-date guys use streams for this purpose ... AssignFile(f, Filename); Rewrite( f,1 ); try BlockWrite(F, FileHeader, SizeOf(BITMAPFILEHEADER)); BlockWrite(F, FileInfo, SizeOf(BITMAPINFOHEADER)); BlockWrite(F, pPicData^, FileInfo.biSizeImage ); finally CloseFile(f); end; finally // free allocated data ... FreeMem(pPicData, FileInfo.biSizeImage); end; end; //------------ // DrawDebugInformation - Procedure draw FPS and some other Informations on Screen //------------ procedure TDisplay.DrawDebugInformation; var Ticks: Cardinal; begin //Some White Background for information glEnable(GL_BLEND); glDisable(GL_TEXTURE_2D); glColor4f(1, 1, 1, 0.5); glBegin(GL_QUADS); glVertex2f(690, 44); glVertex2f(690, 0); glVertex2f(800, 0); glVertex2f(800, 44); glEnd; glDisable(GL_BLEND); //Set Font Specs SetFontStyle(0); SetFontSize(7); SetFontItalic(False); glColor4f(0, 0, 0, 1); //Calculate FPS Ticks := GetTickCount; // TODO: use cross-plattform SDL_GetTicks() instead if (Ticks >= NextFPSSwap) then begin LastFPS := FPSCounter * 4; FPSCounter := 0; NextFPSSwap := Ticks + 250; end; Inc(FPSCounter); //Draw Text //FPS SetFontPos(695, 0); glPrint (PChar('FPS: ' + InttoStr(LastFPS))); //RSpeed SetFontPos(695, 13); glPrint (PChar('RSpeed: ' + InttoStr(Round(1000 * TimeMid)))); //LastError SetFontPos(695, 26); glColor4f(1, 0, 0, 1); glPrint (PChar(OSD_LastError)); glColor4f(1, 1, 1, 1); end; end.