Реферат: Разработка игровой программы на языке программирования Turbo Pascal

МАГНИТОГОРСКИЙ ГОСУДАРСТВЕННЫЙ  УНИВЕРСИТЕТ


КАФЕДРА ИНФОРМАТИКИ


/>


Курсоваяработа по информатике

 

 

                                                               

                                                           Выполнили: студентка  2 курса         

                                                                           Гойтина Ю.В.

      Руководитель:  ст.преподаватель

                                                                                   Гусева Е. Н.       

 

 

 

 

 

/>


СОДЕРЖАНИЕ

ВВЕДЕНИЕ……………………………………………………………3

1.  РАЗРАБОТКА ИГРОВОЙ ПРОГРАММЫ НА ПРИМЕРЕ

ИГРЫ «SIEGE»………..……………….……………………………… 5

2.  СПЕЦИФИКАЦИЯ ИГРОВОЙ ПРОГРАММЫ

«SIEGE»……….……………………………………………………… 9

3.  СТРУКТУРНАЯ ДИАГРАММА…..…………………………… 11

3.1 Описание назначения  модулей……..……………………...11

ЗАКЛЮЧЕНИЕ…………………..…………………………………. 13

СПИСОК  ЛИТЕРАТУРЫ…………………………………………. 14

ПРИЛОЖЕНИЕ……………………………………………………… 15

ВВЕДЕНИЕ

Большинствопользователей, как опытных, так и начинающих, не без удовольствия играют вкомпьютерные игры. Компьютерные игры сравнительно молодое явление, обладающиедостаточно богатой со своими падениями и взлетами. Их история началась не сконца 1970 годов. Начало лежит гораздо раньше. На самом деле все начиналось смодели  железной дороги, на основе которой появились предпосылки длядальнейшего развития первых компьютерных игр.

Игры дают намшанс расслабиться играя, сбросить стресс. Что они делают лучше всего, так этосоздают альтернативные реальности, в которые можно погрузиться. Иногда этиреальности пытаются повторить наш реальный мир. И иногда они могут перенестинас в полностью враждебный или фантастический мир. От управления реактивнымистребителем до управления командой Национальной Футбольной лиги, от сражения сдраконами до создания новых миров, постройки дорог, исследование космоса, довсего, что может изобрести наше воображение.

Указать точноечисло компьютерных игр очень трудно. Можно только примерно оценить числоразличных наименований игр, находящихся на рынке в любое время.

Компьютерная игра– один из наиболее популярных видов программного обеспечения, давший началоцелому направлению – игровой информатике. Несмотря на многообразие подобныхпрограмм, все игры могут быть разделены на следующие виды:

1.   Обучающие

2.   Развивающие

3.   Деловые

4.   Развлекательные

5.   Комбинированные

Целью нашейкурсовой работы является изучение основных положений теории игр, а такжеразработка игровой программы  на языке программирования Turbo Pascal.

Проектированиеигрового продукта состоит из нескольких этапов:

1.   Определения класса игры. На данном этапе необходимосформулировать правила игры.

2.   Выделение компонентов игры.

3.   Определение иерархического уровня игры:

А) оперативный

Б) тактический

В) стратегический

4.   Разработка дизайна игры.

5.    Разработка интерфейса игры.

Чтобы достигнутьпоставленной цели необходимо решить задачи, связанные  психологической областью(использование палитры, образы на экране) и областями теории игр, а такжезадачи, связанные с областью программирования (изучение графическихвозможностей Turbo Pascal).       

1.РАЗРАБОТКА ИГРОВОЙ ПРОГРАММЫ НА ПРИМЕРЕ  ИГРЫ «SIEGE»

      Для того чтобыразработать игровую программу необходимо определить цели и задачи, которыебудут сопровождать нас в процессе  ее создания.

    Создание компьютерной игры – это  не только работапрограммистов, но и творческих деятелей, так как при разработке игровойпрограммы необходимо уделять большое внимание дизайну игры. Будут ли играть вигру, во многом зависит от ее дизайна. Поэтому желательно использовать все своевоображение и фантазию.

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

  Под  и г р о к о м понимается человек или группа людей. Особенностью компьютерных игр является то,что в качестве одного из игроков выступает компьютер.

   В каждой  игреобязательно существуют свои определенные  правила.

  П р а в и л о –предписание, устанавливающее порядок действий играющих.

     В нашей игре также существуют свои правила –используя клавиши управления курсором играющий может последовательнопередвигать героя на протяжении всей стены. Он должен сбрасывать камни на своихврагов, находясь именно над теми врагами, на которые нужно сброситькамень.Чтобы перейти на слудующий уровень ему нужно уничтожить определенноеколичество врагов. При этом ни один из врагов не должен добраться до верхастены, в противном случае игра будет закончена.

В теории игр существуют 2 широких класса компьютерныхигр:

1.  игры спреобладанием роли;

2.  игры спреобладанием правил;

Игры с преобладанием роли можно разделить на следующиеподклассы:

ü сюжетно-ролевые; 

ü деловые;

ü организационно-деятельностные;

ü имитационные;

Игры с преобладанием правил можно разделить на:

ü дидактические;

ü развивающие;

ü  спортивные;

ü  военные;

ü  азартные;

      Игра «Siege» относится к играм, в которыхпреобладают правила. В данной игре не предусматривается то, что играющий можетизменять и вводить свои правила на всем ее протяжении. Во время игры играющемунеобходимо принимать  решения: в каком направлении нужно двигать героя вдольстены и останавливать его в определенном месте для сбрасывания камней.

Можно выделитьследующие составляющие при разработке компьютерной игры:  

ü цель

ü игровуюсреду

ü  взаимодействиес играющим

ü  оценкуигровой ситуации

     Целью является прохождение всех уровней игры, а средством – выбор правильных действийдля  достижения нужного результата.

    В нашей игрепод этим подразумевается  принятие правильного хода игроком в быстро меняющейсяситуации.

И г р о в а я   ср е д а – совокупность связей объектов в игре и правил их изменения.

    В игре«Siege» в качестве игровой среды выступает стена с героем и врагами. Во времяигры герой уничтожает врагов, сбрасывая на них камни. Когда герой уничтожаетврагов, он попадает на уровень выше. Если герой не успеет сбросить камень накакого — либо  врага либо  пройдет все уровни, игра заканчивается.  По мерепрохождения каждого уровня игры увеличивается скорость и количество врагов.

