ПК-01 ЛЬВОВ

форум о ПК-01,02 "Львов"
Текущее время: 16 окт 2018, 13:42

Forum Games WEB Tape Loader Twitter RSS

Часовой пояс: UTC + 2 часа [ Летнее время ]




Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу Пред.  1, 2
Автор Сообщение
СообщениеДобавлено: 18 янв 2018, 15:12 
Не в сети
Site Admin
Аватар пользователя

Зарегистрирован: 24 июл 2008, 12:05
Сообщений: 994
Ну, пока, я не говорю о поноценном компиляторе. Просто твой МАДЛ, компилирует исходник в *.ехе, запускает *.ехе, получает лвт, удаляет *.ехе. Со стороны пользователя - это все "черная магия", которая дает ему вожделенный лвт без лишних телодвижений.
И, забегая наперед, хочу сказать, что лучше уж *.dll вместо *.exe, а МАДЛ будет дергать из него условный MakeLVT метод.

По-моему, так намного логичнее для постороннего пользователя, нет?


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: 19 янв 2018, 12:01 
Не в сети

Зарегистрирован: 18 май 2016, 19:55
Сообщений: 28
Zelya, я вот тебя и твоих "упрёков" не могу понять ?! - создаёт екзешник... запускает екзешник.... удаляет екзешник... это все "черная магия"...
А вот твоя "Львов Студия" часом не "черная магия" ? :-) Ну вот откуда я знаю, что она "вытворяет" во время компиляции?! Может она построена так же как я строю МАДЛ, т.е. запускаю в "Львов студии" компиляцию, а она "втихарика" создаёт proect.dpr, распаковывает "из своего тела" примочку fpc.exe, далее этой примочкой компилироует proect.dpr в proect.exe, далее запускает его, получаем ЛВТ... ну а после это всё "подтирает акуратненько", разве не так ? Чем докажешь ? :-) ВО! Ничем не докажешь! Значит "Львов Студия" , - "черная магия"! :-)
А что если я такое умудрился бы сделать в массиве самого компилятора-МАДЛа?... массив который запускается как машинный код ?! Тоже не правильно ?! Ну никто бы об этом не знал бы, так оно или не так! Просто не смогу я сделать так, - чтобы "набивался" массив в программе машинным кодом и запускался тот массив на выполнение как машинный код, и не нужно бы было fpc.exe и компиляция в екзешник и его запуск.
Конечно есть разные варианты для рассмотрения...
но...
вот скажи мне пожалуйста... существуют примочки tpc.exe, fpc.exe, dcc32.exe и т.д. которые ох как помогают для достижении цели!... и вот извbните меня... какого хрена, меня Zelya (или еще кто-то там) убеждают что использование этих и каких-то других примочек это не правильно?!... использовать эти примочки которые существуют. Причём заметь, примочки на выбор пользователя, - хоть от Дельфи, хоть хоть Free Pascal, хоть от Turbo Pascal7...
В общем, пока разговор не о чём! Будет что показать, я тебе вышлю! Вот тогда и смотреть будем, что с этим всем делать или не делать! А вообще, делаю как могу, а то что это никому не понравится, - я не виноват (буду)! Никто почему-то до сих пор не создал компилятор чтобы можно было писать "человеческим языком" для ПК-01, а вот моё в глаза еще не видел никто, но уже Zelya пытается это "критиковать" и "корректировать" в "нужное русло". :-) :-(


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: 29 янв 2018, 19:37 
Не в сети
Site Admin
Аватар пользователя

Зарегистрирован: 24 июл 2008, 12:05
Сообщений: 994
Друг мой любезный, твои наезды на "упреки" мне совершенно непонятны. Ты создал эту тему, чтобы все восхищались МДАЛом и пели оды его создателю? Увы, восхищаться нечем. Тем более странно, что "В общем, пока разговор не о чём!". Зачем тогда напрашиваться на отзывы, если отзывы не нужны?
Со своей стороны сразу предупрежу, если общение продолжиться в том же стиле: "я создал нечто, и вы все мне обязаны", ни единого поста больше от меня.


Вернуться наверх
 Профиль  
 
СообщениеДобавлено: 20 фев 2018, 18:13 
Не в сети

Зарегистрирован: 18 май 2016, 19:55
Сообщений: 28
Проект МАДЛ я не забросил и всё работаю над ним. Хочу немножко "приоткрыть занавес" и показать как приблизительно будет выглядит код написанный на МАДЛе.
Выкладываю вырезки того кода который МАДЛ уже "понимает". Это вырезки кода, из будущего примера для МАДЛа, моей игры "Лабиринт САС 2014". Естественно код этого примера еще очень и очень "сырой", да и к тому же не полный. Этот код выкладываю только лишь для того, чтобы Вы могли визуально посмотреть, как будет выглядеть исходники на МАДЛе. Также хотелось бы чтобы заранее (до окончания проекта) отозвались те, которых этот проект заинтересует, как говорится в целом!
В коде встречаются многоточие, вот такое:
.................
.................
.................
которое означает, что на том месте вырезанный код, который МАДЛ "не понимает".
[code]

.................
.................
.................
Procedure KeyD; {// Дополнительная клавиатура}
Begin
Label m1,m2,m3 , m4; {Опрос стрелок вверх=32,вниз=128, влево=64, вправо=16}
RgA:=0;
KeyDown:=RgA;
Keyleft:=RgA;
KeyUP:=RgA;
KeyRight:=RgA;
RgA:=247;
OUT_($D2);
IN_($D2);
RgA:= Not RgA;
RgA:=RgA and 240;
If RgA < 128 then goto m1;
KeyDown:=RgA;//{проба комментариев}#13+#10+
RgA:=RgA-128;{проба комментариев};;;;;;{и пустых ";"}}
{ТЕСТ}RgB:=RgA; RgB:=RgB+3; RgA:=RgB-3;
m1:
If RgA < 64 then goto m2;
Keyleft:=RgA;
RgA:=RgA-64;
m2:
If RgA < 32 then goto m3;
KeyUP:=RgA;
RgA:=RgA-32;
m3:
If RgA < 16 then goto m4;
KeyRight:=RgA;
m4:
end;

Procedure KeyO; {// Опрос основной клавиатуры}
Begin
RgA:=0;
KeyProtect:=RgA;
OUT_($D0);
IN_($D1);
RgA:=RgA xor 255;
KeyProtect:=RgA;
end;

{vDelay - переменная в которую необходимо передать значение задержки перед вызовом процедуры делай}
{// Задрежка В ВС- долю задержки}
Procedure Delay;
Label m1,m2,end_;
Begin
RpHL:=vDelay; {переменная в которую необходимо передать значение задержки перед вызовом процедуры делай}
m2:
RgA:=RgH;
If RgA <> 0 then goto m1;
RgA:=RgL;
If RgA <> 0 then goto m1;
Goto end_;
m1:
RpHL:=RpHL-1;
Goto m2;
End_:
end;


Procedure pRND4;
Label m1,m2,m3;
Begin
arnd4c:=arnd4c+1;
If RgA < 96 then goto m1;
arnd4c:=0;
m1:
RgB:=0;
RgC:=RgA;
.................
.................
.................
RpHL:=RpHL+RpBC;
RgA:=mem[RpHL];
RND4:=RgA;
end;


Procedure pRNDx30;
Label m1,m2;
Begin
RgA:=RNDx30;
RgA:=RgA+38;
m2:
If RgA < 30 then goto m1;
RgA:=RgA-30;
Goto m2;
m1:
RNDx30:=RgA;
end;


Procedure pRndy30;
Label m1,m2;
Begin
RgA:=RNDy30;
RgA:=RgA+37;
m2:
If RgA < 30 then goto m1;
RgA:=RgA-30;
Goto m2;
m1:
RNDy30:=RgA;
end;

Procedure pRNDx15;
Label m1, m2;
Begin
RgA:=RNDx15;
RgA:=RgA+23;
m2:
If RgA < 15 then goto m1;
RgA:=RgA-15;
Goto m2;
m1:
RNDx15:=RgA;
end;


Procedure pRndy15;
label m1,m2;
Begin
RgA:=RNDy15;
RgA:=RgA+24;
m2:
If RgA < 15 then goto m1;
RgA:=RgA-15; Goto m2;
m1:
RNDy15:=RgA;
end;

{// в HL -адрес ВОЗУ // рег d - цвет //пример MViH($40);MViL($10);Dr($10);}
Procedure DrawScreen8n8c;
Label loop;
Begin
{включить видеоОЗУ} RgA:=RgA xor RgA; OUT_($C2);
RgE:=8; {//Высота, это верхняя строчка}
RpBC:=63;
{// ВС:=63 Смещение 63 -для двух байтов}
Loop:
mem[RpHL]:=RgD;
RpHL:=RpHL+1;
mem[RpHL]:=RgD;
RpHL:=RpHL+RpBC;
RgE:=RgE-1;
IF RLO <> 0 then goto Loop;
{отключить видеоОЗУ}RgA:= 2; OUT_($C2);
end;

{// вывести Спрайт 8на 8}
{// в HL -адрес ВОЗУ (от $4000) // рег DE - область память // HLr($4001);DEr($F200);}
Procedure Sprite8n8c;
Label loop;
Begin
{включить видеоОЗУ} RgA:=RgA xor RgA; OUT_($C2);
RgB:=8;{//Высота, это верхняя строчка (MOV B,16),}
Loop:
RgA:=mem[rpDE];
mem[RpHL]:=RgA;
RpHL:=RpHL+1;
rpDE:=rpDE+1;
RgA:=mem[rpDE];
mem[RpHL]:=RgA;
RpHL:=RpHL+1;
rpDE:=rpDE+1;
pushDE;
rpDE:=62;
RpHL:=RpHL+rpDE;
popDE;
RgB:=RgB-1;{минусуем строку}
IF RLO <> 0 then goto Loop;
{отключить видеоОЗУ}RgA:= 2; OUT_($C2);
end;


{// вывести КОНКРЕТНЫЙ квадрат 8на 8 в конкретную ячейку цветом регС}
{// рег d - цвет Или спрайт //b- квадрат по X от 0-32 //с- квадрат по Y от 0-32}
Procedure DrawScreen;
Label m1,m2,m3,m4,m5,m6,m242,m243,m244,mz1,mz2;
Begin
RpHL:=16384;
pushDE;
RgA:=RgB;
If RgA= 0 then goto m3;
rpDE:=0;
RgA:=RgA+RgB;
RgE:=RgA;
RpHL:=RpHL+rpDE;
m3:
RgA:=RgC;
If RgA= 0 then goto m2;
pushHL;
.................
.................
.................
rpDE:=0;
RgA:=RgA+RgC;
RgE:=RgA;
RpHL:=RpHL+rpDE; {умножение с на 2 в регпаре BC}{mtabl+ смещение}
rpDE:=memW[RpHL]; //(regDE,act(RAVNO),arrW(RpHL_));//=DErmwHL;#13+#10+
popHL; {4000+B*2}
RpHL:=RpHL+rpDE; {+GetRgC*32*8*2));}
m2:
popDE;
RgA:=RgD;
If RgA <> 241 then goto m242;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC; +
Goto m5;{Человек}
m242:
If RgA <> 242 then goto m243;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC;
Goto m5;{клад обычный}
m243:
If RgA <> 243 then goto mz1;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC;
Goto m5;{Cупер-клад}
mz1:
If RgA <> 1 then goto mz2;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC;
Goto m5;{голова змеи}
mz2:
If RgA <> 2 then goto m244;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC; Goto m5; {голова змеи}
m244:
If RgA <> 244 then goto m4;
pushBC;
.................
.................
.................
Sprite8n8c;
popBC;
Goto m5; {голова змеи}
m4: DrawScreen8n8c;
m5:
end;


{//Вычислить адрес в оп нужной ячейки игрового поля}
{b- квадрат по X от 0-32 //с- квадрат по Y от 0-32 // HL - результат Адрес клетки того поля}
Procedure CalculateCellFeld;
Label m1,m2,m3;
Begin
pushDE;
.................
.................
.................
RgA:=RgB;
If RgA= 0 then goto m3;
rpDE:=0;
RgE:=RgA;
RpHL:=RpHL+rpDE;
m3:
RgA:=RgC;
If RgA= 0 then goto m2;
pushHL;
.................
.................
.................
rpDE:=0;
RgA:=RgA+RgC;
RgE:=RgA;
RpHL:=RpHL+rpDE;
rpDE:=memW[RpHL];
popHL;
RpHL:=RpHL+rpDE;
m2:
popDE;
end;

Procedure GetCellfield;
Begin
CalculateCellFeld;
RgA:=mem[RpHL];
end;

Procedure SetCellfield;
Begin
pushPSW;
CalculateCellFeld;
popPSW;
mem[RpHL]:=RgA;
end;


Procedure SetPoleAndDraw;
Label m0,m240,m1,m2,m241,m242,m243,m244,m239,End_ ;
Begin
pushBC;
SetCellfield;{//Установить значение клетки(ячейки) игрового поля}
popBC;
{0:проход} If RgA= 0 then goto m0;
{240:Стена} If RgA= 240 then goto m240;
{голова змеи1:} If RgA= 1 then goto m1;
{241:Человек} If RgA= 241 then goto m241;
{клад обычный242:} If RgA= 242 then goto m242;
{243:клад Супер} If RgA= 243 then goto m243;
{защита244:} If RgA= 244 then goto m244;
{Змея2..235:} If RgA > 2 then goto m2;
Goto end_;
m0:
{0:проход} RgD:=0; DrawScreen;
Goto end_;
m240: {240:Стена} RgD:=240; DrawScreen; Goto end_;
m1: {голова змеи1:} RgD:=1; DrawScreen; Goto end_;
m241:{241:Человек} RgD:=241; DrawScreen;
RgA:=0; SetCellfield; Goto end_;
m242: {клад обычный242:} RgD:=242; DrawScreen; Goto end_;
m243: {243:клад Супер} RgD:=243; DrawScreen; Goto end_;
m244: {защита244:} RgD:=244; DrawScreen; Goto end_;
m2:{Змея2..235:}
If RgA < 235 then goto end_;
m239:
RgD:=2; DrawScreen; Goto end_;
End_:
end;

Procedure GreenFullScreen;
Label m1,m2;
Begin
RgC:=0;
M2:
RgB:=0;
m1:
pushBC;
RgA:=240;
SetPoleAndDraw;
popBC;
RgB:=RgB+1;
RgA:=RgB;
If RgA <> 32 then goto m1;
RgC:=RgC+1;
RgA:=RgC;
If RgA <> 32 then goto m2;
end;


Procedure UserMovePosPaint;
Label m1,m2,m3,End_;
Begin
RgB:=UserXNew; RgA:=UserX;
.................
.................
.................

IF RgA <> RgB then goto m1;

RgB:=UserYNew; RgA:=UserY;
addToAssmTZVK(cmpB);
{GotoUn0(} IF RLO = 0 then goto end_;

m1:
FirstStart:=1; {// Движение было сделано}
RgB:=UserXNew; RgC:=UserYNew; RgA:=241; SetPoleAndDraw;{// Установить на поле уровня и начертить соотвественно}
RgB:=UserX; RgC:=UserY; RgA:=0;SetPoleAndDraw; {// Установить на поле уровня и начертить соотвественно}
UserX:=UserXNew; UserY:=UserYNew;
end_:
end;

Procedure SetPoleAndDraw_cut1;
Begin
DrawLevelPosX1:=RgA; RgB:=RgA;
RgC:=DrawLevelPosY1;
RgA:=0;
pushBC;
pushPSW;
SetPoleAndDraw;
popPSW;
popBC;
end;

Procedure SetPoleAndDraw_cut2;
Begin
DrawLevelPosY1:=RgA;
RgC:=RgA; RgB:=DrawLevelPosX1; RgA:=0;
pushBC; pushPSW; SetPoleAndDraw; popPSW; popBC;
pushBC; pushPSW; SetCellfield; popPSW; popBC;
DrawScreen;
end;

Procedure ReadaPole;
Begin
RpHL:=CurAdrPoleRead;
RgA:=mem[RpHL]; ReadPole:=RgA;
RpHL:=RpHL+1;
CurAdrPoleRead:=RpHL;
end;

Procedure DrawLevel;
Begin
Label Repeat1,m4180,m81120,m121160,m161200,mCase_,end_,until_,
m4180m1,m81120m1,m121160m1,m161200m1,m1,m2;
RgB:=1; RgC:=1; RgA:=0; SetPoleAndDraw; {ячейка старта человечка}
DrawLevelPosX1:=1; DrawLevelPosY1:=1;
ReadaPole;
DrawLevelD:=ReadPole; RgA:=DrawLevelD;
If RgA <> 0 then goto Repeat1;
ReadaPole; DrawLevelD:=ReadPole; RgA:=DrawLevelD;
If RgA <> 0 then goto Repeat1;
.................
.................
.................
ReadaPole; DrawLevelD:=ReadPole;
ReadaPole; DrawLevelD:=ReadPole;
Repeat1:
ReadaPole; DrawLevelD:=ReadPole;
If RgA= 0 then goto end_; {// концовка уровня}
{//Case// если не концовка уровня}
m4180: {41..80:{вправо}
RgA:=RgA-40;
If RgA > 40 then goto m81120;
RgB:=DrawLevelD-40;
m4180m1:
pushBC;
{Posx1=posx1+1} RgA:=DrawLevelPosX1; RgA:=RgA+1;
SetPoleAndDraw_cut1;
{Установить значение клетки(ячейки) игрового поля b- квадрат по X от 0-32 //с- квадрат по Y от 0-32 // A - результат значение в адрес того поля}
pushBC; pushDE;
SetCellfield;
popDE; popBC;
DrawScreen;
popBC;
RgB:=RgB-1;
IF RLO <> 0 then goto m4180m1;
Goto until_;
m81120: {81..120:{влево}
RgA:=RgA-40;
If RgA > 40 then goto m121160;
RgB:=DrawLevelD-80;
m81120m1:
pushBC;
{PosX1:=PosX1-1;}RgA:=DrawLevelPosX1; RgA:=RgA-1;
SetPoleAndDraw_cut1;
{Установить значение клетки(ячейки) игрового поля}
{//b- квадрат по X от 0-32 //с- квадрат по Y от 0-32}
{// A - результат значение в адрес того поля}
pushBC; pushPSW;
SetCellfield;
popPSW; popBC;
DrawScreen; popBC;
RgB:=RgB-1;
IF RLO <> 0 then goto m81120m1;
Goto until_;
m121160: {121..160:{вверх}
RgA:=RgA-40;
If RgA > 40 then goto m161200;
RgB:=DrawLevelD-120;
m121160m1:
pushBC;
RgA:=DrawLevelPosY1; RgA:=RgA-1;
SetPoleAndDraw_cut2;
popBC;
RgB:=RgB-1;
IF RLO <> 0 then goto m121160m1;
Goto until_;
m161200: {161..200:{вниз}
RgA:=RgA-40;
If RgA > 40 then goto Until_;
RgB:=DrawLevelD-160;
m161200m1:
pushBC;
RgA:=DrawLevelPosY1; RgA:=RgA+1;
SetPoleAndDraw_cut2;
popBC;
RgB:=RgB-1;
IF RLO <> 0 then goto m161200m1;
until_:
RgA:=DrawLevelD;
If RgA <> 0 then goto Repeat1;
end_:
end;


Procedure CountBonusPaint;
Label end_,m1,m2,m3,m4,m5,m6;
Begin
RgA:=CountBonus;
If RgA < 20 then goto m4;
RgA:=20;{//if wremb1>20 then wremb1:=20;}
m4:
RgB:=RgA; {BrA - копия для второй части ФОр}
m1: {Рисуем клады}
If RgA= 0 then goto m2;
pushBC; pushPSW;
RgB:=RgA+11;
RgC:=31; RgA:=242;
SetPoleAndDraw;
popPSW; popBC;
RgA:=RgA-1;
Goto m1;
M2: {Рисуем остальное - стенку}
RgA:=RgB; {востанавливаем в А=ACountBonus}
RgA:=RgA+1; RgB:=20;
M5:);
addToAssmTZVK(cmpB);

IF RLO = 0 then goto m6;
IF RLO > 0 then goto m6;
pushBC; pushPSW;
RgB:=RgA+11; RgC:=31; RgA:=240; SetPoleAndDraw;
popPSW; popBC;
RgA:=RgA+1; Goto m5;
M6: { Пройден ли уровень}
.................
.................
.................
RgA:=CountBonus;
If RgA < 20 then goto end_;
ConditionOfPlay:=110;
End_:
end;

Procedure SBonusDel;
Label m1,m2,m3,m4;
Begin
pRndy30;
{ STAsBonusWaitTimer(400+(LDALevel*10)+LDARndY30);// ожидание создания }
RpHL:=0; RgL:=Level;
RpHL:=RpHL+RpHL; RpHL:=RpHL+RpHL; RpHL:=RpHL+RpHL; {LDALevel*8}
RpBC:=0; RgC:=RNDy30;
RpHL:=RpHL+RpBC;
RpBC:=500;{//!!! 500=40сек Таймер созадния призов}
RpHL:=RpHL+RpBC;
sBonusWaitTimer:=RpHL;
{Получить значение клетки(ячейки) поля}
RgB:=SBonusX; RgC:=SBonusY; GetCellfield;
If RgA <> 243 then goto m1;
RgB:=SBonusX; RgC:=SBonusY; RgA:=0; SetPoleAndDraw;
m1: {//else// если на той клеточке не змея}
If RgA <> 0 then goto m2;
RgB:=UserX; RgA:=SBonusX;
.................
.................
.................
IF RLO = 0 then goto m2;
RgB:=UserY; RgA:=SBonusY;
.................
.................
.................
IF RLO = 0 then goto m2;
RgB:=SBonusX; RgC:=SBonusY; RgA:=0; SetPoleAndDraw;
{// Установить на поле уровня и начертить соотвественно}
m2:
SBonusX:=0;
end;

Procedure ProcesPressedKeys;
Label mM2,m1m1,m2,m2m1,m3,m3m1,m4,m4m1,mm21,mM3,
mm4,mm31,mm32,mm33,mm41,mm42,mm43,mm44,mm5,mm6,mm7,mm8,mm9,mm10,end_,
mm11,mm12;
Begin
UserXNew:=UserX; UserYNew:=UserY; KeyT:=0; RgA:=Keyleft;
If RgA= 0 then goto m2;
{Получить значение клетки(ячейки) поля}
RgB:=UserXNew-1; RgC:=UserYNew; GetCellfield;
If RgA= 0 then goto m1m1;
If RgA= 242 then goto m1m1;
If RgA <> 243 then goto mm2;
m1m1:
KeyT:=1;
Goto mm2;
M2:
RgA:=KeyRight;
If RgA= 0 then goto m3;
{Получить значение клетки(ячейки) поля}
RgB:=UserXNew+1; RgC:=UserYNew; GetCellfield;
If RgA= 0 then goto m2m1;
If RgA= 242 then goto m2m1;
If RgA <> 243 then goto mm2;
m2m1:
KeyT:=2;
Goto mm2;
M3:
RgA:=KeyUP;
If RgA= 0 then goto m4;
RgB:=UserXNew; RgC:=UserYNew-1; GetCellfield;
If RgA= 0 then goto m3m1;
If RgA= 242 then goto m3m1;
If RgA <> 243 then goto mm2;
m3m1:
KeyT:=3;
Goto mm2;
M4:
{4}RgA:=KeyDown;
If RgA= 0 then goto mm2;
RgB:=UserXNew; RgC:=UserYNew+1; GetCellfield;
If RgA= 0 then goto m4m1;
If RgA= 242 then goto m4m1;
If RgA <> 243 then goto mm2;
m4m1:
KeyT:=4;
mM2:
RgA:=KeyT;
If RgA > 3 then goto mm21;
pRNDx30;
Goto mm3;
mm21:
pRndy30;
mM3:
RgA:=Key1;
If RgA <> 0 then goto mm31;
Key1:=KeyT;
Goto mm32;
mm31:
Key2:=KeyT; {если не задано направление движения}
mm32:
RgA:=Key2;
If RgA= 0 then goto mm4;
Key1:=Key2;
mm4:
{case GetKey1 of}RgA:=Key1;
If RgA= 1 then goto mm41;
If RgA= 2 then goto mm42;
If RgA= 3 then goto mm43;
If RgA <> 4 then goto mm5;
{4:} UserYNew:=UserY+1;
Goto mm5;
mm41:
{1:} UserXNew:=UserX-1;
Goto mm5;
mm42:
{2:} UserXNew:=UserX+1;
Goto mm5;
mm43:
{3:} UserYNew:=UserY-1;
mm5:
{Получить значение ячейки поля}
RgB:=UserXNew; RgC:=UserYNew; GetCellfield;
ProcesPressedKeysFPole:=RgA;
If RgA <> 242 then goto mm6;
UserMovePosPaint;{перерисовка новой позиции юзера}
CountBonus:=CountBonus+1;
CountBonusPaint;{// вывести на экран кол-во съеденых кладов}
.................
.................
.................
CountPrizezSpectacleses:=CountPrizezSpectacleses+1;{Счёт Очков для призовой жизни}
SnakeCurMaxLength:=SnakeCurMaxLength+1;{// рост змеи}
GradualDeEmphasDelay; {//Постепенное уменьшение значения задержки vDelay}
mm6:
RgB:=UserX;{Если Суперклад}
RgA:=SBonusX;
.................
.................
.................

IF RgA <> RgB then goto mm7;
RgB:=UserY; RgA:=SBonusY;

IF RgA <> RgB then goto mm7;
{Если человек сїел супер клад} CountBonus:=CountBonus+10;
CountBonusPaint;{// вывести на экран кол-во съеденых кладов}
RgA:=CountSpectacleses;{//regA,act(RAVNO),arrB(aCountSpectacleses));}
RgB:=10; RgA:=RgA+RgB;
CountSpectacleses:=RgA;
SBonusDel;{// Уничтожить супер клад поставить на таймер}
GradualDeEmphasDelay;{//Постепенное уменьшение значения задержки vDelay}
mm7: {/// "Защита" не препятствие себе!!!!{FPole=244=защита or});
.................
.................
.................

IF RLO <> 0 then goto mm8;
.................
.................
.................

IF RLO <> 0 then goto mm8;
ProcesPressedKeysFPole:=0;
mm8:
RgA:=ProcesPressedKeysFPole;
If RgA= 0 then goto mm9;
If RgA= 242 then goto mm9;
If RgA <> 243 then goto mm10;
mm9: {Можно быть на этой клеточке}
UserMovePosPaint;{перерисовка новой позиции юзера}
Goto end_;
mm10:{нельзя быть на клеточке}
Key1:=0;
end_:
end;

Procedure SnakeCreateIllusoryPurpose1;
Label m1,end_;
Begin
RgA:=IllusoryPurposeWaitTimer;
If RgA= 0 then goto m1;
IllusoryPurposeWaitTimer:=IllusoryPurposeWaitTimer-1;
Goto end_;
M1:
pRNDx15; pRndy15; SnakepurposeX:=RNDx15+15; SnakepurposeY:=RNDy15+15;
IllusoryPurposeWaitTimer:=10;
end_:
end;


Procedure SnakeCreateIllusoryPurpose2;
Label m1,end_;
Begin
RgA:=IllusoryPurposeWaitTimer;
If RgA= 0 then goto m1;
IllusoryPurposeWaitTimer:=IllusoryPurposeWaitTimer-1;
Goto end_;
M1:
pRNDx30; pRndy30; SnakepurposeX:=RNDx30; SnakepurposeY:=RNDy30;
IllusoryPurposeWaitTimer:=50;
end_:
end;


Procedure ProcesPressedSnake1;
Label m1,m2,m3,m4,m5,m6,m7,m8,m9,m10,m11,m12,m13;
Begin
SnakeCut:=0;{//1-Был срез змеи, 0 - небыло}
.................
.................
.................
rpDE:=0;
M4:
RgA:=mem[RpBC];
If RgA < 1 then goto m2;
M3:
If RgA < 128 then goto m1;
Goto m2;
M1:
pushAll;
RgA:=RgD;
ProcesPressedSnake1wremX:=RgA;
RgA:=RgE;
ProcesPressedSnake1wremY:=RgA;
RgA:=SnakeX;
RgA:=RgA-RgD;
IF RLO <> 0 then goto m6;
RgA:=SnakeY; RgA:=RgA-RgE;
IF RLO = 0 then goto m5;
M6:
PopALL; RgA:=RgA+1;
mem[RpBC]:=RgA; PushALL;
If RgA <> 2 then goto m9;
RgB:=ProcesPressedSnake1wremX; RgC:=ProcesPressedSnake1wremY;
RgA:=2;{Если 2 перечертить (из 1-головы змеи получилась}
SetPoleAndDraw;{Установить на поле уровня и начертить соотвественно}
M9:
RgD:=RgA;
RgA:=SnakeCurLength;
.................
.................
.................

If RLO > 0 then goto m5; RgA:=SnakeMixCut;
.................
.................
.................
If RLO >= 0 then goto M13;
RgD:=RgA; SnakeMixCut:=RgA;
M13:
RgB:=ProcesPressedSnake1wremX;RgC:=ProcesPressedSnake1wremY;RgA:=0;
SetPoleAndDraw;{// Установить на поле уровня и начертить соотвественно}
SnakeCut:=1;{//Был срез змеи}
M5:
popALL;
m2:
RpBC:=RpBC+1; RgD:=RgD+1; RgA:=RgD;
If RgA < 32 then goto m4;
RgD:=0; RgE:=RgE+1; RgA:=RgE;
If RgA < 32 then goto m4;
end;

Procedure Protect_Del;
Label m01;
Begin
.................
.................
.................
IF RLO = 0 then goto m01;
RgB:=ProtectX; RgC:=ProtectY; RgA:=0; SetPoleAndDraw; Protectx:=0;
m01:
GradualDeEmphasDelay;{Постепенное уменьшение значения задержки vDelay}end;


Procedure ProcesPressedProtect;
Label else01,end01,else02,end02,then03,else03,end03,end_;
Begin
.................
.................
.................
IF RLO <> 0 then goto else01;{// If LDAProtectX=0 then begin// если защита не установлена});
.................
.................
.................
IF RLO = 0 then goto end01;{ если нажата защита}
ProtectDRT:=10; {// длительность}
ProtectX:=Userx; ProtectY:=UserY;
else01: {// если защита установлена}
{несовпадения кординат с юзером}
.................
.................
.................

IF RLO <> 0 then goto then03;
.................
.................
.................


IF RLO <> 0 then goto then03;
Goto Else03;
Then03:
RgB:=ProtectX; RgC:=ProtectY; RgA:=244; SetPoleAndDraw; // Установить на поле уровня и начертить соотвественно
GradualDeEmphasDelay;{//Постепенное уменьшение значения задержки vDelay}
.................
.................
.................
IF RLO <> 0 then goto else03;
Protect_Del;
else03:
end03:
end01:
end;


Procedure pCheckingCoordinates;
Label else01,end01;
Begin
CheckingCoordinates:=0; pRNDx30; pRndy30; RgB:=RNDx30; RgC:=RNDy30; GetCellfield;
{Получить значение клетки(ячейки) поля}
If RgA <> 0 then goto else01;

.................
.................
.................
IF RLO = 0 then goto else01;
.................
.................
.................
IF RLO = 0 then goto else01;
.................
.................
.................
IF RLO = 0 then goto else01;
.................
.................
.................
IF RLO = 0 then goto else01;
.................
.................
.................
IF RLO = 0 then goto else01;
.................
.................
.................
IF RLO = 0 then goto else01;
CheckingCoordinates:=1; { // доступно (для создания клада)}
Goto end01;
else01:
CheckingCoordinates:=0;
end01:
end;

Procedure ProcesPressedBonus;
Label then01,else01,end01,then02,else02,end02,then03,else03,end03,
m01,m02,m03,m04,m05;
Begin
);
.................
.................
.................

IF RLO <> 0 then goto m01;
.................
.................
.................


IF RLO <> 0 then goto m01;
BonusX:=0; BonusY:=0;{// клад съеден}
m01:

.................
.................
.................

IF RLO <> 0 then goto else02;
.................
.................
.................


IF RLO = 0 then goto else03;
{Проверка координат на совпадений с другими элементами игры}
pCheckingCoordinates; RgA:=CheckingCoordinates;
If RgA= 0 then goto else01;
Bonusx:=RNDx30; Bonusy:=RNDy30; RgB:=Bonusx; RgC:=Bonusy;
RgA:=242; SetPoleAndDraw;{ Установить на поле уровня и начертить соотвественно}
Goto end01;
else01:
BonusX:=0; BonusY:=0;
end01: {//EndПроверка координат на совпадений с другими элементами игры}
else03:
Goto end02;
else02:
RgB:=Bonusx;
RgC:=Bonusy; RgA:=242; SetPoleAndDraw;
{// Установить на поле уровня и начертить соотвественно}
end02:
end;

Procedure SBonusCreate;
Begin
SBonusX:=RNDx30; SBonusY:=RNDy30;
RgB:=SBonusX; RgC:=SBonusY; RgA:=243; SetPoleAndDraw;
{ Установить на поле уровня и начертить соотвественно}
pRndy30;
RgB:=Level; RgC:=RNDy30; RgA:=150-RgB; RgA:=RgA-RgC;
sBonusWaitDone:=RgA; SBonusSp:=1; sBonusDLSp:=10;
end;


Procedure SBonusFash;
label the01,else01,end01, the02,else02,end02, the03,else03,end03;
Begin
.................
.................
.................

IF RLO <> 0 then goto else01;
sBonusDLSp:=5;
.................
.................
.................

IF RLO <> 0 then goto else02;
sBonusSp:=1;
Goto end02;
else02:
sBonusSp:=0;{Спрайт либо потух}
end02:
Else01:
.................
.................
.................
IF RLO <> 0 then goto else03;
RgB:=SBonusX; RgC:=SBonusY; RgA:=0; SetPoleAndDraw;
Goto end03;
else03:
RgB:=SBonusX; RgC:=SBonusY; RgA:=243; SetPoleAndDraw;
end03:
end;

Procedure ProcesPressedSBonus;
Label then01,else01,end01,then02,else02,end02,then03,else03,end03,
then04,else04,end04,then05,else05,end05,then06,else06,end06,m01,m02;
Begin
.................
.................
.................

IF RLO = 0 then goto end02;
.................
.................
.................
IF RLO <> 0 then goto end03;
{если таймер создания неравен 0 } RpHL:=sBonusWaitTimer; RgA:=RgH;
If RgA <> 0 then goto m01;
RgA:=RgL;
If RgA <> 0 then goto m01;
Goto else04;
m01:
.................
.................
.................
Goto end04;{//если не равно нулю минус один}
else04: {// если таймер равно нулю}
{// если время истекло надо создать}
pCheckingCoordinates;{проверить кардинаты что нет совпадений с другими елементами}
RgA:=CheckingCoordinates;
If RgA= 0 then goto else01;
then01:
SBonusCreate;
Goto End01; {// Созать и сделать установки}
else01:
sBonusX:=0; {несоздавать}
end01:
end04:
End03:
.................
.................
.................
IF RLO = 0 then goto end05;
RgA:=0;
RpHL:=sBonusWaitDone;
.................
.................
.................
IF RgA <> RgH then goto else06;
.................
.................
.................
IF RgA <> RgL then goto else06;
SBonusDel; {Уничтожить супер клад поставить на таймер}
Goto end06;
else06:
.................
.................
.................
SBonusFash; {//мигание клада}
end06: {// Если супер клад создан}
end05:
end02:
end;

Procedure CountUserPaint;
Label While01,WhileEnd01, m1,m2,Repeat01,Until01,Repeat02,Until02;
Begin
RgA:=Life;
If RgA < 10 then goto m1;
RgA:=10;
m1:
RgC:=RgA;
If RgA= 0 then goto m2;
{Шаблон Repeat}{===============================}
RgB:=RgA; RgA:=0;
Repeat01:
pushBC; pushPSW;
RgB:=RgA; RgC:=31; RgA:=241; SetPoleAndDraw;
popPSW; popBC;
Until01:
RgA:=RgA+1;
.................
.................
.................
IF RLO < 0 then goto Repeat01;
m2:{Шаблон Repeat}{===============================}
RgA:=RgC;
RgB:=11;
Repeat02:
pushBC; pushPSW;
RgB:=RgA; RgC:=31; RgA:=240; SetPoleAndDraw;
popPSW; popBC;
Until02:
RgA:=RgA+1;
.................
.................
.................
IF RLO < 0 then goto Repeat02;
end;


Procedure ProcesPressedPrizeLife;
Label m01;
Begin
{ сколько нужно кладов для появления призовой жизни}
.................
.................
.................
IF RLO < 0 then goto m01;
Life:=Life+1;{Призовая жизнь дается}
.................
.................
.................
CountUserPaint;
M01:
end;

Procedure ForCase0;
Label c00_then01,c00_then01_,c00_end01;
Begin
{ //Получить значение клетки(ячейки) поля}
RgB:=SnakeX-1; RgC:=SnakeY; GetCellfield;
If RgA= 241 then goto c00_then01;
If RgA= 243 then goto c00_then01;
If RgA= 244 then goto c00_then01_;
If RgA= 0 then goto c00_then01;
Goto c00_end01;
c00_then01:
.................
.................
.................
Goto c00_end01;
c00_then01_:
SnakeFromProtect:=1;
c00_end01:
end;

Procedure ForCase1;
Label c01_then01,c01_then01_,c01_end01;
Begin
RgB:=SnakeX+1; RgC:=SnakeY; GetCellfield;
If RgA= 241 then goto c01_then01;
If RgA= 243 then goto c01_then01;
If RgA= 244 then goto c01_then01_;
If RgA= 0 then goto c01_then01;
Goto c01_end01;
c01_then01:
SnakeXnew:=SnakeX+1;
Goto c01_end01;
c01_then01_:
SnakeFromProtect:=1;
c01_end01:
end;

Procedure ForCase2;
Label c02_then01,c02_then01_,c02_end01;
Begin
RgB:=SnakeX; RgC:=SnakeY+1; GetCellfield;
If RgA= 241 then goto c02_then01;
If RgA= 243 then goto c02_then01;
If RgA= 244 then goto c02_then01_;
If RgA= 0 then goto c02_then01;
Goto c02_end01;
c02_then01:
SnakeYnew:=SnakeY+1;
Goto c02_end01;
c02_then01_:
SnakeFromProtect:=1;
c02_end01:
end;



Procedure ForCase3;
Label c03_then01,c03_then01_,c03_end01;
Begin
RgB:=SnakeX;
.................
.................
.................
GetCellfield;
If RgA= 241 then goto c03_then01;
If RgA= 243 then goto c03_then01;
If RgA= 244 then goto c03_then01_;
If RgA= 0 then goto c03_then01;
Goto c03_end01;
c03_then01:
.................
.................
.................
Goto c03_end01;
c03_then01_:
SnakeFromProtect:=1;
c03_end01:
end;



Procedure WindTimerOfGrowingSnake;
Begin
{STASnakeTimerLength(150-(LDALevel)-LDARndx30);}
pRNDx30; RgB:=Level; RgC:=RNDx30; RgA:=150-RgB;{150=10сек}
RgA:=RgA-RgC; RpHL:=0; RgL:=RgA;
// RgL:=10;{Змея ростёт как на дрождях :-)}#13+#10+
SnakeTimerLength:=RpHL;
end;

Procedure IncreaseSnake;
Label then01,else01,end01,end02,end03,then04,else04,end04, end05, end06;
Begin
.................
.................
.................
IF RLO <> 0 then goto then01;
.................
.................
.................
IF RLO <> 0 then goto then01;
else01:
SnakeDeadend:=1;{если стоим на месте в тупике}
Goto end01;
then01:
RgB:=SnakeXnew; RgC:=SnakeYnew; RgA:=1; SetPoleAndDraw;
SnakeX:=SnakeXnew; SnakeY:=SnakeYnew;
{Увеличение змеи}
.................
.................
.................
IF RLO = 0 then goto end02;
.................
.................
.................
IF RLO <> 0 then goto end03;
WindTimerOfGrowingSnake; {Завести таймер роста змеи}
.................
.................
.................
//{GotoUnPlus(}addToSectCODEid_(JP,else04);

IF RLO > 0 then goto else04;
SnakeCurMaxLength:=SnakeCurMaxLength+1;{// рост Змеи +1}
GradualDeEmphasDelay;{Постепенное уменьшение значения задержки vDelay}
Goto end04;
else04:
SnakeCurMaxLength:=119; {// Ограничение змеи}
end04:
end03:
end02:
SnakeDeadend:=0; {// Не в тупике}
end01:
ProcesPressedSnake1;{Обработка Змеи по всему лабиринту}
.................
.................
.................

IF RLO <> 0 then goto end05;
.................
.................
.................

IF RLO = 0 then goto end05;
.................
.................
.................

IF RLO <> 0 then goto end05;
.................
.................
.................
end05:
.................
.................
.................
IF RLO <> 0 then goto end06;
.................
.................
.................
IF RLO = 0 then goto end06;
.................
.................
.................
If RLO <= 0 then goto end06;
SnakeCurLength:=SnakeCurLength+1; {рост Змеи +1}
end06:
end;

procedure ProcesPressedSnake_part1;
Label then01,else01,end01,then02,else02,end02,then03,else03,end03;
Begin
SnakeXnew:=SnakeX; SnakeYnew:=SnakeY; SnakeFromProtect:=0;
.................
.................
.................
IF RLO <> 0 then goto else01; { // Движение Не было сделано}
SnakepurposeXFrom:=2;
.................
.................
.................
IF RLO <> 0 then goto else02;
SnakeCreateIllusoryPurpose2; Goto end02;
else02:
SnakeCreateIllusoryPurpose1; {//Мнимая цель, 1 раз в 3 сек создавать мнимую цель пока небыло движения}
end02:
Goto end01;
else01:
{ // Движение было сделано}
{куда цель}//purposeXFrom:Byte;// на кого цель 0-участник, 1- супер клад, 2 - мнимая
{if LDAsBonusx=0 then}
.................
.................
.................
IF RLO <> 0 then goto else03;
SnakepurposeXFrom:=0; SnakepurposeX:=Userx; SnakepurposeY:=Usery;
Goto end03;
else03:
SnakepurposeXFrom:=1; SnakepurposeX:=sBonusx; SnakepurposeY:=sBonusY;
end03:
end01:
end;

procedure ProcesPressedSnake_part2;
Label Repeat01,until01,Case01_1,Case01_2,Case01_3,Case01end,
Case01_0End,Case01_1End,Case01_2End,Case01_3End;
Begin
SF:=0;
Repeat01: {// основные движения змею}
pRND4; RgA:=RND4;
If RgA <> 0 then goto Case01_1;
.................
.................
.................

If RLO <= 0 then goto Case01_0End;
ForCase0;
Case01_0End:
Goto Case01_1End;
Case01_1:
If RgA <> 1 then goto Case01_2;
.................
.................
.................
If RLO>=0 then goto Case01_1End;
ForCase1;
Case01_1End:
Goto Case01_2End;
Case01_2:
If RgA <> 2 then goto Case01_3;
.................
.................
.................
If RLO > 0 then goto Case01_2End;
IF RLO = 0 then goto Case01_2End;
ForCase2;
Case01_2End:
Goto Case01_3End;
Case01_3:
If RgA <> 3 then goto Case01_3end;
.................
.................
.................
If RLO <= 0 then goto Case01End;
ForCase3;
Case01_3End:
Case01end:
.................
.................
.................
IF RLO = 0 then goto Until01;
.................
.................
.................
IF RLO <> 0 then goto Until01;
.................
.................
.................
IF RLO <> 0 then goto Until01;
Goto Repeat01;
Until01:
end;

procedure ProcesPressedSnake_part3;
Label end01,repeat01,until01,Case01_1,
Case01_2,Case01_3,Case01end,Case01end_0,Case01end_1,Case01end_2,Case01end_3;
Begin
.................
.................
.................
IF RLO <> 0 then goto end01;
.................
.................
.................
IF RLO <> 0 then goto end01;
{ // Дополнительные движения змею}
SF:=0;
repeat01:
pRND4; RgA:=RND4;
If RgA <> 0 then goto Case01_1;
.................
.................
.................
ForCase0;
Goto Case01End;
Case01end_0: Goto Case01end_1;
Case01_1:
If RgA <> 1 then goto Case01_2;
.................
.................
.................
ForCase1; Goto Case01End;
Case01end_1: Goto Case01end_2;
Case01_2:
If RgA <> 2 then goto Case01_3;
.................
.................
.................
ForCase2; Goto Case01End;
Case01end_2: Goto Case01end_3;
Case01_3:
If RgA <> 3 then goto Case01end;
.................
.................
.................
ForCase3;
Case01end_3: Goto Case01end;
Case01end:
.................
.................
.................

IF RLO = 0 then goto until01;
.................
.................
.................
IF RLO <> 0 then goto until01;
.................
.................
.................
IF RLO <> 0 then goto until01;
Goto Repeat01;
until01:
end01:
end;

procedure ProcesPressedSnake;
Label M01,M02, then02,end02, Case01_1,Case01_2,
Case01_3,Case01end,Case01_0End,Case01_1End,Case01_2End,
Case01_3End, else03,end03, then04,else04,end04,
then05,else05,end05,then06,else06,end06;
Begin
{//Обработка Змеи} ProcesPressedSnake_part1;
ProcesPressedSnake_part2;
ProcesPressedSnake_part3;
IncreaseSnake;{Увеличение змеи}
{ // Достиг цели//purposeXFrom:Byte;// на кого цель 0-участник, 1- супер клад, 2 - мнимая}
{Съел юзера}
.................
.................
.................
IF RLO <> 0 then goto end02;
.................
.................
.................
IF RLO <> 0 then goto end02;
then02:
RpBC:=65528; Delay;{// Задкржка!!! Некартное 4}
ConditionOfPlay:=100;
end02:
.................
.................
.................

IF RLO <> 0 then goto Else06;
.................
.................
.................

IF RLO <> 0 then goto Else06;
Case01_1:
rgA:=SnakepurposeXFrom;
If RgA <> 1 then goto Case01_1end;
SBonusDel;
.................
.................
.................
If RLO>=0 then goto else03;
CountBonus:=0;
Goto end03;
else03:
.................
.................
.................
end03:
{минусовка призов при змея бонус-клад} RpHL:=CountSpectacleses;
RgA:=RgH;
If RgA <> 0 then goto else04;
RgA:=RgL;
If RgA>=11 then goto else04;
CountSpectacleses:=0;
Goto end04;
else04:
RpHL:=CountSpectacleses;
RpHL:=RpHL-10;{// минус за съеденный змеёй супер-клад}
CountSpectacleses:=RpHL;
end04:
{Счёт Очков для призовой жизни}
RgA:=CountPrizezSpectacleses;
Rg1_cmp_CB(rgA,tb(11));

If RLO>=0 then goto M01;
CountPrizezSpectacleses:=0;
Goto M02;
M01:
.................
.................
.................
M02:{Счёт Очков для призовой жизни}
CountBonusPaint; {// вывести на экран кол-во съеденых кладов}
{Cъели супер клад поставить на таймер}
Case01_1End: Goto Case01End;
Case01_2:
If RgA <> 2 then goto Case01_2end;
IllusoryPurposeWaitTimer:=0;
.................
.................
.................
IF RLO <> 0 then goto Else05;
SnakeCreateIllusoryPurpose2; Goto end05;
else05:
SnakeCreateIllusoryPurpose1;
end05:
Case01_2End:
Goto Case01End;
Case01end:
else06:
end06:
end;

Procedure ClearKeyboardArrows;
Begin
RgA:=0; Keyleft:=RgA; KeyRight:=RgA; KeyUP:=RgA; KeyDown:=RgA;
KeyProtect:=RgA; KeyT:=RgA; Key1:=RgA; Key2:=RgA;
end;

{!!!! Страннно!!! Ничего не вызывает эту процедуру}
//установить в SDelay{word}, процедурой SetSDelay приплюсовка SDelay к GDelay}
Procedure SetSDelay;
Begin
RpBC:=SDelay; RpHL:=GDelay; RpHL:=RpHL+RpBC; GDelay:=RpHL;SDelay:=0;
end;
{!!!! Страннно!!! Ничего не вызывает эту процедуру}

Procedure GradualDeEmphasDelay;
Label m1,m2,m3,m4,End_;
Begin RpHL:=GDelay;
RgA:=RgH;
If RgA <> 0 then goto m1;
RgA:=RgL;
If RgA <> 0 then goto m1;
Goto end_;
M1:
RpHL:=RpHL-1;
GDelay:=RpHL; RpHL:=vDelay;
{HL = 0 ?}
RgA:=RgH;
If RgA <> 0 then goto m2;
RgA:=RgL;
If RgA <> 0 then goto m2;Goto end_;
M2:
RpHL:=RpHL-1;
vDelay:=RpHL;
End_:
end;

procedure Zastavka1;
Label m1,m2,m3,m4,m5,m6;
Begin
{по горизонтали}
M2:
RgB:=5;
m1:
pushBC; RgC:=5; RgA:=240; SetPoleAndDraw;
popBC; pushBC;
RgC:=25; RgA:=240; SetPoleAndDraw;
popBC; RgB:=RgB+1; RgA:=RgB;
If RgA <> 27 then goto m1;
{по Вертикали}
M4: RgC:=5;
m3:
pushBC;
RgB:=5; RgA:=240; SetPoleAndDraw;
popBC; pushBC;
RgB:=26; RgA:=240; SetPoleAndDraw;
popBC; RgC:=RgC+1; RgA:=RgC;
If RgA <> 25 then goto m3;
{по горизонтали замазка для первого уровня}
M6:
RgB:=19;
m5:
pushBC; RgC:=3; RgA:=240; SetPoleAndDraw;
popBC; RgB:=RgB+1; RgA:=RgB;
If RgA <> 25 then goto m5;
end;

procedure Zastavka2;
Label m1,m2;
Begin
RgC:=6;{// позиция вертикаь}
M2:
RgB:=6;{// позиция горизонталь}
m1:
pushBC; RgA:=0; SetPoleAndDraw; popBC;
RgB:=RgB+1; RgA:=RgB;
If RgA <> 26 then goto m1;
RgC:=RgC+1; RgA:=RgC;
If RgA <> 25 then goto m2;
end;

procedure Zastavka3;
Label m1,m2,m3,m4;
Begin
{по горизонтали}
M2: RgB:=4; {// позиц по икс}
m1:
pushBC; RgC:=4;{// вертикаль}
RgA:=0;{// тип зарисовки "пустота"}
SetPoleAndDraw;
popBC; pushBC;
RgC:=26; RgA:=0; SetPoleAndDraw;
popBC; RgB:=RgB+1; RgA:=RgB;
If RgA <> 27 then goto m1;
{по Вертикали}
M4: RgC:=4;
m3:
pushBC; RgB:=4; RgA:=0; SetPoleAndDraw;
popBC; pushBC;
RgB:=27; RgA:=0; SetPoleAndDraw;
popBC; RgC:=RgC+1; RgA:=RgC;
If RgA <> 27 then goto m3;
end;

procedure Zastavka4;
Label m1,m2,m3,m4,m5,m6;
Begin
RgB:=8; RgC:=3; RgA:=240; SetPoleAndDraw;
RgB:=9; RgC:=3; RgA:=240; SetPoleAndDraw;
RgB:=14; RgC:=3; RgA:=240; SetPoleAndDraw;
RgB:=15; RgC:=3; RgA:=240; SetPoleAndDraw;
RgB:=28; RgC:=5; RgA:=240; SetPoleAndDraw;
RgB:=3; RgC:=13; RgA:=240; SetPoleAndDraw;
RgB:=3; RgC:=14; RgA:=240; SetPoleAndDraw;
RgB:=5; RgC:=27; RgA:=240; SetPoleAndDraw;
RgB:=6; RgC:=27; RgA:=240; SetPoleAndDraw;
RgB:=14; RgC:=26; RgA:=240; SetPoleAndDraw;
RgB:=28; RgC:=11; RgA:=240; SetPoleAndDraw;
RgB:=28; RgC:=12; RgA:=240; SetPoleAndDraw;
RgB:=28; RgC:=13; RgA:=240; SetPoleAndDraw;
end;

procedure Levelinit;
Begin
SBonusDel;
BonusX:=0; BonusY:=0;{// обнуление бонус-клада}
Protect_Del;
ProtectX:=0; ProtectY:=0;{// удаление защиты}
GreenFullScreen; {// очистка поля и зелёный экран}
CountBonus:=0;{//Счет кладов}
CurAdrPoleRead:=CurAddrLevel;{//Установка позиции данных уровня на текущий уровень}
DrawLevel;{Начертить очередной уровень}
CountUserPaint;{// вывести на экран кол-во Попыток// В задержку}
{Змея}
WindTimerOfGrowingSnake;{//Завести таймер роста змеи}
SnakeCurMaxLength:=2; SnakeCurLength:=2;
SnakepurposeX:=30; SnakepurposeY:=29; {// начальная мнимая цель}
SnakeX:=30; SnakeY:=29;{// начальное положение змеи}
RgB:=SnakeX; RgC:=SnakeY; RgA:=1;SetPoleAndDraw;
{// начертить змею (голову)}
FirstStart:=0;{ 0 первый пуск, если не началось движение цель змеи мнимая}
ClearKeyboardArrows;{//Очистка клавиатуры (стрелки)}
vDelay:=1700;{// Начальная задержка}
end;

procedure rndS; { 111 Прокрутка всех рнд для улучшения случайности}
Begin
pRNDx30; pRndy30; pRNDx15; pRndy15;
end;

Procedure Proba;
Begin
{.................
.................
.................}
end;

Procedure InitGame;
Begin
CurAdrPoleRead:=0;{ поставить курсор в начало Данных уровней}
CurAddrLevel:=0;
protectPast:=1;{Если 0 - то через защиту можно проходить, 1 - как заслонка для юзера}
RpHL:=0;
CountSpectacleses:=RpHL;{//Счёт Очков}
CountPrizezSpectacleses:=0;{// Счёт Очков для призовой жизни}
Life:=4;{//колво попыток И + одна текущая}
Level:=1;{// номер Текущего уровня}
end;

Procedure Pause;
Label m1,m2;
Begin
rndS;{// Прокрутка всех рнд для улучшения случайности}
RgA:=239;{ 11101111 = EF}
OUT_($d0);
IN_($D1);
If RgA <> 127 then goto m2;
RgA:=fPause; RgB:=255; RgA:=RgA xor RgB; fPause:=RgA;
M1:
RgA:=239; { 11101111 = EF}
OUT_($D0);
IN_($D1);
If RgA= 127 then goto m1;
M2:
end;

Procedure Color;
Label m1,m2;
Begin
RgA:=239;{ 11101111 = EF}
OUT_($D0);
IN_($D1);
If RgA <> 191 then goto m2;
{Цвет}
RgB:=dColor; RgA:=4; RgA:=RgA+RgB; dColor:=RgA;
OUT_($C1);
M1:
RgA:=239;{ 11101111 = EF}
OUT_($D0);
IN_($D1);
If RgA= 191 then goto m1;
M2:
end;

Procedure StartOrMenu;
Label m1,m2,m3,m4;
Begin
RgA:=239;
OUT_($D0);
IN_($D1);
If RgA <> 223 then goto m2;
{Старт или меню}
.................
.................
.................
IF RLO = 0 then goto m3;
ConditionOfPlay:=0; {//Меню}
Goto m1;
M3:
ConditionOfPlay:=15;{//Старт игры}
M1:
RgA:=239;
OUT_($D0);
IN_($D1);
If RgA= 223 then goto m1;
M2:
end;


procedure EngineGames; {Двигатель игры}
Label m0,m3,m4,m14,m15,m20,m30,m100,m110, Case_,m100_1,m100_2,m100_3,
m20_1,m20_2,m4_0,m4_1,m4_2,m4_3,m4_4,m4_5,m4_9,m30_end,m4_end,m30_1;
Begin
BlackFullScreen; {//Зделать Экран полностью Black (стенкой)}
ConditionOfPlay:=0;
Case_:
RgA:=ConditionOfPlay;
{//только что запущенная}
If RgA= 0 then goto m0;
{//// Заставка}
If RgA= 3 then goto m3;
{// Двигатель Заставки}
If RgA= 4 then goto m4;
{инит игры}
If RgA= 15 then goto m15;
{инит уровня}
If RgA= 20 then goto m20;
{Основной процесс игры}
If RgA= 30 then goto m30;
{съела человека змея}
If RgA= 100 then goto m100;
{Уровень пройден}
If RgA= 110 then goto m110;
Goto case_;
m0:
CurAddrLevel:=0; ConditionOfPlay:=3;{//только что запущенная - ЗАСТАВКА}
Goto case_;
m3: { Заставка}
InitGame;
Levelinit;
UserX:=0; UserY:=0;{// установить значения нулевыми человечка}
SnakeCurMaxLength:=8;{// длина змеи}
Life:=0;
CountUserPaint;{// вывести на экран кол-во Попыток}
Zastavka1;{// Зеленый ободок}
Zastavka2; {// черная внутренность}
Zastavka3; {// Черный ободок}
Proba;
ConditionOfPlay:=4;
Goto Case_;
m4:
{Двигатель заставки}
Pause; color; StartOrMenu; RgA:=fPause;
If RgA <> 0 then goto m4_end;
ProcesPressedSnake;{Обработка Змеи}
Delay;
m4_end:
Goto Case_;
m15: {инит игры }
InitGame;
ConditionOfPlay:=20;
Goto Case_;
m20:
{инит уровня }
Levelinit;{// Начальная инициализация текущего уровня}
UserX:=1; UserY:=1;
RgB:=UserX; RgC:=UserY;
RgA:=241; SetPoleAndDraw; {// начертить человечка}
SnakeCurMaxLength:=4;
gDelay:=vDelay;
{Начальная скорость}
{проба} {Mr(ALevel,12);}
.................
.................
.................
RpHL:=RpHL+RpHL; RpHL:=RpHL+RpHL; RpHL:=RpHL+RpHL;
RpHL:=RpHL+RpHL; RpHL:=RpHL+RpHL;
M20_1:
pushHL; GradualDeEmphasDelay; {//Постепенное уменьшение значения задержки vDelay}
popHL;
RpHL:=RpHL-1;
RgA:=RgH;
If RgA <> 0 then goto m20_1;
RgA:=RgL;
If RgA <> 0 then goto m20_1;
ConditionOfPlay:=30;
Goto Case_;
m30:
{Основной процесс игры} Pause; color; StartOrMenu;
RgA:=fPause;
If RgA <> 0 then goto m30_end;
{если не пауза - ОСНОВНОЙ ПРОЦЕСС игры}
ProcesPressedSBonus; {// обработка Супер клада !!!Первый}
KeyD;
ProcesPressedKeys;{//Обработка нажатых клавиш}
KeyO;{Опрос клавиатуры}
ProcesPressedProtect;{//Обработка нажатых клавиш}
ProcesPressedSnake;{//Обработка Змеи}
ProcesPressedBonus;{// обработка клада}
CountBonusPaint;{ вывести на экран кол-во съеденых кладов // В задержку}
CountUserPaint;{// вывести на экран кол-во Попыток// В задержку}
ProcesPressedPrizeLife;{// вычисление призовой жизни}
.................
.................
.................
IF RLO = 0 then goto m30_1;
GradualDeEmphasDelay;{//Постепенное уменьшение значения задержки vDelay}
m30_1:
Delay;{// Задкржка!!! Некартное 4 {mwr(vDelay,1800);}
m30_end:
Goto Case_;
m100:
{съела человека змея}
RgA:=Life;
If RgA <> 0 then goto m100_2;
{Конец игры}
vDelay:=65535; Delay; {// Задкржка!!! Некартное ;}
ConditionOfPlay:=0;
Goto m100_3;
m100_2:{Остались попытки}
ConditionOfPlay:=20;
m100_3:
CountUserPaint;{// вывести на экран кол-во Попыток}
vDelay:=65535;
Delay;
.................
.................
.................
Protect_Del;{// удаление защиты}
Goto Case_;
m110: {Уровень пройден}
ConditionOfPlay:=20;
Level:=1 ; {Level:=Level+1;;//Уровень Плюс 1}
vDelay:=65535;
Delay;
CurAdrPoleRead:=0;{// поставить курсор в начало Данных уровней}
CurAddrLevel:=0;
Goto Case_;
end;

procedure BlackFullScreen;
Label m1,m2;
Begin
RgC:=0;
M2: RgB:=0;
m1:
pushBC; RgA:=0; SetPoleAndDraw;
popBC; RgB:=RgB+1; RgA:=RgB;
If RgA <> 32 then goto m1;
RgC:=RgC+1; RgA:=RgC;
If RgA <> 32 then goto m2;
end;

.................
.................
.................

BEGIN
EngineGames;
end.

[/code]


Вернуться наверх
 Профиль  
 
Показать сообщения за:  Сортировать по:  
Начать новую тему Ответить на тему  [ Сообщений: 19 ]  На страницу Пред.  1, 2

Forum Games WEB Tape Loader Twitter RSS

Часовой пояс: UTC + 2 часа [ Летнее время ]


Кто сейчас на форуме

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
cron
Free counters!
Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB