GTK graphical user interface
All rights reserved.
Author: Bo Morgan
Permission to use, copy, modify and distribute this software and its
documentation is hereby granted, provided that both the copyright
notice and this permission notice appear in all copies of the
software, derivative works or modified versions, and any portions
thereof, and that both notices appear in supporting documentation.
BO MORGAN ALLOWS FREE USE OF THIS SOFTWARE IN ITS "AS IS" CONDITION.
BO MORGAN DISCLAIMS ANY LIABILITY OF ANY KIND FOR ANY DAMAGES
WHATSOEVER RESULTING FROM THE USE OF THIS SOFTWARE.
Bo Morgan requests users of this software to return to bo@mit.edu any
improvements or extensions that they make and grant Bo Morgan the
rights to redistribute these changes.'
[defunk gtk‑test []
[let [[win [gtk‑window‑new]]
[vbox [gtk‑vbox‑new 0]]
[menu_bar [gtk‑menu_bar‑new]]
[menu_item [gtk‑menu_item‑new 'Menu']]
[menu [gtk‑menu‑new]]
[check_menu_item [gtk‑check_menu_item‑new 'check_menu_item']]
[vpaned [gtk‑vpaned‑new]]
[hbox [gtk‑hbox‑new 2]]
[search_image [gtk‑image‑new_from_image [image‑new_from_rgb_data 24 24 [let [[data [new chunk [* 3 24 24]]]]
[dotimes [x 24]
[dotimes [y 24]
[let [[pixel [* 3 [+ [* 24 y] x]]]]
[set data bit8‑elt [+ pixel 0] [get [random 256] as‑pointer]]
[set data bit8‑elt [+ pixel 1] [get [random 256] as‑pointer]]
[set data bit8‑elt [+ pixel 2] [get [random 256] as‑pointer]]]]]
data]]]]
[search_entry [gtk‑entry‑new]]
[search_button [gtk‑button‑new_with_label 'Search']]
[next_button [gtk‑button‑new_with_label 'Next']]
[open_button [gtk‑button‑new_with_label 'Open']]
[select_button [gtk‑button‑new_with_label 'Select']]
[save_button [gtk‑button‑new_with_label 'Save']]
[insensitive_button [gtk‑button‑new_with_label 'Insensitive']]
[shrink_button [gtk‑button‑new_with_label 'Shrink']]
[check_button [gtk‑check_button‑new 'Check']]
[swindow [gtk‑scrolled_window‑new]]
[notebook [gtk‑notebook‑new]]
[logo_image [gtk‑image‑new_from_file [package_filename‑to_absolute_pathname 'icons/funk2.png']]]
[drawing_area [gtk‑drawing_area‑new]]
[text_view [gtk‑text_view‑new]]
[table_hbox [gtk‑hbox‑new 2]]
[table_scale [gtk‑scale‑new_with_range `vertical 0.0 100.0 1.0]]
[table [gtk‑table‑new 10 4 t]]]
[have vbox pack_start menu_bar nil nil 0]
[have vbox pack_start vpaned t t 0]
[have menu_bar append menu_item]
[set menu_item submenu menu]
[have menu append check_menu_item]
[have check_menu_item signal_connect 'toggled'
[funk []
[terminal_format standard‑terminal '\ntoggled check_menu_item active: ' [get check_menu_item active]]]
nil]
[have hbox pack_start search_image nil nil 0]
[have hbox pack_start search_entry t t 0]
[have hbox pack_start search_button nil nil 0]
[have hbox pack_start next_button nil nil 0]
[have hbox pack_start open_button nil nil 0]
[have hbox pack_start select_button nil nil 0]
[have hbox pack_start save_button nil nil 0]
[have hbox pack_start insensitive_button nil nil 0]
[have hbox pack_start shrink_button nil nil 0]
[have hbox pack_start check_button nil nil 0]
[have check_button signal_connect 'toggled'
[funk []
[terminal_format standard‑terminal '\ntoggled check_button active: ' [get check_button active]]]
nil]
[have vpaned pack1 hbox nil nil]
[have swindow add text_view]
[have notebook append_page swindow [gtk‑label‑new 'Document']]
[have swindow size_allocate_event‑signal_connect
[funk [event]
[terminal_format standard‑terminal '\nsize_allocate_event for scrolled_window: ' event]]
[]]
[have drawing_area request_size 100 100]
[have notebook append_page drawing_area [gtk‑label‑new 'Drawing Area']]
[have table_hbox pack_start table_scale nil nil 0]
[have table_scale value_changed_event‑signal_connect
[funk []
[terminal_format standard‑terminal '\nscale value‑changed: ' [get table_scale value]]]
nil]
[dotimes [column 4]
[dotimes [row 10]
[have table attach [gtk‑label‑new [format nil 'column=' column '\nrow=' row]] column [+ column 1] row [+ row 1] 0 0]]]
[have table_hbox pack_start table t t 0]
[have notebook append_page table_hbox [gtk‑label‑new 'Table']]
[have notebook append_page logo_image [gtk‑label‑new 'Logo']]
[have vpaned pack2 notebook t t]
[have win add vbox]
[set win title 'gtk‑test']
[set win default_size 128 64]
[have search_entry key_press_event‑signal_connect
[funk [key_event]
[let [[keyval [have key_event lookup `keyval]]]
[terminal_format standard‑terminal '\nkey event: ' key_event]
[if [eq keyval GDK_Return]
[prog [print 'Return!']
[set search_entry text '']
]]]]
nil]
[have search_button signal_connect 'clicked'
[funk []
[let [[found_range [have [get [get text_view buffer] start_iter] forward_search [get search_entry text]]]]
[if found_range
[prog [terminal_format standard‑terminal '\n found "' [get search_entry text] '"!']
[have [get text_view buffer] select_range found_range]]
[prog [terminal_format standard‑terminal '\n could not find "' [get search_entry text] '".']]]]]
nil]
[have next_button signal_connect 'clicked'
[funk []
[terminal_format standard‑terminal '\n table_scale‑value: ' [get table_scale value]]
[set table_scale value 50.0]
[set table_scale range ‑1.0 1.0]
[set table_scale increments 0.05 0.1]
[set table_scale digits 4]
[set search_image image [image‑new_from_rgb_data 24 24 [let [[data [new chunk [* 3 24 24]]]]
[dotimes [x 24]
[dotimes [y 24]
[let [[pixel [* 3 [+ [* 24 y] x]]]]
[set data bit8‑elt [+ pixel 0] [get 255 as‑pointer]]
[set data bit8‑elt [+ pixel 1] [get [if [== [‑ x y] 0] 255 0] as‑pointer]]
[set data bit8‑elt [+ pixel 2] [get 0 as‑pointer]]]]]
data]]]
[print 'Next button clicked!']]
nil]
[have open_button signal_connect 'clicked'
[funk []
[terminal_format standard‑terminal '\n open button clicked.']
[let [[open_dialog [gtk‑file_chooser_dialog‑new_for_file_open nil]]
[preview_label [gtk‑label‑new [format nil nil]]]]
[have open_dialog connect_hide_on_delete]
[set open_dialog select_multiple t]
[have open_dialog add_file_filter_pattern 'Text Files' '*.txt']
[set open_dialog preview_widget preview_label]
[have open_dialog response_event‑signal_connect
[funk [event_frame]
[terminal_format standard‑terminal '\nresponse event frame: ' event_frame]
[let [[response_id [have event_frame lookup `response_id]]]
[if [eq response_id GTK_RESPONSE_ACCEPT]
[prog [terminal_format standard‑terminal '\ngot accept response: filenames = ' [get open_dialog filenames]]
]]]
[have open_dialog destroy]]
nil]
[have open_dialog update_preview_event‑signal_connect
[funk []
[let [[preview_filename [get open_dialog preview_filename]]]
[set preview_label text [stringlist‑intersperse [have [format nil preview_filename] split '/'] '\n']]
[set open_dialog preview_widget_active t]]]
nil]
[have open_dialog show_all]
]]
nil]
[have select_button signal_connect 'clicked'
[funk []
[terminal_format standard‑terminal '\n select button clicked.']
[let [[select_dialog [gtk‑file_chooser_dialog‑new_for_folder_select nil]]]
[have select_dialog connect_hide_on_delete]
[have select_dialog response_event‑signal_connect
[funk [event_frame]
[terminal_format standard‑terminal '\nresponse event frame: ' event_frame]
[let [[response_id [have event_frame lookup `response_id]]]
[if [eq response_id GTK_RESPONSE_ACCEPT]
[prog [terminal_format standard‑terminal '\ngot accept response: filenames = ' [get select_dialog filenames]]
]]]
[have select_dialog destroy]]
nil]
[have select_dialog show_all]
]]
nil]
[have save_button signal_connect 'clicked'
[funk []
[terminal_format standard‑terminal '\n save button clicked.']
[let [[save_dialog [gtk‑file_chooser_dialog‑new_for_file_save nil]]]
[have save_dialog connect_hide_on_delete]
[have save_dialog add_file_filter_pattern 'Text Files' '*.txt']
[set save_dialog current_name 'Untitled Document']
[have save_dialog response_event‑signal_connect
[funk [event_frame]
[terminal_format standard‑terminal '\nresponse event frame: ' event_frame]
[let [[response_id [have event_frame lookup `response_id]]]
[if [eq response_id GTK_RESPONSE_ACCEPT]
[prog [terminal_format standard‑terminal '\ngot accept response: filenames = ' [get save_dialog filenames]]
]]]
[have save_dialog destroy]]
nil]
[have save_dialog show_all]
]]
nil]
[have insensitive_button signal_connect 'clicked'
[funk []
[set insensitive_button sensitive nil]]
nil]
[have shrink_button signal_connect 'clicked'
[funk []
[set win size 1 1]]
nil]
[have drawing_area expose_event‑signal_connect
[funk [expose_event]
[terminal_format standard‑terminal '\nexpose event: ' expose_event]
[have drawing_area draw_arc nil 0 0 100 100 [* 64 0] [* 64 90]]
[have drawing_area draw_arc nil 0 0 100 100 [* 64 270] [* 64 ‑90]]
[have drawing_area draw_rectangle nil 0 0 100 100]
[have drawing_area draw_rectangle nil 45 45 10 10]]
nil]
[have win show_all]]]