В з а и м о д е йс т в и е   с   и г р а ю щ и м  – совокупность средств, предоставляемых дляизменения игровой среды.

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

 О ц е н к а   иг р о в о й    с и т у а ц и и  — соотношения и условия, которые определяютцель поведения играющего.

В игре «Siege»начальное положение героя – середина верхней части стены. Задачей игрокаявляется то, что он, должен уничтожить всех врагов. Находясь в разныхположениях, он  должен передвигаться  именно в то место, где находится враг исбрасывать на него камень.

      Этапсоздания компьютерной программы начинается только после выбора   сюжета, способов взаимодействия с играющим и системы критериев оценки поведения играюще­го,описания игровой среды. Игровая программа состоит из двух частей: перваяреализует внутреннюю, логическую структуру компьютерной игры, т. е. отображаетигру в системе машинных дан­ных и алгоритмов, вторая — отображает процесс игрына терминале.

    Основную роль любойкомпьютерной игры составляет логическая структура, в которой выделяют триуровня – оперативный, тактический и стратегический.

     Под    о п е р а т ив н ы м     у р о в н е м      понимают совокупность действий внутри программымежду двумя последовательными действиями играющего. Результатом действияоперативного уровня является отображение всех перемещений и изменений на экранедисплея.

   Т а к т и ч е с к ий       у р о в е н ь    определяется как совокупность игровых действий,ведущих к достижению какой-либо локальной цели. В результате действия тактического плана играющий достигает улучшения (или ухудшения) положения вигре.

     С т р а т ег и ч е с к и й      у р о в е н ь       предполагает планирование всей игры,которая должна  строиться так, чтобы достичь цели и добиться выигрыша.

    В игре «Siege» можно выделить всетри уровня, но преобладает тактический, так как от играющего требуетсяпринимать решения, куда переместить героя в быстроменяющейся ситуации.

 

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

      Среди множества вариантов интерфейсачеловек-компьютер есть два принципиально отличных вида:

1.  «вспоминай-и-набирай»- это язык команд, которые сначала надо вспомнить, потом набрать и выполнить;

2.  «смотри-и-выбирай»- это язык всевозможных меню и пиктограмм, в котором следует выбратьнеобходимое, после чего произойдет соответствующее действие.

        Мы в нашей курсовой работе использовали второйвид интерфейса человек-компьютер для разработки меню игры.  

  В  игре «Siege»  мы использовали стандартныесредства для работы с графическими изображениями языка программирования ТурбоПаскаль. Диалог между компьютером и играющим осуществляется как в  меню, так иво время  самой игры.

 

2. СПЕЦИФИКАЦИЯ ИГРОВОЙ ПРОГРАММЫ «SIEGE»

1.   Название задачи

Компьютернаяигра.

Названиепрограммы – «Siege».

Системапрограммирования Turbo Pascal.

2.   Описание

Игра начинается с заставки, где написано название игры.Затем следует главное меню, где пользователь может выбрать один из трех пунктовменю: «Play the game», «Instruction», «Story», «Exit to DOS». Если пользовательвыбирает первый пункт меню, то после предисловия  он может начать игру. Если онвыбирает – второй, то можно ознакомиться с инструкцией.  Если он выберет третийпункт, то он может прочитать предысторию. Иначе пользователь может выйти изигры.  Игрок должен успеть сбрасывать камни на своих врагов, пока они недобрались до верха стены. При неудачном окончании игры, если враг достиг героя,игра заканчивается и выдается сообщение — «Game Over». При выигрыше, если пользовательпрошел десять уровней, то он может выйти из игры. 

3. Управлениережимами работы программы

Играосуществляется с помощью меню.

4. Входные данные

Входными даннымиявляются действия играющего во время игры, то есть информация о нажатии клавишуправления курсором для управления героем и для выбора пункта меню, клавиши Escдля выхода из игры, клавиши Enter для выбора пункта меню, клавиши  Space длясброса камней.

5. Выходныеданные

Сообщение опобеде после каждого пройденного уровня «Level complete», о проигрыше  «Gameover», либо сообщения, сопровождающие успешные или неуспешные действия игрока«Looser» — неудача, «2 hit combo» — при уничтожение сразу двух врагов, «Ough! 4mans at once» — при уничтожении сразу четырех врагов, «Aaaaaaaaamazing!!!» -приуничтожении более четырех врагов.

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

 6.Ошибки

При инициализациипрограммы предусмотрена выдача сообщений при  отсутствии VGA совместимоговидеоадаптера, ошибки инициализации  графического режима.

3. СТРУКТУРНАЯДИАГРАММА

/> <td/> Siege  

/>/>/>/>/>/>/>/>/>                                                                     

/> /> /> /> /> /> /> /> /> LogoScreen   <td/> /> <td/>

Refrace

  <td/>

SiegeSpr

  /> />

3.1 Описаниеназначения модулей.

S i e g e –основная программа, вызывающая на выполнение программные модули.

Модуль S i e g eS p r -  модуль, содержащий игровые объекты (картинки).

Модуль V G A S pr – модуль для рисования спрайтов.

Модуль L o g o sc r e e n –заставка курсовой работы.

Модуль S i e g eL o g o – модуль, содержащий меню, инструкцию, предысторию.

Модуль B u t t on s –  модуль, позволяющий осуществлять нажатие и отпускание клавиши,информацию о состоянии клавиш в реальном времени и об отпущенных клавишах.

Модуль R e t r ac e  – модуль, позволяющий осуществлять синхронизацию вывода в видеопамять.

Модуль V G A 1 3H — модуль для работы с графикой.

ЗАКЛЮЧЕНИЕ

        Таким образом, представляемая  компьютерная игра относится к классукомбинаторных игр, поскольку может быть использована как в качестве развивающейвнимание, реакцию,  психомоторные навыки (способности) игры, так и дляприятного времяпрепровождения и отдыха. При создании компьютерной игры мы старалисьсделать её по возможности красочнее, интереснее и увлекательнее.

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

СПИСОКИСПОЛЬЗУЕМОЙ  ЛИТЕРАТУРЫ

1.  Игнатьева  А.И. Компьютерные игры. (с. 3-10, 31-35) М. 1988.

2.  Домашний компьютер — №4(с. 62-68),1999

3.  Домашний компьютер — №12(с. 78-88),1999

