(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken pathname))
(import (chicken string))
(import gtk-server)

(define gtk-server (start-gtk-server! args: '("log=/tmp/gtk-server.log")))
(define (gtk #!rest args) (apply gtk-send! gtk-server args))

;; Check availability of Poppler library first
(unless (equal? (gtk "gtk_server_require" "libpoppler-glib.so") "ok")
  (print "No poppler library found!")
  (gtk "gtk_server_exit")
  (stop-gtk-server! gtk-server)
  (exit 1))

;; Define GUI
(gtk "gtk_init" 'NULL 'NULL)
(define window (gtk "gtk_window_new" 0))
(gtk "gtk_window_set_title" window "'CHICKEN Scheme PDF Reader'")
(gtk "gtk_window_set_position" window 1)
;; Create widget to display image
(define image (gtk "gtk_image_new"))
(define cairo-s (gtk "cairo_image_surface_create" 'CAIRO_FORMAT_ARGB32 700 700))
(define cairo-cr (gtk "cairo_create" cairo-s))
;; White background
(gtk "cairo_set_source_rgba" cairo-cr 1 1 1 1)
(gtk "cairo_set_operator" cairo-cr 'CAIRO_OPERATOR_SOURCE)
(gtk "cairo_paint" cairo-cr)
;; Set the image
(gtk "gtk_image_set_from_surface" image cairo-s)
;; Flush all
(gtk "cairo_surface_flush" cairo-s)
(gtk "cairo_surface_destroy" cairo-s)
(gtk "cairo_destroy" cairo-cr)
;; Events
(define ebox (gtk "gtk_event_box_new"))
(gtk "gtk_container_add" ebox image)
(define sw (gtk "gtk_scrolled_window_new" 'NULL 'NULL))
(gtk "gtk_widget_set_size_request" sw 720 720)
(gtk "gtk_scrolled_window_set_policy" sw 1 1)
(gtk "gtk_scrolled_window_set_shadow_type" sw 1)
(gtk "gtk_scrolled_window_add_with_viewport" sw ebox)
;; Connect scroll event
(gtk "gtk_server_connect_after" ebox "scroll-event" "scroll-event" 1)
;; Separator
(define sep (gtk "gtk_hseparator_new"))
;; Open button
(define open (gtk "gtk_button_new_from_stock" 'gtk-open))
;; Spin button
(define combo (gtk "gtk_combo_box_text_new"))
(gtk "gtk_combo_box_text_append_text" combo "'zoom 1x'")
(gtk "gtk_combo_box_text_append_text" combo "'zoom 2x'")
(gtk "gtk_combo_box_text_append_text" combo "'zoom 3x'")
(gtk "gtk_combo_box_text_append_text" combo "'zoom 4x'")
(gtk "gtk_combo_box_text_append_text" combo "'zoom 5x'")
;; Page number
(define bw (gtk "gtk_button_new"))
(define bw-pic (gtk "gtk_image_new_from_stock" 'gtk-go-back 4))
(gtk "gtk_widget_set_size_request" bw 40 30)
(gtk "gtk_container_add" bw bw-pic)
(define frame (gtk "gtk_frame_new"))
(define nr 0)
(define label (gtk "gtk_label_new" "' 0 of 0 pages '"))
(gtk "gtk_container_add" frame label)
(define fw (gtk "gtk_button_new"))
(define fw-pic (gtk "gtk_image_new_from_stock" 'gtk-go-forward 4))
(gtk "gtk_widget_set_size_request" fw 40 30)
(gtk "gtk_container_add" fw fw-pic)
;; Exit button
(define exit (gtk "gtk_button_new_from_stock" 'gtk-quit))
;; Now arrange widgets on window using boxes
(define hbox (gtk "gtk_hbox_new" 0 0))
(gtk "gtk_box_pack_start" hbox open 0 0 1)
(gtk "gtk_box_pack_start" hbox combo 0 0 1)
(gtk "gtk_box_pack_start" hbox bw 0 0 1)
(gtk "gtk_box_pack_start" hbox frame 0 0 1)
(gtk "gtk_box_pack_start" hbox fw 0 0 1)
(gtk "gtk_box_pack_end" hbox exit 0 0 1)
(define vbox (gtk "gtk_vbox_new" 0 0))
(gtk "gtk_box_pack_start" vbox sw 1 1 1)
(gtk "gtk_box_pack_start" vbox sep 0 0 1)
(gtk "gtk_box_pack_end" vbox hbox 0 0 1)
(gtk "gtk_container_add" window vbox)
;; Create file open dialog
(define filedialog (gtk "gtk_window_new" 0))
(gtk "gtk_window_set_title" filedialog "'Open PDF file'")
(gtk "gtk_window_set_icon_name" filedialog "harddrive")
(gtk "gtk_window_set_transient_for" filedialog window)
(gtk "gtk_window_set_position" filedialog 4)
(gtk "gtk_window_set_default_size" filedialog 600 500)
(define selector (gtk "gtk_file_chooser_widget_new" 0))
(define filter (gtk "gtk_file_filter_new"))
(gtk "gtk_file_filter_set_name" filter "'PDF files (*.pdf)'")
(gtk "gtk_file_filter_add_pattern" filter "'*.pdf'")
(gtk "gtk_file_chooser_add_filter" selector filter)
(define okfile (gtk "gtk_button_new_from_stock" 'gtk-open))
(define canfile (gtk "gtk_button_new_from_stock" 'gtk-cancel))
;; Arrange widgets on window
(define vboxfile (gtk "gtk_vbox_new" 0 0))
(define hboxfile (gtk "gtk_hbox_new" 0 0))
(gtk "gtk_box_pack_end" hboxfile okfile 0 0 1)
(gtk "gtk_box_pack_end" hboxfile canfile 0 0 1)
(gtk "gtk_box_pack_start" vboxfile selector 1 1 1)
(gtk "gtk_box_pack_start" vboxfile hboxfile 0 0 1)
(gtk "gtk_container_add" filedialog vboxfile)
;; Redefine the g_object_get call
(gtk "gtk_server_redefine" "g_object_get NONE NONE 4 WIDGET STRING PTR_DOUBLE NULL")

;; Show all widgets
(gtk "gtk_widget_show_all" window)

;; Set default zoomlevel
(gtk "gtk_combo_box_set_active" combo 1)

(define file #f)
(define doc #f)
(define page #f)
(define size #f)
(define adj 0)
(define amount 0)
(define zoom 0)
(define x 0)
(define y 0)

(define (pdf-display)
  (let ((pnr (- nr 1)))
    ;; Get the page
    (set! page (gtk "poppler_document_get_page" doc pnr))
    ;; Get the size of the page
    (set! size (map string->number (string-split (gtk "poppler_page_get_size" page 0 0))))
    (set! x (car size))
    (set! y (cadr size))
    ;; Get zoom factor
    (set! zoom (string->number (gtk "gtk_combo_box_get_active" combo)))
    (set! zoom (+ zoom 1))
    ;; Render to cairo
    (let ((x (* x zoom))
          (y (* y zoom)))
      ;; New surface because of zoomlevel
      (set! cairo-s (gtk "cairo_image_surface_create" 'CAIRO_FORMAT_ARGB32 x y))
      (set! cairo-cr (gtk "cairo_create" cairo-s))
      ;; White background
      (gtk "cairo_set_source_rgba" cairo-cr 1 1 1 1)
      (gtk "cairo_set_operator" cairo-cr 'CAIRO_OPERATOR_SOURCE)
      (gtk "cairo_paint" cairo-cr)
      ;; Scale
      (gtk "cairo_scale" cairo-cr zoom zoom)
      (gtk "poppler_page_render" page cairo-cr)
      ;; Set the image
      (gtk "gtk_image_set_from_surface" image cairo-s)
      ;; Flush all
      (gtk "cairo_surface_flush" cairo-s)
      (gtk "cairo_surface_destroy" cairo-s)
      (gtk "cairo_destroy" cairo-cr))))

;; Mainloop
(let loop ()
  (let ((event (gtk "gtk_server_callback" "wait")))
    (when (not (member event (list exit window)))
      (cond
       ((equal? event open)
        (set! nr 1)
        (gtk "gtk_widget_show_all" filedialog))
       ((equal? event filedialog)
        (gtk "gtk_widget_hide" filedialog))
       ((equal? event okfile)
        (set! file (gtk "gtk_file_chooser_get_filename" selector))
        (gtk "gtk_widget_hide" filedialog)
        (set! doc (gtk "poppler_document_new_from_file" (format "'file://localhost~a'" file) 'NULL 'NULL))
        (when (and doc (not (equal? doc "0")))
          (pdf-display)
          ;; Scroll up
          (set! adj (gtk "gtk_scrolled_window_get_vadjustment" sw))
          (gtk "gtk_adjustment_set_value" adj 0)
          (set! amount (string->number (gtk "poppler_document_get_n_pages" doc)))
          (gtk "gtk_label_set_text" label (format "' ~a of ~a pages '" nr amount))
          (gtk "gtk_window_set_title" window (format "'CHICKEN Scheme PDF Reader - ~a'"
                                                     (pathname-strip-directory file)))))
       ((equal? event canfile)
        (gtk "gtk_widget_hide" filedialog))
       ((equal? event combo)
        (when (and doc (not (equal? doc "0")))
          (pdf-display)))
       ((equal? event bw)
        (when (and doc (not (equal? doc "0")))
          (set! amount (string->number (gtk "poppler_document_get_n_pages" doc)))
          (set! nr (- nr 1))
          (when (< nr 1)
            (set! nr amount))
          (gtk "gtk_label_set_text" label (format "' ~a of ~a pages '" nr amount))
          (pdf-display)
          ;; Scroll up
          (set! adj (gtk "gtk_scrolled_window_get_vadjustment" sw))
          (gtk "gtk_adjustment_set_value" adj 0)))
       ((equal? event fw)
        (when (and doc (not (equal? doc "0")))
          (set! amount (string->number (gtk "poppler_document_get_n_pages" doc)))
          (set! nr (+ nr 1))
          (when (> nr amount)
            (set! nr 1))
          (gtk "gtk_label_set_text" label (format "' ~a of ~a pages '" nr amount))
          (pdf-display)
          ;; Scroll up
          (set! adj (gtk "gtk_scrolled_window_get_vadjustment" sw))
          (gtk "gtk_adjustment_set_value" adj 0)))
       ((equal? event "scroll-event")
        (when (and doc (not (equal? doc "0")))
          (let* (;; First get current value of slider
                 (adj (gtk "gtk_scrolled_window_get_vadjustment" sw))
                 (val (string->number (gtk "gtk_adjustment_get_value" adj)))
                 ;; Now get current maximum possible value
                 (upper (string->number (gtk "g_object_get" adj "upper" 0 0)))
                 (psize (string->number (gtk "g_object_get" adj "page-size" 0 0)))
                 ;; Calculate limitation of Adjustment (see GTK doc)
                 (diff (- upper psize))
                 (mouse (gtk "gtk_server_mouse" 3)))
            (set! amount (number->string (gtk "poppler_document_get_n_pages" doc)))
            (cond
             ((equal? mouse "1")
              (when (> val diff)
                (set! nr (+ nr 1))
                (when (> nr amount)
                  (set! nr 1))
                (gtk "gtk_label_set_text" label (format "' ~a of ~a pages'" nr amount))
                (pdf-display)
                ;; Scroll up
                (gtk "gtk_adjustment_set_value" adj 0)))
             ((equal? mouse "0")
              (when (< val 0)
                (set! nr (- nr 1))
                (when (< nr 1)
                  (set! nr amount))
                (gtk "gtk_label_set_text" label (format "' ~a of ~a pages'" nr amount))
                (pdf-display)
                ;; Scroll down
                (gtk "gtk_adjustment_set_value" adj upper))))))))
      (loop))))

;; Exit GTK
(gtk "gtk_server_exit")
(stop-gtk-server! gtk-server)