2015年6月25日木曜日

開発環境

Land of Lisp (M.D. Conrad Barski (著)、川合 史朗 (翻訳)、オライリージャパン)の5章(テキストゲームのエンジンを作る)、5.4(全てを描写する)を Scheme で取り組んでみる。

5.4(全てを描写する)

コード(Emacs)

(begin 
  (define print (lambda (x) (display x) (newline)))
  (newline)

  (define map
    (lambda (proc items)
      (if (null? items)
          (quote ())
          (cons (proc (car items))
                (map proc (cdr items))))))
  (define filter
    (lambda (pred items)
      (cond ((null? items) (quote ()))
            ((pred (car items))
             (cons (car items)
                   (filter pred (cdr items))))
            (else (filter pred (cdr items))))))
  
  (define assoc
    (lambda (obj alist)
      (if (null? alist)
          #f
          (let ((item (car alist)))
            (if (equal? obj (car item))
                item
                (assoc obj (cdr alist)))))))

  ;; ここから
  (define describe-location
    (lambda (location nodes)
      (let ((item (assoc location nodes)))
        (if item
            (cadr item)
            #f))))  
  (define describe-path
    (lambda (edge)
      (quasiquote (There is a (unquote (caddr edge)) going (unquote (cadr edge))
                         from here.))))  
  (define describe-paths
    (lambda (location edges)
      (apply append (map describe-path (cdr (assoc location edges))))))
  (define objects-at
    (lambda (loc objs obj-locs)
      (define at-loc?
        (lambda (obj)
          (let ((item (assoc obj obj-locs)))
            (and item
                 (eq? (cadr item) loc)))))
      (filter at-loc? objs)))  
  (define describe-objects
    (lambda (loc objs obj-loc)
      (define describe-obj
        (lambda (obj)
          (quasiquote (You see a (unquote obj) on the floor.))))
      (apply append
             (map describe-obj (objects-at loc objs obj-loc)))))

  ;; ここから
  (define *objects* (quote (whiskey bucket frog chain)))
  (define *nodes*
    (quote ((living-room (You are in the living-room. There is a wizard is
                              snoring loudly on the couch.))
            (garden (You are in a beatiful garden. There is a well in front of
                         you.))
            (attic (You are in the attic. There is a giant welding torch in
                        the corner.)))))
  (define *edges* (quote ((living-room (garden west door)
                                       (attic upstairs ladder))
                          (garden (living-room east door))
                          (attic (livving-room downstairs ladder)))))
  (define *object-locations* (quote ((whiskey living-room)
                                     (bucket living-room)
                                     (chain garden)
                                     (frog garden))))  
  
  (define *location* (quote living-room))  
  (define look
    (lambda ()
      (append (describe-location *location* *nodes*)
              (describe-paths *location* *edges*)
              (describe-objects *location* *objects* *object-locations*))))

  (print (look))

  (quote done))

入出力結果(Terminal(kscheme), REPL(Read, Eval, Print, Loop))

$ kscheme < sample4.scm
kscm> 
(You are in the living-room. There is a wizard is snoring loudly on the couch. There is a door going west from here. There is a ladder going upstairs from here. You see a whiskey on the floor. You see a bucket on the floor.)
done
kscm> $

0 コメント:

コメントを投稿

Comments on Google+: