;; The first three lines of this file were inserted by DrScheme. They record metadata
;; about the language level of this file in a form that our tools can easily process.
#reader(lib "htdp-advanced-reader.ss" "lang")((modname ball-world) (read-case-sensitive #t) (teachpacks ((lib "world.ss" "teachpack" "htdp"))) (htdp-settings #(#t constructor repeating-decimal #t #t none #f ((lib "world.ss" "teachpack" "htdp")))))
(define WORLD-WIDTH 600)
(define WORLD-HEIGHT 200)
(define BALL-RADIUS 30)
(define DRAG (exact->inexact 0.01))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; Ball functions:


; A ball is:
;   (make-ball number number number number symbol)
; where xpos,ypos are the x- and y-coordinates,
; and xvel,yvel are the ball' velocity components.
;
(define-struct ball (xpos ypos xvel yvel color))



; move-ball: ball -> ball
; Update the ball's position by its velocity,
; wrapping around the screen,
; and applying some friction (DRAG) to the velocity.
;
(define (move-ball b)
  (make-ball (my-modulo (+ (ball-xpos b) (ball-xvel b)) WORLD-WIDTH)
             (my-modulo (+ (ball-ypos b) (ball-yvel b)) WORLD-HEIGHT)
             (* (ball-xvel b) (- 1 DRAG))
             (* (ball-yvel b) (- 1 DRAG))
             (ball-color b)))

 

; nudge-ball : ball number number -> ball
; Change the ball's velocity (that is, accelerate it).
; 
(define (nudge-ball b xaccel yaccel)
  (make-ball (ball-xpos b)
             (ball-ypos b)
             (+ (ball-xvel b) xaccel)
             (+ (ball-yvel b) yaccel)
             (ball-color b)))


; randomize-ball: ball -> ball
; Return a ball with a random position and color
;  (but the same velocity as the given ball)
;
(define (randomize-ball b)
  (make-ball (random WORLD-WIDTH)
             (random WORLD-HEIGHT)
             (ball-xvel b)
             (ball-yvel b)
             (random-from (list 'red 'orange 'yellow 'green 'blue 'indigo 'violet
                                'black 'purple 'pink 'brown 'gold 'white ))))



; draw-ball: ball scene -> scene
;
(define (draw-ball a-ball a-scene)
  (place-image (star 20 BALL-RADIUS (* 0.8 BALL-RADIUS) 'solid (ball-color a-ball))
               (ball-xpos a-ball)
               (ball-ypos a-ball)
               a-scene))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; World functions

; A world is
;   (make-world ball ball)
;
(define-struct world (b1 b2))

; move-the-world: world -> world
; Given a world, return a new world one 'tick' later
; where everything has moved.
;
(define (move-the-world a-world)
  (make-world (move-ball (world-b1 a-world))
              (move-ball (world-b2 a-world))))

; draw-world: world -> scene
;
(define (draw-world a-world)
  (draw-ball (world-b1 a-world)
             (draw-ball (world-b2 a-world)
                        (empty-scene WORLD-WIDTH WORLD-HEIGHT))))


; handle-keypress: world key -> world
; Update the world, according to what key was pressed.
;
; Note that a 'key' is either a symbol (like 'left)
; or a character (like #\a or #\b or #\space).
;
(define (handle-keypress a-world a-key)
  (cond [(key=? a-key 'left) 
         (make-world (nudge-ball (world-b1 a-world) -1 0)
                     (world-b2 a-world))]
        [(key=? a-key 'right) 
         (make-world (nudge-ball (world-b1 a-world) +1 0)
                     (world-b2 a-world))]
        [(key=? a-key 'up) 
         (make-world (nudge-ball (world-b1 a-world) 0 -1)
                     (world-b2 a-world))]
        [(key=? a-key 'down) 
         (make-world (nudge-ball (world-b1 a-world) 0 +1)
                     (world-b2 a-world))]
        [(key=? a-key #\space)
         (make-world (randomize-ball (world-b1 a-world))
                     (world-b2 a-world))]
        ; Keys for ball-2:
        [(key=? a-key #\a)
         (make-world (world-b1 a-world)
                     (nudge-ball (world-b2 a-world) -1 0))]        
        [(key=? a-key #\d)
         (make-world (world-b1 a-world)
                     (nudge-ball (world-b2 a-world) +1 0))]
        [(key=? a-key #\s)
         (make-world (world-b1 a-world)
                     (nudge-ball (world-b2 a-world) 0 +1))]
        [(key=? a-key #\w)
         (make-world (world-b1 a-world)
                     (nudge-ball (world-b2 a-world) 0 -1))]
        [(key=? a-key #\tab)
         (make-world (world-b1 a-world)
                     (randomize-ball (world-b2 a-world)))]
        
        ; Default: do nothing (ie, return the same world):
        [else a-world]))



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Utility functions


; random-from: (list-of ANY) -> ANY
; Choose a random element from the list.
; 
(define (random-from data)
  (list-ref data (random (length data))))
  ; If 'list-ref' weren't built-in, we could
  ; write it ourselves, using the list-template.
  ; (This is a good self-check exercise.)


; my-modulo: number number -> number
; Like the built-in modulo, except it works with all numbers,
; not just integers.
;
; (This is only needed because we have fractional positions,
;  since we have fractional velocities, since we have slight friction.)
;
(define (my-modulo m n)
  (* (- (/ m n) (floor (/ m n))) n))
 

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; Finally, set up the event handlers (callbacks):
;
(define initial-ball (make-ball 0 0 0 0 'red))

(big-bang WORLD-WIDTH WORLD-HEIGHT 1/60 (make-world initial-ball (randomize-ball initial-ball)))
(on-redraw draw-world)
(on-key-event handle-keypress)
(on-tick-event move-the-world)