一段未完成的Pascal贪吃蛇

说这段代码未完成其实是没有源代码格式化,FP中一行最多只有255字符宽。

uses crt; 
const screenwidth=50; 
screenheight=24; wallchar='#'; snakechar='*'; ; type point=record x,y:integer; end; var snake:array [0..500] of point; map:array [0..screenwidth,0..screenheight] of 0..2; direct:0..3; score:integer; wallnum,foodnum:integer; procedure copyright; begin gotoxy(55,18); textcolor(yellow); writeln('Version a1.0'); gotoxy(55,19); writeln('Coder:RedRooT|R.39'); gotoxy(55,20); writeln('QQ:'); gotoxy(55,21); writeln('E-mail:'); gotoxy(60,22); writeln(); gotoxy(55,23); writeln( Dep.'); end; procedure rc; begin gotoxy(1,1); end; function hitself(x,y:integer):boolean; var i:integer;ret:boolean; begin ret:=false; for i:=1 to snake[0].x do if ((snake[i].x=x) and (snake[i].y=y)) then begin ret:=true; exit; end; hitself:=ret; end; function hit:boolean; var t:Point; begin t:=snake[1]; if direct=0 then t.y:=t.y-1; if direct=1 then t.x:=t.x+1; if direct=2 then t.y:=t.y+1; if direct=3 then t.x:=t.x-1; if hitself(t.x,t.y) then hit:=true else if map[t.x,t.y]=2 then hit:=true else hit:=false; end; procedure outputxy(x,y:integer;c:char); begin gotoxy(x,y); write(c); rc; end; procedure drawscreen(diff:integer); var i,j:integer; begin clrscr;textcolor(blue); for i:=1 to screenwidth do for j:=1 to screenheight do map[i,j]:=0; for i:=1 to screenwidth do begin outputxy (i,2,wallchar); outputxy (i,screenheight,wallchar); map[i,2]:=2; map[i,screenheight]:=2; end; for i:=2 to screenheight do begin outputxy (1,i,wallchar); outputxy (screenwidth,i,wallchar); map[1,i]:=2; map[screenwidth,i]:=2; end; copyright; gotoxy (15,1);textcolor(blue); write ('Greedy Snake Game a,1.0'); textcolor(blue); gotoxy (57,3); write ('Score:'); gotoxy (57,5); write ('Level:',diff,'/20'); gotoxy (57,7); write('**Game Application**'); gotoxy(57,8); write('Arrow keys --> contral'); gotoxy(65,9); write('P --> pause'); gotoxy(64,10); write('ESC --> exit.'); rc; end; procedure createfood; var i,j:integer; begin i:=random(screenwidth-1)+1; j:=random(screenheight-2)+2; while ((map[i,j]<>0) or (hitself(i,j))) do begin i:=random(screenwidth-1)+1; j:=random(screenheight-2)+2; end; outputxy (i,j,foodchar); map[i,j]:=1; end; procedure createwall; var p,q:integer; begin p:=random(screenwidth-1)+1; q:=random(screenheight-2)+2; while ((map[p,q]<>0) or (hitself(p,q))) do begin p:=random(screenwidth-1)+1; q:=random(screenheight-2)+2; end; outputxy (p,q,wallchar); map[p,q]:=2; end; procedure initgame(foodnum,wallnum:integer); var i,j:integer; begin snake[0].x:=1; snake[1].x:=screenwidth div 2; snake[1].y:=screenheight div 2; outputxy (snake[1].x,snake[1].y,snakechar); for i:=1 to foodnum do createfood; textcolor(red); for i:=1 to wallnum do createwall; textcolor(green); score:=0; direct:=0; outputxy (65,3,'0'); end; procedure die; begin rc; gotoxy(22,13); write('Game Over'); Delay(60000); Delay(60000); Delay(60000); clrscr; gotoxy(30,4); write('Greedy Snake a1.0'); gotoxy (20,12); write('Your snake has been dead.Your final score is:',score); window(15,19,65,23); gotoxy(1,1); textbackground(black); textcolor(red); clrscr; writeln(' Buite by RedRooT|R39'); writeln(' QQ: Email:cfo@cnnb.net'); gotoxy(51,3); delay(60000); gotoxy(1,1); rc; clrscr; halt; end; procedure walk(diff:integer); var t:Point; food:boolean; i:integer; begin if hit then die; t:=snake[1]; if direct=0 then t.y:=t.y-1; if direct=1 then t.x:=t.x+1; if direct=2 then t.y:=t.y+1; if direct=3 then t.x:=t.x-1; if map[t.x,t.y]=1 then food:=true else food:=false; if food then snake[0].x:=snake[0].x+1; if (not food) then outputxy (snake[snake[0].x].x,snake[snake[0].x].y,' '); for i:=snake[0].x downto 2 do snake[i]:=snake[i-1]; snake[1]:=t; outputxy (t.x,t.y,snakechar); if food then begin map[t.x,t.y]:=0; score:=score+10*diff; gotoxy(65,3); write (score); rc; createfood; end; end; var i,diff,speed:integer; key:char; begin clrscr; window(1,1,80,25); textbackground(black); textcolor(blue); gotoxy(28,2);write('######################'); gotoxy(28,3);write('# #'); gotoxy(28,5);write('# #'); gotoxy(28,6);write('######################'); gotoxy(30,4); write('Greedy Snake a1.0'); gotoxy(22,11); write('Please input the difficulty (1-20): '); readln(diff); while ((diff<1) or (diff>20)) do begin clrscr; gotoxy(28,2);write('######################'); gotoxy(28,3);write('# #'); gotoxy(28,5);write('# #'); gotoxy(28,6);write('######################'); gotoxy(30,4); write('Greedy Snake a1.0'); gotoxy(22,11); write('Please input the difficulty (1-20): '); readln(diff); end; speed:=50 div trunc(sqrt(diff*2)); foodnum:=1;{22-diff;} wallnum:=diff*4; randomize; drawscreen(diff); initgame(foodnum,wallnum); while (true) do begin if keypressed then key:=readkey; if ord(key)=0 then key:=readkey; delay (speed*1000); if ((key='K') and (direct<>1)) then direct:=3; if ((key='P') and (direct<>0)) then direct:=2; if ((key='H') and (direct<>2)) then direct:=0; if ((key='M') and (direct<>3)) then direct:=1; if (key='p') then while (not keypressed) do; if (ord(key)=27) then begin clrscr; halt; end; walk(diff); end; end.

 
 

Pascal小游戏 贪吃蛇的更多相关文章

  1. 第一个windows 小游戏 贪吃蛇

    最近用dx尝试做了一个小的贪吃蛇游戏,代码放到github上面:https://github.com/nightwolf-chen/MyFreakout 说一下自己实现的过程: 首先,我把蛇这个抽象成 ...

  2. JavaScript面向对象编程小游戏---贪吃蛇

    1 面向对象编程思想在程序项目中有着非常明显的优势: 1- 1 代码可读性高.由于继承的存在,即使改变需求,那么维护也只是在局部模块 1- 2 维护非常方便并且成本较低. ​ 2 这个demo是采用了 ...

  3. 用Canvas制作小游戏——贪吃蛇

    今天呢,主要和小伙伴们分享一下一个贪吃蛇游戏从构思到实现的过程~因为我不是很喜欢直接PO代码,所以只copy代码的童鞋们请出门左转不谢. 按理说canvas与其应用是老生常谈了,可我在准备阶段却搜索不 ...

  4. 使用JavaScript实现简单的小游戏-贪吃蛇

    最近初学JavaScript,在这里分享贪吃蛇小游戏的实现过程, 希望能看到的前辈们能指出这个程序的不足之处. 大致思路 首先要解决的问题 随着蛇头的前进,尾巴也要前进. 用键盘控制蛇的运动方向. 初 ...

  5. python【控制台】小游戏--贪吃蛇

    传统贪吃蛇相信大家都玩过,也是一款很老很经典的游戏,今天我们用python控制台实现 项目有很多bug没有解决,因为本人一时兴起写的一个小游戏,所以只是实现可玩部分功能,并没有花较多的时间和精力去维护 ...

  6. 手把手教学h5小游戏 - 贪吃蛇

    简单的小游戏制作,代码量只有两三百行.游戏可自行扩展延申. 源码已发布至github,喜欢的点个小星星,源码入口:game-snake 游戏已发布,游戏入口:http://snake.game.yan ...

  7. Win32小游戏--贪吃蛇

    近日里学习了关于win32编程的相关知识,利用这些知识制作了一款贪吃蛇小游戏,具体细节还是分模块来叙述 前期准备:在网上找到一些贪吃蛇的游戏素材图片,以及具体的逻辑框图 在正式写功能之前,先把一系列环 ...

  8. Java_GUI小游戏--贪吃蛇

    贪吃蛇游戏:是一条蛇在封闭围墙里,围墙里随机出现一个食物,通过按键盘四个光标键控制蛇向上下左右四个方向移动,蛇头撞倒食物,则食物被吃掉,蛇身体长一节,接着又出现食物,等待蛇来吃,如果蛇在移动中撞到墙或 ...

  9. Java经典小游戏——贪吃蛇简单实现(附源码)

    一.使用知识 Jframe GUI 双向链表 线程 二.使用工具 IntelliJ IDEA jdk 1.8 三.开发过程 3.1素材准备 首先在开发之前应该准备一些素材,已备用,我主要找了一个图片以 ...

随机推荐

  1. 在你的andorid设备上运行netcore (Linux Deploy)

    最近注意到.net core 的新版本已经开始支持ARM 平台的CPU, 特意去Linux Deploy 中尝试了一下,真的可以运行 Welcome to Ubuntu 16.04 LTS (GNU/ ...

  2. 859. Buddy Strings (wrong 4 times so many cases to test and consider) if else**

    Given two strings A and B of lowercase letters, return true if and only if we can swap two letters i ...

  3. POJ - 3109 Inner Vertices

    不存在-1的情况,而且最多一轮就结束了.如果新增加的黑点v0会产生新的黑点v1,那么v0和v1肯定是在一条轴上的,而原来这条轴上已经有黑点了. 离散以后扫描线统计,往线段上插点,然后查询区间上点数. ...

  4. HashMap通过hashcode对其内容进行快速查找,而 TreeMap中所有的元素都保持着某种固定的顺序

    HashMap通过hashcode对其内容进行快速查找,而 TreeMap中所有的元素都保持着某种固定的顺序,如果你需要得到一个有序的结果你就应该使用TreeMap(HashMap中元素的排列顺序是不 ...

  5. 0x40二分法

    二分模板一共有两个,分别适用于不同情况.算法思路:假设目标值在闭区间[l, r]中, 每次将区间长度缩小一半,当l = r时,我们就找到了目标值. 版本1 在单调递增序列a中查找>=x的数中最小 ...

  6. sql server 基础

    1 .左连接 select a.* ,b.* from student as aleft join hobby as bon a.hobbyid=b.hobbyid 2. 右 连接 select a. ...

  7. HTTP Method 详细解读(`GET` `HEAD` `POST` `OPTIONS` `PUT` `DELETE` `TRACE` `CONNECT`)--转

    前言 HTTP Method的历史: HTTP 0.9 这个版本只有GET方法 HTTP 1.0 这个版本有GET HEAD POST这三个方法 HTTP 1.1 这个版本是当前版本,包含GET HE ...

  8. 测试 jdbc 中连接关闭的时机

    测试 jdbc 中连接关闭的时机 写一段程序,测试 jdbc 连接的关闭情况 /** * 测试 jdbc 连接的关闭情况 */ public static void testOpenCon(){ // ...

  9. IE 8 下小心使用console.log()

    我们很多情况下会使用console.log() 对代码调试.在chrome下和Firefox下都不会有太大问题,但是在最近我在IE8 下调试时使用了console.log(),就出现一些问题.在IE8 ...

  10. 第26章 FMC—扩展外部SDRAM—零死角玩转STM32-F429系列

    第26章     FMC—扩展外部SDRAM 全套200集视频教程和1000页PDF教程请到秉火论坛下载:www.firebbs.cn 野火视频教程优酷观看网址:http://i.youku.com/ ...