r_main.pas

delphi编的不错的贪吃蛇

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

(*
=============
R_CalcPalette

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

procedure R_CalcPalette;
var
  palette: array[0..256, 0..4] of Byte;
  _in, _out: PByte;
  i, j, v: Integer;
  alpha: Single;
  one_minus_alpha: Single;
  premult: vec3_t;
begin
  alpha := r_newrefdef.blend[3];
  if (alpha <= 0.0) then
  begin
    if (modified) then
    begin // set back to default
      modified := false;
      R_GammaCorrectAndSetPalette(PByte(@d_8to24table));
      Exit;
    end;
    Exit;
  end;

  modified := true;
  if (alpha > 1) then
    alpha := 1;

  premult[0] := r_newrefdef.blend[0] * alpha * 255;
  premult[1] := r_newrefdef.blend[1] * alpha * 255;
  premult[2] := r_newrefdef.blend[2] * alpha * 255;

  one_minus_alpha := (1.0 - alpha);

  _in := PByte(@d_8to24table);
  _out := PByte(@palette[0, 0]);
  for I := 0 to 255 do
  begin
    for j := 0 to 2 do
    begin
      v := Trunc(premult[j] + one_minus_alpha * PByte(Integer(_in) + j)^);
      if (v > 255) then
        v := 255;
      PByte(Integer(_out) + j)^ := v;
    end;
    PByte(Integer(_out) + 3)^ := 255;
    _in := PByte(Integer(_in) + 4);
    _out := PByte(Integer(_out) + 4);
  end;

  R_GammaCorrectAndSetPalette(PByte(@palette[0, 0]));
//  SWimp_SetPalette( palette[0] );
end;

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

procedure R_SetLightLevel;
var
  light: vec3_t;
begin
  if (((r_newrefdef.rdflags and RDF_NOWORLDMODEL) <> 0) or (r_drawentities^.value = 0.0) or (currententity = nil)) then
  begin
    r_lightlevel^.value := 150.0;
    Exit;
  end;

 // save off light value for server to look at (BIG HACK!)
  R_LightPoint(vec3_p(@r_newrefdef.vieworg)^, light);
  r_lightlevel^.value := 150.0 * light[0];
end;

(*
@@@@@@@@@@@@@@@@
R_RenderFrame

@@@@@@@@@@@@@@@@
*)

procedure R_RenderFrame(fd: refdef_p); cdecl;
begin
  Move(fd^, r_newrefdef, SizeOf(refdef_t));

  if ((r_worldmodel = nil) and ((r_newrefdef.rdflags and RDF_NOWORLDMODEL) = 0)) then
    ri.Sys_Error(ERR_FATAL, 'R_RenderView: NULL worldmodel');

  VectorCopy(vec3_p(@fd^.vieworg)^, r_refdef.vieworg);
  VectorCopy(vec3_p(@fd^.viewangles)^, r_refdef.viewangles);

  if ((r_speeds^.value <> 0.0) or (r_dspeeds^.value <> 0.0)) then
    r_time1 := Sys_Milliseconds;

  R_SetupFrame;
  R_MarkLeaves; // done here so we know if we're in water
  R_PushDlights(r_worldmodel);
  R_EdgeDrawing;

  if (r_dspeeds^.value <> 0.0) then
  begin
    se_time2 := Sys_Milliseconds;
    de_time1 := se_time2;
  end;

  // draws models (monster, weapons, items etc.).
  R_DrawEntitiesOnList;

  if (r_dspeeds^.value <> 0.0) then
  begin
    de_time2 := Sys_Milliseconds;
    dp_time1 := Sys_Milliseconds;
  end;

  R_DrawParticles;

  if (r_dspeeds^.value <> 0.0) then
    dp_time2 := Sys_Milliseconds;

  R_DrawAlphaSurfaces;

  R_SetLightLevel;

  if (r_dowarp) then
    D_WarpScreen;

  if (r_dspeeds^.value <> 0.0) then
    da_time1 := Sys_Milliseconds;

  if (r_dspeeds^.value <> 0.0) then
    da_time2 := Sys_Milliseconds;

  R_CalcPalette;

  if (sw_aliasstats^.value <> 0.0) then
    R_PrintAliasStats;

  if (r_speeds^.value <> 0.0) then
    R_PrintTimes;

  if (r_dspeeds^.value <> 0.0) then
    R_PrintDSpeeds;

  if ((sw_reportsurfout^.value <> 0.0) and (r_outofsurfaces <> 0)) then
    ri.Con_Printf(PRINT_ALL,'Short %d surfaces', r_outofsurfaces);

  if ((sw_reportedgeout^.value <> 0.0) and (r_outofedges <> 0)) then
    ri.Con_Printf(PRINT_ALL,'Short roughly %d edges', (r_outofedges * 2 div 3));
end;

(*
** R_InitGraphics
*)

procedure R_InitGraphics(width: Integer; height: Integer);
begin
  vid.width := width;
  vid.height := height;

 // free z buffer
  if (d_pzbuffer <> nil) then
  begin
    FreeMem(d_pzbuffer);
    d_pzbuffer := nil;
  end;

 // free surface cache
  if (sc_base <> nil) then
  begin
    D_FlushCaches;
    FreeMem(sc_base);
    sc_base := nil;
  end;
  d_pzbuffer := AllocMem(vid.width * vid.height * 2);
  R_InitCaches;
  R_GammaCorrectAndSetPalette(PByte(@d_8to24table));
end;

(*
** R_BeginFrame
*)

procedure R_BeginFrame(camera_separation: Single); cdecl;
var
  err: rserr_t;
begin
 (*
 ** rebuild the gamma correction palette if necessary
 *)
  if (vid_gamma^.modified) then
  begin
    Draw_BuildGammaTable;
    R_GammaCorrectAndSetPalette(PByte(@d_8to24table));
    vid_gamma^.modified := false;
  end;

  while ((sw_mode^.modified) or (vid_fullscreen^.modified)) do
  begin
  (*
  ** if this returns rserr_invalid_fullscreen then it set the mode but not as a
  ** fullscreen mode, e.g. 320x200 on a system that doesn't support that res
  *)
    err := SWimp_SetMode(@vid.width, @vid.height, Trunc(sw_mode^.value), (vid_fullscreen^.value <> 0.0));
    if (err = rserr_ok) then
    begin
      R_InitGraphics(vid.width, vid.height);

      sw_state.prev_mode := Trunc(sw_mode^.value);
      vid_fullscreen^.modified := false;
      sw_mode^.modified := false;
    end
    else
    begin
      if (err = rserr_invalid_mode) then
      begin
        ri.Cvar_SetValue('sw_mode', sw_state.prev_mode);
        ri.Con_Printf(PRINT_ALL, 'ref_soft::R_BeginFrame() - could not set mode' + #13#10);
      end
      else
        if (err = rserr_invalid_fullscreen) then
        begin
          R_InitGraphics(vid.width, vid.height);

          ri.Cvar_SetValue('vid_fullscreen', 0);
          ri.Con_Printf(PRINT_ALL, 'ref_soft::R_BeginFrame() - fullscreen unavailable in this mode' + #13#10);
          sw_state.prev_mode := Trunc(sw_mode^.value);
//        vid_fullscreen->modified = false;
//        sw_mode->modified = false;
        end
        else
        begin
          ri.Sys_Error(ERR_FATAL, 'ref_soft::R_BeginFrame() - catastrophic mode change failure' + #13#10);
        end;
    end;
  end;
end;

(*
================
Draw_BuildGammaTable
================
*)

procedure Draw_BuildGammaTable;
var
  i: Integer;
  inf: Integer;
  g: Single;
begin
  g := vid_gamma^.value;

  if (g = 1.0) then
  begin
    for I := 0 to 255 do
      sw_state.gammatable[i] := i;
    Exit;
  end;

  for I := 0 to 255 do
  begin
    inf := Trunc(255 * Power((i + 0.5) / 255.5, g) + 0.5);
    if (inf < 0) then
      inf := 0;
    if (inf > 255) then
      inf := 255;
    sw_state.gammatable[i] := inf;
  end;
end;

(*
** R_GammaCorrectAndSetPalette
*)

procedure R_GammaCorrectAndSetPalette(const palette: PByte);
var
  i: Integer;
begin
  for I := 0 to 255 do
  begin
    sw_state.currentpalette[i * 4 + 0] := sw_state.gammatable[PByte(Integer(palette) + (i * 4 + 0))^];
    sw_state.currentpalette[i * 4 + 1] := sw_state.gammatable[PByte(Integer(palette) + (i * 4 + 1))^];
    sw_state.currentpalette[i * 4 + 2] := sw_state.gammatable[PByte(Integer(palette) + (i * 4 + 2))^];
  end;
  SWimp_SetPalette(PByteArray(@sw_state.currentpalette[0]));
end;

(*
** R_CinematicSetPalette
*)

procedure R_CinematicSetPalette(palette: PByte); cdecl;
var
  palette32: array[0..1024 - 1] of Byte;
  i, j, w: Integer;
  d: PIntegerArray;
begin
 // clear screen to black to avoid any palette flash
  w := abs(vid.rowbytes) shr 2; // stupid negative pitch win32 stuff...
  for I := 0 to vid.height - 1 do
  begin
    d := PIntegerArray(Integer(vid.buffer) + i * vid.rowbytes);
    for j := 0 to w - 1 do
      d[j] := 0;
  end;
 // flush it to the screen
  SWimp_EndFrame;

  if (palette <> nil) then
  begin
    for I := 0 to 255 do
    begin
      palette32[i * 4 + 0] := PByteArray(palette)^[i * 3 + 0];
      palette32[i * 4 + 1] := PByteArray(palette)^[i * 3 + 1];
      palette32[i * 4 + 2] := PByteArray(palette)^[i * 3 + 2];
      palette32[i * 4 + 3] := $FF;
    end;
    R_GammaCorrectAndSetPalette(PByte(@palette32));
  end
  else
  begin
    R_GammaCorrectAndSetPalette(PByte(@d_8to24table));
  end;
end;

(*
** R_DrawBeam
*)

procedure R_DrawBeam(e: entity_p);
var
  i: Integer;
  perpvec: vec3_t;
  direction: vec3_t;
  normalized_direction: vec3_t;
  start_points: array[0..NUM_BEAM_SEGS - 1] of vec3_t;
  end_points: array[0..NUM_BEAM_SEGS - 1] of vec3_t;
  oldorigin: vec3_t;
  origin: vec3_t;
begin
  oldorigin[0] := e^.oldorigin[0];
  oldorigin[1] := e^.oldorigin[1];
  oldorigin[2] := e^.oldorigin[2];

  origin[0] := e^.origin[0];
  origin[1] := e^.origin[1];
  origin[2] := e^.origin[2];

  direction[0] := oldorigin[0] - origin[0];
  normalized_direction[0] := direction[0];
  direction[1] := oldorigin[1] - origin[1];
  normalized_direction[1] := direction[1];
  direction[2] := oldorigin[2] - origin[2];
  normalized_direction[2] := direction[2];

  if (VectorNormalize(normalized_direction) = 0.0) then
    Exit;

  PerpendicularVector(perpvec, normalized_direction);
  VectorScale(perpvec, e^.frame / 2, perpvec);

  for I := 0 to NUM_BEAM_SEGS - 1 do
  begin
    RotatePointAroundVector(start_points[i], normalized_direction, perpvec, (360.0 / NUM_BEAM_SEGS) * i);
    VectorAdd(start_points[i], origin, start_points[i]);
    VectorAdd(start_points[i], direction, end_points[i]);
  end;

  for I := 0 to NUM_BEAM_SEGS - 1 do
  begin
    R_IMFlatShadedQuad(start_points[i],
      end_points[i],
      end_points[(i + 1) mod NUM_BEAM_SEGS],
      start_points[(i + 1) mod NUM_BEAM_SEGS],
      e^.skinnum and $FF,
      e^.alpha);
  end;
end;

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

(*
============
R_SetSky
============
*)

procedure R_SetSky(name: PChar; rotate: Single; axis: vec3_p); cdecl;
var
  i: Integer;
  pathname: array[0..MAX_QPATH - 1] of Char;
begin
  StrLCopy(skyname, name, sizeof(skyname) - 1);
  skyrotate := rotate;
  VectorCopy(axis^, skyaxis);

  for I := 0 to 5 do
  begin
    Com_sprintf(pathname, sizeof(pathname), 'env/%s%s.pcx', [skyname, suf[r_skysideimage[i]]]);
    r_skytexinfo[i].image := R_FindImage(pathname, it_sky);
  end;
end;

(*
===============
Draw_GetPalette
===============
*)

procedure Draw_GetPalette;
var
  pal, _out: PByteArray;
  i: Integer;
  r, g, b: Integer;
begin
 // get the palette and colormap
  LoadPCX('pics/colormap.pcx', @vid.colormap, @pal, nil, nil);
  if (vid.colormap = nil) then
    ri.Sys_Error(ERR_FATAL, 'Couldn''t load pics/colormap.pcx');
  vid.alphamap := PByte(Integer(vid.colormap) + 64 * 256);

  _out := PByteArray(@d_8to24table);
  for I := 0 to 255 do
  begin
    r := pal^[i * 3 + 0];
    g := pal^[i * 3 + 1];
    b := pal^[i * 3 + 2];
    _out^[0] := r;
    _out^[1] := g;
    _out^[2] := b;
    _out := PByteArray(Integer(_out) + 4);
  end;
  FreeMem(pal);
end;

(*
@@@@@@@@@@@@@@@@@@@@@
GetRefAPI

@@@@@@@@@@@@@@@@@@@@@
*)
var
  re: refexport_t;

function GetRefAPI(rimp: refimport_t): refexport_t; cdecl;
begin
  try
    ri := rimp;
    re.api_version := API_VERSION;
    re.BeginRegistration := R_BeginRegistration;
    re.RegisterModel := R_RegisterModel;
    re.RegisterSkin := R_RegisterSkin;
    re.RegisterPic := Draw_FindPic;
    re.SetSky := R_SetSky;
    re.EndRegistration := R_EndRegistration;
    re.RenderFrame := R_RenderFrame;
    re.DrawGetPicSize := Draw_GetPicSize;
    re.DrawPic := Draw_Pic;
    re.DrawStretchPic := Draw_StretchPic;
    re.DrawChar := Draw_Char;
    re.DrawTileClear := Draw_TileClear;
    re.DrawFill := Draw_Fill;
    re.DrawFadeScreen := Draw_FadeScreen;
    re.DrawStretchRaw := Draw_StretchRaw;
    re.Init := R_Init;
    re.Shutdown := R_Shutdown;
    re.CinematicSetPalette := R_CinematicSetPalette;
    re.BeginFrame := R_BeginFrame;
    re.EndFrame := SWimp_EndFrame;
    re.AppActivate := SWimp_AppActivate;
    Swap_Init;
  except
    ri.Sys_Error(ERR_FATAL, 'Unhandled exception in GetRefAPI.')
  end;
  // DEBUGGERS NOTE:
  // The result MUST be the last assignment otherwise Delphi generate faulty code
  // and the result becomes NIL. This is due to the except statement which clears
  // the eax register and it does not restore it to its original value :-(
  Result := re;
end;

// this is only here so the functions in q_shared.c and q_shwin.c can link
(*
procedure Sys_Error (char *error, ...)
begin
 va_list    argptr;
 char    text[1024];

 va_start (argptr, error);
 vsprintf (text, error, argptr);
 va_end (argptr);

 ri.Sys_Error (ERR_FATAL, "%s", text);
end;
*)

procedure Com_Printf(fmt: PChar; args: array of const);
var
  text: array[0..1024 - 1] of char;
begin
  DelphiStrFmt(text, fmt, args);
  ri.Con_Printf(PRINT_ALL, text);
end;

procedure Com_Printf(fmt: PChar); overload;
begin
  Com_Printf(fmt, []);
end;

end.