#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 !

" ))

(else

(printf " Added ~a to your bag .

" (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 !

" ))

(else

(printf " Removed ~a from your bag .

" (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 .

" ))

((= 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

>" (get-description id descriptions ))

(printf "

> " ))

(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 !

")

(loop id #f ))

;;if look, look in the room

((eq? response 'look )

(get-directions id )

(printf"

")

(display-objects objectdb id)

(printf"

")

(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!!!

")

(exit ))))))