cl_scrn.pas

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                                                      }
{                                                                            }
{----------------------------------------------------------------------------}
// cl_scrn.c -- master for refresh, status bar, console, chat, notify, etc

(*

  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,
  ref,
  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;

function entitycmpfnc(const a, b: entity_p): integer;

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,
  cl_cin,
  cl_inv,
  {$IFDEF WIN32}
  cd_win,
  q_shwin,
  vid_dll,
  {$ELSE}
  cd_sdl,
  q_shlinux,
  vid_so,
  {$ENDIF}
  snd_dma,
  cl_main,
  cl_view,
  menu;

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#29#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#31#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#29#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#30#31#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;
      Inc(j);
    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
  scr_viewsize := Cvar_Get('viewsize', '100', CVAR_ARCHIVE);
  scr_conspeed := Cvar_Get('scr_conspeed', '3', 0);
  scr_showturtle := Cvar_Get('scr_showturtle', '0', 0);
  scr_showpause := Cvar_Get('scr_showpause', '1', 0);
  scr_centertime := Cvar_Get('scr_centertime', '2.5', 0);
  scr_printspeed := Cvar_Get('scr_printspeed', '8', 0);
  scr_netgraph := Cvar_Get('netgraph', '0', 0);
  scr_timegraph := Cvar_Get('timegraph', '0', 0);
  scr_debuggraph_ := Cvar_Get('debuggraph', '0', 0);
  scr_graphheight := Cvar_Get('graphheight', '32', 0);
  scr_graphscale := Cvar_Get('graphscale', '1', 0);
  scr_graphshift := Cvar_Get('graphshift', '0', 0);
  scr_drawall := Cvar_Get('scr_drawall', '0', 0);

  //
  // register our commands
  //