Помогите написать игру на Паскале она мне нужна срочно!!:ypriamii:

Ааааааа лаберинт гебралтар
И что за игра такая?

Я нашел код но он походу не рабочий у меня не запускается((((

program makemaze;

uses
  crt, graph;

const
  screenwidth   = 640;
  screenheight  = 350;
  minblockwidth = 2;
  maxx = 200;   { [3 * maxx * maxy] must be less than 65520 (memory segment) }
  maxy = 109;   { here maxx/maxy about equil to screenwidth/screenheight }
  flistsize = 5000; { flist size (fnum max, about 1/3 of maxx * maxy) }

  background = black;
  gridcolor  = green;
  solvecolor = white;

  rightdir = $01;
  updir	= $02;
  leftdir  = $04;
  downdir  = $08;

  unused   = $00;	{ cell types used as flag bits }
  frontier = $10;
  reserved = $20;
  tree	 = $30;


type
  frec = record
		  column, row : byte;
		 end;
  farr = array [1..flistsize] of frec;

  cellrec = record
			  point : word;  { pointer to flist record }
			  flags : byte;
			end;
  cellarr = array [1..maxx,1..maxy] of cellrec;

  {
	one byte per cell, flag bits...

	0: right, 1 = barrier removed
	1: top	"
	2: left   "
	3: bottom "
	5,4: 0,0 = unused cell type
		 0,1 = frontier "
		 1,1 = tree	 "
		 1,0 = reserved "
	6: (not used)
	7: solve path, 1 = this cell part of solve path
  }


var
  flist	 : farr;		 { list of frontier cells in random order }
  cell	  : ^cellarr;	  { pointers and flags, on heap }
  fnum,
  width,
  height,
  blockwidth,
  halfblock,
  maxrun	: word;
  runset	: byte;
  ch		: char;

procedure initbgi;
var
  grdriver,
  grmode,
  errcode : integer;
begin
  grdriver := DETECT;
  grmode   := EGAhi;
  initgraph(grdriver, grmode, 'e:\bp\bgi');
  errcode:= graphresult;
  if errcode <> grok then
  begin
	writeln('Graphics error: ', grapherrormsg(errcode));
	halt(1);
  end;
end;


function adjust(var x, y : word; d : byte) : boolean;
begin							  { take x,y to next cell in direction d }
  case d of						{ returns false if new x,y is off grid }
	rightdir:
	begin
	  inc (x);
	  adjust:= x <= width;
	end;

	updir:
	begin
	  dec (y);
	  adjust:= y > 0;
	end;

	leftdir:
	begin
	  dec (x);
	  adjust:= x > 0;
	end;

	downdir:
	begin
	  inc (y);
	  adjust:= y <= height;
	end;
  end;
end;


procedure remove(x, y : word);	  { remove a frontier cell from flist }
var
  i : word; { done by moving last entry in flist into it's place }
begin
  i := cell^[x,y].point;		  { old pointer }
  with flist[fnum] do
	cell^[column,row].point := i;   { move pointer }
  flist[i] := flist[fnum];		{ move data }
  dec(fnum);					{ one less to worry about }
end;


procedure add(x, y : word; d : byte);  { add a frontier cell to flist }
var
  i : byte;
begin
  i := cell^[x,y].flags;
  case i and $30 of   { check cell type }
	unused :
	begin
	  cell^[x,y].flags := i or frontier;  { change to frontier cell }
	  inc(fnum);						{ have one more to worry about }
	  if fnum > flistsize then
	  begin	 { flist overflow error! }
		dispose(cell);  { clean up memory }
		closegraph;
		writeln('flist overflow! - To correct, increase "flistsize"');
		write('hit return to halt program ');
		readln;
		halt(1);		{ exit program }
	  end;
	  with flist[fnum] do
	  begin	{ copy data into last entry of flist }
		column := x;
		row	:= y;
	  end;
	  cell^[x,y].point := fnum; { make the pointer point to the new cell }
	  runset := runset or d;   { indicate that a cell in direction d was }
	end;					  {	added to the flist }

	frontier : runset := runset or d;	 { allready in flist }
  end;
end;


procedure addfront(x, y : word);	{ change all unused cells around this }
var							  {	base cell to frontier cells }
  j, k : word;
  d	: byte;
begin
  remove(x, y);	   { first remove base cell from flist, it is now }
  runset := 0;		 {	part of the tree }
  cell^[x,y].flags := cell^[x,y].flags or tree;   { change to tree cell }
  d := $01;			{ look in all four directions- $01,$02,$04,$08 }
  while d <= $08 do
  begin
	j := x;
	k := y;
	if adjust(j, k, d) then
	  add(j, k, d);  { add only if still in bounds }
	d := d shl 1;	{ try next direction }
  end;
end;


procedure remline(x, y : word; d : byte);  { erase line connecting two blocks }
begin
  setcolor(background);
  x := (x - 1) * blockwidth;
  y := (y - 1) * blockwidth;
  case d of
	rightdir : line (x + blockwidth, y + 1, x + blockwidth, y + blockwidth - 1);
	updir	: line (x + 1, y, x + blockwidth - 1, y);
	leftdir  : line (x, y + 1, x, y + blockwidth - 1);
	downdir  : line (x + 1, y + blockwidth, x + blockwidth - 1, y + blockwidth);
  end;
end;


{ erase line and update flags to indicate the barrier has been removed }
procedure rembar(x, y : word; d : byte);
var
  d2 : byte;
begin
  remline(x, y, d);	   { erase line }
  cell^[x,y].flags := cell^[x,y].flags or d; { show barrier removed dir. d }
  d2 := d shl 2;  { shift left twice to reverse direction }
  if d2 > $08 then
	d2 := d2 shr 4;  { wrap around }
  if adjust(x, y, d) then  { do again from adjacent cell back to base cell }
	cell^[x,y].flags := cell^[x,y].flags or d2;	{ skip if out of bounds }
end;


function randomdir : byte;  { get a random direction }
begin
  case random(4) of
	0 : randomdir := rightdir;
	1 : randomdir := updir;
	2 : randomdir := leftdir;
	3 : randomdir := downdir;
  end;
end;


procedure connect(x, y : word);	{ connect this new branch to the tree }
var							 {	in a random direction }
  j, k  : word;
  d	 : byte;
  found : boolean;
begin
  found := false;
  while not found do
  begin { loop until we find a tree cell to connect to }
	j := x;
	k := y;
	d := randomdir;
	if adjust(j, k, d) then
	  found := cell^[j,k].flags and $30 = tree;
  end;
  rembar(x, y, d);   { remove barrier connecting the cells }
end;


procedure branch(x, y : word);  { make a new branch of the tree }
var
  runnum : word;
  d	  : byte;
  i	  : boolean;
begin
  runnum := maxrun;	  { max number of tree cells to add to a branch }
  connect(x, y);		{ first connect frontier cell to the tree }
  addfront(x, y);	   { convert neighboring unused cells to frontier }
  dec(runnum);		 { number of tree cells left to add to this branch }
  while (runnum > 0) and (fnum > 0) and (runset > 0) do
  begin
	repeat
	  d := randomdir;
	until d and runset > 0;  { pick random direction to known frontier }
	rembar(x, y, d);		  {	and make it part of the tree }
	i := adjust(x, y, d);
	addfront(x, y);	  { then pick up the neighboring frontier cells }
	dec(runnum);
  end;
end;


procedure drawmaze;
var
  x, y, i : word;
begin
  setcolor(gridcolor);	{ draw the grid }
  y := height * blockwidth;
  for i := 0 to width do
  begin
	x := i * blockwidth;
	line(x, 0, x, y);
  end;
  x := width * blockwidth;
  for i := 0 to height do
  begin
	y := i * blockwidth;
	line (0, y, x, y);
  end;
  fillchar(cell^, sizeof(cell^), chr(0));	{ zero flags }
  fnum   := 0;   { number of frontier cells in flist }
  runset := 0; { directions to known frontier cells from a base cell }
  randomize;
  x := random(width) + 1;   { pick random start cell }
  y := random(height) + 1;
  add(x, y, rightdir);	   { direction ignored }
  addfront(x, y);	  { start with 1 tree cell and some frontier cells }
  while (fnum > 0) do
  with flist[random(fnum) + 1] do
	branch(column, row);
end;

procedure dot(x, y, colr : word);
begin
  putpixel(blockwidth * x - halfblock, blockwidth * y - halfblock, colr);
end;

procedure solve(x, y, endx, endy : word);
var
  j, k : word;
  d	: byte;
  i	: boolean;
begin
  d := rightdir;  { starting from left side of maze going right }
  while (x <> endx) or (y <> endy) do
  begin
	if d = $01 then
	  d := $08
	else
	  d := d shr 1; { look right, hug right wall }
	while cell^[x,y].flags and d = 0 do
	begin { look for an opening }
	  d := d shl 1;							{ if no opening, turn left }
	  if d > $08 then
		d := d shr 4;
	end;
	j := x;
	k := y;
	i := adjust(x, y, d);		 { go in that direction }
	with cell^[j,k] do
	begin	{ turn on dot, off if we were here before }
	  flags := ((((cell^[x,y].flags xor $80) xor flags) and $80) xor flags);
	  if flags and $80 <> 0 then
		dot(j, k, solvecolor)
	  else
		dot(j, k, background);
	end;
  end;
  dot(endx, endy, solvecolor);	{ dot last cell on }
end;

procedure mansolve (x,y,endx,endy: word);
var
  j, k : word;
  d	: byte;
  ch   : char;
begin
  ch := ' ';
  while ((x <> endx) or (y <> endy)) and (ch <> 'X') and (ch <> #27) do
  begin
	dot(x, y, solvecolor);	{ dot man on, show where we are in maze }
	ch := upcase(readkey);
	dot(x, y, background);	{ dot man off after keypress }
	d := 0;
	case ch of
	  #0:
	  begin
		ch := readkey;
		case ch of
		  #72 : d := updir;
		  #75 : d := leftdir;
		  #77 : d := rightdir;
		  #80 : d := downdir;
		end;
	  end;

	  'I' : d := updir;
	  'J' : d := leftdir;
	  'K' : d := rightdir;
	  'M' : d := downdir;
	end;

	if d > 0 then
	begin
	  j := x;
	  k := y;	{ move if no wall and still in bounds }
	  if (cell^[x,y].flags and d > 0) and adjust(j, k, d) then
	  begin
		x := j;
		y := k;
	  end;
	end;
  end;
end;

procedure solvemaze;
var
  x, y,
  endx,
  endy : word;
  ch   : char;
begin
  x := 1;						 { pick random start on left side wall }
  y := random(height) + 1;
  endx := width;				  { pick random end on right side wall }
  endy := random(height) + 1;
  remline(x, y, leftdir);		 { show start and end by erasing line }
  remline(endx, endy, rightdir);
  mansolve(x, y, endx, endy);	  { try it manually }
  solve(x, y, endx, endy);		 { show how when he gives up }
  while keypressed do
	ch := readkey;
  ch := readkey;
end;


procedure getsize;
var
  j, k : real;
begin
  clrscr;
  writeln('	   Mind');
  writeln('	   Over');
  writeln('	   Maze');
  writeln;
  writeln('   by Randy Ding');
  writeln;
  writeln('Use I,J,K,M or arrow keys to walk thru maze,');
  writeln('then hit X when you give up!');
  repeat
	writeln;
	write('Maze size: ', minblockwidth, ' (hard) .. 95 (easy) ');
	readln(blockwidth);
  until (blockwidth >= minblockwidth) and (blockwidth < 96);
  writeln;
  write('Maximum branch length: 1 easy .. 50 harder, (0 unlimited) ');
  readln(maxrun);
  if maxrun <= 0 then
	maxrun := 65535;  { infinite }
  j := screenwidth / blockwidth;
  k := screenheight / blockwidth;
  if j = int(j) then
	j := j - 1;
  if k = int(k) then
	k := k - 1;
  width  := trunc(j);
  height := trunc(k);
  if (width > maxx) or (height > maxy) then
  begin
	width  := maxx;
	height := maxy;
  end;
  halfblock := blockwidth div 2;
end;

begin
  repeat
	getsize;
	initbgi;
	new(cell);	{ allocate this large array on heap }
	drawmaze;
	solvemaze;
	dispose(cell);
	closegraph;
	while keypressed do
	  ch := readkey;
	write ('another one? ');
	ch := upcase (readkey);
  until (ch = 'N') or (ch = #27);
end.

Добавлено через 1 мин.
Подскажите что нужно подправить

Хотя бы сказать, что за игра лаберинт, как в неё играют..

Что значит не запускается? Какую ошибку выдаёт?

Ну там есть типо заполнение сложности я прохожу ее и все игра закрывается.

Все прекрасно запускается. Если путь к BGI-файлу в строке

initgraph(grdriver, grmode, 'e:\bp\bgi');

выставить правильно. Ничего не нужно править...

Ну там типа кубик или точка должна бродить по лаберинту и выходить.

Добавлено через 4 мин.

Все равно не запускается

> Ну там есть типо заполнение сложности я прохожу ее и все игра закрывается.

Так и надо говорить. "Вылетает после заполнения сложности". А ты что сказал? Чем точнее ты будешь говорить, что происходит, тем скорее мы тебе поможем.

Дальше, если нажать альт+ф5, то что будет написано на чёрном экране?

Вот это

Добавлено через 2 мин.
...

O_o нестандатрный драйвер(лаберинтовый наверное)), что у тебя за паскаль?

Turbo Pascal 7.1

Добавлено через 2 мин.
Unconnected
Если можеш дать полуше не откажусь

Я в шоке.. Прикрепить bmp на мегабайт со всеми виндусовыми красотами, при этом уменьшив ее так, что едва разберешь закорючки - и все это только для того, чтоб сказать, что там нет НИЧЕГО

А что - незаметно?.. спать нельзя!

http://freepascal.org/download.var
Жми на строчку "Win32, Win64 and ..."

Мегабайтовый БМП, на котором ещё и весь рабочий стол?!
Я бы забанил нахрен за такое.

Пусть в бане научится:
1. Пользоваться инструментом "вырезать область" в пеинте.
2. Узначет, чем отличается просто "принтскрин" от "альт+принтскрин".
3. Узнает про назначение формата ПНГ.
4. Изучит пункты "изменить-пометить" и "изменить-копировать" в контекстном меню виндовской консоли, вызываемом при щелчке правой кнопкой по иконке в левой части заголовка.

Хотя это таки лучше, чем фотографии монитора, да.

а я прошел!
с параметрами 10 и 5
))

У меня просто курсовая горит а я в паскале дуб дубом
Мне нужно игра Лаберинт и в ней:
1.Меню
1.Игра
2.Помощь
3.Выход
2. Как минимум 2 уровня в игре
И чтоб это тенула на то что это написал 1 курс

Изелдор, извини, но писать за тебя курсовую тут никто не будет. Какой смысл вообще?? Особенно последняя фраза - еще и подделываться под первокусника? Вот честно скажи - на фига оно нам тут надо, как ты думаешь? Чтобы еще одним ничего не умеющим "программером" стало больше? Да я буду рад, если ты завалишь курсовик..

Короче, если ты проявляешь интерес, пишешь что-то САМ - мы поможем. Если нет - гуляй, вася, жуй опилки.. Без обид, просто по здравому смыслу.