cl_scrn.pas

雷神之锤2(Quake2)Delphi源码

//100%
{$ALIGN ON}{$MINENUMSIZE 4}
{----------------------------------------------------------------------------}
{                                                                            }
{ File(s): client\cl_scrn.c                                                    }
{                                                                            }
{ Initial conversion by : Juha Hartikainen ([e-mail])             }
{ Initial conversion on : 02-Jun-2002                                        }
{                                                                            }
{ This File contains part of convertion of Quake2 source to ObjectPascal.    }
{ More information about this project can be found at:                       }
{ http://www.sulaco.co.za/quake2/                                            }
{                                                                            }
{ Copyright (C) 1997-2001 Id Software, Inc.                                  }
{                                                                            }
{ This program is free software; you can redistribute it and/or              }
{ modify it under the terms of the GNU General Public License                }
{ as published by the Free Software Foundation; either version 2             }
{ of the License, or (at your option) any later version.                     }
{                                                                            }
{ This program is distributed in the hope that it will be useful,            }
{ but WITHOUT ANY WARRANTY; without even the implied warranty of             }
{ MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.                       }
{                                                                            }
{ See the GNU General Public License for more details.                       }
{                                                                            }
{----------------------------------------------------------------------------}
{ Updated on : 04-jun-2002                                                              }
{ Updated by : Juha Hartikainen ([e-mail])                                                              }
{ - moved some variables to interface section                                     }
{                                                                            }
{ Updated on : 09-jun-2002                                                              }
{ Updated by : Juha Hartikainen ([e-mail])                                                              }
{ - Finished conversion                                     }
{                                                                            }
{----------------------------------------------------------------------------}
{ * Still dependent (to compile correctly) on:                               }
{                                                                            }
{----------------------------------------------------------------------------}
{ * TODO:                                                                    }
{ - Move needed (global) procedure declarations to interface section         }
{ - All with TODO define }
{----------------------------------------------------------------------------}
// cl_scrn.c -- master for refresh, status bar, console, chat, notify, etc
{.$DEFINE TODO}

(*

  full screen console
  put up loading plaque
  blanked background with loading plaque
  blanked background with menu
  cinematics
  full screen image for quit and victory

  end of unit intermissions

*)

unit cl_scrn;

interface

uses
  Client,
  CPas,
  vid_h,
  q_shared;


procedure SCR_Init;
procedure SCR_TimeRefresh_f; cdecl;
procedure SCR_Loading_f; cdecl;
procedure SCR_DebugGraph (value: single; color: Integer); cdecl;
procedure SCR_AddDirtyPoint (x, y: Integer);
procedure SCR_DirtyScreen;
procedure SCR_UpdateScreen;
procedure SCR_BeginLoadingPlaque;
procedure SCR_EndLoadingPlaque;
procedure SCR_TouchPics;
procedure SCR_RunConsole;
procedure SCR_CenterPrint (str: pchar);
procedure CL_AddNetgraph;


var
  scr_con_current: single;	// aproaches scr_conlines at scr_conspeed
  scr_conlines: single;		// 0.0 to 1.0 lines of console to display

  scr_initialized: qboolean;		// ready to draw

  scr_draw_loading: integer;

  scr_vrect: vrect_t;		// position of render window on screen


  scr_viewsize,
  scr_conspeed,
  scr_centertime,
  scr_showturtle,
  scr_showpause,
  scr_printspeed,

  scr_netgraph,
  scr_timegraph,
  scr_debuggraph_,
  scr_graphheight,
  scr_graphscale,
  scr_graphshift,
  scr_drawall : cvar_p;

  crosshair_pic: array [0..MAX_QPATH-1] of char;
  crosshair_width, crosshair_height: Integer;


implementation

uses
  SysUtils,
  Cmd,
  Common,
  Console,
  CVar,
  ref,
  cl_cin,
  cl_inv,
  cd_win,
  q_shwin,
  snd_dma,
  cl_main,
  cl_view,
  menu,
  vid_dll;


type
  dirty_t = record
    x1, y1, x2, y2: Integer;
  end;

var
  scr_dirty: dirty_t;
  scr_old_dirty: array[0..1] of dirty_t;



(*
===============================================================================

BAR GRAPHS

===============================================================================
*)

(*
==============
CL_AddNetgraph

A new packet was just parsed
==============
*)
procedure CL_AddNetgraph;
var
  i: Integer;
  in_: integer;
  ping: integer;
begin
  // if using the debuggraph for something else, don't
  // add the net lines
  if (scr_debuggraph_.value<>0) or (scr_timegraph.value<>0) then
    exit;

  for i:= 0 to cls.netchan.dropped-1 do
    SCR_DebugGraph (30, $40);

  for i:=0 to cl.surpressCount-1 do
    SCR_DebugGraph (30, $df);

  // see what the latency was on this packet
  in_ := cls.netchan.incoming_acknowledged and (CMD_BACKUP-1);
  ping := cls.realtime - cl.cmd_time[in_];
  ping := round(ping / 30);
  if (ping > 30) then
    ping := 30;
  SCR_DebugGraph (ping, $d0);
end;

type
  graphsamp_t = packed record
	 value: single;
	 color: integer;
  end;

var
  current: integer;
  values: array[0..1024-1] of graphsamp_t;

(*
==============
SCR_DebugGraph
==============
*)
procedure SCR_DebugGraph (value: single; color: Integer);
begin
	values[current and 1023].value := value;
	values[current and 1023].color := color;
	Inc(current);
end;

(*
==============
SCR_DrawDebugGraph
==============
*)
procedure SCR_DrawDebugGraph;
var
	a, x, y, w, i, h: integer;
	v: single;
	color: integer;
begin
	//
	// draw the graph
	//
	w := scr_vrect.width;

	x := scr_vrect.x;
	y := scr_vrect.y+scr_vrect.height;
	re.DrawFill (x, round(y-scr_graphheight.value),
		w, round(scr_graphheight.value), 8);

	for a := 0 to w-1 do begin
		i := (current-1-a+1024) and 1023;
		v := values[i].value;
		color := values[i].color;
		v := v*scr_graphscale.value + scr_graphshift.value;

		if (v < 0) then
			v := v + scr_graphheight.value * (1+round(-v/scr_graphheight.value));
		h := Round(v) mod round(scr_graphheight.value);
		re.DrawFill (x+w-1-a, y - h, 1,	h, color);
  end;
end;

(*
===============================================================================

CENTER PRINTING

===============================================================================
*)

var
  scr_centerstring: array[0..1024-1] of char;
  scr_centertime_start: single;	// for slow victory printing
  scr_centertime_off: single;
  scr_center_lines: integer;
  scr_erase_center: integer;

(*
==============
SCR_CenterPrint

Called for important messages that should stay in the center of the screen
for a few moments
==============
*)
procedure SCR_CenterPrint (str: pchar);
var
	s: pchar;
	line: array[0..64-1] of char;
	i, j, l: integer;
begin
	strncpy (scr_centerstring, str, sizeof(scr_centerstring)-1);
	scr_centertime_off := scr_centertime.value;
	scr_centertime_start := cl.time;

	// count the number of lines for centering
	scr_center_lines := 1;
	s := str;
	while (s <> #0) do begin
		if (s = #10) then
			Inc(scr_center_lines);
		Inc(s);
  end;

	// echo it to the console
	Com_Printf(#10#10#35#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#37#10#10, []);

	s := str;
  repeat
  	// scan the width of the line
    l := 0;
		while (l < 40) do
    begin
			if (s[l]=#10) or (s[l]=#0) then
				Break;
      Inc(l);
    end;
    i := 0;
		while (i < (40-l) div 2) do
    begin
			line[i] := ' ';
      Inc(i);
    end;

		for j := 0 to l-1 do
    begin
			line[i] := s[j];
      Inc(i);
    end;

		line[i] := #10;
		line[i+1] := #0;

		Com_Printf ('%s', [line]);

		while (s<>#0) and (s <> #10) do
			Inc(s);

		if (s = #0) then
			break;
		Inc(s);		// skip the \n
	until false;
	Com_Printf(#10#10#35#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#36#37#10#10, []);
	Con_ClearNotify ();
end;


procedure SCR_DrawCenterString;
var
	start: pchar;
	l: integer;
	j: integer;
	x, y: integer;
	remaining: integer;
begin
// the finale prints the characters one at a time
	remaining := 9999;

	scr_erase_center := 0;
	start := scr_centerstring;

	if (scr_center_lines <= 4) then
		y := Round(viddef.height*0.35)
	else
		y := 48;

	while true do begin
	// scan the width of the line
		for l := 0 to 40-1 do
			if (start[l]=#10) or (start[l]=#0) then
				break;
		x := Round((viddef.width - l*8)/2);
		SCR_AddDirtyPoint (x, y);
    j := 0;
    while (j < l) do begin
			re.DrawChar (x, y, Byte(start[j]));
      Dec(remaining);
			if (remaining = 0) then
				exit;

      x := x + 8;
    end;
		SCR_AddDirtyPoint (x, y+8);

		y := y + 8;

		while (start <> #0) and (start <> #10) do
			Inc(start);

		if (start = #0) then
			break;
		Inc(start);		// skip the \n
	end;
end;

procedure SCR_CheckDrawCenterString;
begin
  scr_centertime_off := scr_centertime_off - cls.frametime;

  if (scr_centertime_off <= 0) then
          exit;

  SCR_DrawCenterString ();
end;

//=============================================================================

(*
=================
SCR_CalcVrect

Sets scr_vrect, the coordinates of the rendered window
=================
*)
procedure SCR_CalcVrect;
var
  size: integer;
begin
  // bound viewsize
  if (scr_viewsize.value < 40) then
          Cvar_Set ('viewsize','40');
  if (scr_viewsize.value > 100) then
          Cvar_Set ('viewsize','100');

  size := Round(scr_viewsize.value);

  scr_vrect.width := Round(viddef.width*size/100);
  scr_vrect.width := scr_vrect.width and (not 7);

  scr_vrect.height := Round(viddef.height*size/100);
  scr_vrect.height := scr_vrect.height and (not 1);

  scr_vrect.x := Round((viddef.width - scr_vrect.width)/2);
  scr_vrect.y := Round((viddef.height - scr_vrect.height)/2);
end;


(*
=================
SCR_SizeUp_f

Keybinding command
=================
*)
procedure SCR_SizeUp_f; cdecl;
begin
  Cvar_SetValue ('viewsize',scr_viewsize.value+10);
end;


(*
=================
SCR_SizeDown_f

Keybinding command
=================
*)
procedure SCR_SizeDown_f; cdecl;
begin
  Cvar_SetValue ('viewsize',scr_viewsize.value-10);
end;

(*
=================
SCR_Sky_f

Set a specific sky and rotation speed
=================
*)
procedure SCR_Sky_f; cdecl;
var
  rotate: single;
  axis: vec3_t;
begin
  if (Cmd_Argc() < 2) then begin
    Com_Printf ('Usage: sky <basename> <rotate> <axis x y z>'#10, []);
    exit;
  end;
  if (Cmd_Argc() > 2) then
    rotate := StrToFloat(Cmd_Argv(2))
  else
   rotate := 0;
  if (Cmd_Argc() = 6) then begin
   axis[0] := StrToFloat(Cmd_Argv(3));
   axis[1] := StrToFloat(Cmd_Argv(4));
   axis[2] := StrToFloat(Cmd_Argv(5));
  end
  else
  begin
    axis[0] := 0;
    axis[1] := 0;
    axis[2] := 1;
  end;

  re.SetSky (Cmd_Argv(1), rotate, axis);
end;

//============================================================================

(*
==================
SCR_Init
==================
*)
procedure SCR_Init;
begin