4.  Инфо–№2: Компьютерные игры в обучение (с.61-65) /Под ред.Марнуми Е., Когов Ю. 1990.

5.  Лукашенко М.А. «Информатика в играх и задачах» (с.1-5)//Нач.шк. /Приложение к газете «1 сентября» — 1994, №44

6.   Инфо-№4: Компьютерная игра: учим или играем (64-67) /Подред.

МарусеваИ.В. 1997.

7.Коубс Р. и Влейминк И. Интерфейс (36-40) 1991.

8.Ла Мот А. Секреты программирования игр (7-10) 1995.

9.Фридланд А.Я. Информатика. Толковый словарь основных терминов. (57-62) М. 1998.

10.350 игр для IBM PC,  Дж. Дворак, «Пергамент» -                      Санкт-Петербург, 1994 .

11.Turbo Pascal 7. 0, Фаронов В.В. /Изд. «Нолидж», 1999.

ПРИЛОЖЕНИЕ:

Program Siege;

Uses LogoScreen,

     DOS, VGA13h, VGASpr, Retrace, Buttons,

     SiegeLogo, SiegeS

pr;

Type

    EnemyType = record

      X,Y,D,S,A:Integer;

      Falling:Boolean;

      Free:Boolean;

    end;

Const

     MaxEnemies = 50;

     ComboStr:Array [0..5] of String[20] =

     ('Looser!!!',

      '',

      '2 hit combo',

      'Eat this!',

      'Ough! 4 mans at once',

      'Aaaaaaaaamazing!!!');

Var

   ManX,StoneY,StoneX,EnemyDelay,EnemyLimit:Integer;

   Enemies:Array [1..MaxEnemies] of EnemyType;

   Score,Level,Kills,Combo:Word;

   Timer:Longint;

   GameOver:Boolean;

{==================================================================}

Const

     ca:Word       = 0;

     cc:String[20] = '';

Procedure ComboString(s:String);

begin

   if s<>'' then

   begin

     cc:=s;

     ca:=10;

   end;

   if ca>0 then

   begin

     DrawString(Base2,160-Byte(cc[0])*4,90,cc);

     Dec(ca);

   end;

end;

Procedure NextLevel; forward;

{==================================================================}

Procedure InitEnemies;

Var

   i:Byte;

begin

   for i:=1 to MaxEnemies do Enemies[i].Free:=true;

end;

Procedure DrawEnemies;

Var

   i:Byte;

begin

   for i:=1 to MaxEnemies do

   With Enemies[i] do if not Free then

    DrawTSpr(Base2,X,Y,EnemyHgt,EnemyWdt,@EnemySpr[A]);

end;

Procedure MoveEnemies;

Var

   i:Byte;

begin

   for i:=1 to MaxEnemies do

   With Enemies[i] do

   if not Free then

   begin

     if Falling then

     begin

       Y:=Y+10;

       if Y>199 then

       begin

         Free:=true;

         if Kills=(Level+1)*20 then NextLevel;

       end;

       if D=0 then

       begin

         Inc(A);

         if A>2 then A:=1;

         D:=2;

       end else Dec(D);

     end else

       if D=0 then

       begin

         Y:=Y-5;

         if Y<40 then GameOver:=true;

         Inc(A);

         if A>2 then A:=1;

         D:=S;

       end else Dec(D);

   end else

   if (EnemyLimit>0) and (EnemyDelay=0) then

   begin

     X:=Random(38)*8;

     Y:=200;

     D:=0;

     S:=(10-Level);

     A:=1;

     EnemyDelay:=(13-Level)*2+1;

     Falling:=false;

     Free:=false;

     Dec(EnemyLimit);

   end;

   Dec(EnemyDelay);

end;

{==================================================================}

Procedure DrawScreen;

Var

   x,y:Integer;

   s:String[80];

   tmp:String[6];

begin

   Bar(Base2,0,0,319,9,8);

   FillBase(Base2,3200,9600,$03030303);

   for y:=0 to 15 do

     for x:=0 to 31 do

      DrawOSpr(Base2,x*10,40+y*10,BrickHgt,BrickWdt,@BrickSpr);

   s:='ю ~SIEGE~  ю  Level:';

   Str(Level,tmp);

   While Byte(tmp[0])<2 do tmp:='ъ'+tmp;

   s:=s+tmp+'  ю  Score:';

   Str(Score,tmp);

   While Byte(tmp[0])<5 do tmp:='ъ'+tmp;

   s:=s+tmp+' ю';

   DrawString(Base2,1,1,s);

end;

{==================================================================}

Procedure DrawMan;

begin

   if StoneY=0 then

   begin

    DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[2]);

    DrawTSpr(Base2,ManX*8+4,17,StoneHgt,StoneWdt,@StoneSpr);

   end else

   begin

     DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[1]);

    DrawTSpr(Base2,StoneX,StoneY,StoneHgt,StoneWdt,@StoneSpr);

     Inc(StoneY,10);

     if StoneY>199 then

     begin

       StoneY:=0;

       if Combo<7 then ComboString(ComboStr[Combo])else ComboString('Kiiler!!!');

       Combo:=0;

     end;

   end;

end;

{==================================================================}

Procedure CheckCollisions;

Var

   i:Byte;

begin

   if StoneY>0 then

   for i:=1 to MaxEnemies do

   With Enemies[i] do

   if not Free and not Falling then

   begin

     if ((StoneX+8>X) and (StoneX<X+EnemyWdt))and

        ((StoneY+8>Y) and (StoneY<Y+EnemyHgt))then

        begin

          Falling:=true;

          D:=0;

          Inc(Score);

          Inc(Kills);

          Inc(Combo);

        end;

   end;

end;

{==================================================================}

Procedure NextLevel;

Var

   i:Byte;

begin

   Timer:=MemL[Seg0040:$006C];

   Inc(Level);

   for i:=1 to 30 do

   begin

     ClearBase(Base2);

     DrawScreen;

     DrawTSpr(Base2,ManX*8,20,ManHgt,ManWdt,@ManSpr[1+Byte(iand 1=1)]);

     DrawString(Base2,132,80,'Level'+Char($30+Level));

     WaitRetraceMode;

     CopyBase(Base2,Base1);

     While Timer=MemL[Seg0040:$006C] do;

     Timer:=MemL[Seg0040:$006C];

   end;

   EnemyLimit:=(1+Level)*20;

   EnemyDelay:=0;

   Kills:=0;

   ca:=0;

