Welcome to the CHICKEN Scheme pasting service

(module sail *
        (import scheme chicken)
        (use sdl
             miscmacros
             coops
             coops-primitive-objects
             rigid-body
             fin
;;             boat
             (rename boat (fin boat:fin))
             drawable
             vector2
             srfi-18)

(define *screen-width* 800)
(define *screen-height* 800)

(define boat-coordinates
  (map (lambda (elx ely)
         (make <vector2> 'x elx 'y ely))
       (list  0.9  0.5  0.0 -0.5 -0.9 -0.9
             -0.9 -0.9 -0.5  0.0  0.5  0.9)
       (list  0.0  0.2  0.4  0.4  0.2  0.0
              0.0 -0.2 -0.4 -0.4 -0.2  0.0)))

(define (transform-coords! coords)
  (for-each (lambda (v)
              (vector2-scale! v (v2 50 40)))
            coords)
  ;; (for-each (lambda (v)
  ;;             (vector2-+! v (make <vector2> 'x 50 'y 50)))
  ;;           coords)
  ;; (for-each (lambda (v)
  ;;             (set! (x v) (flonum->fixnum (x v)))
  ;;             (set! (y v) (flonum->fixnum (y v))))
  ;;           coords)
  )

(transform-coords! boat-coordinates)

(define (ms->s ms)
  (/ ms 10e2))

(define (run-game)
  (let ((screen (sdl-set-video-mode *screen-width* *screen-height*
                                   0
                                   (+ SDL_HWSURFACE
                                      SDL_HWPALETTE
                                      SDL_DOUBLEBUF)))
        (running #t)
        (event (make-sdl-event))
        (fin (make <fin>
               'position-relative (v2 -50 0)
               'orientation-relative 0
               'debug #t))
        (boat (make <boat>
                'position-relative (v2 (/ *screen-width* 2) (/ *screen-height* 2))
                'shape boat-coordinates
                'orientation-relative 0
                'debug #t))
        (angle 0)
        (t0 (current-milliseconds))
        (t-last (- (current-milliseconds) 1))
        (t 0)
        (dt 333)
        (fps 30))

;;    (push-child! boat fin)
    (add-fin! boat fin)
    (set! (linear-velocity boat) (v2 0 0))
    
    (let loop ()
      (if (sdl-poll-event! event)
          (cond 
           ((= (sdl-event-type event) SDL_QUIT)
            (set! running #f))
           ((= (sdl-event-type event) SDL_KEYDOWN)
            (let* ((i (sdl-event-sym event))
                   (c (integer->char i)))
              (case i
                ((273)
                 (set! acceleration (v2 10 0)))
                ((274)
                 (set! acceleration (v2 -10 0)))
                ((275)
                 (rotate! (fin boat) 0.1)
                 (set! angular-acceleration 1))
                ((276)
                 (set! angular-acceleration -1))
)))
           ((= (sdl-event-type event) SDL_KEYUP)
            (set! acceleration (v2 0 0))
            (set! angular-acceleration 0))))

      ;; Time
      (set! t (- (current-milliseconds) t0))
      (set! dt (- t t-last))
      (set! t-last t)
      (set! fps (/ 1 (ms->s dt)))

      ;; Some test animation
      ;; (set! (orientation-relative boat) angle)
      ;; (set! (orientation-relative fin) (sin (* 10 angle)))

      (set! angle (+ angle 0.005))

      ;; Draw background
      (sdl-fill-rect screen #f (make-sdl-color 0 0 0))

      ;; Update physics
      (update-kinematics! boat (ms->s t) 0.033)
  
      ;; Update graphics
      (draw! boat screen)
      
      ;; Draw
      (sdl-flip screen)
      
      ;; Slow down
      (thread-sleep! 0.023)

      (if running (loop)))
    (sdl-quit)))

(run-game)

)