Главная страница
Top.Mail.Ru    Яндекс.Метрика
Текущий архив: 2005.06.14;
Скачать: CL | DM;

Вниз

Прикольный исходник на паскале нашол :)   Найти похожие ветки 

 
syte_ser78 ©   (2005-05-25 10:32) [0]

Взято на http://deep.webest.net

program OH_TOPMO3;

uses
CRT;

const
MHOrO_TEKCTOB         = 15;
nPOPEXA               = nil;

type
A_KTO_EBO_3HAET       = (HO_KTO_TO_BEgb_3HAET, BCE_ETO_BECbMA_CTPAHHO);

HyMEP                 = Byte;

CTPOKA                = String[15];

TEKCTuK               = record
                          OHA: CTPOKA;
                          TOPMO3: HyMEP;
                        end;

TAM_ABTOMAT           = ^ABTOMAT;

ABTOMAT               = object
                          MOE_X, MOE_Y: HyMEP;
                          TEKCTOB_BCEBO: HyMEP;
                          TEKCTbl: array[1..MHOrO_TEKCTOB] of TEKCTuK;
                          KAKOE: HyMEP;
                          TOPMO3uM: HyMEP;
                          XPEH_EMy: TAM_ABTOMAT;

                          constructor BOT_EBOHOE_MECTO(X, Y: HyMEP);
                          procedure BOH_ETOT_XPEH(KOMy_XPEH: TAM_ABTOMAT);
                          procedure ETO_CTPOKA(OHA_CAMA: CTPOKA;
                                               EE_TOPMO3: HyMEP);
                          procedure BblBOg;
                        end;

XMblPb                = object
                          HE_KACEKOB: A_KTO_EBO_3HAET;
                          KTO_TAM_CAMOE_TAKOE: TAM_ABTOMAT;

                          constructor Hy_HuKAK_MHE_EBO_HE_HA3BATb;
                          procedure B_nyTb;
                          procedure u_EBO_TO3E
(uMEHHO_ETO_MOXHATOE_OHO_CAMOE:
TAM_ABTOMAT);
                      end;

procedure BAM_TEMHO;
begin
ClrScr;
end;

procedure TOPMO3HyTb(CKOKO: HyMEP);
begin
Delay(CKOKO);
end;

procedure rge_EMy_KBACuTb(EBO_X, EBO_Y: HyMEP);
begin
GoToXY(EBO_X, EBO_Y);
end;

function WyXEP: Boolean;
begin
WyXEP := KeyPressed;
end;

constructor ABTOMAT.BOT_EBOHOE_MECTO(X, Y: HyMEP);
begin
MOE_X           := X;
MOE_Y           := Y;
TEKCTOB_BCEBO   := 0;
KAKOE           := 0;
TOPMO3uM        := 0;
end;

procedure ABTOMAT.BOH_ETOT_XPEH(KOMy_XPEH: TAM_ABTOMAT);
begin
XPEH_EMy := KOMy_XPEH;
end;

procedure ABTOMAT.ETO_CTPOKA(OHA_CAMA: CTPOKA; EE_TOPMO3: HyMEP);
begin
if TEKCTOB_BCEBO < MHOrO_TEKCTOB then begin
  Inc(TEKCTOB_BCEBO);
  with TEKCTbl[TEKCTOB_BCEBO] do begin
    OHA    := OHA_CAMA;
    TOPMO3 := EE_TOPMO3;
  end;
end;
end;

procedure ABTOMAT.BblBOg;
begin
if TEKCTOB_BCEBO > 0 then begin
  if TOPMO3uM = 0 then begin
    Inc(KAKOE);
    if KAKOE > TEKCTOB_BCEBO then KAKOE := 1;
    rge_EMy_KBACuTb(MOE_X, MOE_Y);
    with TEKCTbl do begin
       Write(OHA);
       TOPMO3uM := TOPMO3;
    end;
  end;
  Dec(TOPMO3uM);
end;
end;

constructor XMblPb.Hy_HuKAK_MHE_EBO_HE_HA3BATb;
begin
KTO_TAM_CAMOE_TAKOE := nPOPEXA;
HE_KACEKOB := BCE_ETO_BECbMA_CTPAHHO;
end;

procedure XMblPb.u_EBO_TO3E(uMEHHO_ETO_MOXHATOE_OHO_CAMOE: TAM_ABTOMAT);
begin
if KTO_TAM_CAMOE_TAKOE = nPOPEXA then begin
  KTO_TAM_CAMOE_TAKOE := uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
  uMEHHO_ETO_MOXHATOE_OHO_CAMOE^.XPEH_EMy :=
uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
end
else begin
  uMEHHO_ETO_MOXHATOE_OHO_CAMOE^.XPEH_EMy :=
KTO_TAM_CAMOE_TAKOE^.XPEH_EMy;
  KTO_TAM_CAMOE_TAKOE^.XPEH_EMy := uMEHHO_ETO_MOXHATOE_OHO_CAMOE;
end;
end;

procedure XMblPb.B_nyTb;
var
ETOT_PAXuT: TAM_ABTOMAT;

