[Back to SCROLL SWAG index] [Back to Main SWAG index] [Original]
{
S921878@MINYOS.XX.RMIT.OZ.AU, Daniel John Lee Parnell
I have received several requests for the source code to the
scrolly demo I posted to this group. Sorry about posting a binary. I
didn't know it was not allowed on this group. Anyway the following is the
source code to the scrolly. It is not a unit. It uses one 286
instruction so it wont work on an XT :(
}
{$G+}
program ColorBars;
uses
DOS, CRT;
const
maxBars = 7;
maxStars = 100;
maxLines = 7;
m : array [1..maxLines] of string =
('Welcome to my first scrolly demo on the PC. It was written using ',
'Turbo Pascal 6.0 on the 7th of October 1993. This program took me ',
'about 2 hours to write and I had a lot of fun writing it! ',
'I suppose I''d better put in some greets I guess...............',
'Greetings go to Robyn Adam Rowan Mandy ',
' Weng Speed Shane Iceberg Inc. And anybody ',
'else out there whom I have forgotten about...... ');
var
colors : array [0..768] of byte;
rMsk,
gMsk,
bMsk : array [0..255] of byte;
y, dy, s : array [1..maxBars] of integer;
sx, sy,
sdx : array [1..maxStars] of integer;
tx, ty : array [0..640] of integer;
dot : integer;
ticks : word;
scrly : array [0..360] of integer;
mpos,
mlen : integer;
procedure SetMode(m : integer); { Set video mode }
var
regs : registers;
begin
regs.ax := m;
intr($10, regs);
end;
procedure WaitRetrace; { Wait for vertical retrace }
begin
repeat { Nothing } until (Port[$03da] and 8) <> 0;
end;
procedure WaitNotRetrace; { Wait for not vertical retrace }
begin
repeat { Nothing } until (Port[$03da] and 8) <> 8;
end;
procedure InitScreen; { Sets up the colored bars }
var
i, j : integer;
begin
for i := 0 to 199 do
for j := 0 to 319 do
mem[$a000 : i * 320 + j] := i;
end;
procedure InitColors; { Zeros the first 200 colors }
var
i : integer;
begin
for i := 0 to 199 * 3 do
colors[i] := 0;
end;
procedure SetColors; assembler; { Loads the colors into the regs }
asm
@ntrace: { Wait for not retrace }
mov dx, $03da
in al, dx
test al, 8
jnz @vtrace
@vtrace: { Now wait for retrace }
mov dx, $03da
in al, dx
test al, 8
jz @vtrace
mov dx, $03c8 { Start changeing colors from color # 1 }
mov al, 1
out dx, al
inc dx { Make DX point to the color register }
mov cx, 199*3 { The number of bytes to put into the color register }
mov si, offset colors { Load the address of the color array }
rep outsb { Now change the colors }
end;
procedure CalcBars; { Calculate the color bars }
var
i, j, k : integer;
begin
for i := 0 to 199 * 3 do { Zero all the colors }
colors[i] := 0;
for i := 1 to maxBars do { Now process each bar in turn }
begin
y[i] := y[i] + dy[i]; { Move the bar }
if (y[i] < 4) or (y[i] > 190) then { Has it hit the top or the bottom? }
begin
dy[i] := -dy[i]; { Yes, so make it bounce }
y[i] := y[i] + dy[i];
end;
for j := (y[i] - s[i]) to (y[i] + s[i]) do { Now update the color array }
begin
if j < y[i] then { Calculate the intensity }
k := 63 - (y[i] - j) * 4
else
k := 63 - (j - y[i]) * 4;
if j > 0 then { If it is a valid color change it }
begin
colors[j * 3] := (colors[j * 3] + (k and rMsk[i])); { Do red }
colors[j * 3 + 1] := (colors[j * 3 + 1] + (k and gMsk[i])); { Do green }
colors[j * 3 + 2] := (colors[j * 3 + 2] + (k and bMsk[i])); { Do blue }
end;
end;
end;
end;
procedure InitBars; { Set up the bars randomly }
var
i : integer;
begin
for i := 1 to MaxBars do
begin
y[i] := random(150)+4; { Starting pos }
s[i] := random(6)+4; { Size }
rMsk[i] := random(2)*255; { Red mask }
gMsk[i] := random(2)*255; { Green mask }
bMsk[i] := random(2)*255; { Blue mask }
repeat { Calc direction }
dy[i] := random(6) - 3;
until dy[i] <> 0;
end;
end;
procedure InitStars; { Set up the stars }
var
i : integer;
begin
port[$03c8] := $f8; { Change the colors for stars }
for i := 7 downto 0 do
begin
port[$03c9] := 63 - (i shl 2);
port[$03c9] := 63 - (i shl 2);
port[$03c9] := 63 - (i shl 2);
end;
for i := 1 to maxStars do
begin
sx[i] := random(320); { Choose X pos }
sy[i] := random(200); { Y pos }
sdx[i] := 1 shl random(3); { Speed }
end;
end;
procedure InitScroll; { Initialize the scrolly }
const
k = 3.141 / 180;
var
i : integer;
begin
mlen := 0; { Calc length of scroll text }
for i := 1 to maxLines do
mlen := mlen + length(m[i]);
for i := 0 to 640 do { Zero all the star positions }
tx[i] := -1;
for i := 0 to 360 do { Calculate the scroll path }
scrly[i] := round(100 + 50 * sin(i * k));
end;
procedure UpdateStars; { Draw the stars }
var
i, ad : integer;
begin
for i := 1 to maxStars do
begin
ad := sx[i] + sy[i] * 320; { Calc star address in video ram }
mem[$a000 : ad] := sy[i]; { Unplot old star pos }
sx[i] := sx[i] + sdx[i]; { Calc new star pos }
if sx[i] > 319 then { Is it past the end of the screen? }
begin
sy[i] := random(200); { Yes, generate a new star }
sx[i] := 0;
sdx[i] := 1 shl random(3);
ad := sx[i] + sy[i] * 320;
end;
mem[$a000:ad + sdx[i]] := $f7 + (sdx[i]) * 2;
end;
end;
function msg(var i : integer) : char; { Get a char from the scroll text }
var
j, t, p : integer;
begin
if i > mlen then { Is I longer then the text? }
i := 1;
j := 0; { Find which line it is in }
t := 0;
repeat
inc(j);
t := t + length(m[j]);
until i<t;
p := i - t + length(m[j]); { Calculate position in line }
if p > 0 then
msg := m[j][p]
else
msg := chr(0);
inc(i); { Increment text position }
end;
procedure NextChar; { Create nex character in scroll text }
var
ad : word;
i, j,
q, c : integer;
begin
c := ord(msg(mpos)); { Get the char }
ad := $fa6e + (c * 8); { Calc address of character image in ROM }
for i := 0 to 7 do
begin
q := mem[$f000 : ad + i]; { Get a byte of the image }
for j := 0 to 7 do
begin
if odd(q) then { Is bit 0 set? }
begin
tx[dot] := 320 + (7 - j) * 4; { If so add a dot to the list }
ty[dot] := i * 4;
inc(dot);
if dot > 640 then
dot := 0;
end;
q := q shr 1; { Shift the byte one pos to the right }
end;
end;
end;
procedure DisplayScroll; { Display scrolly and update dot positions }
var
i : integer;
ad : word;
begin
if (ticks mod 32) = 0 then { Is it time for the next char? }
NextChar;
for i := 0 to 640 do
if tx[i] > 0 then { Is this dot being used? }
begin
if tx[i] < 320 then { Is it on the screen? }
begin
ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc old position }
mem[$a000:ad] := ty[i] + scrly[tx[i]]; { Clear old dot }
end;
dec(tx[i]); { Move dot to the left }
ad := tx[i] + (ty[i] + scrly[tx[i]]) * 320; { Calc new position }
if (tx[i] > 0) and (tx[i] < 320) then { Is it on the screen? }
mem[$a000:ad] := $ff - (ty[i] shr 2); { Plot new dot }
end;
end;
begin
randseed := 4845267; { Set up the random seed }
SetMode($13); { Go to 320*200*256 mode }
InitColors; { Blank the color array }
SetColors; { Set the colors to black }
InitScreen; { Set up the colored bars }
InitBars; { Set up the bar positions }
InitStars; { Set up the stars }
InitScroll; { Set up the scrolly }
dot := 0; { Set the dot counter to 0 }
mpos := 1; { Set up the text pos }
repeat
CalcBars; { Calculate the color bars }
DisplayScroll; { Display the scrolly text }
UpdateStars; { Update & display the stars }
SetColors; { Set the colors }
inc(ticks); { Update the tick counter }
until KeyPressed;
SetMode(3); { Return to text mode }
end.
[Back to SCROLL SWAG index] [Back to Main SWAG index] [Original]