jackcartersmith/rerogue
2
0
Fork 0
mirror of https://github.com/dpethes/rerogue.git synced 2025-06-07 18:58:32 +02:00
Code Issues Releases Wiki Activity

new terrain viewer; currently displays points only. Updated HMP spec

Browse Source
This commit is contained in:
dpethes 2015-07-06 11:45:46 +02:00
parent a856753543
commit 93536c4b64
7 changed files with 996 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
.hgignore
View File

@ -9,4 +9,10 @@ syntax: glob
*.res
*.bat
*.hob
*.hmt
*.hmt
*.HOB
*.HMT
*.text
*.tex
*.pgm
*.png

14
README.md
View File

@ -2,20 +2,25 @@ rerogue
=======
Tools to extract data from Star Wars: Rogue Squadron 3D.
Unpackers:
* DAT repacker - unpacks DAT archive or packs files from folder structure to DAT archive.
Parsers, exporters:
* Hmp2obj - creates wavefront OBJ files from .hmp and corresponding .tex + .text files.
* Image exporter - exports some images to pnm/pgm/tga files (according to their internal format).
* HOB parser - parses mesh data files.
* HMT parser - parses material data files and exports stored textures.
* HMT compiler - builds custom material data files.
* HOB display - utilizes HOB & HMT parsers to view 3d objects used in game. Uses OpenGL and SDL for display & input handling.
Viewers:
* HOB viewer - utilizes HOB & HMT parsers to view 3d objects used in game. Uses OpenGL and SDL for display & input handling.
* Terrain viewer - displays any .hmp heightmap level as points. Uses OpenGL and SDL for display & input handling.
Compilation
-----------
Use recent Lazarus (1.2.x) with Freepascal (2.6.x) to compile.
HOB display needs SDL 1.2 and OpenGL 1.x support to work.
Viewers need SDL 1.2 and OpenGL 1.x support to work. I tested 32bit versions only, 64bit will most probably work as well.
TODO
-----------
@ -23,6 +28,5 @@ TODO
* hmt parser: decode all image subtypes
* hmt compiler: needs some usable interface
* hob parser: parse more header fields
* mesh viewer: reuse hmt & hob parsers to display data
* bundle repack: extract & compile bundle.00x archives
* terrain viewer
* terrain viewer: use tiling and texturing

38
doc/file_hmp_spec.txt
View File

@ -1,25 +1,21 @@
15B zeros
1B ? allways 0x3f (63)
4B ?
4B ? allways 0x0000003f (63)
2B tile count
2b ?
4B offset to tiles
4B offset to some data?
2B width in BLK
2B height in BLK
BLK
{
width * height * 2B tile indices
}
12B: zeros
4B float: always 0x3f000000 (0.5)
4B float: terrain height scale
4B float: always 0x3f000000
2B int : tile count
2B int : ?
4B int : offset to tiles
4B int : offset to some data?
2B int : width in BLK
2B int : height in BLK
array[width * height] of 2B int: tile indices
xB ?
tiles
tiles
{
2b texmap idx (from texture index file)
1b ?
1b lo - minimum height in tile (probably for terrain LOD?)
1b hi - maximum height in tile
25B - 5x5 heights
2B int: texmap idx (from texture index file)
1B int: ?
1B uint: lo - minimum height in tile (probably for terrain LOD?)
1B uint: hi - maximum height in tile
array[25] of uint8: - 5x5 heights
}
2B 0x0000

433
terrain_viewer/rs_world.pas Normal file
View File

