## translate-guipane-to-guipith.pkg
#
# Editing running GUIs.
# For motivation, overview and background see Note[1] at bottom of file.
# Compiled by:
# src/lib/x-kit/widget/xkit-widget.sublibstipulate
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
include package threadkit; # threadkit is from src/lib/src/lib/thread-kit/src/core-thread-kit/threadkit.pkg #
package evt = gui_event_types; # gui_event_types is from src/lib/x-kit/widget/gui/gui-event-types.pkg package gts = gui_event_to_string; # gui_event_to_string is from src/lib/x-kit/widget/gui/gui-event-to-string.pkg package gt = guiboss_types; # guiboss_types is from src/lib/x-kit/widget/gui/guiboss-types.pkg package a2r = windowsystem_to_xevent_router; # windowsystem_to_xevent_router is from src/lib/x-kit/xclient/src/window/windowsystem-to-xevent-router.pkg package gtr = translate_guiplan_to_guipane; # translate_guiplan_to_guipane is from src/lib/x-kit/widget/gui/translate-guiplan-to-guipane.pkg package gd = gui_displaylist; # gui_displaylist is from src/lib/x-kit/widget/theme/gui-displaylist.pkg package s2b = sprite_to_spritespace; # sprite_to_spritespace is from src/lib/x-kit/widget/space/sprite/sprite-to-spritespace.pkg package o2c = object_to_objectspace; # object_to_objectspace is from src/lib/x-kit/widget/space/object/object-to-objectspace.pkg package pp = standard_prettyprinter; # standard_prettyprinter is from src/lib/prettyprint/big/src/standard-prettyprinter.pkg package err = compiler::error_message; # compiler is from src/lib/core/compiler/compiler.pkg # error_message is from src/lib/compiler/front/basics/errormsg/error-message.pkg package bt = gui_to_sprite_theme; # gui_to_sprite_theme is from src/lib/x-kit/widget/theme/sprite/gui-to-sprite-theme.pkg package ct = gui_to_object_theme; # gui_to_object_theme is from src/lib/x-kit/widget/theme/object/gui-to-object-theme.pkg package wt = widget_theme; # widget_theme is from src/lib/x-kit/widget/theme/widget/widget-theme.pkg package boi = spritespace_imp; # spritespace_imp is from src/lib/x-kit/widget/space/sprite/spritespace-imp.pkg package cai = objectspace_imp; # objectspace_imp is from src/lib/x-kit/widget/space/object/objectspace-imp.pkg package pai = widgetspace_imp; # widgetspace_imp is from src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg #
package gtg = guiboss_to_guishim; # guiboss_to_guishim is from src/lib/x-kit/widget/theme/guiboss-to-guishim.pkg package gtj = guiboss_types_junk; # guiboss_types_junk is from src/lib/x-kit/widget/gui/guiboss-types-junk.pkg package b2s = spritespace_to_sprite; # spritespace_to_sprite is from src/lib/x-kit/widget/space/sprite/spritespace-to-sprite.pkg package c2o = objectspace_to_object; # objectspace_to_object is from src/lib/x-kit/widget/space/object/objectspace-to-object.pkg package s2s = sprite_to_spritespace; # sprite_to_spritespace is from src/lib/x-kit/widget/space/sprite/sprite-to-spritespace.pkg package o2o = object_to_objectspace; # object_to_objectspace is from src/lib/x-kit/widget/space/object/object-to-objectspace.pkg package g2p = gadget_to_pixmap; # gadget_to_pixmap is from src/lib/x-kit/widget/theme/gadget-to-pixmap.pkg# package frm = frame; # frame is from src/lib/x-kit/widget/leaf/frame.pkg package lts = list_to_string; # list_to_string is from src/lib/src/list-to-string.pkg package idm = id_map; # id_map is from src/lib/src/id-map.pkg package im = int_red_black_map; # int_red_black_map is from src/lib/src/int-red-black-map.pkg# package is = int_red_black_set; # int_red_black_set is from src/lib/src/int-red-black-set.pkg package r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg package r64 = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.pkg package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.pkg package g2j = geometry2d_junk; # geometry2d_junk is from src/lib/std/2d/geometry2d-junk.pkg package ebi = millboss_imp; # millboss_imp is from src/lib/x-kit/widget/edit/millboss-imp.pkg package e2g = millboss_to_guiboss; # millboss_to_guiboss is from src/lib/x-kit/widget/edit/millboss-to-guiboss.pkg tracefile = "widget-unit-test.trace.log";
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
package translate_guipane_to_guipith
: Translate_Guipane_To_Guipith # Translate_Guipane_To_Guipith is from src/lib/x-kit/widget/gui/translate-guipane-to-guipith.api {
fun guipanes_to_guipiths
#
( me: gt::Guiboss_State
)
:
idm::Map( gt::Xi_Hostwindow_Info )
=
{ xi_hostwindow_infos
=
map do_hostwindow_info (idm::vals_list *me.hostwindows)
where
fun do_hostwindow_info (hostwindow_info: gt::Hostwindow_Info): gt::Xi_Hostwindow_Info
=
{ id = hostwindow_info.guiboss_to_hostwindow.id;
#
subwindow_info
=
case *hostwindow_info.subwindow_info
#
THE (gt::SUBWINDOW_DATA subwindow_info)
=>
THE (gt::XI_SUBWINDOW_DATA (do_subwindow_info subwindow_info));
NULL => NULL;
esac;
xi_hostwindow_info
=
{ id, subwindow_info };
xi_hostwindow_info;
};
end;
result = (list::fold_forward add_hostwindow_info idm::empty xi_hostwindow_infos)
where
fun add_hostwindow_info
(
xi_hostwindow_info: gt::Xi_Hostwindow_Info,
result_so_far: idm::Map(gt::Xi_Hostwindow_Info)
)
=
idm::set( result_so_far,
xi_hostwindow_info.id,
xi_hostwindow_info
);
end;
result;
}
where
fun do_rg_widget (rg_widget: gt::Rg_Widget_Type)
=
case rg_widget
#
gt::RG_ROW { id: Id,
widgets: List( gt::Rg_Widget_Type ),
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref( g2d::Box ),
first_cut: Null_Or( Float )
}
=>
gt::XI_ROW { id,
widgets => map do_rg_widget widgets,
first_cut
};
gt::RG_COL { id: Id,
widgets: List( gt::Rg_Widget_Type ),
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref( g2d::Box),
first_cut: Null_Or( Float )
}
=>
gt::XI_COL { id,
widgets => map do_rg_widget widgets,
first_cut
};
gt::RG_GRID { id: Id,
widgets: List( List( gt::Rg_Widget_Type ) ),
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref(g2d::Box)
}
=>
gt::XI_GRID { id,
widgets => map do_row widgets
}
where
fun do_row (widgets: List(gt::Rg_Widget_Type))
=
(map do_rg_widget widgets);
end;
gt::RG_MARK { id: Id,
doc: String,
widget: gt::Rg_Widget_Type,
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref(g2d::Box)
}
=>
gt::XI_MARK { id,
doc,
widget => do_rg_widget widget
};
gt::RG_SCROLLPORT
{ id: Id,
upperleft: Ref(g2d::Point), # Origin of view's subwindow_or_view in scrollport coordinates, used for scrolling pixmap in scrollport.
scroller: Ref(gt::Scroller), # Client-code interface for controlling view_upperleft. This is a ref to resolve mutual recursion issues at creation, not because we expect to update it.
callback: gt::Scroller_Callback, # This is how we pass our Scroller to app client code, which basically lets it set 'pixmap_upperleft' above.
site: Ref(g2d::Box), # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg rg_widget: Ref( gt::Rg_Widget_Type ), # Widget-tree visible in this viewable, which gets rendered onto 'pixmap' here.
# # rg_widget is a Ref not because we intend to change it, but to work around a technical difficulty in guiboss-imp.pkg:do_pg_widget:PG_SCROLLPORT where viewable_data and rg_widget each want to be created first.
pixmap: g2p::Gadget_To_Rw_Pixmap, #
#
#
parent_subwindow_or_view: gt::Subwindow_Or_View # This can be a SCROLLABLE_INFO if we have a scrollport located on a scrollport.
}
=>
{
xi_widget = do_rg_widget *rg_widget;
# pixmap_size = gadget_to_rw_pixmap.size;
#
gt::XI_SCROLLPORT
{ id,
xi_widget
};
};
gt::RG_TABPORT { id: Id,
tabs: List( gt::Tabbable_Info),
visible_tab: Ref( Int ),
callback: gt::Tab_Picker_Callback,
site: Ref(g2d::Box)
}
=>
{
#
gt::XI_TABPORT { id, widgets => map do_tab tabs }
where
fun do_tab (tab: gt::Tabbable_Info)
=
do_rg_widget tab.rg_widget;
end;
};
gt::RG_FRAME
{ id: Id,
frame_widget: gt::Rg_Widget_Type, # Widget which will draw the frame surround.
widget: gt::Rg_Widget_Type, # Widget-tree to draw surrounded by frame.
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref(g2d::Box) # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg }
=>
{ gt::XI_FRAME { id, frame_widget, widget } #
where
fun do_widget (r: gt::Rg_Widget_Type)
=
( do_rg_widget r
);
frame_widget = do_widget frame_widget;
widget = do_widget widget;
end;
};
gt::RG_WIDGET r
=>
{ id = r.guiboss_to_widget.id;
# i = id_to_int id;
#
gadget_imp_info = gtj::get_gadget_imp_info (me.gadget_imps, id);
widget_layout_hint
=
case (idm::get (*me.widget_layout_hints, id))
#
THE hint => hint;
#
NULL => { msg = "widget not in *me.widget_layout_hints?! -- guipane_to_guipith in translate-guipane-to-guipith.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
gt::XI_WIDGET
{
widget_id => r.guiboss_to_widget.id,
widget_layout_hint,
doc => r.guiboss_to_widget.doc
};
};
#
gt::RG_OBJECTSPACE objectspace
=>
do_objectspace objectspace;
gt::RG_SPRITESPACE spritespace
=>
do_spritespace spritespace;
gt::RG_NULL_WIDGET
=>
gt::XI_NULL_WIDGET;
esac
also
fun do_spritespace r
=
{
guiboss_to_spritespace_id
=
r.guiboss_to_spritespace.id;
xi_sprites = do_rg_sprites r.sprites;
#
# (idm::get_or_raise_exception_not_found (*hostwindow_info.spritespace_imps, r.spritespace_id))
# ->
# { guiboss_to_spritespace, sprite_to_spritespace, shutdown_oneshot };
#
# arg = get_from_oneshot shutdown_oneshot;
gt::XI_SPRITESPACE { guiboss_to_spritespace_id, xi_sprites };
}
also
fun do_rg_sprites (sprites: List (gt::Rg_Sprite_Type))
=
{
sprites'' = map do_sprite sprites
where
fun do_sprite (sprite: gt::Rg_Sprite_Type)
=
case sprite
#
gt::RG_SPRITE r
=>
gt::XI_SPRITE { sprite_id => r.guiboss_to_gadget.id }; # Read and return final state of sprite-imp -- incidentally confirming that it has completed its shutdown.
esac;
#
# fun do_sprite (sprite': gt::Rg_Sprite_Type)
# =
# { sprite'' = do_sprite' sprite';
# #
# sprite'';
# };
end;
sprites'';
}
also
fun do_objectspace r
=
{
guiboss_to_objectspace_id
=
r.guiboss_to_objectspace.id;
xi_objects = do_rg_objects r.objects;
#
# (idm::get_or_raise_exception_not_found (*hostwindow_info.objectspace_imps, r.objectspace_id))
# ->
# { guiboss_to_objectspace, object_to_objectspace, shutdown_oneshot };
#
# arg = get_from_oneshot shutdown_oneshot;
gt::XI_OBJECTSPACE { guiboss_to_objectspace_id, xi_objects };
}
also
fun do_rg_objects (objects: List (gt::Rg_Object_Type))
=
{
objects'' = map do_object objects
where
fun do_object (object: gt::Rg_Object_Type)
=
case object
#
gt::RG_OBJECT r
=>
gt::XI_OBJECT { object_id => r.guiboss_to_gadget.id }; # Read and return final state of object-imp -- incidentally confirming that it has completed its shutdown.
gt::RG_WIDGETSPACE
{ guiboss_to_widgetspace: gt::Guiboss_To_Widgetspace,
rg_widget: gt::Rg_Widget_Type
}
=>
{ xi_widget = do_rg_widget rg_widget;
#
gt::XI_WIDGETSPACE
{
widgetspace_id => guiboss_to_widgetspace.id,
xi_widget
};
};
esac;
#
# fun do_object (object': gt::Rg_Object_Type)
# =
# { object'' = do_object' object';
# #
# object'';
# };
end;
objects'';
} # fun do_rg_objects
also
fun do_subwindow_info (subwindow_info: gt::Subwindow_Info): gt::Xi_Subwindow_Info
=
{ subwindow_info
->
{ id: Id,
guipane: Ref( Null_Or( gt::Guipane ) ),
pixmap: Ref( g2p::Gadget_To_Rw_Pixmap ), # Main backing store for this running gui.
popups: Ref(List(gt::Subwindow_Data)), # These will all be SUBWINDOW_INFO, so 'Ref(List(Subwindow_Info))' would be a better type here.
parent: Null_Or( gt::Subwindow_Data ), # For popups this points to the parent; for the original non-popup window it is NULL.
stacking_order: Int, # Assigned in increasing order starting at 1; these determine who overlies who visually on the screen in case of overlaps. (Popups must be entirely within parent, but sibling popups can overlap.)
upperleft: Ref(g2d::Point) # If we have a parent, this gives our location on it. Note that pixmap.size gives our size.
};
guipane = case *guipane
#
THE guipane => THE (do_guipane guipane);
NULL => NULL;
esac;
popups = map do_popup *popups;
{ id, guipane, popups };
}
also
fun do_guipane (guipane: gt::Guipane): gt::Xi_Guipane
=
{ guipane -> { id: Id,
rg_widget: gt::Rg_Widget_Type, # The widget (or more commonly, tree of widgets) managed by the gui-tree's toplevel widgetspace-imp.
guiboss_to_widgetspace: gt::Guiboss_To_Widgetspace,
widget_to_guiboss: gt::Widget_To_Guiboss,
space_to_gui: gt::Space_To_Gui,
hostwindow: gtg::Guiboss_To_Hostwindow, # The hostwindow on which to draw our widgets. This represents the X-server window holding our tree of running guis.
subwindow_info: gt::Subwindow_Data, # The subwindow on which this running gui is drawn. This will be a sub-rectangle of the hostwindow, except for the root running gui of the popups tree. It hosts the actual backing pixmap on which rg_widget will be drawn first.
needs_layout_and_redraw: Ref( Bool )
};
guiboss_to_widgetspace_id
=
guiboss_to_widgetspace.id;
xi_widget
=
do_rg_widget rg_widget;
{ id, guiboss_to_widgetspace_id, xi_widget };
}
also
fun do_popup (popup: gt::Subwindow_Data): gt::Xi_Subwindow_Data
=
{ popup -> gt::SUBWINDOW_DATA subwindow_info;
#
xi_subwindow_info
=
do_subwindow_info subwindow_info;
gt::XI_SUBWINDOW_DATA xi_subwindow_info;
};
end;
Running_Gui_Contents # Return type for gather_contents_of_running_guis().
=
{ rg_rows: idm::Map( gt::Rg_Row ),
rg_cols: idm::Map( gt::Rg_Col ),
rg_grids: idm::Map( gt::Rg_Grid ),
rg_marks: idm::Map( gt::Rg_Mark ),
#
rg_widgets: idm::Map( gt::Rg_Widget ),
rg_objects: idm::Map( gt::Rg_Object ),
rg_sprites: idm::Map( gt::Rg_Sprite ),
#
rg_frames: idm::Map( gt::Rg_Frame ),
#
rg_scrollports: idm::Map( gt::Rg_Scrollport ),
rg_tabports: idm::Map( gt::Rg_Tabport ),
#
rg_objectspaces: idm::Map( gt::Rg_Objectspace ),
rg_spritespaces: idm::Map( gt::Rg_Spritespace ),
rg_widgetspaces: idm::Map( gt::Rg_Widgetspace ),
#
get_rg_row: Id -> gt::Rg_Row,
get_rg_col: Id -> gt::Rg_Col,
get_rg_grid: Id -> gt::Rg_Grid,
get_rg_mark: Id -> gt::Rg_Mark,
#
get_rg_frame: Id -> gt::Rg_Frame,
#
get_rg_scrollport: Id -> gt::Rg_Scrollport,
get_rg_tabport: Id -> gt::Rg_Tabport,
#
get_rg_object: Id -> gt::Rg_Object,
get_rg_sprite: Id -> gt::Rg_Sprite,
get_rg_widget: Id -> gt::Rg_Widget,
#
get_rg_objectspace: Id -> gt::Rg_Objectspace,
get_rg_spritespace: Id -> gt::Rg_Spritespace,
get_rg_widgetspace: Id -> gt::Rg_Widgetspace
};
fun guipiths_to_guipanes # Called (only) by install_updated_guipiths in src/lib/x-kit/widget/gui/guiboss-imp.pkg (
me: gt::Guiboss_State,
new_guipiths: idm::Map( gt::Xi_Hostwindow_Info ), # This is a new GUI configuration constructed by application, submitted via Gadget_To_Guiboss.install_guipiths, which is to replace the current running GUI configuration.
guiboss_to_guishim: gtg::Guiboss_To_Guishim,
clear_box_in_pixmap # Clear a box to black, mostly to avoid undefined values etc.
:
( gt::Subwindow_Or_View, # pixmap holding the scrollport.
g2d::Box # Box in view coordinates.
)
-> Void,
update_offscreen_parent_pixmaps_and_then_hostwindow
:
( gt::Subwindow_Or_View,
g2d::Box, # From-box in source pixmap coordinates.
gtg::Guiboss_To_Hostwindow
)
-> Void
)
:
idm::Map( gt::Hostwindow_Info )
=
{
oldcontents = gather_contents_of_running_guis *me.hostwindows;
#
newpanes = build_new_guipanes (new_guipiths, oldcontents);
newcontents = gather_contents_of_running_guis newpanes;
shut_down_dropped_imps (oldcontents, newcontents);
newpanes;
}
where
old_guipiths = guipanes_to_guipiths me;
fun gather_contents_of_running_guis (hostwindows: idm::Map( gt::Hostwindow_Info )): Running_Gui_Contents
=
# Here we need to iterate over all hostwindows,
# then over all guipanes in each hostwindow,
# then over all Subwindow_Info instances in each guipane.
{
do_hostwindows hostwindows;
#
{ rg_rows => *rg_rows,
rg_cols => *rg_cols,
rg_grids => *rg_grids,
rg_marks => *rg_marks,
#
rg_widgets => *rg_widgets,
rg_objects => *rg_objects,
rg_sprites => *rg_sprites,
#
rg_frames => *rg_frames,
#
rg_scrollports => *rg_scrollports,
rg_tabports => *rg_tabports,
#
rg_objectspaces => *rg_objectspaces,
rg_spritespaces => *rg_spritespaces,
rg_widgetspaces => *rg_widgetspaces,
get_rg_row,
get_rg_col,
get_rg_grid,
get_rg_mark,
#
get_rg_frame,
#
get_rg_scrollport,
get_rg_tabport,
#
get_rg_object,
get_rg_sprite,
get_rg_widget,
#
get_rg_objectspace,
get_rg_spritespace,
get_rg_widgetspace
};
}
where
rg_rows = REF (idm::empty: idm::Map( gt::Rg_Row )); fun note_rg_row (rg_row: gt::Rg_Row ) = { key = rg_row.id; rg_rows := idm::set (*rg_rows, key, rg_row ); };
rg_cols = REF (idm::empty: idm::Map( gt::Rg_Col )); fun note_rg_col (rg_col: gt::Rg_Col ) = { key = rg_col.id; rg_cols := idm::set (*rg_cols, key, rg_col ); };
rg_grids = REF (idm::empty: idm::Map( gt::Rg_Grid )); fun note_rg_grid (rg_grid: gt::Rg_Grid ) = { key = rg_grid.id; rg_grids := idm::set (*rg_grids, key, rg_grid ); };
rg_marks = REF (idm::empty: idm::Map( gt::Rg_Mark )); fun note_rg_mark (rg_mark: gt::Rg_Mark ) = { key = rg_mark.id; rg_marks := idm::set (*rg_marks, key, rg_mark ); };
#
rg_widgets = REF (idm::empty: idm::Map( gt::Rg_Widget )); fun note_rg_widget (rg_widget: gt::Rg_Widget ) = { key = rg_widget.guiboss_to_widget.id; rg_widgets := idm::set (*rg_widgets, key, rg_widget ); };
rg_objects = REF (idm::empty: idm::Map( gt::Rg_Object )); fun note_rg_object (rg_object: gt::Rg_Object ) = { key = rg_object.guiboss_to_gadget.id; rg_objects := idm::set (*rg_objects, key, rg_object ); };
rg_sprites = REF (idm::empty: idm::Map( gt::Rg_Sprite )); fun note_rg_sprite (rg_sprite: gt::Rg_Sprite ) = { key = rg_sprite.guiboss_to_gadget.id; rg_sprites := idm::set (*rg_sprites, key, rg_sprite ); };
#
rg_frames = REF (idm::empty: idm::Map( gt::Rg_Frame )); fun note_rg_frame (rg_frame: gt::Rg_Frame ) = { key = rg_frame.id; rg_frames := idm::set (*rg_frames, key, rg_frame ); };
#
rg_scrollports = REF (idm::empty: idm::Map( gt::Rg_Scrollport )); fun note_rg_scrollport (rg_scrollport: gt::Rg_Scrollport ) = { key = rg_scrollport.id; rg_scrollports := idm::set (*rg_scrollports, key, rg_scrollport ); };
rg_tabports = REF (idm::empty: idm::Map( gt::Rg_Tabport )); fun note_rg_tabport (rg_tabport: gt::Rg_Tabport ) = { key = rg_tabport.id; rg_tabports := idm::set (*rg_tabports, key, rg_tabport ); };
#
rg_objectspaces = REF (idm::empty: idm::Map( gt::Rg_Objectspace )); fun note_rg_objectspace (rg_objectspace: gt::Rg_Objectspace ) = { key = rg_objectspace.guiboss_to_objectspace.id; rg_objectspaces := idm::set (*rg_objectspaces, key, rg_objectspace ); };
rg_spritespaces = REF (idm::empty: idm::Map( gt::Rg_Spritespace )); fun note_rg_spritespace (rg_spritespace: gt::Rg_Spritespace ) = { key = rg_spritespace.guiboss_to_spritespace.id; rg_spritespaces := idm::set (*rg_spritespaces, key, rg_spritespace ); };
rg_widgetspaces = REF (idm::empty: idm::Map( gt::Rg_Widgetspace )); fun note_rg_widgetspace (rg_widgetspace: gt::Rg_Widgetspace ) = { key = rg_widgetspace.guiboss_to_widgetspace.id; rg_widgetspaces := idm::set (*rg_widgetspaces, key, rg_widgetspace ); };
fun get_rg_row (id: Id) = { key = id_to_int id; case (idm::get (*rg_rows, id)) THE x => x; NULL => { msg = sprintf "No rg_row found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_col (id: Id) = { key = id_to_int id; case (idm::get (*rg_cols, id)) THE x => x; NULL => { msg = sprintf "No rg_col found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_grid (id: Id) = { key = id_to_int id; case (idm::get (*rg_grids, id)) THE x => x; NULL => { msg = sprintf "No rg_grid found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_mark (id: Id) = { key = id_to_int id; case (idm::get (*rg_marks, id)) THE x => x; NULL => { msg = sprintf "No rg_mark found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
#
fun get_rg_frame (id: Id) = { key = id_to_int id; case (idm::get (*rg_frames, id)) THE x => x; NULL => { msg = sprintf "No rg_frame found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
#
fun get_rg_scrollport (id: Id) = { key = id_to_int id; case (idm::get (*rg_scrollports, id)) THE x => x; NULL => { msg = sprintf "No rg_scrollport found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_tabport (id: Id) = { key = id_to_int id; case (idm::get (*rg_tabports, id)) THE x => x; NULL => { msg = sprintf "No rg_tabport found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
#
fun get_rg_object (id: Id) = { key = id_to_int id; case (idm::get (*rg_objects, id)) THE x => x; NULL => { msg = sprintf "No rg_object found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_sprite (id: Id) = { key = id_to_int id; case (idm::get (*rg_sprites, id)) THE x => x; NULL => { msg = sprintf "No rg_sprite found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_widget (id: Id) = { key = id_to_int id; case (idm::get (*rg_widgets, id)) THE x => x; NULL => { msg = sprintf "No rg_widget found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
#
fun get_rg_objectspace (id: Id) = { key = id_to_int id; case (idm::get (*rg_objectspaces, id)) THE x => x; NULL => { msg = sprintf "No rg_objectspace found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_spritespace (id: Id) = { key = id_to_int id; case (idm::get (*rg_spritespaces, id)) THE x => x; NULL => { msg = sprintf "No rg_spritespace found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun get_rg_widgetspace (id: Id) = { key = id_to_int id; case (idm::get (*rg_widgetspaces, id)) THE x => x; NULL => { msg = sprintf "No rg_widgetspace found with id=%d -- gather_contents_of_running_guis" key; log::fatal msg; raise exception DIE msg; }; esac; };
fun do_hostwindows (hostwindows: idm::Map( gt::Hostwindow_Info ))
=
apply do_hostwindow (idm::keyvals_list hostwindows)
where
fun do_hostwindow
(
id: Id,
hostwindow_info: gt::Hostwindow_Info
)
=
{ gtj::all_guipanes_on_hostwindow_apply
#
hostwindow_info
#
do_guipane
#
where
fun do_guipane (guipane: gt::Guipane)
=
gtj::guipane_apply
(
guipane,
#
[ gtj::RG_ROW_FN note_rg_row,
gtj::RG_COL_FN note_rg_col,
gtj::RG_GRID_FN note_rg_grid,
gtj::RG_MARK_FN note_rg_mark,
#
gtj::RG_WIDGET_FN note_rg_widget,
gtj::RG_OBJECT_FN note_rg_object,
gtj::RG_SPRITE_FN note_rg_sprite,
#
gtj::RG_FRAME_FN note_rg_frame,
#
gtj::RG_SCROLLPORT_FN note_rg_scrollport,
gtj::RG_TABPORT_FN note_rg_tabport,
#
gtj::RG_OBJECTSPACE_FN note_rg_objectspace,
gtj::RG_SPRITESPACE_FN note_rg_spritespace,
gtj::RG_WIDGETSPACE_FN note_rg_widgetspace
]
);
end;
};
end;
end;
fun shut_down_dropped_imps
(
oldcontents: Running_Gui_Contents,
newcontents: Running_Gui_Contents
)
=
{ # A running gui contains:
#
#
# rg_rows # No imp and no nontrivial state, so nothing to recycle.
# rg_cols # No imp and no nontrivial state, so nothing to recycle.
# rg_grids # No imp and no nontrivial state, so nothing to recycle.
# rg_marks # No imp and no nontrivial state, so nothing to recycle.
# rg_frames # No imp and no nontrivial state, so nothing to recycle.
# # #
# rg_scrollports # We currently don't allow dropping these from a guipith, so we should be able to ignore these.
# rg_tabports # We currently don't allow dropping these from a guipith, so we should be able to ignore these.
#
#
# rg_widgets # Has imp that we need to shut down if it was dropped.
# rg_objects # Has imp that we need to shut down if it was dropped.
# rg_sprites # Has imp that we need to shut down if it was dropped.
# # #
# rg_objectspaces # Has imp that we need to shut down if it was dropped.
# rg_spritespaces # Has imp that we need to shut down if it was dropped.
# rg_widgetspaces # Has imp that we need to shut down if it was dropped.
apply do_widget (idm::vals_list oldcontents.rg_widgets)
where
fun do_widget (rg_widget: gt::Rg_Widget)
=
case (idm::get (newcontents.rg_widgets, rg_widget.guiboss_to_widget.id))
#
THE rg_widget => (); # Widget is retained in new running gui, so nothing to do.
NULL => { rg_widget.guiboss_to_widget.g.die (); # Widget was dropped between old and new running guis, so we need to shut down its imp.
#
me.gadget_imps := idm::drop (*me.gadget_imps, rg_widget.guiboss_to_widget.g.id);
me.widget_layout_hints := idm::drop (*me.widget_layout_hints, rg_widget.guiboss_to_widget.id);
};
esac;
end;
apply do_object (idm::vals_list oldcontents.rg_objects)
where
fun do_object (rg_object: gt::Rg_Object)
=
case (idm::get (newcontents.rg_objects, rg_object.guiboss_to_gadget.id))
#
THE rg_object => (); # Object is retained in new running gui, so nothing to do.
NULL => { rg_object.guiboss_to_gadget.die (); # Object was dropped between old and new running guis, so we need to shut down its imp.
#
me.gadget_imps := idm::drop (*me.gadget_imps, rg_object.guiboss_to_gadget.id);
};
esac;
end;
apply do_sprite (idm::vals_list oldcontents.rg_sprites)
where
fun do_sprite (rg_sprite: gt::Rg_Sprite)
=
case (idm::get (newcontents.rg_sprites, rg_sprite.guiboss_to_gadget.id))
#
THE rg_sprite => (); # Sprite is retained in new running gui, so nothing to do.
NULL => { rg_sprite.guiboss_to_gadget.die (); # Sprite was dropped between old and new running guis, so we need to shut down its imp.
#
me.gadget_imps := idm::drop (*me.gadget_imps, rg_sprite.guiboss_to_gadget.id);
};
esac;
end;
apply do_widgetspace (idm::vals_list oldcontents.rg_widgetspaces)
where
fun do_widgetspace (rg_widgetspace: gt::Rg_Widgetspace)
=
case (idm::get (newcontents.rg_widgetspaces, rg_widgetspace.guiboss_to_widgetspace.id))
#
THE rg_widgetspace => (); # Widgetspace is retained in new running gui, so nothing to do.
NULL => { rg_widgetspace.guiboss_to_widgetspace.die (); # Widgetspace was dropped between old and new running guis, so we need to shut down its imp.
#
me.widgetspace_imps := idm::drop (*me.widgetspace_imps, rg_widgetspace.guiboss_to_widgetspace.id);
};
esac;
end;
apply do_objectspace (idm::vals_list oldcontents.rg_objectspaces)
where
fun do_objectspace (rg_objectspace: gt::Rg_Objectspace)
=
case (idm::get (newcontents.rg_objectspaces, rg_objectspace.guiboss_to_objectspace.id))
#
THE rg_objectspace => (); # Objectspace is retained in new running gui, so nothing to do.
NULL => { rg_objectspace.guiboss_to_objectspace.die (); # Objectspace was dropped between old and new running guis, so we need to shut down its imp.
#
me.objectspace_imps := idm::drop (*me.objectspace_imps, rg_objectspace.guiboss_to_objectspace.id);
};
esac;
end;
apply do_spritespace (idm::vals_list oldcontents.rg_spritespaces)
where
fun do_spritespace (rg_spritespace: gt::Rg_Spritespace)
=
case (idm::get (newcontents.rg_spritespaces, rg_spritespace.guiboss_to_spritespace.id))
#
THE rg_spritespace => (); # Spritespace is retained in new running gui, so nothing to do.
NULL => { rg_spritespace.guiboss_to_spritespace.die (); # Spritespace was dropped between old and new running guis, so we need to shut down its imp.
#
me.spritespace_imps := idm::drop (*me.spritespace_imps, rg_spritespace.guiboss_to_spritespace.id);
};
esac;
end;
};
fun gather_all__subwindow_info__and__guipane__instances_in_running_guis ()
=
# Here we need to iterate over all hostwindows,
# then over all guipanes in each hostwindow,
# then over all Subwindow_Info instances in each guipane.
{
do_hostwindows *me.hostwindows;
#
{ subwindow_infos => *subwindow_infos,
guipanes => *guipanes
};
}
where
subwindow_infos = REF (idm::empty: idm::Map( gt::Subwindow_Info ));
guipanes = REF (idm::empty: idm::Map( gt::Guipane ));
#
fun note_subwindow_info (subwindow_info: gt::Subwindow_Info)
=
{ key = subwindow_info.id;
#
subwindow_infos := idm::set (*subwindow_infos, key, subwindow_info);
case *subwindow_info.guipane
#
THE guipane => { key = guipane.id;
#
guipanes := idm::set (*guipanes, key, guipane);
};
NULL => ();
esac;
};
fun do_hostwindows (hostwindows: idm::Map( gt::Hostwindow_Info ))
=
apply do_hostwindow (idm::keyvals_list hostwindows)
where
fun do_subwindow_data (gt::SUBWINDOW_DATA subwindow_info)
=
{ note_subwindow_info subwindow_info;
#
apply do_subwindow_data *subwindow_info.popups;
};
#
fun do_hostwindow
(
id: Id,
arg: gt::Hostwindow_Info
)
=
{
arg -> { guiboss_to_hostwindow: gtg::Guiboss_To_Hostwindow,
current_frame_number: Ref(Int), # We count frames for convenience of widgets and debugging.
seconds_per_frame: Ref(Float), # Primarily so widgets can do motion blurring if they wish.
done_extra_redraw_request_this_frame: Ref(Bool), # See Note[3].
next_stacking_order: Ref(Int), # Next Subwindow_Or_View.stacking_order value to issue.
# The remainder are valid only while a gui is running,
# which is to say, between start_gui' and kill_gui'.
subwindow_info: Ref( Null_Or( gt::Subwindow_Data ) )
};
case *subwindow_info
#
THE subwindow_data
=>
do_subwindow_data subwindow_data;
NULL => ();
esac;
};
end;
end;
fun gather_all_widgets_in_guipith (guipith: idm::Map( gt::Xi_Hostwindow_Info ))
=
{ widgets = REF (idm::empty: idm::Map( gt::Xi_Widget ));
#
gtj::guipith_apply (new_guipiths, [ gtj::XI_WIDGET_FN do_xi_widget ])
where
fun do_xi_widget (xi_widget: gt::Xi_Widget)
=
{ id = xi_widget.widget_id;
#
case (idm::get (*widgets, xi_widget.widget_id))
#
NULL => widgets := idm::set (*widgets, id, xi_widget);
THE _ => { msg = sprintf "Xi_Widget %d appears more than once in guipith!" (id_to_int id);
log::fatal msg;
raise exception DIE msg;
};
esac;
};
end;
*widgets;
};
fun validate_guipith ()
=
{ # The idea here is that
# Gadget_To_Guiboss.install_guipiths
# is intended to move widgets around between guipanes,
# not (yet?) to create or destroy hostwindows or guipanes,
# so we want to check that the app-supplied 'guipith'
# arg has the same basic topology as the currently running
# gui in terms of existing hostwindows and tree of popups
# on each hostwindow.
verify_same_list_of_hostwindows ();
verify_popup_trees_match ();
verify_no_widgets_are_duplicated ();
verify_all_widgets_exist ();
# Eventually we'll probably want stuff like the following, but for now
# object and sprite support is more notional than actual, so I'm wimping
# out on this stuff:
# verify_no_objects_are_duplicated new_guipiths ;
# verify_all_objects_exist (old_guipiths, new_guipiths);
#
# verify_no_sprites_are_duplicated new_guipiths ;
# verify_all_sprites_exist (old_guipiths, new_guipiths);
#
# verify_no_objectspace_imps_are_duplicated new_guipiths ;
# verify_all_objectspace_imps_exist (old_guipiths, new_guipiths);
#
# verify_no_spritespace_imps_are_duplicated new_guipiths ;
# verify_all_spritespace_imps_exist (old_guipiths, new_guipiths);
}
where
fun verify_no_widgets_are_duplicated ()
=
gather_all_widgets_in_guipith new_guipiths;
fun verify_all_widgets_exist ()
=
{ old_widgets = gather_all_widgets_in_guipith old_guipiths;
new_widgets = gather_all_widgets_in_guipith new_guipiths;
apply check_widget_existence (idm::keys_list new_widgets)
where
fun check_widget_existence (id: Id)
=
case (idm::get (old_widgets, id))
#
THE _ => ();
NULL => { msg = sprintf "guipith widget %d is not present in original gui!" (id_to_int id);
log::fatal msg;
raise exception DIE msg;
};
esac;
end;
};
fun verify_same_list_of_hostwindows ()
=
{ old_hostwindows = idm::keys_list old_guipiths;
new_hostwindows = idm::keys_list new_guipiths;
old_hostwindows = map id_to_int old_hostwindows;
new_hostwindows = map id_to_int new_hostwindows;
old_hostwindows = int::sort old_hostwindows;
new_hostwindows = int::sort new_hostwindows;
ints_to_string = lts::list_to_string int::to_string;
if (old_hostwindows != new_hostwindows)
#
old = ints_to_string old_hostwindows;
new = ints_to_string new_hostwindows;
msg = sprintf "new guipith hostwindows list does not match running gui: running = %s new = %s" old new;
log::fatal msg;
raise exception DIE msg;
fi;
};
fun verify_popup_trees_match () # We know list of hostwindows match, check that each has the same popup structure.
=
{ apply check_hostwindow (idm::keyvals_list old_guipiths)
where
fun verify_popup_trees_match' # Check recursively that old and new guipiths have the same tree of popups.
(
old_subwindow_info: gt::Xi_Subwindow_Info,
new_subwindow_info: gt::Xi_Subwindow_Info
)
=
{ fun note_info (gt::XI_SUBWINDOW_DATA info, r: idm::Map(gt::Xi_Subwindow_Info))
=
{ id = info.id;
#
case (idm::get (r, id))
#
NULL => idm::set (r, id, info);
#
THE _ => { msg = sprintf "guipith contains two references to popup %d!" (id_to_int id); log::fatal msg; raise exception DIE msg; };
esac;
};
old_subwindow_infos = list::fold_forward note_info idm::empty old_subwindow_info.popups;
new_subwindow_infos = list::fold_forward note_info idm::empty old_subwindow_info.popups;
apply check_old_info (idm::keys_list old_subwindow_infos) # Verify that all old popups are present in new guipith.
where
fun check_old_info (id: Id)
=
case (idm::get (new_subwindow_infos, id))
#
THE _ => ();
NULL => { msg = sprintf "old popup %d is missing in guipith!" (id_to_int id); log::fatal msg; raise exception DIE msg; };
esac;
end;
apply check_new_info (idm::keys_list new_subwindow_infos) # Verify that all new popups are present in old guipith.
where
fun check_new_info (id: Id)
=
case (idm::get (new_subwindow_infos, id))
#
THE _ => ();
NULL => { msg = sprintf "popup %d in new guipith is not in original guipith!" (id_to_int id); log::fatal msg; raise exception DIE msg; };
esac;
end;
apply check_recursively (idm::keys_list old_subwindow_infos)
where
fun check_recursively (id: Id)
=
{ old = the (idm::get (old_subwindow_infos, id)); # 'the' is safe because i is known to be a key in old_subwindow_infos.
new = the (idm::get (new_subwindow_infos, id)); # 'the' is safe because new_subwindow_infos is known to have the same keys as old_subwindow_infos.
verify_popup_trees_match' (old, new);
};
end;
};
fun check_hostwindow
(
key: Id,
old_hostwindow: gt::Xi_Hostwindow_Info
)
=
{ new_hostwindow = idm::get_or_raise_exception_not_found (new_guipiths, key); # We know it is there from verify_same_list_of_hostwindows check.
#
#
case (old_hostwindow.subwindow_info, new_hostwindow.subwindow_info)
#
( THE (gt::XI_SUBWINDOW_DATA old_data),
THE (gt::XI_SUBWINDOW_DATA new_data)
)
=>
verify_popup_trees_match' (old_data, new_data);
(THE _, NULL) => { msg = sprintf "New guipith hostwindow %d lacks subwindow info present in original hostwindow %d" (id_to_int new_hostwindow.id) (id_to_int old_hostwindow.id); log::fatal msg; raise exception DIE msg; };
(NULL, THE _) => { msg = sprintf "New guipith hostwindow %d has subwindow info absent in original hostwindow %d" (id_to_int new_hostwindow.id) (id_to_int old_hostwindow.id); log::fatal msg; raise exception DIE msg; };
(NULL, NULL ) => ();
esac;
};
end;
};
end;
(gather_all__subwindow_info__and__guipane__instances_in_running_guis ())
->
{ subwindow_infos, guipanes };
fun get_guipane (id: Id) = { key = id_to_int id; case ( idm::get (guipanes, id)) THE x => x; NULL => { msg = sprintf "No guipane found with id=%d -- guipith_to_guipane" ( key); log::fatal msg; raise exception DIE msg; }; esac; };
fun get_subwindow_info (id: Id) = { key = id_to_int id; case ( idm::get (subwindow_infos, id)) THE x => x; NULL => { msg = sprintf "No subwindow_info found with id=%d -- guipith_to_guipane" ( key); log::fatal msg; raise exception DIE msg; }; esac; };
fun build_new_guipanes
(
new_guipiths: idm::Map( gt::Xi_Hostwindow_Info ),
oldcontents: Running_Gui_Contents
)
=
(build_new_guipanes' ())
where
oldcontents
->
{ rg_rows,
rg_cols,
rg_grids,
rg_marks,
#
rg_widgets,
rg_objects,
rg_sprites,
#
rg_frames,
#
rg_scrollports,
rg_tabports,
#
rg_objectspaces,
rg_spritespaces,
rg_widgetspaces,
get_rg_row,
get_rg_col,
get_rg_grid,
get_rg_mark,
#
get_rg_frame,
#
get_rg_scrollport,
get_rg_tabport,
#
get_rg_object,
get_rg_sprite,
get_rg_widget,
#
get_rg_objectspace,
get_rg_spritespace,
get_rg_widgetspace
};
fun build_new_guipanes' ()
=
{ hostwindows = do_hostwindows new_guipiths;
#
hostwindows;
}
where
fun do_xi_guipane (arg: gt::Xi_Guipane)
=
{ arg -> { id: Id,
guiboss_to_widgetspace_id: Id,
xi_widget: gt::Xi_Widget_Type # The widget (or more commonly, tree of widgets) managed by the gui-tree's toplevel widgetspace-imp.
};
guipane = get_guipane id;
guipane -> { id: Id,
rg_widget: gt::Rg_Widget_Type, # The widget (or more commonly, tree of widgets) managed by the gui-tree's toplevel widgetspace-imp.
guiboss_to_widgetspace: gt::Guiboss_To_Widgetspace,
widget_to_guiboss: gt::Widget_To_Guiboss,
space_to_gui: gt::Space_To_Gui,
hostwindow: gtg::Guiboss_To_Hostwindow, # The hostwindow on which to draw our widgets. This represents the X-server window holding our tree of running guis.
subwindow_info: gt::Subwindow_Data, # The subwindow on which this running gui is drawn -- a sub-rectangle of the hostwindow, except for the root running gui of the popups tree. It hosts the actual backing pixmap on which rg_widget will be drawn first.
needs_layout_and_redraw: Ref( Bool )
}: gt::Guipane;
# fun do_gp_widget (gp_widget: gt::Gp_Widget_Type): gt::Gp_Widget_Type
# =
# case gp_widget
# #
# gt::ROW (arg: gt::Gp_Row)
# =>
# { arg -> (row: List(gt::Gp_Widget_Type));
# #
# row = map do_gp_widget row;
#
# gt::ROW row;
# };
#
# gt::COL (arg: gt::Gp_Col)
# =>
# { arg -> (col: List(gt::Gp_Widget_Type));
# #
# col = map do_gp_widget col;
# #
# gt::COL col;
# };
#
# gt::GRID (arg: gt::Gp_Grid)
# =>
# { arg -> (grid: List(List(gt::Gp_Widget_Type)));
# #
# grid = map do_gp_widgets grid
# where
# fun do_gp_widgets (widgets: List(gt::Gp_Widget_Type))
# =
# map do_gp_widget widgets;
# end ;
#
# arg = grid;
#
# gt::GRID arg;
# };
#
# gt::MARK (arg: gt::Gp_Mark)
# =>
# { arg -> (widget: gt::Gp_Widget_Type);
# #
# widget = do_gp_widget widget;
#
# arg = widget;
#
# gt::MARK arg;
# };
#
# gt::ROW' (arg: gt::Gp_Row')
# =>
# { arg -> ( id: Id,
# widgets: List(gt::Gp_Widget_Type)
# );
# #
# widgets = map do_gp_widget widgets;
#
# arg = (id, widgets);
#
# gt::ROW' arg;
# };
#
# gt::COL' (arg: gt::Gp_Col')
# =>
# { arg -> ( id: Id,
# widgets: List(gt::Gp_Widget_Type)
# );
# #
# widgets = map do_gp_widget widgets;
#
# arg = (id, widgets);
#
# gt::COL' arg;
# };
#
# gt::GRID' (arg: gt::Gp_Grid')
# =>
# { arg -> ( id: Id,
# grid: List(List(gt::Gp_Widget_Type))
# );
# #
# grid = map do_gp_widgets grid
# where
# fun do_gp_widgets (widgets: List(gt::Gp_Widget_Type))
# =
# map do_gp_widget widgets;
# end ;
#
# arg = (id, grid);
#
# gt::GRID' arg;
# };
#
# gt::MARK' (arg: gt::Gp_Mark')
# =>
# { arg -> ( id: Id,
# widget: gt::Gp_Widget_Type
# );
# #
# widget = do_gp_widget widget;
#
# arg = (id, widget);
#
# gt::MARK' arg;
# };
#
# gt::SCROLLPORT (arg: gt::Gp_Scrollport)
# =>
# { arg -> { scroller_callback: gt::Scroller_Callback,
# pixmap_size: g2d::Size, # Size of pixmap visible in scrollport.
# widget: gt::Gp_Widget_Type # Widget-tree providing content visible in scrollport -- will be rendered onto pixmap.
# };
#
# # arg = { scroller_callback,
# # pixmap_size,
# # widget
# # };
#
# gt::SCROLLPORT arg;
# };
#
# gt::TABPORT (arg: gt::Gp_Tabport)
# =>
# { arg -> ( tab_picker_callback: gt::Tab_Picker_Callback,
# tab: gt::Gp_Widget_Type,
# tabs: List( gt::Gp_Widget_Type ) #
# );
#
# tabs = map do_gp_widget (tab ! tabs);
#
# arg = ( tab_picker_callback,
# tab,
# tabs
# );
#
# gt::TABPORT arg;
# };
#
# gt::FRAME (arg: gt::Gp_Frame)
# =>
# { arg -> ( frame_options: List(gt::Frame_Option),
# gp_widget: gt::Gp_Widget_Type
# );
#
# gp_widget = do_gp_widget gp_widget;
#
# arg -> ( frame_options, gp_widget);
#
# gt::FRAME arg;
# };
#
# gt::WIDGET (arg: gt::Gp_Widget)
# =>
# { arg -> (wdget_start_fn: gt::Widget_Start_Fn);
# #
# gt::WIDGET arg;
# };
#
# gt::OBJECTSPACE (arg: gt::Gp_Objectspace)
# =>
# { arg -> ( objectspace_options: List( gt::Objectspace_Option ),
# objects: List( gt::Gp_Object )
# );
#
# arg = ( objectspace_options,
# objects
# );
#
# gt::OBJECTSPACE arg; # Eventually we'll have to do the full subrecursion here but for the moment none of that stuff is really operational.
# };
#
# gt::SPRITESPACE (arg: gt::Gp_Spritespace)
# =>
# { arg -> ( spritespace_options: List( gt::Spritespace_Option ),
# sprites: List( gt::Gp_Sprite )
# );
#
# arg = ( spritespace_options,
# sprites
# );
#
# gt::SPRITESPACE arg; # Eventually we'll have to do the full subrecursion here but for the moment none of that stuff is really operational.
# };
#
# gt::NULL_WIDGET
# =>
# {
# gp_widget;
# };
# esac;
fun do_xi_widget (xi_widget: gt::Xi_Widget_Type)
=
case xi_widget
#
gt::XI_ROW (arg: gt::Xi_Row)
=>
{ arg -> { id, widgets, first_cut };
#
my (widget_layout_hint, site)
=
case (idm::get (rg_rows, id))
#
THE rg_row => (rg_row.widget_layout_hint, rg_row.site);
NULL => (REF gt::default_widget_layout_hint, REF g2d::box::zero); # This allows client code editing a guipith to freely insert new XI_ROW instances, which is a convenience. Since RG_ROWs have no associated imps or important state, this is not a problem.
esac; # (Note that both layout hint and site get recomputed driven by layout hints to the XI_ROW's children, so the values here do not matter.)
widgets = map do_xi_widget widgets;
first_cut = case first_cut # Do a little data validation. We don't want to assign zero pixels to a widget -- it would confuse the user -- so we arbitrarily require a minimum of 5% pixels.
#
NULL => NULL;
THE f => if (f < 0.05) THE 0.05;
elif (f > 0.95) THE 0.95;
else first_cut;
fi;
esac;
arg = { id,
widgets, # The list of widgets to be laid out and displayed in this row.
widget_layout_hint, # Derived ultimately from Rg_Widget layout hints. This gets computed and set in src/lib/x-kit/widget/gui/guiboss-widget-layout.pkg site, # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg first_cut
};
gt::RG_ROW arg;
};
gt::XI_COL (arg: gt::Xi_Col)
=>
{ arg -> { id, widgets, first_cut };
#
my (widget_layout_hint, site)
=
case (idm::get (rg_cols, id))
#
THE rg_col => (rg_col.widget_layout_hint, rg_col.site);
NULL => (REF gt::default_widget_layout_hint, REF g2d::box::zero); # This allows client code editing a guipith to freely insert new XI_COL instances, which is a convenience. Since RG_COLs have no associated imps or important state, this is not a problem.
esac; # (Note that both layout hint and site get recomputed driven by layout hints to the XI_COL's children, so the values here do not matter.)
widgets = map do_xi_widget widgets;
first_cut = case first_cut # Do a little data validation. We don't want to assign zero pixels to a widget -- it would confuse the user -- so we arbitrarily require a minimum of 5% pixels.
#
NULL => NULL;
THE f => if (f < 0.05) THE 0.05;
elif (f > 0.95) THE 0.95;
else first_cut;
fi;
esac;
arg = { id,
widgets, # The list of widgets to be laid out and displayed in this col.
widget_layout_hint, # Derived ultimately from Rg_Widget layout hints. This gets computed and set in src/lib/x-kit/widget/gui/guiboss-widget-layout.pkg site, # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg first_cut
};
gt::RG_COL arg;
};
gt::XI_GRID (arg: gt::Xi_Grid)
=>
{ arg -> { id, widgets };
#
my (widget_layout_hint, site)
=
case (idm::get (rg_grids, id))
#
THE rg_grid => (rg_grid.widget_layout_hint, rg_grid.site);
NULL => (REF gt::default_widget_layout_hint, REF g2d::box::zero); # This allows client code editing a guipith to freely insert new XI_GRID instances, which is a convenience. Since RG_GRIDs have no associated imps or important state, this is not a problem.
esac;
widgets = map do_widgets widgets
where
fun do_widgets (widgets: List(gt::Xi_Widget_Type))
=
map do_xi_widget widgets;
end;
arg = { id,
widgets, # The list of lists of widgets to be laid out and displayed in this grid.
widget_layout_hint, # Derived ultimately from Rg_Widget layout hints. This gets computed and set in src/lib/x-kit/widget/gui/guiboss-widget-layout.pkg site # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg };
gt::RG_GRID arg;
};
gt::XI_MARK (arg: gt::Xi_Mark)
=>
{ arg -> { id, doc, widget };
#
my (widget_layout_hint, site)
=
case (idm::get (rg_marks, id))
#
THE rg_mark => (rg_mark.widget_layout_hint, rg_mark.site);
NULL => (REF gt::default_widget_layout_hint, REF g2d::box::zero); # This allows client code editing a guipith to freely insert new XI_MARK instances, which is a convenience. Since RG_MARKs have no associated imps or important state, this is not a problem.
esac;
widget = do_xi_widget widget;
arg = { id,
doc,
widget, # The widget to be displayed.
widget_layout_hint, # Derived ultimately from Rg_Widget layout hints. This gets computed and set in src/lib/x-kit/widget/gui/guiboss-widget-layout.pkg site # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg };
gt::RG_MARK arg;
};
gt::XI_SCROLLPORT (arg: gt::Xi_Scrollport)
=>
{ arg -> { id: Id,
xi_widget: gt::Xi_Widget_Type # Tree of widgets partially visible in scrollport.
};
rg_scrollport = get_rg_scrollport id;
rg_scrollport -> { id: Id,
upperleft: Ref(g2d::Point), # Upperleft of scrollport's contents in scrollport coordinates, used for scrolling pixmap in scrollport.
scroller: Ref(gt::Scroller), # Client-code interface for controlling 'upperleft' and thus scrolling scrollport contents. This is a ref to resolve mutual recursion issues at creation, not because we expect to update it.
callback: gt::Scroller_Callback, # This is how we pass our Scroller to app client code, which basically lets it set 'upperleft' above.
site: Ref(g2d::Box), # Our scrollport's current assigned site on parent pixmap (NOT 'pixmap'). Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg pixmap: g2p::Gadget_To_Rw_Pixmap, #
#
parent_subwindow_or_view: gt::Subwindow_Or_View, # Used when propagating redraws up the pixmap hierachy. This can be a SCROLLABLE_INFO if we have a scrollport located on a scrollport.
rg_widget => _: Ref( gt::Rg_Widget_Type ) # Widget-tree visible in this viewable, which gets rendered onto 'pixmap' here.
# rg_widget is a Ref not because we intend to change it, but to work around a technical difficulty in guiboss-imp.pkg:do_pg_widget:PG_SCROLLPORT where rg_scrollport and rg_widget each want to be created first.
};
rg_widget = do_xi_widget xi_widget;
arg = { id,
upperleft,
scroller,
callback,
site,
pixmap,
parent_subwindow_or_view, #
rg_widget => REF rg_widget
};
gt::RG_SCROLLPORT arg;
};
gt::XI_TABPORT (arg: gt::Xi_Tabport)
=>
{ arg -> { id: Id,
widgets: List( gt::Xi_Widget_Type )
};
rg_tabport = get_rg_tabport id;
rg_tabport -> { id: Id,
visible_tab: Ref ( Int ), # Which of 'tabs' is currently visible? This refcell references one element from 'tabs'; it supports switching between the tabbed views.
callback: gt::Tab_Picker_Callback, # This is how we pass our Tab_Picker to app client code, which basically lets it set 'visible_tab' above.
tabs: List( gt::Tabbable_Info ), # This record holds one of the alternate views which may be made visible in the scrollport. *** WE REQUIRE AT LEAST ONE ENTRY IN THE LIST! ***
site: Ref(g2d::Box) # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg # NOTE: We specifically depend on tab.site == rg_tabport.site for all tabs (i.e., all point to the same refcell).
}: gt::Rg_Tabport;
widgets = map do_xi_widget widgets;
widget_count = list::length widgets;
tab_count = list::length tabs;
tabs = if (tab_count == widget_count)
#
do_tabs (tabs, widgets, [])
where
fun do_tabs (tab ! tabs, rg_widget ! widgets, result_so_far)
=>
{ tab -> { rg_widget => _, # We replace this entry, keep everything else.
pixmap,
parent_subwindow_or_view,
site,
is_visible
}: gt::Tabbable_Info;
tab = { rg_widget, # Note (possibly) new widget-tree for this tab.
pixmap,
parent_subwindow_or_view,
site,
is_visible
};
do_tabs (tabs, widgets, tab ! result_so_far);
};
do_tabs ([], [], result)
=>
reverse result;
do_tabs _ => raise exception DIE "impossible"; # We know tabcount==widget_count, so we cannot get here.
end;
end;
else
msg = sprintf "May not change number of tabs in tabport! Was %d, now %d -- build_new_guipanes in translate-guipane-to-guipith.pkg" tab_count widget_count; # This restriction is purely from implementation laziness. We'll presumably allow it eventually.
log::fatal msg;
raise exception DIE msg;
fi;
visible_tab := if (*visible_tab >= tab_count) 0; # Make sure visible_tab has a sane value. This is a given now,
else *visible_tab; # But eventually we'll probably allow changing the number of tabs, and then this will be needed.
fi;
arg = { id,
visible_tab,
callback,
tabs,
site
};
gt::RG_TABPORT arg;
};
gt::XI_FRAME (arg: gt::Xi_Frame)
=>
{ arg -> { id: Id,
frame_widget: gt::Xi_Widget_Type, # Widget which will draw the frame surround.
widget: gt::Xi_Widget_Type # Widget-tree to draw surrounded by frame.
};
rg_frame = get_rg_frame id;
rg_frame -> { id: Id,
widget_layout_hint: Ref( gt::Widget_Layout_Hint ),
site: Ref(g2d::Box), # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg frame_widget => _: gt::Rg_Widget_Type, # Widget which will draw the frame surround.
widget => _: gt::Rg_Widget_Type # Widget-tree to draw surrounded by frame.
}: gt::Rg_Frame;
frame_widget = do_xi_widget frame_widget;
widget = do_xi_widget widget;
arg = { id,
widget_layout_hint,
site,
frame_widget,
widget
};
gt::RG_FRAME arg;
};
gt::XI_WIDGET (arg: gt::Xi_Widget)
=>
{ arg -> { widget_id: Id,
widget_layout_hint: gt::Widget_Layout_Hint,
doc: String
};
# nb {. sprintf "build_new_guipanes/do_xi_widget/gt::XI_WIDGET/ above get_rg_widget call widget_id=%d doc='%s' -- translate-guipane-to-guipith.pkg" (id_to_int widget_id) doc; };
rg_widget = get_rg_widget widget_id;
# nb {. sprintf "build_new_guipanes/do_xi_widget/gt::XI_WIDGET/ below get_rg_widget call widget_id=%d doc='%s' -- translate-guipane-to-guipith.pkg" (id_to_int widget_id) doc; };
rg_widget -> { # We don't need an 'id' field here because guiboss_to_widget.id serves the purpose.
guiboss_to_widget: gt::Guiboss_To_Widget, # The command end of a port for communication to a widget-imp from a src/lib/x-kit/widget/gui/guiboss-imp.pkg shutdown_oneshot: Oneshot_Maildrop( Void ), # The widget-imp will fire this when shutting down due to die() call. Used by guiboss-imp to detect when all widgets in a GUI have cleanly shut down.
site: Ref(g2d::Box) # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg }: gt::Rg_Widget;
arg = { guiboss_to_widget,
shutdown_oneshot,
site
};
# id = id_to_int widget_id;
me.widget_layout_hints := idm::set (*me.widget_layout_hints, widget_id, widget_layout_hint);
gt::RG_WIDGET arg;
};
gt::XI_OBJECTSPACE (arg: gt::Xi_Objectspace)
=>
{ arg -> { guiboss_to_objectspace_id: Id,
xi_objects: List(gt::Xi_Object)
};
rg_objectspace = get_rg_objectspace guiboss_to_objectspace_id;
rg_objectspace -> { # We don't need an 'id' field here because guiboss_to_objectspace.id serves the purpose.
guiboss_to_objectspace: gt::Guiboss_To_Objectspace,
object_to_objectspace: o2c::Object_To_Objectspace, #
objects: List( gt::Rg_Object_Type ), # The list of objects to be drawn. These can be placed arbitrarily, including possible overlaps.
site: Ref(g2d::Box) # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg }: gt::Rg_Objectspace;
arg = { guiboss_to_objectspace,
object_to_objectspace,
# XXX SUCKO FIXME Eventually we need to be processing 'objects' recursively.
objects,
site
};
gt::RG_OBJECTSPACE arg; # Eventually we'll have to do the full subrecursion here but for the moment none of that stuff is really operational.
};
gt::XI_SPRITESPACE (arg: gt::Xi_Spritespace)
=>
{ arg -> { guiboss_to_spritespace_id: Id,
xi_sprites: List(gt::Xi_Sprite)
};
rg_spritespace = get_rg_spritespace guiboss_to_spritespace_id;
rg_spritespace -> { # We don't need an 'id' field here because guiboss_to_spritespace.id serves the purpose.
guiboss_to_spritespace: gt::Guiboss_To_Spritespace,
sprite_to_spritespace: s2b::Sprite_To_Spritespace, #
sprites: List( gt::Rg_Sprite_Type ), # The list of widgets to be drawn on the spritespace. These can be placed arbitrarily.
site: Ref(g2d::Box) # Current assigned site on pixmap. Set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg }: gt::Rg_Spritespace;
arg = { guiboss_to_spritespace,
sprite_to_spritespace,
# XXX SUCKO FIXME Eventually we need to be processing 'sprites' recursively.
sprites,
site
};
gt::RG_SPRITESPACE arg; # Eventually we'll have to do the full subrecursion here but for the moment none of that stuff is really operational.
};
gt::XI_NULL_WIDGET
=>
{
gt::RG_NULL_WIDGET;
};
gt::XI_GUIPLAN (arg: gt::Guiplan) # This is the (only) way to add new widgets to running guis via Gadget_To_Guiboss.install_updated_guipiths.
=> # The idea is to embed a mini-Guiplan in the Guipith, to be started up by re-using as much as possible of the regular Guiplan startup logic.
{ arg -> (gp_widget: gt::Gp_Widget_Type);
#
(make_run_gun ()) -> { run_gun', fire_run_gun }; # Run gun to start up widgets. We don't use an end_gun with them because they wander between guipane instances which start/stop independently, so it would be a mess.
my (rg_widget, { guiboss_to_widgetspace, shutdown_oneshot })
=
(gtr::gp_widget__to__rg_widget #
{
gp_widget,
widgetspace_arg => [],
run_gun',
subwindow_info,
me,
widget_to_guiboss,
gadget_to_guiboss => widget_to_guiboss.g,
guiboss_to_guishim,
hostwindow_for_gui => hostwindow,
space_to_gui,
clear_box_in_pixmap,
update_offscreen_parent_pixmaps_and_then_hostwindow
}
);
fire_run_gun ();
rg_widget;
};
esac;
rg_widget = do_xi_widget xi_widget;
result = { id,
rg_widget,
guiboss_to_widgetspace,
widget_to_guiboss,
space_to_gui,
hostwindow,
subwindow_info,
needs_layout_and_redraw
};
result;
};
fun do_xi_subwindow_info (arg: gt::Xi_Subwindow_Info): gt::Subwindow_Info
=
{ arg -> { id: Id, # From (*Subwindow_Info.pixmap).id
guipane: Null_Or( gt::Xi_Guipane ),
popups: List(gt::Xi_Subwindow_Data) #
};
guipane' = case guipane
#
THE guipane => THE (do_xi_guipane guipane);
NULL => NULL;
esac;
popups' = map do_info popups
where
fun do_info (gt::XI_SUBWINDOW_DATA xi_subwindow_info)
=
gt::SUBWINDOW_DATA (do_xi_subwindow_info xi_subwindow_info);
end;
subwindow_info
=
get_subwindow_info id;
subwindow_info -> { id: Id,
pixmap: Ref( g2p::Gadget_To_Rw_Pixmap ), # Main backing store for this running gui.
popups: Ref(List(gt::Subwindow_Data)), # These will all be SUBWINDOW_INFO, so 'Ref(List(Subwindow_Info))' would be a better type here.
parent: Null_Or( gt::Subwindow_Data ), # For popups this points to the parent; for the original non-popup window it is NULL.
stacking_order: Int, # Assigned in increasing order starting at 1; these determine who overlies who visually on the screen in case of overlaps. (Popups must be entirely within parent, but sibling popups can overlap.)
upperleft: Ref(g2d::Point), # If we have a parent, this gives our location on it. Note that pixmap.size gives our size.
guipane: Ref( Null_Or( gt::Guipane ) )
}: gt::Subwindow_Info;
guipane := guipane';
popups := popups' ;
result = { id,
pixmap,
popups,
parent,
stacking_order,
upperleft,
guipane
};
result;
};
fun do_hostwindows (hostwindows: idm::Map( gt::Xi_Hostwindow_Info ))
=
{ apply do_hostwindow (idm::keyvals_list hostwindows);
#
*result;
}
where
result = REF (idm::empty: idm::Map( gt::Hostwindow_Info ));
#
fun do_hostwindow
(
id': Id,
arg: gt::Xi_Hostwindow_Info
)
=
{ arg -> { id: Id, # From hostwindow_info.guiboss_to_hostwindow.id
subwindow_info: Null_Or( gt::Xi_Subwindow_Data )
};
hostwindow_info
=
case (idm::get (*me.hostwindows, id))
#
THE ti => ti;
NULL => { msg = sprintf "Xi__Hostwindow_Info.id = %d not found in hostwindows -- do_hostwindows() in translate-guipane-to-guipith.pkg" (id_to_int id);
log::fatal msg;
raise exception DIE msg;
};
esac;
hostwindow_info
->
{ guiboss_to_hostwindow: gtg::Guiboss_To_Hostwindow,
current_frame_number: Ref(Int), # We count frames for convenience of widgets and debugging.
seconds_per_frame: Ref(Float), # Primarily so widgets can do motion blurring if they wish.
done_extra_redraw_request_this_frame: Ref(Bool), # See Note[3].
next_stacking_order: Ref(Int), # Next Subwindow_Or_View.stacking_order value to issue.
# The remainder are valid only while a gui is running,
# which is to say, between start_gui' and kill_gui'.
subwindow_info => _
};
subwindow_info
=
case subwindow_info
#
THE (gt::XI_SUBWINDOW_DATA xi_subwindow_info)
=>
THE (gt::SUBWINDOW_DATA (do_xi_subwindow_info xi_subwindow_info)); # <===
NULL => NULL;
esac;
hostwindow_info
=
{ guiboss_to_hostwindow,
current_frame_number => REF (*current_frame_number), # For now at least I'm creating fresh refcells to minimize sharing between old and new trees to give a maximally functional flavor.
seconds_per_frame => REF (*seconds_per_frame),
done_extra_redraw_request_this_frame => REF (*done_extra_redraw_request_this_frame),
next_stacking_order => REF (*next_stacking_order),
subwindow_info => REF subwindow_info
};
result := idm::set (*result, id', hostwindow_info);
};
end; # fun do_hostwindows
end; # fun build_new_guipanes'
end; # fun build_new_guipanes
end; # fun guipanes_to_guipiths
}; # package translate_guipane_to_guipith
end;
##########################################################################
# Note[1]
#
# The basic Client_To_Guiboss.start_gui() facility provides a simple # Client_To_Guiboss is from src/lib/x-kit/widget/gui/guiboss-imp.pkg# way to start up a running GUI sub/application from a reasonably
# concise Guiplan specification.
#
# What it does not provide is a way to morph that GUI while it is running.
#
# The export/import facility implemented here is intended to provide a
# a way to implement limited but useful topological changes in a running
# gui in a clean, safe, client-friendly fashion.
#
# The motivating example is an emacs-style editor wanting to add an
# additional edit pane. (C-x 2 or C-x 3 functionality.)
#
# The design idea is to allow client code to ask for an abstracted
# Xi_Widget_Type of guiboss_imp's current Guipane datastructure, # Guipane is from src/lib/x-kit/widget/gui/guiboss-types.pkg# edit it, then submit the edited version to guiboss_imp to be
# expanded into a full Guipane to replace the previous one.
#
# The intended advantages of this approach are:
#
# o The abstracted Xi_Widget_Type version will be stripped of all mutable
# values of interest to guiboss_imp, eliminating risk of client code
# doing weird things to guiboss_imp's state behind its back, producing
# hard-to-debug problems.
#
# o The abstracted Xi_Widget_Type version will be easier for client code
# to process, and less likely to change (breaking client code) than
# the full Guipane datastructure.
#
# o The client-code rewrites of the Xi_Widget_Type version will meet all
# anticipated client needs for moving widgets around on a pane,
# without allowing topological changes in the current popup-window
# hierarchy which would introduce additional implementation difficulty
# no good purpose.
#
# o The Xi_Widget_Type version allows introducing new gadgets into the running
# GUI via an escape mechanism (Xi_Widget_Type.XI_GUIPLAN) allowing inclusion
# of raw Guiplan nodes or subtrees.
#
# o Widgets can be deleted from the running gui just by eliding them from
# the Xi_Widget_Type tree before returning the result to guiboss_imp.
#
# o The export-import sequence provides guiboss_imp the opportunity to
# thoroughly validate the replacement Xi_Widget_Type tree before installing
# it as the replacement running gui.