#!/usr/local/bin/logo

; Logo GUI demonstration with the GTK-server
;
; Tested with Brian Harvey's Berkeley Logo 5.3
; on Slackware Linux 10.
;
; Run with 'logo demo.logo'.
;
; The GTK-server cannot be started with the SHELL command,
; because this command does not return to the script. Hence
; the GTK-server has to be started manually first.
;
; By Peter van Eerten, September 5 2004
; Revised for GTK-server 1.2 October 7, 2004
; Revised for GTK-server 1.3 December 4, 2004
; Revised for GTK-server 2.0.6 at december 17, 2005
; ------------------------------------------

TO warning
	PRINT []
	PRINT [!!!WARNING: The GTK-server is not running!!!]
	PRINT []
	PRINT [Start with "gtk-server -fifo=/tmp/demo.logo &"]
	PRINT []
	;;SHELL [gtk-server fifo /tmp/demo.logo &]
END

; Generic communication function
TO GTK :str
	OPENWRITE "/tmp/demo.logo
	SETWRITE "/tmp/demo.logo
	PRINT THING "str
	SETWRITE []
	CLOSE "/tmp/demo.logo
	OPENREAD "/tmp/demo.logo
	SETREAD "/tmp/demo.logo
	MAKE "tmp READCHARS 128
	SETREAD []
	CLOSE "/tmp/demo.logo
	OUTPUT THING "tmp
END

; -------------------------------------------

; Check if the GTK-server is running
MAKE "tmp SHELL [ls /tmp/demo.logo]
IF EMPTYP :tmp [warning bye]

; Continue with main program GUI definition
MAKE "tmp GTK [gtk_init NULL NULL]
MAKE "win GTK [gtk_window_new 0]
MAKE "tmp GTK (SENTENCE [gtk_window_set_title ] :win [ \"Logo GUI demo script using GTK\"] )
MAKE "tmpGTK (SENTENCE [gtk_widget_set_usize ] :win [ 450 400] )
MAKE "tbl GTK [gtk_table_new 50 50 1]
MAKE "tmp GTK (SENTENCE [gtk_container_add ] :win [ ] :tbl )
MAKE "but GTK [gtk_button_new_with_label Exit]
MAKE "tmp GTK (SENTENCE [gtk_table_attach_defaults ] :tbl [ ] :but [ 41 49 45 49] )
MAKE "ent GTK [gtk_entry_new]
MAKE "tmp GTK (SENTENCE [gtk_table_attach_defaults ] :tbl [ ] :ent [ 1 40 45 49] )
MAKE "txt GTK [gtk_text_new NULL NULL]
MAKE "tmp GTK (SENTENCE [gtk_table_attach_defaults ] :tbl [ ] :txt [ 1 49 8 44] )

MAKE "radio1 GTK [gtk_radio_button_new_with_label_from_widget NULL Yes]
MAKE "tmp GTK (SENTENCE [gtk_table_attach_defaults ] :tbl [ ] :radio1 [ 1 10 1 4] )
MAKE "radio2 GTK (SENTENCE [gtk_radio_button_new_with_label_from_widget ] :radio1 [ No] )
MAKE "tmp GTK (SENTENCE [gtk_table_attach_defaults ] :tbl [ ] :radio2 [ 1 10 4 7] )
MAKE "tmp GTK (SENTENCE [gtk_widget_show_all ] :win )
MAKE "tmp GTK (SENTENCE [gtk_widget_grab_focus ] :ent )

MAKE "event 0

WHILE [NOT EQUALP :event :but] [
	MAKE "event GTK (SENTENCE [gtk_server_callback WAIT] )
	IF EQUALP :event THING "ent [
		MAKE "tmp GTK (SENTENCE [gtk_entry_get_text ] :ent )
		; Use WORD here to avoid spaces in inserted text
		MAKE "tmp GTK (SENTENCE [gtk_text_insert ] :txt [ NULL NULL NULL \"] :tmp [\" -1] )
		; Empty entry field
		MAKE "tmp GTK (SENTENCE [gtk_editable_delete_text ] :ent [ 0 -1] )
	]
]

; Exit the GTK-server
GTK [gtk_server_exit]

; Exit the Logo interpreter
BYE