• Archive by category "游戏"

Blog Archives

发布gridgame游戏包

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-game-gridgame/

gridgame

前言

为了能发布自己的游戏包,我们已经储备了很多的基础知识,包括 R语言面向对象编程、R包开发编程、R语言游戏编程 等,最后一步就到综合运用的时候了。按CRAN的R包发布的要求,把所有代码和文档串起来,就是我们要发布的gridgame游戏包。

目录

  1. 知识储备
  2. gridgame包开发
  3. gridgame包发布

1. 知识储备

在综合运用所有知识前,先回顾一下,我们都需要掌握哪些知识,1)R语言编程的基础是必需,2)游戏的算法主要是对矩阵的操作,线性代数最好也要掌握,3)游戏操作需要有界面,虽然不需要太好看,但我们也要有能力用代码画出游戏界面来,4)游戏的框架封装,对于相同类型的游戏,如果第二款游戏能延续第一款游戏的结构,不仅能简化开发节约时间,还能降低游戏技术门槛,就需要用面向对象的思维模式对游戏框架进行封装。

1.1 基础知识

上面列出的4个主要知识点,我都做技术准备,针对不同问题,参考不同文章就可以解决:

1.2 给R包起名

技术准备一切就绪,先给项目起个名字吧!

其实,起名也是有讲究的,不能太随便,虽然CRAN上面没有叫game包,但我们直接用game做为项目名字,也不是很好。如何起名最好先问问Google,找一个没有太多重名的关键字作为名字。

直接用google搜索 game 有 1,100,000,000 条结果,r game 有1,680,000,000条结果。我连0都数不过来了!和这么多搜索结果去竞争关键字,是我们在推广过程中不可逾越的鸿沟。

rgame-google

所以,换个名字让我们从小成长,找一个热度不是那么高的关键字,作为项目名字。gridgame就是一个不错的选择,既能表现游戏的特征,从推广角度又没有特别强大的竞争对手,一下子压力全无,倍感轻松!

gridgame-google

做好了各种准备工作,下面就是把gridgame包搞定了!

2. gridgame包开发

按照 在巨人的肩膀前行 催化R包开发 文章中介绍的标准化的开发流程,进行R包的开发。

本文的系统环境

  • Win7 64bit
  • R version 3.0.3 x86_64-w64-mingw32/x64 (64-bit)
  • Rtools31.exe
  • basic-miktex-2.9.5105.exe

由于有gridgame包开发的游戏都是基于Window平台的,而且我不打算支持Linux平台运行,所以我们的选择的R包开发环境,也应该是Window平台。后文中会介绍,为什么不支持Linux平台运行,R的版本最好也升级到3.0.3。(坑很多的,要一点一点填!)

2.1 构建工程

为了简化工作量,提高开发效率,我将按照devtools包的开发流程进行操作。

首先,打开一个项目目录,然后创建项目骨架。


~ cd /home/conan/R
~ R    

# 加载开发工具包
> library(devtools)
> library(roxygen2)
Loading required package: digest
> library(testthat)

# 创建项目骨架
> create(paste(getwd(),"/gridgame",sep=""))
Creating package gridgame in /home/conan/R
No DESCRIPTION found. Creating default:

Package: gridgame
Title:
Description:
Version: 0.1
Authors@R: # getOptions('devtools.desc.author')
Depends: R (>= 3.0.1)
License: # getOptions('devtools.desc.license')
LazyData: true

# 重置当前目录
> setwd(paste(getwd(),"/gridgame",sep=""))

# 查看项目骨架生成的文件
> dir(full.names=TRUE)
[1] "./DESCRIPTION" "./man"         "./R"

2.2 编写代码和文档

1). 编辑DESCRIPTION文件,增加项目的描述信息。


~ vi /home/conan/R/gridgame/DESCRIPTION

Package: gridgame
Type: Package
Title: A game framework for R
Version: 0.0.1
Date: 2014-07-23
Authors@R: c(person("Dan", "Zhang", email = "bsspirit@gmail.com", role
    =c("aut", "cre")))
Maintainer: Dan Zhang 
Description: This package provides a general-purpose game framework for grid game in R. The package includes 2 games about snake and 2048. You can run the function snake() or g2048() to startup the game. These games are only running on Window platform.
Depends:
    R (>= 3.0.1)
Imports:
    methods
License: GPL-3
URL: http://onbook.me/#/project/gridgame
BugReports: https://github.com/bsspirit/gridgame/issues
OS_type: windows
Collate:
    'game.R'
    '2048.R'
    'package.R'
    'snake.R'

DESCRIPTION文件中,有两个地方需要注意:

  • Imports: methods,由于我们用的是RC类型,系统默认会用methods包中的函数进行解析,必需在这里显示声明。
  • OS_type: windows,由于我们只仅支持Window系统运行,因此在后面上传到CRAN检查时,必需要指明支持的系统。同时,也是由于加了这个属性,再到Linux中执行R CMD check 过程的时候会自动失败,因此要求我们只能在windows系统中进行打包和发布的操作了。

2). 复制我们已经完成的3个R文件到 /home/conan/R/gridgame/R 目录下面。


~ ls -l
-rw-rw-r-- 1 conan conan 5030  7月 23 17:23 2048.R
-rw-rw-r-- 1 conan conan 2151  7月 23 17:18 game.R
-rw-rw-r-- 1 conan conan 5204  7月 23 17:23 snake.R

我们需要对代码进行再整理,都是检查失败错误。

  • 1. 去掉2048.R和snake.R代码中source()函数对game.R文件的引用。
  • 2. 去掉代码中所有中文注释,只能是ASCII码支持的字符。
  • 3. 在代码中增加Window平台检查,非Window则禁止运行,通过 .Platform$OS.type==’windows’ 代码,判断运行时的系统环境。
  • 4. 增加package.R文件,用于加载methods包的配置信息,#’ @import methods。
  • 5. 去掉代码中启动函数,启动交给用户来操作。

2.3 调试程序

在Windows系统开发环境中,通过load_all()函数加载程序包,然后运行一个snake()函数 或者 g2048()函数,一切正常。


# 加载程序包
> load_all(getwd())
Loading gridgame

# 启动snake游戏
> snake()

# 启动2048游戏
> g2048()

我们写的游戏程序,都是在window7下开发的,运行一切正常,那么为什么不支持在Linux系统中运行呢? 主要原因是 Linux和Window7有不同的图形设备输出。windows系统中,输出设备是通过.net框架来支持的;而Linux系统中的输出设备是X11()显示驱动支持,或者通过在Linux系统中加载第三方的tk设备支持,R语言通过tkrplot包来实现调用。


~ sudo apt-get install tk-dev
> install.packages("tkrplot")

Windows系统和Linux系统对于运行GUI程序是有区别的,无法统一用一套代码来完成。有人会说,每个地方都增加系统类型的判断条件,就能可实现了。

当然情况并不是这么简单,除了输出设备的问题以外,Linux上面还会遇到字体的问题,字库不全将导致字符加载失败的错误。下面的问题,Linux系统中没有helvetica的60号字体。


Error in text.default(0.5, 0.7, label = name, cex = 5) : 
  X11 font -adobe-helvetica-%s-%s-*-*-%d-*-*-*-*-*-*-*, face 1 at size 60 could not be loaded

虽然在Linux Ubuntu环境中,我尝试了安装所有字体库,仍然无法解决大号字体的加载问题。所以,我决定最终将不支持Linux平台。


~ sudo apt-get install xfont-100dpi xfont-75dpi xfont-cyrillic xfont-*

2.4 单元测试

在inst/test目录下面,我们分别针对不同的文件,创建单元测试类。

  • test-game.R, 对game.R的函数进行单元测试
  • test-snake.R,对snake.R的函数进行单元测试
  • test-2048.R,对2048.R的函数进行单元测试

以test-game.R为例,打开test-game.R文件


~ vi inst/test/test-game.R

context("game")

test_that("Initial the construct function of Game class", {
  name<-"R"
  width<-height<-10
  
  game<-Game$new()
  game$initFields(name=name,width=width,height=height)
  expect_that(game$name,equals(name))
  expect_that(game$width,equals(width))
  expect_that(game$height,equals(height))
})

执行单元测试代码。


> test(getwd())
Testing gridgame
Loading gridgame
game : ...

2.5 撰写文档

R包开发中最繁琐的一个过程,就是撰写文档,Latex的格式文档。幸好有人发明了roxygen2包,通过简单的注释规则来生成Latex文档。

