今晚心血来潮，折腾了一些很奇怪的东西（？）……
正文开始前先说明下这个——
很久很久以前仿照Narcissu的中二产物，
一个片段式的视觉小说，
发扬了一贯的坑人作风。
传送门名字是
《树的故事》，
这次使用NScripter制作的，
渣图自绘，并伴随自制毁耳背景音。
情节是简单的心情记录，
表达曾经对人生的未来的迷惘（？）吧，
[strike]现在看来或许只是太闲了而已[/strike]。
[wrap=正文点我,0]
记得程序语言入门的时候曾热衷于在终端下面写一些简单的字符界面的下游戏，比如贪食蛇推箱子俄罗斯方块，或者就是命令选单式的RPG。
虽然原理很简单，而且成品也确实不好玩，不过当时写的时候还是有些些隐约的乐趣的。觉得有点小成就感，又觉得有点小自卑。
现在的能力依然只是作为一个外行人士，不过出于脑海中忽然冒出的怀旧的想法，又想来写写简单的字符界面的小游戏自娱自乐了。
既然是娱乐的想法呢，这次用Scheme来写吧。语言依照ieee和r5rs的交集，并为代码便携作出若干约定。
详细的说就是不包括卫生宏和eval函数，并且限定延续只能用来作局部跳出用，数字类型只使用整数和浮点数。
不过为了一些功能的需要，这里额外定义了三个函数：
(clrscr) 清除屏幕
(exit) 退出并返回0
(inkey) 等价于getch函数
目前是用tinyscheme的代码中添加了这三个函数，方便测试用（
link）。
执行tscm.exe，它会自动执行init.scm中的代码。
那么Hello World
(clrscr)
(display "hello world")
(exit) |
那么用来测试按键的小代码就是
(clrscr)
(let loop ()
(let ((c (inkey)))
(display (char->integer c))
(newline)
(loop)))
(exit) |
据此可以把光标键转换为udlr四个符号
(define (wait-key)
(let loop ()
(define (pad c)
(case (char->integer c)
((72) 'u)
((80) 'd)
((75) 'l)
((77) 'r)
(else (loop))))
(let* ((key-char (inkey))
(key-code (char->integer key-char)))
(cond
((member key-code '(224 0)) (pad (inkey)))
((char-ci=? key-char #\z) 'a)
((char-ci=? key-char #\x) 'b)
((char-ci=? key-char #\c) 's)
((char-ci=? key-char #\w) 'u)
((char-ci=? key-char #\s) 'd)
((char-ci=? key-char #\a) 'l)
((char-ci=? key-char #\d) 'r)
((= key-code 13) 'a)
((= key-code 32) 'a)
((= key-code 8) 'b)
((char-ci=? key-char #\q) 'b)
((= key-code 27) 's)
((= key-code 3) (exit))
(else (loop)))))) |
不过在测试的时候可以用一个简单的版本代替
(define (wait-key)
(define (co key-map)
(define (co lst)
(cons
(char-downcase
(string-ref (symbol->string (car lst)) 0))
(cadr lst)))
(map co key-map))
(define key-map
(co '((w u)(s d)(a l)(d r)(z a)(x b)(c s))))
(let loop ()
(cond
((assoc (inkey) key-map)
=>(lambda (x) (if x (cdr x) (loop))))))) |
在正式的代码开始前，先写几个会用到的，但是r5rs里面未定义的函数
(define (filter pred list)
(cond
((null? list) '())
((pred (car list))
(cons (car list) (filter pred (cdr list))))
(else (filter pred (cdr list)))))
;(display (filter even? '(1 2 3 4 5 6)))
(define (curry fun . args)
(lambda x
(apply fun (append args x))))
;((curry + 2) 3)
(define (assert ture . msgs)
(if (not ture) (begin (for-each (lambda (x) (display x)) msgs) (error "assert-fail"))))
(define (require name)
;(push! *require-loaded* name)
(load (string-append (symbol->string name) ".ss"))) |
那么接下来可以定义一个类似于GalGame用于选项的场景，这里用上下键来选
(define (ui-choose msg . items)
(define (show vec cur)
(define cur (modulo cur (vector-length vec)))
(clrscr)
(display msg)
(newline)
(do ((i 0 (+ i 1))) ((= i (vector-length vec)) 1)
(display (if (= i cur) " * " " "))
(display (vector-ref vec i))
(newline))
(let ((k (wait-key)))
(case k
((u) (show vec (- cur 1)))
((d) (show vec (+ cur 1)))
((a) (+ cur 1))
(else (show vec cur)))))
(show (list->vector items) 0))
;(display (ui-choose "where to go?" "walk" "eat" "sleep")) |
如果想简单地模拟galgame那种对话加选支的功能，目前实现的东西已经足够了。
接下来要做的事情是想写成rogue-like那种字符界面的地图。
(define (show-map-scene5)
(define (map-event p x y)
(cond
((assoc (list x y) (filter (lambda (x) (eqv? #\$ (cadr x))) map-objs))
(clrscr)
(display "hello world")
(inkey))
((assoc (list x y) map-objs)
=>(lambda (x) '()))
(else (p 'put x y)))
(map-loop))
(define p (make-movable map-event))
(define budr1 (make-pos-list
'("......................"
".......#.......#......"
"..........#......$...."
".....$................"
".............#........"
"......#..............."
"...............#......"
"........#.....#.......")))
(define map-objs
(cons
(list (p 'position-ref) "@")
(budr1 'data-ref)));map this
(define (map-char-of-pos x y);map-show make this simpler
(let ((lst (assoc-all (list x y) map-objs)));map-objs
(if (not lst) "." (cadr (car lst)))))
(define (map-loop)
(clrscr)
(display "[map]\n")
(map-view-display (budr1 'width) (budr1 'height) map-char-of-pos)
(input-and-move (curry p 'move)))
(map-loop))
(show-map-scene5) |
这是一个简单的演示用场景，更多的场景可以用同样的模式来写，或者抽象出一个通用的数据范式出来。
需要注意的是场景里面的函数都是用的尾调用，这样可以以函数调用的形式切换到别的场景而不会函数调用的溢出。
其中用到movable对象表示了可以用光标移动的坐标
(define (dispatch->callable host)
(define (object message . args)
(apply (host message) args))
object)
(define (make-movable call-with-this-new-position)
(define position (list 0 0))
(define (position-ref)
position)
(define (position-copy)
(append position))
(define (position-set! x y)
(set-car! position x)
(set-car! (cdr position) y))
(define (move dx dy)
(let ((new-x (+ dx (car position)))
(new-y (+ dy (cadr position))))
;;tail-rec/cps
(call-with-this-new-position this new-x new-y)))
(define (dispatch message)
(case message
((position-ref) position-ref)
((position) position-copy)
((position-set!) position-set!)
((put) position-set!)
((move) move)
(else (error message))))
(define this (dispatch->callable dispatch))
this)
(define (input-and-move move)
;;with-system-menu
(case (wait-key)
((u) (move +0 -1))
((d) (move +0 +1))
((l) (move -1 +0))
((r) (move +1 +0))))
|
地图的显示是用的另一组函数
(define (assoc-all obj alist)
(let ((f (filter (lambda (x) (equal? (car x) obj)) alist)))
(if (null? f) #f f)))
;;;ui-display-map
(define (map-view-display width height call-with-char-position)
(do ((y 0 (+ y 1))) ((= y height))
(do ((x 0 (+ x 1))) ((= x width))
(let ((chr (call-with-char-position x y)))
(if (or (not chr) (null? chr))
(display ".")
(display chr)))
;(display (call-with-char-position x y))
);when get #f or '() display "."?
(display "\n"))) |
其中参数call-with-char-position的类型是int-int->string，这样可以灵活的使用不同的地图实现方式。
不过目前简单的使用了关联列表
;;make-pos-list
(define (pos-list-of-strs map-data)
'(demo-data
("##....###"
"#.$.....#"
"#.....@.#"
"#.$..####"))
(let loop ((x 0) (y 0) (w 0) (h 0)(it map-data) (ret '()))
(cond
((null? it)
(cons (list w h) ret));return this
((= x (string-length (car it)))
(loop 0 (+ y 1) (max x w) (+ h 1) (cdr it) ret))
((equal? (string-ref (car it) x) #\.)
(loop (+ x 1) y w h it ret))
(else
(loop (+ x 1) y w h it
(cons (list (list x y) (string-ref (car it) x)) ret))))))
(define (make-pos-list string-list-data)
(define _ (pos-list-of-strs string-list-data))
(define (dispatch message)
(case message
((width)
(lambda () (caar _)))
((height)
(lambda () (cadar _)))
((data-ref)
(lambda ()(cdr _)))
(else (error message))))
(dispatch->callable dispatch)) |
关联列表虽然读取需要O(n)的时间，不过有点是稀疏的，并且可以在同一下标有重复元素。
以上这个两个函数只负责由方便编辑的字符串产生这个关联数组，至于之后怎么用就随意了。
比如说推箱子就需要物件的移动，NPC不同场合不一定出现，地面道具怪兽就会同时在同一个坐标上面。
比如写
(define map2
'(("##....###"
"#.......#"
"#.....@.#"
"#....####")
((#\# floor)
(#\. floor)
(#\@ floor player))
((floor #\#))
)) |
就可以把多个物件放在同一个格子上面，并在数据中指定事件以及显示的方法。
最后就是存档功能，也用来在游戏中放置需要的状态
(define (make-state)
(define alist-data (list))
(define (dispatch message)
(case message
((get)
(lambda (key)
(cond ((assoc key alist-data)=>(lambda (x) (cdr x)))(else #f))))
((put)
(lambda (key value)
(let ((ptr (assoc key alist-data)))
(if ptr (set-cdr! ptr value)
(set! alist-data (cons (cons key value) alist-data))))))
((save)
(lambda (file)
(call-with-output-file file
(lambda (port)
(write alist-data port)))))
((load)
(lambda (file)
(call-with-input-file file
(lambda (port)
(let ((sexp (read port)))
(if (eof-object? sexp)
(set! alist-data (list))
(set! alist-data sexp)))))))
(else (error message))))
dispatch) |
目前来是只能说是把结构搭建好了不过没有任何内容的游戏还算是游戏么。。。
[/wrap]
为什么土卫一没有发贴按钮呢……
[strike]接下来得专心地填坑去了……[/strike]
----
@光
谢谢指正，链接已修复。
@ge
填坑指的是文区的坑……