@ -0,0 +1,433 @@
unit rs_world;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils;
const
TEX_WIDTH = 64;
TEX_HEIGHT = 64;
TEXTURE_FNAME = 'level_tex.pnm';
type
TRGB = array[0..2] of byte;
PRGB = ^TRGB;
TPalette_4bit = array[0..15] of TRGB;
TTile = packed record
texture_index: word;
unknown_attrib: byte;
unknown_lo: byte;
unknown_hi: byte;
unknown: array[0..24] of byte;
end;
PTile = ^TTile;
THeightmap = record
y_scale: single;
width, height: word;
blk: pword;
tile_count: integer;
tiles: PTile;
texture_count: integer;
textures: array of pbyte;
texture_index_map: array of integer;
end;
TVertex3f = record
x, y, z: single;
u, v: single
end;
PVertex3f = ^TVertex3f;
{ TWorld }
TWorld = class
private
world_texture: pbyte;
height_texture: pbyte;
procedure LoadTextures(const tex_fname, texidx_fname: string);
procedure LoadHeightmap(fname: string);
procedure GenerateCompositeTexture;
procedure HeightmapToTexture;
procedure GenerateVertices;
procedure WriteToObj(const objFname: string);
public
heightmap: THeightmap;
vertex_array: PVertex3f;
vertex_count: integer;
property TileWidth: word read heightmap.width;
property TileHeight: word read heightmap.height;
procedure LoadFromFiles(const hmp, tex, texmap: string);
procedure ExportToObj(const objfname: string);
constructor Create;
destructor Destroy; override;
end;
//**************************************************************************************************
implementation
procedure pnm_save(const fname: string; const p: pbyte; const w, h: integer);
var
f: file;
c: PChar;
Begin
c := PChar(format('P6'#10'%d %d'#10'255'#10, [w, h]));
AssignFile (f, fname);
Rewrite (f, 1);
BlockWrite (f, c^, strlen(c));
BlockWrite (f, p^, w * h * 3);
CloseFile (f);
end;
procedure pgm_save(fname: string; p: pbyte; w, h: integer) ;
var
f: file;
c: PChar;
Begin
c := PChar(format('P5'#10'%d %d'#10'255'#10, [w, h]));
AssignFile (f, fname);
Rewrite (f, 1);
BlockWrite (f, c^, strlen(c));
BlockWrite (f, p^, w * h);
CloseFile (f);
end;
procedure convert_4bit_to_32bit(const indices: PByte; const w, h: Word; const image: PByte; const pal: TPalette_4bit);
var
i: Integer;
index: integer;
dst: PRGB;
begin
dst := PRGB(image);
for i := 0 to w * h div 2 - 1 do begin
index := indices[i];
dst[i * 2 ] := pal[(index shr 4) and 15];
dst[i * 2 + 1] := pal[index and 15];
end;
end;
procedure CopyTexToXY(image: PByte; texture: PByte; const x, y, stride: integer);
var
i: integer;
src, dst: pbyte;
begin
src := texture;
dst := image + y * stride + x * 3;
for i := 0 to TEX_HEIGHT - 1 do begin
move(src^, dst^, TEX_WIDTH * 3);
dst += stride;
src += TEX_WIDTH * 3;
end;
end;
procedure CopyTileToXY(image: PByte; tile: PByte; const x, y, stride: integer);
var
i: integer;
src, dst: pbyte;
begin
src := tile + 5 * 4;
dst := image + y * stride + x;
for i := 0 to 3 do begin
move(src^, dst^, 4);
dst += stride;
src -= 5;
end;
end;
{ TWorld }
procedure TWorld.LoadTextures(const tex_fname, texidx_fname: string);
var
f: file;
buf: pbyte;
tex_size: integer;
i: Integer;
palette: TPalette_4bit;
image: pbyte;
palette_size: Integer;
texture_count: integer;
begin
AssignFile(f, tex_fname);
reset(f, 1);
palette_size := 48; //16x RGB
tex_size := TEX_WIDTH * TEX_HEIGHT div 2;
texture_count := filesize(f) div (tex_size + palette_size);
//writeln('texture_count: ', texture_count);
SetLength(heightmap.textures, texture_count);
heightmap.texture_count := texture_count;
buf := getmem(tex_size);
for i := 0 to texture_count - 1 do begin
image := getmem(TEX_WIDTH * TEX_HEIGHT * 3);
Blockread(f, buf^, tex_size);
Blockread(f, palette, palette_size);
convert_4bit_to_32bit(buf, TEX_WIDTH, TEX_HEIGHT, image, palette);
heightmap.textures[i] := image;
end;
freemem(buf);
CloseFile(f);
AssignFile(f, texidx_fname);
Reset(f, 1);
texture_count := filesize(f) div 4 - 1;
SetLength(heightmap.texture_index_map, texture_count);
Blockread(f, heightmap.texture_index_map[0], texture_count * 4);
CloseFile(f);
end;
procedure TWorld.LoadHeightmap(fname: string);
var
f: file;
buffer: array[0..15] of byte;
tile_offset: integer;
blk: pword;
blk_size: integer;
tile_count: word;
i: integer;
begin
AssignFile(f, fname);
reset(f, 1);
//header
Blockread(f, buffer, 12);
Blockread(f, buffer, 4);
Blockread(f, heightmap.y_scale, 4);
Blockread(f, buffer, 4);
Blockread(f, tile_count, 2); //tile count
Blockread(f, buffer, 2); //2B?
Blockread(f, tile_offset, 4); //tile offset
Blockread(f, buffer, 4); //offset?
Blockread(f, heightmap.width, 2);
Blockread(f, heightmap.height, 2);
//blocks / tile indices
blk_size := heightmap.width * heightmap.height * 2;
blk := getmem(blk_size);
Blockread(f, blk^, blk_size);
heightmap.blk := blk;
//tiles
//writeln('tiles: ', tile_count);
Seek(f, tile_offset);
heightmap.tile_count := tile_count;
heightmap.tiles := getmem(tile_count * 30);
for i := 0 to tile_count - 1 do
Blockread(f, heightmap.tiles[i], 30);
CloseFile(f);
end;
procedure TWorld.GenerateCompositeTexture;
var
image: pbyte;
image_size: integer;
x, y, stride: integer;
tile_idx, texture_idx, texmap_idx: integer;
texture: pbyte;
begin
image_size := heightmap.width * heightmap.height * TEX_WIDTH * TEX_HEIGHT * 3;
image := GetMem(image_size);
stride := heightmap.width * TEX_WIDTH * 3;
for y := 0 to heightmap.height - 1 do
for x := 0 to heightmap.width - 1 do begin
tile_idx := heightmap.blk[y * heightmap.width + x];
texmap_idx := heightmap.tiles[tile_idx].texture_index;
if texmap_idx > Length(heightmap.texture_index_map) - 1 then
texmap_idx := 0;
texture_idx := heightmap.texture_index_map[texmap_idx];
texture := heightmap.textures[texture_idx];
CopyTexToXY(image, texture, x * TEX_WIDTH, (heightmap.height - y - 1) * TEX_HEIGHT, stride);
end;
world_texture := image;
pnm_save(TEXTURE_FNAME, image, heightmap.width * TEX_WIDTH, heightmap.height * TEX_HEIGHT);
end;
procedure TWorld.HeightmapToTexture;
const
TILE_WIDTH = 4;
SCALE = 128;
var
x, y: integer;
tile_idx: integer;
i: integer;
image_size: integer;
image: pbyte;
begin
image_size := heightmap.width * heightmap.height * TILE_WIDTH * TILE_WIDTH;
image := GetMem(image_size);
for y := 0 to heightmap.height - 1 do begin
for x := 0 to heightmap.width - 1 do begin
tile_idx := heightmap.blk[y * heightmap.width + x];
CopyTileToXY(image, @(heightmap.tiles[tile_idx].unknown),
x * TILE_WIDTH, (heightmap.height - y - 1) * TILE_WIDTH, heightmap.width * TILE_WIDTH);
end;
end;
//scale
for i := 0 to image_size - 1 do
image[i] := byte(image[i] + SCALE);
height_texture := image;
//pgm_save('map_height.pgm', image, heightmap.width * TILE_WIDTH, heightmap.height * TILE_WIDTH);
end;
{
While vertical scaling is stored within file, horizontal seems to be always 0.5
The height values need to be centered, 128 seems to be the correct offset.
The generated y coords are flipped for (opengl) rendering
}
procedure TWorld.GenerateVertices;
const
h_scale = 0.5;
var
va_size: integer;
x, y: integer;
vert: TVertex3f;
width_half, height_half: integer;
i: integer;
v_scale: single;
begin
vertex_count := heightmap.width * 4 * heightmap.height * 4;
va_size := vertex_count * SizeOf(TVertex3f);
vertex_array := getmem(va_size);
width_half := heightmap.width * 2;
height_half := heightmap.height * 2;
v_scale := heightmap.y_scale;
for y := 0 to heightmap.height * 4 - 1 do
for x := 0 to heightmap.width * 4 - 1 do begin
vert.x := (-width_half + x) * h_scale;
vert.z := (-height_half + y) * h_scale;
vert.u := x / (heightmap.width * 4);
vert.v := y / (heightmap.height * 4);
i := y * heightmap.width * 4 + x;
vert.y := (height_texture[i] - 128) * v_scale;
vert.y := -vert.y;
vertex_array[i] := vert;
end;
end;
procedure SaveMaterialFile(const obj_fname, mtl_name, texture_fname: string);
var
f: TextFile;
begin
AssignFile(f, obj_fname + '.mtl');
Rewrite(f);
writeln(f, '# RS heightmap');
writeln(f, 'newmtl ', mtl_name); //begin new material
writeln(f, 'map_Kd ', texture_fname); //texture
writeln(f, 'Ka 1.000 1.000 1.000'); //ambient color
writeln(f, 'Kd 1.000 1.000 1.000'); //diffuse color
writeln(f, 'Ks 1.000 1.000 1.000'); //specular color
writeln(f, 'Ns 100.0'); //specular weight
writeln(f, 'illum 2'); //Color on and Ambient on, Highlight on
CloseFile(f);
end;
procedure TWorld.WriteToObj(const objFname: string);
const
MAT_NAME = 'default';
var
f: textfile;
i: integer;
v: TVertex3f;
x, y, stride: integer;
i2, i3: integer;
texfname: string;
begin
AssignFile(f, objFname);
Rewrite(f);
writeln(f, '# RS heightmap');
writeln(f, 'mtllib ', objFname + '.mtl');
//vertices
for i := 0 to vertex_count - 1 do begin
v := vertex_array[i];
writeln(f, 'v ', v.x:10:6, ' ', v.y:10:6, ' ', v.z:10:6);
end;
//uv-s
for i := 0 to vertex_count - 1 do begin
v := vertex_array[i];
writeln(f, 'vt ', v.u:10:6, ' ', v.v:10:6);
end;
//select material
writeln(f, 'usemtl ' + MAT_NAME);
//faces
{
12 2
3 34
}
stride := heightmap.width * 4;
for y := 0 to heightmap.height * 4 - 2 do
for x := 0 to heightmap.width * 4 - 2 do begin
i := y * stride + x + 1;
i2 := i + 1;
i3 := i + stride;
writeln(f, Format('f %d/%d %d/%d %d/%d', [i, i, i2, i2, i3, i3]));
i := i3 + 1;
writeln(f, Format('f %d/%d %d/%d %d/%d', [i2, i2, i, i, i3, i3]));
end;
CloseFile(f);
SaveMaterialFile(objFname, MAT_NAME, TEXTURE_FNAME);
end;
procedure TWorld.LoadFromFiles(const hmp, tex, texmap: string);
begin
LoadHeightmap(hmp);
//LoadTextures(tex, texmap);
end;
procedure TWorld.ExportToObj(const objfname: string);
begin
//GenerateCompositeTexture;
HeightmapToTexture;
GenerateVertices;
//WriteToObj(objfname);
end;
constructor TWorld.Create;
begin
height_texture := nil;
vertex_array := nil;
end;
destructor TWorld.Destroy;
begin
if height_texture <> nil then Freemem(height_texture);
if vertex_array <> nil then Freemem(vertex_array);
inherited Destroy;
end;
end.

67
terrain_viewer/terrain_mesh.pas Normal file
View File

@ -0,0 +1,67 @@
unit terrain_mesh;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils,
gl,
rs_world;
type
TRenderOpts = record
wireframe: boolean;
points: boolean;
vcolors: boolean;
textures: boolean;
fg_to_draw: integer;
end;
{ TTerrainMesh }
TTerrainMesh = class
private
terrain: TWorld;
public
destructor Destroy; override;
procedure Load(const hmp_filename: string);
procedure InitGL;
procedure DrawGL(opts: TRenderOpts);
end;
implementation
destructor TTerrainMesh.Destroy;
begin
inherited Destroy;
end;
procedure TTerrainMesh.Load(const hmp_filename: string);
begin
terrain := TWorld.Create;
terrain.LoadFromFiles(hmp_filename, '', '');
terrain.ExportToObj(''); //generate vertices
end;
//generate textures / texture atlas?
procedure TTerrainMesh.InitGL;
begin
end;
//draw vertices / tiles around actual position
procedure TTerrainMesh.DrawGL(opts: TRenderOpts);
var
i: integer;
v: TVertex3f;
begin
glBegin(GL_POINTS);
glColor3f(0, 1, 0);
for i := 0 to terrain.vertex_count - 1 do begin
v := terrain.vertex_array[i];
glVertex3fv(@v);
end;
glEnd;
end;
end.

82
terrain_viewer/terrain_viewer.lpi Normal file
View File

@ -0,0 +1,82 @@
<?xml version="1.0" encoding="UTF-8"?>
<CONFIG>
<ProjectOptions>
<Version Value="9"/>
<PathDelim Value="\"/>
<General>
<Flags>
<MainUnitHasCreateFormStatements Value="False"/>
<MainUnitHasTitleStatement Value="False"/>
</Flags>
<SessionStorage Value="InProjectDir"/>
<MainUnit Value="0"/>
<Title Value="terrain_viewer"/>
<UseAppBundle Value="False"/>
<ResourceType Value="res"/>
</General>
<i18n>
<EnableI18N LFM="False"/>
</i18n>
<VersionInfo>
<StringTable ProductVersion=""/>
</VersionInfo>
<BuildModes Count="1">
<Item1 Name="Default" Default="True"/>
</BuildModes>
<PublishOptions>
<Version Value="2"/>
</PublishOptions>
<RunParams>
<local>
<FormatVersion Value="1"/>
<CommandLineParams Value="hmp"/>
</local>
</RunParams>
<RequiredPackages Count="1">
<Item1>
<PackageName Value="LCL"/>
</Item1>
</RequiredPackages>
<Units Count="3">
<Unit0>
<Filename Value="terrain_viewer.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="terrain_viewer"/>
</Unit0>
<Unit1>
<Filename Value="terrain_mesh.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="terrain_mesh"/>
</Unit1>
<Unit2>
<Filename Value="rs_world.pas"/>
<IsPartOfProject Value="True"/>
<UnitName Value="rs_world"/>
</Unit2>
</Units>
</ProjectOptions>
<CompilerOptions>
<Version Value="11"/>
<PathDelim Value="\"/>
<Target>
<Filename Value="terrain_viewer"/>
</Target>
<SearchPaths>
<IncludeFiles Value="$(ProjOutDir)"/>
<UnitOutputDirectory Value="lib\$(TargetCPU)-$(TargetOS)"/>
</SearchPaths>
<Other>
<CompilerPath Value="$(CompPath)"/>
</Other>
</CompilerOptions>
<Debugging>
<Exceptions Count="2">
<Item1>
<Name Value="ECodetoolError"/>
</Item1>
<Item2>
<Name Value="EFOpenError"/>
</Item2>
</Exceptions>
</Debugging>
</CONFIG>

381
terrain_viewer/terrain_viewer.pas Normal file
View File

@ -0,0 +1,381 @@
{ HMP terrain viewer
Copyright (c) 2015 David Pethes
Permission is hereby granted, free of charge, to any person obtaining a copy of this software
and associated documentation files (the "Software"), to deal in the Software without
restriction, including without limitation the rights to use, copy, modify, merge, publish,
distribute, sublicense, and/or sell copies of the Software, and to permit persons to whom the
Software is furnished to do so, subject to the following conditions:
The above copyright notice and this permission notice shall be included in all copies or
substantial portions of the Software.
THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR IMPLIED, INCLUDING
BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,
DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
}
program terrain_viewer;
uses
sysutils, math,
gl, glu, glext, sdl,
terrain_mesh, rs_world;
const
SCR_W_fscrn = 1024;
SCR_H_fscrn = 768;
SCR_W_INIT = 1280;
SCR_H_INIT = 720;
SCREEN_BPP = 0;
RotationAngleIncrement = 1;
ZoomIncrement = 0.3;
MouseZoomDistanceMultiply = 0.15;
PitchIncrement = 0.5;
MouseTranslateMultiply = 0.025;
var
surface: PSDL_Surface;
done,
fullscreen: boolean;
terrain: TTerrainMesh;
view: record
rotation_angle: single;
distance: single;
pitch: single;
x, y: single;
autorotate: boolean;
opts: TRenderOpts;
end;
key_pressed: record
wireframe: boolean;
vcolors: boolean;
points: boolean;
textures: boolean;
fullscreen: boolean;
autorotate: boolean;
fg: boolean;
end;
mouse: record
drag: boolean;
translate: boolean;
last_x, last_y: integer;
resume_autorotate_on_release: boolean;
end;
procedure ReportError(s: string);
begin
writeln(s);
halt;
end;
// initial parameters
procedure InitGL;
var
ogl_info: string;
begin
ogl_info := format('vendor: %s renderer: %s', [glGetString(GL_VENDOR), glGetString(GL_RENDERER)]);
writeln(ogl_info);
ogl_info := 'version: ' + glGetString(GL_VERSION);
writeln(ogl_info);
//glShadeModel( GL_SMOOTH ); // Enable smooth shading
glClearColor( 0.0, 0.0, 0.0, 0.0 );
glClearDepth( 1.0 ); // Depth buffer setup
glEnable( GL_DEPTH_TEST ); // Enables Depth Testing
glDepthFunc( GL_LEQUAL ); // The Type Of Depth Test To Do
glHint( GL_PERSPECTIVE_CORRECTION_HINT, GL_NICEST ); // Really Nice Perspective Calculations
//glEnable( GL_CULL_FACE ); //backface culling
//glCullFace( GL_BACK );
glEnable(GL_TEXTURE_2D);
end;
// function to reset our viewport after a window resize
procedure ResizeWindow( width, height : integer );
begin
if ( height = 0 ) then
height := 1; // Protect against a divide by zero
glViewport( 0, 0, width, height ); // Setup our viewport.
glMatrixMode( GL_PROJECTION ); // change to the projection matrix and set our viewing volume.
glLoadIdentity;
gluPerspective( 45.0, width / height, 0.1, 1000.0 ); // Set our perspective
glMatrixMode( GL_MODELVIEW ); // Make sure we're changing the model view and not the projection
glLoadIdentity; // Reset The View
end;
// The main drawing function.
procedure DrawGLScene;
begin
glClear( GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT );
glMatrixMode( GL_MODELVIEW );
glLoadIdentity;
if view.distance < ZoomIncrement then
view.distance := ZoomIncrement;
glTranslatef(view.x, view.y, -view.distance);
glRotatef(view.rotation_angle, 0, 1, 0);
glRotatef(view.pitch, 1, 0, 0);
if view.autorotate then
view.rotation_angle += RotationAngleIncrement;
if view.rotation_angle > 360 then
view.rotation_angle -= 360;
terrain.DrawGL(view.opts);
SDL_GL_SwapBuffers;
end;
procedure SetMode(w, h: word; fullscreen: boolean = false);
var
flags: UInt32;
begin
if fullscreen then
flags := SDL_OPENGL or SDL_FULLSCREEN
else
flags := SDL_OPENGL or SDL_RESIZABLE;
surface := SDL_SetVideoMode( w, h, SCREEN_BPP, flags);
if surface = nil then
ReportError('SDL_SetVideoMode failed');
SDL_WM_SetCaption('HOB viewer', nil);
end;
procedure WindowScreenshot(const width, height : integer);
const
head: array[0..8] of word = (0, 2, 0, 0, 0, 0, 0, 0, 24);
counter: integer = 0;
var
buf: pbyte;
f: file;
fname: string;
begin
buf := getmem(width * height * 4);
glReadBuffer(GL_FRONT);
glReadPixels(0, 0, width, height, GL_BGR, GL_UNSIGNED_BYTE, buf);
fname := format('screenshot_%.4d.tga', [counter]);
AssignFile(f, fname);
Rewrite(f, 1);
head[6] := width;
head[7] := height;
BlockWrite(f, head, sizeof(head));
BlockWrite(f, buf^, width * height * 3);
CloseFile(f);
counter += 1;
Freemem(buf);
end;
procedure InitView;
begin
view.rotation_angle := 0;
view.distance := 6;
view.pitch := 0;
view.x := 0;
view.y := 0;
view.autorotate := true;
view.opts.wireframe := false;
view.opts.points := false;
view.opts.vcolors := true;
view.opts.textures := true;
end;
procedure HandleEvent;
var
event: TSDL_Event;
begin
SDL_PollEvent( @event );
case event.type_ of
SDL_QUITEV:
Done := true;
SDL_VIDEORESIZE:
begin
SetMode (event.resize.w, event.resize.h);
ResizeWindow( surface^.w, surface^.h );
end;
SDL_KEYDOWN:
case event.key.keysym.sym of
SDLK_ESCAPE:
Done := true;
SDLK_F1:
if not key_pressed.fullscreen then begin
if not fullscreen then begin
SetMode(SCR_W_fscrn, SCR_H_fscrn, true);
fullscreen := true;
end else begin
SetMode(SCR_W_INIT, SCR_H_INIT, false);
fullscreen := false;
end;
InitGL;
ResizeWindow( surface^.w, surface^.h );
key_pressed.fullscreen := true;
end;
SDLK_s:
WindowScreenshot( surface^.w, surface^.h );
SDLK_PAGEUP:
view.distance += ZoomIncrement;
SDLK_PAGEDOWN:
view.distance -= ZoomIncrement;
SDLK_r:
if not key_pressed.autorotate then begin
view.autorotate := not view.autorotate;
key_pressed.autorotate := true;
end;
//terrain rendering opts
SDLK_w:
if not key_pressed.wireframe then begin
view.opts.wireframe := not view.opts.wireframe;
key_pressed.wireframe := true;
end;
SDLK_v:
if not key_pressed.vcolors then begin
view.opts.vcolors := not view.opts.vcolors;
key_pressed.vcolors := true;
end;
SDLK_p:
if not key_pressed.points then begin
view.opts.points := not view.opts.points;
key_pressed.points := true;
end;
SDLK_t:
if not key_pressed.textures then begin
view.opts.textures := not view.opts.textures;
key_pressed.textures := true;
end;
SDLK_LEFT:
view.opts.fg_to_draw := max(0, view.opts.fg_to_draw - 1);
SDLK_RIGHT:
view.opts.fg_to_draw += 1;
end;
SDL_KEYUP:
case event.key.keysym.sym of
SDLK_F1:
key_pressed.fullscreen := false;
SDLK_w:
key_pressed.wireframe := false;
SDLK_v:
key_pressed.vcolors := false;
SDLK_p:
key_pressed.points := false;
SDLK_t:
key_pressed.textures := false;
SDLK_r:
key_pressed.autorotate := false;
end;
SDL_MOUSEBUTTONDOWN: begin
mouse.resume_autorotate_on_release := view.autorotate;
if event.button.button in [1..3] then begin
mouse.drag := true;
mouse.translate := event.button.button in [2];
mouse.last_x := event.button.x;
mouse.last_y := event.button.y;
view.autorotate := false;
end;
if event.button.button = 5 then
view.distance += view.distance * MouseZoomDistanceMultiply;
if event.button.button = 4 then
view.distance -= view.distance * MouseZoomDistanceMultiply;
end;
SDL_MOUSEBUTTONUP: begin
mouse.drag := false;
view.autorotate := mouse.resume_autorotate_on_release;
end;
SDL_MOUSEMOTION: begin
if mouse.drag then begin
if not mouse.translate then begin
if event.motion.y <> mouse.last_y then begin
view.pitch += PitchIncrement * event.motion.yrel;
mouse.last_y := event.motion.y;
end;
if event.motion.x <> mouse.last_x then begin
view.rotation_angle += RotationAngleIncrement * event.motion.xrel;
mouse.last_x := event.motion.x;
end;
end else begin
if event.motion.y <> mouse.last_y then begin
view.y -= MouseTranslateMultiply * event.motion.yrel;
mouse.last_y := event.motion.y;
end;
if event.motion.x <> mouse.last_x then begin
view.x += MouseTranslateMultiply * event.motion.xrel;
mouse.last_x := event.motion.x;
end;
end;
end;
end;
end; {case}
end;
//******************************************************************************
var
sec, frames: integer;
in_file: string;
begin
if Paramcount < 1 then begin
writeln('specify HOB file');
exit;
end;
in_file := ParamStr(1);
terrain := TTerrainMesh.Create;
terrain.Load(in_file);
writeln('Init SDL...');
SDL_Init( SDL_INIT_VIDEO );
SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
SetMode(SCR_W_INIT, SCR_H_INIT);
writeln('Init OpenGL...');
InitGL;
ResizeWindow( surface^.w, surface^.h );
InitView;
terrain.InitGL;
sec := SDL_GetTicks;
frames := 0;
Done := False;
key_pressed.wireframe := false;
key_pressed.fullscreen := false;
while not Done do begin
HandleEvent;
DrawGLScene;
frames += 1;
if (SDL_GetTicks - sec) >= 1000 then begin
write(frames:3, ' dist: ', view.distance:5:1, ' rot: ', view.rotation_angle:5:1, #13);
frames := 0;
sec := SDL_GetTicks;
end;
SDL_Delay(10);
//WindowScreenshot( surface^.w, surface^.h );
end;
terrain.Free;
SDL_Quit;
end.