## easy-gtk.pkg
# Compiled by:
# src/lib/std/standard.lib# Compare with:
# src/lib/src/gtk.pkg### "The customs of the wise were out of vogue,
### The lists of madmen flourished everywhere,
### All virtue was despised, black art esteemed,
### Right lost to sight, disaster manifest;
### While divs accomplished their fell purposes
### And no man spake of good, except by stealth."
###
### -- "Mythology of All Races",
### Vol. VI, Indian & Iranian,
### (1917) p. 321
package easy_gtk
: Easy_Gtk # Easy_Gtk is from src/lib/src/easy-gtk.api{
include gtk_via_pipe;
Arg
= CALLBACKS List( Callback_Type )
| PROPERTIES List( Property )
| KIDS List( Widget_Tree )
also
Box_Arg
= HOMOGENEOUS Bool # These two are box properties
| SPACING Int
| PADDING Int # These four are boxkid properties
| EXPAND Bool
| FILL Bool
| PACK_FROM Pack_From
also
Widget_Tree
= WINDOW List( Arg )
| HORIZONTAL_BOX (List( Box_Arg), List( Widget_Tree ) )
| VERTICAL_BOX (List( Box_Arg), List( Widget_Tree ) )
| LABEL (String, List( Arg ))
| BUTTON List( Arg )
| BUTTON_WITH_LABEL (String, List( Arg ))
| BUTTON_WITH_MNEMONIC (String, List( Arg ))
| TOGGLE_BUTTON List( Arg )
| TOGGLE_BUTTON_WITH_LABEL (String, List( Arg ))
| TOGGLE_BUTTON_WITH_MNEMONIC (String, List( Arg ))
| CHECK_BUTTON List( Arg )
| CHECK_BUTTON_WITH_LABEL (String, List( Arg ))
| CHECK_BUTTON_WITH_MNEMONIC (String, List( Arg ))
| IMAGE_FROM_FILE (String, List( Arg ))
also
Callback_Type
= DESTROY Void_Callback
| REALIZE Void_Callback
| CLICK Void_Callback
| PRESS Void_Callback
| RELEASE Void_Callback
| ENTER Void_Callback
| LEAVE Void_Callback
| BUTTON_PRESS_EVENT Button_Event_Callback
| BUTTON_RELEASE_EVENT Void_Callback
| KEY_PRESS_EVENT Key_Event_Callback
| KEY_RELEASE_EVENT Void_Callback
| SCROLL_EVENT Void_Callback
| MOTION_NOTIFY_EVENT Motion_Event_Callback
| CONFIGURE_EVENT Configure_Event_Callback
| DELETE_EVENT Void_Callback
| EXPOSE_EVENT Expose_Event_Callback
| ENTER_NOTIFY_EVENT Void_Callback
| LEAVE_NOTIFY_EVENT Void_Callback
| FOCUS_IN_EVENT Void_Callback
| FOCUS_OUT_EVENT Void_Callback
| MAP_EVENT Void_Callback
| UNMAP_EVENT Void_Callback
| PROPERTY_NOTIFY_EVENT Void_Callback
| SELECTION_CLEAR_EVENT Void_Callback
| SELECTION_REQUEST_EVENT Void_Callback
| SELECTION_NOTIFY_EVENT Void_Callback
| PROXIMITY_IN_EVENT Void_Callback
| PROXIMITY_OUT_EVENT Void_Callback
| CLIENT_EVENT Void_Callback
| NO_EXPOSE_EVENT Void_Callback
| WINDOW_STATE_EVENT Void_Callback
also
Property
= EASY_ID String # This is part of our binding machinery, not part of GTK+ itself.
| BORDER_WIDTH Int
| WINDOW_TITLE String
| WINDOW_DEFAULT_SIZE (Int, Int)
| EVENT_BOX_VISIBILITY Bool
;
fun set_properties (session, widget, properties)
=
foreach properties .{
case #property
EASY_ID id => set_easy_id (session, id, widget);
BORDER_WIDTH width => set_border_width (session, widget, width);
WINDOW_TITLE title => set_window_title (session, widget, title);
WINDOW_DEFAULT_SIZE size => set_window_default_size (session, widget, size);
EVENT_BOX_VISIBILITY bool => set_event_box_visibility (session, widget, bool);
esac;
};
fun set_callbacks (session, widget, callbacks)
=
foreach callbacks .{
case #callback
DESTROY callback => set_destroy_callback session widget callback;
REALIZE callback => set_realize_callback session widget callback;
CLICK callback => set_clicked_callback session widget callback;
PRESS callback => set_pressed_callback session widget callback;
RELEASE callback => set_release_callback session widget callback;
ENTER callback => set_enter_callback session widget callback;
LEAVE callback => set_leave_callback session widget callback;
BUTTON_PRESS_EVENT button_callback => set_button_press_event_callback session widget button_callback;
BUTTON_RELEASE_EVENT callback => set_button_release_event_callback session widget callback;
KEY_PRESS_EVENT key_callback => set_key_press_event_callback session widget key_callback;
KEY_RELEASE_EVENT callback => set_key_release_event_callback session widget callback;
SCROLL_EVENT callback => set_scroll_event_callback session widget callback;
MOTION_NOTIFY_EVENT motion_callback => set_motion_notify_event_callback session widget motion_callback;
CONFIGURE_EVENT configure_callback => set_configure_event_callback session widget configure_callback;
DELETE_EVENT callback => set_delete_event_callback session widget callback;
EXPOSE_EVENT expose_callback => set_expose_event_callback session widget expose_callback;
ENTER_NOTIFY_EVENT callback => set_enter_notify_event_callback session widget callback;
LEAVE_NOTIFY_EVENT callback => set_leave_notify_event_callback session widget callback;
FOCUS_IN_EVENT callback => set_focus_in_event_callback session widget callback;
FOCUS_OUT_EVENT callback => set_focus_out_event_callback session widget callback;
MAP_EVENT callback => set_map_event_callback session widget callback;
UNMAP_EVENT callback => set_unmap_event_callback session widget callback;
PROPERTY_NOTIFY_EVENT callback => set_property_notify_event_callback session widget callback;
SELECTION_CLEAR_EVENT callback => set_selection_clear_event_callback session widget callback;
SELECTION_REQUEST_EVENT callback => set_selection_request_event_callback session widget callback;
SELECTION_NOTIFY_EVENT callback => set_selection_notify_event_callback session widget callback;
PROXIMITY_IN_EVENT callback => set_proximity_in_event_callback session widget callback;
PROXIMITY_OUT_EVENT callback => set_proximity_out_event_callback session widget callback;
CLIENT_EVENT callback => set_client_event_callback session widget callback;
NO_EXPOSE_EVENT callback => set_no_expose_event_callback session widget callback;
WINDOW_STATE_EVENT callback => set_window_state_event_callback session widget callback;
esac;
};
# Some arglist scanners for HORIZONTAL_BOX and VERTICAL_BOX:
#
fun box_is_homogeneous [] => TRUE;
box_is_homogeneous ((HOMOGENEOUS h) ! rest) => h;
box_is_homogeneous (_ ! rest) => box_is_homogeneous rest;
end;
fun box_spacing [] => 0;
box_spacing ((SPACING s) ! rest) => s;
box_spacing (_ ! rest) => box_spacing rest;
end;
fun box_expand [] => TRUE;
box_expand ((EXPAND e) ! rest) => e;
box_expand (_ ! rest) => box_expand rest;
end;
fun box_fill [] => TRUE;
box_fill ((FILL f) ! rest) => f;
box_fill (_ ! rest) => box_fill rest;
end;
fun box_padding [] => 0;
box_padding ((PADDING p) ! rest) => p;
box_padding (_ ! rest) => box_padding rest;
end;
fun box_pack_from [] => FROM_START;
box_pack_from ((PACK_FROM p) ! rest) => p;
box_pack_from (_ ! rest) => box_pack_from rest;
end;
fun set_kids (session, mom, kids)
=
foreach kids .{
kid = make_kid (session, #a_kid);
add_kid { session, kid, mom };
}
also
fun pack_box_kids (session, box, expand, fill, pack, padding, kids)
=
foreach kids .{
kid = make_kid (session, #a_kid);
pack_box { session, box, kid, pack, expand, fill, padding };
}
also
fun set_args (session, widget, [])
=>
();
set_args (session, widget, arg ! args)
=>
case arg
CALLBACKS callbacks => { set_callbacks (session, widget, callbacks ); set_args (session, widget, args); };
PROPERTIES properties => { set_properties (session, widget, properties ); set_args (session, widget, args); };
KIDS kids => { set_kids (session, widget, kids ); set_args (session, widget, args); };
esac;
end
also
fun make_kid (session, kid)
=
case kid
WINDOW args
=>
{ window = make_window session;
set_args (session, window, args);
window;
};
HORIZONTAL_BOX (box_args, kids)
=>
{ box = make_horizontal_box (session, box_is_homogeneous box_args, box_spacing box_args);
pack_box_kids( session, box, box_expand box_args, box_fill box_args, box_pack_from box_args, box_padding box_args, kids );
box;
};
VERTICAL_BOX (box_args, kids)
=>
{ box = make_vertical_box (session, box_is_homogeneous box_args, box_spacing box_args);
pack_box_kids( session, box, box_expand box_args, box_fill box_args, box_pack_from box_args, box_padding box_args, kids );
box;
};
LABEL (label, args)
=>
{ label = make_label (session, label);
set_args (session, label, args);
label;
};
BUTTON args
=>
{ button = make_button session;
set_args (session, button, args);
button;
};
BUTTON_WITH_LABEL (label, args)
=>
{ button = make_button_with_label (session, label);
set_args (session, button, args);
button;
};
BUTTON_WITH_MNEMONIC (mnemonic, args)
=>
{ button = make_button_with_mnemonic (session, mnemonic);
set_args (session, button, args);
button;
};
TOGGLE_BUTTON args
=>
{ toggle_button = make_toggle_button session;
set_args (session, toggle_button, args);
toggle_button;
};
TOGGLE_BUTTON_WITH_LABEL (label, args)
=>
{ toggle_button = make_toggle_button_with_label (session, label);
set_args (session, toggle_button, args);
toggle_button;
};
TOGGLE_BUTTON_WITH_MNEMONIC (mnemonic, args)
=>
{ toggle_button = make_toggle_button_with_mnemonic (session, mnemonic);
set_args (session, toggle_button, args);
toggle_button;
};
CHECK_BUTTON args
=>
{ check_button = make_check_button session;
set_args (session, check_button, args);
check_button;
};
CHECK_BUTTON_WITH_LABEL (label, args)
=>
{ check_button = make_check_button_with_label (session, label);
set_args (session, check_button, args);
check_button;
};
CHECK_BUTTON_WITH_MNEMONIC (mnemonic, args)
=>
{ check_button = make_check_button_with_mnemonic (session, mnemonic);
set_args (session, check_button, args);
check_button;
};
IMAGE_FROM_FILE (filename, args)
=>
{ image = make_image_from_file (session, filename);
set_args (session, image, args);
image;
};
esac;
fun do session (widget_tree: Widget_Tree)
=
{ widget_tree' = make_kid (session, widget_tree);
set_destroy_callback session widget_tree' .{ quit_eventloop session; winix::process::exit 0; };
set_widget_tree (session, widget_tree');
show_widget_tree (session, widget_tree');
run_eventloop_indefinitely session;
};
fun window a = WINDOW a;
fun horizontal_box a b = HORIZONTAL_BOX (a, b); # Lets us write horizontal_box [...] [...] instead of HORIZONTAL_BOX ([...], [...])
fun vertical_box a b = VERTICAL_BOX (a, b); # Lets us write vertical_box [...] [...] instead of VERTICAL_BOX ([...], [...])
fun label a b = LABEL (a, b);
fun button_with_label a b = BUTTON_WITH_LABEL (a, b);
fun button_with_mnemonic a b = BUTTON_WITH_MNEMONIC (a, b);
fun toggle_button_with_label a b = TOGGLE_BUTTON_WITH_LABEL (a, b);
fun toggle_button_with_mnemonic a b = TOGGLE_BUTTON_WITH_MNEMONIC (a, b);
fun check_button_with_label a b = CHECK_BUTTON_WITH_LABEL (a, b);
fun check_button_with_mnemonic a b = CHECK_BUTTON_WITH_MNEMONIC (a, b);
fun image_from_file a b = IMAGE_FROM_FILE (a, b);
homogeneous = HOMOGENEOUS;
spacing = SPACING;
padding = PADDING;
expand = EXPAND;
fill = FILL;
pack_from = PACK_FROM;
callbacks = CALLBACKS;
properties = PROPERTIES;
kids = KIDS;
easy_id = EASY_ID;
border_width = BORDER_WIDTH;
window_title = WINDOW_TITLE;
window_default_size = WINDOW_DEFAULT_SIZE;
event_box_visibility = EVENT_BOX_VISIBILITY;
destroy = DESTROY;
realize = REALIZE;
click = CLICK;
press = PRESS;
release = RELEASE;
enter = ENTER;
leave = LEAVE;
button_press_event = BUTTON_PRESS_EVENT;
button_release_event = BUTTON_RELEASE_EVENT;
key_press_event = KEY_PRESS_EVENT;
key_release_event = KEY_RELEASE_EVENT;
scroll_event = SCROLL_EVENT;
motion_notify_event = MOTION_NOTIFY_EVENT;
configure_event = CONFIGURE_EVENT;
delete_event = DELETE_EVENT;
expose_event = EXPOSE_EVENT;
enter_notify_event = ENTER_NOTIFY_EVENT;
leave_notify_event = LEAVE_NOTIFY_EVENT;
focus_in_event = FOCUS_IN_EVENT;
focus_out_event = FOCUS_OUT_EVENT;
map_event = MAP_EVENT;
unmap_event = UNMAP_EVENT;
property_notify_event = PROPERTY_NOTIFY_EVENT;
selection_clear_event = SELECTION_CLEAR_EVENT;
selection_request_event = SELECTION_REQUEST_EVENT;
selection_notify_event = SELECTION_NOTIFY_EVENT;
proximity_in_event = PROXIMITY_IN_EVENT;
proximity_out_event = PROXIMITY_OUT_EVENT;
client_event = CLIENT_EVENT;
no_expose_event = NO_EXPOSE_EVENT;
window_state_event = WINDOW_STATE_EVENT;
};
## Code by Jeff Prothero: Copyright (c) 2010-2012,
## released under Gnu Public Licence version 3.