home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
The Equalizer BBS
/
equalizer-bbs-collection_2004.zip
/
equalizer-bbs-collection
/
DEMOSCENE-STUFF
/
K-BBS.ZIP
/
CALL-IT.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1996-07-31
|
10KB
|
361 lines
Program Call_It;{
══════════════════════════════════════════════════════════════════════════════
Gautier Portet impulse/KNIGHTS
"BBS Advert for LiTHiUM" 3, Place Ferdinand Buisson
Copyright KNIGHTS 1996 31240 St Jean France
All Code by impulse . KNIGHTS FAX: (+33) 35 69 44 83 (EcLiPsE)
══════════════════════════════════════════════════════════════════════════════
│
-.▄█ ██▄ ▄█ █▄ ▄█ ▄████▄ ▄█ █▄ ▀████▄ ▄█████▄
│██ ██ ███ ██ ██ ██ ██ ██ ██ ██
███▌ ██ █ ██ ██ ██ ▄██▄ ███████ ██ █████▄
██ ██ ██ ███ ██ ██ █ ██ ██ ██ ██
▀█ ██▄ ▀█ █▀ █▀ ▀█████▀ ▀█ █▀ █▀ ▄█████▀
εcLiPsε ]<
coded by impluse 08..09/07/96
[ KNIGHTS Official Source Code ]
- Couleurs de t...... , Copyright Remdy / CeQuiVaAvecLaBrosseàDent 1996 :)
- 60% pur Pascal (lame!) code , Copyright impulse/KNIGHTS 1996
You can do whatever you want with this source code.
It is PUBLIC DOMAIN.
But as I'm the creator of it, I want the credits and Greets if you use it (?!)
If you want a BBS addy, just ask !
}
{$M 1024,0,0}
{$G+}
{$B-}
{$D-}
{$A+}
{$N-}
const
Sinus : Array[0..255] of byte = (
63,
69, 75, 81, 87, 93, 98, 103, 108, 112, 116, 119, 121, 123, 125, 126, 126,
126, 125, 123, 121, 118, 115, 111, 107, 102, 97, 92, 86, 81, 75, 68, 62,
56, 50, 44, 38, 33, 27, 22, 18, 14, 10, 7, 4, 2, 1, 0, 0,
0, 1, 3, 5, 8, 11, 15, 19, 24, 29, 35, 40, 46, 52, 58, 65,
71, 77, 83, 89, 94, 99, 104, 109, 113, 116, 119, 122, 124, 125, 126, 126,
125, 124, 123, 120, 118, 114, 110, 106, 101, 96, 91, 85, 79, 73, 67, 61,
54, 48, 42, 37, 31, 26, 21, 17, 13, 9, 6, 4, 2, 1, 0, 0,
1, 2, 4, 6, 9, 12, 16, 21, 25, 30, 36, 42, 48, 54, 60, 66,
72, 78, 84, 90, 96, 101, 105, 110, 114, 117, 120, 122, 124, 125, 126, 126,
125, 124, 122, 120, 117, 113, 109, 105, 100, 95, 89, 84, 78, 72, 65, 59,
53, 47, 41, 35, 30, 25, 20, 16, 12, 8, 6, 3, 2, 1, 0, 0,
1, 2, 4, 7, 10, 13, 17, 22, 27, 32, 37, 43, 49, 55, 61, 68,
74, 80, 86, 91, 97, 102, 107, 111, 115, 118, 121, 123, 125, 126, 126, 126,
125, 124, 122, 119, 116, 112, 108, 104, 99, 93, 88, 82, 76, 70, 64, 58,
51, 45, 40, 34, 29, 24, 19, 15, 11, 8, 5, 3, 1, 0, 0, 0,
1, 3, 5, 7, 10, 14, 18, 23, 28, 33, 39, 45, 51, 57, 63 );
{ iMPULSE's Sinus Generator version 5.4 }
const logo : array[1..14] of string[80] = (
' █ ████ ████ █ █ ████ █ █ █ █ ',
' ██ ██████ ██████ ██ ██ ██████ ██ ██ ██ ██ ',
' ███ ████████ ████████ ███ ███ ████████ ███ ███ ███ ███ ',
' ████ ██████████ ██████████ ████ ████ ██████████ ████ ████ ████ ████',
' ████ █ █ ████ ████ █ ████ ████ █████ ████',
' ████ ██ ██ ████ ████ ██ ████ ████ ██████████',
' ████ '+chr(24)+' ███ ███ ████ ████ ███ ████ ████ ████ ████',
' ████ '+chr(27)+'■'+chr(26)+' ████ ████ █████ ████ ████ ████ ████ ████ ████',
' ████ '+chr(25)+' ████ ████ ██████████ ████ ████ ████ ████ ████',
' ████ ████ ████ ████ ████ ████ ████ ████ ████ ████',
' █████████ ██████████ ████ ████ ████ ██████████ ████ ████ ████ ████',
' █████████ ██████████ ████ ████ ████ ██████████ ████ ████ ████ ████',
' █████████ ██████████ ████ ████ ████ ██████████ █████ ████ ████ ████',
' █████████ ██████████ ████ ████ ████ ██████████ ██████████ ████ ████');
number : array[1..8] of string[80] = (
' ██ ██████ ██████ ██ ███ ██████ ███ ██████ ██████ ██████ ██████ ██████',
' █ ███ ███ █ ███ ███ ███ ███ ███ ███ ███ ███',
' █ ███ ███ █ ███ ███ ███ ███ ███ ███ ███ ███',
' █ ███ ███ █ ███ ███ ███ ███ ███ ███ ███ ███',
' █ ███ ███ █ ███ ███ ███ ███ ███ ███ ███ ███',
' █ ████ ██████ █~██████ ██████~██████ ████~ ████ ███~ ████ ██████',
' █ ███ ███ █ ██▌▐██ ███ ██▌▐██ ███ ███ ███ ███ ███ ',
' ██ ██████ ██████ ██ ██████ ██████ ██████ ██████ ██████ ███ ██████ ██████');
var
n , m ,add1,add2,phi : word;
fin : boolean;
index,add_index : byte;
PROCEDURE Init_Curseur; ASSEMBLER;
{ Vire cette saloperie de putain de curseur !!!!!}
ASM
mov ah,1
mov cx,2020h
int 10h
end;
procedure print(x,y : byte ;st : string; c : byte);
{ affiche une chaine ... repompé ?!?! :) }
{ j'en ai une en ASM, mais bon ... }
var Offset : word;
i, j : byte;
Attribut : word;
colonne : byte;
begin
Offset := y * 160 + x shl 1 ;
Attribut := c shl 8;
i := length( St );
for j:=1 to i do
begin
memw[$b800:Offset] := Attribut or ord( St[j] );
Offset := Offset + 2;
end;
end;
procedure SetRGB(color : integer; r,g,b : byte); assembler;
asm
cli
mov dx,$3C8
mov ax,color
out dx,al
inc dx
mov al,r
out dx,al
mov al,g
out dx,al
mov al,b
out dx,al
sti
end;
procedure wait_VBL; assembler;
asm
mov dx,3DAh
@t1:
in al,dx
test al,8
jz @t1
cli
@t2:
in al,dx
test al,8
jnz @t2
sti
end;
procedure do_vagues ;assembler ;
asm
mov ax,0b800h
mov es,ax
mov di,49*160+1
xor cx,cx
mov bl,index
mov dx,32
mov si,n
mov bx,phi
@loop:
add si,add1
add bx,add2
and bx,255
and si,255
mov cl,byte ptr sinus[si]
add cl,byte ptr sinus[bx]
mov dx,32
shr cl,3
sub dl,cl
mov ax,1+16*2
inc cl
@loop1:
mov es:[di],al
add di,2
dec cx
jnz @loop1
mov ax,1
@loop2:
mov es:[di],al
add di,2
dec dl
jnz @loop2
sub di,160+66
or di,di
jns @loop
end;
procedure intro;
const max = 4;
const scroll : string =
(
' Call LiTHiUM bbs KNIGHTS Belgium HeadQuarter (32)-65-63-37-32 '
+' ');
const texte : array[1..max] of string[80] =
(
' !! W A R N I N G !! ',
' K · N · I · G · H · T · S ',
' Belgium HeadQuarter ',
' CALL NOW : '
);
const pos : array [1..max] of byte =
(34,35,36,37);
var sc_i : byte;
st : string[28];
i : byte;
begin
st := '';
setrgb(0,0,0,0);
setrgb(1,0,0,0);
setrgb(2,0,0,0);
index := 0;
fin := false;
add1 := 0;
add2 := 0;
for n := 1 to 14 do
print(0,n+16,logo[n],1);
for n := 1 to 8 do
print(0,n+40,number[n],1);
for n := 1 to 8 do
print(0,n+1,number[n],1);
sc_i := 1;
for n := 0 to 10 do
begin
setrgb(0,n*4,n*3,n*4);
setrgb(1,n*4,n*3,n*4);
setrgb(2,n*4,n*3,n*4);
wait_vbl;
end;
for n := 0 to 20 do
begin
wait_vbl;
setrgb(1,40+n,30+n,40+n);
setrgb(2,40-(n shr 1),30-(n shr 1),40-(n shr 1));
end;
randomize;randomize;
for n := 1 to random(20) do randomize;
{ boucle principale }
repeat
begin
wait_vbl;
inc(n);
if (n mod 200 ) = 0 then begin
phi := n;
add1 := random(5)+1;
add2 := random(5)+1;
end;
i := 2+( sinus[n and 255] )div 3;
for m := 1 to max do
print(i,pos[m],texte[m],1); { LAME !! }
sc_i := (sc_i+1) and 127;
st := copy(scroll,sc_i,28);
print(25,13,'['+st+']',1);
do_vagues;
{ quitte si ESC appuyé }
asm
in al,60h
cmp al,1
jne @fin_KKK
mov fin,true
@fin_KKK:
end;
end;
until fin = true;
{ vide le buffer de clavier }
asm
@debut:
mov ax,0100h
int 16h
jz @fin
xor ax,ax
int 16h
jmp @debut
@fin:
end;
end;
procedure endtro;
begin
asm
mov ax,0003h
int 10h
end;
setrgb(7,0,0,0);
for n := 1 to 154 do write('LiTHiUM bbs ');
writeln('Code, Ascii by impulse / KNIGHTS ');
print(30,12,' LITHIUM bbs ',0+16*7);
print(0,13,' KNIGHTS Belgium HQ ',0+16*7);
print(30,14,' (32)-65-63-37-32 ',0+16*7);
for n := 0 to 63 do
begin
wait_vbl;
wait_vbl;
setrgb(7,n,n,n);
end;
for n := 63 downto 40 do
begin
wait_vbl;
wait_vbl;
setrgb(7,n,n,n);
end;
end;
begin
asm
{ Verifie si VGA }
mov ax,01a00h
int 10h
cmp al,1ah
je @suite
mov ax,4c00h
int 21h
@suite:
{ passe en mode 80*50 }
mov ax,0003h
int 10h
mov ax,1112h
mov bx,0000h
int 10h
end;
init_curseur;
intro;
endtro;
end.