r_image.pas

delphi编的不错的贪吃蛇

        Inc(column);
      end;
    end;
  end
  else
    if (targa_header.image_type = 10) then
    begin // Runlength encoded RGB images
      row := rows - 1;
      while (row >= 0) do
      begin
        pixbuf := Pointer(Integer(targa_rgba) + row * columns * 4);
        column := 0;
        while (column <= columns - 1) do
        begin
          packetHeader := buf_p^;
          inc(Cardinal(buf_p));
          packetSize := 1 + (packetHeader and $7F);
          if (packetHeader and $80) = $80 then
          begin // run-length packet
            case (targa_header.pixel_size) of
              24:
                begin
                  blue := buf_p^;
                  inc(Cardinal(buf_p));
                  green := buf_p^;
                  inc(Cardinal(buf_p));
                  red := buf_p^;
                  inc(Cardinal(buf_p));
                  alphabyte := 255;
                end;
              32:
                begin
                  blue := buf_p^;
                  inc(Cardinal(buf_p));
                  green := buf_p^;
                  inc(Cardinal(buf_p));
                  red := buf_p^;
                  inc(Cardinal(buf_p));
                  alphabyte := buf_p^;
                  inc(Cardinal(buf_p));
                end;
            else // hhmmm, actually this should produce an error, but set rgb to default black
              begin
                red := 0;
                green := 0;
                blue := 0;
                alphabyte := 0;
              end;
            end;
            for j := 0 to packetSize - 1 do
            begin
              pixbuf^ := red;
              inc(Cardinal(pixbuf));
              pixbuf^ := green;
              inc(Cardinal(pixbuf));
              pixbuf^ := blue;
              inc(Cardinal(pixbuf));
              pixbuf^ := alphabyte;
              inc(Cardinal(pixbuf));
              Inc(column);
              if (column = columns) then
              begin // run spans across rows
                column := 0;
                if (row > 0) then
                  inc(row)
                else
                  goto breakOut;
                pixbuf := Pointer(Integer(targa_rgba) + row * columns * 4);
              end;
            end;
          end
          else
          begin // non run-length packet
            for j := 0 to packetSize - 1 do
            begin
              case (targa_header.pixel_size) of
                24:
                  begin
                    blue := buf_p^;
                    inc(Cardinal(buf_p));
                    green := buf_p^;
                    inc(Cardinal(buf_p));
                    red := buf_p^;
                    inc(Cardinal(buf_p));
                    pixbuf^ := red;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := green;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := blue;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := 255;
                    inc(Cardinal(pixbuf));
                  end;
                32:
                  begin
                    blue := buf_p^;
                    inc(Cardinal(buf_p));
                    green := buf_p^;
                    inc(Cardinal(buf_p));
                    red := buf_p^;
                    inc(Cardinal(buf_p));
                    alphabyte := buf_p^;
                    inc(Cardinal(buf_p));
                    pixbuf^ := red;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := green;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := blue;
                    inc(Cardinal(pixbuf));
                    pixbuf^ := alphabyte;
                    inc(Cardinal(pixbuf));
                  end;
              end;
              inc(column);
              if (column = columns) then
              begin // pixel packet run spans across rows
                column := 0;
                if (row > 0) then
                  dec(row)
                else
                  goto breakOut;
                pixbuf := Pointer(Integer(targa_rgba) + row * columns * 4);
              end;
            end;
          end;
          Inc(column);
        end;
        breakOut:
        Inc(Row);
      end;
    end;
  ri.FS_FreeFile(buffer);
end;

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

function R_FindFreeImage: image_p;
var
  image: image_t;
  i: Integer;
begin
 // find a free image_t
  for i := 0 to numr_images - 1 do
  begin
    image := r_images[i];
    if (image.registration_sequence = 0) then
      break;
  end;
  if (i = numr_images) then
  begin
    if (numr_images = MAX_RIMAGES) then
      ri.Sys_Error(ERR_DROP, 'MAX_RIMAGES');
    inc(numr_images);
  end;
  if numr_images = 0 then
  begin
    i := 0;
    inc(numr_images);
  end;
  Result := @r_images[i];
end;

