optimisations

This commit is contained in:
Dave Griffiths 2009-10-26 15:00:45 +00:00
parent c1c1bbb0e1
commit 3f9dfe95ab
3 changed files with 35 additions and 3 deletions

View file

@ -50,3 +50,8 @@
((null? l) #f) ((null? l) #f)
((eq? (car l) k) n) ((eq? (car l) k) n)
(else (which-element k (cdr l) (+ n 1))))) (else (which-element k (cdr l) (+ n 1)))))
(define (last l)
(cond ((null? (cdr l)) (car l))
(else
(last (cdr l)))))

View file

@ -36,6 +36,7 @@
(define insect-send-prob 3) (define insect-send-prob 3)
(define update-count 0) (define update-count 0)
(define num-checks 0)
; moveme ; moveme
(define (collide? line objs) (define (collide? line objs)
@ -353,11 +354,34 @@
; adds the ornament if it's close, and checks sub-twigs ; adds the ornament if it's close, and checks sub-twigs
; returns true if it's succeded ; returns true if it's succeded
(define/public (check-pickup pickup) (define/public (check-pickup pickup)
; check last point in our twig
(set! num-checks (+ num-checks 1))
; if we havent found anything yet and it's intersecting
(cond ((and (not (null? points))
(< (vdist-sq (vadd (send plant get-pos) (last points))
(send pickup get-pos))
100 #;(+ width (send pickup get-size))))
(set! pickedups (cons (list pickup (- (length points) 1)) pickedups))
(send pickup pick-up) ; this will remove the pickup for us
(send-message 'pick-up-highlight
(list (list 'pickup-id (send pickup get-id))
(list 'plant-id (send plant get-id))))
#t)
(else
(foldl
(lambda (twig found)
(if (not found)
(send (cadr twig) check-pickup pickup)
#f))
#f
twigs)))
; check each point in our twig ; check each point in our twig
(let* ((i -1) (found (foldl #;(let* ((i -1) (found (foldl
(lambda (point found) (lambda (point found)
(set! i (+ i 1)) (set! i (+ i 1))
(set! num-checks (+ num-checks 1))
; if we havent found anything yet and it's intersecting ; if we havent found anything yet and it's intersecting
(cond ((and (not found) (< (vdist (vadd (send plant get-pos) point) (cond ((and (not found) (< (vdist (vadd (send plant get-pos) point)
(send pickup get-pos)) (send pickup get-pos))
@ -371,6 +395,7 @@
(else #f))) (else #f)))
#f #f
points))) points)))
; now check each sub-twig ; now check each sub-twig
(if (not found) (if (not found)
(foldl (foldl
@ -795,7 +820,9 @@
(printf "num updates ~a~n" update-count) (printf "num updates ~a~n" update-count)
(printf "num pickups ~a~n" (length pickups)) (printf "num pickups ~a~n" (length pickups))
(printf "num checks ~a~n" num-checks)
(set! update-count 0) (set! update-count 0)
(set! num-checks 0)
(run-auto-pilot t d) (run-auto-pilot t d)

View file

@ -1602,7 +1602,7 @@
((eq? type 'leaf) "found a nutrient from the leaf plant") ((eq? type 'leaf) "found a nutrient from the leaf plant")
((eq? type 'horn) "found a nutrient from the horn plant") ((eq? type 'horn) "found a nutrient from the horn plant")
((eq? type 'inflatoe) "found an inflatoe growing ability") ((eq? type 'inflatoe) "found an inflatoe growing ability")
((eq? type 'fork) "found a nutrient from the hanging plant") ((eq? type 'fork) "found a nutrient from the canopy plant")
((eq? type 'flower) "found a nutrient from the flower plant")) 4)))))) ((eq? type 'flower) "found a nutrient from the flower plant")) 4))))))
(define/public (add-ornament plant-id twig-id point-index property) (define/public (add-ornament plant-id twig-id point-index property)