chickmunk->doodle


;; here's a quick hack to draw chipmunk shapes with doodle primitives:

(use doodle chickmunk parley )

;; hacky trickery to get the inferior scheme terminal
;; to behave properly
(parley "")
(let ((old (current-input-port)))
     (current-input-port (make-parley-port old)))

(new-doodle)

(define space (nodes->space
               `(space
                 ((gravity (0 9.8)))
                 (body ()
                       (box (vertices ((-13 -13)
                                       (-13 -1)
                                       (-1 -13)))))
                 (body ()
                       (circle (radius 10)
                               (offset (0 0))))
                 (body ((pos (0 -40)))
                       (circle (radius 10)
                               (offset (0 0))
                               (elasticity .1)))
                 (body ((static 1))
                       (segment (endpoints ((-100 40)
                                           ( 100 80)))))
                 (body ((static 1))
                       (segment (endpoints ((100 80)
                                           ( 200 00))))))))

;; (define (p . a) (apply print a) (last a))
(define (p . a) (last a))


(define (scale point)
  #|(if (list? point)
      (map (cut * 2 <>) point)
      (* 2 point))|#
  point)

(begin
  (define (translate point . points)
    (define (t p)
      (list (+ (car p) 200)
            (+ (cadr p) 100)))

    (if (null? points)
        (t point)
        (let loop ([res '()]
                   [points (cons point points)])
          (if (null? points)
              (reverse res)
              (begin
                (loop (cons (t (car points)) res)
                      (cdr points)))))))

  (translate '(1 3) '(0 0) '(-100 -100))
  (translate '(2 3)))


(define trasc (compose translate scale))

(begin
  (space-step space (/ 1 60))
  (clear-screen)
  
  (define (draw-shape shape)

    ;; poslist is '((x1 y1) (x2 y2) [...])
    (define (draw-segment poslist)
      (let ([p1 (car poslist)]
            [p2 (cadr poslist)])
        (draw-line (car p1) (cadr p1)
                   (car p2) (cadr p2))))
    
    (case (shape-get-type shape)
      ((circle)
       (define shape-pos 
         (trasc (vect->list (vadd (body-get-pos (shape-get-body shape))
                                  (circle-shape-get-offset shape)))))
       (define x (car shape-pos))
       (define y (cadr shape-pos))
       (circle (p "x " x) (p "y " y)
               (p "rad= " (fp* 2.0 (scale (circle-shape-get-radius shape)))) '(1 1 1 1)))
      ((poly)
       (let ([poslist (poly-shape-get-vertices shape)]
             [addbody (lambda (pos) (vect->list
                                (body-local2world (shape-get-body shape)
                                                  (apply v pos))))])
         (let loop ([pos (map (compose trasc addbody)
                              (cons (last poslist) poslist))])
           (if (null? (cdr pos))
               #f
               (begin
                 (draw-segment pos)
                 (loop (cdr pos)))))))
      ((segment) (draw-segment (apply translate (segment-shape-get-endpoints shape))))
      (else (print "unknown type " (shape-get-type shape)))))
  
  (for-each draw-shape (space-shapes space))
  (show!))

(vect->list (body-local2world body (v 1 0)))

(define body (car (space-bodies space)))

(font-color '(1 0 1 1))
(font-size 10)

(world-changes
 (lambda (events dt quit)
   (thread-sleep! 0.005)

   (clear-screen)
;;   (text 0 10 (conc "dt: " (/ 1 (if (= 0 dt) 1 dt))))

   (space-step space (/ 1 120))

   (for-each draw-shape (body-shapes (space-get-static-body space)))
   (for-each draw-shape (space-shapes space))))


(run-event-loop run-in-background: #t )