r_draw.pas

delphi编的不错的贪吃蛇

    ri.Sys_Error(ERR_FATAL, 'Draw_Pic: bad coordinates');

  height := h;
  if (y < 0) then
  begin
    skip := -y;
    height := height + y;
    y := 0;
  end
  else
    skip := 0;

  dest := Ptr(LongInt(vid.buffer) + y * vid.rowbytes + x);
  for v := 0 to height - 1 do
  begin
    sv := ((skip + v) * pic^.height) div h;
    source := PByte(Integer(pic^.pixels[0]) + sv * pic^.width);
    if w = pic^.width then
      move(source^, Dest^, w)
    else
    begin
      f := 0;
      fstep := (pic^.width * $10000) div w;
      u := 0;
      while (u < w) do
      begin
        PByteArray(dest)^[u] := PByteArray(source)^[f shr 16];
        f := f + fstep;
        PByteArray(dest)^[u + 1] := PByteArray(source)^[f shr 16];
        f := f + fstep;
        PByteArray(dest)^[u + 2] := PByteArray(source)^[f shr 16];
        f := f + fstep;
        PByteArray(dest)^[u + 3] := PByteArray(source)^[f shr 16];
        f := f + fstep;
        Inc(u, 4);
      end;
    end;
    Inc(Integer(dest), vid.rowbytes);
  end;
end;

{
=============
Draw_StretchPic
=============
}

procedure Draw_StretchPic(x, y, w, h: integer; name: Pchar); cdecl;
var
  pic: image_p;
begin
  pic := Draw_FindPic(name);
  if pic = nil then
  begin
    ri.Con_Printf (PRINT_ALL, 'Can''t find pic: %s', name);
    exit;
  end;
  Draw_StretchPicImplementation(x, y, w, h, pic);
end;

{
=============
Draw_StretchRaw
=============
}

procedure Draw_StretchRaw(x, y, w, h, cols, rows: integer; data: Pbyte);
var
  pic: image_t;
begin
  pic.pixels[0] := data;
  pic.width := cols;
  pic.height := rows;
  Draw_StretchPicImplementation(x, y, w, h, @pic);
end;

{
=============
Draw_Pic
=============
}

procedure Draw_Pic(x, y: integer; name: Pchar); cdecl;
var
  pic: image_p;
  dest, source: cPtrByte;
  v, u,
    tbyte,
    height: integer;

begin
  pic := Draw_FindPic(name);
  if (pic = nil) then
  begin
    ri.Con_Printf(PRINT_ALL, 'Can''t find pic: %s', name);
    exit;
  end;

  if (x < 0) or (x + pic^.width > vid.width) or (y + pic^.height > vid.height) then
  begin
    ri.Sys_Error(ERR_FATAL, 'Draw_Pic: bad coordinates');
    exit; // ri.Sys_Error (ERR_FATAL,"Draw_Pic: bad coordinates");
  end;
  height := pic^.height;
  source := cPtrByte(Integer(pic^.pixels[0]));
  if (y < 0) then
  begin
    height := height + y;
    source := cPtrByte(Integer(source) + pic^.width * -y);
    y := 0;
  end;

  dest := cPtrByte(Integer(vid.buffer) + y * vid.rowbytes + x);
  if not pic^.transparent then
  begin
    for v := 0 to height - 1 do
    begin
      Move(source^, dest^, pic^.width);
      dest := cPtrByte(Integer(dest) + vid.rowbytes);
      source := cPtrByte(Integer(source) + pic^.width);
    end;
  end
  else
  begin
    if (pic^.width and 7) <> 0 then
    begin // general
      for v := 0 to height - 1 do
      begin
        for u := 0 to pic^.width - 1 do
        begin
          tbyte := source^[u];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u] := tbyte;
        end;
        dest := cPtrByte(Integer(dest) + vid.rowbytes);
        source := cPtrByte(Integer(source) + pic^.width);
      end;
    end
    else
    begin // unwound
      for v := 0 to height - 1 do
      begin
        u := 0;
        while (u < pic^.width) do
        begin
          tbyte := source^[u];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u] := tbyte;
          tbyte := source^[u + 1];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 1] := tbyte;
          tbyte := source^[u + 2];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 2] := tbyte;
          tbyte := source^[u + 3];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 3] := tbyte;
          tbyte := source^[u + 4];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 4] := tbyte;
          tbyte := source^[u + 5];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 5] := tbyte;
          tbyte := source^[u + 6];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 6] := tbyte;
          tbyte := source^[u + 7];
          if tbyte <> TRANSPARENT_COLOR then
            dest^[u + 7] := tbyte;
          Inc(u, 8);
        end;
        dest := cPtrByte(Integer(dest) + vid.rowbytes);
        source := cPtrByte(Integer(source) + pic^.width);
      end;
    end;
  end;
end;

{
=============
Draw_TileClear

This repeats a 64*64 tile graphic to fill the screen around a sized down
refresh window.
=============
}

procedure Draw_TileClear(x, y, w, h: integer; name: Pchar); cdecl;
var
  i, j: integer;
  psrc, pdest: cPtrByte;
  pic: image_p;
  x2: integer;

begin
  if x < 0 then
  begin
    w := w + x;
    x := 0;
  end;
  if y < 0 then
  begin
    h := h + y;
    y := 0;
  end;
  if x + w > vid.width then
    w := vid.width - x;
  if y + h > vid.height then
    h := vid.height - y;
  if not (w <= 0) or (h <= 0) then
  begin
    pic := Draw_FindPic(name);
    if pic <> nil then
    begin
      x2 := x + w;
      pdest := cPtrByte(Integer(vid.buffer) + y * vid.rowbytes);
      for i := 0 to h - 1 do
      begin
        psrc := cPtrByte(Integer(pic^.pixels[0]) + pic^.width * ((i + y) and 63));
        for j := x to x2 - 1 do
          pdest^[j] := psrc^[j and 63];
        pdest := cPtrByte(Integer(pdest) + vid.rowbytes);
      end;
    end
    else
      ri.Con_Printf (PRINT_ALL, 'Can''t find pic: %s', name);
  end;
end;

{
=============
Draw_Fill

Fills a box of pixels with a single color
=============
}

procedure Draw_Fill(x, y, w, h, c: integer); cdecl;
var
  dest: cPtrByte;
  u, v: integer;
begin
  if (x + w > vid.width) then
    w := vid.width - x;
  if (y + h > vid.height) then
    h := vid.height - y;
  if x < 0 then
  begin
    w := w + x;
    x := 0;
  end;
  if (y < 0) then
  begin
    h := h + y;
    y := 0;
  end;
  if not ((w < 0) or (h < 0)) then
  begin
    dest := cPtrByte(Integer(vid.buffer) + y * vid.rowbytes + x);
    for v := 0 to h - 1 do
    begin
      for u := 0 to w - 1 do
        dest^[u] := c;
      dest := cPtrByte(Integer(dest) + vid.rowbytes);
    end;
  end;
end;
//=============================================================================

{
================
Draw_FadeScreen

================
}

procedure Draw_FadeScreen();
var
  x, y, t: integer;
  pbuf: cPtrByte;
begin
  for y := 0 to vid.height - 1 do
  begin
    pbuf := cPtrByte(Integer(vid.buffer) + vid.rowbytes * y);
    t := (y and 1) shl 1;
    for x := 0 to vid.width - 1 do
    begin
      if ((x and 3) <> t) then
        pbuf^[x] := 0;
    end;
  end;
end;

end.