home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Collection of Hack-Phreak Scene Programs
/
cleanhpvac.zip
/
cleanhpvac
/
SKY.ZIP
/
TESTSKY.PAS
< prev
Wrap
Pascal/Delphi Source File
|
1996-02-14
|
4KB
|
125 lines
{*****************************************************************************}
{* *}
{* SKY *}
{* *}
{* This code is Copyright (C) 1996 Mark Mackey. Use, modification, *}
{* and redistribution of this code is freely permitted, provided that *}
{* the original author is acknowledged. *}
{* *}
{*****************************************************************************}
program showsky;
uses crt;
type maptype=array[0..65534] of byte;
mapptr=^maptype;
const screen:pointer=pointer($A0000000);
var sky,buffer:mapptr;
i:longint;
randseed:longint;
{$L testsky.obj}
procedure projectsky(sky:mapptr;buffer:pointer;x,y,height:longint);external;
{Projects the sky to the buffer. x, y and height are all in 16.16
fixed point format. Assumes a buffer width of 256.
See TESTSKY.ASM for details.}
{$L subdiv.obj}
procedure subdivide(map:mapptr;start,side:word);external;
{Creates a wraparound fractal map using recursive subdivision.
Assumes that the map is 256x256 bytes, initialised to all 255's
except for some seed values at the corners.
See SUBDIV.ASM for more details.}
procedure smooth(map:mapptr;shift:word);external;
{Smooths a map and adds _shift_ to all values}
procedure SetPalette;
{ Sets the palette. This is fairly crude: much better palettes can
be designed using a decent palette editor. Colour 129 is the
background sky colour: higher values are increasing cloudiness.}
var i:integer;j:byte;
begin
port[$03c8]:=0;
for i:=1 to 3 do port[$03c9]:=0;
for i:=1 to 127 do
begin
port[$03c9]:=0;
port[$03c9]:=0; {*}
port[$03c9]:=0;
end;
for i:=0 to 95 do
begin
j:=byte(round(10+i/94*22));
port[$03c9]:=j;
j:=byte(round(10+(i+0.5)/94*22));
port[$03c9]:=j;
port[$03c9]:=32
end;
for i:=0 to 31 do
begin
j:=byte(round(32-i/61*10));
port[$03c9]:=j;
j:=byte(round(32-(i+0.33)/61*10));
port[$03c9]:=j;
j:=byte(round(32-(i+0.66)/61*10));
port[$03c9]:=j;
end;
end;
procedure MakeSky(sky:mapptr);
{ Makes the sky map. The sky only uses colours 129 to 255 }
var i,j:longint;
begin
for i:=0 to 65535 do sky^[i]:=$FF; {Initialise map}
for i:=0 to 3 do
for j:=0 to 3 do
sky^[i*$4000+j*$40]:=$80; {Set some initial values}
subdivide(sky,0,256); {and subdivide recursively}
smooth(sky,20); {Smooth off and add 20 to all values}
for i:=0 to 65535 do
if sky^[i]<129 then sky^[i]:=129; {Limit to 129..255}
end;
procedure blit(buffer:pointer;Lines:word);assembler;
{Blit the buffer to the screen. Assumes a buffer width of 256, and
writes Lines lines from the buffer.}
asm
push ds
lds si,[buffer]
mov ax,$A000
mov es,ax
mov di,32
mov bx,[Lines]
@Loop:
mov cx,256
rep movsb
add di,64
dec bx
jnz @Loop
pop ds
end;
begin
randseed:=2; {Change or use randomize to get a different sky}
getmem(buffer,65535);
getmem(sky,65535);
writeln('Generating map...');
MakeSky(sky); {Make the sky map.}
asm
mov ax,013h
int 10h {Enter 320x200 256-colour graphics mode}
end;
SetPalette; {Set up the palette}
i:=-1500;
repeat {draw the sky, moving forwards and up}
inc(i);
projectsky(sky,buffer,0,i shl 14,400 shl 16 - i shl 14);
blit(buffer,96);
until (i>1550) or keypressed;
asm
mov ax,03h; {back to text mode}
int 10h
end;
end.