Моя первая змейка

[Чудо-программист]

Всем привет.
Написал сегодня змейку на паскале.
Хочу конструктивной критики.

Program Python;

uses
  Crt,
  Dos;

const
  XRes=320;
  YRes=200;
  MaxX=XRes-1;
  MaxY=YRes-1;
  BlockHeight=8;
  BlockWidth=8;

type
  TScreen=array[0..MaxY, 0..MaxX] of byte;
  T8x8=array[0..7, 0..7] of byte;

  TZmX=array[0..1000] of byte;

  TKey=(Left, Right, Up, Down, Esc);

const
  Block: T8x8=(
    (63, 62, 61, 60, 59, 58, 57, 56),
    (62, 19, 20, 21, 22, 23, 24, 55),
    (61, 20, 21, 22, 23, 24, 25, 54),
    (60, 21, 22, 23, 24, 25, 26, 53),
    (59, 22, 23, 24, 25, 26, 27, 52),
    (58, 23, 24, 25, 26, 27, 28, 51),
    (57, 24, 25, 26, 27, 28, 29, 50),
    (56, 55, 54, 53, 52, 51, 50, 49)
  );
  Food: T8x8=(
    (00, 64, 65, 65, 65, 64, 00, 00),
    (64, 65, 65, 65, 65, 65, 64, 00),
    (65, 65, 65, 64, 65, 65, 65, 00),
    (65, 65, 64, 00, 64, 65, 65, 00),
    (65, 65, 65, 64, 65, 65, 65, 00),
    (64, 65, 65, 65, 65, 65, 64, 00),
    (00, 64, 65, 65, 65, 64, 00, 00),
    (00, 00, 00, 00, 00, 00, 00, 00)
  );

  MinKey: TKey=Left;
  MaxKey: TKey=Esc;
  Keys: array[TKey] of char=(#75, #77, #72, #80, #27);

var
  Screen: TScreen Absolute 40960:0;

  KeysPressed: array[TKey] of boolean;

  ZmX, ZmY: TZmX;
  ZmLength: word;
  BestLength: word;
  Direction: byte;
  Hungry: boolean;
  Crash: boolean;
  FramesToDelay: byte;

  HiscoresFile: file of word;

  Red7, Green7, Blue7: byte;
  Int8: Procedure;

{ GRAPHICS }

{ GRAPHICS C }

{ GRAPHICS C1 }

procedure AllowPal;

begin
  Port[966]:=255
end;

procedure SetPal(C, R, G, B: byte);

begin
  Port[968]:=C;
  Port[969]:=R;
  Port[969]:=G;
  Port[969]:=B
end;

{ /GRAPHICS C1 }

{ /GRAPHICS C }

{ GRAPHICS C&D }

{ GRAPHICS C&D3 }

procedure CreatePal;

var
  I: byte;

begin
  for I:=0 to 31 do
  begin
    SetPal(I, I shl 1, 0, 0);
    SetPal(I+32, 63, I shl 1, 0)
  end
end;

{ /GRAPHICS C&D3 }

{ GRAPHICS C&D2 }

procedure Init13h; Assembler;

asm
  mov ax, 19
  int 16
end;

procedure Close13h; Assembler;

asm
  mov ax, 3
  int 16
end;

procedure InitPal;

begin
  AllowPal;
  CreatePal
end;

{ /GRAPHICS C&D2 }

{ GRAPHICS C&D1 }

procedure InitVideo;

begin
  Init13h;
  InitPal;
  DirectVideo:=False
end;

procedure CloseVideo;

begin
  TextColor(7);
  Close13h
end;

{ /GRAPHICS C&D1 }

{ /GRAPHICS C&D }

{ GRAPHICS L3 }

procedure DrawFood(X0, Y0: byte);

var
  X1, Y1: word;
  I: byte;

begin
  X1:=X0 shl 3 mod XRes;
  Y1:=Y0 shl 3 mod YRes;
  for I:=0 to 7 do
    Move(Food[I, 0], Screen[Y1+I, X1], BlockWidth)
end;

procedure DrawBlock(X0, Y0: byte);

var
  X1, Y1: word;
  I: byte;

begin
  X1:=X0 shl 3 mod XRes;
  Y1:=Y0 shl 3 mod YRes;
  for I:=0 to 7 do
    Move(Block[I, 0], Screen[Y1+I, X1], BlockWidth)
end;

procedure EraseBlock(X0, Y0: byte);

var
  X1, Y1: word;
  I: byte;

begin
  X1:=X0 shl 3 mod XRes;
  Y1:=Y0 shl 3 mod YRes;
  for I:=0 to 7 do
    FillChar(Screen[Y1+I, X1], BlockWidth, 0)
end;

{ /GRAPHICS L3 }

{ GRAPHICS L2 }

procedure TryDrawFood;

var
  X0, Y0: byte;

begin
  X0:=Random(XRes shr 3);
  Y0:=Random(YRes shr 3);
  if Screen[Y0 shl 3, X0 shl 3]=0 then
    if Random(10)=Random(20) then
      DrawFood(X0, Y0)
end;

procedure DrawZmeyka;

begin
  DrawBlock(ZmX[1], ZmY[1]);
  if Hungry then
    EraseBlock(ZmX[ZmLength+1], ZmY[ZmLength+1])
end;

procedure DrawInfo;

begin
  GotoXy(1, 25);
  Write(ZmLength);
  GotoXy(36, 25);
  Write(BestLength)
end;

{ /GRAPHICS L2 }

{ GRAPHICS L1 }

procedure DrawAll;

begin
  TryDrawFood;
  DrawZmeyka;
  DrawInfo
end;

{ /GRAPHICS L1 }

{ /GRAPHICS }

[Чудо-программист]

Продолжение:

{ C }

{ C2 }

function EscPressed: boolean;

begin
  EscPressed:=KeysPressed[Esc]
end;

{ /C2 }

{ C1 }

procedure HelloWorld;

begin
  WriteLn('ZmEyKa');
  WriteLn('Vritten by IvAnOfF');
  WriteLn('FiRsT wErSiOn: 23.07.2015');
  WriteLn('CuRrAnT WeRsIoN: 23.07.2015')
end;

function WannaQuit: boolean;

begin
  WannaQuit:=EscPressed
end;

procedure LoadHiscores;

begin
  Assign(HiscoresFile, 'python.sco');
  Reset(HiscoresFile);
  Read(HiscoresFile, BestLength);
  Close(HiscoresFile)
end;

procedure SaveHiscores;

begin
  Assign(HiscoresFile, 'python.sco');
  Rewrite(HiscoresFile);
  Write(HiscoresFile, BestLength);
  Close(HiscoresFile)
end;

procedure BlinkPalette; Interrupt;

begin
  if Red7<63 then Inc(Red7, Random(2));
  if 0<Red7 then Dec(Red7, Random(2));
  if Green7<63 then Inc(Green7, Random(2));
  if 0<Green7 then Dec(Green7, Random(2));
  if Blue7<63 then Inc(Blue7, Random(2));
  if 0<Blue7 then Dec(Blue7, Random(2));
  SetPal(7, Red7, Green7, Blue7);
  asm
    pushf
  end;
  Int8;
  Port[32]:=32
end;

{ /C1 }

{ /C }

[Чудо-программист]

Окончание:

{ C&D }

{ C&D4 }

procedure InitGameVars;

begin
  ZmX[1]:=20;
  ZmY[1]:=10;
  ZmLength:=1;
  Hungry:=False;
  Crash:=False
end;

{ /C&D4 }

{ C&D3 }

procedure InitGame;

begin
  InitGameVars
end;

procedure CloseGame;

begin
  if not EscPressed then
  begin
    FillChar(Screen, SizeOf(Screen), 0);
    GotoXy(1, 1);
    WriteLn('G A M E   O V E R');
    WriteLn;
    WriteLn('yOuR lAsT lEnGtH wAs ', ZmLength);
    if ZmLength>BestLength then
    begin
      WriteLn;
      WriteLn('WAAAAAW! iTs ThE nEw ReCoRd!!!');
      BestLength:=ZmLength
    end;
    WriteLn;
    WriteLn('HiT eNtEr To CoNtInUe!!!');
    ReadLn
  end
end;

{ /C&D3 }

{ C&D2 }

procedure InitVars;

begin
  Randomize;
  Red7:=47;
  Green7:=47;
  Blue7:=47
end;

procedure InitInt;

begin
  GetIntVec(8, @Int8);
  SetIntVec(8, @BlinkPalette)
end;

procedure CloseInt;

begin
  SetIntVec(8, @Int8)
end;

{ /C&D2 }

{ C&D1 }

procedure InitAll;

begin
  InitVideo;
  InitVars;
  InitInt;
  LoadHiscores
end;

procedure CloseAll;

begin
  SaveHiscores;
  CloseInt;
  CloseVideo
end;

{ /C&D1 }

{ /C&D }

{ L4 }

procedure DelayGame;

var
  I: byte;

begin
  for I:=1 to FramesToDelay do
  begin
    repeat until Port[986] and 8>0;
    repeat until Port[986] and 8=0
  end
end;

{ /L4 }

{ L3 }

procedure OneFrame;

begin
  GetControls;
  ApplyPhysics;
  DrawAll;
  DelayGame
end;

function GameOver: boolean;

var
  B: boolean;

begin
  B:=False;
  if WannaQuit then
    B:=True;
  if Crash then
    B:=True;
  GameOver:=B
end;

{ /L3 }

{ L2 }

procedure Menu;

var
  Done: boolean;
  Key: char;

begin
  ClrScr;
  FillChar(Screen, SizeOf(Screen), 0);
  WriteLn('cHoOsE yOuR mIsSiOn');
  WriteLn;
  WriteLn('1 - eXtReMeLy EaSy');
  WriteLn('2 - VeRy EaSy');
  WriteLn('3 - eAsY');
  WriteLn('4 - MoDeRaTe');
  WriteLn('5 - hArD');
  WriteLn('6 - VeRy HaRd');
  WriteLn('7 - ExTrEmElY hArD');
  repeat
    Key:=ReadKey;
    case Key of
      '1': begin
        FramesToDelay:=20;
        Done:=True
      end;
      '2': begin
        FramesToDelay:=15;
        Done:=True
      end;
      '3': begin
        FramesToDelay:=10;
        Done:=True
      end;
      '4': begin
        FramesToDelay:=7;
        Done:=True
      end;
      '5': begin
        FramesToDelay:=5;
        Done:=True
      end;
      '6': begin
        FramesToDelay:=3;
        Done:=True
      end;
      '7': begin
        FramesToDelay:=2;
        Done:=True
      end;
      '8': begin
        FramesToDelay:=1;
        Done:=True
      end;
      '9': begin
        FramesToDelay:=0;
        Done:=True
      end;
      #27: Done:=True
      else
        Done:=False
    end
  until Done
end;

procedure PlayGame;

begin
  InitGame;
  repeat
    OneFrame
  until GameOver;
  CloseGame
end;

{ /L2 }

{ L1 }

procedure MainLoop;

begin
  repeat
    Menu;
    PlayGame
  until WannaQuit
end;

{ /L1 }

Begin
  InitAll;
  MainLoop;
  CloseAll;
  HelloWorld
End.

[8Observer8]

Чудо-программист, прикрепите, пожалуйста, архив с exe. Хочеться посмотреть, как выглюдит игра.

[Чудо-программист]

Загрузил. Тут ехе, исходник и файл с максимальными очками.
Работает под ХР и досбоксом.

[8Observer8]

При запуске ошибка. У меня Win7 SP1.

[Чудо-программист]

Значит, придется качать досбокс :-(
Еще могу кинуть скриншот и объяснить управление!

[8Observer8]

А нельзя что-то придумать, чтобы без досбокс? Тогда нужна инструкция установки для пользователя, а объяснение управления лучше поместить в саму игру - в меню добавить пункт.

[Чудо-программист]

Можно, но я пока только на турбо паскале умею кодить)))

[8Observer8]

Я понял, как нужно. Я в поисковике ввёл: досбокс как запустить игру. Нужно запустить досбокс и мышкой кинуть на ярлык exe.

Нужно добавить в меню, как управлять, а то ни WASD ни стрелки не реагируют.

Я понимаю, что в исходниках можно посмотреть, но всё же лучше иметь инструкцию по управлению.