; A test program for the Cairo bindings
; Michael Bridgen <address@hidden>
; Tony Garnock-Jones <address@hidden>

(use posix)
(use (prefix sdl2 sdl2:)
     miscmacros)
(use cairo)
(import chicken scheme foreign)

	
;; From:	address@hidden
;;
(define (sdl-colorspace->cairo bytes-per-pixel)
  (case (* 8 bytes-per-pixel)
    ((8) CAIRO_FORMAT_A8)
    ((24) CAIRO_FORMAT_RGB24)
    ((32) CAIRO_FORMAT_ARGB32)
    (else CAIRO_FORMAT_ARGB32)))

(define (create-sdl2-cairo-context window)
  (let*-values
    (((width height) (sdl2:window-size window))
     ((window-surface) (sdl2:window-surface window))
     ((cairo-surface)
      (cairo-image-surface-create-for-data
        (sdl2:surface-pixels-raw window-surface)
        (sdl-colorspace->cairo
          (sdl2:pixel-format-bytes-per-pixel (sdl2:surface-format window-surface)))
        width
        height
        (sdl2:surface-pitch window-surface))))
    (cairo-create cairo-surface)))

;;; Draw (or redraw) the entire scene. It would be more efficient to
;;; only redraw the parts of the scene that have changed, but since
;;; this is just a demo program we don't want to get too complex.
(define (draw-scene!)
  (let ((window-surf (sdl2:window-surface window)))
    ;; Clear the whole screen using a blue background color
    (sdl2:fill-rect! window-surf #f (sdl2:make-color 0 80 160))
    ;; Draw the smileys
    ;; (draw-obj! smiley2 window-surf)
    ;; (draw-obj! smiley1 window-surf)
    ;; Refresh the screen
    (sdl2:update-window-surface! window)))




#;(sdl-init SDL_INIT_EVERYTHING)

(define maxx 640)
(define maxy 480)

;;; Initialize the parts of SDL that we need.
(sdl2:set-main-ready!)
(sdl2:init! '(video events joystick))

;; Automatically call sdl2:quit! when program exits normally.
(on-exit sdl2:quit!)

;; Call sdl2:quit! and then call the original exception handler if an
;; unhandled exception reaches the top level.
(current-exception-handler
 (let ((original-handler (current-exception-handler)))
   (lambda (exception)
     (sdl2:quit!)
     (original-handler exception))))


(printf "Compiled with SDL version ~A~N" (sdl2:compiled-version))
(printf "Running with SDL version ~A~N" (sdl2:current-version))
(printf "Using sdl2 egg version ~A~N" (sdl2:egg-version))

;;; Create a new window.
(define window
  (sdl2:create-window!
   "SDL Basics"                         ; title
   'centered  100                       ; x, y
   800  600                             ; w, h
   '(shown resizable)))                 ; flags

;;; Restrict the window from being made too small or too big, for no
;;; reason except to demonstrate this feature.
(set! (sdl2:window-maximum-size window) '(1024 768))
(set! (sdl2:window-minimum-size window) '(200 200))

(printf "Window position: ~A, size: ~A, max size: ~A, min size: ~A~N"
        (receive (sdl2:window-position window))
        (receive (sdl2:window-size window))
        (receive (sdl2:window-maximum-size window))
        (receive (sdl2:window-minimum-size window)))

(define c (create-sdl2-cairo-context window)) ;; (cairo-create is))

(cairo-set-source-rgba c 1 1 0 1)

(cairo-set-line-width c 20)

(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_BUTT)
(cairo-move-to c 10 10)
(cairo-line-to c 10 80)

(cairo-stroke c)

(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_ROUND)
(cairo-move-to c 50 10)
(cairo-line-to c 50 80)
(cairo-stroke c)

(cairo-new-path c)
(cairo-set-line-cap c CAIRO_LINE_CAP_SQUARE)
(cairo-move-to c 90 10)
(cairo-line-to c 90 80)
(cairo-stroke c)

(cairo-set-line-join c CAIRO_LINE_JOIN_BEVEL)
(define (tri)
  (cairo-new-path c)
  (cairo-move-to c 110 110)
  (cairo-line-to c 110 190)
  (cairo-line-to c 190 190)
  (cairo-close-path c))

(cairo-set-line-width c 10)
(tri)
(cairo-set-source-rgb c 0 1 1)
(cairo-stroke c)
(tri)
(cairo-set-source-rgb c 1 0 1)
(cairo-fill c)

(define (radians degrees)
  (* 3.142 (/ degrees 180)))

(define (sector x y d)
  (cairo-new-path c)
  (cairo-move-to c x y)
  (cairo-line-to c (+ x d) y)
  (cairo-line-to c (+ x d) (+ y d))
  (cairo-arc c (+ x d) y d (radians 90) (radians 180)))

(sector 240 240 60)
(cairo-set-line-join c CAIRO_LINE_JOIN_MITER)
(cairo-set-source-rgb c 1 0.5 0)
(cairo-stroke c)

(cairo-reset-clip c)
(cairo-new-path c)
(cairo-rectangle c 30 240 70 300)
(cairo-clip c)
(cairo-new-path c)
(sector 20 250 100)
(cairo-set-source-rgb c 0 0.5 1)
(cairo-fill c)

(cairo-reset-clip c)
(sector 20 250 100)
(cairo-set-source-rgba c 0 0.5 1 0.3)
(cairo-fill c)

(cairo-select-font-face c "sans-serif" CAIRO_FONT_SLANT_NORMAL CAIRO_FONT_WEIGHT_NORMAL)
(cairo-set-font-size c 30)

(cairo-move-to c 300 100)
(cairo-set-source-rgba c 1 1 1 1)
(cairo-show-text c "Chicken Cairo")

(let ((ext (make-cairo-text-extents-type)))
  (cairo-text-extents c "Chicken Cairo" ext)
;  (display ext)(newline)
  (cairo-new-path c)
  (cairo-rectangle c 300 100 (cairo-text-extents-width ext) (- (cairo-text-extents-height ext)))
  (cairo-set-source-rgba c 1 1 1 0.5)
  (cairo-set-line-width c 2.0)
  (cairo-stroke c))

;; (sdl2:flip-surface window #t #t)
(sdl2:update-window-surface! window)

#;(let ((done #f)
      (verbose? #f))
  (while (not done)
    (let ((ev (sdl2:wait-event!)))

      (when verbose?
        (print ev))

      (case (sdl2:event-type ev)
        ;; Window exposed, resized, etc.
        ((window)
         (draw-scene!))

        ;; User requested app quit (e.g. clicked the close button).
        ((quit)
         (set! done #t))

        ;; Joystick added (plugged in)
        ((joy-device-added)
         ;; Open the joystick so we start receiving events for it.
         (sdl2:joystick-open! (sdl2:joy-device-event-which ev)))

        ;; Mouse button pressed
        ((mouse-button-down)
         ;; Move smiley1 to the mouse position.
         (set! (obj-x smiley1) (sdl2:mouse-button-event-x ev))
         (set! (obj-y smiley1) (sdl2:mouse-button-event-y ev))
         (draw-scene!))

        ;; Mouse cursor moved
        ((mouse-motion)
         ;; If any button is being held, move smiley1 to the cursor.
         ;; This way it seems like you are dragging it around.
         (when (not (null? (sdl2:mouse-motion-event-state ev)))
           (set! (obj-x smiley1) (sdl2:mouse-motion-event-x ev))
           (set! (obj-y smiley1) (sdl2:mouse-motion-event-y ev))
           (draw-scene!)))

        ;; Keyboard key pressed.
        ((key-down)
         (case (sdl2:keyboard-event-sym ev)
           ;; Escape or Q quits the program
           ((escape q)
            (set! done #t))

           ;; V toggles verbose printing of events
           ((v)
            (if verbose?
                (begin
                  (print "Verbose OFF (events will not be printed)")
                  (set! verbose? #f))
                (begin
                  (print "Verbose ON (events will be printed)")
                  (set! verbose? #t))))

           ;; Space bar randomizes smiley colors
           ((space)
            (randomize-smiley! smiley1)
            (randomize-smiley! smiley2)
            (draw-scene!))

           ;; Arrow keys control smiley2
           ((left)
            (dec! (obj-x smiley2) 20)
            (draw-scene!))
           ((right)
            (inc! (obj-x smiley2) 20)
            (draw-scene!))
           ((up)
            (dec! (obj-y smiley2) 20)
            (draw-scene!))
           ((down)
            (inc! (obj-y smiley2) 20)
            (draw-scene!))))))))

(let ((event (sdl2:make-event)))
  (let loop ((count 0))
    (sdl2:wait-event! event)
    (print "Got here!")
    (let ((t (sdl2:event-type event)))
      (print "Got here! Event=" t)
      (if (or (sdl2:quit-event? t)
	      (> count 100))
	  (print "Got 100 events, I'm bored. Quiting.")
	  (loop (+ count 1))))))

(exit 0)