cl_scrn.pas

delphi编的不错的贪吃蛇

  Cmd_AddCommand('timerefresh', SCR_TimeRefresh_f);
  Cmd_AddCommand('loading', SCR_Loading_f);
  Cmd_AddCommand('sizeup', SCR_SizeUp_f);
  Cmd_AddCommand('sizedown', SCR_SizeDown_f);
  Cmd_AddCommand('sky', SCR_Sky_f);

  scr_initialized := true;
end;

(*
==============
SCR_DrawNet
==============
*)

procedure SCR_DrawNet;
begin
  if (cls.netchan.outgoing_sequence - cls.netchan.incoming_acknowledged < CMD_BACKUP - 1) then
    exit;

  re.DrawPic(scr_vrect.x + 64, scr_vrect.y, 'net');
end;

(*
==============
SCR_DrawPause
==============
*)

procedure SCR_DrawPause;
var
  w, h: integer;
begin
  if (scr_showpause.value = 0) then     // turn off for screenshots
    exit;

  if (cl_paused.value = 0) then
    exit;

  re.DrawGetPicSize(@w, @h, 'pause');
  re.DrawPic((viddef.width - w) div 2, viddef.height div 2 + 8, 'pause');
end;

(*
==============
SCR_DrawLoading
==============
*)

procedure SCR_DrawLoading;
var
  w, h: integer;
begin
  if (scr_draw_loading = 0) then
    exit;

  scr_draw_loading := Integer(False);
  re.DrawGetPicSize(@w, @h, 'loading');
  re.DrawPic((viddef.width - w) div 2, (viddef.height - h) div 2, 'loading');
end;

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

(*
==================
SCR_RunConsole

Scroll it up or down
==================
*)

procedure SCR_RunConsole;
begin
  // decide on the height of the console
  if (cls.key_dest = key_console) then
    scr_conlines := 0.5                 // half screen
  else
    scr_conlines := 0;                  // none visible

  if (scr_conlines < scr_con_current) then
  begin
    scr_con_current := scr_con_current - scr_conspeed.value * cls.frametime;
    if (scr_conlines > scr_con_current) then
      scr_con_current := scr_conlines;
  end
  else if (scr_conlines > scr_con_current) then
  begin
    scr_con_current := scr_con_current + scr_conspeed.value * cls.frametime;
    if (scr_conlines < scr_con_current) then
      scr_con_current := scr_conlines;
  end;
end;

(*
==================
SCR_DrawConsole
==================
*)

procedure SCR_DrawConsole;
begin
  Con_CheckResize();

  if (cls.state = ca_disconnected) or (cls.state = ca_connecting) then
  begin
    // forced full screen console
    Con_DrawConsole(1);
    exit;
  end;

  if (cls.state <> ca_active) or (not cl.refresh_prepped) then
  begin
    // connected, but can't render
    Con_DrawConsole(0.5);
    re.DrawFill(0, viddef.height div 2, viddef.width, viddef.height div 2, 0);
    exit;
  end;

  if (scr_con_current <> 0) then
  begin
    Con_DrawConsole(scr_con_current);
  end
  else
  begin
    if (cls.key_dest = key_game) or (cls.key_dest = key_message) then
      Con_DrawNotify();                 // only draw notify in game
  end;
end;

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

(*
================
SCR_BeginLoadingPlaque
================
*)

procedure SCR_BeginLoadingPlaque;
begin
  S_StopAllSounds();
  cl.sound_prepped := false;            // don't play ambients
  CDAudio_Stop();
  if (cls.disable_screen <> 0) then
    exit;
  if (developer.value <> 0) then
    exit;
  if (cls.state = ca_disconnected) then
    exit;                               // if at console, don't bring up the plaque
  if (cls.key_dest = key_console) then
    exit;
  if (cl.cinematictime > 0) then
    scr_draw_loading := 2               // clear to balack first
  else
    scr_draw_loading := 1;
  SCR_UpdateScreen();
  cls.disable_screen := Sys_Milliseconds();
  cls.disable_servercount := cl.servercount;
end;

(*
================
SCR_EndLoadingPlaque
================
*)

procedure SCR_EndLoadingPlaque;
begin
  cls.disable_screen := 0;
  Con_ClearNotify();
end;

(*
================
SCR_Loading_f
================
*)

procedure SCR_Loading_f;
begin
  SCR_BeginLoadingPlaque();