我们用roxygen2包,来生成man/*.Rd的文档文件,对RC类型的程序,其实就可以偷点懒了,只是在类的定义上,增加注释就行了。RC类中方法的注释,就没强制的检查了。多写少写就看开发者的心情了。如果是S3的编程方式或者纯函数式的包,那么写文档也是一件很辛苦的工程呢。当然,文件不能出现中文字符,不然check过程的时候,还是会有警告发生的。

以snake.R文件中注释为例,我们只写setRefClass的注释 和 snake<-function(){}的注释就行了,Snake类的内部方法就省略了。


~ vi snake.R

#' Snake game class
#' @include game.R
Snake<-setRefClass("Snake",contains="Game",
   ...
)

#' Snake game function
#'
#' @export
snake<-function(){
  game<-Snake$new()
  game$initFields()
  game$run()
}

通过代码中的注释生成Latex文件。


> document(getwd())
Updating gridgame documentation
Loading gridgame
Writing G2048-class.Rd
Writing g2048.Rd
Writing Game-class.Rd
Writing Snake-class.Rd
Writing snake.Rd

打开snake.Rd文件,看看生成的内容。


~ vi man/snake.Rd

% Generated by roxygen2 (4.0.1): do not edit by hand
\name{snake}
\alias{snake}
\title{Snake game function}
\usage{
snake()
}
\description{
Snake game function
}

这一步的操作过程,其实也不是一帆风顺的。在引用roxygen2 包的时候,我同样遇到的问题了。
在Window环境中,roxygen2包 依赖于R 3.0.2以上的版本,R 3.0.1版本的R程序装不上roxygen2包。github有对这个强依赖问题的描述:https://github.com/klutometis/roxygen/issues/163

所以,上文中指定的R 3.0.3的版本环境,是实践检验出来的。

2.6 程序检查

程序检查,这一步其实是所有操作过程最容易出错的,而且还搞不定。R的打包的检查真的很严格啊!!

在Windows平台中开发R包,要装额外装两个软件 Rtools(http://cran.us.r-project.org/bin/windows/Rtools/) 和 MikTeX (http://www.miktex.org/download),不仅版本要和R语言环境对上,还要配置环境变量。MikTeX在调用过程中,还会遇到文件找不到,pdflatex.exe运行的错误 等等。

比如,其中的一个常见错误:


* checking PDF version of manual ... WARNING
LaTeX errors when creating PDF version.
This typically indicates Rd problems.
LaTeX errors found:
!pdfTeX error: pdflatex.EXE (file ts1-zi4r): Font ts1-zi4r at 540 not found
 ==> Fatal error occurred, no output PDF file produced!
* checking PDF version of manual without hyperrefs or index ... ERROR

解决方法,运行下面的命令。


~ updmap 
~ initexmf --update-fndb
~ initexmf --edit-config-file updmap

# 在文件中增加一行
Map zi4.map 

~ initexmf --mkmaps

最后,如果经过9*9=81难,终于修成正果,一路OK的完成了!


> check(getwd())
Updating gridgame documentation
Loading gridgame
Writing NAMESPACE
Writing G2048-class.Rd
Writing g2048.Rd
Writing Game-class.Rd
Writing Snake-class.Rd
Writing snake.Rd
"C:/PROGRA~1/R/R-30~1.3/bin/x64/R" --vanilla CMD build  \
  "D:\workspace\R\app\gridgame" --no-manual --no-resave-data

* checking for file 'D:\workspace\R\app\gridgame/DESCRIPTION' ... OK
* preparing 'gridgame':
* checking DESCRIPTION meta-information ... OK
* checking for LF line-endings in source and make files
* checking for empty or unneeded directories
* building 'gridgame_0.0.1.tar.gz'

"C:/PROGRA~1/R/R-30~1.3/bin/x64/R" --vanilla CMD check  \
  "C:\Users\ADMINI~1\AppData\Local\Temp\RtmponOeAc/gridgame_0.0.1.tar.gz"  \
  --timings

* using log directory 'C:/Users/ADMINI~1/AppData/Local/Temp/RtmponOeAc/gridgame.Rcheck'
* using R version 3.0.3 (2014-03-06)
* using platform: x86_64-w64-mingw32 (64-bit)
* using session charset: ASCII
* checking for file 'gridgame/DESCRIPTION' ... OK
* checking extension type ... Package
* this is package 'gridgame' version '0.0.1'
* checking package namespace information ... OK
* checking package dependencies ... OK
* checking if this is a source package ... OK
* checking if there is a namespace ... OK
* checking for executable files ... OK
* checking for hidden files and directories ... OK
* checking for portable file names ... OK
* checking whether package 'gridgame' can be installed ... OK
* checking installed package size ... OK
* checking package directory ... OK
* checking DESCRIPTION meta-information ... OK
* checking top-level files ... OK
* checking for left-over files ... OK
* checking index information ... OK
* checking package subdirectories ... OK
* checking R files for non-ASCII characters ... OK
* checking R files for syntax errors ... OK
* checking whether the package can be loaded ... OK
* checking whether the package can be loaded with stated dependencies ... OK
* checking whether the package can be unloaded cleanly ... OK
* checking whether the namespace can be loaded with stated dependencies ... OK
* checking whether the namespace can be unloaded cleanly ... OK
* checking loading without being on the library search path ... OK
* checking dependencies in R code ... OK
* checking S3 generic/method consistency ... OK
* checking replacement functions ... OK
* checking foreign function calls ... OK
* checking R code for possible problems ... OK
* checking Rd files ... OK
* checking Rd metadata ... OK
* checking Rd cross-references ... OK
* checking for missing documentation entries ... OK
* checking for code/documentation mismatches ... OK
* checking Rd \usage sections ... OK
* checking Rd contents ... OK
* checking for unstated dependencies in examples ... OK
* checking examples ... OK
* checking PDF version of manual ... OK

在执行check过程中,你的项目里可能会有其他的文件,检查也过不去的。你可新建一个文件.Rbuildignore,通过这个文件配置,可以忽略不希望参与打包的文件。


~ vi .Rbuildignore

.gitignore
dist
^.*\.Rproj$
^\.Rproj\.user$
README*
NEWS*
FAQ*

这样一些帮助文件,就能躲避检查了。

2.7 程序打包

在检查通过以后,我们就可以自由地打包了,用build命令。

我们可以选择2种打包方式,源代码打包和二进打包。

默认是给源代码打包。


> build()
"C:/PROGRA~1/R/R-30~1.3/bin/x64/R" --vanilla CMD build  \
  "D:\workspace\R\app\gridgame" --no-manual --no-resave-data

* checking for file 'D:\workspace\R\app\gridgame/DESCRIPTION' ... OK
* preparing 'gridgame':
* checking DESCRIPTION meta-information ... OK
* checking for LF line-endings in source and make files
* checking for empty or unneeded directories
* building 'gridgame_0.0.2.tar.gz'

[1] "D:/workspace/R/app/gridgame_0.0.2.tar.gz"

二进制打包


> build(binary=TRUE)
"C:/PROGRA~1/R/R-30~1.3/bin/x64/R" --vanilla CMD INSTALL  \
  "D:\workspace\R\app\gridgame" --build

* installing to library 'C:/Users/Administrator/AppData/Local/Temp/RtmpI3hhpp'
* installing *source* package 'gridgame' ...
** R
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** testing if installed package can be loaded
*** arch - i386
*** arch - x64
* MD5 sums
packaged installation of 'gridgame' as gridgame_0.0.2.zip
* DONE (gridgame)
[1] "D:/workspace/R/app/gridgame_0.0.2.zip"

这两个文件都可以用出来发布项目,用户下载后可以直接进行安装。


# 安装命令
~ R CMD INSTALL gridgame_0.0.2.tar.gz
* installing to library 'C:/Users/Administrator/R/win-library/3.0'
* installing *source* package 'gridgame' ...
** R
** inst
** preparing package for lazy loading
** help
*** installing help indices
** building package indices
** testing if installed package can be loaded
*** arch - i386
*** arch - x64
* DONE (gridgame)

3. gridgame包发布

最后一步,就是把我的好不容易开发的包,发布到资源库。有3个地方可以发布。

  • CRAN:R的官方发布平台
  • R-Forge:R-Forge发布平台
  • RForge:RForge发布平台
  • Github:个人开源发布平台

3.1 Github:个人的开源发布平台

在Github上发布是最容易的,只要把项目代码上传到Github就完成了,都不需要做check()检查。基于Github的包管理工具是devtools包,我把gridgame项目已上传到Github, 项目地址是:https://github.com/bsspirit/gridgame,用户可以下面两种方式,直接从Github安装gridgame项目。

方法一:使用devtools包,二进制安装。


library(devtools)
install_github("gridgame","bsspirit")

方法二:通过源代码安装。


git clone https://github.com/bsspirit/gridgame.git
R CMD BUILD gridgame
R CMD INSTALL gridgame_*.tar.gz

3.2 R-Forge:R-Forge发布平台

在R-Forge(https://r-forge.r-project.org/)发布,就比较麻烦了,你需要先注册一个账号,https://r-forge.r-project.org/account/register.php,登陆后,再新建一个项目,需要等72小时审核才能通过。

在R-Forge中,gridgame项目管理界面截图
rfroge1

然后,通过SVN把项目的源代码提交上去。我用习惯了Git进行版本管理,再用回SVN感觉好老土啊!

在RForge提交代码,并运行通过以后,你会有项目介绍页:http://gridgame.r-forge.r-project.org/,别个会看到介绍,下载你的包。

rfroge2

用户可以直接查看项目信息 http://gridgame.r-forge.r-project.org/,也可以在线查看项目源代码,https://r-forge.r-project.org/scm/viewvc.php/?root=gridgame,R-Froge平台会每天自动打包一次。

3.3 RForge:RForge发布平台

此RForge(http://rforge.net/)非R-Froge,竟然两个名字如此之近似,第一次用的人肯定会混的。首先注册RForge账号,同时注册一个要发布的项目。gridgame项目,我已经上传到Github了,这边能直接导入Github项目,就非常方便了。

rfroge

通过RForge源下载gridgame包,可以直接用install.packages()函数。


install.packages('gridgame', repos = 'http://rforge.net')  # 未发布成功,请先用Github的方案

3.4 CRAN发布:R的官方发布平台

这4个发布平台,CRAN是最全威的、是官方的,也不是那么容易发布的,有很严格的审查机制。CRAN发布条款:http://cran.r-project.org/web/packages/policies.html

我们明白政策后,通过 http://cran.r-project.org/submit.html 提交项目,大概要等待48小时审查。可能我这个包的问题比较严重6个小时内有就了回复。

  • 第一次不合格:没有标出只支持Window平台,对应DESCRIPTION文件中OS_type: windows。(当然,他是不会告诉你怎么改的,找自己Google找)
  • 第二次不合格:Linux平台R CMD check出错。(加了OS_type后,Linux执行当然会出错了,老外似乎也晕了。)
  • 第三次不合格:为什么Linux不能用,为什么用.Platform$OS.type的代码检查,getGraphicsEvent在没有GUI的环境中怎么办,文档不全,对game framework的定义不清楚。(费了好大劲的解释,把这几篇文章的设计理念,写了封总结的邮件。)
  • 第四次不合格:这次Uwe Ligges的态度很强硬,必须把Rd写完整,必须支持至少2个平台,必须对getGraphicsEvent进行检查,必须处理OS.type的代码问题,没有商量的余地,不搞定就不发包。(我真是悲剧了,看来发布项目,又要延迟一周了。)

下面是,提交项目到CRAN过程。

第一步:填写用户基本信息,并上传打好的tar.gz包
cran1

第二步:核对DESCRIPTION文件中的描述,与网页自动解析的内容是否一致。
cran2

第三步:等待审核。
cran3

第一次不合格,老外回复的邮件:


On 25/07/2014 04:24, Dan Zhang wrote:
> [This was generated from CRAN.R-project.org/submit.html]
>
> The following package was uploaded to CRAN:
> ===========================================
>
> Package Information:
> Package: gridgame
> Version: 0.0.1
> Title: A game framework for R
> Author(s): Dan Zhang [aut, cre]
> Maintainer: Dan Zhang 
> Depends: R (>= 3.0.1)
> Description: This package provides a general-purpose game framework for
 
'This package provides' is redundant.
 
>    grid game in R. The package includes 2 games about snake and
>    2048. You can run the function snake() or g2048() to startup
>    the game. These games are only running on Window platform.
 
Eh?  The CRAN policies do not allow such a package, and you have not
marked this as Windows-only.
> License: GPL-3
> Imports: methods
>
>
> The maintainer confirms that he or she
> has read and agrees to the CRAN policies.
>
> Submitter's comment: This package provides a general-purpose game
>    framework for grid game in R. The package includes 2
>    games about snake and 2048. You can run the function
>    snake() or g2048() to startup the game. These games
>    are only running on Window platform.
>

--
Brian D. Ripley,                  ripley@stats.ox.ac.uk
Professor of Applied Statistics, http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595

经过多次的对决和修改,终于把包成功发布到了CRAN。

同学们可以直接下载使用了。


# 从CRAN下载gridgame包
install.packages('gridgame')  # 未发布成功,请先用Github的方案

# 加载gridgame包
library(gridgame)

# 启动贪食蛇游戏
snake()

# 启动2048游戏
g2048()

到CRAN上发布一个R包,真是不一件轻松的事情啊。坚持,修改,打磨,再坚持,虽然过程很痛苦,但是软件质量最终得到了保证,这就是CRAN严格审查的意义。

转载请注明出处:
http://blog.fens.me/r-game-gridgame/

打赏作者

R语言游戏之旅 游戏2048

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-game-2048/

game-2048

前言

150行代码写出游戏2048,哪种语言能实现?答案是R语言。虽然R语言并不适合做游戏开发,但是R语言中的向量计算,能极大地简化矩阵算法代码实现的复杂度,可以高效的完成计算任务。如果我们把游戏问题变成数学问题,那么R就是绝佳的工具。

目录

  1. 2048游戏介绍
  2. 场景设计
  3. 程序设计
  4. R语言实现

1. 2048游戏介绍

2048是一款单人在线和移动端游戏,由19岁的意大利人Gabriele Cirulli于2014年3月开发。游戏任务是在一个网格上滑动小方块来进行组合,直到形成一个带有有数字2048的方块,它是滑块类游戏的一种电脑变体。作者开发这个游戏是为了测试自己是否有能力从零开始创造一款游戏,但游戏飙升的人气(不到1周内有400万访客)完全出乎他的预料。事实上,它已被称为网络上「最上瘾的东西」,华尔街日报将其评价为「属于数学极客的 Candy Crush」。

2048_game1

该游戏为开源软件,这导致它衍生出许多改进版和变种,包括积分排行榜和提升的触屏可玩性等。2048是基于HTML5的Javascript应用,源代码的地址:https://github.com/gabrielecirulli/2048,免费的在线版本:http://gabrielecirulli.github.io/2048/。当然本文中R语言的程序现实,完全是我的想法,与游戏作者的JS源代码无关。

游戏玩法

该游戏使用方向键让方块上下左右移动。如果两个带有相同数字的方块在移动中碰撞,则它们会合并为一个数字,为两者之和。每次移动时,会有一个值为2或者4的新方块出现。当值为2048的方块出现时,游戏即胜利,该游戏因此得名。

2. 场景设计

接下来,就回了游戏设计环节,如同上篇文章 R语言游戏之旅 贪食蛇入门 一样。要开发这款游戏,我们应该如何动手呢?我们需要从软件开发的角度,对这款游戏进行需求分析,列出游戏的规则,并设计业务流程,给出游戏的原型,验证是否可行。

2.1 需求分析

2048游戏,应该有3个场景:开机场景,游戏场景,结束场景。

  • 开机场景:运行程序,在游戏前,给用户做准备,并提示如何操作游戏。
  • 游戏场景:游戏运行中的场景。
  • 结束场景:当用户胜利、失败或退出时的场景,并提示用户在游戏中的得分。

开机场景和结束场景比较简单,不再解释。游戏场景,包括一块4*4的画布,画面中每个格子对应一个数字,数字大于0的格子有背景颜色填充。

2.2 游戏规则

游戏进行时的规则:

  • 1. 开始游戏后,用户可以通过上(up)下(down)左(left)右(right)键,来控制数字的移动。
  • 2. 如果两个相同的数字在移动中碰撞,则它们会合并为一个方块,且所带数字变为两者之和。
  • 3. 每次移动时,会有一个值为2或者4的新数字出现。
  • 4. 当用户按键操作,数字的顺序未发生变化时,则不会生成新数字,视为无效的按键操作。
  • 5. 当画布格子被数字填满时,而在上下左边方向,无可合并的数字时,则游戏失败。

2.3 业务流程

场景切换的流程:

  • 打开程序时,用户首先看到开机场景,按任意键后进入游戏场景。
  • 在游戏场景,当游戏失败,进入结束场景;按q键,则直接游戏失败。
  • 在结束场景,按空格回到开机场景;按q键,则直接能出软件。

snake-process

业务流程,同贪食蛇游戏的业务流程。

2.4 游戏原型

我们画出3个场景的界面。左边为开机场景,中间是游戏场景,右边是结束场景。

game-2048-2

我们根据游戏原型的图,用程序画出游戏的场景。

3. 程序设计

通过上面的功能需求分析,我们已经非常清楚地了解 2048游戏 的各种规则和功能。接下来,我们要把需求分析中的业务语言,通过技术语言重新描述,并考虑非功能需求,以及R语言相关的技术细节。

3.1 游戏场景

我们让每个场景对应于一块画布,及每个场景对应一个内存结构。

  • 开机场景,是静态的,我们可以提前生成好这块画布存储起来,也可以当用户切换时再临时生成,性能开销不大。
  • 游戏场景,是动态的,每进行一次用户的交互行为或按时间刷新时,都需要求重新绘制画布,让游戏场景通过绑定事件来生成画布。
  • 结束场景,是动态的,在结束场景会显示当次游戏的得分,需要在切换时临时生成。

3.2 游戏对象

在游戏进行中,会产生很多的对象,如上文中提到的。这些对象都需要在内存中进行定义,匹配到对应程序语言的数据类型。

比起贪食蛇游戏,2048游戏要简单的多,我只需要定义一个画布对象就行了。

  • 画布对象:用矩阵来描述。
  • 画布中的数字:用矩阵中的数字值来表示。
  • 画布的背景色:用矩阵中的数字值来表示。

通过矩阵来描述游戏画布和对象:

矩阵结构:


     [,1] [,2] [,3] [,4]
[1,]    4   32    4   32
[2,]   32   16    2    4
[3,]    4    2    8    2
[4,]    2    8    2    0

对应该的游戏画布:
game-2048-3

3.3 游戏事件

游戏过程中,会有2种事件,键盘事件和碰撞事件。

  • 键盘事件:全局事件,用户通过键盘输入,而触发的事件,比如,上下左右控制蛇的移动方向。
  • 碰撞事件:如果两个相同的数字在移动中碰撞,则它们会合并为一个数字。

全局监听键盘事件,用键盘事件触发碰撞事件,检查游戏状态。

3.4 游戏控制

在游戏进行中,每个状态我们都需要进行控制的。比如,什么生成新的数字,什么合并相同的数字,什么时候游戏结束等。通过定义控制函数,可以方便我们管理游戏运行中的各种游戏状态。

game-2048-process

上图中每个方块代表一个R语言函数定义:

  • run():启动程序。
  • keydown():监听键盘事件,锁定线程。
  • stage0():创建开机场景,可视化输出。
  • stage1():创建游戏场景,可视化输出。
  • stage2():创建结束场景,可视化输出。
  • init():打开游戏场景时,初始化游戏变量。
  • create():判断并生成数字。
  • move():移动数字。
  • lose():失败查询,判断当画布格子是否被被数字填满时,且不能合并的数字时,进行结束场景。
  • drawTable():绘制游戏背景。
  • drawMatrix():绘制游戏矩阵。

通过程序设计过程,我们就把需求分析中的业务语言描述,变成了程序开发中的技术语言描述。经过完整的设计后,最后就剩下写代码了。

4. R语言实现

按照上面的函数定义,我们把代码像填空一样地写进去就行了。由于我们之前已经做好了一个游戏框架,场景函数及功能函数定义已在框架中现实了一部分,就可以更方便地填入游戏代码了。关于R语言游戏框架介绍,请参考文章:R语言游戏框架设计

4.1 数字移动函数 move()

2048游戏算法上最复杂的操作,就是数字移动。在4*4的矩阵中,数字会按上下左右四个方向移动,相同的数字在移动中碰撞时会进行合并。这个算法是2048游戏的核心算法,我们的程序要保证数字合并正确性。

我们先把这个函数从框架中抽出来,单独进行实现和单元测试。

构建函数moveFun(),这里简化移动过程,只考虑左右移动,再通过倒序的算法,让左右移动的核心算法共用一套代码。


> moveFun<-function(x,dir){
+   if(dir == 'right') x<-rev(x)
+   
+   len0<-length(which(x==0)) # 0长度
+   x1<-x[which(x>0)] #去掉0
+   pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置
+   
+   if(length(pos1)==3){ #3个索引
+     pos1<-pos1[c(1,3)]
+   }else if(length(pos1)==2 && diff(pos1)==1){ #2个索引
+     pos1<-pos1[1]
+   }
+   
+   x1[pos1]<-x1[pos1]*2
+   x1[pos1+1]<-0
+   
+   x1<-x1[which(x1>0)] #去掉0
+   x1<-c(x1,rep(0,4))[1:4] #补0,取4个
+   
+   if(dir == 'right') x1<-rev(x1)
+   return(x1)
+ }

接下来,为了检验函数moveFun()的正确性,我们使用单元测试工具包testthat,来检验算法是否正确。关于testthat包的介绍,请参考文章 在巨人的肩膀前行 催化R包开发

按游戏规则我们模拟数字左右移动,验证计算结果是否与我们给出的目标值相同。

game-2048-move

单元测试的代码


> library(testthat)
> x<-c(4,2,2,2)
> expect_that(moveFun(x,'left'), equals(c(4,4,2,0)))
> expect_that(moveFun(x,'right'), equals(c(0,4,2,4)))
 
> x<-c(4,4,2,4)
> expect_that(moveFun(x,'left'), equals(c(8,2,4,0)))
> expect_that(moveFun(x,'right'), equals(c(0,8,2,4)))
 
> x<-c(2,2,0,2)
> expect_that(moveFun(x,'left'), equals(c(4,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))
 
> x<-c(2,4,2,4)
> expect_that(moveFun(x,'left'), equals(c(2,4,2,4)))
> expect_that(moveFun(x,'right'), equals(c(2,4,2,4)))
 
> x<-c(4,4,2,2)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,8,4)))
 
> x<-c(2,2,4,4)
> expect_that(moveFun(x,'left'), equals(c(4,8,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
 
> x<-c(4,4,0,4)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
 
> x<-c(4,0,4,4)
> expect_that(moveFun(x,'left'), equals(c(8,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,8)))
 
> x<-c(4,0,4,2)
> expect_that(moveFun(x,'left'), equals(c(8,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,8,2)))
 
> x<-c(2,2,2,2)
> expect_that(moveFun(x,'left'), equals(c(4,4,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,4,4)))
 
> x<-c(2,2,2,0)
> expect_that(moveFun(x,'left'), equals(c(4,2,0,0)))
> expect_that(moveFun(x,'right'), equals(c(0,0,2,4)))

当然,我们还可以写更多的测试用例,来检验函数的正确性。这样就实现了,数字移动的核心算法了。

4.2 其他函数实现

开机场景函数stage0()


 # 开机画图
 stage0=function(){
   callSuper()
   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
   text(0.5,0.7,label=name,cex=5)
   text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
   text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
   text(0.2,0.05,label="Author:DanZhang",cex=1)
   text(0.5,0.05,label="http://blog.fens.me",cex=1)
 }

结束场景函数stage2()


 # 结束画图
 stage2=function(){
   callSuper()
   info<-paste("Congratulations! You have max number",max(m),"!")
   print(info)
   
   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
   text(0.5,0.7,label="Game Over",cex=5)
   text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
   text(0.5,0.3,label=info,cex=2,col=2)
   text(0.2,0.05,label="Author:DanZhang",cex=1)
   text(0.5,0.05,label="http://blog.fens.me",cex=1)
 }

键盘事件,控制场景切换


 # 键盘事件,控制场景切换
 keydown=function(K){
   callSuper(K)
   
   if(stage==1){ #游戏中
	 if(K == "q") stage2()
	 else {
	   if(tolower(K) %in% c("up","down","left","right")){
		 e$dir<<-tolower(K)
		 print(e$dir)
		 stage1()  
	   }
	 }
	 return(NULL)
   }
   return(NULL)
 }

游戏场景初始化函数init()


 # 初始化变量
 init = function(){
   callSuper()  # 调父类
   
   e$max<<-4 # 最大数字
   e$step<<-1/width #步长
   e$dir<<-'up'
   e$colors<<-rainbow(14) #颜色
   e$stop<<-FALSE #不满足移动条件
   
   create()
 }

随机产生一个新数字函数create()


 # 随机产生一个新数字
 create=function(){
   if(length(index(0))>0 & !e$stop){
	 e$stop<<-TRUE	 
	 one<-sample(c(2,4),1)
	 idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))
	 m[idx]<<-one
   }
 }

失败条件函数lose()


 #失败条件
 lose=function(){
   
   # 判断是否有相邻的有重复值
   near<-function(x){
	 length(which(diff(x)==0))
   }

   # 无空格子
   if(length(index(0))==0){
	 h<-apply(m,1,near)  # 水平方向
	 v<-apply(m,2,near) # 垂直方向
	 
	 if(length(which(h>0))==0 & length(which(v>0))==0){
	   fail("No free grid.")
	   return(NULL)
	 }
   }
 }

游戏画布函数drawTable()


 # 画布背景
 drawTable=function(){
   if(isFail) return(NULL)
   plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
   abline(h=seq(0,1,e$step),col="gray60") # 水平线
   abline(v=seq(0,1,e$step),col="gray60") # 垂直线
 }

游戏矩阵函数drawMatrix()


 # 根据矩阵画数据
 drawMatrix=function(){
   if(isFail) return(NULL)
   a<-c(t(m))
   lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])
   
   d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)
   df<-d[which(d$lab>0),]
   points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)
   text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)
 }

游戏场景函数stage1()


 # 游戏场景
 stage1=function(){
   callSuper()
   
   move()
   lose()
   create()
   
   drawTable()
   drawMatrix()  
 }

完整的程序代码


source(file="game.r") #加载游戏框架

# Snake类,继承Game类
G2048<-setRefClass("G2048",contains="Game",
                   
   methods=list(
     
     # 构造函数
     initialize = function(name,debug) {
       callSuper(name,debug) # 调父类
       
       name<<-"2048 Game"
       width<<-height<<-4
     },
     
     # 初始化变量
     init = function(){
       callSuper()  # 调父类
       
       e$max<<-4 # 最大数字
       e$step<<-1/width #步长
       e$dir<<-'up'
       e$colors<<-rainbow(14) #颜色
       e$stop<<-FALSE #不满足移动条件
       
       create()
     },
     
     # 随机产生一个新数字
     create=function(){
       if(length(index(0))>0 & !e$stop){
         e$stop<<-TRUE         
         one<-sample(c(2,4),1)
         idx<-ifelse(length(index(0))==1,index(0),sample(index(0),1))
         m[idx]<<-one
       }      
     },
     
     #失败条件
     lose=function(){
       
       # 判断是否有相邻的有重复值
       near<-function(x){
         length(which(diff(x)==0))
       }

       # 无空格子
       if(length(index(0))==0){
         h<-apply(m,1,near)  # 水平方向
         v<-apply(m,2,near) # 垂直方向
         
         if(length(which(h>0))==0 & length(which(v>0))==0){
           fail("No free grid.")
           return(NULL)
         }
       }
     },
     
     # 方向移动
     move=function(){
       
       # 方向移动函数
       moveFun=function(x){
         if(e$dir %in% c('right','down')) x<-rev(x)
         
         len0<-length(which(x==0)) # 0长度
         x1<-x[which(x>0)] #去掉0
         pos1<-which(diff(x1)==0) # 找到挨着相等的元素的位置
         
         if(length(pos1)==3){ #3个索引
           pos1<-pos1[c(1,3)]
         }else if(length(pos1)==2 && diff(pos1)==1){ #2个索引
           pos1<-pos1[1]
         }
         
         x1[pos1]<-x1[pos1]*2
         x1[pos1+1]<-0
         
         x1<-x1[which(x1>0)] #去掉0
         x1<-c(x1,rep(0,4))[1:4] #补0,取4个
         
         if(e$dir %in% c('right','down')) x1<-rev(x1)
         return(x1)
       }
       
       last_m<-m
       if(e$dir=='left')  m<<-t(apply(m,1,moveFun))
       if(e$dir=='right') m<<-t(apply(m,1,moveFun))
       if(e$dir=='up')    m<<-apply(m,2,moveFun)
       if(e$dir=='down')  m<<-apply(m,2,moveFun)
       
       e$stop<<-ifelse(length(which(m != last_m))==0,TRUE,FALSE)
     },
     
     # 画布背景
     drawTable=function(){
       if(isFail) return(NULL)
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       abline(h=seq(0,1,e$step),col="gray60") # 水平线
       abline(v=seq(0,1,e$step),col="gray60") # 垂直线
     },
     
     # 根据矩阵画数据
     drawMatrix=function(){
       if(isFail) return(NULL)
       a<-c(t(m))
       lab<-c(a[13:16],a[9:12],a[5:8],a[1:4])
       
       d<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=lab)
       df<-d[which(d$lab>0),]
       points(df$x+e$step/2,df$y+e$step/2,col=e$colors[log(df$lab,2)],pch=15,cex=23)
       text(df$x+e$step/2,df$y+e$step/2,label=df$lab,cex=2)
     },
     
     # 游戏场景
     stage1=function(){
       callSuper()
       
       move()
       lose()
       create()
       
       drawTable()
       drawMatrix()  
     },
     
     # 开机画图
     stage0=function(){
       callSuper()
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       text(0.5,0.7,label=name,cex=5)
       text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
       text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
       text(0.2,0.05,label="Author:DanZhang",cex=1)
       text(0.5,0.05,label="http://blog.fens.me",cex=1)
     },
     
     # 结束画图
     stage2=function(){
       callSuper()
       info<-paste("Congratulations! You have max number",max(m),"!")
       print(info)
       
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       text(0.5,0.7,label="Game Over",cex=5)
       text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
       text(0.5,0.3,label=info,cex=2,col=2)
       text(0.2,0.05,label="Author:DanZhang",cex=1)
       text(0.5,0.05,label="http://blog.fens.me",cex=1)
     },
     
     # 键盘事件,控制场景切换
     keydown=function(K){
       callSuper(K)
       
       if(stage==1){ #游戏中
         if(K == "q") stage2()
         else {
           if(tolower(K) %in% c("up","down","left","right")){
             e$dir<<-tolower(K)
             stage1()  
           }
         }
         return(NULL)
       }
       return(NULL)
     }
     
   )
)

# 封装启动函数
g2048<-function(){
  game<-G2048$new()
  game$initFields(debug=TRUE)
  game$run()
}

# 启动游戏
g2048()

游戏截图:
2048

全部代码仅仅190行,有效代码行只有150行左右,我们就实现了2048游戏。用R语言处理矩阵的向量计算,还是很方便的,另外我们又用面向对象的方法,对游戏程序进行了统一的封装,标准化了函数定义和接口,让我们能更专注于游戏算法本身,提高开发的效率。下一步,就可以把游戏这个框架项目打包发布到CRAN了。

转载请注明出处:
http://blog.fens.me/r-game-2048/

打赏作者

R语言游戏框架设计

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-game-framework/

r-game-framework

前言

本文继续上一篇文章 R语言游戏之旅 贪食蛇入门。当我们完成了贪食蛇游戏之后,我们应该把代码进一步整理,抽象出游戏中通用的部分,分离游戏框架代码和贪食蛇游戏代码。我们就可以提取出一个R语言的游戏开发引擎,当再开发新的游戏时,只要关心游戏本身的程序设计就行了。

目录

  1. 贪食蛇的面向对象改造
  2. 游戏框架定义
  3. 在框架中重新实现贪食蛇游戏

1. 贪食蛇的面向对象改造

我们可以利用面向对象的方法论,对贪食蛇游戏进行抽象整理,并实现代码的面向对象的改造。R语言支持3种面向对象的编程实现方式,我选择基于RC的面向对象编程,关于RC详细使用请参考文章:R语言基于RC的面向对象编程

由于我们之前的代码都是通过函数来封装的,所以代码重构还是比较简单的,只要把Snake对象的属性和方法定义清楚就行了。

1.1 定义Snake类

定义Snake类,画出类图,包括属性和方法。

class1

属性解释:

  • name:游戏的名字
  • stage:当前的游戏场景
  • e:游戏中的变量,environment类型
  • m:游戏地图矩阵
  • width:矩阵的宽
  • height:矩阵的高

方法解释:

  • initialize():构建函数,用于RC类的初始化
  • init():给stage1场景初始化游戏变量
  • fail():失败查询
  • furit():判断并生成水果坐标
  • head():生成蛇头移动坐标。
  • body():生成蛇尾移动坐标。
  • drawTable():绘制游戏背景。
  • drawMatrix():绘制游戏矩阵。
  • stage0():创建开机场景,可视化输出。
  • stage1():创建游戏场景,stage1()函数内部,封装了游戏场景运行时的函数,并进行调用。
  • stage2():创建结束场景,可视化输出
  • keydown():监听键盘事件。
  • run():启动函数

1.2 全局函数调用顺序图

接下来,根据UML规范画出顺序图,主要包括全局函数调用和stage1场景游戏环境调用。

全局函数调用关系。

  1. 通过run()函数启动游戏,进入stage0场景,注册键盘事件。
  2. 在stage0场景按任意键切换到stage1场景。
  3. init()出始化stage1场景的游戏变量。
  4. stage1()运行游戏
  5. 当游戏失败fail()或按q键
  6. 游戏进行stage2场景,显示游戏结束画面,
  7. 按空格键回到stage0重新开始,按q键退出程序。

seq1

1.3 stage1场景游戏环境函数调用顺序图

stage1场景游戏环境函数调用关系。

  1. 游戏进入stage1场景,按上下左右(up,down,left,right)方向键操作蛇头的前进路线。
  2. furit()函数检查,如果地图上水果被吃掉,生成一个新水果,记录到矩阵中。
  3. head()函数,通过上下左边键的操作,进行蛇头的移动,记录到矩阵中。
  4. fail()函数失败检查,no未失败继续,yes失败进行stage2场景。
  5. body()函数,蛇身体移动,记录到矩阵中。
  6. drawTable()函数,画出游戏背景画布。
  7. drawMatrix()函数,画出游戏矩阵。

seq2

利用UML的方法,通过类图和顺序图的描述,我们就把贪食蛇的游戏程序进行了面向对象的设计改造。不用着急去写代码,我们再想想如何进行游戏框架的提取。

2. 游戏框架定义

要设计一个完整、易用、有良好扩展的游戏框架是比难的,但我们可以基于贪食蛇的游戏,一步一步来做抽象。抽象过程就是把程序对象化,上面的我们已经做了;第二步再把公用的属性和方法提取封装,可以统一把公用的部分提取到一个Game的父类里面,让Snake类继承Game类,从而实现游戏框架定义。我们画出Game类和Snake类的类图。

class2

  • Game类公共属性,包括了所有的Snake类的属性,这是因为这些属性都是全局的,其他的游戏也会用到,而且每个游戏中的属性,可以在e中进行定义。
  • Game类公共方法,包括了游戏全局调用的方法,但不包括Snake游戏stage1场景中运行的方法。在Game类的方法中,我们主要实现的都是开发的辅助功能。
  • Snake类方法,同样还有Game类的方法,这是用到方法的重写技术。子类的方法,先调用父类的同名方法,然后再执行子类方法里的程序。

这样我们就简单地分离了游戏框架Game类和游戏实现Snake类,下面我们要做的就是把代码按照设计进行实现,看看我们的设计是否是合理的。

3. 在框架中重新实现贪食蛇游戏

Game类的代码实现,用R语言的RC面向对象编程进行代码编写。


Game<-setRefClass('Game',
                  
    fields=list(
      # 系统变量
      name="character", # 名字
      debug='logical',  # 调试状态
      width='numeric',  # 矩阵宽
      height='numeric', # 矩阵高
      
      # 应用变量
      stage='numeric',  # 场景
      e='environment',  # 环境空间变量
      m='matrix',       # 数据矩阵
      isFail='logical'  # 游戏失败
    ),
                  
    methods=list(
      
      # 构造函数
      initialize = function(name,width,height,debug) {
        name<<-"R Game Framework"
        debug<<-FALSE
        width<<-height<<-20   #矩阵宽高
      },
      
      # 初始化变量
      init = function(){
        e<<-new.env()   #环境空间
        m<<-matrix(rep(0,width*height),nrow=width)  #数据矩阵
        isFail<<-FALSE
      },
      
      # 开机画图
      stage0=function(){
        stage<<-0
        init()
      },
      
      # 结束画图
      stage2=function(){
        stage<<-2
      },
      
      # 游戏中
      stage1=function(default=FALSE){
        stage<<-1
        if(FALSE){  # 默认游戏中界面
          plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
          text(0.5,0.7,label="Playing",cex=5)  
        }
      },
      
      # 矩阵工具
      index = function(col) {
        return(which(m==col))
      },
      
      # 失败操作
      fail=function(msg){
        print(paste("Game Over",msg))
        isFail<<-TRUE
        keydown('q')
        return(NULL)
      },
      
      # 键盘事件,控制场景切换
      keydown=function(K){
        if(stage==0){ #开机画面
          stage1()
          return(NULL)
        }  
        
        if(stage==2){ #结束画面
          if(K=="q") q()
          else if(K==' ') stage0()  
          return(NULL)
        } 
      },
      
      # 启动程序
      run=function(){
        par(mai=rep(0,4),oma=rep(0,4))
        stage0()
        getGraphicsEvent(prompt="Snake Game",onKeybd=function(K){
          if(debug) print(paste("keydown",K))  
          return(keydown(K))
        })
      }
    )                  
)

Snake类的代码实现,继承Game类,并实现贪食蛇游戏的私有方法。


# 引用game.r文件
source(file="game.r")

# Snake类,继承Game类
Snake<-setRefClass("Snake",contains="Game",
                   
   methods=list(
     
     # 构造函数
     initialize = function(name,width,height,debug) {
       callSuper(name,width,height,debug) # 调父类
       
       name<<-"Snake Game"
     },
     
     # 初始化变量
     init = function(){
       callSuper()  # 调父类
       
       e$step<<-1/width #步长
       e$dir<<-e$lastd<<-'up' # 移动方向
       e$head<<-c(2,2) #初始蛇头坐标
       e$lastx<<-e$lasty<<-2 # 蛇头上一个点坐标
       e$tail<<-data.frame(x=c(),y=c())#初始蛇尾坐标
       
       e$col_furit<<-2 #水果颜色
       e$col_head<<-4 #蛇头颜色
       e$col_tail<<-8 #蛇尾颜色
       e$col_path<<-0 #路颜色
       e$col_barrier<<-1 #障碍颜色
     },
     
     # 失败检查
     lose=function(){
       # head出边界
       if(length(which(e$head<1))>0 | length(which(e$head>width))>0){
         fail("Out of ledge.")
         return(NULL)
       }
       
       # head碰到tail
       if(m[e$head[1],e$head[2]]==e$col_tail){
         fail("head hit tail.")
         return(NULL)
       }
     },
     
     # 随机的水果点
     furit=function(){
       if(length(index(e$col_furit))<=0){ #不存在水果
         idx<-sample(index(e$col_path),1)
         
         fx<-ifelse(idx%%width==0,10,idx%%width)
         fy<-ceiling(idx/height)
         m[fx,fy]<<-e$col_furit
         
         if(debug){
           print(paste("furit idx",idx))
           print(paste("furit axis:",fx,fy))
         }
       }
     },
     
     # snake head
     head=function(){
       e$lastx<<-e$head[1]
       e$lasty<<-e$head[2]
       
       # 方向操作
       if(e$dir=='up') e$head[2]<<-e$head[2]+1
       if(e$dir=='down') e$head[2]<<-e$head[2]-1
       if(e$dir=='left') e$head[1]<<-e$head[1]-1
       if(e$dir=='right') e$head[1]<<-e$head[1]+1
     },
     
     # snake body
     body=function(){
       if(isFail) return(NULL)
       
       m[e$lastx,e$lasty]<<-e$col_path
       m[e$head[1],e$head[2]]<<-e$col_head #snake
       if(length(index(e$col_furit))<=0){ #不存在水果
         e$tail<<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
       }
       
       if(nrow(e$tail)>0) { #如果有尾巴
         e$tail<<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
         m[e$tail[1,]$x,e$tail[1,]$y]<<-e$col_path
         e$tail<<-e$tail[-1,]
         m[e$lastx,e$lasty]<<-e$col_tail
       }
       
       if(debug){
         print(paste("snake idx",index(e$col_head)))
         print(paste("snake axis:",e$head[1],e$head[2]))  
       }
     },
     
     # 画布背景
     drawTable=function(){
       if(isFail) return(NULL)
       
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       
       if(debug){
         # 显示背景表格
         abline(h=seq(0,1,e$step),col="gray60") # 水平线
         abline(v=seq(0,1,e$step),col="gray60") # 垂直线
         # 显示矩阵
         df<-data.frame(x=rep(seq(0,0.95,e$step),width),y=rep(seq(0,0.95,e$step),each=height),lab=seq(1,width*height))
         text(df$x+e$step/2,df$y+e$step/2,label=df$lab)
       }
     },
     
     # 根据矩阵画数据
     drawMatrix=function(){
       if(isFail) return(NULL)
       
       idx<-which(m>0)
       px<- (ifelse(idx%%width==0,width,idx%%width)-1)/width+e$step/2
       py<- (ceiling(idx/height)-1)/height+e$step/2
       pxy<-data.frame(x=px,y=py,col=m[idx])
       points(pxy$x,pxy$y,col=pxy$col,pch=15,cex=4.4)
     },
     
     # 游戏场景
     stage1=function(){
       callSuper()
       
       furit()
       head()
       lose()
       body()
       drawTable()
       drawMatrix()  
     },
     
     # 开机画图
     stage0=function(){
       callSuper()
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       text(0.5,0.7,label=name,cex=5)
       text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
       text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
       text(0.2,0.05,label="Author:DanZhang",cex=1)
       text(0.5,0.05,label="http://blog.fens.me",cex=1)
     },
     
     # 结束画图
     stage2=function(){
       callSuper()
       info<-paste("Congratulations! You have eat",nrow(e$tail),"fruits!")
       print(info)
       
       plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
       text(0.5,0.7,label="Game Over",cex=5)
       text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
       text(0.5,0.3,label=info,cex=2,col=2)
       text(0.2,0.05,label="Author:DanZhang",cex=1)
       text(0.5,0.05,label="http://blog.fens.me",cex=1)
     },
     
     # 键盘事件,控制场景切换
     keydown=function(K){
       callSuper(K)
       
       if(stage==1){ #游戏中
         if(K == "q") stage2()
         else {
           if(tolower(K) %in% c("up","down","left","right")){
             e$lastd<<-e$dir
             e$dir<<-tolower(K)
             stage1()  
           }
         }
         return(NULL)
       }
       return(NULL)
     }
   )                   
)

snake<-function(){
  game<-Snake$new()
  game$initFields(debug=TRUE)
  game$run()
}

snake()

最后,我们运行snake.r的程序,就完成了整个贪食蛇游戏。游戏运行效果,可以查看上一篇文章,R语言游戏之旅 贪食蛇入门 的游戏截图和动画。

对于贪食蛇游戏的开发,我们已经完成了,虽然界面还是比较土,而且没有时间维度的操作。那么我们换一个角度思考,如果不太要求画面效果,而且不需要时间维度的游戏,是不是R语言会表现的更好呢?当然,这类游戏也有很多,比如最近流行的2048。那么接下来,就用我们的游戏框架,再来做一个2048的游戏吧,试试在100行之内实现。

转载请注明出处:
http://blog.fens.me/r-game-framework/

打赏作者

R语言游戏之旅 贪食蛇入门

R的极客理想系列文章,涵盖了R的思想,使用,工具,创新等的一系列要点,以我个人的学习和体验去诠释R的强大。

R语言作为统计学一门语言,一直在小众领域闪耀着光芒。直到大数据的爆发,R语言变成了一门炙手可热的数据分析的利器。随着越来越多的工程背景的人的加入,R语言的社区在迅速扩大成长。现在已不仅仅是统计领域,教育,银行,电商,互联网….都在使用R语言。

要成为有理想的极客,我们不能停留在语法上,要掌握牢固的数学,概率,统计知识,同时还要有创新精神,把R语言发挥到各个领域。让我们一起动起来吧,开始R的极客理想。

关于作者:

  • 张丹(Conan), 程序员Java,R,PHP,Javascript
  • weibo:@Conan_Z
  • blog: http://blog.fens.me
  • email: bsspirit@gmail.com

转载请注明出处:
http://blog.fens.me/r-game-snake/

snake-title

前言

用R语言进行统计分析不神奇,用R语言做分类算法不神奇,用R语言做可视也不神奇,你见过用R语言做的游戏吗?

本文将带你进入R语言的游戏开发,用R语言实现贪食蛇游戏。

目录

  1. 贪食蛇游戏介绍
  2. 场景设计
  3. 程序设计
  4. R语言实现

1. 贪食蛇游戏介绍

贪食蛇是一个产生于1970年代中后期的计算机游戏。此类游戏在1990年代由于一些小屏幕设备引入而再度流行起來,在现在的手机上基本都可安装此小游戏。

在游戏中,玩家操控一条细长的直线蛇,它会不停前进,玩家只能操控蛇的头部朝向(上下左右),一路拾起触碰到之物(水果),并要避免触碰到自身或者其他障碍物。每次贪食蛇吃掉一件食物,它的身体便增长一些。吃掉一些食物后会使蛇的移動速度逐漸加快,让游戏的难度渐渐变大。游戏设置分为四面都有墙,并且不可以穿越,蛇头碰到墙或障碍物时,游戏结束。以游戏过程吃到的水果,得分。 贪食蛇游戏,在各种设备上都有实现,已经有很多种版本。

snake0

2. 场景设计

要开发这款游戏,我们应该如何动手呢?首先,我们需要从软件开发的角度,对这款游戏进行需求分析,列出游戏的规则,并设计业务流程,给出游戏的原型,验证是否可行。

2.1 需求分析

贪食蛇游戏,应该有3个场景:开机场景,游戏场景,结束场景。

  • 开机场景:运行程序,在游戏前,给用户做准备,并提示如何操作游戏。
  • 游戏场景:游戏运行中的场景。
  • 结束场景:当用户胜利、失败或退出时的场景,并提示用户在游戏中的得分。

开机场景和结束场景比较简单,不再解释。游戏场景,包括一块画布,一条蛇,一个蛇头和一个不定长的蛇尾,一个水果,边界和障碍物。

2.2 游戏规则

游戏进行时的规则:

  • 1. 开始游戏后,用户可以通过上(up)下(down)左(left)右(right)键,来操作蛇头,控制蛇的前进方向,还可以按q键直接游戏失败,其他的键盘操作无效。
  • 2. 蛇头用蓝色标识,蛇尾用灰色标识,水果用红色标识,障碍物用黑色标识。
  • 3. 当蛇头移动到水果的位置后,表示蛇吃到了水果,蛇尾的长度加1。水果会在下一次蛇头移动后,在空路径上自动生成。
  • 4. 游戏画布的外围是枪,当蛇头移动到画布看不到的位置,则表示蛇头撞到枪,游戏失败。
  • 5. 游戏画面中,有一些黑色障碍物,当蛇头碰到障碍,游戏失败。
  • 6. 当蛇头碰到蛇尾时,游戏失败。

2.3 业务流程

场景切换的流程:

  • 打开程序时,用户首先看到开机场景,按任意键后进入游戏场景。
  • 在游戏场景,当游戏失败,进入结束场景;按q键,则直接游戏失败。
  • 在结束场景,按空格回到开机场景;按q键,则直接能出软件。

snake-process

2.4 游戏原型

我们画出3个场景的界面。左边为开机场景,中间是游戏场景,右边是结束场景。

snake-stage

我们根据游戏原型的图,用程序画出游戏的场景。

3. 程序设计

通过上面的功能需求分析,我们已经非常清楚地了解贪食游戏的各种规则和功能。接下来,我们要把需求分析中的业务语言,通过技术语言重新描述,并考虑非功能需求,以及R语言相关的技术细节。

3.1 游戏场景

我们让每个场景对应于一块画布,及每个场景对应一个内存结构。

  • 开机场景,是静态的,我们可以提前生成好这块画布存储起来,也可以当用户切换时再临时生成,性能开销不大。
  • 游戏场景,是动态的,每进行一次用户的交互行为或按时间刷新时,都需要求重新绘制画布,让游戏场景通过绑定事件来生成画布。由于用户会频繁操作,因此性能开销比较大。
  • 结束场景,是动态的,在结束场景会显示当次游戏的得分,需要在切换时临时生成。

3.2 游戏对象

在游戏进行中,会产生很多的对象,如上文中提到的。这些对象都需要在内存中进行定义,匹配到对应程序语言的数据类型。

画布对象:

  • 画布:用矩阵来描述,画布中每个小方块对应到矩阵中一个数据。
  • 画布大小:画布的长和宽,分别用对应两个数字变量。
  • 画布坐标:用于画布内小格子的定位,从左到右横坐标是1到20,从底到顶纵坐标为1到20。
  • 画布索引:用于画布内小格式的定位,按从左到右,从底到顶的顺序,为1到400。
  • 方格:在画布里最小的单位是方格,按照画面的比例,设置方格的大小。

matrix

蛇对象:

  • 蛇头:用一个向量来描述,只有一个方格。游戏开始时,起点位置为坐标(2,2),默认蛇头向上移动,用户打开界面显示位置为(2,3)。
  • 蛇尾:用数据框来描述,存储不定长度的坐标向量。游戏开始时,蛇尾长度是0。

水果对象:

  • 水果:用一个向量来描述,只有一个方格。游戏开始时,随机在空格式上,选一个坐标为水果位置。

边界和障碍物:

  • 边界:无内存描述,通过计算判断。当蛇头坐标超过矩阵坐标时,触发边界。
  • 障碍物:用数据框来描述,存储不定长度的坐标向量。

3.3 游戏事件
游戏过程中,会有3种事件,键盘事件、时间事件和碰撞事件。

  • 键盘事件:全局事件,用户通过键盘输入,而触发的事件,比如,上下左右控制蛇的移动方向。
  • 时间事件:全局事件,系统计时以每0.2秒触发一个时间事件,比如,蛇头每0.2秒的移动一格。
  • 碰撞事件:当蛇头移动时,与非空和格式碰撞除法的事情,比如,吃到水果,蛇头撞到蛇尾。

通常情况,上面3种事件分别有3个线程来控制。但由于R语言本身是单线程的设计,而且不支持异步调用,因此我们无法同时实现上面的3个事件监听。取一种折中方案为,全局监听键盘事件,通过键盘事件触发碰撞事件的进行检查。

3.4 游戏控制

在游戏进行中,每个状态我们都需要进行控制的。比如,什么时候生成新的水果,什么时候增加一节尾巴,什么游戏结束等。通过定义控制函数,可以方便我们管理游戏运行中的各种游戏状态。

program

上图中每个方块代表一个R语言函数定义:

  • run():启动程序。
  • keydown():监听键盘事件,锁定线程。
  • stage0():创建开机场景,可视化输出。
  • stage1():创建游戏场景,可视化输出。
  • stage2():创建结束场景,可视化输出。
  • init():打开游戏场景时,初始化游戏变量。
  • furit():判断并生成水果坐标。
  • head():生成蛇头移动坐标。
  • fail():失败查询,判断蛇头是否撞墙或蛇尾,如果失败则跳过画图,进入结束场景。
  • body():生成蛇尾移动坐标。
  • drawTable():绘制游戏背景。
  • drawMatrix():绘制游戏矩阵。

通过程序设计过程,我们就把需求分析中的业务语言描述,变成了程序开发中的技术语言描述。经过完整的设计后,最后就剩下写代码了。

4. R语言实现

用R语言写代码,其实没有几行就可以搞定,按照上面的函数定义,我们把代码像填空一样地写进去就行了。当然,在写代码的过程中,我们需要掌握一些R语言特性,让代码更健壮。

run()函数,启动程序。


run<-function(){
  # 设置全局画布无边
  par(mai=rep(0,4),oma=rep(0,4))

  # 定义全局环境空间,用于封装变量
  e<<-new.env()

  # 启动开机场景
  stage0()
  
  # 注册键盘事件
  getGraphicsEvent(prompt="Snake Game",onKeybd=keydown)
}

上面代码中,通过定义环境空间e来存储变量,可以有效的解决变量名冲突,和变量污染的问题,关于环境空间的介绍,请参考文章:揭开R语言中环境空间的神秘面纱解密R语言函数的环境空间

keydown函数,监听键盘事件。


keydown<-function(K){
  print(paste("keydown:",K,",stage:",e$stage));
  
  if(e$stage==0){ #开机画面
    init()
    stage1()
    return(NULL)
  }  
  
  if(e$stage==2){ #结束画面
    if(K=="q") q()
    else if(K==' ') stage0()  
    return(NULL)
  } 
  
  if(e$stage==1){ #游戏中
    if(K == "q") {
      stage2()
    } else {
      if(tolower(K) %in% c("up","down","left","right")){
        e$lastd<-e$dir
        e$dir<-tolower(K)
        stage1()  
      }
    }
  }
  return(NULL)
}

代码中,参数K为键盘输入。通过对当前所在场景,与键盘输入的条件判断,来确定键盘事件的响应。在游戏中,键盘只响应5个键 "up","down","left","right","q"。

stage0():创建开机场景,可视化输出。


# 开机画图
stage0<-function(){
  e$stage<-0
  plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
  text(0.5,0.7,label="Snake Game",cex=5)
  text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
  text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
  text(0.2,0.05,label="Author:DanZhang",cex=1)
  text(0.5,0.05,label="http://blog.fens.me",cex=1)
}

stage2():创建结束场景,可视化输出。


# 结束画图
stage2<-function(){
  e$stage<-2
  plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
  text(0.5,0.7,label="Game Over",cex=5)
  text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
  text(0.5,0.3,label=paste("Congratulations! You have eat",nrow(e$tail),"fruits!"),cex=2,col=2)
  text(0.2,0.05,label="Author:DanZhang",cex=1)
  text(0.5,0.05,label="http://blog.fens.me",cex=1)
}

init():打开游戏场景时,初始化游戏变量。


# 初始化环境变量
init<-function(){
  e<<-new.env()
  e$stage<-0 #场景
  e$width<-e$height<-20  #切分格子
  e$step<-1/e$width #步长
  e$m<-matrix(rep(0,e$width*e$height),nrow=e$width)  #点矩阵
  e$dir<-e$lastd<-'up' # 移动方向
  e$head<-c(2,2) #初始蛇头
  e$lastx<-e$lasty<-2 # 初始化蛇头上一个点
  e$tail<-data.frame(x=c(),y=c())#初始蛇尾
  
  e$col_furit<-2 #水果颜色
  e$col_head<-4 #蛇头颜色
  e$col_tail<-8 #蛇尾颜色
  e$col_path<-0 #路颜色
}

代码中,初始化全局的环境空间e,然后将所有需要的变量,定义在e中。

furit():判断并生成水果坐标。


 # 随机的水果点
  furit<-function(){
    if(length(index(e$col_furit))<=0){ #不存在水果
      idx<-sample(index(e$col_path),1)
      
      fx<-ifelse(idx%%e$width==0,10,idx%%e$width)
      fy<-ceiling(idx/e$height)
      e$m[fx,fy]<-e$col_furit
      
      print(paste("furit idx",idx))
      print(paste("furit axis:",fx,fy))
    }
  }

fail():失败查询,判断蛇头是否撞墙或蛇尾,如果失败则跳过画图,进入结束场景。


 # 检查失败
  fail<-function(){
    # head出边界
    if(length(which(e$head<1))>0 | length(which(e$head>e$width))>0){
      print("game over: Out of ledge.")
      keydown('q')
      return(TRUE)
    }
    
    # head碰到tail
    if(e$m[e$head[1],e$head[2]]==e$col_tail){
      print("game over: head hit tail")
      keydown('q')
      return(TRUE)
    }
    
    return(FALSE)
  }

head():生成蛇头移动坐标。


  # snake head
  head<-function(){
    e$lastx<-e$head[1]
    e$lasty<-e$head[2]
    
    # 方向操作
    if(e$dir=='up') e$head[2]<-e$head[2]+1
    if(e$dir=='down') e$head[2]<-e$head[2]-1
    if(e$dir=='left') e$head[1]<-e$head[1]-1
    if(e$dir=='right') e$head[1]<-e$head[1]+1
    
  }

body():生成蛇尾移动坐标。


  # snake body
  body<-function(){
    e$m[e$lastx,e$lasty]<-0
    e$m[e$head[1],e$head[2]]<-e$col_head #snake
    if(length(index(e$col_furit))<=0){ #不存在水果
      e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
    }
    
    if(nrow(e$tail)>0) { #如果有尾巴
      e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
      e$m[e$tail[1,]$x,e$tail[1,]$y]<-e$col_path
      e$tail<-e$tail[-1,]
      e$m[e$lastx,e$lasty]<-e$col_tail
    }
    
    print(paste("snake idx",index(e$col_head)))
    print(paste("snake axis:",e$head[1],e$head[2]))
  }

drawTable():绘制游戏背景。


 # 画布背景
  drawTable<-function(){
    plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
    
    # 显示背景表格
    abline(h=seq(0,1,e$step),col="gray60") # 水平线
    abline(v=seq(0,1,e$step),col="gray60") # 垂直线
    # 显示矩阵
    df<-data.frame(x=rep(seq(0,0.95,e$step),e$width),y=rep(seq(0,0.95,e$step),each=e$height),lab=seq(1,e$width*e$height))
    text(df$x+e$step/2,df$y+e$step/2,label=df$lab)
  }

drawMatrix():绘制游戏矩阵。


  # 根据矩阵画数据
  drawMatrix<-function(){
    idx<-which(e$m>0)
    px<- (ifelse(idx%%e$width==0,e$width,idx%%e$width)-1)/e$width+e$step/2
    py<- (ceiling(idx/e$height)-1)/e$height+e$step/2
    pxy<-data.frame(x=px,y=py,col=e$m[idx])
    points(pxy$x,pxy$y,col=pxy$col,pch=15,cex=4.4)
  }

stage1():创建游戏场景,stage1()函数内部,封装了游戏场景运行时的函数,并进行调用。


# 游戏中
stage1<-function(){
  e$stage<-1
  furit<-function(){...} //见furit
  fail<-function(){...} //见fail
  head<-function(){...} //见head
  body<-function(){...}//见body
  drawTable<-function(){...} //见drawTable
  drawMatrix<-function(){...} //见drawMatrix

  # 运行函数
  furit()
  head()
  if(!fail()){ #失败检查
    body()
    drawTable()
    drawMatrix()  
  }
}

注:此处代码为伪代码。

最后,是完整的程序代码。


# 初始化环境变量
init<-function(){
  e<<-new.env()
  e$stage<-0 #场景
  e$width<-e$height<-20  #切分格子
  e$step<-1/e$width #步长
  e$m<-matrix(rep(0,e$width*e$height),nrow=e$width)  #点矩阵
  e$dir<-e$lastd<-'up' # 移动方向
  e$head<-c(2,2) #初始蛇头
  e$lastx<-e$lasty<-2 # 初始化蛇头上一个点
  e$tail<-data.frame(x=c(),y=c())#初始蛇尾
  
  e$col_furit<-2 #水果颜色
  e$col_head<-4 #蛇头颜色
  e$col_tail<-8 #蛇尾颜色
  e$col_path<-0 #路颜色
}


# 获得矩阵的索引值
index<-function(col) which(e$m==col)

# 游戏中
stage1<-function(){
  e$stage<-1
  
  # 随机的水果点
  furit<-function(){
    if(length(index(e$col_furit))<=0){ #不存在水果
      idx<-sample(index(e$col_path),1)
      
      fx<-ifelse(idx%%e$width==0,10,idx%%e$width)
      fy<-ceiling(idx/e$height)
      e$m[fx,fy]<-e$col_furit
      
      print(paste("furit idx",idx))
      print(paste("furit axis:",fx,fy))
    }
  }
  
  
  # 检查失败
  fail<-function(){
    # head出边界
    if(length(which(e$head<1))>0 | length(which(e$head>e$width))>0){
      print("game over: Out of ledge.")
      keydown('q')
      return(TRUE)
    }
    
    # head碰到tail
    if(e$m[e$head[1],e$head[2]]==e$col_tail){
      print("game over: head hit tail")
      keydown('q')
      return(TRUE)
    }
    
    return(FALSE)
  }
  
  
  # snake head
  head<-function(){
    e$lastx<-e$head[1]
    e$lasty<-e$head[2]
    
    # 方向操作
    if(e$dir=='up') e$head[2]<-e$head[2]+1
    if(e$dir=='down') e$head[2]<-e$head[2]-1
    if(e$dir=='left') e$head[1]<-e$head[1]-1
    if(e$dir=='right') e$head[1]<-e$head[1]+1
    
  }
  
  # snake body
  body<-function(){
    e$m[e$lastx,e$lasty]<-0
    e$m[e$head[1],e$head[2]]<-e$col_head #snake
    if(length(index(e$col_furit))<=0){ #不存在水果
      e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
    }
    
    if(nrow(e$tail)>0) { #如果有尾巴
      e$tail<-rbind(e$tail,data.frame(x=e$lastx,y=e$lasty))
      e$m[e$tail[1,]$x,e$tail[1,]$y]<-e$col_path
      e$tail<-e$tail[-1,]
      e$m[e$lastx,e$lasty]<-e$col_tail
    }
    
    print(paste("snake idx",index(e$col_head)))
    print(paste("snake axis:",e$head[1],e$head[2]))
  }
  
  # 画布背景
  drawTable<-function(){
    plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
  }
  
  # 根据矩阵画数据
  drawMatrix<-function(){
    idx<-which(e$m>0)
    px<- (ifelse(idx%%e$width==0,e$width,idx%%e$width)-1)/e$width+e$step/2
    py<- (ceiling(idx/e$height)-1)/e$height+e$step/2
    pxy<-data.frame(x=px,y=py,col=e$m[idx])
    points(pxy$x,pxy$y,col=pxy$col,pch=15,cex=4.4)
  }
  
  furit()
  head()
  if(!fail()){
    body()
    drawTable()
    drawMatrix()  
  }
}


# 开机画图
stage0<-function(){
  e$stage<-0
  plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
  text(0.5,0.7,label="Snake Game",cex=5)
  text(0.5,0.4,label="Any keyboard to start",cex=2,col=4)
  text(0.5,0.3,label="Up,Down,Left,Rigth to control direction",cex=2,col=2)
  text(0.2,0.05,label="Author:DanZhang",cex=1)
  text(0.5,0.05,label="http://blog.fens.me",cex=1)
}

# 结束画图
stage2<-function(){
  e$stage<-2
  plot(0,0,xlim=c(0,1),ylim=c(0,1),type='n',xaxs="i", yaxs="i")
  text(0.5,0.7,label="Game Over",cex=5)
  text(0.5,0.4,label="Space to restart, q to quit.",cex=2,col=4)
  text(0.5,0.3,label=paste("Congratulations! You have eat",nrow(e$tail),"fruits!"),cex=2,col=2)
  text(0.2,0.05,label="Author:DanZhang",cex=1)
  text(0.5,0.05,label="http://blog.fens.me",cex=1)
}

# 键盘事件
keydown<-function(K){
  print(paste("keydown:",K,",stage:",e$stage));
  
  if(e$stage==0){ #开机画面
    init()
    stage1()
    return(NULL)
  }  
  
  if(e$stage==2){ #结束画面
    if(K=="q") q()
    else if(K==' ') stage0()  
    return(NULL)
  } 
  
  if(e$stage==1){ #游戏中
    if(K == "q") {
      stage2()
    } else {
      if(tolower(K) %in% c("up","down","left","right")){
        e$lastd<-e$dir
        e$dir<-tolower(K)
        stage1()  
      }
    }
  }
  return(NULL)
}

#######################################
# RUN  
#######################################  

run<-function(){
  par(mai=rep(0,4),oma=rep(0,4))
  e<<-new.env()
  stage0()
  
  # 注册事件
  getGraphicsEvent(prompt="Snake Game",onKeybd=keydown)
}

run()

游戏截图:

snake

全部代码仅仅190行,有效代码行只有100行左右,我们就实现了贪食蛇游戏。当然,时间事件我们没有实现,只因为R语言本身的单线程机制,而且不支持异步调用。正因为R语言强大的数据处理能力和可视化能力,让我们的程序写起来非常简单。我想如果让R来实现策略类游戏的矩阵部分的计算,一定会非常顺手的。

有了贪食蛇游戏的雏形,再通过面向对象的封装,能不能归纳出一个基于R语言游戏的开发框架呢?下一篇文章将继续R语言游戏之旅,R语言游戏框架设计

转载请注明出处:
http://blog.fens.me/r-game-snake/

打赏作者