begin
ETOT_PAXuT := KTO_TAM_CAMOE_TAKOE;

while not WyXEP do
  with ETOT_PAXuT^ do begin
    BblBOg;
    ETOT_PAXuT := XPEH_EMy;
    rge_EMy_KBACuTb(1, 10);
    TOPMO3HyTb(10);
  end;
end;

procedure BAM_XOPOWO;
begin
BAM_TEMHO;
WriteLN(""OH TOPMO3 v1.0  Copyright The Future Hackers, 1993"");
WriteLN("" . Written by Kirill Shirokov and Dmitry Moskovich, May 93"");
WriteLN;
end;

var
EBO_3EHKu,
EBO_HOC,
EBO_POT,
EBO_XBOCT      : ABTOMAT;

KACEKOB       : XMblPb;

begin
with KACEKOB do begin
  Hy_HuKAK_MHE_EBO_HE_HA3BATb;
  with EBO_3EHKu do begin
    BOT_EBOHOE_MECTO(1, 1);
    ETO_CTPOKA(""-  -"", 20);
    ETO_CTPOKA(""o  o"", 3);
    ETO_CTPOKA(""O  O"", 16);
    ETO_CTPOKA(""0  0"", 23);
    ETO_CTPOKA(""O  O"", 14);
    ETO_CTPOKA(""o  o"", 5);
  end;
  u_EBO_TO3E(@EBO_3EHKu);

  with EBO_HOC do begin
    BOT_EBOHOE_MECTO(1, 2);
    ETO_CTPOKA("" .. "", 21);
    ETO_CTPOKA("" oo "", 16);
  end;
  u_EBO_TO3E(@EBO_HOC);

  with EBO_POT do begin
    BOT_EBOHOE_MECTO(1, 3);
    ETO_CTPOKA("" -- "", 22);
    ETO_CTPOKA("" == "", 4);
    ETO_CTPOKA(""-==-"", 6);
    ETO_CTPOKA(""/--"", 19);
    ETO_CTPOKA(""----"", 16);
    ETO_CTPOKA(""==/"", 21);
    ETO_CTPOKA(""----"", 3);
  end;
  u_EBO_TO3E(@EBO_POT);

  BAM_TEMHO;
  B_nyTb;
  BAM_XOPOWO;
end;
end.


 
Игорь Шевченко ©   (2005-05-25 10:37) [1]

LMD


 
Alexander Panov ©   (2005-05-25 10:38) [2]

Игорь Шевченко ©   (25.05.05 10:37) [1]
LMD


Снисходительнее надо быть к школьникам-)


 
Игорь Шевченко ©   (2005-05-25 10:43) [3]

Alexander Panov ©   (25.05.05 10:38) [2]

К ламерам снисхождения не будет. Это те школьники, которым самый кайф в лифте соответствующее слово нацарапать или наскальной живописью стены разукрасить. Отстой.


 
syte_ser78 ©   (2005-05-25 10:48) [4]

Не знаю, заметили ли уважаемые мастера, но это код который компелируется. Процедуры и переменные написаны латинскими буквами. Меня прикольнуло именно это.


 
DVM ©   (2005-05-25 10:52) [5]

это каким же надо терпением обладать, чтобы сидеть и подыскивать замены русским буквам среди латинских в течение всей работы.


 
syte_ser78 ©   (2005-05-25 10:53) [6]

Терпения не надо. Просто написать утилитку меняющую русские символы на латинские.


 
raidan ©   (2005-05-25 10:53) [7]

>DVM ©   (25.05.05 10:52) [5]
>это каким же надо терпением обладать, чтобы сидеть и подыскивать замены русским буквам среди латинских в течение всей работы.

Категорически не хотели либо работать, либо учиться :)


 
КаПиБаРа ©   (2005-05-25 11:01) [8]

Очень занимательный код


 
TUser ©   (2005-05-25 11:22) [9]

> Не знаю, заметили ли уважаемые мастера, но это код который  компелируется. Процедуры и переменные написаны латинскими буквами. Меня прикольнуло именно это.

Увы, для компилируемости его пришлось немного поправить. Вот интересно, что имел в виду автор, когда писАл такое
writeln (""чего-то там"");
И еще там что-то по мелочи редактировать пришлось. А так - действительно забавно.



Страницы: 1 вся ветка

Текущий архив: 2005.06.14;
Скачать: CL | DM;

Наверх




Память: 0.5 MB
Время: 0.028 c
3-1115383404
Kirill
2005-05-06 16:43
2005.06.14
Halcyon и работа с индексом CDX


1-1117054790
viny
2005-05-26 00:59
2005.06.14
Как заставить Delphi правильно считать?


14-1117085089
Ozone
2005-05-26 09:24
2005.06.14
Построение грамматик (задолбали заочники)


14-1116930920
Mx
2005-05-24 14:35
2005.06.14
Почему массивы не авторасширяемые?


14-1116614542
_Pasha_
2005-05-20 22:42
2005.06.14
Евровидение 2005