Program PYTHON; uses crt,graph; Type TColor = integer; const AMaxX= 62; AMaxY= 46; var GameA: array [1..AMaxX,1..AMaxY] of integer; type TElem = ^TStek; { элемент змейки } TStek = record X:integer; {координата по X } Y:integer; {координата по Y } View: Byte; {вид этого элемента } Nomber: Word;{номер элемента } Next: TElem; {следующий элеметн змейки } Prev: TElem; {предыдущий элемент змейки} end; TDir= 1..4; {направление} TSnake = object First : TElem; {первый элемент змейки } Last : TElem; {последний элемент змейки } Direction: TDir; {направление змейки } Length : Word; {длина змейки } Color : TColor;{цвет змеки } constructor Create(sDirection:TDir;sLength:Word;sX,sY:Byte;sColor:TColor); {функция создания змеи} destructor Destroy; {функция уничтожения} procedure Release; {процедура обозначает места нахождения клеточек змеи} procedure Draw; {отрисовывает змею} procedure DrawElement(Elem:TElem); {отрисовывает определенный звено змеи} function Move(newX,newY:word):boolean; {двигает все элементы змейки} procedure Add; {добавляет к змейке звено} procedure Remove; {уничтожает элемент змейки} function GetByNomber(Nomber:Word):TElem; {находит элемент по номеру} function GetByCoord(X,Y:word):TElem; {находит элемент по координатам} function SetDirection(sDirection:TDir):boolean; procedure SetView(sView:byte); {Устанавливает вид всей змеи} end; procedure ShowMessage(const s: string);{Сообщение об ошибках} begin settextjustify(centertext, centertext); outtextxy(getmaxx div 2, getmaxy div 2, s); end; {********************Classes*********************************} constructor TSnake.create(sDirection:TDir;sLength:Word;sX,sY:Byte;sColor:TColor); var i:integer; Beg, Tek, Tek2: TElem; begin if sDirection = 3 then Direction:=1 else Direction:=sDirection; Length:=sLength; Color:=sColor; First:=nil; Last:=nil; {делаем проверку на правильное введение координат} if (sX<1) or (sX>AMaxX) or (sY<1) or (sY>AMaxY) or ((sX+sLength)>AMaxX) then begin ShowMessage('Ошибка создания змеки'); exit end; if sLength=0 then begin ShowMessage('Ошибка создания змеки'); exit end; new(Beg); {создание первого элемента} Beg^.X:=sX+sLength; Beg^.Y:=sY; Beg^.View:=0; Beg^.Nomber:=1; Beg^.Next:=nil; Beg^.Prev:=nil; first:=beg; {запомнили первый элемент змейки} Tek:=beg; if sLength-1<1 then exit; for i:=1 to (sLength-1) do begin new(Tek2); Tek2^.X:=Tek^.X-1; {распологаем новый элемент левее} Tek2^.Y:=Tek^.Y; {по оси Y все находятся одинаковой } Tek2^.View:=0; {стартовый вид у всех одитнаковый} Tek2^.Next:=nil; { предыдущего пока не существует} Tek2^.Prev:=Tek; {следующий элемент должен быть тот, который мы до этого создали} Tek2^.Nomber:=Tek^.Nomber+1; {прибавляем номер} Tek^.Next:=Tek2; Tek:=Tek2; Last:=Tek2; end; end; destructor TSnake.Destroy; var Tek, Tek2: TElem; begin Tek:=First; if tek=nil then exit; {вдруг змеи нет} while tek^.Next<>nil do begin Tek2:=Tek^.Next; dispose(tek2); {уничтожаем} tek:=tek2; end; dispose(First); end; procedure TSnake.Release; var Tek: TElem; begin tek:=First; if tek=nil then exit; GameA[tek^.X,tek^.Y]:=1; while tek^.Next<>nil do begin tek:=tek^.Next; GameA[tek^.X,tek^.Y]:=1; end; end; function TSnake.GetByNomber(Nomber:Word):TElem; var Tek: TElem; begin GetByNomber := nil; if Nomber>Length then exit; if First=nil then exit; if Nomber=1 then begin GetByNomber := first; exit end; if Nomber=Length then begin GetByNomber := last; exit end; Tek:=First; while tek^.Next<>nil do begin tek:=tek^.Next; if tek^.Nomber=Nomber then begin GetByNomber := tek; exit end; end; end; function TSnake.GetByCoord(X,Y:word):TElem; var Tek: TElem; begin GetByCoord := nil; {проверяем на существование змеи} if First=nil then exit; tek:=Last; if (Tek^.X=X) and (Tek^.Y=Y) then GetByCoord:=Tek; tek:=First;if (Tek^.X=X) and (Tek^.Y=Y) then GetByCoord:=Tek; while Tek^.Next<>nil do begin Tek:=Tek^.Next; if (Tek^.X=X) and (Tek^.Y=Y) then begin {Result}GetByCoord:=Tek; exit; end; end; end; procedure Tsnake.DrawElement(Elem:TElem); begin setcolor(black); setfillstyle(solidfill, color); case Elem^.view of 0: begin bar(Elem^.X*10, Elem^.Y*10, Elem^.X*10+10, Elem^.Y*10+10); rectangle(Elem^.X*10, Elem^.Y*10, Elem^.X*10+10, Elem^.Y*10+10); end; end; end; procedure TSnake.Draw; var Tek: TElem; begin tek:=First; if tek=nil then exit; DrawElement(tek); while tek^.Next<>nil do begin tek:=tek^.Next; DrawElement(tek); end; end; function TSnake.Move(newX,newY:word):boolean; var tek :TElem; tek2: TElem; begin Move:=false; if First=nil then exit; tek:=last; if newX>AMaxX then newX:=1; if newX<1 then newX:=AMaxX; if newY>AMaxY then newY:=1; if newY<1 then newY:=AMaxY; Release; if GameA[newX,newY]>0 then Move:=true; while tek^.Prev<>nil do begin tek2:=tek^.Prev; tek^.X:=tek2^.X; tek^.Y:=tek2^.Y; tek^.View:=tek2^.View; tek:=tek2; end; First^.X:=newX; First^.Y:=newY; end; function TSnake.SetDirection(sDirection:TDir):boolean; begin SetDirection:=false; if (sDirection=1) and (Direction=3) then exit; if (sDirection=3) and (Direction=1) then exit; if (sDirection=2) and (Direction=4) then exit; if (sDirection=4) and (Direction=2) then exit; Direction:=sDirection; SetDirection:=true; end; procedure TSnake.Add; var tek:TElem; begin new(tek); tek^.X:=0; {координаты можно ставить любые,} tek^.Y:=0; tek^.Next:=nil; tek^.Prev:=Last; tek^.View:=Last^.View; tek^.Nomber:=Last^.Nomber+1; Last^.Next:=tek; inc(length); Last:=Tek; end; procedure TSnake.Remove; var Tek:TElem; begin if Last=First then exit; tek:=Last; last:=tek^.Prev; last^.Next:=nil; dispose(tek); inc(length,-1); end; procedure TSnake.SetView(sView:Byte); var Tek: TElem; begin if First=nil then exit; tek:=first; first^.View:=sView; while tek^.Next<>nil do begin tek:=tek^.Next; tek^.View:=sView; end; end; var Snake : TSnake; posX: word; grDriver, grMode:Integer ; ErrCode: Integer; i, j: integer; ch: char; begin grDriver := Detect; InitGraph(grDriver, grMode,''); ErrCode := GraphResult; if ErrCode = grOk then begin for i:=1 to AMaxX do for j:=1 to AMaxY do GameA[i,j]:=0; Snake.Create(1,5,10,10,12); repeat delay(20000); cleardevice; setcolor(red); for i:=1 to AMaxX do for j:=1 to AMaxY do if gameA[i,j]=-1 then begin Rectangle(i*5,j*5,i*5+5,j*5+5); end; case Snake.Direction of 1: Snake.Move(Snake.First^.X+1,Snake.First^.Y); 2: Snake.Move(Snake.First^.X,Snake.First^.Y+1); 3: Snake.Move(Snake.First^.X-1,Snake.First^.Y); 4: Snake.Move(Snake.First^.X,Snake.First^.Y-1); end; Snake.Draw; if keypressed then begin ch := readkey; case upcase(ch) of 'W': Snake.SetDirection(4); { W } 'D': Snake.SetDirection(1); { D } 'A': Snake.SetDirection(3); { A } 'S': Snake.SetDirection(2); { S } #32: Snake.Remove; #43: Snake.Add; { GRAY + } #27: break; else while keypressed do readkey; end; end; until false end else Writeln('Graphics error:', GraphErrorMsg(ErrCode)); snake.destroy; end.