(*
================
GL_LoadPic

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

function GL_LoadPic(name: PChar; pic: PByte; width, height: Integer; _type: imagetype_t): image_p;
var
  image: image_p;
  i, c, b: Integer;
  pix: PByte;
begin
  image := R_FindFreeImage;
  if (StrLen(name) >= sizeof(image^.name)) then
    ri.Sys_Error(ERR_DROP, 'Draw_LoadPic: "%s" is too long', name);
  StrCopy(PChar(@image^.name), name);
  image^.registration_sequence := registration_sequence;

  image^.width := width;
  image^.height := height;
  image^._type := _type;

  c := width * height;
  image^.pixels[0] := AllocMem(c);
  image^.transparent := false;
  pix := image^.pixels[0];
  for i := 0 to c - 1 do
  begin
    b := pic^;
    if (b = 255) then
      image^.transparent := true;
    pix^ := b;
    Inc(Integer(pic));
    Inc(Integer(pix));
  end;
  result := image;
end;

(*
================
R_LoadWal
================
*)

function R_LoadWal(const name: PChar): image_p;
var
	mt    : miptex_p;
	ofs   : Integer;
	image : image_p;
	size  : Integer;
begin
	ri.FS_LoadFile(name,@mt);
	if (mt = nil) then
	begin
		ri.Con_Printf(PRINT_ALL,'R_LoadWal: can''t load %s', name);
		Result := r_notexture_mip;
    Exit;
  end;
  image := R_FindFreeImage;
  StrCopy(PChar(@image^.name), name);
  image^.width := LittleLong(mt^.width);
  image^.height := LittleLong(mt^.height);
  image^._type := it_wall;
  image^.registration_sequence := registration_sequence;

  size := image^.width * image^.height * (256 + 64 + 16 + 4) div 256;
  image^.pixels[0] := AllocMem(size);
  image^.pixels[1] := PByte(Integer(image^.pixels[0]) + image^.width * image^.height);
  image^.pixels[2] := PByte(Integer(image^.pixels[1]) + image^.width * image^.height div 4);
  image^.pixels[3] := PByte(Integer(image^.pixels[2]) + image^.width * image^.height div 16);

  ofs := LittleLong(mt^.offsets[0]);
  Move(Pointer(Integer(mt) + ofs)^, image^.pixels[0]^, size);

  ri.FS_FreeFile(mt);
  Result := image;
end;

(*
===============
R_FindImage
Finds or loads the given image
===============
*)

function R_FindImage(const name: PChar; _type: imagetype_t): image_p;
var
  image: image_p;
  i, len: Integer;
  pic: PByte;
  palette: PByte;
  width: Integer;
  height: Integer;
begin
  Result := nil;
  if (name = nil) then
  begin
    //ri.Sys_Error(ERR_DROP, PChar('R_FindImage: NULL name'+CrLf));
    Exit; //
  end;
  len := StrLen(name);
  if (len < 5) then
  begin
    //ri.Sys_Error(ERR_DROP, PChar('R_FindImage: bad name: '+name+CrLf));
    Exit; //
  end;
 // look for it
  for i := 0 to numr_images - 1 do
  begin
    image := @r_images[i];
    if (StrComp(name, image^.name) = 0) then
    begin
      image^.registration_sequence := registration_sequence;
      Result := image;
      Exit;
    end;
  end;

 //
 // load the pic from disk
 //
  pic := nil;
  palette := nil;
  if (StrComp(PChar(@name[len - 4]), '.pcx') = 0) then
  begin
    LoadPCX(name, @pic, @palette, @width, @height);
    if (pic = nil) then
    begin
      //ri.Sys_Error(ERR_DROP, PChar('R_FindImage: can''t load '+name+CrLf));
      Exit; //
    end;
    image := GL_LoadPic(name, pic, width, height, _type);
  end
  else
    if (StrComp(PChar(@name[len - 4]), '.wal') = 0) then
      image := R_LoadWal(name)
    else
      if (StrComp(PChar(@name[len - 4]), '.tga') = 0) then
      begin
        //ri.Sys_Error(ERR_DROP, PChar('R_FindImage: can''t load '+name+' in software renderer'+CrLf));
        Exit //
      end
      else
      begin
        //ri.Sys_Error(ERR_DROP, PChar('R_FindImage: bad extension on: '+name+CrLf));
        Exit; //
      end;
  if (pic <> nil) then
    FreeMem(pic);
  if (palette <> nil) then
    FreeMem(palette);
  Result := image;
end;

(*
===============
R_RegisterSkin
===============
*)

function R_RegisterSkin(name: PChar): Pointer; cdecl; //image_p;
begin
  Result := R_FindImage(name, it_skin);
end;

(*
================
R_FreeUnusedImages

Any image that was not touched on this registration sequence
will be freed.
================
*)

procedure R_FreeUnusedImages;
var
  i: Integer;
  image: image_p;
begin
  for i := 0 to numr_images - 1 do
  begin
    image := @r_images[i];
    if (image^.registration_sequence = registration_sequence) then
    begin
      Com_PageInMemory(image^.pixels[0], image^.width * image^.height);
      continue; // used this sequence
    end;
    if (image^.registration_sequence = 0) then
      continue; // free texture
    if (image^._type = it_pic) then
      continue; // don't free pics
  // free it
    FreeMem(image^.pixels[0]); // the other mip levels just follow
    FillChar(image^, sizeof(image_t), 0);
  end;
end;

(*
===============
R_ShutdownImages
===============
*)

procedure R_ShutdownImages;
var
  i: Integer;
  image: image_p;
begin
  for i := 0 to numr_images - 1 do
  begin
    image := @r_images[i];
    if (image^.registration_sequence = 0) then
      continue; // free texture
  // free it
    FreeMem(image^.pixels[0]); // the other mip levels just follow
    FillChar(image^, sizeof(image_t), 0);
  end;
end;

(*
===============
R_InitImages
===============
*)

procedure R_InitImages;
begin
  registration_sequence := 1;
end;

end.