end;

(*
================
SCR_TimeRefresh_f
================
*)

function entitycmpfnc(const a, b: entity_p): integer;
begin
  (*
  ** all other models are sorted by model then skin
  *)
  if (a.model = b.model) then
  begin
    Result := Cardinal(a.skin) - Cardinal(b.skin);
  end
  else
  begin
    Result := Cardinal(a.model) - Cardinal(b.model);
  end;
end;

procedure SCR_TimeRefresh_f;
var
  i: Integer;
  start, stop: integer;
  time: single;
begin
  if (cls.state <> ca_active) then
    exit;

  start := Sys_Milliseconds();

  if (Cmd_Argc() = 2) then
  begin
    // run without page flipping
    re.BeginFrame(0);
    for i := 0 to 128 - 1 do
    begin
      cl.refdef.viewangles[1] := i / 128.0 * 360.0;
      re.RenderFrame(@cl.refdef);
    end;
    re.EndFrame();
  end
  else
  begin
    for i := 0 to 128 - 1 do
    begin
      cl.refdef.viewangles[1] := i / 128.0 * 360.0;

      re.BeginFrame(0);
      re.RenderFrame(@cl.refdef);
      re.EndFrame();
    end;
  end;

  stop := Sys_Milliseconds();
  time := (stop - start) / 1000.0;
  Com_Printf('%f seconds (%f fps)'#10, [time, 128 / time]);
end;

(*
=================
SCR_AddDirtyPoint
=================
*)

procedure SCR_AddDirtyPoint(x, y: integer);
begin
  if (x < scr_dirty.x1) then
    scr_dirty.x1 := x;
  if (x > scr_dirty.x2) then
    scr_dirty.x2 := x;
  if (y < scr_dirty.y1) then
    scr_dirty.y1 := y;
  if (y > scr_dirty.y2) then
    scr_dirty.y2 := y;
end;

procedure SCR_DirtyScreen;
begin
  SCR_AddDirtyPoint(0, 0);
  SCR_AddDirtyPoint(viddef.width - 1, viddef.height - 1);
end;

(*
==============
SCR_TileClear

Clear any parts of the tiled background that were drawn on last frame
==============
*)

procedure SCR_TileClear;
var
  i: integer;
  top, bottom, left, right: integer;
  clear: dirty_t;
begin
  if (scr_drawall.value <> 0) then
    SCR_DirtyScreen();                  // for power vr or broken page flippers...

  if (scr_con_current = 1.0) then
    exit;                               // full screen console
  if (scr_viewsize.value = 100) then
    exit;                               // full screen rendering
  if (cl.cinematictime > 0) then
    exit;                               // full screen cinematic

  // erase rect will be the union of the past three frames
  // so tripple buffering works properly
  clear := scr_dirty;
  for i := 0 to 1 do
  begin
    if (scr_old_dirty[i].x1 < clear.x1) then
      clear.x1 := scr_old_dirty[i].x1;
    if (scr_old_dirty[i].x2 > clear.x2) then
      clear.x2 := scr_old_dirty[i].x2;
    if (scr_old_dirty[i].y1 < clear.y1) then
      clear.y1 := scr_old_dirty[i].y1;
    if (scr_old_dirty[i].y2 > clear.y2) then
      clear.y2 := scr_old_dirty[i].y2;
  end;

  scr_old_dirty[1] := scr_old_dirty[0];
  scr_old_dirty[0] := scr_dirty;

  scr_dirty.x1 := 9999;
  scr_dirty.x2 := -9999;
  scr_dirty.y1 := 9999;
  scr_dirty.y2 := -9999;

  // don't bother with anything convered by the console)
  top := Round(scr_con_current * viddef.height);
  if (top >= clear.y1) then
    clear.y1 := top;

  if (clear.y2 <= clear.y1) then
    exit;                               // nothing disturbed

  top := scr_vrect.y;
  bottom := top + scr_vrect.height - 1;
  left := scr_vrect.x;
  right := left + scr_vrect.width - 1;

  if (clear.y1 < top) then
  begin
    // clear above view screen
    if (clear.y2 < top - 1) then
      i := clear.y2
    else
      i := top - 1;
    re.DrawTileClear(clear.x1, clear.y1,
      clear.x2 - clear.x1 + 1, i - clear.y1 + 1, 'backtile');
    clear.y1 := top;
  end;
  if (clear.y2 > bottom) then
  begin
    // clear below view screen
    if (clear.y1 > bottom + 1) then
      i := clear.y1
    else
      i := bottom + 1;
    re.DrawTileClear(clear.x1, i,
      clear.x2 - clear.x1 + 1, clear.y2 - i + 1, 'backtile');
    clear.y2 := bottom;
  end;
  if (clear.x1 < left) then
  begin
    // clear left of view screen
    if (clear.x2 < left - 1) then
      i := clear.x2
    else
      i := left - 1;
    re.DrawTileClear(clear.x1, clear.y1,
      i - clear.x1 + 1, clear.y2 - clear.y1 + 1, 'backtile');
    clear.x1 := left;
  end;
  if (clear.x2 > right) then
  begin
    // clear left of view screen
    if (clear.x1 > right + 1) then
      i := clear.x1
    else
      i := right + 1;
    re.DrawTileClear(i, clear.y1,
      clear.x2 - i + 1, clear.y2 - clear.y1 + 1, 'backtile');
    clear.x2 := right;
  end;
end;

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

const
  STAT_MINUS = 10;                      // num frame for '-' stats digit

var
  sb_nums: array[0..1, 0..10] of pchar =
  (
    ('num_0', 'num_1', 'num_2', 'num_3', 'num_4', 'num_5',
    'num_6', 'num_7', 'num_8', 'num_9', 'num_minus'),
    ('anum_0', 'anum_1', 'anum_2', 'anum_3', 'anum_4', 'anum_5',
    'anum_6', 'anum_7', 'anum_8', 'anum_9', 'anum_minus')
    );

const
  ICON_WIDTH = 24;
  ICON_HEIGHT = 24;
  CHAR_WIDTH = 16;
  ICON_SPACE = 8;

  (*
  ================
  SizeHUDString

  Allow embedded \n(#10) in the string
  ================
  *)

procedure SizeHUDString(string_: pchar; w, h: pinteger);
var
  lines, width, current: integer;
begin
  lines := 1;
  width := 0;

  current := 0;
  while (string_^ <> #0) do
  begin
    if (string_^ = #10) then
    begin
      Inc(Lines);
      current := 0;
    end
    else
    begin
      Inc(current);
      if (current > width) then
        width := current;
    end;
    Inc(string_);
  end;

  w^ := width * 8;
  h^ := lines * 8;
end;

procedure DrawHUDString(string_: pchar; x, y, centerwidth, xor_: integer);
var
  margin: integer;
  line: array[0..1024 - 1] of char;
  width: integer;
  i: integer;
begin
  margin := x;

  while (string_^ <> #0) do
  begin
    // scan out one line of text from the string
    width := 0;
    while (string_^ <> #0) and (string_^ <> #10) do
    begin
      line[width] := string_^;
      Inc(string_);
      Inc(width);
    end;
    line[width] := #0;

    if (centerwidth <> 0) then
      x := margin + (centerwidth - width * 8) div 2
    else
      x := margin;
    for i := 0 to width - 1 do
    begin
      re.DrawChar(x, y, byte(line[i]) xor xor_);
      x := x + 8;
    end;
    if (string_^ <> #0) then
    begin
      Inc(string_);                     // skip the \n
      x := margin;
      y := y + 8;
    end;
  end;
end;

(*
==============
SCR_DrawField
==============
*)

procedure SCR_DrawField(x, y, color, width, value: integer);
var
  num: array[0..16 - 1] of char;
  ptr: pchar;
  l: integer;
  frame: integer;
begin
  if (width < 1) then
    exit;

  // draw number string
  if (width > 5) then
    width := 5;

  SCR_AddDirtyPoint(x, y);
  SCR_AddDirtyPoint(x + width * CHAR_WIDTH + 2, y + 23);

  Com_sprintf(num, sizeof(num), '%d', [value]);
  l := strlen(num);
  if (l > width) then
    l := width;
  x := x + 2 + CHAR_WIDTH * (width - l);

  ptr := num;
  while (ptr^ <> #0) and (l <> 0) do
  begin
    if (ptr^ = '-') then
      frame := STAT_MINUS
    else
      frame := Byte(ptr^) - Byte('0');

    re.DrawPic(x, y, sb_nums[color][frame]);
    x := x + CHAR_WIDTH;
    Inc(Ptr);
    Dec(l);
  end;
end;