7441

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

Курсовая

Информатика, кибернетика и программирование

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

Русский

2013-01-23

134.5 KB

3 чел.

Введение

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

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

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

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

Обучающие

Развивающие

  1.  Деловые

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

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

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

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

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

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

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

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

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

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

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

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

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


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

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

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

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

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

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

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

В нашей игре также существуют свои правила – используя клавиши управления курсором, играющий может последовательно передвигать героя на протяжении всей стены. Он должен сбрасывать камни на своих врагов, находясь именно над теми врагами, на которые нужно сбросить камень. Чтобы перейти на следующий уровень ему нужно уничтожить определенное количество врагов. При этом ни один из врагов не должен добраться до верха стены, в противном случае игра будет закончена.
В теории игр существуют 2 широких класса компьютерных игр:
  1.  игры с преобладанием роли;
игры с преобладанием правил;
Игры с преобладанием роли можно разделить на следующие подклассы:
  •  сюжетно-ролевые;  
  •  деловые;
  •  организационно-деятельностные;
  •  имитационные;
Игры с преобладанием правил можно разделить на:
  •  дидактические;
  •  развивающие;
  •   спортивные;
  •   военные;
  •   азартные;
Игра «Siege» относится к играм, в которых преобладают правила. В данной игре не предусматривается то, что играющий может изменять и вводить свои правила на всем ее протяжении. Во время игры играющему необходимо принимать решения: в каком направлении нужно двигать героя вдоль стены и останавливать его в определенном месте для сбрасывания камней.

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

  •  цель
  •  игровую среду
  •   взаимодействие с играющим
  •   оценку игровой ситуации

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

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

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

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

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

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

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

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

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

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

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

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

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

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

Так же при разработке компьютерных игр, должно уделятся большое внимание на проектирование интерфейса между человеком и компьютером.
Среди множества вариантов интерфейса человек-компьютер есть два принципиально отличных вида:
  1.  «вспоминай-и-набирай» - это язык команд, которые сначала надо вспомнить, потом набрать и выполнить;
«смотри-и-выбирай» - это язык всевозможных меню и пиктограмм, в котором следует выбрать необходимое, после чего произойдет соответствующее действие.
Мы в нашей курсовой работе использовали второй вид интерфейса человек-компьютер для разработки меню игры.

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


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

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

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

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

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

Описание

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

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

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

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

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

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

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

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

6.Ошибки

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


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

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

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

Модуль SiegeSpr-  модуль, содержащий игровые объекты (картинки).

Модуль VGASpr – модуль для рисования спрайтов.

Модуль Logoscreen –заставка курсовой работы.

Модуль SiegeLogo – модуль, содержащий меню, инструкцию, предысторию.

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

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

Модуль VGA13H - модуль для работы с графикой.


ЗАКЛЮЧЕНИЕ

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

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


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

  1.  Игнатьева  А.И. Компьютерные игры. (с. 3-10, 31-35) М. 1988.
  2.  Домашний компьютер - №4(с. 62-68),1999
  3.  Домашний компьютер - №12(с. 78-88),1999

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

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

Инфо-№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(i and 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 then Inc(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) div 2),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) div 2),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 div 2,90,90+i,400,400);

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

   sector(getmaxx div 2,getmaxy div 2,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;Const s: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 then PutPixel(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;Const s: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] of Byte =

    (((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;

Procedure MakePixelSquare;                                     

Procedure CopyBase(Source,Destin:Word);

Procedure ClearBase(Base:Word);

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

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

Procedure TileBase(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;                

Procedure Line(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);         

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

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

Function  InitVirtualPage:Boolean;

Procedure DoneVirtualPage;                                     

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 do HLine(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^)) shl 4)+Longint(Ofs(VirtualPage^));

  if Temp and $F<>0 then Temp:=(Temp shr 4)+1 else 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);

Procedure DrawTSpr(Base:Word;x,y:Integer;h,w:Word;Image:Pointer); Procedure DrawOSpr(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) shl 8)+((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) shl 6)+(x+fx)]:=BA(Image^)[fy*w+fx];

end;

BEGIN

  SetClipRect(0,0,GetMaxX,GetMaxY);

END.


SiegeLogo

GASpr

SiegeSpr

Logoscreen

Retrace

Buttons

VGA13H

Siege


 

А также другие работы, которые могут Вас заинтересовать

14339. Грузовое устройство судна. Экспериментальная оценка грузоподъемности и коэффициента полезного действия талей 428.5 KB
  Лабораторная работа № 2 Тема: Грузовое устройство судна. Экспериментальная оценка грузоподъемности и коэффициента полезного действия талей. Цель работы: Ознакомление с характеристиками и физическим явлением используемом в грузовом устройстве. Задача: Опре...
14340. Якорное устройство судна. Экспериментальная оценка уравнения цепной линии 341 KB
  Лабораторная работа №3 Тема: Якорное устройство судна. Экспериментальная оценка уравнения цепной линии. Цель работы: Ознакомление с характеристиками и физическим явлением используемом в якорном устройстве. Задача: Определить основные параметры формы тяжелой г...
14341. Личностный дифференциал 85.5 KB
  Личностный дифференциал Методика личностного дифференциала ЛД разработана на базе современного русского языка и отражает сформировавшиеся в нашей культуре представления о структуре личности. Методика ЛД адаптирована сотрудниками психоневрологического института и...
14342. Методика Ценностные ориентации» М.Рокича 43 KB
  Методика Ценностные ориентации М.Рокича Система ценностных ориентации определяет содержательную сторону направленности личности и составляет основу ее отношений к окружающему миру к другим людям к себе самой основу мировоззрения и ядро мотивации жизненной актив
14343. ЦЕННОСТНЫЕ ОРИЕНТАЦИИ МЕТОДИКА (М. Рокич) 41.5 KB
  ЦЕННОСТНЫЕ ОРИЕНТАЦИИ МЕТОДИКА М. Рокич Обзор Тест личности направленный на изучение ценностномотивационной сферы человека. Система ценностных ориентаций определяет содержательную сторону направленности личности и составляет основу ее отношений к окружающем
14344. Диагностика межличностных отношений (методика Т. Лири) 27.06 KB
  Диагностика межличностных отношений методика Т. Лири При исследовании межличностных отношений наиболее часто выделяются два фактора: доминированиеподчинение и дружелюбиеагрессивность. Именно эти факторы определяют общее впечатление о человеке в процессах межличн...
14345. К. ТОМАСА ОПИСАНИЯ ПОВЕДЕНИЯ ТЕСТ 69.5 KB
  К. ТОМАСА ОПИСАНИЯ ПОВЕДЕНИЯ ТЕСТ Обзор Опросник личностный разработан К. Томасом и предназначен для изучения личностной предрасположенности к конфликтному поведению выявления определенных стилей разрешения конфликтной ситуации. В России тест адаптирован Н.В. Гри...
14346. Тест Томаса 30.07 KB
  Тест Томаса Опитувальник особистісний розроблений К. Томасом і призначений для вивчення особистісної схильності до конфліктного поводження виявлення певних стилів вирішення конфліктної ситуації. Методика може використовуватися як орієнтовна для вивчення адаптаці