1 2(define (edge-spawn-exec kwm) 3 4 ;;(println "edge-spawn-exec") 5 6 (define (get-ptype loc) 7 (println "get-ptype:" loc) 8 (terrain-to-ptype (kern-place-get-terrain loc) 9 (mean-player-party-level))) 10 11 (define (try-to-spawn-at loc) 12 (let ((ptype (get-ptype loc))) 13 ;;(println " try-to-spawn-at:ptype=" ptype) 14 (if (not (null? ptype)) 15 (let ((kparty (ptype-generate ptype))) 16 ;; note: must put the party on the map (thus giving it a refcount) 17 ;; before setting ttl 18 ;; FIXME: what if loc is invalid? will put-at fail? will ttl then crash? 19 (kern-obj-put-at kparty loc) 20 (kern-obj-set-ttl kparty 50) 21 )))) 22 23 (define (pick-edge-tile) 24 (let* ((ww 9) 25 (wh 9) 26 (ploc (kern-obj-get-location (kern-get-player))) 27 (kplace (loc-place ploc)) 28 (x (loc-x ploc)) 29 (y (loc-y ploc))) 30 (case (modulo (random-next) 4) 31 ((0) (random-loc kplace (- x ww) (- y wh) (+ 1 (* 2 ww)) 1)) ; north 32 ((1) (random-loc kplace (- x ww) (+ y wh) (+ 1 (* 2 ww)) 1)) ; south 33 ((2) (random-loc kplace (+ x ww) (- y wh) 1 (+ 1 (* 2 wh)))) ; east 34 ((3) (random-loc kplace (- x ww) (- y wh) 1 (+ 1 (* 2 wh)))) ; west 35 ))) 36 37 (define (roll-to-spawn?) 38 (>= (modulo (random-next) 100) 98)) 39 40 (if (and (kern-place-is-wilderness? (loc-place (kern-obj-get-location (kern-get-player)))) 41 (roll-to-spawn?)) 42 (try-to-spawn-at (pick-edge-tile))) 43 44 ) 45 46(define edge-spawn-ifc 47 (ifc nil 48 (method 'exec edge-spawn-exec))) 49 50(mk-obj-type 't_edge_spawn nil nil layer-none edge-spawn-ifc) 51 52(define (mk-edge-spawn-generator) 53 (kern-obj-set-visible (kern-mk-obj t_edge_spawn 1) #f) 54 ) 55