Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- (require srfi/1)
- (require srfi/13)
- (require srfi/48)
- ;; Defined descriptions for each command in the rooms
- (define descriptions '((1 "You come across a spooky castle and enter the castle entrance! ")
- (2 "There seems to be a stench coming from the toilet of the room you've entered, gross ")
- (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!.")
- (4 "You are in the castle hallway and see exits around you")
- (5 "You are in the castle living room filled with old dusty furniture")
- (6 "You appear to be in the castle dining room, you can hear a scream coming from the north!")
- (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!")))
- (define objects `((3 "A loaf of bread" )
- (7 "a princess" )))
- ;;defines the functions for the game, keywords used for its functionality
- (define look '(((directions) look) ((look) look) ((examine room) look)))
- (define quit '(((exit game) quit) ((quit game) quit) ((exit) quit) ((quit) quit)))
- (define inventory `(((inventory ) inventory ) ((bag ) inventory )))
- (define pick `(((get)pick) ((pickup)pick) ((pick)pick) ((take)pick)))
- (define put `(((put)drop) ((drop)drop)((remove)drop)))
- (define eat `(((eat)eat)))
- (define actions `(,@look ,@quit ,@pick ,@put ,@inventory ))
- ;Decision table actions for entering rooms, allows user to choose between which direction you can move in and back
- (define decisiontable `((1 ((north) 4) ((east) 2) ((west) 3) ,@actions)
- (2 ((west) 1) ,@actions)
- (3 ((east) 1),@actions)
- (4 ((north) 5) ((south) 1),@actions)
- (5 ((south) 4) ((east) 6),@actions)
- (6 ((west) 5) ((north) 7),@actions)
- (7 ((south) 6) ((west) 5),@actions)))
- ;;creates the object data base
- (define objectdb (make-hash ))
- (define inventorydb (make-hash ))
- ;;adds one object to the hash table
- (define (add-object db id object )
- (if (hash-has-key? db id )
- (let ((record (hash-ref db id )))
- (hash-set! db id (cons object record )))
- (hash-set! db id (cons object empty ))))
- ;;adds all object to hash table
- (define (add-objects db )
- (for-each
- (lambda (r)
- (add-object db (first r) (second r ))) objects ))
- (hash-set! objectdb 1 '())
- (hash-set! inventorydb 'bag '())
- (add-objects objectdb )
- ;; searches the inventory for the princess
- (define (search db)
- (if (null? db)
- #f
- (if (eq? "a princess" (car db))
- #t
- (search (cdr db)))))
- ;; search the inventory for the loaf of bread
- (define (search2 db)
- (if (null? db)
- #f
- (if (eq? "a loaf of bread" (car db))
- #t
- (search2 (cdr db)))))
- ;;display objects in database
- (define (display-objects db id )
- (if (hash-has-key? db id )
- (let* ((record (hash-ref db id ))
- (output (string-join record " and " )))
- (if (eq? id 'bag )
- (if (equal? output "" )
- (printf "Your bag is empty.")
- (printf " You are carrying ~a. " output))
- (if (equal? output "" )
- (printf "The room is empty")
- (printf "You can see ~a . " output))))
- (printf "Does not exist")))
- ;;Removing items from room
- (define (remove-object-from-room db id str )
- (when (hash-has-key? db id )
- (let* ((record (hash-ref db id ))
- (result (remove (lambda(x) (string-suffix-ci? str x)) record ))
- (item (lset-difference equal? record result)))
- (cond ((null? item) ;;Checks if the value is null and there isnt the item stated in the room
- (printf "I don ’t see that item in the room !\n" ))
- (else
- (printf " Added ~a to your bag .\n" (first item )) ;;Found item will be placed in bag
- (add-object inventorydb `bag (first item ))
- (hash-set! db id result ))))))
- ;;Removing items from inventory
- (define (remove-object-from-inventory db id str )
- (when (hash-has-key? db `bag )
- (let* ((record (hash-ref db `bag ))
- (result (remove (lambda (x) (string-suffix-ci? str x )) record ))
- (item (lset-difference equal? record result)))
- (cond ((null? item )
- (printf " You are not carrying that item !\n" ))
- (else
- (printf " Removed ~a from your bag .\n" (first item ))
- (add-object objectdb id (first item ))
- (hash-set! db `bag result ))))))
- ;;Shortcuts
- (define (pick-item id input )
- (let ((item (string-join (cdr (string-split input )))))
- (remove-object-from-room objectdb id item )))
- (define (put-item id input )
- (let ((item (string-join (cdr (string-split input )))))
- (remove-object-from-inventory inventorydb id item )))
- (define (display-inventory)
- (display-objects inventorydb `bag ))
- ;;return the description of the room when first entered
- (define (get-description id bla)
- (cond
- ((null? bla) '())
- ((eq? (caar bla) id) (second(car bla)))
- (else(get-description id (cdr bla)) )))
- ;;convert list of symbols into strings
- (define (slist->string l)
- (string-join (map symbol->string l)))
- ;;return directions of the room when the "look" command is used
- (define (get-directions id)
- (let ((record (assq id decisiontable)))
- (let* ((result (filter (lambda (n) (number? (second n))) (cdr record)))
- (n (length result )))
- (cond ((= 0 n)
- (printf " You appear to have entered a room with no exits .\n " ))
- ((= 1 n)
- (printf " You can see an exit to the ~a ." (slist->string (caar result))))
- (else
- (let* ((losym (map (lambda (x) (car x)) result))
- (lostr ( map (lambda (x ) ( slist->string x )) losym)))
- (printf (string-append " You can see exits to the "(string-join lostr " and " )))))))))
- (define (assq-ref l id)
- (cdr (assq id l)))
- (define (assv-ref l id)
- (cdr (assv id l)))
- (define (get-keywords id)
- (let ((keys (assq-ref decisiontable id)))
- (map (lambda (key) (car key)) keys)))
- (define (list-of-length l t)
- (map
- (lambda (x)
- (let ((set(lset-intersection equal? t x)))
- (*(/(length set) (length x)) (length set))))
- l))
- ;;largest number in list returned
- (define (index-of-largest-number l)
- (let ((n (car (sort l >))))
- (if (zero? n)
- #f
- (list-index (lambda (x) (eq? x n) )l))))
- ;;The tokens entered will give a response
- (define (lookup id tokens )
- (let* ((record (assv-ref decisiontable id ))
- (keylist (get-keywords id ))
- (index (index-of-largest-number (list-of-length keylist tokens))))
- (if index
- (cadr (list-ref record index))
- #f)))
- ;;Game started
- (define (startgame initial-id )
- (let loop ((id initial-id ) (description #t ))
- (if description
- (printf "~a \n >" (get-description id descriptions ))
- (printf "\n > " ))
- (let* ((input (read-line ))
- (string-tokens (string-tokenize input))
- (tokens (map string->symbol string-tokens)))
- (let ((response (lookup id tokens)))
- (cond
- ((number? response )
- (loop response #t ))
- ;;invalid, ask again
- ((eq? #f response )
- (printf " huh ? I didn ’t understand that !\n")
- (loop id #f ))
- ;;if look, look in the room
- ((eq? response 'look )
- (get-directions id )
- (printf"\n")
- (display-objects objectdb id)
- (printf"\n")
- (display-objects inventorydb 'bag)
- (loop id #f))
- ;;if pick, pick item off floor
- ((eq? response 'pick)
- (pick-item id input)
- (loop id #f))
- ;;if put, drop an item on the floor
- ((eq? response 'drop)
- (put-item id input)
- (loop id #f)))
- ;;if quit, go home
- ((eq? response 'quit )
- (printf "You have returned the princess to the castle entrance and won the game, Congratulations!!!\n")
- (exit ))))))
- (startgame 1)
Advertisement
Add Comment
Please, Sign In to add comment