whiteline/kekkonen
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

stupid stupid

Browse Source
This commit is contained in:
Victor Fors 2020-10-07 17:41:57 +02:00
parent cd795692e3
commit faedb83046
1 changed files with 8 additions and 15 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

23
kekkonen.scm
View File

@ -385,7 +385,8 @@
(if (not object) (if (not object)
(show "You can't see that here.") (show "You can't see that here.")
(begin (begin
(setter tag value)))))) (setter object value)
(show "You set a value."))))))
(define (do-command-rename tag name) (define (do-command-rename tag name)
(do-setter-command tag name string? set-name)) (do-setter-command tag name string? set-name))
@ -417,13 +418,11 @@
(up . down) (up . down)
(down . up))) (down . up)))
(define (get-cardinal-set direction)
(find (cut member direction <>) +cardinal-sets+))
(define (get-cardinal-aliases direction) (define (get-cardinal-aliases direction)
(let loop ((directions +cardinal-sets+)) (perhaps (cut remove (cut eq? direction <>) <>) (get-cardinal-set direction)))
(if (null? directions)
#f
(if (member direction (car directions))
(remove (cut eq? direction <>) (car directions))
(loop (cdr directions))))))
(define (cardinal-direction? direction) (define (cardinal-direction? direction)
(list? (member direction (flatten +cardinal-sets+)))) (list? (member direction (flatten +cardinal-sets+))))
@ -432,12 +431,7 @@
(perhaps cdr (assoc direction +cardinal-opposites+))) (perhaps cdr (assoc direction +cardinal-opposites+)))
(define (get-canonical-cardinal-direction-name direction) (define (get-canonical-cardinal-direction-name direction)
(let loop ((directions +cardinal-sets+)) (perhaps car (get-cardinal-set direction)))
(if (null? directions)
#f
(if (member direction (car directions))
(caar directions)
(loop (cdr directions))))))
(define (do-command-dig direction destination) (define (do-command-dig direction destination)
(if (not (and (symbol? direction) (symbol? destination))) (if (not (and (symbol? direction) (symbol? destination)))
@ -452,8 +446,7 @@
(move-object exit-tag (get-container 'you)) (move-object exit-tag (get-container 'you))
(set-hidden exit-tag #t) (set-hidden exit-tag #t)
(set-destination exit-tag destination) (set-destination exit-tag destination)
(add-alias exit-tag canonical-direction) (map (cut add-alias exit-tag <>) (get-cardinal-set direction))
(map (cut add-alias exit-tag <>) (get-cardinal-aliases canonical-direction))
(show "You create a passage.")))))))) (show "You create a passage."))))))))
(define (do-command-exit) (define (do-command-exit)