; import relevant modules
(use-modules  ((sdl sdl) #:prefix SDL:)
              ((sdl gfx) #:prefix SDL:)
              (srfi srfi-1)
              (srfi srfi-2)
              (srfi srfi-9 gnu))

(define (rgba r g b a)
  (logior (ash r 24) (logior (ash g 16) (logior (ash b 8) a))))

(define (rgb r g b)
  (rgba r g b #xFF))

; constants
(define (do-nothing state) state) ; rather than keep declaring lambdas, use this when the state is not to be altered
(define bat-height 10)
(define bat-width 96)
(define ball-size 8)
(define bat-vel 1)
(define ball-vel 1)

; game state
(define-immutable-record-type <settings>
  (make-settings bat-y screen-width screen-height)
  settings?
  (bat-y          settings-bat-y)
  (screen-width    settings-screen-width)
  (screen-height  settings-screen-height))

(define-immutable-record-type <gamestate>
  (make-gamestate ball-x ball-y ball-vx ball-vy bat-x bat-vx inplay)
  gamestate?
  (ball-x    gamestate-ball-x  set-gamestate-ball-x)
  (ball-y    gamestate-ball-y  set-gamestate-ball-y)
  (ball-vx  gamestate-ball-vx  set-gamestate-ball-vx)
  (ball-vy  gamestate-ball-vy  set-gamestate-ball-vy)
  (bat-x    gamestate-bat-x    set-gamestate-bat-x)
  (bat-vx    gamestate-bat-vx  set-gamestate-bat-vx)
  (inplay    gamestate-inplay  set-gamestate-inplay))

; handle quit event
(define (handle-quit)
  (SDL:quit)
  (quit)
  )

(define (handle-keydown key)
  (display "keydown: ")
  (display key)
  (display "\n")
  (case key
    ((escape) (handle-quit))
    ((left) (lambda (state) (set-gamestate-bat-vx state (- (gamestate-bat-vx state) bat-vel))))
    ((right) (lambda (state) (set-gamestate-bat-vx state (+ (gamestate-bat-vx state) bat-vel))))
    (else do-nothing))
  )

(define (handle-keyup key)
  (display "keyup: ")
  (display key)
  (display "\n")
  (case key
    ((escape) (handle-quit))
    ((left) (lambda (state) (set-gamestate-bat-vx state (+ (gamestate-bat-vx state) bat-vel))))
    ((right) (lambda (state) (set-gamestate-bat-vx state (- (gamestate-bat-vx state) bat-vel))))
    (else do-nothing))
  )

; event handler
(define (handle-event)
  (let ((e (SDL:make-event)))
    (if (SDL:poll-event e)
      ; event happened
      (case (SDL:event:type e)
        ((quit) (handle-quit))
        ((key-down) (handle-keydown (SDL:event:key:keysym:sym e)))
        ((key-up) (handle-keyup (SDL:event:key:keysym:sym e)))
        (else do-nothing)
        )
      ; no event
      do-nothing)
      ))

; drawing
(define (render settings state)
  (let* ((screen (SDL:display-format (SDL:make-surface (settings-screen-width settings) (settings-screen-height settings))))
        (format (SDL:surface-get-format screen)))
    ; draw background
    (SDL:draw-rectangle screen 0 0 (settings-screen-width settings) (settings-screen-height settings) (rgb 0 0 0) #t)

    ; draw bat
    (let ((batx (gamestate-bat-x state) )
          (baty (settings-bat-y settings)))
      (SDL:draw-rectangle screen batx baty (+ batx bat-width) (+ baty bat-height) (rgb 255 255 255) #t))

    ; draw ball
    (let ((ballx (gamestate-ball-x state))
          (bally (gamestate-ball-y state)))
      (SDL:draw-rectangle screen ballx bally (+ ballx ball-size) (+ bally ball-size) (rgb 255 255 255) #t))

    ; copy this surface to the screen
    (SDL:blit-surface screen)
    (SDL:flip)
    )
  )

; update state
(define (update-state settings state)
  (let* ((ball-x (gamestate-ball-x state))
         (ball-y (gamestate-ball-y state))
         (ball-vx (gamestate-ball-vx state))
         (ball-vy (gamestate-ball-vy state))
         (bat-x (gamestate-bat-x state))
         (bat-vx (gamestate-bat-vx state))
         (moved-ball-x (+ ball-x ball-vx))
         (moved-ball-y (+ ball-y ball-vy))
         (moved-bat-x (+ bat-x bat-vx))
         (final-ball-vx (if (or (< moved-ball-x 0) (> (+ moved-ball-x ball-size) (settings-screen-width settings))) (* -1 ball-vx) ball-vx))
         (final-ball-vy (if (or (< moved-ball-y 0) (and (> (+ moved-ball-y ball-size) (settings-bat-y settings)) (and (> (+ ball-x ball-size) bat-x) (< ball-x (+ bat-x bat-width))))) (* -1 ball-vy) ball-vy))
         (final-bat-x (if (or (< moved-bat-x 0) (> (+ moved-bat-x bat-width) (settings-screen-width settings))) bat-x moved-bat-x))
         (final-ball-x (if (or (< moved-ball-x 0) (> (+ moved-ball-x ball-size) (settings-screen-width settings))) ball-x moved-ball-x))
         (final-ball-y (if (or (< moved-ball-y 0) (and (> (+ moved-ball-y ball-size) (settings-bat-y settings)) (and (> (+ ball-x ball-size) bat-x) (< ball-x (+ bat-x bat-width))))) ball-y moved-ball-y))
         )
      (make-gamestate final-ball-x
                      final-ball-y
                      final-ball-vx
                      final-ball-vy
                      final-bat-x
                      (gamestate-bat-vx state)
                      (gamestate-inplay state))
    ))

; main game loop
(define (main-loop settings state)
  ; draw to the screen
  (render settings state)
  ; update state based on events and pass new state back into the next iteration of the loop
  (main-loop settings (update-state settings ((handle-event) state)))
  )

; prepare sdl
(define (init width height bpp)
  ; set up video
  (SDL:init 'video)
  (SDL:set-video-mode width height bpp 'hw-surface)

  ; jump into game
  (let* ((bat-y (- height (/ height 5)))
         (ball-x (- (/ width 2) (/ ball-size 2)))
         (bat-x (- (/ width 2) (/ bat-width 2)))
         (ball-y (- bat-y ball-size)))
  (main-loop
    (make-settings bat-y width height)
    (make-gamestate ball-x ball-y -1 -1 bat-x 0 #f)))
  )

; entry point to program
(init 640 480 32)