48 lines
1.5 KiB
Scheme
48 lines
1.5 KiB
Scheme
(import (scheme base)
|
|
(scheme write)
|
|
(scheme process-context)
|
|
(retropikzel system)
|
|
(retropikzel named-pipes)
|
|
(retropikzel gtk-server))
|
|
|
|
(gtk-server-start "/tmp/scheme-gtkserver.log")
|
|
|
|
(define gtk-server-version (gtk "gtk_server_version"))
|
|
(display gtk-server-version)
|
|
(newline)
|
|
|
|
(gtk "gtk_init NULL NULL")
|
|
(define window (gtk "gtk_window_new 0"))
|
|
(gtk (string-append "gtk_window_set_title " window " 'Scheme gtk-server test'"))
|
|
(gtk (string-append "gtk_window_set_default_size " window " 400 200"))
|
|
(gtk (string-append "gtk_window_set_position " window " 1"))
|
|
|
|
(define button (gtk "gtk_button_new_with_label 'Click to Quit'"))
|
|
|
|
(define table (gtk "gtk_table_new 10 10 1"))
|
|
(gtk (string-append "gtk_table_attach_defaults " table " " button " 5 9 7 9"))
|
|
|
|
(define entry (gtk "gtk_entry_new"))
|
|
(gtk (string-append "gtk_table_attach_defaults " table " " entry " 1 6 3 4"))
|
|
(gtk (string-append "gtk_container_add " window " " table))
|
|
|
|
|
|
(gtk (string-append "gtk_widget_show_all " window))
|
|
|
|
(define (main event)
|
|
(when (not (string=? event "0"))
|
|
(display "Event: ")
|
|
(display event)
|
|
(newline)
|
|
(when (string=? entry event)
|
|
(display "You wrote: ")
|
|
(display (gtk (string-append "gtk_entry_get_text " entry)))
|
|
(newline))
|
|
(when (string=? button event) (exit 0)))
|
|
(gtk "gtk_main_iteration")
|
|
(main (gtk "gtk_server_callback WAIT")))
|
|
|
|
(gtk "gtk_main_iteration")
|
|
(main (gtk "gtk_server_callback 0"))
|
|
(gtk "gtk_server_exit")
|