回 帖 发 新 帖 刷新版面

主题:[原创]自制赛车游戏(模仿单色液晶屏)

program race;
uses
  crt;

type
  cartype=record
    x,y:byte;
  end;

var
  map:array[1..10,1..200] of 0..1;
  screen:byte;
  car:cartype;
  i,speed:byte;

procedure createscreen;
var
  i,j:byte;
begin
  window(35,5,44,24);
  textbackground(yellow);
  textcolor(blue);
  for i:=1 to 20 do
    for j:=1 to 10 do
    begin
      gotoxy(j,i);
      write(' ');
    end;
end;

procedure init;
var
  fin:text;
  i,j,n:byte;
  x:char;
begin
  assign(fin,'road.map');
  reset(fin);
  readln(fin,n);
  for i:=n downto 1 do
  begin
    for j:=1 to 10 do
    begin
      read(fin,x);
      if x='x' then map[j,i]:=1
      else map[j,i]:=0;
    end;
    readln(fin);
  end;
  close(fin);
  car.x:=5;
  car.y:=5;
  screen:=0;
end;

function crash:boolean;
begin
  crash:=false;
  if map[car.x,car.y]=1 then crash:=true;
  if map[car.x-1,car.y-1]=1 then crash:=true;
  if map[car.x-1,car.y-3]=1 then crash:=true;
  if map[car.x+1,car.y-1]=1 then crash:=true;
  if map[car.x+1,car.y-3]=1 then crash:=true;
end;

procedure goleft;
begin
  if car.x>0 then car.x:=car.x-1;
end;

procedure goright;
begin
  if car.x<10 then car.x:=car.x+1;
end;

procedure gogogo;
begin
  car.y:=car.y+1;
  screen:=screen+1;
end;

procedure print;
var
  i,j:byte;
begin
  for i:=1 to 20 do
    for j:=1 to 10 do
    begin
      gotoxy(j,21-i);
      if map[j,screen+i]=1 then write(#219)
      else write(' ');
    end;

  {print car}
  for i:=15 to 18 do
  begin
    textcolor(red);
    gotoxy(car.x,i);
    write(#219);
  end;
  gotoxy(car.x-1,16);
  write(#219);
  gotoxy(car.x-1,18);
  write(#219);
  gotoxy(car.x+1,16);
  write(#219);
  gotoxy(car.x+1,18);
  write(#219);
  textcolor(blue);

  {print information}
  textbackground(blue);
  textcolor(white);
  gotoxy(1,1);
  delline;
  write('speed:',speed);
  textbackground(yellow);
  textcolor(blue);
end;

procedure playmusic(s:string);
var
  i:byte;
begin
  for i:=1 to length(s) do
  begin
    case s[i] of
      'a':sound(264);
      's':sound(297);
      'd':sound(330);
      'f':sound(352);
      'j':sound(396);
      'k':sound(440);
      'l':sound(495);
      ';':sound(528);
      '.':nosound;
    end;
    delay(100);
  end;
  nosound;
end;

{main program}
begin
  for speed:=1 to 10 do
  begin
    createscreen;
    init;
    print;
    playmusic('aaddjjddjj;;;;;;.......aaaaaa.....aaaaaa.....aaaaaa.....;;;;;;;;;..');
    sound(100);
    repeat
      if keypressed then
      begin
        case upcase(readkey) of
          'A':goleft;
          'D':goright;
          'Q':halt;
        end;
        print;
      end
      else
      begin
        gogogo;
        print;
        delay(400-speed*20);
      end;
      if crash then
      begin
        textbackground(blue);
        textcolor(yellow);
        gotoxy(1,10);
        write('game over!');
        sound(200);
        delay(1000);
        nosound;
        delay(10000);
        halt;
        textbackground(yellow);
        textcolor(blue);
      end;
    until car.y>=120;
    playmusic('aaadddjjjjjjkkkjjj');
    nosound;
    delay(5000);
  end;
  nosound;
  delay(10000);
end.

回复列表 (共31个回复)

21 楼

试run一下发现用不了!!![em10][em10]
每次运行都是Error 2~~~~
出错地点好象在procedure init里面的readln(fin,n)那里~~~
谁能帮我一下
?????

22 楼

用FP编译.TP可能有漏洞需要打补丁

23 楼


24 楼

[quote]为什么老是game over我还没玩呢[/quote]


就是,我按得是a和d呀!游戏没开始就over了!而且屏幕上看不到赛道,只是一滩黄色……

25 楼

!

26 楼

[quote][quote]为什么老是game over我还没玩呢[/quote]


就是,我按得是a和d呀!游戏没开始就over了!而且屏幕上看不到赛道,只是一滩黄色……

[/quote]


有些机器是有问题,我也不知道怎么回事。。。。
机太好和太差都不行。。。

27 楼


……诶,难为你一片苦心拉!!不过程序我看了,是不错。

大概我的机器太先进了但PASCAL装得不好[em10][em10]

28 楼

而且我按A和D怎么看上去美撞墙怎么就GAME OVER了???????????

29 楼

有的时候是挂了一下也会被判定为撞墙。。。

30 楼

cool!
我也要学,我自做谈吃蛇的

我来回复

您尚未登录,请登录后再回复。点此登录或注册