kiefac/lispjam24
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

pull out look, utils; rename object struct; turn room struct into a substruct of entity; remove console.rkt require

Browse source
This commit is contained in:
kiefac 2024-05-23 20:19:00 -04:00
parent 5c865db137
commit 2e055721c5
5 changed files with 123 additions and 62 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

95
interpret.rkt
View file

@ -1,15 +1,23 @@
#lang racket/gui
(require "structs.rkt")
(require "structs.rkt"
"look.rkt"
"utils.rkt")
(provide interpret)
;temporary hard-coded player and room with items for testing, before implementing procgen
(define room1 (room
(pos 0 0)
(dim 10 10)
(list (weapon "BIG SWORD" (pos 5 5) 4 'sword 5)
(armor "LEATHER CAP" (pos 5 9) 1 'helmet 2))))
(define plyr (player "YOU" room1 '() 'human 20 '() 50))
(set-room-contents! room1 (append (room-contents room1) (list plyr)))
(define room1 (room "A DARK ROOM"
(pos 0 0)
(list (armor "LEATHER CAP" (pos 5 9) 1 'helmet 2))
(dim 0 0)))
(add-to-inventory! room1 (entity "CHEST"
room1
(list (weapon "BIG SWORD" (pos 5 5) 4 'sword 5))))
(define plyr (player "YOU"
room1
'()
'human 20 '() 50))
(add-to-inventory! room1 plyr)
(define (interpret in)
(let ([command (string-upcase in)])
@ -19,52 +27,29 @@
[verb (first tokens)]
[args (rest tokens)])
(case verb
[("LOOK") (look args)]
[("LOOK") (look args room1)]
[("TAKE") (take args room1 plyr)]
[else (~a "I don't understand the verb " verb ".")])))))
(define (look what)
(let ([room (obj-pos plyr)])
(if (empty? what)
(string-join (obj-names (room-contents room)) ", "
#:before-first "In this area, there is: "
#:before-last ", and "
#:after-last ".")
(let* ([what-str (string-join what)]
[obj (find-obj what-str room)])
(if (find-obj what-str room)
(~a "There is a " what-str " in the area."
(describe-obj obj))
(~a "The \"" what-str "\" you're looking for isn't in this area."))))))
(define (find-obj obj room)
(findf
(λ (arg) (string=? obj (obj-name arg)))
(room-contents room)))
(define (obj-names list)
(map obj-name list))
(define (describe-obj obj)
(let ([output ""])
(when (player? obj)
(append-str! output "\nIt's you."))
(when (item? obj)
(append-str! output (~a "\nIt has a size of: " (item-size obj) "."))
(when (equipment? obj)
(append-str! output (~a "\nIt is a piece of equipment of type: " (equipment-type obj) "."))
(when (weapon? obj)
(append-str! output (~a "\nIt deals " (weapon-damage obj) " damage.")))
(when (armor? obj)
(append-str! output (~a "\nIt has a damage resistance of: " (armor-resistance obj) ".")))))
(when (creature? obj)
(append-str! output (~a "\nIts species is: " (creature-species obj) "."))
(append-str! output (~a "\nIt's at " (creature-health obj) "HP."))
(if (empty? (creature-equipment obj))
(append-str! output (~a "\nIt doesn't look like it's carrying anything."))
(append-str! output (~a "\nIt looks like it's carrying something."))))
output))
(define-syntax-rule (append-str! str1 str2)
(set! str1 (~a str1 str2)))
(define (take args where who)
(if (empty? args)
"You need to say what to take."
(let* ([args-str (string-join args)]
[split-str (string-split args-str " FROM ")]
[what-str (first split-str)]
[from-str (if (= 1 (length split-str))
'()
(last split-str))]
[from (if (empty? from-str)
where
(find-object-by-name from-str where))]
[what (find-object-by-name what-str from)])
(when (empty? from-str)
(set! from-str (object-name where)))
(if what
(if (creature? what)
"You can't take a living thing."
(if (entity? what)
"You can't take something with an inventory."
(move-obj! what from who)))
(~a "There isn't a \"" what-str "\" in this area.")))))

42
look.rkt Normal file
View file

@ -0,0 +1,42 @@
#lang racket/gui
(require "structs.rkt"
"utils.rkt")
(provide look)
(define (look what where)
(if (empty? what)
(~a "In this area, there is: " (oxford-object-names where))
(let* ([what-str (string-join what)]
[obj (find-object-by-name what-str where)])
(if obj
(~a "There is a " what-str " in the area."
(describe-obj obj))
(~a "The \"" what-str "\" you're looking for isn't in this area.")))))
(define (describe-obj obj)
(let ([output ""])
(when (player? obj)
(append-str! output "\nIt's you."))
(when (item? obj)
(append-str! output (~a "\nIt has a size of: " (item-size obj) "."))
(when (equipment? obj)
(append-str! output (~a "\nIt is a piece of equipment of type: " (equipment-type obj) "."))
(when (weapon? obj)
(append-str! output (~a "\nIt deals " (weapon-damage obj) " damage.")))
(when (armor? obj)
(append-str! output (~a "\nIt has a damage resistance of: " (armor-resistance obj) ".")))))
(cond
[(creature? obj)
(append-str! output (~a "\nIts species is: " (creature-species obj) "."))
(append-str! output (~a "\nIt's at " (creature-health obj) "HP."))
(if (empty? (creature-equipment obj))
(append-str! output (~a "\nIt doesn't look like it's carrying anything."))
(append-str! output (~a "\nIt looks like it's carrying something.")))]
[else
(when (entity? obj)
(append-str! output (~a "\nInside is: " (oxford-object-names obj))))]
)
output))

1
main.rkt
View file

@ -10,7 +10,6 @@
(require racket/gui/easy
racket/gui/easy/operator)
(require "interpret.rkt")
(require "console.rkt")
(define mono (send the-font-list find-or-create-font 12 'modern 'normal 'normal))
(define/obs @log "You awake in a dark room.")

10
structs.rkt
View file

@ -5,19 +5,17 @@
;for clarity - an x/y pair that represents a dimension instead of a position
(struct dim pos ())
(struct obj (name pos))
(struct object (name pos))
(struct item obj (size))
(struct item object (size))
(struct equipment item (type))
(struct weapon equipment (damage))
(struct armor equipment (resistance))
(struct entity obj ((inventory #:mutable)))
(struct entity object ((inventory #:mutable)))
(struct creature entity (species
(health #:mutable)
(equipment #:mutable)))
(struct player creature (capacity))
(struct room (pos
size
(contents #:mutable)))
(struct room entity (size))

37
utils.rkt Normal file
View file

@ -0,0 +1,37 @@
#lang racket/gui
(require "structs.rkt")
(provide (all-defined-out))
(define (find-object obj where)
(find-object-by-name (object-name obj) where))
(define (find-object-by-name obj-name where)
(findf (λ (o) (string=? obj-name (object-name o)))
(if (creature? where)
(append (creature-equipment where) (entity-inventory where))
(entity-inventory where))))
(define (object-names list)
(map object-name list))
(define (oxford-object-names where)
(let ([lst (object-names (entity-inventory where))])
(if (empty? lst)
"nothing."
(string-join lst ", "
#:before-last ", and "
#:after-last "."))))
(define-syntax-rule (append-str! str1 str2)
(set! str1 (~a str1 str2)))
(define (add-to-inventory! ent obj)
(set-entity-inventory! ent (append (entity-inventory ent) (list obj))))
(define (remove-from-inventory! ent obj)
(set-entity-inventory! ent (remove obj (entity-inventory ent))))
(define (move-obj! obj from to)
(let ([obj-str (object-name obj)]
[from-str (object-name from)])
(add-to-inventory! to obj)
(remove-from-inventory! from obj)
(~a "Took " obj-str " from " from-str ".")))