(use doodle sdl-base lazy-seq fps fps-cairo matchable clojurian-syntax)

(include "doodle-utils")

(define next-event
  (let ((ev (make-sdl-event)))
    (lambda ()
      (if (sdl-poll-event! ev)
        (translate-events ev)
        '(none)))))

(define (time-stream)
  (define last (sdl-get-ticks))
  (lazy-seq (cons 0
                  (lazy-repeatedly
                    (lambda ()
                      (let* ((now (sdl-get-ticks))
                             (dt (/ (- now last) 1000)))
                        (set! last now)
                        dt))))))

(define (make-clock time)
  (lazy-reductions + 0 time))

(define (event-stream)
  (lazy-repeatedly next-event))

(define (timing-event? e)
  (eq? (car e) 'timing))


(define (lazy-reductions kons knil . streams)
  (letrec ((s (lazy-seq
                (cons knil
                      (apply lazy-map kons s streams)))))
    s))

(define (scale-stream factor stream)
  (lazy-map
    (cut * factor <>)
    stream))

(define (scale-pt-stream factors points)
  (lazy-map
    (lambda (f p)
      (scale-pt f f p))
    factors points))

; Logic

(define (movement-keys events)
  (lazy-reductions
    (lambda (previous event)
      (add-pts
        previous
        (match event
          ((or ('key 'pressed 'up)
               ('key 'released 'down))  (pt 0 -1))
          ((or ('key 'pressed 'down)
               ('key 'released 'up))  (pt 0 1))
          ((or ('key 'pressed 'left)
               ('key 'released 'right))  (pt -1 0))
          ((or ('key 'pressed 'right)
               ('key 'released 'left))  (pt 1 0))
          (else  origin))))
    origin events))

(define (square-position dts keys-status)
  (lazy-reductions
    add-pts
    origin
    (scale-pt-stream (scale-stream 10 dts) keys-status)))

(define (sin-oscilator amplitude freq time)
  (lazy-map
    (lambda (t) (* amplitude (sin (* freq t 2pi))))
    (make-clock time)))

(define (cos-oscilator amplitude freq time)
  (lazy-map
    (lambda (t) (* amplitude (cos (* freq t 2pi))))
    (make-clock time)))

(define (wiggle picture time)
  (lazy-map
    (lambda (x y)
      (translate (+ x (/ doodle-width 2)) (+ y (/ doodle-height 2))
        picture))
    (sin-oscilator 100 0.5 time)
    (cos-oscilator 100 0.5 time)))


; Rendering

(new-doodle width: 320 height: 240)

(define chan (cairo-channel (doodle-context)))

(define (square position-stream)
  (lazy-map
    (lambda (pos)
      (begin
        (print pos)
        (fill (rect pos 10 10) (:color (rgb 1 0 0)))))
    position-stream))

(define clear
  (fill (rect origin doodle-width doodle-height) (:color (rgb 0 0 0))))

(define (render pict)
  (show chan (compose clear pict))
  (show!)
  (gc))


(->>
  (time-stream)
  (wiggle (fill (arc origin 10 0 2pi) (:color (rgb 0 1 0))))
  (lazy-each render)
  )