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

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 (require racket/gui/easy
racket/gui/easy/operator) racket/gui/easy/operator)
(require "interpret.rkt") (require "interpret.rkt")
(require "console.rkt")
(define mono (send the-font-list find-or-create-font 12 'modern 'normal 'normal)) (define mono (send the-font-list find-or-create-font 12 'modern 'normal 'normal))
(define/obs @log "You awake in a dark room.") (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 ;for clarity - an x/y pair that represents a dimension instead of a position
(struct dim pos ()) (struct dim pos ())
(struct obj (name pos)) (struct object (name pos))
(struct item obj (size)) (struct item object (size))
(struct equipment item (type)) (struct equipment item (type))
(struct weapon equipment (damage)) (struct weapon equipment (damage))
(struct armor equipment (resistance)) (struct armor equipment (resistance))
(struct entity obj ((inventory #:mutable))) (struct entity object ((inventory #:mutable)))
(struct creature entity (species (struct creature entity (species
(health #:mutable) (health #:mutable)
(equipment #:mutable))) (equipment #:mutable)))
(struct player creature (capacity)) (struct player creature (capacity))
(struct room (pos (struct room entity (size))
size
(contents #:mutable)))

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