我正在尝试创建一个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）我如何将球的弹跳限制在一个明确的窗口（也就是如何确保球不会从定义的窗口弹回）
任何可以启动我的努力的想法？ :)提前致谢！
答案 0 :(得分：0)
我正在尝试一段时间试图让球以功能性方式反弹。我没有到达那里，但我确实通过复制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)
)