end;

Procedure GameOverProc;

Var

   i:Byte;

begin

   ClearBase(Base2);

   DrawScreen;

   DrawString(Base2,124,80,'Game Over');

   WaitRetraceMode;

   CopyBase(Base2,Base1);

   Timer:=MemL[Seg0040:$006C];

   for i:=1 to 30 do

   begin

     While Timer=MemL[Seg0040:$006C] do;

     Timer:=MemL[Seg0040:$006C];

   end;

end;

{==================================================================}

Procedure Init;

begin

   if not DetectVGA then

   begin

    Writeln('Необходим VGA совместимый видеоадаптер.'#7);

    Halt(1);

   end;

   SetGraphMode;

   InitButtons;

   Randomize;

   ManX:=19;

   Timer:=MemL[Seg0040:$006C];

   EnemyLimit:=(Level+1)*20;

   GetIntVec($43, Pointer(Font));

end;

Procedure Game;

begin

   InitEnemies;

   Level:=0;

   Score:=0;

   Kills:=0;

   Combo:=0;

   EnemyLimit:=(Level+1)*20;

   GameOver:=false;

   Repeat

     ClearBase(Base2);

     DrawScreen;

     DrawEnemies;

     DrawMan;

     ComboString('');

     MoveEnemies;

     CheckCollisions;

     if Key[keyLeft] then if ManX>0 then Dec(ManX);

     if Key[keyRight] then if ManX<38 thenInc(ManX);

     if Key[keySpace] then if StoneY=0 then

     begin

       StoneX:=(ManX*8)+4;

       StoneY:=24;

     end;

     WaitRetraceMode;

     CopyBase(Base2,Base1);

     While Timer=MemL[Seg0040:$006C] do;

     Timer:=MemL[Seg0040:$006C];

   Until Key[keyEsc] or (Level>=10) or GameOver;

   if GameOver then GameOverProc;

end;

Procedure Done;

begin

   DoneButtons;

   SetTextMode;

   DoneVirtualPage;

end;

{==================================================================}

Var

   choice:Byte;

begin

   Init;

   Repeat

     choice:=Logo;

     Case choice of

       1:Game;

       2:Info;

       3:Story;

     end;

   Until choice=4;

   Done;

end.

UNIT Buttons;

INTERFACE

Uses DOS;

Const

     keyESC             = 1;

     keyF1              = 59;

     keyF2              = 60;

     keyF3              = 61;

     keyF4              = 62;

     keyF5              = 63;

     keyF6              = 64;

     keyF7              = 65;

     keyF8              = 66;

     keyF9              = 67;

     keyF10             = 68;

     keyF11             = 87;

     keyF12             = 88;

     keyScrollLock      = 70;

     keyTilde           = 41;

     key1               = 2;

     key2               = 3;

     key3               = 4;

     key4               = 5;

     key5               = 6;

     key6               = 7;

     key7               = 8;

     key8               = 9;

     key9               = 10;

     key0               = 11;

     keyUnderline       = 12;

     keyEquality        = 13;

     keyBackspace       = 14;

     keyTab             = 15;

     keyQ               = 16;

     keyW               = 17;

     keyE               = 18;

     keyR               = 19;

     keyT               = 20;

     keyY               = 21;

     keyU               = 22;

     keyI               = 23;

     keyO               = 24;

     keyP               = 25;

     keyIndex           = 26;

     keyBackIndex       = 27;

     keyEnter           = 28;

     keyCapsLock        = 58;

     keyA               = 30;

     keyS               = 31;

     keyD               = 32;

     keyF               = 33;

     keyG               = 34;

     keyH               = 35;

     keyJ               = 36;

     keyK               = 37;

     keyL               = 38;

     keyDoublePeriod    = 39;

     keyApostroph       = 40;

     keyLShift          = 42;

     keyBackSlash       = 43;

     keyZ               = 44;

     keyX               = 45;

     keyC               = 46;

     keyV               = 47;

     keyB               = 48;

     keyN               = 49;

     keyM               = 50;

     keyComma           = 51;

     keyPeriod          = 52;

     keySlash           = 53;

     keyRShift          = 54;

     keyCtrl            = 29;

     keyAlt             = 56;

     keySpace           = 57;

     keyNumLock         = 69;

     keyMultiply        = 55;

     keyMinus           = 74;

     keyPlus            = 78;

     keyDelete          = 83;

     keyHome            = 71;

     keyUp              = 72;

     keyPgUp            = 73;

     keyLeft            = 75;

     keyFive            = 76;

     keyRight           = 77;

     keyEnd             = 79;

     keyDown            = 80;

     keyPgDn            = 81;

     keyInsert          = 82;

     KeyPressed:Boolean = FALSE;

Var

   Key       :Array [1..128] of Boolean;

   WasPressed:Array [1..128] of Boolean;

Const

     CheckWarmReboot:Boolean    = TRUE;

     WarmRebootFlag :Boolean    = FALSE;

Procedure InitButtons;                     

Procedure DoneButtons;                   

Function  ButtonsInited:Boolean;

Function  IsKeypressed:Boolean; 

Function  Pressed(Index:Byte):Boolean;

Procedure ClearKeys;

IMPLEMENTATION

Const

     Init:Boolean=FALSE;

Var

   OldKbdHandler:Pointer;

Procedure Int9; INTERRUPT;

Var

   ScanCode,Tmp:Byte;

begin

   ScanCode:=Port[$60];

    if ScanCode and 128=0 then

   begin

     Key[ScanCode]:=TRUE;

     KeyPressed:=TRUE;

   end else

   begin

     ScanCode:=ScanCode xor 128;

     Key[ScanCode]:=FALSE;

     WasPressed[ScanCode]:=TRUE;

     KeyPressed:=FALSE;

   end;

   if CheckWarmReboot and (ScanCode=keyDelete) then

   begin

     Tmp:=Mem[Seg0040:$0017];

     if Tmp and 12=12 then

     begin

       Tmp:=Tmp xor 21;

       WarmRebootFlag:=TRUE;

     end;

     Mem[Seg0040:$0017]:=Tmp;

   end;

   asm

      in al,61h

      or al,82h

      out 61h,al

      and al,7Fh

      out 61h,al

      mov al,20h

      out 20h,al

   end;

 

end;

Procedure InitButtons;

begin

   if not Init then

   begin

     GetIntVec($9,OldKbdHandler);

     SetIntVec($9,@Int9);

     FillChar(Key,SizeOf(Key),FALSE);

     FillChar(WasPressed,SizeOf(WasPressed),FALSE);

     CheckWarmReboot:=TRUE;

     WarmRebootFlag:=FALSE;

     Init:=TRUE;

   end;

end;

Procedure DoneButtons;

begin

   if Init then

   begin

     SetIntVec($9,OldKbdHandler);

     WarmRebootFlag:=FALSE;

     Init:=FALSE;

   end;

end;

Function ButtonsInited;

begin

   ButtonsInited:=Init;

end;

Function IsKeypressed;

Var

   i:Byte;

   f:Boolean;

begin

   f:=false;

   i:=1;

   While (i<=128) and not f do

   begin

     f:=Key[i];

     Inc(i);

   end;

   IsKeypressed:=f;

end;

Function Pressed;

begin

   if WasPressed[Index] then

   begin

     WasPressed[Index]:=FALSE;

     Pressed:=TRUE;

   end else Pressed:=FALSE;

end;

Procedure ClearKeys;

begin

   FillChar(Key,SizeOf(Key),false);

   FillChar(WasPressed,SizeOf(WasPressed),false);

end;

END.

UNIT LogoScreen;

INTERFACE

IMPLEMENTATION

uses graph,crt;

const

     a = 'Vera & Yulya presents';

     b = '           science game';

     d = '               for kids';

     e = 'Magnitogorsk — 2001';

     t = 'Siege';

var driver,mode,x1,x,y,

color:integer;i,j:word;

    x2,y2,o:array[1..500] of integer; g,n:integer;

    label 1;

begin

  detectgraph(driver,mode);

  initgraph(driver,mode,'c:\');

  if graphresult<>0 then write('Ошибка!')

  else for g:=1 to 500 do

  begin

    n:=random(18);

    case n of

         1: o[g]:=1;

         2: o[g]:=3;

         3: o[g]:=4;

         4: o[g]:=5;

         5: o[g]:=9;

         6: o[g]:=11;

         7: o[g]:=12;

         8: o[g]:=13;

         9: o[g]:=14;

        10: o[g]:=15

    end;

    x2[g]:=random(640);

    y2[g]:=random(480);

    putpixel(x2[g],y2[g],o[g])

   end;

   setcolor(9);

begin

  j:=getmaxx-250;

  i:=1;

  settextstyle(7,0,4);

  while i<=getmaxx-length(a)-400 do

  begin

    setcolor(black);

    outtextxy(i-length(a)-2,10,a);

    outtextxy(j+2,50,b);

    outtextxy(j+2,90,d);

    setcolor(1+random(14));

    outtextxy(i-length(a),10,a);

    outtextxy(j,50,b);

    outtextxy(j,90,d);

    j:=j-2;

    i:=i+2;

    if keypressed then goto 1;

  end;

  color:=getcolor;

  settextstyle(4,0,1);

  for i:=1 to 10 do

  begin

    setcolor(black);

    outtextxy(230,getmaxy-20-i+1,e);

    delay(100);

    setcolor(color);

    outtextxy(230,getmaxy-20-i,e);

  end;

  settextstyle(4,0,15);

  setviewport(1,1,639,479,false);

  repeat

    for i:=15 downto 1 do

    begin

      if(i=1)or(i=5)then continue;

      setcolor(i);

      outtextxy((GetMaxX div 2)-(TextWidth(t) div2),180,t);

      delay(100);

    end;

    for i:=1 to 15 do

    begin

      if(i=1)or(i=5)then continue;

      setcolor(i);

      outtextxy((GetMaxX div 2)-(TextWidth(t) div2),180,t);

      delay(100);

    end;

  until keypressed;

1:

  setcolor(black);

  setfillstyle(1,1);

  SetBkcolor(1);

  setviewport(1,1,639,479,true);

  for i:=1 to 90 do

  begin

    sector(getmaxx div 2,getmaxy div 2,0,i,400,400);

    sector(getmaxx div 2,getmaxy div2,90,90+i,400,400);

    sector(getmaxx div 2,getmaxy div2,180,180+i,400,400);

    sector(getmaxx div 2,getmaxy div2,270,270+i,400,400);

  end;

  setcolor(Magenta);

  settextstyle(7,0,8);

  outtextxy((getmaxx div 2)-(TextWidth('Good luck!!!')div 2),

            (getmaxy div 2)-180,'Good luck!!!');

  Delay(1000);

  closegraph;

end;

END.

UNIT Retrace;

INTERFACE

Procedure WaitRetraceMode;

IMPLEMENTATION

Procedure WaitRetraceMode;

begin

   While Port[$3DA] and 8<>0 do;

end;

END.

UNIT SiegeLogo;

INTERFACE

Uses Buttons, VGA13h;

Type

    PFont = ^TFont;

    TFont = Array [0..255,0..7] of Byte;

Var

   Font:PFont;

Procedure DrawString(Base:Word;xp,yp:Integer;Consts:String); Function Logo:Byte;                        

Procedure Info;                           

Procedure Story;                          

IMPLEMENTATION

Procedure DrawString;

Var

   x,y,l,t:Byte;

begin

   if Byte(s[0])>0 then

   begin

     for l:=1 to Byte(s[0]) do

     begin

       for y:=0 to 7 do

       begin

         t:=Font^[Byte(s[l])][y];

         for x:=0 to 7 do

         begin

           if t and 128=128 thenPutPixel(Base,xp+x,yp+y,15);

           t:=t shl 1;

         end;

       end;

       xp:=xp+8;

     end;

   end;

end;

Function Logo;

Var

   Res,Old:Byte;

begin

   ClearKeys;

   Old:=0;

   Res:=1;

   ClearBase(Base1);

   DrawString(Base1,30,60,'Play the game');

   DrawString(Base1,30,70,'Instructions');

   DrawString(Base1,30,80,'Story');

   DrawString(Base1,30,90,'Exit to DOS');

   Repeat

     if Old<>Res then

     begin

       Bar(Base1,20,60,28,100,0);

       DrawString(Base1,20,60+(Res-1)*10,'>');

       Old:=Res;

     end;

     if Pressed(keyUp) then

     begin

       Res:=Res-1;

       if Res<1 then Res:=4;

     end;

     if Pressed(keyDown) then

     begin

       Res:=Res+1;

       if Res>4 then Res:=1;

     end;

   Until Key[keyEnter];

   Logo:=Res;

end;

Procedure Center(y:Integer;Consts:String);

begin

   DrawString(Base1,160-(Length(s)*8 div 2),y,s);

end;

Procedure Info;

begin

   ClearBase(Base1);

   Center(2,'Instructions');

   Center(20,'Arrows — moving Hero');

   Center(30,'Space — throw stone');

   Center(40,'Esc — exit the game');

   Center(190,'Press any key');

   ClearKeys;

   Repeat Until IsKeypressed;

end;

Procedure Story;

begin

 ClearBase(Base1);

 Center(2,'Предыстория');

 DrawString(Base1,1,20,'Много лет назад на Землю упалметеорит.');

 DrawString(Base1,1,30,'Приисследовании в лаборатории ученые  ');

 DrawString(Base1,1,40,'обнаружилив нем биологическое вещес-  ');

 DrawString(Base1,1,50,'твовнеземного происхождения. Поняв всю');

 DrawString(Base1,1,60,'опасностьэтого вируса, они попытались ');

 DrawString(Base1,1,70,'нейтрализоватьего.Но вирус стал быстро');

 DrawString(Base1,1,80,'распространятьсяи заразил всех участни ');

 DrawString(Base1,1,90,'ковисследования. Выйдя за стены лабора-');

 DrawString(Base1,1,100,'тории он стал зарожать людей.Зараженные');

 DrawString(Base1,1,110,'вирусомвнешне не отличались от обычных');

 DrawString(Base1,1,120,'людей,но подчинялись внеземному разуму.');

 DrawString(Base1,1,130,'Ихзадачей было: уничтожить оставшееся ');

 DrawString(Base1,1,140,'население.Тогдалюди стали объединять- ');

 DrawString(Base1,1,150,'ся, чтобызащитить себя. Они устроили ');

 DrawString(Base1,1,160,'засадув крепости. Но агрессивных «лик-');

 DrawString(Base1,1,170,'видаторовничто не могло остановить.....');

 ClearKeys;

   Repeat Until IsKeypressed;

end;

END.

UNIT SiegeSpr;

INTERFACE

Const 

     BrickHgt = 10;

     BrickWdt = 10;

     BrickSpr:Array [1..BrickHgt,1..BrickWdt] of Byte=

     ((7,7,7,7,7,7,7,7,7,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (4,4,4,4,4,4,4,4,4,7),

      (7,7,7,7,7,7,7,7,7,7),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4),

      (4,4,4,4,7,4,4,4,4,4));

Const 

     StoneHgt = 8;

     StoneWdt = 8;

     StoneSpr:Array [1..StoneHgt,1..StoneWdt] of Byte=

     ((0,0,8,8,8,8,0,0),

      (0,8,7,7,8,8,8,0),

      (8,7,8,8,8,8,8,8),

      (8,7,8,8,8,8,8,8),

      (8,8,8,8,8,8,8,8),

      (8,8,8,8,8,8,8,8),

      (0,8,8,8,8,8,8,0),

      (0,0,8,8,8,8,0,0));

Const 

     ManHgt = 20;

     ManWdt = 16;

     ManSpr:Array [1..2,1..ManHgt,1..ManWdt] of Byte =

    (((00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

      (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

      (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,00,00,00,00,00, 7, 7, 7,7,00,00,00,00,00,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7,7,00,00,00,00,00),

       (00,00,00,00,00, 7,15,15,15,15,7,00,00,00,00,00),

       (00,00,00,00,00,15, 3, 1, 1,3,15,00,00,00,00,00),

       (00,00,00,00,00,15,15,15,15,15,15,00,00,00,00,00),

       (00,00,00,00,00,15,15, 8,8,15,15,00,00,00,00,00),

      (00,00,00,00,00,15,15,13,13,15,15,00,00,00,00,00),

      (00,00,00,00,00,00,15,15,15,15,00,00,00,00,00,00),

       (00,00,00,00,12,12,15,15,15,15,12,12,00,00,00,00),

      (00,12,12,12,12,12,12,14,14,12,12,12,12,12,12,00),

      (12,12,12,12,12,12,12,14,14,12,12,12,12,12,12,12),

      (12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),

       (12,12, 8,12,12,12,12,12,12,12,12,12,12,8,12,12),

       (12,12, 8,12,12,12,12,12, 8,12,12,12,12,8,12,12),

       (12,12, 8,12,12,12,12,12,12,12,12,12,12,8,12,12),

       (12,12, 8,12,12,12,12,12, 8,12,12,12,12,8,12,12)),

     ((00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

       (00,00,00,15,00,00,00,00,00,00,00,00,15,00,00,00),

      (00,00,12,12,00,00,00,00,00,00,00,00,12,12,00,00),

      (00,00,12,12,00,00,00,00,00,00,00,00,12,12,00,00),

       (00,00,12,12,00,00, 7, 7, 7,7,00,00,12,12,00,00),

       (00,00,12,12,00, 7, 7, 7, 7, 7, 7,00,12,12,00,00),

       (00,12,12,00,00, 7,15,15,15,15,7,00,00,12,12,00),

       (00,12,12,00,00,15, 3, 1, 1,3,15,00,00,12,12,00),

      (00,12,12,00,00,15,15,15,15,15,15,00,00,12,12,00),

       (00,12,12,00,00,15,15, 8,8,15,15,00,00,12,12,00),

       (00,12,12,00,00,15,15,13,13,15,15,00,00,12,12,00),

      (00,12,12,12,00,00,15,15,15,15,00,00,12,12,12,00),

      (00,00,12,12,12,12,15,15,15,15,12,12,12,12,00,00),

      (00,00,12,12,12,12,12,14,14,12,12,12,12,12,00,00),

       (00,00,12,12,12,12,12,14,14,12,12,12,12,12,00,00),

      (00,00,12,12,12,12,12,12,12,12,12,12,12,12,00,00),

      (00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

       (00,00,00,12,12,12,12,12,8,12,12,12,12,00,00,00),

      (00,00,00,12,12,12,12,12,12,12,12,12,12,00,00,00),

       (00,00,00,12,12,12,12,12,8,12,12,12,12,00,00,00)));

Const

     EnemyHgt = 42;

     EnemyWdt = 16;

     EnemySpr:Array [1..2,1..EnemyHgt,1..EnemyWdt] ofByte =

    (((00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

       (00,00,00,00,00,00,00,00,00,00,00,00,00,00,15,00),

      (00,00,00,00,00,00,00,00,00,00,00,00,00,10,10,00),

      (00,00,00,00,00,00,00,00,00,00,00,00,00,10,10,00),

       (00,00,00,00,00,00, 7, 7, 7,7,00,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7,7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7,7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7,7,00,00,10,10,00),

       (00,00,00,00,00, 7, 7, 7, 7, 7,7,00,00,10,10,00),

       (00,00,00,00,00,15, 7, 7, 7,7,15,00,00,10,10,00),

       (00,00,00,00,00,15, 7, 7, 7,7,15,00,00,10,10,00),

      (00,00,00,00,00,00,15,15,15,15,00,00,10,10,10,00),

      (00,00,00,00,10,10,15,15,15,15,10,10,10,10,00,00),

      (00,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

       (10,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

      (10,10,10,10,10,10,10,10,10,10,10,10,10,10,00,00),

      (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

      (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

      (10,10,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

      (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

      (00,10,10,10,10,10,10,10,10,10,10,10,10,00,00,00),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9,9,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00,00),

       (00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00,00),

       (00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00,00),

       (00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00,00),

       (00, 8, 8, 8, 8,00,00,00,00, 8, 8, 8,8,00,00,00),

       ( 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00,00),

       ( 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00,00),

       (00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00,00),

       (00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8,8,00),

       (00,00,00,00,00,00,00,00,00,00,00, 8, 8, 8,8,00)),

     ((00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

      (00,15,00,00,00,00,00,00,00,00,00,00,00,00,00,00),

      (00,10,10,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,10,10,00,00,00,00,00,00,00,00,00,00,00,00,00),

       (00,10,10,00,00,00, 7, 7, 7,7,00,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7,7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7,7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7,7,00,00,00,00,00),

       (00,10,10,00,00, 7, 7, 7, 7, 7,7,00,00,00,00,00),

       (00,10,10,00,00,15, 7, 7, 7,7,15,00,00,00,00,00),

       (00,10,10,00,00,15, 7, 7, 7,7,15,00,00,00,00,00),

      (00,10,10,10,00,00,15,15,15,15,00,00,00,00,00,00),

       (00,00,10,10,10,10,15,15,15,15,10,10,10,10,00,00),

      (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,00),

      (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,10),

      (00,00,10,10,10,10,10,10,10,10,10,10,10,10,10,10),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,00,10,10),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

       (00,00,00,10,10,10,10,10,10,10,10,10,10,10,10,00),

      (00,00,00,10,10,10,10,10,10,10,10,10,10,00,00,00),

       (00,00,00, 9, 9, 9, 9, 9, 9, 9, 9, 9,9,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00,00),

       (00,00,00, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8, 8,8,00),

       (00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8,8,00),

       (00,00, 8, 8, 8, 8, 8,00,00,00,00, 8, 8, 8, 8,8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8, 8,8),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8,8,00),

       (00,00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8,8,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8,8,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8,8,00,00),

       (00, 8, 8, 8, 8,00,00,00,00,00,00, 8, 8,8,00,00),

       (00, 8, 8, 8,8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8,8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8,8,00,00,00,00,00,00,00,00,00,00,00),

       (00, 8, 8, 8,8,00,00,00,00,00,00,00,00,00,00,00)));

IMPLEMENTATION

END.

UNIT VGA13h;

INTERFACE

Type

    PScreen = ^TScreen;

    TScreen = Array [0..199,0..319] of Byte;

Const

     ScreenHeight               = 200;

     ScreenWidth                = 320;

     GetMaxY                    = ScreenHeight-1;

     GetMaxX                    = ScreenWidth-1;

     MidX                       = GetMaxX div 2;

     MidY                       = GetMaxY div 2;

     PageSize                   =ScreenHeight*ScreenWidth;

     QuarterSize                = PageSize div 4;

     VideoSegment:Word          = 0;

     Base1:Word                 = 0;

     Base2:Word                 = 0;

     Page1:PScreen              = NIL;

     Page2:PScreen              = NIL;

Function  DetectVGA:Boolean;

Procedure SetGraphMode;

Procedure SetTextMode;

ProcedureMakePixelSquare;                                    

Procedure CopyBase(Source,Destin:Word);

Procedure ClearBase(Base:Word);

Procedure FillBase(Base,Ofs,Count:Word;Color:Longint);

Procedure MoveBase(Source,Destin,Count:Word);

ProcedureTileBase(Base,Ofs,Count:Word;Tile:Pointer;Len:Word);

Procedure PutPixel(Base:Word;x,y:Integer;Color:Byte);

Function GetPixel(Base:Word;x,y:Integer):Byte;               

ProcedureLine(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);

Procedure VLine(Base:Word;x,y1,y2:Integer;Color:Byte);

Procedure HLine(Base:Word;y,x1,x2:Integer;Color:Byte);        

ProcedureBar(Base:Word;x1,y1,x2,y2:Integer;Color:Byte);      

ProcedurePolygon(Base:Word;x1,y1,x2,y2,x3,y3,x4,y4:Integer;c:Byte);

Function  InitVirtualPage:Boolean;

ProcedureDoneVirtualPage;                                    

IMPLEMENTATION

Var

   VirtualPage:Pointer;

{$L VGA13H.OBJ}

Function  DetectVGA;       external;

Procedure SetGraphMode;    external;

Procedure SetTextMode;     external;

Procedure MakePixelSquare; external;

Procedure CopyBase;        external;

Procedure ClearBase;       external;

Procedure FillBase;        external;

Procedure MoveBase;        external;

Procedure TileBase;        external;

Procedure PutPixel;        external;

Function  GetPixel;        external;

Procedure HLine;           external;

Procedure VLine;           external;

Procedure Polygon;

Var

  xpos:array [0..199,0..1] of Word;

  mny,mxy,y:Integer;

  i:Word;

  s1,s2,s3,s4:Shortint;

begin

  mny:=y1;

  if y2<mny then mny:=y2;

  if y3<mny then mny:=y3;

  if y4<mny then mny:=y4;

  mxy:=y1;

  if y2>mxy then mxy:=y2;

  if y3>mxy then mxy:=y3;

  if y4>mxy then mxy:=y4;

  s1:=byte(y1<y2)*2-1;

  s2:=byte(y2<y3)*2-1;

  s3:=byte(y3<y4)*2-1;

  s4:=byte(y4<y1)*2-1;

  y:=y1;

  if y1<>y2 then

  Repeat

    xpos[y,byte(y1<y2)]:=integer(x2-x1)*(y-y1) div(y2-y1)+x1;

    y:=y+s1;

  Until y=y2+s1

  else xpos[y,byte(y1<y2)]:=x1;

  y:=y2;

  if y2<>y3 then

  Repeat

    xpos[y,byte(y2<y3)]:=integer(x3-x2)*(y-y2) div(y3-y2)+x2;

    y:=y+s2;

  Until y=y3+s2

  else xpos[y,byte(y2<y3)]:=x2;

  y:=y3;

  if y3<>y4 then

  Repeat

    xpos[y,byte(y3<y4)]:=integer(x4-x3)*(y-y3) div(y4-y3)+x3;

    y:=y+s3;

  Until y=y4+s3

  else xpos[y,byte(y3<y4)]:=x3;

  y:=y4;

  if y4<>y1 then

  Repeat

    xpos[y,byte(y4<y1)]:=integer(x1-x4)*(y-y4) div(y1-y4)+x4;

    y:=y+s4;

  Until y=y1+s4

  else xpos[y,byte(y1<y4)]:=x4;

  for y:=mny to mxy doHLine(Base,y,xpos[y,0],xpos[y,1],c);

end;

Procedure Line;

Var

   dx,dy,sx,sy,d,d1,d2,x,y,i:Integer;

begin

   dx:=Abs(x2-x1);

   dy:=Abs(y2-y1);

   if x2>=x1 then sx:=+1 else sx:=-1;

   if y2>=y1 then sy:=+1 else sy:=-1;

   Mem[Base:(y1 shl 8)+(y1 shl 6)+x1]:=Color;

   if dy<=dx then

   begin

     d:=(dy shl 1)-dx;

     d1:=dy shl 1;

     d2:=(dy-dx) shl 1;

     x:=x1+sx;

     y:=y1;

     for i:=1 to dx do

     begin

       if d>0 then

       begin

         d:=d+d2;

         y:=y+sy;

       end else d:=d+d1;

       Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;

       x:=x+sx;

     end;

   end

   else begin

     d:=(dx shl 1)-dy;

     d1:=dx shl 1;

     d2:=(dx-dy) shl 1;

     x:=x1;

     y:=y1+sy;

     for i:=1 to dy do

     begin

       if d>0 then

       begin

         d:=d+d2;

         x:=x+sx;

       end else d:=d+d1;

       Mem[Base:(y shl 8)+(y shl 6)+x]:=Color;

       y:=y+sy;

     end;

   end;

end;

Procedure Bar;

Var

   Row,Column:Integer;

begin

  for Row:=y1 to y2 do

    for Column:=x1 to x2 do

      Mem[Base:(Row shl 8)+(Row shl 6)+Column]:=Color;

end;

Function InitVirtualPage;

Var

   Temp:Longint;

begin

   VirtualPage:=NIL;

   Base2:=0;

   Page2:=NIL;

   InitVirtualPage:=false;

   GetMem(VirtualPage,PageSize+15);

   Temp:=(Longint(Seg(VirtualPage^)) shl4)+Longint(Ofs(VirtualPage^));

   if Temp and $F<>0 then Temp:=(Temp shr 4)+1else Temp:=Temp shr 4;

   Base2:=Temp;

   Page2:=Ptr(Base2,0);

   ClearBase(Base2);

   InitVirtualPage:=true;

end;

Procedure DoneVirtualPage;

begin

   FreeMem(VirtualPage,PageSize+15);

   VirtualPage:=NIL;

   Base2:=0;

   Page2:=NIL;

end;

{==================================================================}

BEGIN

   VideoSegment:=SegA000;

   Base1:=VideoSegment;

   Page1:=Ptr(Base1,0);

   InitVirtualPage;

END.

UNIT VGASpr;

INTERFACE

Uses VGA13h;

Type

    BA=Array [0..$FFF0] of Byte;

Var

   TopX,TopY,BotX,BotY:Integer;

Procedure SetClipRect(x1,y1,x2,y2:Integer);

ProcedureDrawTSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); ProcedureDrawOSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); IMPLEMENTATION

Procedure SetClipRect;

  Function Max(a,b:Integer):Integer;

  begin

     if a>b then Max:=a else Max:=b;

  end;

  Function Min(a,b:Integer):Integer;

  begin

     if a<b then Min:=a else Min:=b;

  end;

begin

   TopX:=Max(0,Min(x1,x2));

   BotX:=Min(GetMaxX,Max(x1,x2));

   TopY:=Max(0,Min(y1,y2));

   BotY:=Min(GetMaxY,Max(y1,y2));

end;

Procedure DrawTSpr;

Var

   fx,fy,x1,y1,x2,y2:Word;

   c:Byte;

begin

   if (x+w-1<TopX) or (y+h-1<TopY) or(x>BotX) or (y>BotY) then Exit;

   if x<TopX then x1:=Abs(x) else x1:=0;

   if y<TopY then y1:=Abs(y) else y1:=0;

   if x+w>BotX then x2:=BotX-x else x2:=w-1;

   if y+h>BotY then y2:=BotY-y else y2:=h-1;

   for fy:=y1 to y2 do

     for fx:=x1 to x2 do

     begin

       c:=BA(Image^)[fy*w+fx];

       if c<>0 then Mem[Base:((y+fy) shl8)+((y+fy) shl 6)+(x+fx)]:=c;

     end;

end;

Procedure DrawOSpr;

Var

   fx,fy,x1,y1,x2,y2:Word;

begin

   if (x+w-1<TopX) or (y+h-1<TopY) or(x>BotX) or (y>BotY) then Exit;

   if x<TopX then x1:=Abs(x) else x1:=0;

   if y<TopY then y1:=Abs(y) else y1:=0;

   if x+w>BotX then x2:=BotX-x else x2:=w-1;

   if y+h>BotY then y2:=BotY-y else y2:=h-1;

   for fy:=y1 to y2 do

     for fx:=x1 to x2 do

       Mem[Base:((y+fy) shl 8)+((y+fy) shl6)+(x+fx)]:=BA(Image^)[fy*w+fx];

end;

BEGIN

   SetClipRect(0,0,GetMaxX,GetMaxY);

END.

еще рефераты
Еще работы по информатике, программированию