The Matrix V1.01, Для прикола написал Опции

[godd]

Код

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]

Неплохо... Но есть одно замечание: не стоит выводить с помощью 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]

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]

А зацените мою:

[godd]

ZeroLink
понимаешь я ведь прогу почему матрицой назвал... ты фильм матрица смотрел? ну и посмотри там на матрицу у них... вроде зеленые символы сторчками снизу вверх ползут
А у тебя - дождик какой-то, еще и копирайты выводятся - зачем они? лучше прогу с полностью открытым кодом - она ж не сложная, а если чо кому надо - пусть берут.

[ZeroLink]

Да мы с корешем на новый год её писали и нам тогда казалось, что это и есть МАТРИЦА

[godd]

я в мае писал за 5 мин вывод нулей и единиц потоком сверху вниз, на тс, в Autorun поместили (самый старый кабинет - Винда98, а так весьде 2000), перезагрузили, училка - дура полнейшая - подошла (когда мы отошли от компа), и сказала или (точно не помню):
-вирус
-машина с ума сошла [вроде так] ))))

недавно решил нормальную матрицу написать

[P@sh@]

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]

P@sh@
chr(7) прет через звукаху, мастдаевский звук. писка нету!

да ты крут! 

Да я таков :p13:
Делать просто нечего было - вот фигней и страдал