在球拍中编码弹跳球

Question

我正在尝试创建一个World in Racket，其中World接收一个Listof Ball（Ball是一个具有y坐标，速度和弹性的结构）并创建一个大爆炸，这些球在窗口内弹跳。当球全部停止弹跳时（y坐标= 0，速度= 0），模拟将结束。

这就是我到目前为止......

(define-struct Ball
  ([y : Real] ;; position above ground of the center of ball in metres
   [v : Real] ;; velocity in m/s
   [e : Real] ;; between 0 and 1
   [r : Real] ;; radius in meters
   [c : Image-Color])) ;; colour of ball

(define-type World (Listof Ball))

我有点迷失了我的第一步应该是什么;我不太确定速度和弹性的参数如何适合方程式。特别是这些是我的担忧：

1）我们如何设计一个包含Listof

的世界

2）我如何将球的弹跳限制在一个明确的窗口（也就是如何确保球不会从定义的窗口弹回）

任何可以启动我的努力的想法？ :)提前致谢！

Answer 1

我正在尝试一段时间试图让球以功能性方式反弹。我没有到达那里，但我确实通过复制Flash程序来实现弹跳。当我调查它时，碰撞被证明是一个相当深刻的问题，并且取决于你想要的准确性/高效性，你可以做很多事情。无论如何，如果有人仍然对这个问题感兴趣，我会走多远。

#lang racket

(require 2htdp/image 2htdp/universe)

(define HEIGHT 300)
(define WIDTH 400)
(define ESCENE (empty-scene WIDTH HEIGHT))
(define colors '("red" "green" "blue" "purple" "black" "orange"))
(define FRICTION 1)
(define GRAVITY .5)

(struct pos [x y] #:transparent #:mutable)
(struct motion pos [dx dy] #:transparent #:mutable)

(struct ball motion [size (color #:mutable)] #:transparent)

(struct fps (prev-time res)#:transparent)
(struct world [balls fps] #:transparent)

(define (random-range min max)
    (define rand (exact->inexact (random (- max min))))
    (+ rand min))

(define (rand-color)
  (list-ref colors (random (length colors))))

(define ball-lst (build-list (+ 5(random 10)) (lambda (x)
                  (ball (random WIDTH)
                        (random HEIGHT)
                        (random-range -10 10)
                        (random-range -10 10)
                        (random-range 15 30)
                        ;(rand-color)
                        "red"))))

(define (make-world)
  (world ball-lst (fps 0 0)))

;; ball -> scene -> scene
(define (render-ball b scene)
  (define ball-img
    (circle (ball-size b) "solid" (ball-color b)))
  (place-image ball-img (pos-x b) (pos-y b) scene))

;;list::balls -> scene
(define (render-balls lst)
  (foldl render-ball ESCENE ball-lst))

(define (render-world w)
   (underlay/xy 
   (render-balls (world-balls w)) 0 0
   (text (number->string (fps-res (world-fps w))) 64 "Red")))

;; ball-> ball->bool 
(define (inside-circle? circle1 circle2)
     (let
         ([x (pos-x circle1)]
          [y (pos-y circle1)]
          [xobj (pos-x circle2)]
          [yobj (pos-y circle2)])
        (<= (distance-from-point x y xobj yobj)
               (+ (ball-size circle1) (ball-size circle2)))
       ))

(define (distance-from-point x1 y1 x2 y2)
    (sqrt(+ (sqr(- x2 x1)) (sqr(- y2 y1)))))

(define (check-collision ball)
    (map (lambda (x) (inside-circle?
                      ball x))
         ball-lst))

;;this is so unfuncitonal, copied straight off of examples from flash
(define (collide-balls lst)
  (for ([i lst])
    (set-ball-color! i "red")
     (for ([j lst])
    (cond
      [(eq? i j) void]
      [(inside-circle? i j)
       (collision-update! i j)
       (set-ball-color! i "green")])))
  lst)

;; ball -> ball
;; inner if statement for direction helps the ball not do stupid stuff
;; if it goes out of bounds completely by only reversing the direction once
(define (ball-move! obj)
  (define (change-dir! motion-set motion-get eq-test)
    (define dir (* FRICTION (motion-get obj)))
    (motion-set obj (if (eq-test 0 dir) (- dir) dir) ))

  ;;ball motion
  (define dy-vel (motion-dy obj))
  (set-pos-x! obj (+ (pos-x obj) (motion-dx obj)))
  (set-pos-y! obj (+ (pos-y obj) dy-vel))
;;  (set-motion-dy! obj (+ dy-vel GRAVITY)) ;; gravity

  ;;ball collision
  (let*
      ([size (ball-size obj)]
       [lbound (- (pos-x obj) size)]
       [rbound (+ (pos-x obj) size)]
       [ubound (- (pos-y obj) size)]
       [bbound (+ (pos-y obj) size)])

    (cond
      [(> 0 lbound)
       (change-dir! set-motion-dx! motion-dx >)
       obj]
      [(< WIDTH rbound)
       (change-dir! set-motion-dx! motion-dx <)
       obj]
      [(> 0 ubound) 
       (change-dir! set-motion-dy! motion-dy >)
       obj]
      [(< HEIGHT bbound)
       (change-dir! set-motion-dy! motion-dy <)
       obj]
      [else obj])))


;; ball -> ball -> void
;;ball to ball collision, grossly unfunctional 
(define (collision-update! ball1 ball2)
    (let*
        ((m1  (ball-size ball1))
         (m2  (ball-size ball2))
         (vx1 (motion-dx ball1))
         (vx2 (motion-dx ball2))
         (vy1 (motion-dy ball1))
         (vy2 (motion-dy ball2))

         (nvx1 (/ (+ (* vx1 (- m1 m2))
                 (* 2 m2 vx2))
                  (+ m1 m2)))
         (nvx2 (/ (+ (* vx2 (- m2 m1))
                 (* 2 m1 vx1))
                  (+ m1 m2)))
         (nvy1 (/ (+ (* vy1 (- m1 m2))
                 (* 2 m2 vy2))
                  (+ m1 m2)))
         (nvy2 (/ (+ (* vy2 (- m2 m1))
                     (* 2 m1 vy1))
                  (+ m1 m2))))

      (set-motion-dx! ball1 nvx1)
      (set-motion-dy! ball1 nvy1)
      (set-motion-dx! ball2 nvx2)
      (set-motion-dx! ball2 nvy2)

      (set-pos-x! ball1 (+ (pos-x ball1) nvx1))
      (set-pos-y! ball1 (+ (pos-y ball1) nvy1))
      (set-pos-x! ball2 (+ (pos-x ball2) nvx2))
      (set-pos-y! ball2 (+ (pos-y ball2) nvy2))))

;; calls all the actions
;; list::balls -> list::balls
(define (ball-tick w)
  (define cm (current-inexact-milliseconds))
  (world (collide-balls (map ball-move! (world-balls w)))
         (fps cm (exact-floor (/ 1000.0
                                 (- cm (fps-prev-time (world-fps w))))))))


(big-bang (make-world)
          (on-tick ball-tick)
          (to-draw render-world))

(module+ test
  (require rackunit)

;;circle collision tests
  (define b1 (ball 0 0 0 0 2 "red"))
  (define b2 (ball 2 3 0 0 3 "red"))
  (define b3 (ball 4 5 0 0 2 "green"))

  (check-equal? (inside-circle? b1 b2) #t)
  (check-equal? (inside-circle? b1 b3) #f)
  (check-equal? (inside-circle? b2 b3) #t)

)