IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

 
 Ответить  Открыть новую тему 
> The Matrix V1.01, Для прикола написал
сообщение
Сообщение #1


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


Код
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.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


N337
****

Группа: Пользователи
Сообщений: 737
Пол: Мужской

Репутация: -  26  +


smile.gif

Неплохо... Но есть одно замечание: не стоит выводить с помощью Write/Writeln символы c кодами 0..31. Например, Chr(7) может порождать достаточно длительные задержки на генерацию звукового сигнала (не говоря об акустических артефактахsmile.gif).

Для быстрого вывода символа с любым кодом 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.


--------------------
The idiots are winning.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


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 должны принести - прощай Паскаль ))). тока на алгоре еще с ним в этом году придется встечаться - всякую чушь (неинтересно - легко - поэтому чушь) делать]
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Новичок
*

Группа: Пользователи
Сообщений: 41
Пол: Мужской

Репутация: -  0  +


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


Прикрепленные файлы
Прикрепленный файл  MATRIX.RAR ( 1012 байт ) Кол-во скачиваний: 274


--------------------
Я могу изменить мир, но Бог не даёт исходник:(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


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


Новичок
*

Группа: Пользователи
Сообщений: 41
Пол: Мужской

Репутация: -  0  +


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


--------------------
Я могу изменить мир, но Бог не даёт исходник:(
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


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

недавно решил нормальную матрицу написать
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Бывалый
***

Группа: Пользователи
Сообщений: 180
Пол: Мужской

Репутация: -  2  +


godd
недавно решил нормальную матрицу написать
да ты крут! :D
только это, надо еще людям дырки в затылках проделать, а то с экрана ощущения не те smile.gif (шучу)

chr(7) в наушниках не услышишь, паскаль с саундбластером работать не умеет, только со спикером smile.gif

у xds в проге ассемблер вообще непонятно зачем используется (уж явно не для вывода на экран) - readkey и keypressed (да и setmode вроде) есть в модуле crt, а режим вообще по умолчанию текстовый...
а вывод напрямую в видеопамять можно и без буферов делать - в текстовом режиме скорость достаточная и мерцания не будет (если не очищать экран, конечно):
mem[$B800: y*160+x*2]:=2 - вывод закрашенного смайлика в позицию x,y
mem[$B800: y*160+x*2+1]:=$1E - установка аттрибута там же - желтый на синем фоне...
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Новичок
*

Группа: Пользователи
Сообщений: 40
Пол: Мужской

Репутация: -  0  +


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

Цитата
да ты крут! 

Да я таков :p13:
Делать просто нечего было - вот фигней и страдал
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 27.10.2020 22:48
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name