PROGRAM floor2;
{
Floor of Doom, second life
- by Bjarke Viksíe
oct 1994
Use mouse and mousebuttons!
Trying to rotate the damn thing. (Jazz JackRabbit, here I come :)
Anyway, rotating a texturemapped floor is hardly a demo thing -
but a game idea? And very tricky to do.
Ok, it's pretty much the same as "Floor1" except that I do both a x-slope
and a y-slope run.
And all rotated coords are precalc'ed (LINES*2 coords per angle). Only
half of the 512 angles are actually precalc'ed, the other half is
calc'ed using the others (by negating x/y).
Oh, it needs about 320 Kb of free memory! Quit the IDE and start it
from the prompt on machines which are low on memory...
}
{$A+,B-,G+,E+,I+,N-,X+}
{$IFDEF DPMI}
{$C FIXED PRELOAD PERMANENT}
{$ENDIF}
USES
DEMOINIT,MOUSE;
{{$DEFINE DEBUG}
TYPE
pBunk = ^BunkArray;
BunkArray = ARRAY[0..254, 0..255] of byte;
pIntegerArray = ^IntegerArray;
IntegerArray = ARRAY[0..32760] of integer;
CONST
LINES = 70; {how many lines shall we paint}
TILT = 31780; {tilt floor how much?}
VAR
map, tiles : pBunk;
LineTable : array[1..3] of pIntegerArray;
xpos,ypos, angle : word;
CoordPtr : array[0..255] of pointer;
SinusTable : array[0..639] of integer;
(*------------------------------------------------*)
procedure SetupSinus;
var
i : integer;
v, vadd : real;
begin
v:=0.0;
vadd:=(2.0*pi/512.0);
for i:=0 to 639 do begin
SinusTable[i]:=round(sin(v)*32767);
v:=v+vadd;
end;
end;
procedure SetColours;
{Setup ugly, more or less randomly picked, colours}
var
i : integer;
begin
for i:=0 to 7 do setRGB(i, i,i,i);
for i:=8 to 15 do setRGB(i, (i-5)*2,0,0);
for i:=16 to 23 do setRGB(i, 0,(i-10)*2,(i-8)*2);
for i:=24 to 31 do setRGB(i, 0,0,42);
for i:=32 to 39 do setRGB(i, 0,(i-15)*2,0);
for i:=40 to 47 do setRGB(i, i,i,i);
for i:=48 to 55 do setRGB(i, i,0,0);
end;
procedure CreateMap;
{Create map.
Characters in string are indexes to tiles! 'a' is tile #0,
'b' is #1 (red one) and so...}
procedure Strip(ypos,xpos : integer; st : string);
var j : integer;
begin
for j:=1 to length(st) do st[j]:=char(ord(st[j])-ord('a'));
Move(st[1],map^[ypos,xpos],length(st));
end;
var
y : integer;
begin
GetMem(map,65535);
FillChar(map^,65535,#0);
y:=20;
while y<60 do begin
Strip(y,30,'fgfgfgfgfgfgfgfgfgfg');
Strip(y+1,30,'gfgfgfgfgfgfgfgfgfgf');
if (y>35) AND (y<45) then begin Strip(y,39,'aaaaa'); Strip(y+1,39,'aaaaa'); end;
inc(y,2);
end;
Strip(20,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc'); Strip(21,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
y:=22;
while (y<42) do begin
Strip(y,70,'bcaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaabc'); Strip(y+1,70,'cbaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaacb');
Strip(y,60,'dedede'); Strip(y+1,60,'ededed');
inc(y,2)
end;
Strip(42,70,'bcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbc');
Strip(43,70,'cbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcbcb');
end;
procedure CreateTiles;
{Create some ugly tiles. We simple choose some colours and paint
a brick with them}
var
i,j : integer;
begin
GetMem(tiles,65535);
FillChar(tiles^,65535,#0);
for i:=0 to 254 do {254, not 255, to get in running under DPMI!}
for j:=0 to 255 do
tiles^[i,j]:=((j DIV 32)*8) + random(8); {make dithered tile}
end;
procedure PrecalcLines;
const
XPOS = 20; {this will ajust the height of the viewer}
var
q,p,i, x1,y1,x2,y2 : integer;
z,sin1,cos1 : integer;
pos,angle : word;
cx,cy : longint;
begin
for i:=1 to 3 do GetMem(LineTable[i],65535);
p:=1;
pos:=0;
angle:=0;
for q:=0 to 255 do begin
CoordPtr[q]:=@LineTable[p]^[pos];
z:=8000;
sin1:=SinusTable[angle];
cos1:=SinusTable[angle+128];
for i:=1 to LINES do begin
x1:=LongDiv(-XPOS*65536,z); {calc first coord}
y1:=LongDiv((LINES-i)*longint(TILT),z);
cx := (LongMul(x1,cos1) - LongMul(y1,sin1)) DIV 32768; {rotate it}
cy := (LongMul(x1,sin1) + LongMul(y1,cos1)) DIV 32768;
x1:=cx;
y1:=cy;
LineTable[p]^[pos]:=x1;
LineTable[p]^[pos+1]:=y1;
x2:=LongDiv(XPOS*65535,z); {calc second coord}
y2:=LongDiv((LINES-i)*longint(TILT),z);
cx := (LongMul(x2,cos1) - LongMul(y2,sin1)) DIV 32768; {rotate it}
cy := (LongMul(x2,sin1) + LongMul(y2,cos1)) DIV 32768;
x2:=cx;
y2:=cy;
LineTable[p]^[pos+2]:=(longint(x2-x1) SHL 11) DIV 160;
LineTable[p]^[pos+3]:=(longint(y2-y1) SHL 11) DIV 160;
inc(pos,4);
inc(z,310);
end;
{Check if next set of coords should be placed in other buffer, since
they cannot all fit into one 64Kb segment!!!}
if ((pos*2 + (LINES*8)) > 65200) then begin
inc(p);
pos:=0;
end;
inc(angle,1); {calc next angle}
end;
end;
procedure InitDemo;
var
i : integer;
begin
ClearWholeScreen;
SetColours;
SetupSinus;
CreateMap;
CreateTiles;
PrecalcLines;
xpos:=1200; ypos:=800;
angle:=0;
end;
procedure UninitDemo;
var
i : integer;
begin
FreeMem(map,65535);
FreeMem(tiles,65535);
for i:=1 to 3 do FreeMem(LineTable[i],65535);
end;
(*------------------------------------------------*)
procedure MoveHero;
var
x,y, sin1,cos1 : integer;
cx,cy : longint;
begin
{Determine new rotation angle}
ReadMouseMotionCounters(x,y);
angle:=(angle + x) AND 511;
{is hero moving forward?}
if (LeftButton) then begin
sin1:=SinusTable[angle];
cos1:=SinusTable[angle+128];
x:=0; {this is the moving speed}
y:=6;
cx := (longmul(x,cos1) - longmul(y,sin1)) DIV 32768;
cy := (longmul(x,sin1) + longmul(y,cos1)) DIV 32768;
inc(xpos,cx);
inc(ypos,cy);
end;
{hero cannot move outside board}
if (xpos<200) then xpos:=200;
if (xpos>16384) then xpos:=16384;
if (ypos<200) then ypos:=200;
if (ypos>16384) then ypos:=16384;
end;
(*------------------------------------------------*)
procedure DrawFloor(x,y, angle : integer; Coords : pointer); assembler;
var
mappos,tablepos : word;
xadd,yadd,
mapxadd,mapyadd : integer;
height, counts : word;
asm
push ds
mov es,SEGA000
mov di,100*320
mov ax,WORD PTR [map+2]
{mov fs,ax} DB $8E,$E0
mov ax,WORD PTR [Coords+2]
{mov gs,ax} DB $8E,$E8
mov ax,WORD PTR [Coords]
mov [tablepos],ax
mov ds,WORD PTR [tiles+2]
cld
mov [height],LINES
@y_run:
mov si,[tablepos]
DB GS; mov ax,[si+4]
cmp [angle],256
jb @anglelow1
neg ax
@anglelow1:
mov [xadd],ax
mov [mapxadd],1
or ax,ax
jns @mapxup
mov [mapxadd],-1
@mapxup:
DB GS; mov ax,[si+6]
cmp [angle],256
jb @anglelow2
neg ax
@anglelow2:
mov [yadd],ax
mov [mapyadd],256
or ax,ax
jns @mapyup
mov [mapyadd],-256
@mapyup:
DB GS; mov dx,[si]
DB GS; mov cx,[si+2]
cmp [angle],256
jb @anglelow3
neg cx
neg dx
@anglelow3:
add dx,[x]
add cx,[y]
mov bx,dx {Find first tile}
mov ax,cx
shr ax,5
shr bx,5
mov bh,al
mov [mappos],bx
DB FS; mov al,[bx] {get tile-index from map}
mov ah,al {find map position in map-buffer}
and al,7
shr ah,3
shl ax,5
mov si,ax
shl dx,11
shl cx,11
xor dx,$8000
xor cx,$8000
mov [counts],160
@x_run:
mov bh,dh {get x-position of pixel}
mov bl,ch {get y-position of pixel}
shr bx,3
and bx,$1F1F
mov al,[si+bx] {get that pixel}
mov ah,al
stosw {store it... well, we draw it twice to gain speed!}
add dx,[xadd] {add to x-slope}
jno @noxadd
mov bx,[mappos]
add bx,[mapxadd]
mov [mappos],bx
DB FS; mov al,[bx] {get new tile-index from map}
mov ah,al {find tile position in tile-buffer}
and al,7
shr ah,3
shl ax,5
mov si,ax
@noxadd:
add cx,[yadd] {add to y-slope}
jno @noyadd
mov bx,[mappos]
add bx,[mapyadd]
mov [mappos],bx
DB FS; mov al,[bx] {get new tile-index from map}
mov ah,al {find tile position in tile-buffer}
and al,7
shr ah,3
shl ax,5
mov si,ax
@noyadd:
dec [counts]
jnz @x_run
add [tablepos],8
dec [height]
jnz @y_run
pop ds
end;
(*------------------------------------------------*)
procedure RunOnce;
var
i : integer;
begin
VBLANK;
{$IFDEF DEBUG} SetRGB(0,20,0,0); {$ENDIF}
MoveHero;
DrawFloor(xpos,ypos, angle, CoordPtr[angle AND 255]);
{$IFDEF DEBUG} SetRGB(0,0,0,0); {$ENDIF}
end;
begin
if NOT MouseDriverPresent then begin writeln('No mouse...'); halt; end;
SetScreenMode($13);
InitDemo;
repeat RunOnce until KeyPressed;
UninitDemo;
SetScreenMode(TEXTMODE);
end.
