Haxima Scheme Corrections

worlds/haxima-1.001/abandoned-farm.scm

@@ -70,7 +70,7 @@
                 (list (mk-wood-spider) 9 22)
                 (list (mk-door) 13 17)
                 (list (mk-door) 7 25)
-                (list (mk-queen-spider faction-wood-spider) 9 23)
+                (list (mk-queen-spider) 9 23)
                 (list (mk-ladder-down 'p_abandoned_cellar 6 25) 6 25)
                 )
                (list 'af-entry) ; hooks

worlds/haxima-1.001/bim.scm

@@ -39,7 +39,7 @@
   (display "bim-change-state")(newline)
   (let ((bim (gob-data (kobj-gob kobj))))
     (bim-set-on! bim on?)
-    (let ((state ((kobj-ifc kobj) 'state on? kobj)))
+    (let ((state ((kobj-ifc kobj) 'state on?)))
       (display "state:")(display state)(newline)
       (kern-obj-set-sprite kobj (state-sprite state))
       (kern-obj-set-opacity kobj (state-opacity state))
@@ -50,13 +50,13 @@
 ;; handlers
 (define (bim-on kobj khandler) 
   (display "bim-on")(newline)
-  (bim-change-state kobj khandler #t 'on)
+  (bim-change-state kobj khandler #t)
   (bim-send-signal kobj 'on)
   )
 
 (define (bim-off kobj khandler) 
   ;;(display "bim-off")(newline)
-  (bim-change-state kobj khandler #f 'on)
+  (bim-change-state kobj khandler #f)
   (bim-send-signal kobj 'off)
   )
 

worlds/haxima-1.001/monster-generator.scm

@@ -108,7 +108,7 @@
 ;; mk-wilderness-ambush-generator -- make an object type for spawning random
 ;; ambush encounters
 ;; ----------------------------------------------------------------------------
-(define (mk-wilderness-ambush-generator-type tag threshold party faction)
+(define (mk-wilderness-ambush-generator-type tag threshold max party faction)
   (mk-obj-type tag                ;; tag
                nil                ;; name
                nil                ;; sprite

worlds/haxima-1.001/moongate-clearing-zones.scm

@@ -0,0 +1,8 @@
+;;----------------------------------------------------------------------------
+;; Zones for Moongate Clearing
+;;
+;; A zone is a rectangle formatted as:
+;;      (upper-left-corner-x upper-left-corner-y width height)
+;;----------------------------------------------------------------------------
+(define (mk-zone x y w h) (list 'p_moongate_clearing x y w h))
+(define mgc-roadbend (list 14 20 4 3))

worlds/haxima-1.001/moongate-clearing.scm

@@ -25,7 +25,7 @@
                nil                 ; container
                nil                 ; readied
                )
- (gregor-mk #f #f))
+ (gregor-mk))
 
 ;;-----------------------------------------------------------------------------
 ;; Make some chests containing items to get the player started. 

worlds/haxima-1.001/npc-types.scm

@@ -50,7 +50,7 @@
 ;; character is a monster, guard or similar cannon-fodder NPC, with no
 ;; interesting conversation, no schedule of appointments, etc.
 (define (mk-stock-char name species occupation sprite faction ai container 
-                       arms)
+                       arms . extra)
   (kern-mk-char
    nil ;;..........tag
    name ;;.........name

worlds/haxima-1.001/spells.scm

@@ -226,30 +226,29 @@
 (define (cast-wind-spell origin proc field-type)
   (let ((dir (ui-get-direction)))
     (if (null? dir) nil
-        (begin
-          (define (dropfield loc)
-            (if (kern-is-valid-location? loc)
-                (kern-obj-put-at (kern-mk-obj field-type 1) loc)))
-          (define (is-field? kobj) (eqv? field-type (kern-obj-get-type kobj)))
-          (define (rmfield loc)
-            (if (> (kern-dice-roll "2d20") 16)
-                (let ((fields (filter is-field? (kern-get-objects-at loc))))
-                  (cond ((null? fields) nil)
-                        (else
-                         (kern-obj-remove (car fields)))))))
-          (define (doline line)
-            (map (lambda (loc)
-                   (map proc (kern-get-objects-at loc)))
-                 line)
-            (map dropfield line)
-            (kern-map-repaint)
-            (map rmfield line)
-            )
-          (let ((lines (get-cone origin 10 dir)))
-            (cond ((null? lines) nil)
-                  (else
-                   (map doline (cdr lines))
-                   (kern-map-repaint))))))))
+                    (letrec ((dropfield (lambda (loc)
+                                          (if (kern-is-valid-location? loc)
+                                            (kern-obj-put-at (kern-mk-obj field-type 1) loc))))
+                              (is-field? (lambda (kobj)
+                                           (eqv? field-type (kern-obj-get-type kobj))))
+                              (rmfield (lambda (loc)
+                                         (if (> (kern-dice-roll "2d20") 16)
+                                           (let ((fields (filter is-field? (kern-get-objects-at loc))))
+                                             (cond ((null? fields) nil)
+                                               (else
+                                                 (kern-obj-remove (car fields))))))))
+                              (doline (lambda (line)
+                                        (map (lambda (loc)
+                                               (map proc (kern-get-objects-at loc)))
+                                          line)
+                                        (map dropfield line)
+                                        (kern-map-repaint)
+                                        (map rmfield line))))
+                      (let ((lines (get-cone origin 10 dir)))
+                        (cond ((null? lines) nil)
+                          (else
+                            (map doline (cdr lines))
+                            (kern-map-repaint))))))))
 
 ;; This version:
 ;;   o has caller-limited depth
@@ -264,6 +263,7 @@
   (define (doline line)
     (map dropfield line)
     (kern-map-repaint))
+  (display "cast-wind-spell2")(newline)
   (let ((lines (get-cone origin depth dir)))
     (cond ((null? lines) nil)
           (else

worlds/haxima-1.001/spider.scm

@@ -10,8 +10,8 @@
 ;   (apply display args))
 ; (define (spider-newline) (newline))
 
-(define (spider-display . args) )
-(define (spider-newline) )
+(define (spider-display . args) (if #f #f))
+(define (spider-newline) (if #f #f))
 
 ;; ----------------------------------------------------------------------------
 ;; Spider Egg
@@ -32,14 +32,14 @@
 ;; neighboring tiles contained non-spiders. I discontinued it because it made
 ;; eggs run too slowly (about 30ms per). Replaced it with a simple egg timer.
 (define (spider-egg-disturbed kegg)
-  (spider-display "spider-egg-disturbed")(spider-newline)
   (define (check val loc)
     (or val
         (foldr (lambda (a b) (or a
                                  (and (obj-is-char? b)
                                       (not (is-spider? b)))))
                #f
                (kern-get-objects-at loc))))
+  (spider-display "spider-egg-disturbed")(spider-newline)
   (let ((loc (kern-obj-get-location kegg)))
     (kern-fold-rect (loc-place loc)
                     (- (loc-x loc) 2)

worlds/haxima-1.001/trigrave.scm

@@ -311,8 +311,8 @@
   )
  (list 'trigrave-entry) ;; hooks
  (list  ;; edge entrances
-  (list south 18 0)
-  (list north  12 31)
+  (list north 18 0)
+  (list south  12 31)
   )
  )
 

worlds/haxima-1.001/troll.scm

@@ -4,8 +4,8 @@
 ;   (apply display args))
 ; (define (troll-newline) (newline))
 
-(define (troll-display . args) )
-(define (troll-newline) )
+(define (troll-display . args) (if #f #f))
+(define (troll-newline) (if #f #f))
 
 
 ;;----------------------------------------------------------------------------
@@ -96,7 +96,6 @@
 ;; with terrain that can be converted to ammo objects.
 ;; ----------------------------------------------------------------------------
 (define (troll-find-nearest-ammo ktroll)
-  (troll-display "troll-find-nearest-ammo")(troll-newline)
   (define (scanobjlst lst)
     (foldr (lambda (a b) 
              (or a (eqv? (kern-obj-get-type b) troll-ranged-weapon)))
@@ -108,6 +107,7 @@
         (if (scanobjlst (kern-get-objects-at loc))
             (cons loc lst)
             lst)))
+  (troll-display "troll-find-nearest-ammo")(troll-newline)
   (let* ((loc (kern-obj-get-location ktroll))
          (rad (kern-obj-get-vision-radius ktroll))
          (coords (profile foldr-rect (loc-place loc)
@@ -134,7 +134,6 @@
     (profile loc-closest loc coords)))
 
 (define (troll-find-nearest-ammo3 ktroll)
-  (troll-display "troll-find-nearest-ammo3")(troll-newline)
   (define (scanobjlst lst)
     (foldr (lambda (a b) 
              (or a (eqv? (kern-obj-get-type b) troll-ranged-weapon)))
@@ -146,6 +145,7 @@
         (if (scanobjlst (kern-get-objects-at loc))
             (cons loc lst)
             lst)))
+  (troll-display "troll-find-nearest-ammo3")(troll-newline)
   (let* ((loc (kern-obj-get-location ktroll))
          (rad (kern-obj-get-vision-radius ktroll))
          (coords (profile kern-fold-rect (loc-place loc)

worlds/haxima-1.002/bim.scm

@@ -38,7 +38,7 @@
   ;;(display "bim-change-state")(newline)
   (let ((bim (gob-data (kobj-gob kobj))))
     (bim-set-on! bim on?)
-    (let ((state ((kobj-ifc kobj) 'state on? kobj)))
+    (let ((state ((kobj-ifc kobj) 'state on?)))
       ;;(display "state:")(display state)(newline)
       (kern-obj-set-sprite kobj (state-sprite state))
       (kern-obj-set-opacity kobj (state-opacity state))
@@ -49,13 +49,13 @@
 ;; handlers
 (define (bim-on kobj khandler) 
   ;(display "bim-on")(newline)
-  (bim-change-state kobj khandler #t 'on)
+  (bim-change-state kobj khandler #t)
   (bim-send-signal kobj 'on)
   )
 
 (define (bim-off kobj khandler) 
   ;(display "bim-off")(newline)
-  (bim-change-state kobj khandler #f 'on)
+  (bim-change-state kobj khandler #f)
   (bim-send-signal kobj 'off)
   )
 

worlds/haxima-1.002/monster-generator.scm

@@ -56,7 +56,7 @@
 ;; mk-wilderness-ambush-generator -- make an object type for spawning random
 ;; ambush encounters
 ;; ----------------------------------------------------------------------------
-(define (mk-wilderness-ambush-generator-type tag threshold party faction)
+(define (mk-wilderness-ambush-generator-type tag threshold max party faction)
   (mk-obj-type tag                ;; tag
                nil                ;; name
                nil                ;; sprite

worlds/haxima-1.002/spells.scm

@@ -135,30 +135,29 @@
 (define (cast-wind-spell origin proc field-type)
   (let ((dir (ui-get-direction)))
     (if (null? dir) nil
-        (begin
-          (define (dropfield loc)
+        (letrec (
+          (dropfield (lambda (loc))
             (if (kern-is-valid-location? loc)
-                (kern-obj-put-at (kern-mk-obj field-type 1) loc)))
-          (define (is-my-field? kobj) (eqv? field-type (kern-obj-get-type kobj)))
-          (define (rmfield loc)
+                (kern-obj-put-at (kern-mk-obj field-type 1) loc))))
+          (is-my-field? (lambda (kobj) (eqv? field-type (kern-obj-get-type kobj))))
+          (rmfield (lambda (loc)
             (if (> (kern-dice-roll "2d20") 16)
                 (let ((fields (filter is-my-field? (kern-get-objects-at loc))))
                   (cond ((null? fields) nil)
                         (else
-                         (kern-obj-remove (car fields)))))))
-          (define (doline line)
+                         (kern-obj-remove (car fields))))))))
+          (doline (lambda (line)
             (map (lambda (loc)
                    (map proc (kern-get-objects-at loc)))
                  line)
             (map dropfield line)
             (kern-map-repaint)
-            (map rmfield line)
-            )
-          (let ((lines (get-cone origin 10 dir)))
-            (cond ((null? lines) nil)
-                  (else
-                   (map doline (cdr lines))
-                   (kern-map-repaint))))))))
+            (map rmfield line))))
+        (let ((lines (get-cone origin 10 dir)))
+          (cond ((null? lines) nil)
+                (else
+                 (map doline (cdr lines))
+                 (kern-map-repaint)))))))
 
 ;; This version:
 ;;   o has caller-limited depth

worlds/haxima-1.002/spider.scm

@@ -9,8 +9,8 @@
 ;   (apply display args))
 ; (define (spider-newline) (newline))
 
-(define (spider-display . args) )
-(define (spider-newline) )
+(define (spider-display . args) (if #f #f))
+(define (spider-newline) (if #f #f))
 
 ;; ----------------------------------------------------------------------------
 ;; Spider Egg
@@ -31,7 +31,6 @@
 ;; neighboring tiles contained non-spiders. I discontinued it because it made
 ;; eggs run too slowly (about 30ms per). Replaced it with a simple egg timer.
 (define (spider-egg-disturbed kegg)
-  (spider-display "spider-egg-disturbed")(spider-newline)
   (define (check val loc)
     ;;(display "loc:")(display loc)(newline)
     (or val
@@ -40,6 +39,7 @@
                                       (not (is-spider? b)))))
                #f
                (kern-get-objects-at loc))))
+  (spider-display "spider-egg-disturbed")(spider-newline)
   (let ((loc (kern-obj-get-location kegg)))
     (kern-fold-rect (loc-place loc)
                     (- (loc-x loc) 2)

worlds/haxima-1.002/trigrave.scm

@@ -326,8 +326,8 @@
   )
  (list 'lock-inn-room-doors) ;; hooks
  (list  ;; edge entrances
-  (list south 18 0)
-  (list north  12 31)
+  (list north 18 0)
+  (list south  12 31)
   )
  )
 

worlds/haxima-1.002/troll.scm

@@ -4,8 +4,8 @@
 ;   (apply display args))
 ; (define (troll-newline) (newline))
 
-(define (troll-display . args) )
-(define (troll-newline) )
+(define (troll-display . args) (if #f #f))
+(define (troll-newline) (if #f #f))
 (define troll-melee-weapon t_horns)
 
 ;;----------------------------------------------------------------------------
@@ -96,7 +96,6 @@
 ;; with terrain that can be converted to ammo objects.
 ;; ----------------------------------------------------------------------------
 (define (troll-find-nearest-ammo ktroll)
-  (troll-display "troll-find-nearest-ammo")(troll-newline)
   (define (scanobjlst lst)
     (foldr (lambda (a b) 
              (or a (eqv? (kern-obj-get-type b) troll-ranged-weapon)))
@@ -108,6 +107,7 @@
         (if (scanobjlst (kern-get-objects-at loc))
             (cons loc lst)
             lst)))
+  (troll-display "troll-find-nearest-ammo")(troll-newline)
   (let* ((loc (kern-obj-get-location ktroll))
          (rad (kern-obj-get-vision-radius ktroll))
          (coords (profile foldr-rect (loc-place loc)
@@ -134,7 +134,6 @@
     (profile loc-closest loc coords)))
 
 (define (troll-find-nearest-ammo3 ktroll)
-  (troll-display "troll-find-nearest-ammo3")(troll-newline)
   (define (scanobjlst lst)
     (foldr (lambda (a b) 
              (or a (eqv? (kern-obj-get-type b) troll-ranged-weapon)))
@@ -146,6 +145,7 @@
         (if (scanobjlst (kern-get-objects-at loc))
             (cons loc lst)
             lst)))
+  (troll-display "troll-find-nearest-ammo3")(troll-newline)
   (let* ((loc (kern-obj-get-location ktroll))
          (rad (kern-obj-get-vision-radius ktroll))
          (coords (profile kern-fold-rect (loc-place loc)