Law281

Mud scheme game help

Apr 23rd, 2016
440
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 8.68 KB | None | 0 0
  1. #lang racket
  2.  
  3. (require srfi/1)
  4. (require srfi/13)
  5. (require srfi/48)
  6.  
  7. ;; Defined descriptions for each command in the rooms
  8. (define descriptions '((1 "You come across a spooky castle and enter the castle entrance! ")
  9. (2 "There seems to be a stench coming from the toilet of the room you've entered, gross ")
  10. (3 "There's seems to be alot of food around you, it looks like a kitchen...maybe I should take a snack for this adventure!.")
  11. (4 "You are in the castle hallway and see exits around you")
  12. (5 "You are in the castle living room filled with old dusty furniture")
  13. (6 "You appear to be in the castle dining room, you can hear a scream coming from the north!")
  14. (7 "You followed the scream, and have entered the castle chamber, a princess is in distress and needs saving! Bring her back to the castle entrance to win!")))
  15.  
  16. (define objects `((3 "A loaf of bread" )
  17. (7 "a princess" )))
  18.  
  19. ;;defines the functions for the game, keywords used for its functionality
  20. (define look '(((directions) look) ((look) look) ((examine room) look)))
  21. (define quit '(((exit game) quit) ((quit game) quit) ((exit) quit) ((quit) quit)))
  22. (define inventory `(((inventory ) inventory ) ((bag ) inventory )))
  23. (define pick `(((get)pick) ((pickup)pick) ((pick)pick) ((take)pick)))
  24. (define put `(((put)drop) ((drop)drop)((remove)drop)))
  25. (define eat `(((eat)eat)))
  26. (define actions `(,@look ,@quit ,@pick ,@put ,@inventory ))
  27.  
  28.  
  29. ;Decision table actions for entering rooms, allows user to choose between which direction you can move in and back
  30. (define decisiontable `((1 ((north) 4) ((east) 2) ((west) 3) ,@actions)
  31. (2 ((west) 1) ,@actions)
  32. (3 ((east) 1),@actions)
  33. (4 ((north) 5) ((south) 1),@actions)
  34. (5 ((south) 4) ((east) 6),@actions)
  35. (6 ((west) 5) ((north) 7),@actions)
  36. (7 ((south) 6) ((west) 5),@actions)))
  37.  
  38.  
  39.  
  40. ;;creates the object data base
  41. (define objectdb (make-hash ))
  42. (define inventorydb (make-hash ))
  43.  
  44. ;;adds one object to the hash table
  45. (define (add-object db id object )
  46. (if (hash-has-key? db id )
  47. (let ((record (hash-ref db id )))
  48. (hash-set! db id (cons object record )))
  49. (hash-set! db id (cons object empty ))))
  50.  
  51. ;;adds all object to hash table
  52. (define (add-objects db )
  53. (for-each
  54. (lambda (r)
  55. (add-object db (first r) (second r ))) objects ))
  56. (hash-set! objectdb 1 '())
  57. (hash-set! inventorydb 'bag '())
  58. (add-objects objectdb )
  59. ;; searches the inventory for the princess
  60. (define (search db)
  61. (if (null? db)
  62. #f
  63. (if (eq? "a princess" (car db))
  64. #t
  65. (search (cdr db)))))
  66.  
  67. ;; search the inventory for the loaf of bread
  68. (define (search2 db)
  69. (if (null? db)
  70. #f
  71. (if (eq? "a loaf of bread" (car db))
  72. #t
  73. (search2 (cdr db)))))
  74. ;;display objects in database
  75.  
  76. (define (display-objects db id )
  77. (if (hash-has-key? db id )
  78. (let* ((record (hash-ref db id ))
  79. (output (string-join record " and " )))
  80. (if (eq? id 'bag )
  81. (if (equal? output "" )
  82. (printf "Your bag is empty.")
  83. (printf " You are carrying ~a. " output))
  84. (if (equal? output "" )
  85. (printf "The room is empty")
  86. (printf "You can see ~a . " output))))
  87. (printf "Does not exist")))
  88.  
  89. ;;Removing items from room
  90. (define (remove-object-from-room db id str )
  91. (when (hash-has-key? db id )
  92. (let* ((record (hash-ref db id ))
  93. (result (remove (lambda(x) (string-suffix-ci? str x)) record ))
  94. (item (lset-difference equal? record result)))
  95. (cond ((null? item) ;;Checks if the value is null and there isnt the item stated in the room
  96. (printf "I don ’t see that item in the room !\n" ))
  97. (else
  98. (printf " Added ~a to your bag .\n" (first item )) ;;Found item will be placed in bag
  99. (add-object inventorydb `bag (first item ))
  100. (hash-set! db id result ))))))
  101.  
  102. ;;Removing items from inventory
  103. (define (remove-object-from-inventory db id str )
  104. (when (hash-has-key? db `bag )
  105. (let* ((record (hash-ref db `bag ))
  106. (result (remove (lambda (x) (string-suffix-ci? str x )) record ))
  107. (item (lset-difference equal? record result)))
  108. (cond ((null? item )
  109. (printf " You are not carrying that item !\n" ))
  110. (else
  111. (printf " Removed ~a from your bag .\n" (first item ))
  112. (add-object objectdb id (first item ))
  113. (hash-set! db `bag result ))))))
  114.  
  115. ;;Shortcuts
  116. (define (pick-item id input )
  117. (let ((item (string-join (cdr (string-split input )))))
  118. (remove-object-from-room objectdb id item )))
  119.  
  120. (define (put-item id input )
  121. (let ((item (string-join (cdr (string-split input )))))
  122. (remove-object-from-inventory inventorydb id item )))
  123.  
  124. (define (display-inventory)
  125. (display-objects inventorydb `bag ))
  126.  
  127. ;;return the description of the room when first entered
  128. (define (get-description id bla)
  129. (cond
  130. ((null? bla) '())
  131. ((eq? (caar bla) id) (second(car bla)))
  132. (else(get-description id (cdr bla)) )))
  133. ;;convert list of symbols into strings
  134. (define (slist->string l)
  135. (string-join (map symbol->string l)))
  136.  
  137. ;;return directions of the room when the "look" command is used
  138. (define (get-directions id)
  139. (let ((record (assq id decisiontable)))
  140. (let* ((result (filter (lambda (n) (number? (second n))) (cdr record)))
  141. (n (length result )))
  142. (cond ((= 0 n)
  143. (printf " You appear to have entered a room with no exits .\n " ))
  144. ((= 1 n)
  145. (printf " You can see an exit to the ~a ." (slist->string (caar result))))
  146. (else
  147. (let* ((losym (map (lambda (x) (car x)) result))
  148. (lostr ( map (lambda (x ) ( slist->string x )) losym)))
  149. (printf (string-append " You can see exits to the "(string-join lostr " and " )))))))))
  150.  
  151. (define (assq-ref l id)
  152. (cdr (assq id l)))
  153.  
  154. (define (assv-ref l id)
  155. (cdr (assv id l)))
  156.  
  157. (define (get-keywords id)
  158. (let ((keys (assq-ref decisiontable id)))
  159. (map (lambda (key) (car key)) keys)))
  160.  
  161. (define (list-of-length l t)
  162. (map
  163. (lambda (x)
  164. (let ((set(lset-intersection equal? t x)))
  165. (*(/(length set) (length x)) (length set))))
  166. l))
  167. ;;largest number in list returned
  168. (define (index-of-largest-number l)
  169. (let ((n (car (sort l >))))
  170. (if (zero? n)
  171. #f
  172. (list-index (lambda (x) (eq? x n) )l))))
  173.  
  174. ;;The tokens entered will give a response
  175. (define (lookup id tokens )
  176. (let* ((record (assv-ref decisiontable id ))
  177. (keylist (get-keywords id ))
  178. (index (index-of-largest-number (list-of-length keylist tokens))))
  179. (if index
  180. (cadr (list-ref record index))
  181. #f)))
  182.  
  183.  
  184. ;;Game started
  185. (define (startgame initial-id )
  186. (let loop ((id initial-id ) (description #t ))
  187. (if description
  188. (printf "~a \n >" (get-description id descriptions ))
  189. (printf "\n > " ))
  190. (let* ((input (read-line ))
  191. (string-tokens (string-tokenize input))
  192. (tokens (map string->symbol string-tokens)))
  193. (let ((response (lookup id tokens)))
  194. (cond
  195. ((number? response )
  196. (loop response #t ))
  197. ;;invalid, ask again
  198. ((eq? #f response )
  199. (printf " huh ? I didn ’t understand that !\n")
  200. (loop id #f ))
  201. ;;if look, look in the room
  202. ((eq? response 'look )
  203. (get-directions id )
  204. (printf"\n")
  205. (display-objects objectdb id)
  206. (printf"\n")
  207. (display-objects inventorydb 'bag)
  208. (loop id #f))
  209. ;;if pick, pick item off floor
  210. ((eq? response 'pick)
  211. (pick-item id input)
  212. (loop id #f))
  213. ;;if put, drop an item on the floor
  214. ((eq? response 'drop)
  215. (put-item id input)
  216. (loop id #f)))
  217. ;;if quit, go home
  218. ((eq? response 'quit )
  219. (printf "You have returned the princess to the castle entrance and won the game, Congratulations!!!\n")
  220. (exit ))))))
  221.  
  222. (startgame 1)
Advertisement
Add Comment
Please, Sign In to add comment