stupid stupid

kekkonen.scm

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