fork download
copy 
  1. #lang racket
  2.  
  3. (require 2htdp/universe 2htdp/image lang/posn)
  4.  
  5.  
  6. (struct world (key brave flag))
  7.  
  8. ;; ここは実際に画像を「挿入」する
  9. (define *images* '(. . . . .))
  10.  
  11. (define *width* 620)
  12. (define *height* 434)
  13. (define *step* 62)
  14.  
  15. ;; マップ描画の準備
  16.  
  17. (define *image-posns*
  18.   (append-map (lambda (y)
  19.                 (map (lambda (x)
  20.                        (make-posn x y))
  21.                     (range (/ *step* 2) *width* *step*)))
  22.              (range (/ *step* 2) *height* *step*)))
  23.  
  24. ;; マップデータ
  25.  
  26. (define *map-data* '((1 0 1 1 1 1 1 1 1 1)
  27.                      (1 0 0 1 2 0 0 1 3 1)
  28.                      (1 1 0 1 1 1 0 1 0 1)
  29.                      (1 0 0 0 0 0 0 1 0 1)
  30.                      (1 0 1 1 1 1 1 1 0 1)
  31.                      (1 0 0 0 0 0 0 0 0 1)
  32.                      (1 1 1 1 1 1 1 1 1 1)))
  33.  
  34. ;; バックグラウンド
  35.  
  36. (define *background*
  37.   (place-images (map (lambda (i)
  38.                        (list-ref *images* (if (< i 3)
  39.                                              i
  40.                                              0)))
  41.                     (apply append *map-data*))
  42.                *image-posns*
  43.                (empty-scene *width* *height*)))
  44.  
  45. ;; *map-data* 上の座標を構造体 posn に変換
  46.  
  47. (define *d-pairs* (append-map (lambda (y)
  48.                                 (map (lambda (x)
  49.                                        (cons x y))
  50.                                     (range 0
  51.                                           (length
  52.                                            (list-ref *map-data* 0)))))
  53.                              (range 0 (length *map-data*))))
  54.  
  55. (define *d-pair->posn-table*
  56.   (make-hash (map (lambda (x y)
  57.                     (cons x y))
  58.                  *d-pairs* *image-posns*)))
  59.  
  60. (define (d-pair->posn d-pair)
  61.   (hash-ref *d-pair->posn-table* d-pair))
  62.  
  63. ;; *map-posn*上のデータを座標に変換
  64.  
  65. (define *posn->d-pair-table*
  66.   (make-hash (map (lambda (x y)
  67.                     (cons x y))
  68.                  *image-posns* *d-pairs*)))
  69.  
  70. (define (posn->d-pair posn)
  71.   (hash-ref *posn->d-pair-table* posn))
  72.  
  73. ;; キー配置関数
  74.  
  75. (define (place-key p flag scene)
  76.     (place-image
  77.      (list-ref *images* (if flag
  78.                            0
  79.                            3))
  80.      (posn-x p)
  81.      (posn-y p)
  82.      scene))
  83.  
  84. ;; 勇者配置関数
  85.  
  86. (define (place-brave p scene)
  87.   (place-image
  88.    (list-ref *images* 4)
  89.    (posn-x p)
  90.    (posn-y p)
  91.    scene))
  92.  
  93. ;; 移動用関数のユーティリティ
  94.  
  95. (define (map-ref x y)
  96.   (list-ref (list-ref *map-data* y) x))
  97.  
  98. (define (movable? x y)
  99.   (not (or (negative? y) (= (map-ref x y) 1))))
  100.  
  101. ;; 移動用のキーを使ってworldを更新する
  102.  
  103. (define (change w a-key)
  104.   (let ((dir (posn->d-pair (world-brave w))))
  105.     (let ((x (car dir)) (y (cdr dir)))
  106.       (world
  107.        (world-key w)
  108.        (cond
  109.          ((key=? a-key "left") (let ((x (- x 1)))
  110.                                  (if (movable? x y)
  111.                                     (d-pair->posn (cons x y))
  112.                                     (world-brave w))))
  113.          ((key=? a-key "right") (let ((x (+ x 1)))
  114.                                   (if (movable? x y)
  115.                                      (d-pair->posn (cons x y))
  116.                                      (world-brave w))))
  117.          ((= (string-length a-key) 1) (world-brave w))
  118.          ((key=? a-key "up") (let ((y (- y 1)))
  119.                                (if (movable? x y)
  120.                                   (d-pair->posn (cons x y))
  121.                                   (world-brave w))))
  122.          ((key=? a-key "down") (let ((y (+ y 1)))
  123.                                  (if (movable? x y)
  124.                                     (d-pair->posn (cons x y))
  125.                                     (world-brave w))))
  126.          (else (world-brave w)))
  127.        (if (= (map-ref x y) 3) #t (world-flag w))))))
  128.  
  129. ;; world 配置関数
  130.  
  131. (define (place-world w)
  132.   (place-brave (world-brave w)
  133.               (place-key (world-key w)
  134.                         (world-flag w)
  135.                         *background*)))
  136.  
  137. ;; エンディング表示
  138.  
  139. (define (game-ends? w)
  140.   (let ((dir (posn->d-pair (world-brave w))))
  141.     (let ((x (car dir)) (y (cdr dir)))
  142.       (and (world-flag w) (= (map-ref x y) 2)))))
  143.  
  144. (define (ending w)
  145.   (place-image (text "ゴールおめでとう。
  146.  
  147. だが、君の戦いはまだ始まったばかりだ。
  148.  
  149.                      ......つづく?" 15 "white")
  150.               300
  151.               200
  152.               (empty-scene *width* *height* "black")))
  153.  
  154. ;; main プログラム
  155. (big-bang (world (d-pair->posn '(8 . 1))
  156.                 (d-pair->posn '(1 . 0))
  157.                 #f)
  158.   (to-draw place-world)
  159.   (on-key change)
  160.   (stop-when game-ends? ending)
  161.   (name "Dungeon & Racket"))
Runtime error #stdin #stdout #stderr 0.29s 57072KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
Standard output is empty
stderr
copy 
prog.rkt:9:19: read-syntax: illegal use of `.`
  context...:
   read-symbol-or-number8
   read-undotted
   read-one/not-eof
   loop
   read-unwrapped-sequence17
   read-undotted
   [repeats 1 more time]
   read-one/not-eof
   loop
   [repeats 2 more times]
   read-unwrapped-sequence17
   read-undotted
   read-syntax
   /usr/share/racket/collects/syntax/module-reader.rkt:186:17: body
   /usr/share/racket/collects/syntax/module-reader.rkt:183:2: wrap-internal
   /usr/share/racket/collects/racket/../syntax/module-reader.rkt:65:9: lang:read-syntax
   ...
https://ideone.com/OhdipS
language:
Racket (racket 7.0)
created:
4 years ago
visibility:
public

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!