program mc4k;
{$mode objfpc}{$h+}
{$ifdef mswindows}
{$apptype gui}
{$endif}
{$RANGECHECKS OFF}
{$FPUTYPE SSE3}
{$INLINE ON}
{$A 32}
{$OPTIMIZATION LOOPUNROLL,LEVEL3,UNCERTAIN,PEEPHOLE,ASMCSE,ORDERFIELDS,FASTMATH,CSE,DFA}
uses
cmem,
sdl,
math;
type
p32Array = ^u32Array;
u32Array = array[0..$FFFFFF] of int32;
const
WIDTH = 640;
HEIGHT = 400;
math_pi = 3.141592;
MAPDIM = 64;
TIME_SCALE = 100000;
var
event : TSDL_Event;
done : boolean = false;
screen : PSDL_Surface;
texmap : array[0..12287] of Integer;
map : array[0..MAPDIM * MAPDIM * MAPDIM] of Integer;
tickStart: LongWord;
function inttostr(v : integer): ansistring;
begin
str(v,result);
end;
var curr: Integer = 1254543;
var rndCnt: Integer = 0;
function nextInt(bound: Integer): Integer;
begin
rndCnt := rndCnt + 1;
curr := (curr * bound + 476611) mod 455345;
Result := curr mod bound;
end;
procedure makeTextures();
var
j, y, lBrightness, color, lBrightness2, lColor, x : int32;
begin
// each texture
for j:=1 to 15 do begin
lBrightness := 255 - nextInt(96);
// each pixel in the texture
for y:=0 to (16 * 3)-1 do
for x :=0 to 15 do begin
color := $966C4A;
lBrightness2 := 0;
lColor := 0;
if (j = 4) then
color := $7F7F7F;
if ((j <> 4) or (nextInt(3) = 0)) then
lBrightness := 255 - nextInt(96);
if (j = 1) and (y < (((x * x * 3 + x * 81) >> 2) and $3) + 18) then
color := $6AAA40
else if (j = 1) and (y < (((x * x * 3 + x * 81) >> 2) and $3) + 19) then
lBrightness := lBrightness * 2 div 3;
if (j = 7) then
begin
color := $675231;
if ((x > 0) and (x < 15) and (((y > 0) and (y < 15)) or ((y > 32) and (y < 47)))) then
begin
color := $BC9862;
lBrightness2 := x - 7;
lColor := (y and $F) - 7;
if (lBrightness2 < 0) then
lBrightness2 := 1 - lBrightness2;
if (lColor < 0.0) then
lColor := 1 - lColor;
if (lColor > lBrightness2) then
lBrightness2 := lColor;
lBrightness := 196 - nextInt(32) + lBrightness2 mod 3 * 32;
end
else if (nextInt(2) = 0) then
lBrightness := lBrightness * (150 - (x and $1) * 100) div 100;
end;
if (j = 5) then
begin
color := $B53A15;
if (((x + y div 4 * 4) mod 8 = 0) or (y mod 4 = 0)) then
color := $BCAFA5;
end;
if (j = 9) then
color := $4040ff; // water
if (j = 14) then begin
color := $7F7F7F; // stone with moss
if nextInt(3) = 0 then
color := $6AAA40
else if ((x + y div 4 * 4) mod 8 = 0) or (y mod 4 = 0) then
color := $6AAA60;
end;
if (j = 15) then begin
color := $B53A15; // red bricks with moss
if nextInt(3) = 0 then
color := $6AAA40
else if ((x + y div 4 * 4) mod 8 = 0) or (y mod 4 = 0) then
color := $6AAA60;
end;
lBrightness2 := lBrightness;
if (y >= 32) then
lBrightness2 := lBrightness2 div 2;
if (j = 8) then
begin
color := $50D937; // leaves
if (nextInt(2) = 0) then
begin
color := 0;
lBrightness2 := 255;
end;
end;
// fixed point colour multiply between i1 and i2
lColor :=
((((color >> 16) and $FF) * lBrightness2 div 255) << 16) or
((((color >> 8) and $FF) * lBrightness2 div 255) << 8) or
((color and $FF) * lBrightness2 div 255);
// pack the colour away
texmap[ x + y * 16 + j * 256 * 3 ] := lColor;
end;
end;
end;
procedure makeMap( ) ;
var
x, y, z, i : Integer;
yd, zd, th : single;
begin
// add random blocks to the map
for x := 0 to MAPDIM-1 do begin
for y := 0 to MAPDIM-1 do begin
for z := 0 to MAPDIM-1 do begin
i := (z shl 12) or (y shl 6) or x;
yd := (y - 32.5) * 0.4;
zd := (z - 32.5) * 0.4;
map[i] := nextInt( 16 );
th := nextInt( 256 ) / 256.0;
if (th > sqrt( sqrt( sqr((y - 32.5) * 0.4) + sqr(zd) ) ) - 0.8) or (th < 0.5) then
map[i] := 0;
end;
end;
end;
end;
procedure init( );
begin
makeTextures( );
makeMap( );
end;
procedure render();
var
now,xRot,yRot,yCos,
ySin,xCos,xSin,
ox, oy, oz,
__zd,
___xd,__yd,___zd,_yd,
_xd,_zd,closest,
dimLength,ll,
xd,yd,zd,initial,dist,
xp,yp,zp: single;
x,y ,col,br,d,tex,u,v,cc: Integer;
begin
now := ((SDL_GetTicks() - tickStart) mod TIME_SCALE) / TIME_SCALE;
xRot := sin(now * math_pi * 2) * 0.4 + math_pi / 2;
yRot := cos(now * math_pi * 2) * 0.4;
yCos := cos(yRot);
ySin := sin(yRot);
xCos := cos(xRot);
xSin := sin(xRot);
ox := 32.5 + now * 64.0;
oy := 32.5;
oz := 32.5;
// for each column
for x :=0 to WIDTH -1 do begin
// get the x axis delta
___xd := (x - WIDTH div 2) / HEIGHT;
// for each row
for y :=0 to HEIGHT-1 do begin
// get the y axis delta
__yd := (y - HEIGHT div 2) / HEIGHT;
__zd := 1;
___zd := __zd * yCos + __yd * ySin;
_yd := __yd * yCos - __zd * ySin;
_xd := ___xd * xCos + ___zd * xSin;
_zd := ___zd * xCos - ___xd * xSin;
col := 0;
br := 255;
closest := 32.0;
// for each principle axis x,y,z
for d :=0 to 2 do begin
dimLength := _xd;
if (d = 1) then
dimLength := _yd
else if (d = 2) then
dimLength := _zd;
ll := 1.0 / abs(dimLength);
xd := _xd * ll;
yd := _yd * ll;
zd := _zd * ll;
initial := ox - Trunc(ox);
if (d = 1) then initial := oy - Trunc(oy);
if (d = 2) then initial := oz - Trunc(oz);
if (dimLength > 0.0) then initial := 1 - initial;
dist := ll * initial;
xp := ox + xd * initial;
yp := oy + yd * initial;
zp := oz + zd * initial;
if (dimLength < 0.0) then begin
if (d = 0)then xp-=1;
if (d = 1)then yp-=1;
if (d = 2)then zp-=1;
end;
// while we are concidering a ray that is still closer then the best so far
while (dist < closest) do begin
// quantize to the map grid
tex := map[ ((trunc(zp) and 63) << 12) or ((trunc(yp) and 63) << 6) or (trunc(xp) and 63) ];
// if this voxel has a texture applied
if (tex > 0) then begin
// find the uv coordinates of the intersection point
u := (trunc((xp + zp) * 16)) and 15;
v := (trunc(yp * 16) and 15) + 16;
// fix uvs for alternate directions?
if (d = 1) then begin
u := (trunc(xp * 16)) and 15;
v := ((trunc(zp * 16)) and 15);
if (yd < 0.0) then
v += 32;
end;
//find the colour at the intersection point
cc := texmap[ u + v * 16 + tex * 256 * 3 ];
// if the colour is not transparent
if (cc > 0) then begin
col := cc;
br := 255 - trunc(dist * (255.0 / 32.0));
br := br * (255 - ((d + 2) mod 3) * 50) div 255;
//we now have the closest hit point (also terminates this ray)
closest := dist;
end;
end;
// advance the ray
xp += xd;
yp += yd;
zp += zd;
dist += ll;
end;
end;
p32Array(screen^.pixels)^[y * WIDTH + x] := ((br * ((col shr 16) and 255) div 255) shl 16
+ (br * ((col shr 8 ) and 255) div 255) shl 8
+ br * (col and 255) div 255);
end;
end;
end;
var
tickf: longword;
frames : longword = 0;
begin
SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, exOverflow, exUnderflow, exPrecision]);
SDL_putenv('SDL_VIDEO_CENTERED=1');
SDL_Init(SDL_INIT_VIDEO);
screen := SDL_SetVideoMode( WIDTH, HEIGHT, 32 , SDL_SWSURFACE );
init();
tickStart := SDL_GetTicks();
tickf := tickStart;
while not done do
begin
while SDL_PollEvent( @event ) > 0 do
case event.type_ of
SDL_KEYDOWN:
if ( event.key.keysym.sym = SDLK_ESCAPE ) then
begin
done := true;
end;
SDL_QUITEV:
begin
done := true;
end;
end;
render( );
inc(frames);
SDL_Flip(screen);
if SDL_GetTicks() - tickf > 1000 then begin
tickf := SDL_GetTicks();
SDL_WM_SetCaption(pchar('FPS='+inttostr(frames)), nil);
frames := 0;
end;
end;
end.