(import scheme)
(import (chicken base))
(import gtk-server)

;; Define some constants
(define first-col 0)
(define second-col 1)

;; Start GTK-server
(define gtk-server (start-gtk-server!))
(define (gtk #!rest args) (apply gtk-send! gtk-server args))

;; Initialize GTK
(gtk "gtk_init" 'NULL 'NULL)

;; Define main window and some attributes
(define window (gtk "gtk_window_new" 'GTK_WINDOW_TOPLEVEL))
(gtk "gtk_window_set_title" window "'Floats in lists'")
(gtk "gtk_window_set_resizable" window 0)
(gtk "gtk_window_set_icon_name" window "gtk-info")
(gtk "gtk_widget_set_size_request" window 200 200)

;; Create a model
(define view (gtk "gtk_tree_view_new"))
(gtk "gtk_tree_view_set_headers_clickable" view 1)
(gtk "gtk_tree_view_set_grid_lines" view 3)

;; Create columns
(define column1 (gtk "gtk_tree_view_column_new"))
(gtk "gtk_tree_view_column_set_title" column1 "Column1")
(gtk "gtk_tree_view_append_column" view column1)
(gtk "gtk_tree_view_column_set_resizable" column1 1)
(gtk "gtk_tree_view_column_set_clickable" column1 1)

(define column2 (gtk "gtk_tree_view_column_new"))
(gtk "gtk_tree_view_column_set_title" column2 "Column2")
(gtk "gtk_tree_view_append_column" view column2)
(gtk "gtk_tree_view_column_set_resizable" column2 1)
(gtk "gtk_tree_view_column_set_clickable" column2 1)

;; Create renderers to show contents
(define renderer1 (gtk "gtk_cell_renderer_text_new"))
(gtk "gtk_tree_view_column_pack_start" column1 renderer1 1)
(define renderer2 (gtk "gtk_cell_renderer_text_new"))
(gtk "gtk_tree_view_column_pack_start" column2 renderer2 1)

;; Define the store where the actual data is kept
(gtk "gtk_server_redefine gtk_list_store_new NONE WIDGET 3 INT INT INT")
(define lst (gtk "gtk_list_store_new 2 G_TYPE_DOUBLE G_TYPE_DOUBLE"))

;; Fill store with some data
(define iter (gtk "gtk_server_opaque"))
(gtk "gtk_server_redefine gtk_list_store_set NONE NONE 5 WIDGET WIDGET INT DOUBLE INT")
(gtk "gtk_list_store_append" lst iter)
(gtk "gtk_list_store_set" lst iter first-col 1.23456 -1)
(gtk "gtk_list_store_set" lst iter second-col 9.87654 -1)
(gtk "gtk_list_store_append" lst iter)
(gtk "gtk_list_store_set" lst iter first-col 5.43210 -1)
(gtk "gtk_list_store_set" lst iter second-col 4.56789 -1)
(gtk "gtk_list_store_append" lst iter)
(gtk "gtk_list_store_set" lst iter first-col 10.13578 -1)
(gtk "gtk_list_store_set" lst iter second-col 1.010101 -1)

;; Attach store to model
(gtk "gtk_tree_view_set_model" view lst)

;; Make sure all memory is released when the model is destroyed
(gtk "g_object_unref" lst)

;; Set the mode of the view
(define sel (gtk "gtk_tree_view_get_selection" view))
(gtk "gtk_tree_selection_set_mode" sel 'GTK_SELECTION_SINGLE)

;; Define a scrolled window
(define sw (gtk "gtk_scrolled_window_new" 'NULL 'NULL))
(gtk "gtk_scrolled_window_set_policy" sw 1 1)
(gtk "gtk_scrolled_window_set_shadow_type" sw 1)
(gtk "gtk_container_add" sw view)

;; Now register a 'userfunction' for both columns - using different
;; macros with different column number
(gtk "gtk_server_define gtk_tree_view_column_set_cell_data_func NONE NONE 5 WIDGET WIDGET MACRO DATA NULL")
(gtk "gtk_tree_view_column_set_cell_data_func" column1 renderer1 "GtkTreeCellDataFunc_1" first-col 'NULL)
(gtk "gtk_tree_view_column_set_cell_data_func" column2 renderer2 "GtkTreeCellDataFunc_2" second-col 'NULL)

;; Finish gui
(gtk "gtk_container_add" window sw)
(gtk "gtk_widget_show_all" window)

;; Set ordering variable
(define order-first 0)
(define order-second 1)

;; Mainloop
(let loop ()
  (let ((event (gtk "gtk_server_callback wait")))
    (print event)
    (when (not (equal? event window))
      (cond
       ((equal? event column1)
        (set! order-first (if (= order-first 1) 0 1))
        (set! order-second (if (= order-second 1) 0 1))
        (gtk "gtk_tree_sortable_set_sort_column_id" lst first-col order-first))
       ((equal? event column2)
        (set! order-first (if (= order-first 1) 0 1))
        (set! order-second (if (= order-second 1) 0 1))
        (gtk "gtk_tree_sortable_set_sort_column_id" lst second-col order-second)))
      (loop))))

(gtk "gtk_server_exit")
(stop-gtk-server! gtk-server)