Автор: godd 7.10.2004 0:42
Код
uses crt;
var Del:word;
i:byte;
procedure WWD(Del:word;Col:byte;Str:string);
var i:byte;
begin
TextColor(Col);
for i:=1 to length(Str) do
begin
delay(Del);
write(str[i]);
end;
for i:=1 to 5 do Delay(Del);
writeln;
end;
Procedure MI; {MatrixInitialized}
type arr35b=array[1..15] of byte;
var matrix:record
element:array[1..25,1..80] of char;
color:array[1..25,1..80] of byte;
pos:arr35b;
leng:arr35b;
end;
f:boolean;
i,j,j_2,n:byte;
s:string;
begin
TextColor(2);
s:='';
with matrix do
for j_2:=1 to 15 do
begin
pos[j_2]:=random(80)+1;
leng[j_2]:=random(15)+1;
end;
for i:=25 downto 1 do
begin
for j:=1 to 80 do
begin
f:=false;
n:=random(16);
matrix.color[i,j]:=2;
for j_2:=1 to n do
if j=matrix.pos[j_2] then
if matrix.leng[j_2]>0 then
begin
with matrix do
begin
element[i,j]:=chr(random(256));
if leng[j_2]>random(15) then color[i,pos[j_2]]:=10;
leng[j_2]:=leng[j_2]-1;
end;
f:=true;
end;
if f=false then matrix.element[i,j]:=' ';
end;
end;
while TRUE do
begin
if KeyPressed then
begin
s:=s+ReadKey;
if s='godd rulez forever' then exit;
if s[length(s)]=#27 then s:='';
end;
for i:=1 to 25 do
begin
for j:=1 to 80 do
begin
GotoXY(j,i);
TextColor(matrix.color[i,j]);
write(matrix.element[i,j]);
with matrix do
begin
element[i,j]:=element[i+1,j];
color[i,j]:=color[i+1,j];
end
end;
Delay(random(10));
end;
for j:=1 to 80 do
with matrix do
begin
element[25,j]:=' ';
color[25,j]:=2;
end;
with matrix do
for j_2:=1 to 15 do
begin
leng[j_2]:=leng[j_2]-1;
if leng[j_2]<=0 then
begin
f:=true;
pos[j_2]:=random(80)+1;
leng[j_2]:=random(15)+1;
element[25,pos[j_2]]:=chr(random(256));
color[25,pos[j_2]]:=10;
end
else element[25,pos[j_2]]:=chr(random(256));
if leng[j_2]>random(10)+1 then color[25,pos[j_2]]:=10;
end;
end;
end;
begin
clrscr;
randomize;
CheckBreak:=false;
Del:=150;
clrscr;
WWD(Del,8,'Entering the MATRIX v1.01');
WWD(Del*2,2,'');
WWD(Del,2,'Loading');
WWD(Del*2,11,'..........................................');
WWD(trunc(Del*0.5),2,'');
WWD(trunc(Del*0.5),12,'All modules loaded.');
WWD(Del*2,2,'');
WWD(Del,2,'Testing the System');
WWD(Del*2,11,'..........................................');
WWD(trunc(Del*0.5),2,'');
WWD(trunc(Del*0.5),12,'System is OK.');
WWD(Del*2,2,'');
WWD(Del,7,'We are in the MATRIX now!');
WWD(trunc(Del*0.8),2,'');
WWD(Del,2,'Go follow white rabbit and remember...');
WWD(trunc(Del*0.8),2,'');
WWD(Del,10,'MATRIX HAD YOU !!!');
for i:=1 to 10 do Delay(del);
MI;
clrscr;
WWD(Del,2,'Password is right.');
WWD(Del,10,'Yes godd rulez, you right )))');
WWD(Del,2,'Bye!');
for i:=1 to 25 do delay(Del);
clrscr;
TextColor(15);
end.
P.S. Delay настроил под пропатченный CRT.
Автор: xds 7.10.2004 9:43
Неплохо... Но есть одно замечание: не стоит выводить с помощью Write/Writeln символы c кодами 0..31. Например, Chr(7) может порождать достаточно длительные задержки на генерацию звукового сигнала (не говоря об акустических артефактах).
Для быстрого вывода символа с любым кодом 0..255 можно использовать прямую запись в видеобуфер:
Код
program Code;
procedure SetTextMode; assembler;
asm
mov ax,3
int 10h
end;
function ReadKey: Word; assembler;
asm
xor ah,ah
int 16h
end;
function KeyPressed: Boolean; assembler;
asm
mov ah,1
int 16h
mov al,0
jz @l
inc al
@l:
end;
type
TTextBuf = array[0..24, 0..79] of Word;
var
BackBuf: TTextBuf;
ScrBuf: TTextBuf absolute $B800:0;
Timer: Word absolute $40:$6C;
t: Word;
x, y, dx, dy: Integer;
c, a: Byte;
i, j: Integer;
begin
SetTextMode;
x := 0;
y := 9;
dx := 3;
dy := 1;
c := 0;
repeat
t := Timer + 1;
Inc(x, dx);
if x < 0 then
begin
x := 0;
dx := -dx;
end
else
if x > 63 then
begin
x := 63;
dx := -dx;
end;
Inc(y, dy);
if y < 0 then
begin
y := 0;
dy := -dy;
end
else
if y > 9 then
begin
y := 9;
dy := -dy;
end;
for i := 0 to 24 do
for j := 0 to 79 do
BackBuf[i, j] := ((i + j) shr 3 and 1 - (i - j) shr 4 and 1) shl 12;
for i := 0 to 15 do
begin
for j := 0 to 15 do
begin
a := $F xor (c + i) and 3 shl 4;
BackBuf[i + y, j + x] := c or a shl 8;
Inc(c);
end;
end;
Move(BackBuf, ScrBuf, SizeOf(TTextBuf));
while Timer < t do;
until KeyPressed;
ReadKey;
end.
Автор: godd 7.10.2004 19:30
xds
chr(7), chr(8), chr(13), .. - оно и понятно, но в то же время chr(1), .. - всякие там значки - по моему игра стоит свеч [в принципе 'нехорошие' символы можно исключить, но прогу я писал особо не задаваясь вопросами производительности и пр.].
кстате, посчет chr(7) - наушники забыл одеть ))) [звука не слышал - внимания не обращал]
исправление:
в 3ех местах
после
Код
element[i,j]:=chr(random(256));
после
Код
element[25,pos[j_2]]:=chr(random(256));
добавить
Код
if (ord(element[i,j])=0) or (ord(element[i,j])=7) or (ord(element[i,j])=8) or (ord(element[i,j])=10) or (ord(element[i,j])=13)then element[i,j]:=chr(random(242)+14);
ветку
Код
else
element[25,pos[j_2]]:=chr(random(256));
надо сделать составной
Код
else
begin
element[25,pos[j_2]]:=chr(random(256));
if (ord(element[i,j])=0) or (ord(element[i,j])=7) or (ord(element[i,j])=8) or (ord(element[i,j])=10) or (ord(element[i,j])=13)then element[i,j]:=chr(random(242)+14);
end;
P.S.
xds наскока я понял ты в своей проге иллюстрируешь прямую запись в видеобуфер? [тама прямоугольник с символами лазает туда-сюда] - так я ж для прикола делал эту матрицу, и в ассме я маловато разбираюсь, серьезный проект мой будет - 3D RPG на С++ с использованием DirectX9.0. А Паскаль - это так, для прикола [послезавтра Borland C++ Builder должны принести - прощай Паскаль ))). тока на алгоре еще с ним в этом году придется встечаться - всякую чушь (неинтересно - легко - поэтому чушь) делать]
Автор: ZeroLink 8.10.2004 13:08
А зацените мою:
Прикрепленные файлы
MATRIX.RAR ( 1012 байт )
Кол-во скачиваний: 400
Автор: godd 8.10.2004 13:34
ZeroLink
понимаешь я ведь прогу почему матрицой назвал... ты фильм матрица смотрел? ну и посмотри там на матрицу у них... вроде зеленые символы сторчками снизу вверх ползут
А у тебя - дождик какой-то, еще и копирайты выводятся - зачем они? лучше прогу с полностью открытым кодом - она ж не сложная, а если чо кому надо - пусть берут.
Автор: ZeroLink 9.10.2004 12:32
Да мы с корешем на новый год её писали и нам тогда казалось, что это и есть МАТРИЦА
Автор: godd 9.10.2004 21:51
я в мае писал за 5 мин вывод нулей и единиц потоком сверху вниз, на тс, в Autorun поместили (самый старый кабинет - Винда98, а так весьде 2000), перезагрузили, училка - дура полнейшая - подошла (когда мы отошли от компа), и сказала или (точно не помню):
-вирус
-машина с ума сошла [вроде так] ))))
недавно решил нормальную матрицу написать
Автор: P@sh@ 11.10.2004 15:57
godd
недавно решил нормальную матрицу написать
да ты крут! :D
только это, надо еще людям дырки в затылках проделать, а то с экрана ощущения не те (шучу)
chr(7) в наушниках не услышишь, паскаль с саундбластером работать не умеет, только со спикером
у xds в проге ассемблер вообще непонятно зачем используется (уж явно не для вывода на экран) - readkey и keypressed (да и setmode вроде) есть в модуле crt, а режим вообще по умолчанию текстовый...
а вывод напрямую в видеопамять можно и без буферов делать - в текстовом режиме скорость достаточная и мерцания не будет (если не очищать экран, конечно):
mem[$B800: y*160+x*2]:=2 - вывод закрашенного смайлика в позицию x,y
mem[$B800: y*160+x*2+1]:=$1E - установка аттрибута там же - желтый на синем фоне...
Автор: godd 12.10.2004 0:10
P@sh@
chr(7) прет через звукаху, мастдаевский звук. писка нету!
Цитата
да ты крут!
Да я таков :p13:
Делать просто нечего было - вот фигней и страдал