(import scheme)
(import (chicken base))
(import (chicken format))
(import (chicken pathname))
(import (chicken process-context))
(import gtk-server)

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

(gtk "gtk_init" 'NULL 'NULL)
(gtk "gtk_server_define gtk_builder_new_from_file NONE WIDGET 1 STRING")
(gtk "gtk_server_define gtk_builder_get_object NONE WIDGET 2 WIDGET STRING")
(define widget #f)

;; Get GUI definition
(define ui-file (pathname-replace-extension (program-name) ".ui"))
(define xml (gtk "gtk_builder_new_from_file" ui-file))

;; Get main window ID and connect signal
(set! widget (gtk "gtk_builder_get_object" xml "window"))
(gtk "gtk_server_connect" widget "delete-event" "window")

;; Get button ID's and connect signals
(set! widget (gtk "gtk_builder_get_object" xml "button0"))
(gtk "gtk_server_connect" widget "clicked" "button0")
(set! widget (gtk "gtk_builder_get_object" xml "button1"))
(gtk "gtk_server_connect" widget "clicked" "button1")
(define button2 (gtk "gtk_builder_get_object" xml "button2"))
(gtk "gtk_server_connect" button2 "clicked" "button2")
(define button3 (gtk "gtk_builder_get_object" xml "button3"))
(gtk "gtk_server_connect" button3 "clicked" "button3")
(define button4 (gtk "gtk_builder_get_object" xml "button4"))
(gtk "gtk_server_connect" button4 "clicked" "button4")
(define button5 (gtk "gtk_builder_get_object" xml "button5"))
(gtk "gtk_server_connect" button5 "clicked" "button5")
(define button6 (gtk "gtk_builder_get_object" xml "button6"))
(gtk "gtk_server_connect" button6 "clicked" "button6")
(define button7 (gtk "gtk_builder_get_object" xml "button7"))
(gtk "gtk_server_connect" button7 "clicked" "button7")
(define button8 (gtk "gtk_builder_get_object" xml "button8"))
(gtk "gtk_server_connect" button8 "clicked" "button8")
(define button9 (gtk "gtk_builder_get_object" xml "button9"))
(gtk "gtk_server_connect" button9 "clicked" "button9")
(define buttonA (gtk "gtk_builder_get_object" xml "buttonA"))
(gtk "gtk_server_connect" buttonA "clicked" "buttonA")
(define buttonB (gtk "gtk_builder_get_object" xml "buttonB"))
(gtk "gtk_server_connect" buttonB "clicked" "buttonB")
(define buttonC (gtk "gtk_builder_get_object" xml "buttonC"))
(gtk "gtk_server_connect" buttonC "clicked" "buttonC")
(define buttonD (gtk "gtk_builder_get_object" xml "buttonD"))
(gtk "gtk_server_connect" buttonD "clicked" "buttonD")
(define buttonE (gtk "gtk_builder_get_object" xml "buttonE"))
(gtk "gtk_server_connect" buttonE "clicked" "buttonE")
(define buttonF (gtk "gtk_builder_get_object" xml "buttonF"))
(gtk "gtk_server_connect" buttonF "clicked" "buttonF")
;; Converter buttons
(set! widget (gtk "gtk_builder_get_object" xml "buttonHex"))
(gtk "gtk_server_connect" widget "clicked" "buttonHex")
(set! widget (gtk "gtk_builder_get_object" xml "buttonDec"))
(gtk "gtk_server_connect" widget "clicked" "buttonDec")
(set! widget (gtk "gtk_builder_get_object" xml "buttonClr"))
(gtk "gtk_server_connect" widget "clicked" "buttonClr")
(set! widget (gtk "gtk_builder_get_object" xml "buttonBin"))
(gtk "gtk_server_connect" widget "clicked" "buttonBin")
;; Get entry ID
(define entry (gtk "gtk_builder_get_object" xml "entry"))

;;; Init variables
(define mode 0)
(define number "0")

(gtk "gtk_widget_set_sensitive" buttonA 0)
(gtk "gtk_widget_set_sensitive" buttonB 0)
(gtk "gtk_widget_set_sensitive" buttonC 0)
(gtk "gtk_widget_set_sensitive" buttonD 0)
(gtk "gtk_widget_set_sensitive" buttonE 0)
(gtk "gtk_widget_set_sensitive" buttonF 0)

(gtk "gtk_entry_set_text" entry number)

;;; Functions

;; Define action when 0 1 2 3 4 5 6 7 8 9 is pressed; requires argument
(define (number-key arg)
  (set! number (gtk "gtk_entry_get_text" entry))
  (if (equal? number "0")
      (set! number arg)
      (set! number (string-append number arg)))
  (gtk "gtk_entry_set_text" entry number))

;; Mainloop
(let loop ()
  (let ((event (gtk "gtk_server_callback wait")))
    (when (not (equal? event "window"))
      (cond
       ((member event '("button0" "button1" "button2" "button3"
                        "button4" "button5" "button6" "button7"
                        "button8" "button9" "buttonA" "buttonB"
                        "buttonC" "buttonD" "buttonE" "buttonF"))
        (number-key (string (string-ref event 6))))
       ((equal? event "buttonClr")
        (gtk "gtk_entry_set_text" entry 0))
       ((equal? event "buttonBin")
        (when (memv mode '(0 1))
          (gtk "gtk_widget_set_sensitive" button2 0)
          (gtk "gtk_widget_set_sensitive" button3 0)
          (gtk "gtk_widget_set_sensitive" button4 0)
          (gtk "gtk_widget_set_sensitive" button5 0)
          (gtk "gtk_widget_set_sensitive" button6 0)
          (gtk "gtk_widget_set_sensitive" button7 0)
          (gtk "gtk_widget_set_sensitive" button8 0)
          (gtk "gtk_widget_set_sensitive" button9 0)
          (gtk "gtk_widget_set_sensitive" buttonA 0)
          (gtk "gtk_widget_set_sensitive" buttonB 0)
          (gtk "gtk_widget_set_sensitive" buttonC 0)
          (gtk "gtk_widget_set_sensitive" buttonD 0)
          (gtk "gtk_widget_set_sensitive" buttonE 0)
          (gtk "gtk_widget_set_sensitive" buttonF 0)
          (let ((input (gtk "gtk_entry_get_text" entry)))
            (when (not (equal? input "0"))
              (let* ((hex? (= mode 1))
                     (temp (string->number number (if hex? 16 10))))
                (set! number (format "~B" temp))
                (gtk "gtk_entry_set_text" entry number))))
          (set! mode 2)))
       ((equal? event "buttonHex")
        (when (memv mode '(0 2))
          (gtk "gtk_widget_set_sensitive" button2 1)
          (gtk "gtk_widget_set_sensitive" button3 1)
          (gtk "gtk_widget_set_sensitive" button4 1)
          (gtk "gtk_widget_set_sensitive" button5 1)
          (gtk "gtk_widget_set_sensitive" button6 1)
          (gtk "gtk_widget_set_sensitive" button7 1)
          (gtk "gtk_widget_set_sensitive" button8 1)
          (gtk "gtk_widget_set_sensitive" button9 1)
          (gtk "gtk_widget_set_sensitive" buttonA 1)
          (gtk "gtk_widget_set_sensitive" buttonB 1)
          (gtk "gtk_widget_set_sensitive" buttonC 1)
          (gtk "gtk_widget_set_sensitive" buttonD 1)
          (gtk "gtk_widget_set_sensitive" buttonE 1)
          (gtk "gtk_widget_set_sensitive" buttonF 1)
          (let ((input (gtk "gtk_entry_get_text" entry)))
            (when (not (equal? input "0"))
              (let* ((binary? (= mode 2))
                     (temp (string->number number (if binary? 2 10))))
                (set! number (format "~X" temp))
                (gtk "gtk_entry_set_text" entry number))))
          (set! mode 1)))
       ((equal? event "buttonDec")
        (when (memv mode '(1 2))
          (gtk "gtk_widget_set_sensitive" button2 1)
          (gtk "gtk_widget_set_sensitive" button3 1)
          (gtk "gtk_widget_set_sensitive" button4 1)
          (gtk "gtk_widget_set_sensitive" button5 1)
          (gtk "gtk_widget_set_sensitive" button6 1)
          (gtk "gtk_widget_set_sensitive" button7 1)
          (gtk "gtk_widget_set_sensitive" button8 1)
          (gtk "gtk_widget_set_sensitive" button9 1)
          (gtk "gtk_widget_set_sensitive" buttonA 0)
          (gtk "gtk_widget_set_sensitive" buttonB 0)
          (gtk "gtk_widget_set_sensitive" buttonC 0)
          (gtk "gtk_widget_set_sensitive" buttonD 0)
          (gtk "gtk_widget_set_sensitive" buttonE 0)
          (gtk "gtk_widget_set_sensitive" buttonF 0)
          (let* ((input (gtk "gtk_entry_get_text" entry))
                 (radix (cond
                         ((= mode 2) 2)
                         ((= mode 1) 16)
                         (else 10)))
                 (temp (string->number number radix)))
            (set! number (number->string temp))
            (gtk "gtk_entry_set_text" entry number))
          (set! mode 0))))
      (loop))))

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