## guiboss-imp.pkg
#
# For the big picture see the imp dataflow diagrams in
#
# src/lib/x-kit/xclient/src/window/xclient-ximps.pkg#
# The vision here is to implement a simple, flexible, easy-to-customize
# GUI widget infrastructure portable to various rendering layers like
# X, OpenGL and javascript. The allow small teams to efficiently develop
# (for example) GUI-driven custom scientific, stock-trading and programming
# support apps. As such, the emphasis is on simplicity, portability,
# cleanliness, smooth integration with Mythryl facilities such as the
# type system, garbage collector and package system. Competing with
# commercial GUI toolkits for glitter factor is NOT a priority.
#
# guiboss_imp is the master imp responsible for starting up and shutting
# down running GUIs.
#
# Most of its major types and supporting code for handling them is in
# src/lib/x-kit/widget/gui/guiboss-types.pkg#
# guiboss_imp GUIs divide into three types of spaces:
# widgetspace, for conventional row/column widget layout.
# objectspace, for draw and paint functionality and also
# free-form drop-and-drag knob-and-tube GUIs.
# spritespace, for 2D (and eventually 3D) animation.
#
# At the moment (2014-11-20) only widgetspace is at all well developed.
#
# guiboss_imp delegates management of these three kinds of spaces
# (in particular widget layout) to
# src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg# src/lib/x-kit/widget/space/sprite/spritespace-imp.pkg# src/lib/x-kit/widget/space/object/objectspace-imp.pkg#
# guiboss_imp is designed to be portable, but at the moment the only
# rendering layer implemented is for X, using the interface exported by
# src/lib/x-kit/widget/xkit/app/guishim-imp-for-x.pkg#
# We refer to mouse-sensitive controls as "gadgets".
# Each of our three spaces has its own flavor of gadget:
# widgetspace: Widgets, base implementation being src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg# objectsapce: Objects, base implementation being src/lib/x-kit/widget/xkit/theme/widget/default/look/object-imp.pkg# spritespace: Sprites, base implementation being src/lib/x-kit/widget/xkit/theme/widget/default/look/sprite-imp.pkg#
# 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 #
# package ap = client_to_atom; # client_to_atom is from src/lib/x-kit/xclient/src/iccc/client-to-atom.pkg# package au = authentication; # authentication is from src/lib/x-kit/xclient/src/stuff/authentication.pkg# package cpm = cs_pixmap; # cs_pixmap is from src/lib/x-kit/xclient/src/window/cs-pixmap.pkg# package cpt = cs_pixmat; # cs_pixmat is from src/lib/x-kit/xclient/src/window/cs-pixmat.pkg# package dy = display; # display is from src/lib/x-kit/xclient/src/wire/display.pkg# package fil = file__premicrothread; # file__premicrothread is from src/lib/std/src/posix/file--premicrothread.pkg# package fti = font_index; # font_index is from src/lib/x-kit/xclient/src/window/font-index.pkg# package r2k = xevent_router_to_keymap; # xevent_router_to_keymap is from src/lib/x-kit/xclient/src/window/xevent-router-to-keymap.pkg# package mtx = rw_matrix; # rw_matrix is from src/lib/std/src/rw-matrix.pkg# package rop = ro_pixmap; # ro_pixmap is from src/lib/x-kit/xclient/src/window/ro-pixmap.pkg# package rw = root_window; # root_window is from src/lib/x-kit/widget/lib/root-window.pkg# package rwv = rw_vector; # rw_vector is from src/lib/std/src/rw-vector.pkg# package sep = client_to_selection; # client_to_selection is from src/lib/x-kit/xclient/src/window/client-to-selection.pkg# package shp = shade; # shade is from src/lib/x-kit/widget/lib/shade.pkg# package sj = socket_junk; # socket_junk is from src/lib/internet/socket-junk.pkg# package x2s = xclient_to_sequencer; # xclient_to_sequencer is from src/lib/x-kit/xclient/src/wire/xclient-to-sequencer.pkg# package tr = logger; # logger is from src/lib/src/lib/thread-kit/src/lib/logger.pkg# package tsr = thread_scheduler_is_running; # thread_scheduler_is_running is from src/lib/src/lib/thread-kit/src/core-thread-kit/thread-scheduler-is-running.pkg# package u1 = one_byte_unt; # one_byte_unt is from src/lib/std/one-byte-unt.pkg# package v1u = vector_of_one_byte_unts; # vector_of_one_byte_unts is from src/lib/std/src/vector-of-one-byte-unts.pkg# package v2w = value_to_wire; # value_to_wire is from src/lib/x-kit/xclient/src/wire/value-to-wire.pkg# package wg = widget; # widget is from src/lib/x-kit/widget/old/basic/widget.pkg# package wi = window; # window is from src/lib/x-kit/xclient/src/window/window.pkg# package wme = window_map_event_sink; # window_map_event_sink is from src/lib/x-kit/xclient/src/window/window-map-event-sink.pkg# package wpp = client_to_window_watcher; # client_to_window_watcher is from src/lib/x-kit/xclient/src/window/client-to-window-watcher.pkg# package wy = widget_style; # widget_style is from src/lib/x-kit/widget/lib/widget-style.pkg# package xc = xclient; # xclient is from src/lib/x-kit/xclient/xclient.pkg# package xj = xsession_junk; # xsession_junk is from src/lib/x-kit/xclient/src/window/xsession-junk.pkg# package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.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 rtx = translate_guipane_to_guipith; # translate_guipane_to_guipith is from src/lib/x-kit/widget/gui/translate-guipane-to-guipith.pkg package ged = guiboss_event_dispatch; # guiboss_event_dispatch is from src/lib/x-kit/widget/gui/guiboss-event-dispatch.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 gtj = guiboss_types_junk; # guiboss_types_junk is from src/lib/x-kit/widget/gui/guiboss-types-junk.pkg package gpj = guiboss_popup_junk; # guiboss_popup_junk is from src/lib/x-kit/widget/gui/guiboss-popup-junk.pkg package gwl = guiboss_widget_layout; # guiboss_widget_layout is from src/lib/x-kit/widget/gui/guiboss-widget-layout.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 gd = gui_displaylist; # gui_displaylist is from src/lib/x-kit/widget/theme/gui-displaylist.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 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 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 sm = string_map; # string_map is from src/lib/src/string-map.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 mbi = 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 package g2c = guiboss_to_compileimp; # guiboss_to_compileimp is from src/lib/x-kit/widget/edit/guiboss-to-compileimp.pkg package a2c = app_to_compileimp; # app_to_compileimp is from src/lib/x-kit/widget/edit/app-to-compileimp.pkg package ci = compile_imp; # compile_imp is from src/lib/x-kit/widget/edit/compile-imp.pkg# package tbi = textmill; # textmill is from src/lib/x-kit/widget/edit/textmill.pkg tracefile = "widget-unit-test.trace.log";
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
package guiboss_imp
: Guiboss_Imp # Guiboss_Imp is from src/lib/x-kit/widget/gui/guiboss-imp.api {
Client_To_Guiboss # The 'client' is the microthread starting up guiboss, who will typically then just do block_until_mailop_fires client_to_guiboss.guiboss_done'; -- see e.g. src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg =
{ id: Id, # Unique id to facilitate storing guiboss instances in indexed datastructures like red-black trees.
#
get_sprite_theme: Void -> bt::Gui_To_Sprite_Theme,
get_object_theme: Void -> ct::Gui_To_Object_Theme,
get_widget_theme: Void -> wt::Widget_Theme,
#
make_hostwindow: gtg::Hostwindow_Hints -> gtg::Guiboss_To_Hostwindow, #
#
start_gui: (gtg::Guiboss_To_Hostwindow, gt::Guiplan) -> (Void -> gt::Client_To_Guiwindow), # Calling return value will block microthread until gui-plan startup is complete.
#
guiboss_done': End_Gun # Something to block on in src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg };
Guiboss_Option
#
= MICROTHREAD_NAME String #
| ID Id # Stable, unique id for imp.
;
Guiboss_Arg = List(Guiboss_Option); # Currently no required component.
Imports = { # Ports we use, provided by other imps.
int_sink: Int -> Void,
guiboss_to_guishim: gtg::Guiboss_To_Guishim,
gui_to_sprite_theme: bt::Gui_To_Sprite_Theme,
gui_to_object_theme: ct::Gui_To_Object_Theme,
theme: wt::Widget_Theme
};
Me_Slot = Mailslot( { imports: Imports,
me: gt::Guiboss_State,
guiboss_arg: Guiboss_Arg,
run_gun': Run_Gun,
end_gun': End_Gun
}
);
Exports = { # Ports we provide for use by other imps.
client_to_guiboss: Client_To_Guiboss
};
Guiboss_Egg = Void -> (Exports, (Imports, Run_Gun, End_Gun) -> Void);
Runstate = { # These values will be statically globally visible throughout the code body for the imp.
id: Id,
me: gt::Guiboss_State, #
guiboss_arg: Guiboss_Arg,
imports: Imports, # Imps to which we send requests.
guiboss_to_millboss: mbi::Guiboss_To_Millboss,
guiboss_to_compileimp: g2c::Guiboss_To_Compileimp,
app_to_compileimp: a2c::App_To_Compileimp,
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, # We shut down the microthread when this fires.
fire__guiboss_done: Void -> Void # Fire Client_To_Guiboss.guiboss_done' mailop. Callers block on this, e.g. src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg };
Guiboss_Q = Mailqueue( Runstate -> Void );
Globals = Ref( sm::Map(Crypt) );
globals__global = (REF sm::empty): Globals; # For Gadget_To_Guiboss.note_global, .find_global and .drop_global. Holds global values whose types we don't want to import into guiboss_imp.
# Putting it here (instead of in gt::Guiboss_State) lets find_global() run in client microthread, reducing risk of deadlock.
fun shut_down_guiboss' (runstate: Runstate)
=
{ runstate.fire__guiboss_done ();
#
thread_exit { success => TRUE }; # Will not return.
};
fun run ( guiboss_q: Guiboss_Q, #
#
runstate as
{ # These values will be statically globally visible throughout the code body for the imp.
id: Id,
me: gt::Guiboss_State, #
guiboss_arg: Guiboss_Arg,
imports: Imports, # Imps to which we send requests.
guiboss_to_millboss: mbi::Guiboss_To_Millboss,
guiboss_to_compileimp: g2c::Guiboss_To_Compileimp,
app_to_compileimp: a2c::App_To_Compileimp,
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, #
fire__guiboss_done: Void -> Void # Fire Client_To_Guiboss.guiboss_done' mailop. Callers block on this, e.g. src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg }
)
=
{ loop ();
}
where
#
fun loop () # Outer loop for the imp.
=
{ do_one_mailop' to [
#
end_gun' ==> shut_down_guiboss_imp',
take_from_mailqueue' guiboss_q ==> do_guiboss_plea
];
loop ();
}
where
fun do_guiboss_plea thunk
=
thunk runstate;
#
fun shut_down_guiboss_imp' ()
=
shut_down_guiboss' runstate;
end;
end;
#
fun kill_gui'
(
runstate as
{ id: Id,
me: gt::Guiboss_State, #
guiboss_arg: Guiboss_Arg,
imports: Imports, # Imps to which we send requests.
guiboss_to_millboss: mbi::Guiboss_To_Millboss,
guiboss_to_compileimp: g2c::Guiboss_To_Compileimp,
app_to_compileimp: a2c::App_To_Compileimp,
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, #
fire__guiboss_done: Void -> Void # Fire Client_To_Guiboss.guiboss_done' mailop. Callers block on this, e.g. src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg }: Runstate,
( guipane: gt::Guipane,
hostwindow_info: gt::Hostwindow_Info,
redraw_window_when_done: Bool
)
)
=
{ # Recursively kill off all running guis
# which are children of current running gui:
#
case guipane.subwindow_info
#
gt::SUBWINDOW_DATA r
=>
apply kill_one_subgui *r.popups
where
fun kill_one_subgui (subwindow_info: gt::Subwindow_Data)
=
case subwindow_info
#
gt::SUBWINDOW_DATA r
=>
case *r.guipane
#
THE guipane => kill_gui' (runstate, (guipane, hostwindow_info, FALSE));
NULL => ();
esac;
esac;
end;
esac;
gpj::kill__guipane__imps (guipane, me);
gpj::free__guipane__resources (guipane, me);
case guipane.subwindow_info
#
gt::SUBWINDOW_DATA r
=>
{ # If we have a parent, remove ourself from parent's list of active popups:
#
case r.parent
#
THE parent_subwindow_info
=>
# We do have a parent -- remove ourself from parent's list of active popups:
#
case parent_subwindow_info
#
gt::SUBWINDOW_DATA q
=>
q.popups := list::remove is_us *q.popups
where
fun is_us (bp: gt::Subwindow_Data)
=
case bp
#
gt::SUBWINDOW_DATA r'
=>
same_id ((*r.pixmap).id, (*r'.pixmap).id);
esac;
end;
esac;
NULL => ();
esac;
};
esac;
case guipane.subwindow_info # If we're the toplevel gui, remember we no longer have a gui running on this hostwindow.
#
gt::SUBWINDOW_DATA r
=>
case r.parent
#
NULL => hostwindow_info.subwindow_info := NULL; # We're killing the toplevel gui for this hostwindow so remember that we no longer have a gui running on this hostwindow.
THE _ => (); # We're pausing a secondary popup gui for this hostwindow.
esac;
esac;
case *hostwindow_info.subwindow_info # Redraw the window if there are any running guis left to redraw.
#
THE subwindow_info
=>
{
gwl::redraw_all_guipanes
(
subwindow_info, # This provides redraw_all_guipanes an entrypoint into the remaining Subwindow_Or_View tree. Any Subwindow_Or_View in the tree would do.
hostwindow_info.guiboss_to_hostwindow
);
};
NULL => # No running guis left on window so clear it to black.
case guipane.subwindow_info
#
gt::SUBWINDOW_DATA r
=>
{ entire_window = g2d::box::make (g2d::point::zero, (*r.pixmap).size);
#
midpoint = g2d::box::midpoint entire_window;
text = [ gd::PUT_TEXT (gd::CENTERED_ON_POINT, [ gd::TEXT (midpoint, "No GUI running.") ]) ];
text = [ gd::FONT ([ "-*-courier-bold-r-*-*-20-*-*-*-*-*-*-*", "9x15" ], text) ];
hostwindow_info.guiboss_to_hostwindow.draw_displaylist
[
gd::COLOR (r64::black, [ gd::FILLED_BOXES [ entire_window ]] ),
gd::COLOR (r64::white, text)
];
};
esac;
esac;
};
fun position_subwindow_entirely_within_parent # Do nothing unless required, change only upperleft if possible, change size only as a last resort.
{ #
parent_size: g2d::Size, # Parent upperleft is { row => 0, col => 0 } for our purposes here -- i.e., we're working in parent window coordinate system.
old_upperleft: g2d::Point, # In parent coordinates.
old_size: g2d::Size
}
=
{ old_upperleft -> { row, col };
old_size -> { high, wide };
row = max (row, 0); # Let's start by ensuring that popup upperleft is not left of or above origin of parent coordinate system..
col = max (col, 0); #
high = max (high, 1); # Next let's make sure the requested size is positive...
wide = max (wide, 1); #
high = min (high, parent_size.high); # Now let's ensure that popup can in fact fit within parent.
wide = min (wide, parent_size.wide); #
row = min (row, parent_size.high - high); # Now slide the popup left and/or up as necessary to make it actually fit within parent.
col = min (col, parent_size.wide - wide); #
{ new_upperleft => { row, col },
new_size => { high, wide } # That should do it!
};
};
fun size_subwindow_entirely_within_parent # Do nothing unless required, change only size if reasonable, change upperleft only as a last resort.
{ #
parent_size: g2d::Size, # Parent upperleft is { row => 0, col => 0 } for our purposes here -- i.e., we're working in parent window coordinate system.
old_upperleft: g2d::Point, # In parent coordinates.
old_size: g2d::Size
}
=
{
old_upperleft -> { row, col };
old_size -> { high, wide };
parent_size -> { high => mom_high, wide => mom_wide };
row = min (row, mom_high - 20); # First let's ensure that popup upperleft is not right of or below parent window.
col = min (col, mom_wide - 20); #
row = max (row, 0); # Now let's ensure that popup upperleft is not left of or above origin of parent coordinate system..
col = max (col, 0); #
high = max (high, 1); # Next let's make sure the requested size is positive...
wide = max (wide, 1); #
high = min (high, mom_high - row); # Now shrink the popup as necessary to make it actually fit within parent.
wide = min (wide, mom_wide - col); #
{ new_upperleft => { row, col },
new_size => { high, wide } # That should do it!
};
};
fun make_subwindow_info_for_popup # Create a g2p::Gadget_To_Rw_Pixmap instance, wrap it in a gt::SUBWINDOW_INFO, and enter the latter into the tree of SUBWINDOW_INFO.
(
make_rw_pixmap: g2d::Size -> g2p::Gadget_To_Rw_Pixmap,
next_stacking_order: Ref(Int),
parent: gt::Subwindow_Data,
site: g2d::Box
)
=
{ p = case parent gt::SUBWINDOW_DATA p => p;
esac;
(g2d::box::upperleft_and_size site)
->
( old_upperleft as { row, col },
old_size as { high, wide }
);
parent_size = (*p.pixmap).size;
my { new_upperleft, new_size } # Select actual site for popup. We need it to fit entirely within parent.
=
position_subwindow_entirely_within_parent
{
parent_size,
old_upperleft,
old_size
};
pixmap = make_rw_pixmap new_size; # We're blocking for a round-trip here, which is not great. We probably should implement imports.guiboss_to_guishim.pass_fresh_rw_pixmap to allow this to be nonblocking. XXX SUCKO FIXME
stacking_order = *next_stacking_order;
#
next_stacking_order := stacking_order + 1;
new_subwindow_info
=
gt::SUBWINDOW_DATA
{ id => issue_unique_id (),
guipane => REF NULL,
pixmap => REF pixmap, # Main backing store for this running gui.
popups => REF ([]: List( gt::Subwindow_Data)),
parent => THE parent,
upperleft => REF new_upperleft,
#
stacking_order
};
p.popups := new_subwindow_info ! *p.popups; # Remember that parent subwindow has a new child subwindow.
site = g2d::box::make (new_upperleft, new_size);
(site, new_subwindow_info);
};
fun start_gui'
(
( runstate
as
{ id: Id,
me: gt::Guiboss_State, #
guiboss_arg: Guiboss_Arg,
imports: Imports, # Imps to which we send requests.
guiboss_to_millboss: mbi::Guiboss_To_Millboss,
guiboss_to_compileimp: g2c::Guiboss_To_Compileimp,
app_to_compileimp: a2c::App_To_Compileimp,
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
end_gun': End_Gun, # We shut down the guiboss microthread when end_gun' fires.
fire__guiboss_done: Void -> Void # Fire Client_To_Guiboss.guiboss_done' mailop. Callers block on this, e.g. src/lib/x-kit/widget/gui/run-guiplan-on-x.pkg }
): Runstate,
#
hostwindow_for_gui: gtg::Guiboss_To_Hostwindow,
subwindow_info: gt::Subwindow_Data,
guiplan: gt::Guiplan,
gui_startup_complete': Oneshot_Maildrop( gt::Client_To_Guiwindow ),
guiboss_q: Guiboss_Q,
kill_gui: (gt::Guipane, gt::Hostwindow_Info) -> Void
)
=
{
case subwindow_info
#
gt::SUBWINDOW_DATA r
=> # guipane is from
{ r.guipane := THE guipane; #
# # below 'where' clause. so as to be available in make_popup().
case r.parent
#
NULL => hostwindow_info.subwindow_info := THE subwindow_info; # We're starting a toplevel gui for this hostwindow so remember that we now have a gui running on this hostwindow.
THE _ => (); # We're starting a secondary popup gui for this hostwindow.
esac;
};
esac;
fire_run_gun ();
window_site = hostwindow_for_gui.get_window_site ();
resite_and_redraw (me, window_site, subwindow_info, guipane, hostwindow_info);
client_to_guiwindow
=
{ id => issue_unique_id (),
kill_gui => {. kill_gui (guipane, hostwindow_info); }
}
: gt::Client_To_Guiwindow
;
put_in_oneshot (gui_startup_complete', client_to_guiwindow);
}
where
we_are_a_popup_gui
=
case subwindow_info
#
gt::SUBWINDOW_DATA r
=>
{ case r.parent
#
NULL => FALSE; # We're starting the primary (toplevel) gui for this hostwindow.
THE _ => TRUE; # We're starting a secondary popup gui for this hostwindow.
esac;
};
esac;
(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.
hostwindow_info = idm::get_or_raise_exception_not_found (*me.hostwindows, hostwindow_for_gui.id)
except
NOT_FOUND = { printf "*me.hostwindows contains no entry for hostwindow %d?! -- restart_gui' in guiboss-imp.pkg\n" (id_to_int hostwindow_for_gui.id);
log::fatal (sprintf "*me.hostwindows contains no entry for hostwindow %d?! -- restart_gui' in guiboss-imp.pkg" (id_to_int hostwindow_for_gui.id));
raise exception NOT_FOUND; # Execution will never reach this point, but the compiler doesn't know that log::fatal doesn't return.
};
current_frame_number = hostwindow_info.current_frame_number;
seconds_per_frame = hostwindow_info.seconds_per_frame;
done_extra_redraw_request_this_frame
= hostwindow_info.done_extra_redraw_request_this_frame;
# We expect the following fns to capture the above values:
# that is why we define them here rather than more globally.
#
fun set__needs_redraw_request__flag (i: gt::Gadget_Imp_Info)
=
{
i.needs_redraw_request := TRUE;
};
#################################################################################
# space_to_gui interface fns:
fun note_widget_site'
{
id: Id,
subwindow_or_view: gt::Subwindow_Or_View, # A widget can be located either directly on a subwindow, or via a scrollport (which is ultimately visible on a subwindow, possibly via aother scrollports).
site: g2d::Box,
me: gt::Guiboss_State
} # PUBLIC.
=
{
case (idm::get (*me.gadget_imps, id))
#
THE i => { if (site != *i.site # Has the window site of this widget changed?
or (not (same_id ( gtj::subwindow_or_view_id_of subwindow_or_view,
gtj::subwindow_or_view_id_of *i.subwindow_or_view
) ) ) )
# # Yes.
i.site := site; # Note site for widget.
i.subwindow_or_view := subwindow_or_view; # Note pixmap for widget.
set__needs_redraw_request__flag i;
fi;
};
NULL => (); # We'll assume this was from a queued (stale) message from a now-dead widget, and silently ignore it.
esac;
};
#
fun note_widget_site # PUBLIC.
{
id: Id,
subwindow_or_view: gt::Subwindow_Or_View, # A widget can be located either directly on a subwindow, or via a scrollport (which is ultimately visible on a subwindow, possibly via aother scrollports).
site: g2d::Box
}
=
# This fn is called by
#
# src/lib/x-kit/widget/space/sprite/spritespace-imp.pkg # src/lib/x-kit/widget/space/object/objectspace-imp.pkg # src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg #
# when they assign a widget a new site in response to our call
#
# guiboss_to_widgetspace.pass_re_siting_done_flag
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
note_widget_site' { id, subwindow_or_view, site, me }
);
space_to_gui = { id => hostwindow_for_gui.id, # Since each hostwindow has a unique id and we will have only one space_to_gui per hostwindow,
# # using hostwindow_for_gui.id here ensures a unique id per space_to_gui.
note_widget_site
};
#################################################################################
# resite_and_redraw
#
fun resite_and_redraw
(
me: gt::Guiboss_State,
window_site: g2d::Window_Site,
subwindow_info: gt::Subwindow_Data,
guipane: gt::Guipane,
hostwindow_info: gt::Hostwindow_Info
)
=
{ window_site -> ({ size => { high => hostwindow_high, wide => hostwindow_wide }, ... }: g2d::Window_Site);
#
my (high, wide)
=
case subwindow_info
#
gt::SUBWINDOW_DATA r
=>
{ (*r.pixmap).size -> { high, wide };
(high, wide);
};
esac;
site = { col => 0, high, # Allocate all of window pixel area to widgets in guipane.rg_widget widget-tree.
row => 0, wide
}
: g2d::Box;
apply note_hint (idm::keyvals_list widget_layout_hints) # Add them to our global collection of layout hints.
where
widget_layout_hints # Collect gt:::Widget_Layout_Hint values for all widgets in new guipane.
=
gwl::gather_widget_layout_hints { me, guipane };
fun note_hint
( id: Id,
hint: gt::Widget_Layout_Hint
)
=
me.widget_layout_hints := idm::set (*me.widget_layout_hints, id, hint);
end;
sites = gwl::lay_out_guipane # Assign to each widget in given widget-tree a pixel-rectangle on which to draw itself, in window coordinates.
{
me,
site, # This is the available window rectangle to divide between our widgets.
rg_widget => guipane.rg_widget, # This is the tree of widgets -- possibly a single leaf widget.
subwindow_info => guipane.subwindow_info,
widget_layout_hints => *me.widget_layout_hints
};
apply do_site (idm::vals_list sites)
where
fun do_site (widget_site_info: gwl::Widget_Site_Info)
=
{ widget_site_info -> { id, subwindow_or_view, site };
note_widget_site' { id, subwindow_or_view, site, me }; # Sets 'needs_redraw_request' flag for widget if its site has changed.
};
end;
gtj::guipane_apply # If a view pixmap is too small to fill its scrollport there will be undefined pixels showing in the scrollport.
( # By setting the origin to its default 0,0 we trigger the logic to black out these undefined areas.
guipane, # Does doing so result in a double-draw of views at GUI startup? If so, that might someday prove problematic: XXX QUERO FIXME
[ gtj::RG_SCROLLPORT_FN
(\\ (arg: gt::Rg_Scrollport)
=
{ (*arg.scroller).set_scrollport_upperleft
{ row => 0, col => 0 };
}
)
]
);
};
#################################################################################
# widget_to_guiboss interface fns:
#
fun note_widget_layout_hint
{
id: Id,
widget_layout_hint: gt::Widget_Layout_Hint
}
: Void
=
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
{ case (idm::get (*me.gadget_imps, id))
#
THE gadget_imp_info
=>
{
need_re_layout_and_redraw
=
case (idm::get (*me.widget_layout_hints, id))
#
NULL => TRUE;
THE old_layout_hint => widget_layout_hint != old_layout_hint;
esac;
if need_re_layout_and_redraw
#
me.widget_layout_hints
:=
idm::set (*me.widget_layout_hints, id, widget_layout_hint);
case (gtj::find__guipane__containing_gadget gadget_imp_info)
#
THE guipane
=>
guipane.needs_layout_and_redraw := TRUE;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac;
fi;
};
NULL => ();
esac;
}
);
#################################################################################
# gadget_to_guiboss interface fns:
#
fun needs_redraw_gadget_request # PUBLIC.
(
id: Id
)
=
# The point of this call is to alert us that the
# GUI display needs refreshing.
# If no widget calls this, we can stop the frame-
# redisplay cycle to conserve CPU cycles:
#
{
put_in_mailqueue (guiboss_q,
#
\\ (runstate as { me, imports, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => if *done_extra_redraw_request_this_frame
#
set__needs_redraw_request__flag i; # This is the "normal" codepath -- we just remember that this gadget needs a redraw. We'll send it a redraw_gadget_request next time "frameclock" nudges us to run display_one_frame().
else
# # This is a special codepath intended to reduce user-input response latency in the common case of only one mouseclick or such per frametime (10-100 ms). For background see Note[3].
done_extra_redraw_request_this_frame := TRUE; # Throttle this codepath to at most once per "frameclock" tick, to prevent runaway gadgets from overwhelming the CPU+GPU with redraw_gadget() calls.
#
i -> { guiboss_to_gadget, site, gadget_mode, needs_redraw_request, ... };
guiboss_to_gadget.redraw_gadget_request # Give the gadget an instant redraw_gadget_request() in response to its needs_redraw_gadget_request() call to us, instead of making it wait until start of next frame (== next time "frameclock" microthread wakes up).
{
frame_number => *current_frame_number,
site => *site,
duration_in_seconds => 0.0,
gadget_mode => *gadget_mode,
theme => imports.theme,
popup_nesting_depth => gpj::popup_nesting_depth_of_gadget (id, me)
};
fi;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
};
fun draw_gadget (clip_box, gui_displaylist, gadget_imp_info: gt::Gadget_Imp_Info)
=
{
gui_displaylist = [ gd::CLIP_TO (clip_box, gui_displaylist) ]; # Clip gadget's displaylist to its assigned site so it won't traspass on neighboring gadgets if it gets sloppy.
#
gadget_to_rw_pixmap
=
gtj::gadget_to_rw_pixmap__of *gadget_imp_info.subwindow_or_view; # Find gadget's assigned off-screen backing pixmap.
gadget_to_rw_pixmap.draw_displaylist gui_displaylist; # Draw updated gadget appearance into its off-screen backing-pixmap home site.
# Now to update on-screen image of gadget (if it is visible).
#
# We'll update the gadget on the visible window by doing a rectangular blit
# from offscreen backing pixmap to on-screen pixel refresh buffer.
#
# Just redrawing gui_displaylist a second time would be another strategy.
# The blit has the advantage that the worst case is pretty fast, whereas
# the worst case for redrawing gui_displaylist can be arbitrarily slow.
#
# Also, draw-offscreen-and-blit completely eliminates redraw flicker
# where "flicker" == partly-redrawn widget being visible momentarily:
# it is essentially a primitive form of double-buffering.
from_box = *gadget_imp_info.site; # Where should we copy pixels from, on gadget's home pixmap? We initialize this to the full site for the gadget; later it may get clipped by scrollports.
pixmap = *gadget_imp_info.subwindow_or_view;
#
gpj::update_offscreen_parent_pixmaps_and_then_hostwindow
#
(pixmap, from_box, hostwindow_for_gui);
};
#
fun redraw_gadget # Update gadget appearance in response to a guiboss_to_gadget.redraw_gadget_request {...} call.
{
id: Id,
site: g2d::Box, # This should be the 'site' value handed to Guiboss_To_Gadget.redraw_gadget_request: guiboss_imp uses this value to detect (and discard) stale redraw_gadget messages.
displaylist: gd::Gui_Displaylist,
point_in_gadget: Null_Or( g2d::Point -> Bool ) # Optional function deciding if (e.g.) a mouseclick location is within the gadget. This allows more geometric accuracy than a simple bounding box or such.
}
=
# The point of this call is to update the appearance
# of the gadget. This call is normally made in response
# to guiboss_to_gadget.redraw_gadget_request {} # Guiboss_To_Gadget is from src/lib/x-kit/widget/gui/guiboss-types.pkg #
{
# fg = pp::prettyprint_to_string [] {. gd::prettyprint_gui_displaylist #pp displaylist; };
# print ("\narrowbutton: foreground:\n" + fg + "\n");
#
# { t = pp::prettyprint_to_string [] {. gd::prettyprint_gui_displaylist #pp displaylist; };
# nb {. ("redraw_gadget displaylist: " + t); };
# };
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => { i.point_in_gadget := point_in_gadget;
if (site == *i.site) # The point of this test is to discard stale redraws to sites no longer valid, to keep them from corrupting the display.
# # This can happen (for example) if we do a re-layout with some redraws for the old layout in our input mailqueue.
draw_gadget (*i.site, displaylist, i);
fi;
};
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
};
fun pass_guipane_size
#
(id: Id)
(replyqueue: Replyqueue)
(reply_handler: g2d::Size -> Void)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( g2d::Size );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => case (gtj::find__guipane__containing_gadget i)
#
THE guipane =>
{
subwindow_info = gtj::subwindow_info_of_subwindow_data guipane.subwindow_info;
#
guipane_size = (*subwindow_info.pixmap).size;
put_in_oneshot (reply_oneshot, guipane_size);
};
NULL => { msg = "pass_guipane_size: find__guipane__containing_gadget returned NULL.";
log::fatal msg;
raise exception DIE msg;
};
esac;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun set_guipane_size # Gadget request to change value of size for guipane containing gadget.
(
id: Id,
requested_size: g2d::Size
)
=
put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => case (gtj::find__guipane__containing_gadget i)
#
THE guipane =>
{
subwindow_info = gtj::subwindow_info_of_subwindow_data guipane.subwindow_info;
#
old_size = (*subwindow_info.pixmap).size;
old_upperleft = *subwindow_info.upperleft;
case subwindow_info.parent
#
THE (gt::SUBWINDOW_DATA parent_subwindow_info)
=>
{ parent_size = (*parent_subwindow_info.pixmap).size;
#
parent_upperleft_in_basewindow_coordinates
=
gtj::subwindow_info_upperleft_in_base_window_coordinates
#
parent_subwindow_info;
#
my { new_upperleft, new_size } # Select actual site for popup. We need it to fit entirely within parent.
=
size_subwindow_entirely_within_parent
{
parent_size,
old_upperleft,
old_size => requested_size
};
if (new_size != (*subwindow_info.pixmap).size)
#
old_pixmap = *subwindow_info.pixmap;
new_pixmap = imports.guiboss_to_guishim.make_rw_pixmap new_size; # XXX SUCKO FIXME blocking here sucks. Probably guiboss_to_guishim should have a pass_new_rw_pixmap() or such.
subwindow_info.pixmap := new_pixmap;
old_pixmap.free_rw_pixmap (); # XXX QUERO FIXME Does this block also?
guipane.needs_layout_and_redraw := TRUE;
# We also need to redraw any background exposed by the
# guipane shrinking along one/both axes during resize:
#
newly_exposed_background # This list may be empty. That's ok.
=
g2d::box::subtract_box_b_from_box_a
{
a => g2d::box::make (parent_upperleft_in_basewindow_coordinates + old_upperleft, old_size),
b => g2d::box::make (parent_upperleft_in_basewindow_coordinates + new_upperleft, new_size)
};
apply do_exposed_background_box newly_exposed_background
where
fun do_exposed_background_box (box: g2d::Box)
=
gpj::refresh_hostwindow_rectangle (hostwindow_info, box);
end;
fi;
};
NULL =>
{ msg = "Cannot move basewindow around on hostwindow! -- setguipane_upperleft in guiboss-imp.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
};
NULL => { msg = "set_guipane_upperleft: find__guipane__containing_gadget returned NULL."; # Should we be silently ignoring this one too...?
log::fatal msg;
raise exception DIE msg;
};
esac;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
fun pass_guipane_upperleft
#
(id: Id)
(replyqueue: Replyqueue)
(reply_handler: g2d::Point -> Void)
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( g2d::Point );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => case (gtj::find__guipane__containing_gadget i)
#
THE guipane =>
{
subwindow_info = gtj::subwindow_info_of_subwindow_data guipane.subwindow_info;
#
guipane_upperleft = *subwindow_info.upperleft;
put_in_oneshot (reply_oneshot, guipane_upperleft);
};
NULL => { msg = "pass_guipane_upperleft: find__guipane__containing_gadget returned NULL.";
log::fatal msg;
raise exception DIE msg;
};
esac;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun set_guipane_upperleft # Gadget request to change value of Subwindow_Info.upperleft for guipane containing gadget.
(
id: Id,
old_upperleft: g2d::Point
)
=
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => case (gtj::find__guipane__containing_gadget i)
#
THE guipane =>
{
subwindow_info = gtj::subwindow_info_of_subwindow_data guipane.subwindow_info;
#
old_size = (*subwindow_info.pixmap).size;
case subwindow_info.parent
#
THE (gt::SUBWINDOW_DATA parent_subwindow_info)
=>
{ parent_size = (*parent_subwindow_info.pixmap).size;
#
parent_upperleft_in_basewindow_coordinates
=
gtj::subwindow_info_upperleft_in_base_window_coordinates
#
parent_subwindow_info;
my { new_upperleft, new_size } # Select actual site for popup. We want it to fit entirely within parent.
=
position_subwindow_entirely_within_parent
{
parent_size,
old_upperleft,
old_size
};
if (new_size != (*subwindow_info.pixmap).size)
#
msg = "Fatal: subwindow does not fit in parent?! -- set_guipane_upperleft in guiboss-imp.pkg.";
log::fatal msg;
raise exception DIE msg;
fi;
old_upperleft = *subwindow_info.upperleft;
subwindow_info.upperleft := new_upperleft;
old_site = g2d::box::make (parent_upperleft_in_basewindow_coordinates + old_upperleft, old_size);
new_site = g2d::box::make (parent_upperleft_in_basewindow_coordinates + new_upperleft, new_size);
affected_rectangle
=
g2d::bounding_box
#
( (g2d::box::to_points old_site) # We need to redraw both where the subwindow was and where it now is.
@ (g2d::box::to_points new_site)
);
gpj::refresh_hostwindow_rectangle (hostwindow_info, affected_rectangle);
};
NULL =>
{ msg = "Cannot move basewindow around on hostwindow! -- setguipane_upperleft in guiboss-imp.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
};
NULL => { msg = "set_guipane_upperleft: find__guipane__containing_gadget returned NULL.";
log::fatal msg;
raise exception DIE msg;
};
esac;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
#
fun request_keyboard_focus # At any given time at most one gadget has the keyboard focus. This call lets gadgets request the keyboard focus.
(
id: Id # Id of gadget requesting keyboard focus.
)
=
{ put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE new => { case *me.keyboard_focus # If another gadget had the keyboard focus, tell it that it has lost the keyboard focus.
#
THE old # 'old' previously had the keyboard focus.
=>
if (not (same_id ( new.guiboss_to_gadget.id, # Ignore calls which just set keyboard focus to value it already has.
old.guiboss_to_gadget.id
) ) )
#
old.guiboss_to_gadget.note_keyboard_focus (FALSE, imports.theme); # Tell 'old' that it no longer has the keyboard focus.
new.guiboss_to_gadget.note_keyboard_focus (TRUE, imports.theme); # Tell 'new' that it now has the keyboard focus.
# #
me.keyboard_focus := THE new; # Remember which gadget now has the keyboard focus.
fi;
NULL => # No gadget had the keyboard focus.
{ new.guiboss_to_gadget.note_keyboard_focus (TRUE, imports.theme); # Tell 'new' that it now has the keyboard focus.
# #
me.keyboard_focus := THE new; # Remember which gadget now has the keyboard focus.
};
esac;
};
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
}; # XXX SUCKO FIXME We need some mechanism to do me.keyboard_focus := NULL; if/when we close down that gadget.
#
fun release_keyboard_focus # At any given time at most one gadget has the keyboard focus. This call lets gadgets relinquish the keyboard focus.
(
id: Id # Id of gadget relinquishing keyboard focus.
)
=
{ put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE new => { case *me.keyboard_focus #
#
THE old # We think 'old' has the keyboard focus.
=>
if (same_id ( new.guiboss_to_gadget.id, # If gadget does not have the keyboard focus, ignore the call.
old.guiboss_to_gadget.id
) )
#
old.guiboss_to_gadget.note_keyboard_focus (FALSE, imports.theme); # Tell it that it no longer has the keyboard focus.
me.keyboard_focus := NULL; # Remember no gadget now has the keyboard focus.
fi;
NULL => (); # No gadget had the keyboard focus.
esac;
};
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
}; # XXX SUCKO FIXME We need some mechanism to do me.keyboard_focus := NULL; if/when we close down that gadget.
#
fun note_changed_gadget_activity # PUBLIC.
{
id: Id,
is_active: Bool
}
=
# The point of this call is to mark gadget as not
# eligible for user input. It will often be drawn grayed-out.
#
{ put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => { (*i.gadget_mode) -> { is_active => _, has_mouse_focus, has_keyboard_focus };
i.gadget_mode := { is_active, has_mouse_focus, has_keyboard_focus };
};
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
};
fun wake_me # Used to schedule guiboss_to_gadget.wakeup calls.
{
id: Id,
options: List( gt::Wake_Me_Option )
}
=
# The point of this call is to set up (or cancel)
# wakeup calls to a given widget.
#
{
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
case (idm::get (*me.gadget_imps, id))
#
THE i => apply do_option options
where
fun do_option (option: gt::Wake_Me_Option)
=
case option
#
gt::AT_FRAME_N NULL => i.at_frame_n := NULL;
gt::EVERY_N_FRAMES NULL => i.every_n_frames := NULL;
#
gt::AT_FRAME_N (THE (at_frame, wakeup_fn)) => i.at_frame_n := THE { at_frame, wakeup_fn };
gt::EVERY_N_FRAMES (THE (n, wakeup_fn)) => i.every_n_frames := THE { n, wakeup_fn, next => REF (*current_frame_number + n) };
esac;
end;
NULL => (); # We'll assume this was a queued (stale) message from a now-dead gadget, and silently ignore it.
esac
);
};
fun shut_down_guiboss (): Void
=
{
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
shut_down_guiboss' runstate
);
};
fun get_guipiths () # See Note[1] in src/lib/x-kit/widget/gui/translate-guipane-to-guipith.pkg =
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( (Int, idm::Map( gt::Xi_Hostwindow_Info )) );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, ... }: Runstate)
=
{ guipiths = rtx::guipanes_to_guipiths me; # Could take awhile; possibly this should be pass_guipiths instead of get_guipiths...
version = *me.gui_update_count;
#
put_in_oneshot (reply_oneshot, (version, guipiths));
}
);
result =
get_from_oneshot reply_oneshot;
# nb {. "========================================="; };
# nb {. "get_guipiths pprinting original guipanes:"; };
# gtj::pprint_hostwindows (me, *me.hostwindows);
result;
};
fun resite_and_redraw_all_hostwindows
(
me: gt::Guiboss_State
)
=
apply do_hostwindow (idm::vals_list *me.hostwindows)
where
fun do_hostwindow
(
hostwindow_info: gt::Hostwindow_Info
)
=
{
hostwindow_info
->
{ guiboss_to_hostwindow: gtg::Guiboss_To_Hostwindow,
subwindow_info: Ref( Null_Or( gt::Subwindow_Data ) ),
...
};
fun do_subwindow_data (subwindow_data: gt::Subwindow_Data)
=
{ subwindow_data -> gt::SUBWINDOW_DATA 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.
};
window_site = guiboss_to_hostwindow.get_window_site ();
case *guipane
#
THE guipane
=>
resite_and_redraw (me, window_site, subwindow_data, guipane, hostwindow_info);
NULL => ();
esac;
apply do_subwindow_data *popups;
};
case *subwindow_info
#
THE subwindow_data
=>
do_subwindow_data subwindow_data;
NULL => ();
esac;
};
end;
fun install_updated_guipiths
(
version: Int,
updated_guipiths: idm::Map( gt::Xi_Hostwindow_Info ) # Update guiboss_imp's running gui per supplied Guipith, which should be a suitably edited version of return value from get_guipiths. See Note[1] in src/lib/x-kit/widget/gui/translate-guipane-to-guipith.pkg )
= # See Note[1] in src/lib/x-kit/widget/gui/translate-guipane-to-guipith.pkg { reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Bool );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
{
if (version != *me.gui_update_count)
#
put_in_oneshot (reply_oneshot, FALSE); # Some other client updated the GUI topology first; client will have to retry its get_guipiths -> mutate -> install_updated_guipiths sequence.
else
# nb {. "====================================================="; };
# nb {. "install_updated_guipiths pprinting original guipanes:"; };
# gtj::pprint_hostwindows (me, *me.hostwindows); # I'm leaving this debug call in place (commented out) to save myself the effort of rememberhing how to do it next time I need it.
guipanes = rtx::guipiths_to_guipanes # This call also shuts down all widget (etc) imps used in *me.hostwindows but not new guipanes, and drops them from *me.gadget_imps, *me.widget_layout_hints, *me.objectspace_imps, *me.spritespace_imps, *me.widgetspace_imps.
(
me,
updated_guipiths,
imports.guiboss_to_guishim,
gpj::clear_box_in_pixmap,
gpj::update_offscreen_parent_pixmaps_and_then_hostwindow
)
:
idm::Map( gt::Hostwindow_Info );
me.hostwindows := guipanes;
# nb {. "===================================================="; };
# nb {. "install_updated_guipiths pprinting updated guipanes:"; };
# gtj::pprint_hostwindows (me, *me.hostwindows);
resite_and_redraw_all_hostwindows me; # Obviously, we can add logic here to redraw only changed popups, or only changed parts of them, if performance becomes a problem.
# Until it does, I'm sticking with simple here.
put_in_oneshot (reply_oneshot, TRUE); # Notify caller that GUI update was successful.
me.gui_update_count := *me.gui_update_count + 1;
fi;
}
);
get_from_oneshot reply_oneshot;
};
fun make_popup # PUBLIC. Create popup pane on given window in given site. Given site is adjusted to lie entirely within parent (if necessary) and returned.
(
requested_site: g2d::Box,
guiplan: gt::Guiplan
)
: (
g2d::Box,
gt::Client_To_Guiwindow
)
=
{ gui_startup_complete' = make_oneshot_maildrop(): Oneshot_Maildrop( gt::Client_To_Guiwindow );
#
actual_site_and_subwindow_info'
=
make_oneshot_maildrop(): Oneshot_Maildrop( (g2d::Box, gt::Subwindow_Data) );
#
put_in_mailqueue (guiboss_q, # make_popup() is intended to be called by widget code, so our first task is to transition from caller's microthread to the guiboss-imp microthread.
#
\\ (runstate as { me, imports, ... }: Runstate) # Once into the body of this fn we are running in the guiboss-imp microthread.
=
{
(make_subwindow_info_for_popup # Make a new rw_pixmap, wrap it in a SUBWINDOW_DATA, enter latter into the SUBWINDOW_DATA popup hierarchy for this gui.
(
imports.guiboss_to_guishim.make_rw_pixmap, # To allocate the actual rw_pimap for the Subwindow_Or_View.
hostwindow_info.next_stacking_order, # To allocate a 'stacking_order' value for Subwindow_Or_View.
subwindow_info, # Our parent Subwindow_Or_View.
requested_site # Where to put popup on parent Subwindow_Or_View.
)
) -> (actual_site, subwindow_info);
put_in_oneshot # Pass actual site of popup back to calling microthread, plus backing pixmap for popup GUI.
(
actual_site_and_subwindow_info',
(actual_site, subwindow_info)
);
start_gui'
(
runstate: Runstate,
#
hostwindow_for_gui: gtg::Guiboss_To_Hostwindow,
subwindow_info: gt::Subwindow_Data,
guiplan: gt::Guiplan,
gui_startup_complete': Oneshot_Maildrop( gt::Client_To_Guiwindow ),
guiboss_q: Guiboss_Q,
kill_gui: (gt::Guipane, gt::Hostwindow_Info) -> Void
);
}
);
(get_from_oneshot actual_site_and_subwindow_info')
->
(actual_site, subwindow_info); # Read actual site of popup back from guiboss-imp microthread, also backing pixmap for popup GUI.
client_to_guiwindow = get_from_oneshot gui_startup_complete'; # Wait until popup startup is complete. We do this in caller's thread to reduce risk of lockup -- caller is typically a button that can afford to sleep a bit.
( actual_site,
client_to_guiwindow # Return port to the running popup.
);
};
guipaneref = REF (NULL: Null_Or(gt::Guipane)); # Another skanky little hack to resolve cyclic dependencies. We set guipaneref just below, immediately after creating guipane, and never change it thereafter.
#
fun kill_popup ()
=
case *guipaneref
#
THE guipane => kill_gui (guipane, hostwindow_info);
#
NULL => { msg = "guipaneref NULL in kill_gui! -- guiboss-imp.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
###################################################################################
# These next three allow guiboss clients to use us as a
# blackboard to publish arbitrary values, at the cost
# of some typesafety. Used for example in
#
# src/lib/x-kit/widget/edit/millboss-imp.pkg fun note_global (global: Crypt)
=
{ put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
globals__global := sm::set (*globals__global, global.type, global)
);
};
fun find_global (type: String) # 'type' should be the Crypt.type string for the desired Crypt.
=
sm::get (*globals__global, type); # Doing this in client microthread reduces risk of deadlock. There's no obvious synchronization risk since we do a single read and get a value that we could have gotten via the usual in-imp-microthread approach.
fun drop_global (type: String) # 'type' should be the Crypt.type string for the Crypt to be dropped.
=
{
put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate)
=
globals__global := sm::drop (*globals__global, type)
);
};
gadget_to_guiboss = { id => hostwindow_for_gui.id, # Since each hostwindow has a unique id and we will have only one gadget_to_guiboss per hostwindow, using hostwindow_for_gui.id
# # here ensures a unique id per gadget_to_guiboss. It also makes gadget_to_guiboss.id stable across gui stop/restart cycles.
needs_redraw_gadget_request,
#
redraw_gadget,
request_keyboard_focus,
release_keyboard_focus,
note_changed_gadget_activity,
wake_me,
#
shut_down_guiboss,
app_to_compileimp,
#
get_guipiths,
install_updated_guipiths,
#
pass_guipane_upperleft,
set_guipane_upperleft,
#
pass_guipane_size,
set_guipane_size,
#
note_global,
find_global,
drop_global,
#
make_popup,
kill_popup
};
widget_to_guiboss = { id => hostwindow_for_gui.id, # Since each hostwindow has a unique id and we will have only one widget_to_guiboss per hostwindow,
# # using hostwindow_for_gui.id here ensures a unique id per widget_to_guiboss.
g => gadget_to_guiboss,
note_widget_layout_hint
};
#################################################################################
# frameclock microthread -- wakes us up 10 times/sec to draw a frame.
#
guipane = gtr::guiplan_to_guipane # Starts up all widget-imps plus the object- sprite- and widgetspace imps, and
{ # populates our spritespace_imps, objectspace_imps, widgetspace_imps and gadget_imps maps.
run_gun',
subwindow_info,
me,
widget_to_guiboss,
gadget_to_guiboss,
guiboss_to_guishim => imports.guiboss_to_guishim,
hostwindow_for_gui,
space_to_gui,
clear_box_in_pixmap => gpj::clear_box_in_pixmap,
update_offscreen_parent_pixmaps_and_then_hostwindow => gpj::update_offscreen_parent_pixmaps_and_then_hostwindow
}
guiplan;
guipaneref := THE guipane;
if (not we_are_a_popup_gui) # One frameclock microthread per hostwindow is quite sufficient, so we avoid starting extra ones up each time we start up a secondary (popup) gui.
#
make_thread' [ THREAD_NAME "frameclock" ] frameclock end_gun' # Start up frameclock thread which tells us when it is time to draw a new frame.
where
fun display_one_frame ({ me, imports, to, guiboss_to_millboss, ... }: Runstate) # THIS FUNCTION RUNS IN THE REGULAR GUIBOSS_IMP MICROTHREAD, NOT THE "frameclock" MICROTHREAD.
=
{
current_frame_number := *current_frame_number + 1;
#
done_extra_redraw_request_this_frame := FALSE; # See Note[3].
guiboss_to_millboss.do_one_frame *current_frame_number;
imps = idm::vals_list *me.gadget_imps;
apply' imps {.
#
#imp -> { guiboss_to_gadget,
site,
gadget_mode,
needs_redraw_request,
sent__initialize_gadget,
subwindow_or_view,
pixmaps,
...
};
if (not *sent__initialize_gadget and *site != g2d::box::zero) # If *site==g2d::box::zero then widgetspace_imp has not yet done layout and we cannot yet call initialize_gadget or redraw_gadget_request, since both require a valid site.
#
fun make_rw_pixmap (size: g2d::Size): g2p::Gadget_To_Rw_Pixmap
=
{ rw_pixmap = imports.guiboss_to_guishim.make_rw_pixmap( size );
#
subwindow_info
=
gtj::subwindow_info_of_subwindow_or_view
#
*subwindow_or_view;
pixmaps := im::set ( *pixmaps,
id_to_int rw_pixmap.id,
rw_pixmap
);
#
rw_pixmap;
};
guiboss_to_gadget.initialize_gadget { site => *site,
theme => imports.theme,
get_font => hostwindow_for_gui.get_font,
pass_font => hostwindow_for_gui.pass_font,
make_rw_pixmap
};
sent__initialize_gadget := TRUE;
needs_redraw_request := TRUE;
fi;
};
apply' imps {.
#imp -> { guiboss_to_gadget, site, gadget_mode, needs_redraw_request, at_frame_n, every_n_frames, ... };
#
if (*site != g2d::box::zero) # If *site==g2d::box::zero then widgetspace_imp has not yet done layout and we cannot yet call redraw_gadget_request because it requires a valid site.
#
case *at_frame_n
#
THE { at_frame: Int,
wakeup_fn: gt::Wakeup_Arg -> Void
}
=>
if (*current_frame_number == at_frame)
#
guiboss_to_gadget.wakeup
{
wakeup_arg => { frame_number => *current_frame_number },
wakeup_fn
};
elif (*current_frame_number > at_frame)
#
at_frame_n := NULL;
fi;
NULL => ();
esac;
case *every_n_frames
#
THE { n: Int,
next: Ref(Int),
wakeup_fn: gt::Wakeup_Arg -> Void
}
=>
if (*current_frame_number >= *next)
#
guiboss_to_gadget.wakeup
{
wakeup_arg => { frame_number => *current_frame_number },
wakeup_fn
};
next := *current_frame_number + n;
fi;
NULL => ();
esac;
if (*needs_redraw_request)
#
guiboss_to_gadget.redraw_gadget_request
{
frame_number => *current_frame_number,
site => *site,
#
duration_in_seconds => 0.0,
gadget_mode => *gadget_mode,
theme => imports.theme,
popup_nesting_depth => gpj::popup_nesting_depth_of_gadget (guiboss_to_gadget.id, me)
};
needs_redraw_request := FALSE;
fi;
fi;
};
# Start re-layout-and-redraw of any running guis which need one:
#
apply' (idm::vals_list *me.hostwindows)
#
(\\ (hostwindow_info: gt::Hostwindow_Info) = {
#
gtj::all_guipanes_on_hostwindow_apply hostwindow_info
#
(\\ (guipane: gt::Guipane) = {
#
if(*guipane.needs_layout_and_redraw)
guipane.needs_layout_and_redraw := FALSE;
my { high, wide }
=
case guipane.subwindow_info
#
gt::SUBWINDOW_DATA r
=>
(*r.pixmap).size;
esac;
site = { col => 0, high, # Allocate all of window pixel area to widgets in guipane.rg_widget widget-tree.
row => 0, wide
}
: g2d::Box;
sites = gwl::lay_out_guipane # Assign to each widget in given widget-tree a pixel-rectangle on which to draw itself, in window coordinates.
{
me,
site, # This is the available window rectangle to divide between our widgets.
rg_widget => guipane.rg_widget, # This is the tree of widgets -- possibly a single leaf widget.
subwindow_info => guipane.subwindow_info,
widget_layout_hints => *me.widget_layout_hints
};
apply do_site (idm::vals_list sites)
where
fun do_site (widget_site_info: gwl::Widget_Site_Info)
=
{ widget_site_info -> { id, subwindow_or_view, site };
note_widget_site' { id, subwindow_or_view, site, me }; # Sets 'needs_redraw_request' flag for widget if its site has changed.
};
end;
fi;
});
});
};
# XXX SUCKO FIXME we should probably just use the 50HZ timeslicing clock.
# This fn provides the body for a little microthread which just
# loops ten times a second telling our main thread to disply frame:
#
fun frameclock end_gun' # THIS FUNCTION RUNS IN THE "frameclock" MICROTHREAD.
=
loop ()
where
count = REF 19;
#
fun loop ()
=
{
do_one_mailop [
#
end_gun'
==>
{.
thread_exit { success => TRUE };
},
#
timeout_in' *seconds_per_frame
==>
{.
put_in_mailqueue (guiboss_q, display_one_frame);
}
];
loop ();
};
end;
end;
();
fi;
end; # fun restart_gui'
#
fun startup (id: Id, reply_oneshot: Oneshot_Maildrop( (Me_Slot, Exports) )) () # Root fn of imp microthread. Note currying.
=
{ me_slot = make_mailslot () : Me_Slot;
#
(make_end_gun ()) -> { end_gun' => guiboss_done',
fire_end_gun => fire__guiboss_done
};
client_to_guiboss = { id,
make_hostwindow,
start_gui,
get_sprite_theme,
get_object_theme,
get_widget_theme,
guiboss_done'
};
millboss_to_guiboss = { id, # Exported interface for use by src/lib/x-kit/widget/edit/millboss-imp.pkg shut_down_guiboss
};
to = make_replyqueue();
#
put_in_oneshot (reply_oneshot, (me_slot, { client_to_guiboss })); # Return value from guiboss_egg'().
(take_from_mailslot me_slot) # Imports from guiboss_egg'().
->
{ me, guiboss_arg, imports, run_gun', end_gun' };
compileimp_egg = ci::make_compileimp_egg []; # Set up millboss_imp, our delegate responsible for central
# # coordination of emacs-flavored text editing functionality,
(compileimp_egg()) # such as tracking all active textmills, editpanes etc.
-> #
(compileimp_exports, compileimp_egg'); # We should probably have a more generic mechanism (like an Option IMP_TO_START?) for starting up things like millboss, rather than this special-case hack.
# #
compileimp_egg' ({ }, run_gun', end_gun');
compileimp_exports -> { app_to_compileimp, guiboss_to_compileimp }; #
millboss_egg = mbi::make_millboss_egg []; # Set up millboss_imp, our delegate responsible for central
# # coordination of emacs-flavored text editing functionality,
(millboss_egg()) # such as tracking all active textmills, editpanes etc.
-> #
(millboss_exports, millboss_egg'); # We should probably have a more generic mechanism (like an Option IMP_TO_START?) for starting up things like millboss, rather than this special-case hack.
# #
millboss_egg' ({ millboss_to_guiboss, app_to_compileimp }, run_gun', end_gun');
millboss_exports -> { guiboss_to_millboss }; #
block_until_mailop_fires run_gun'; # Wait for the starting gun.
run ( guiboss_q, # Will not return.
{ id,
me,
guiboss_arg,
imports,
guiboss_to_millboss,
guiboss_to_compileimp,
app_to_compileimp,
to,
end_gun',
fire__guiboss_done
}
);
}
where
guiboss_q = make_mailqueue (get_current_microthread()): Guiboss_Q;
#################################################################################
# guiboss interface fns::
#
#
fun make_guievent_sink
(
hostwindow_info: gt::Hostwindow_Info,
saved_events: Ref (List( (a2r::Envelope_Route, evt::x::Event) ) ) # Somewhere for initial_guievent_sink to save any events it gets.
)
=
guievent_sink
where
fun guievent_sink (arg as (route: a2r::Envelope_Route, event: evt::x::Event)) # The production Gui_Event handling routine, which locks in the value of 'hostwindow_info'.
= # This will run in client's thread.
put_in_mailqueue (guiboss_q, # Incoming Gui_Event values MUST be run through the guiboss_q to guarantee mutual exclusion on access to internal guiboss datastructures.
#
\\ (runstate as { me, imports, ... }: Runstate) # Now we're running in our own thread, with mutual exclusion and access to our core datastructures.
=
{
case *hostwindow_info.subwindow_info
#
NULL => { saved_events := arg ! *saved_events; # When no GUI is running, all we can do is save user input for later processing. (Or maybe discard it?)
printf "guievent_sink()/guiboss: received '%s' Gui_Event but saved it because *hostwindow_info.guipane is NULL. -- guiboss-imp.pkg\n"
(gts::gui_event_to_string event);
};
THE (gt::SUBWINDOW_DATA r)
=>
case *r.guipane
#
NULL => { saved_events := arg ! *saved_events; # When no GUI is running, all we can do is save user input for later processing. (Or maybe discard it?)
printf "guievent_sink()/guiboss: received '%s' Gui_Event but saved it because *hostwindow_info.guipane is NULL. -- guiboss-imp.pkg\n"
(gts::gui_event_to_string event);
};
THE guipane
=> {
case *saved_events
#
[] => ged::dispatch_event (arg, me, imports.theme, hostwindow_info);
_ => { # Woops, we have prior events that came in before we were ready to process them.
saved_events := arg ! *saved_events; # Add latest event to saved-events list.
events = reverse *saved_events; # Reverse saved-events list so we process them in first-in-first-out order.
saved_events := []; # Clear saved-events so we don't process any of them twice.
apply guievent_sink events; # Recursively process all saved events in order. NB: Any new events that arrive during this will just accumulate on guiboss_q. That's fine.
}; #
esac;
};
esac;
esac;
} # In-private-thread part of fun guievent_sink.
); # fun guievent_sink
end;
fun shut_down_guiboss (): Void # PUBLIC.
=
{
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
shut_down_guiboss' runstate
);
};
fun make_hostwindow (hints: gtg::Hostwindow_Hints) # PUBLIC.
: gtg::Guiboss_To_Hostwindow
= # This will run in client's thread.
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( gtg::Guiboss_To_Hostwindow );
# reply_oneshot is NOT locked into guievent_sink.
#
put_in_mailqueue (guiboss_q,
#
\\ ({ me, imports, ... }: Runstate) # Now we're running in our own thread, with mutual exclusion and access to our core datastructures.
=
{ # We have to do an awkward little dance here because we
# must hand a guievent_sink() TO make_hostwindow() but we
# want guievent_sink() to lock in the 'hostwindow' result
# FROM make_hostwindow():
# saved_events IS directly locked into guievent_sink
saved_events = REF ([]: List( (a2r::Envelope_Route, evt::x::Event) ) ); # Somewhere for initial_guievent_sink to save any events it gets.
# guievent_sink_fn is NOT directly locked into guievent_sink() (but it is indirectly locked via hostwindow_info -> guiboss_to_hostwindow).
guievent_sink_fn
=
REF initial_guievent_sink
where
fun initial_guievent_sink (arg as (route: a2r::Envelope_Route, event: evt::x::Event)) # An initial version which just saves events in 'saved_events' until we're ready to process them, since we don't yet have 'hostwindow' available.
= # This will run in client's thread.
saved_events := arg ! *saved_events;
end;
guiboss_to_hostwindow
=
imports.guiboss_to_guishim.make_hostwindow # XXX SUCKO FIXME we're blocking until we get the result from guishim.
#
(hints, guievent_sink_wrapper)
where
fun guievent_sink_wrapper (arg as (route: a2r::Envelope_Route, event: evt::x::Event)) # A wrapper which initially calls initial_guievent_sink but almost immediately switches to calling the production guievent_sink.
= # This will run in client's thread.
*guievent_sink_fn arg;
end;
hostwindow_info = { guiboss_to_hostwindow, # Remember our handle for the hostwindow.
subwindow_info => REF NULL, # Remember that we do not yet have a GUI running on the hostwindow.
#
current_frame_number => REF 1, # We count frames for convenience of widgets and debugging.
seconds_per_frame => REF 0.01, # Let's initially assume a nominal ten frames per second. Passed to widgets primarily so widgets can do motion blurring if they wish.
#
done_extra_redraw_request_this_frame => REF FALSE,
#
next_stacking_order => REF 2
};
me.hostwindows # Remember that we have a new hostwindow to manage.
:=
idm::set( *me.hostwindows,
guiboss_to_hostwindow.id,
hostwindow_info
);
guievent_sink
=
make_guievent_sink (hostwindow_info, saved_events);
guievent_sink_fn := guievent_sink; # Switch guievent_sink_wrapper() over from using initial_guievent_sink() to using guievent_sink().
put_in_oneshot (reply_oneshot, guiboss_to_hostwindow);
imports.theme.guiboss_to_hostwindow := THE guiboss_to_hostwindow; # So widget-theme-imp.pkg can make guiboss_to_hostwindow.get_font() calls.
} # In-private-thread part of fun make_hostwindow.
); # put_in_mailqueue call.
get_from_oneshot reply_oneshot;
}; # fun make_hostwindow
#
fun kill_gui
(
guipane: gt::Guipane, # Private
hostwindow_info: gt::Hostwindow_Info
)
: Void
=
{
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
kill_gui' (runstate, (guipane, hostwindow_info, TRUE))
);
();
};
#
fun start_gui # PUBLIC.
(
hostwindow_for_gui: gtg::Guiboss_To_Hostwindow,
guiplan: gt::Guiplan
)
: (Void -> gt::Client_To_Guiwindow)
=
{ gui_startup_complete' = make_oneshot_maildrop(): Oneshot_Maildrop( gt::Client_To_Guiwindow );
#
put_in_mailqueue (guiboss_q,
#
\\ (runstate: Runstate)
=
{ subwindow_info = gtj::make_base_subwindow_data hostwindow_for_gui.subwindow_or_view;
#
start_gui' (runstate, hostwindow_for_gui, subwindow_info, guiplan, gui_startup_complete', guiboss_q, kill_gui);
}
);
{. get_from_oneshot gui_startup_complete'; };
};
#
fun get_sprite_theme () # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( bt::Gui_To_Sprite_Theme );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ imports, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, imports.gui_to_sprite_theme)
);
get_from_oneshot reply_oneshot;
};
#
fun get_object_theme () # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( ct::Gui_To_Object_Theme );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ imports, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, imports.gui_to_object_theme)
);
get_from_oneshot reply_oneshot;
};
#
fun get_widget_theme () # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( wt::Widget_Theme );
#
put_in_mailqueue (guiboss_q,
#
\\ ({ imports, ... }: Runstate)
=
put_in_oneshot (reply_oneshot, imports.theme)
);
get_from_oneshot reply_oneshot;
};
end;
#
fun process_options (options: List(Guiboss_Option), { name, id })
=
{ my_name = REF name;
my_id = REF id;
#
apply do_option options
where
fun do_option (MICROTHREAD_NAME n) => my_name := n;
do_option (ID i) => my_id := i;
end;
end;
{ name => *my_name,
id => *my_id
};
};
##########################################################################################
# PUBLIC.
#
fun make_guiboss_egg
(guiboss_arg: Guiboss_Arg) # PUBLIC. PHASE 1: Construct our state and initialize from 'options'.
=
{ guiboss_arg -> (guiboss_options); # Currently no guiboss_needs component, so this is a no-op.
#
(process_options
( guiboss_options,
{ name => "guiboss",
id => id_zero
}
) )
->
{ name,
id
};
my (id, guiboss_options)
=
if (id_to_int(id) == 0)
id = issue_unique_id(); # Allocate unique imp id.
(id, ID id ! guiboss_options); # Make our id stable across stop/restart cycles.
else
(id, guiboss_options);
fi;
guiboss_arg = (guiboss_options); # Currently no guiboss_needs component, so this is a no-op.
me = {
gui_update_count => REF 0,
hostwindows => REF idm::empty, # Track all hostwindows created by our make_hostwindow() entrypoint.
mouse_is => REF gt::CROSSING_NONGADGET, # Mouse is not currently dragging, and in fact not currently known to be on any particular widget.
last_button_changed => REF evt::button1, # Track last button clicked, so we can pass it to drag_fn clients. (evt::Motion_Xevtinfo contain no 'mouse_button' field, unlike evt::Button_Xevtinfo values.) Cnoice of initial value does not matter.
keyboard_focus => REF (NULL: Null_Or( gt::Gadget_Imp_Info )), # Gadget currently holding keyboard focus, if any.
#
spritespace_imps => (REF idm::empty): gt::Spritespace_Imps, # Holds our gt::Guiboss_To_Spritespace instances.
objectspace_imps => (REF idm::empty): gt::Objectspace_Imps, # Holds our gt::Guiboss_To_Objectspace instances.
widgetspace_imps => (REF idm::empty): gt::Widgetspace_Imps, # Holds our gt::Guiboss_To_Widgetspace instances.
gadget_imps => (REF idm::empty): gt::Gadget_Imps, #
widget_layout_hints => (REF idm::empty): gt::Widget_Layout_Hints #
};
\\ () = { reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( (Me_Slot, Exports) ); # PUBLIC. PHASE 2: Start our microthread and return our Exports to caller.
#
xlogger::make_thread name (startup (id, reply_oneshot)); # Note that startup() is curried.
(get_from_oneshot reply_oneshot) -> (me_slot, exports);
fun phase3 # PUBLIC. PHASE 3: Accept our Imports, then wait for Run_Gun to fire.
(
imports: Imports,
run_gun': Run_Gun,
end_gun': End_Gun
)
=
{
put_in_mailslot (me_slot, { me, guiboss_arg, imports, run_gun', end_gun' });
};
(exports, phase3);
};
};
};
end;
##########################################################################
# Note[2] Pop-up Design Considerations:
#
# o As a practical matter we expect typically just one
# popup at a time, either a tooltip or a dialog, so
# we try to avoid adding too much semantic and implementation
# complexity in service of the remaining rarer cases.
#
# Also, we don't worry much about the efficiency of the
# complex cases which we expect to be vanishingly rare:
# we use simple O(N**2) algorithms for our overlapping-
# update cases rather than implementing and using
# sophisticated spatial datastructures.
#
# o For simplicity and portability we do popups entirely
# within guiboss-imp, as opposed to using one separate
# X window per popup. This leaves the door open to
# ports to non-X substrates which do not naturally
# support extra windows, perhaps OpenGL or simple
# hardware framebuffers.
#
# o We support multiple simultaneous popups on a given
# hostwindow because this has the simplest, most natural
# semantics: on a big GUI on a 30" monitor there is no
# reason that a popup or tooltip in one corner should
# block a popup or tooltip in another corner.
#
# o We expect each popup to fit entirely within its parent,
# but it seems unnatural and inconvenient to insist that
# sibling popups sharing a parent not overlap, so for
# simplest semantics we allow such overlaps.
#
# o For similar considerations of clean semantics we support
# popups on popups: We want each popup to support the same
# GUI semantics as the underlying parent gui window.
#
# o We resolve sibling overlaps via a global stacking order,
# with younger windows overlaying older ones. At some point
# we may want to support popping windows to the top of the
# stacking order: In that case we'll have to make stacking_order
# fields mutuable and trigger a redraw after updating them.
#
# o I do not see any need to have pop-ups belong to viewables and
# thus be partially visible through a scrollport. The point
# of a popup is to be attention-getting and visible, so having
# hidden popups seems counterproductive. Consequently we do not
# (further!) complicate the implementation problem by requiring
# support for that.
##########################################################################
# Note[3] Gadget Redraw Protocol Design Considerations:
#
# A core idea here is that if a gadget updates its state say 100,000
# times a second (counting incoming ethernet packets, perhaps),
# we do NOT want it redrawing that often because it would overwhelm
# the rendering subsystem (and anyhow waste a lot of CPU + CPU time).
#
# Rather than have each gadget (most likely FAIL to) include redraw
# frequency throttling logic, we centralize this functionality here
# in guiboss_imp:
#
# o When a gadget updates its state, it calls # See for example src/lib/x-kit/widget/leaf/arrowbutton.pkg# gadget_to_guiboss.needs_redraw_gadget_request #
# which results in guiboss_imp setting the gadget's
# gadget_imp_info.needs_redraw_request := TRUE;
#
# o Each time guiboss_imp's "frameclock" thread wakes up # As a special tweak, once per frame guiboss_imp will send a
# (10-100 times per second, say), it sends a # guiboss_to_gadget.redraw_gadget_request
# guiboss_to_gadget.redraw_gadget_request # immediately upon receiving a
# all to each gadget with gadget_imp_info.needs_redraw_request == TRUE; # gadget_to_guiboss.needs_redraw_gadget_request
# # The intention here is to reduce GUI user-response latency
# o When (and only when) a gadget receives a redraw_gadget_request # by ten to a hundred milliseconds in the common case of only
# call, it does a # one user mouselick (or other input) per frameclock tick,
# gadget_to_guiboss.redraw_gadget # without risking runaway redraws.
# call to actually redraw itself. # This mechanism is implemented via
# # done_extra_redraw_request_this_frame: Ref(Bool),
# In general it is the gadget's responsibility to call
# gadget_to_guiboss.needs_redraw_gadget_request
# when it needs to be redrawn. There are exactly two
# situations in which guiboss_imp will send a
# guiboss_to_gadget.redraw_gadget_request
# without such prompting:
#
# 1) At GUI startup guiboss_imp sends a redraw_gadget_request
# to every gadget in the GUI, to establish the initial
# visual appearance of the GUI.
#
# 2) When a widget's assigned site changes (say, due to the # Window resizing is actually not supported as of 2014-11-28
# user resizing the window).
#
# Originally, to be helpful, guiboss_imp would spontaneously send a
# a redraw_gadget_request() to any gadget receiving a mouse event
# or such, but I eventually concluded that this was more confusing
# than helpful, and retreated to the above simple, easy-to-remember
# policy. (Also, spontaneous redraw_gadget_requests() could cause
# needless redraws, which for some gadgets might be quite expensive.)
#
# Note that there is no actual logic or interlock in place to
# prevent a gadget from ignoring the
# gadget_to_guiboss.needs_redraw_gadget_request
# guiboss_to_gadget.redraw_gadget_request
# handshake and simply sending
# gadget_to_guiboss.redraw_gadget
# There may be widget implementation problems for which this is
# actually a good solution, but it should be done only occasionally,
# after careful consideration of the alternatives and risks.
#
# -- CrT 2014-11-28