Pascal小游戏 贪吃蛇
一段未完成的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小游戏 贪吃蛇的更多相关文章
- 第一个windows 小游戏 贪吃蛇
最近用dx尝试做了一个小的贪吃蛇游戏,代码放到github上面:https://github.com/nightwolf-chen/MyFreakout 说一下自己实现的过程: 首先,我把蛇这个抽象成 ...
- JavaScript面向对象编程小游戏---贪吃蛇
1 面向对象编程思想在程序项目中有着非常明显的优势: 1- 1 代码可读性高.由于继承的存在,即使改变需求,那么维护也只是在局部模块 1- 2 维护非常方便并且成本较低. 2 这个demo是采用了 ...
- 用Canvas制作小游戏——贪吃蛇
今天呢,主要和小伙伴们分享一下一个贪吃蛇游戏从构思到实现的过程~因为我不是很喜欢直接PO代码,所以只copy代码的童鞋们请出门左转不谢. 按理说canvas与其应用是老生常谈了,可我在准备阶段却搜索不 ...
- 使用JavaScript实现简单的小游戏-贪吃蛇
最近初学JavaScript,在这里分享贪吃蛇小游戏的实现过程, 希望能看到的前辈们能指出这个程序的不足之处. 大致思路 首先要解决的问题 随着蛇头的前进,尾巴也要前进. 用键盘控制蛇的运动方向. 初 ...
- python【控制台】小游戏--贪吃蛇
传统贪吃蛇相信大家都玩过,也是一款很老很经典的游戏,今天我们用python控制台实现 项目有很多bug没有解决,因为本人一时兴起写的一个小游戏,所以只是实现可玩部分功能,并没有花较多的时间和精力去维护 ...
- 手把手教学h5小游戏 - 贪吃蛇
简单的小游戏制作,代码量只有两三百行.游戏可自行扩展延申. 源码已发布至github,喜欢的点个小星星,源码入口:game-snake 游戏已发布,游戏入口:http://snake.game.yan ...
- Win32小游戏--贪吃蛇
近日里学习了关于win32编程的相关知识,利用这些知识制作了一款贪吃蛇小游戏,具体细节还是分模块来叙述 前期准备:在网上找到一些贪吃蛇的游戏素材图片,以及具体的逻辑框图 在正式写功能之前,先把一系列环 ...
- Java_GUI小游戏--贪吃蛇
贪吃蛇游戏:是一条蛇在封闭围墙里,围墙里随机出现一个食物,通过按键盘四个光标键控制蛇向上下左右四个方向移动,蛇头撞倒食物,则食物被吃掉,蛇身体长一节,接着又出现食物,等待蛇来吃,如果蛇在移动中撞到墙或 ...
- Java经典小游戏——贪吃蛇简单实现(附源码)
一.使用知识 Jframe GUI 双向链表 线程 二.使用工具 IntelliJ IDEA jdk 1.8 三.开发过程 3.1素材准备 首先在开发之前应该准备一些素材,已备用,我主要找了一个图片以 ...
随机推荐
- 洛谷 P2814 家谱
题目背景 现代的人对于本家族血统越来越感兴趣. 题目描述 给出充足的父子关系,请你编写程序找到某个人的最早的祖先. 输入输出格式 输入格式: 输入由多行组成,首先是一系列有关父子关系的描述,其中每一组 ...
- ie6下按钮下边框消失不显示的问题
最近网站做改版,又发现一个ie6奇葩的问题,就一个很普通带边框的按钮,但在ie6中下边框不显示,ie7没有测试不知道是不是也不显示,其他浏览器正常 代码和预览效果如下: <style> b ...
- 指定类型的成员XX”不支持实体LINQ。只有初始化,成员单位,和实体导航性能的支持。
The specified type member 'DeleteFlag' is not supported in LINQ to Entities. Only initializers, enti ...
- 第22章 常用存储器介绍—零死角玩转STM32-F429系列
第22章 常用存储器介绍 全套200集视频教程和1000页PDF教程请到秉火论坛下载:www.firebbs.cn 野火视频教程优酷观看网址:http://i.youku.com/firege ...
- 1.Netty入门
Netty入门 1.Netty介绍 (1)百度百科介绍: Netty是由JBOSS提供的一个java开源框架.Netty提供异步的.事件驱动的网络应用程序框架和工具,用以快速开发高性能.高可靠性的网络 ...
- 写给iOS小白的MVVM教程(序)
这几天,需要重构下部分代码,这里简要记录下.但是涉及的技术要点还是很多,所以分为多个篇章叙述.此教程来源于,并将于应用于实践,不做过多的概念性阐释和争论.每个篇章都会附上实际的可执行的代码.因涉及的技 ...
- 【iOS】史上最全的iOS持续集成教程 (上)
:first-child{margin-top:0!important}.markdown-body>:last-child{margin-bottom:0!important}.markdow ...
- ZJOI2019Round#2
乱听课记录 关于树的分治问题&杂题选讲 张哲宇 边分治 (边分不是很鸡肋吗) 例题一 题目大意:给出两颗有正负边权的树,求出两个点\(u,v\)使得两棵树中\((u,v)\)距离的和最大. ...
- MySQL 5.7基于GTID的主从复制环境搭建(一主一从)
Preface As wel all know,replication base on GTID with row format of binary log is comprehens ...
- Xtrabackup实现MySQL备份
一.xtrabackup介绍 Xtrabackup是一个对InnoDB做数据备份的工具,支持在线热备份(备份时不影响数据读写)它由percona提供的mysql数据库备份工具,据官方介绍,这也是世界上 ...