[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]
{$g+}
program rotationalfield;
{ Source by Bas van Gaalen, Holland, PD }
uses crt,dos;
const
gseg : word = $a000;
dots = 459;
dist : word = 250;
sintab : array[0..255] of integer = (
0,3,6,9,13,16,19,22,25,28,31,34,37,40,43,46,49,52,55,58,60,63,66,68,
71,74,76,79,81,84,86,88,91,93,95,97,99,101,103,105,106,108,110,111,
113,114,116,117,118,119,121,122,122,123,124,125,126,126,127,127,127,
128,128,128,128,128,128,128,127,127,127,126,126,125,124,123,122,122,
121,119,118,117,116,114,113,111,110,108,106,105,103,101,99,97,95,93,
91,88,86,84,81,79,76,74,71,68,66,63,60,58,55,52,49,46,43,40,37,34,31,
28,25,22,19,16,13,9,6,3,0,-3,-6,-9,-13,-16,-19,-22,-25,-28,-31,-34,
-37,-40,-43,-46,-49,-52,-55,-58,-60,-63,-66,-68,-71,-74,-76,-79,-81,
-84,-86,-88,-91,-93,-95,-97,-99,-101,-103,-105,-106,-108,-110,-111,
-113,-114,-116,-117,-118,-119,-121,-122,-122,-123,-124,-125,-126,
-126,-127,-127,-127,-128,-128,-128,-128,-128,-128,-128,-127,-127,
-127,-126,-126,-125,-124,-123,-122,-122,-121,-119,-118,-117,-116,
-114,-113,-111,-110,-108,-106,-105,-103,-101,-99,-97,-95,-93,-91,
-88,-86,-84,-81,-79,-76,-74,-71,-68,-66,-63,-60,-58,-55,-52,-49,
-46,-43,-40,-37,-34,-31,-28,-25,-22,-19,-16,-13,-9,-6,-3);
type
dotrec = record x,y,z : integer; end;
dotpos = array[0..dots] of dotrec;
var dot : dotpos;
{----------------------------------------------------------------------------}
procedure setpal(col,r,g,b : byte); assembler; asm
mov dx,03c8h; mov al,col; out dx,al; inc dx; mov al,r
out dx,al; mov al,g; out dx,al; mov al,b; out dx,al; end;
procedure setvideo(mode : word); assembler; asm
mov ax,mode; int 10h end;
function esc : boolean; begin
esc := port[$60] = 1; end;
{----------------------------------------------------------------------------}
procedure init;
var i : word; x,z : integer;
begin
i := 0;
z := -100;
while z < 100 do begin
x := -100;
while x < 100 do begin
dot[i].x := x;
dot[i].y := -45;
dot[i].z := z;
inc(i);
inc(x,10);
end;
inc(z,9);
end;
for i := 0 to 63 do setpal(i,0,i,i);
end;
{----------------------------------------------------------------------------}
procedure rotation;
const yst = 1;
var
xp : array[0..dots] of word;
yp : array[0..dots] of byte;
x,z : integer; n : word; phiy : byte;
begin
asm mov phiy,0; mov es,gseg; cli; end;
repeat
asm
mov dx,03dah
@l1:
in al,dx
test al,8
jnz @l1
@l2:
in al,dx
test al,8
jz @l2
end;
setpal(0,0,0,10);
for n := 0 to dots do begin
asm
mov si,n
mov al,byte ptr yp[si]
cmp al,200
jae @skip
shl si,1
mov bx,word ptr xp[si]
cmp bx,320
jae @skip
shl ax,6
mov di,ax
shl ax,2
add di,ax
add di,bx
xor al,al
mov [es:di],al
@skip:
end;
x := (sintab[(phiy+192) mod 255] * dot[n].x
{^^^^ ^^^^^^^^^^^^^^^^^^^^^^^^^^ ^ ^^^^^^^^
9 1 3 2 }
- sintab[phiy] * dot[n].z) div 128;
{ ^ ^^^^^^^^^^^^ ^ ^^^^^^^^ ^^^^^^^
7 4 6 5 8 }
(*
asm
xor ah,ah { 1 }
mov al,phiy
add al,192
mov si,ax
mov ax,word ptr sintab[si]
mov si,n { 2 }
mov dx,word ptr dot[si].x
mul dx { 3 }
mov cx,ax
mov dx,word ptr dot[si].z { 5 }
mov al,phiy { 4 }
mov si,ax
mov ax,word ptr sintab[si]
mul dx { 6 }
sub cx,ax { 7 }
shr cx,7 { 8 }
mov x,cx { 9 }
end;
*)
z := (sintab[(phiy+192) mod 255]*dot[n].z+sintab[phiy]*dot[n].x) div 128;
xp[n] := 160+(x*dist) div (z-dist);
yp[n] := 100+(dot[n].y*dist) div (z-dist);
{
asm
mov ax,x
mov dx,dist
mul dx
mov dx,z
sub dx,dist
div dx
add ax,160
(* can't assign ax to xp[n] !? *)
end;
}
asm
mov si,n
mov al,byte ptr yp[si]
cmp al,200
jae @skip
shl si,1
mov bx,word ptr xp[si]
cmp bx,320
jae @skip
shl ax,6
mov di,ax
shl ax,2
add di,ax
add di,bx
mov ax,z
shr ax,3
add ax,30
mov [es:di],al
@skip:
end;
end;
asm inc phiy end;
setpal(0,0,0,0);
until esc;
asm sti end;
end;
{----------------------------------------------------------------------------}
begin
setvideo($13);
Init;
rotation;
textmode(lastmode);
end.
[Back to GRAPHICS SWAG index] [Back to Main SWAG index] [Original]