## translate-guiplan-to-guipane.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 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 gpj = guiboss_popup_junk; # guiboss_popup_junk is from src/lib/x-kit/widget/gui/guiboss-popup-junk.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 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_guiplan_to_guipane
: Translate_Guiplan_To_Guipane # Translate_Guiplan_To_Guipane is from src/lib/x-kit/widget/gui/translate-guiplan-to-guipane.api {
fun gp_widget__to__rg_widget #
{
gp_widget: gt::Gp_Widget_Type,
widgetspace_arg: gt::Widgetspace_Arg,
run_gun': Run_Gun,
subwindow_info: gt::Subwindow_Data,
me: gt::Guiboss_State,
widget_to_guiboss: gt::Widget_To_Guiboss,
gadget_to_guiboss: gt::Gadget_To_Guiboss,
guiboss_to_guishim: gtg::Guiboss_To_Guishim,
hostwindow_for_gui: gtg::Guiboss_To_Hostwindow,
space_to_gui: gt::Space_To_Gui,
#
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
}
: ( gt::Rg_Widget_Type,
{ guiboss_to_widgetspace: gt::Guiboss_To_Widgetspace,
shutdown_oneshot: Oneshot_Maildrop( Void )
}
)
=
{
(do_widgetspace widgetspace_arg)
->
stuff as { guiboss_to_widgetspace, shutdown_oneshot };
widgetspace_id = guiboss_to_widgetspace.id;
me.widgetspace_imps := idm::set (*me.widgetspace_imps, widgetspace_id, stuff);
subwindow_info -> gt::SUBWINDOW_DATA subwindow_info;
subwindow_info = gt::SUBWINDOW_INFO subwindow_info;
(do_gp_widget (gp_widget, subwindow_info)) #
->
rg_widget;
(rg_widget, stuff);
}
where
fun make_gadget_imp_info
(
guiboss_to_gadget: gt::Guiboss_To_Gadget,
subwindow_or_view: gt::Subwindow_Or_View
)
=
{
guiboss_to_gadget,
subwindow_or_view => REF subwindow_or_view,
#
needs_redraw_request => REF FALSE, # We do not want to draw until we've sent initialize_gadget to gadget.
sent__initialize_gadget => REF FALSE,
#
gadget_mode => REF { is_active => TRUE, has_mouse_focus => FALSE, has_keyboard_focus => FALSE },
site => REF g2d::box::zero,
#
point_in_gadget => REF (NULL: Null_Or( g2d::Point -> Bool )), # Optional fn to decide if a mouseclick actually hit the gadget itself, or just somewhere near it.
pixmaps => REF (im::empty: im::Map( g2p::Gadget_To_Rw_Pixmap )), # This tracks all X-server pixmaps created by this particular gadget. We need this so that we can reliably recycle them all when killing the gadget -- otherwise we're leaking memory in the X server.
#
at_frame_n => REF NULL, # Call gadget.wakeup once, during frame N, and pass wakeup_fn in call. NULL means this wakeup is off.
every_n_frames => REF NULL # Call gadget.wakeup every N frames, and pass wakeup_fn in call. NULL means this wakeup is off.
};
#
fun do_widgetspace (widgetspace_arg: gt::Widgetspace_Arg)
=
{ shutdown_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Void ); # When die() runs shutdown will be signalled via this oneshot.
#
widgetspace_egg
=
pai::make_widgetspace_egg widgetspace_arg (THE shutdown_oneshot);
(widgetspace_egg ())
->
(exports, widgetspace_egg');
exports -> { guiboss_to_widgetspace };
me.widgetspace_imps := idm::set (*me.widgetspace_imps, guiboss_to_widgetspace.id, { guiboss_to_widgetspace, shutdown_oneshot });
# NOT VERY SOON add gadget_to_guiboss to imports:
widgetspace_imports = { int_sink => \\ (i: Int) = (), space_to_gui };
widgetspace_egg' (widgetspace_imports, run_gun');
{ guiboss_to_widgetspace, shutdown_oneshot };
}
also
fun do_spritespace (spritespace_arg: gt::Spritespace_Arg)
=
{ shutdown_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Void ); # When die() runs shutdown will be signalled via this oneshot.
#
spritespace_egg
=
boi::make_spritespace_egg spritespace_arg (THE shutdown_oneshot);
(spritespace_egg ())
->
(exports, spritespace_egg');
exports -> { guiboss_to_spritespace, sprite_to_spritespace };
me.spritespace_imps := idm::set (*me.spritespace_imps, guiboss_to_spritespace.id, { guiboss_to_spritespace, sprite_to_spritespace, shutdown_oneshot });
# NOT VERY SOON add gadget_to_guiboss to imports:
spritespace_imports = { int_sink => \\ (i: Int) = () };
spritespace_egg' (spritespace_imports, run_gun');
{ guiboss_to_spritespace, sprite_to_spritespace, shutdown_oneshot };
}
also
fun do_objectspace (objectspace_arg: gt::Objectspace_Arg)
=
{ shutdown_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Void ); # When die() runs shutdown will be signalled via this oneshot.
#
objectspace_egg
=
cai::make_objectspace_egg objectspace_arg (THE shutdown_oneshot);
(objectspace_egg ())
->
(exports, objectspace_egg');
exports -> { guiboss_to_objectspace, object_to_objectspace };
me.objectspace_imps := idm::set (*me.objectspace_imps, guiboss_to_objectspace.id, { guiboss_to_objectspace, object_to_objectspace, shutdown_oneshot });
# NOT VERY SOON add gadget_to_guiboss to imports:
objectspace_imports = { int_sink => \\ (i: Int) = () };
objectspace_egg' (objectspace_imports, run_gun');
{ guiboss_to_objectspace, object_to_objectspace, shutdown_oneshot };
}
also
fun do_gp_sprite # XXX SUCKO FIXME should rename to do_sprite.
(
gp_sprite: gt::Gp_Sprite,
sprite_to_spritespace: s2s::Sprite_To_Spritespace,
current_subwindow_or_view: gt::Subwindow_Or_View
)
=
case gp_sprite
#
gt::SPRITE
(
(gt::SPRITE_START_FN sprite_start_fn): gt::Sprite_Start_Fn
)
=>
{
shutdown_oneshot # When endgun fires we'll read back final widget state via this oneshot.
=
make_oneshot_maildrop()
:
Oneshot_Maildrop ( Void );
#
(sprite_start_fn { gadget_to_guiboss, sprite_to_spritespace, run_gun', shutdown_oneshot })
->
{ guiboss_to_gadget, spritespace_to_sprite };
gadget_imp_info
=
make_gadget_imp_info (guiboss_to_gadget, current_subwindow_or_view);
me.gadget_imps := idm::set (*me.gadget_imps, guiboss_to_gadget.id, gadget_imp_info );
gt::RG_SPRITE { spritespace_to_sprite, guiboss_to_gadget, shutdown_oneshot };
};
esac
also
fun do_gp_object
(
gp_object: gt::Gp_Object,
object_to_objectspace: o2o::Object_To_Objectspace,
current_subwindow_or_view: gt::Subwindow_Or_View
)
=
case gp_object
#
gt::WIDGETSPACE (widgetspace_arg: gt::Widgetspace_Arg, gp_widget: gt::Gp_Widget_Type)
=>
{
(do_widgetspace widgetspace_arg)
->
stuff as { guiboss_to_widgetspace, shutdown_oneshot };
me.widgetspace_imps := idm::set (*me.widgetspace_imps, guiboss_to_widgetspace.id, stuff);
(do_gp_widget (gp_widget, current_subwindow_or_view))
->
rg_widget;
gt::RG_WIDGETSPACE { guiboss_to_widgetspace, rg_widget };
};
gt::OBJECT
(
(gt::OBJECT_START_FN object_start_fn): gt::Object_Start_Fn
)
=>
{
shutdown_oneshot # When endgun fires we'll read back final object state via this oneshot.
=
make_oneshot_maildrop()
:
Oneshot_Maildrop( Void );
#
(object_start_fn { gadget_to_guiboss, object_to_objectspace, run_gun', shutdown_oneshot })
->
{ guiboss_to_gadget, objectspace_to_object };
gadget_imp_info = make_gadget_imp_info (guiboss_to_gadget, current_subwindow_or_view);
me.gadget_imps := idm::set (*me.gadget_imps, guiboss_to_gadget.id, gadget_imp_info );
gt::RG_OBJECT { objectspace_to_object, guiboss_to_gadget, shutdown_oneshot };
};
esac
also
fun do_gp_widget
(
gp_widget: gt::Gp_Widget_Type, # 'gp_widgets' can be a tree of widgets with ROW and COL internal nodes.
current_subwindow_or_view: gt::Subwindow_Or_View # This will be a SCROLLABLE_INFO when we're processing widgets displayed in a scrollport.
)
=
{
fun do_grid ( id: Id,
gp_widgets: List( List( gt::Gp_Widget_Type )) # A grid of widgets. The GRID itself is not a widget (given no microthread).
)
=
{
my { high, wide } # 'wide' is used below in do_row; 'high' is unused.
=
grid_dimensions gp_widgets
#
where
fun grid_dimensions (grid: List( List( gt::Gp_Widget_Type )))
#
: g2d::Size
=
{ high = list::length grid;
wide = int::list_max (map list::length grid);
#
{ high, wide };
};
end;
regularized_grid # We should probably produce a 2D matrix of some sort as our result instead of another list of lists;
= # the code using the list-of-lists representation gets pretty ugly. XXX SUCKO FIXME.
regularize_grid gp_widgets # Make all rows same length by padding with blank.pkg widgets as needed.
#
where
fun regularize_grid (grid: List( List( gt::Gp_Widget_Type )))
=
map do_row grid
where
fun do_row (row: List( gt::Gp_Widget_Type ))
=
do_row' (row, wide, [])
where
fun do_row' (w ! rest, i, result)
=>
do_row' (rest, i - 1, w ! result);
do_row' ([], 0, result)
=>
reverse result;
do_row' ([], i, result)
=>
do_row' ([], i - 1, (blank::with []) ! result);
end;
end;
end;
end;
widgets = map do_row regularized_grid
where
fun do_row
(row: List( ( gt::Gp_Widget_Type) ))
=
map do_widget row
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
end;
end;
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
gt::RG_GRID { id,
widgets,
widget_layout_hint,
site
};
};
case gp_widget
#
gt::ROW (gp_widgets: List( gt::Gp_Widget_Type )) # A row of widgets. The ROW itself is not a widget (given no microthread).
=>
{ id = issue_unique_id();
#
widgets = map do_widget gp_widgets
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
end;
widget_layout_hint = REF gt::default_widget_layout_hint;
gt::RG_ROW { id,
widgets,
widget_layout_hint,
site => REF g2d::box::zero,
first_cut => NULL
};
};
gt::ROW' (id, gp_widgets: List( gt::Gp_Widget_Type )) # A row of widgets. The ROW itself is not a widget (given no microthread).
=>
{ widgets = map do_widget gp_widgets
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
end;
widget_layout_hint = REF gt::default_widget_layout_hint;
gt::RG_ROW { id,
widgets,
widget_layout_hint,
site => REF g2d::box::zero,
first_cut => NULL
};
};
gt::COL (gp_widgets: List( gt::Gp_Widget_Type )) # A column of widgets. The COL itself is not a widget (given no microthread).
=>
{ id = issue_unique_id();
#
widgets = map do_widget gp_widgets
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
end;
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
gt::RG_COL { id,
widgets,
widget_layout_hint,
site,
first_cut => NULL
};
};
gt::COL' (id, gp_widgets: List( gt::Gp_Widget_Type )) # A column of widgets. The COL itself is not a widget (given no microthread).
=>
{ widgets = map do_widget gp_widgets
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
end;
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
gt::RG_COL { id,
widgets,
widget_layout_hint,
site,
first_cut => NULL
};
};
gt::GRID (gp_widgets: List( List( gt::Gp_Widget_Type ))) # A grid of widgets. The GRID itself is not a widget (given no microthread).
=>
do_grid (issue_unique_id(), gp_widgets);
gt::GRID' ( id: Id,
gp_widgets: List( List( gt::Gp_Widget_Type )) # A grid of widgets. The GRID itself is not a widget (given no microthread).
)
=>
do_grid (id, gp_widgets);
gt::MARK (gp_widget: gt::Gp_Widget_Type) # A single widget. The MARK itself is not a widget (given no microthread).
=>
{ id = issue_unique_id();
#
widget = do_gp_widget (gp_widget, current_subwindow_or_view);
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
gt::RG_MARK { id,
doc => "",
widget,
widget_layout_hint,
site
};
};
gt::MARK' # Used to mark a spot in widget-tree for later reference, typically between Gadget_To_Guiboss get_guipiths() and install_updated_guipiths() calls.
(
id,
doc: String,
gp_widget: gt::Gp_Widget_Type
)
=>
{ widget = do_gp_widget (gp_widget, current_subwindow_or_view);
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
gt::RG_MARK { id,
doc,
widget,
widget_layout_hint,
site
};
};
gt::SCROLLPORT # A scrollport onto a scrollable pixmap
{
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.
}
=>
{ gp_widget = widget;
callback = scroller_callback;
#
gadget_to_rw_pixmap = guiboss_to_guishim.make_rw_pixmap
#
pixmap_size;
upperleft = REF { row => 0, # View upperleft in scrollport coordinates. Controls which part of view is visible in scrollport. guiboss-imp.pkg will update this in response to scrollbar motions etc.
col => 0
};
site = REF g2d::box::zero; # Dummy initial value -- real value will be set by assign_sites_to_all_widgets() in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg dummy_scroller = { get_scrollport_upperleft => \\ () = g2d::point::zero,
set_scrollport_upperleft => \\ _ = ()
};
rg_scrollport = { id => issue_unique_id (),
upperleft,
scroller => REF dummy_scroller, # (Dummy val overwritten below.) Client-code interface for controlling view_upperleft.
rg_widget => REF gt::RG_NULL_WIDGET, # (Dummy val overwritten below.)
callback => scroller_callback,
site,
pixmap => gadget_to_rw_pixmap, # The backing pixmap for this viewable.
#
parent_subwindow_or_view => current_subwindow_or_view # The subwindow_or_view we were doing before diving recursively into this view.
};
subwindow_or_view = gt::SCROLLABLE_INFO rg_scrollport; # Widgets use this to track what subwindow/view they are on.
rg_scrollport.rg_widget
:=
do_gp_widget # Process widget-tree in new subwindow_or_view not current_subwindow_or_view!
(
gp_widget,
subwindow_or_view
);
scrollport_scroller # Define the get/set fns client code uses to scroll the scrollport.
=
{ get_scrollport_upperleft,
set_scrollport_upperleft
}
where
fun get_scrollport_upperleft ()
=
*upperleft; # Upperleft of gadget_to_rw_pixmap in scrollport coordinates, used for scrolling pixmap in scrollport.
fun set_scrollport_upperleft (view_upperleft_in_scrollport_coordinates: g2d::Point)
=
{ # In this routine we must clearly distinguish three different coordinate systems.
# We are dealing with a subwindow_or_view for a scrollable view which is visible
# through a scrollport which is located on a parent subwindow_or_view.
# Thus, we have:
# o The coordinate system of the view itself, with 0,0 at upper-left of the view's backing pixmap.
# o The coordinate system of the parent, with 0,0 at upper-left of its own backing pixmap.
# o The coordinate system of the scrollport, with 0,0 at upper-left of the scrollport.
# These three coordinate systems are related by
# o site, which gives the scrollport upperleft (and size) in parent coordinates.
# o upperleft, which gives the view upperleft in scrollport coordinates.
# We have boxes in all three coordinate systems here, so we must track carefully which box is in which coordinate system.
upperleft := view_upperleft_in_scrollport_coordinates; # Note new upperleft of gadget_to_rw_pixmap in scrollport coordinates, used for scrolling pixmap in scrollport.
scrollport_site_in_parent_coordinates
=
*site; # <== From environment.
scrollport_upperleft_in_parent_coordinates
=
g2d::box::upperleft scrollport_site_in_parent_coordinates;
view_site_in_parent_coordinates
=
g2d::box::make
(
view_upperleft_in_scrollport_coordinates + scrollport_upperleft_in_parent_coordinates,
gadget_to_rw_pixmap.size # <== From environment.
);
view_site_in_view_coordinates
=
g2d::box::make
(
g2d::point::zero,
gadget_to_rw_pixmap.size # <== From environment.
);
scrollport_upperleft_in_view_coordinates
=
g2d::point::zero - view_upperleft_in_scrollport_coordinates;
scrollport_site_in_view_coordinates
=
g2d::box::clone_box_at
(
scrollport_site_in_parent_coordinates,
scrollport_upperleft_in_view_coordinates
);
if (not (g2d::box::box_a_in_box_b { a => scrollport_site_in_view_coordinates, # Does our pixmap fill the scrollport on parent pixmap?
b => view_site_in_view_coordinates
}
) )
# # No, so we have to clear the remainder of the scrollport.
#
boxes_to_clear = g2d::box::subtract_box_b_from_box_a # Express area to be cleared as a list of non-overlapping rectangles.
{
a => scrollport_site_in_parent_coordinates,
b => view_site_in_parent_coordinates
};
apply do_box boxes_to_clear # For each box to be cleared ...
where
fun do_box (box: g2d::Box)
=
{
clear_box_in_pixmap # ... fill it with black, then ...
#
(rg_scrollport.parent_subwindow_or_view, box); # <== From environment
#
update_offscreen_parent_pixmaps_and_then_hostwindow # ... copy that blackness all the way up the scrollport chain to visible hostwindow.
#
( rg_scrollport.parent_subwindow_or_view, # <== From environment
box,
hostwindow_for_gui # <== From environment
);
};
end;
fi;
from_box = g2d::box::intersection # We want to draw on parent only that part which is visible and which exists.
(
scrollport_site_in_view_coordinates, # This is the part that is visible.
view_site_in_view_coordinates # This is what exists.
);
case from_box
#
NULL => (); # No intersection means nothing to draw. Pixmap must be scrolled completely out of sight...
#
THE from_box => update_offscreen_parent_pixmaps_and_then_hostwindow # Draw visible part pixmap on parent.
#
( subwindow_or_view, # <== From environment
from_box,
hostwindow_for_gui # <== From environment
);
esac;
}; # fun set_scrollport_upperleft
end;
rg_scrollport.scroller := scrollport_scroller;
callback (THE scrollport_scroller); # Give app client code a handle with which to scroll gadget_to_rw_pixmap in scrollport.
gt::RG_SCROLLPORT rg_scrollport;
};
gt::TABPORT # A scrollport onto a set of alternate pixmaps for tabbed viewing.
(
callback: gt::Tab_Picker_Callback,
widget: gt::Gp_Widget_Type, # A little trick to use the type system to force the widget list to be non-empty -- we take the list to be (widget ! widgets).
widgets: List( gt::Gp_Widget_Type )
)
=>
{
############
# This is untested, immature code. 'pixmap_size' is inherited from
# scrollport, where it makes sense, since the size of the scrollable
# area visible through the viewport bears no necessary relation to
# scrollport.
#
# But the tabs all have the same size at the tabport, so either we
# should resize our pixmaps dynamically once we know what our site
# size is, or else maybe we shouldn't have per-tab pixmaps at all,
# and should just render our widgets directly onto our parent.
#
# [ LATER:
# In general I've been presuming that widgets always
# have a place to render to, and can do so at will.
# That gives nice clean semantics.
# Having some widgets (those on currently-invisible tabs)
# not have any place to render to would complicate
# the semantics to no huge win, which seems like a Bad Idea.
# So dynamically resizing tab pixmaps as required
# seems like the way to go. We may need to arrange
# some extra communication between widgetspace-imp
# and tabport to make this work...?
# ]
#
# [ STILL LATER:
# Looks like guiboss HAS to have the ability to ignore
# stale redraw commands to retain sanity in a concurrent
# world. So having it ignore ALL redraw commands from
# invisible widgets does not actually seem much of a stretch.
# #
# So now I'm thinking that extra per-tab pixmaps are just
# added complexity blindly carried over from the scrollport
# case (where we actually need them) and we should go with
# having tab widgets just render to parent subwindow pixmap.
# ]
#
# This needs thought. For now, the below code is at least a placeholder
# and a zero-th order approximation to what we need.
#
# The following magic constant is also buried in
# assign_sites_to_all_widgets/gt::RG_TABPORT in src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg #
############
widgets = widget ! widgets;
pixmap_size = { high => 400, wide => 800 }: g2d::Size;
if ((list::length widgets) == 0) # We could be more robust by supporting empty 'tabs', but that would give us special
log::fatal "TABBED_VIEWS needs at least one view! -- guiboss-imp.pkg"; # cases in the code every time we access visible_tab. Maybe it is worth it?
(); #
fi;
site = REF g2d::box::zero; # Dummy initial value -- real value will be 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).
visible = REF TRUE; # We'll default this to TRUE for first widget, FALSE for the rest.
id = issue_unique_id ();
tabs = map do_widget widgets
where
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
{ rg_widget = do_gp_widget ( gp_widget,
current_subwindow_or_view
);
#
gadget_to_rw_pixmap = guiboss_to_guishim.make_rw_pixmap
#
pixmap_size;
parent_subwindow_or_view = current_subwindow_or_view;
tabbable_info = { rg_widget,
pixmap => gadget_to_rw_pixmap, # The backing pixmap for this view.
parent_subwindow_or_view, # The subwindow_or_view we were doing before diving recursively into this view.
site, # Site of tabport on parent.
is_visible => REF *visible
};
visible := FALSE;
tabbable_info;
};
end;
visible_tab = REF 0; # Default to displaying first tab, if there is more than one.
tabbed_view_picker
=
{ get_active_tab,
set_active_tab
}
where
fun get_active_tab ()
=
*visible_tab;
fun set_active_tab (i: Int)
=
{ tab_count = list::length tabs;
#
if (i != *visible_tab) # Do nothing if client code is re-selecting already-active tabview.
#
if (i >= 0 and i < tab_count)
#
this_tab = list::nth (tabs, *visible_tab);
this_tab.is_visible := FALSE; # Remember previously visible view is now not visible.
visible_tab := i;
this_tab = list::nth (tabs, *visible_tab);
this_tab.is_visible := TRUE; # Remember newly visible view is now visible.
else
log::note_on_stderr {. sprintf "set_active_view: arg = %d not in range 0 -> %d\n" i tab_count; };
fi;
this_tab = list::nth (tabs, *visible_tab);
from_box = g2d::box::make # We want to update the whole pixmap. (A tabview should always be the same size as the tabport, and all of it needs updating.)
(
g2d::point::zero,
this_tab.pixmap.size
);
update_offscreen_parent_pixmaps_and_then_hostwindow # Draw pixmap on parent.
#
( gt::TABBABLE_INFO this_tab,
from_box,
hostwindow_for_gui
);
fi;
();
};
end;
callback (THE tabbed_view_picker); # Give app client code a handle with which to select which tab is visible in tabport.
gt::RG_TABPORT { id, callback, tabs, visible_tab, site };
};
gt::FRAME
(
options: List( gt::Frame_Option ),
widget: gt::Gp_Widget_Type
)
=>
{
frame_widget
=
case options
#
[ ] => frm::with []; # Default to standard frame from src/lib/x-kit/widget/leaf/frame.pkg [ gt::FRAME_WIDGET frame_widget ] => frame_widget; # Custom frame widget. This won't work currently if margins are non-default, but changing relief is ok.
_ => { msg = "Unsupported List(Frame_Option) arg in paused_gui__to__guipane/gt::GP_FRAME -- guiboss-imp.pkg";
log::fatal msg;
raise exception DIE msg;
};
esac;
fun do_widget
(
gp_widget: gt::Gp_Widget_Type
)
=
do_gp_widget (gp_widget, current_subwindow_or_view);
widget = do_widget widget;
frame_widget = do_widget frame_widget;
widget_layout_hint = REF gt::default_widget_layout_hint;
site = REF g2d::box::zero;
id = issue_unique_id ();
gt::RG_FRAME
{ id,
frame_widget,
widget,
widget_layout_hint,
site
};
};
gt::WIDGET (widget as (gt::WIDGET_START_FN widget_start_fn): gt::Widget_Start_Fn) # widget_start_fn was generated by make_widget_start_fn in src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg =>
{ shutdown_oneshot # When endgun fires we'll read back final widget state via this oneshot.
=
make_oneshot_maildrop()
:
Oneshot_Maildrop ( Void );
#
(widget_start_fn { widget_to_guiboss, run_gun', shutdown_oneshot })
->
{ guiboss_to_widget };
gadget_imp_info = make_gadget_imp_info (guiboss_to_widget.g, current_subwindow_or_view);
me.gadget_imps := idm::set (*me.gadget_imps, guiboss_to_widget.g.id, gadget_imp_info );
site = REF g2d::box::zero;
gt::RG_WIDGET { guiboss_to_widget, shutdown_oneshot, site };
};
gt::OBJECTSPACE
( objectspace_arg: gt::Objectspace_Arg,
gp_objects: List( gt::Gp_Object )
)
=>
{
(do_objectspace objectspace_arg)
->
stuff as { guiboss_to_objectspace, object_to_objectspace, shutdown_oneshot };
objectspace_id = guiboss_to_objectspace.id;
me.objectspace_imps := idm::set (*me.objectspace_imps, objectspace_id, stuff);
#
objects = map do_object gp_objects
where
fun do_object (gp_object: gt::Gp_Object)
=
do_gp_object (gp_object, object_to_objectspace, current_subwindow_or_view);
end;
site = REF g2d::box::zero;
gt::RG_OBJECTSPACE { guiboss_to_objectspace, object_to_objectspace, objects, site };
};
gt::SPRITESPACE
( spritespace_arg: gt::Spritespace_Arg,
gp_sprites: List(gt::Gp_Sprite)
)
=>
{
(do_spritespace spritespace_arg)
->
stuff as { guiboss_to_spritespace, sprite_to_spritespace, shutdown_oneshot };
me.spritespace_imps := idm::set (*me.spritespace_imps, guiboss_to_spritespace.id, stuff);
#
sprites = map do_sprite gp_sprites
where
fun do_sprite (gp_sprite: gt::Gp_Sprite)
=
do_gp_sprite (gp_sprite, sprite_to_spritespace, current_subwindow_or_view);
end;
site = REF g2d::box::zero;
gt::RG_SPRITESPACE { guiboss_to_spritespace, sprite_to_spritespace, sprites, site };
};
gt::NULL_WIDGET
=>
gt::RG_NULL_WIDGET;
esac;
};
end; # fun gp_widget__to__rg_widget
fun guiplan_to_guipane
#
( context
as
{ run_gun': Run_Gun,
subwindow_info: gt::Subwindow_Data,
me: gt::Guiboss_State,
widget_to_guiboss: gt::Widget_To_Guiboss,
gadget_to_guiboss: gt::Gadget_To_Guiboss,
guiboss_to_guishim: gtg::Guiboss_To_Guishim,
hostwindow_for_gui: gtg::Guiboss_To_Hostwindow,
space_to_gui: gt::Space_To_Gui,
#
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
}
)
#
(guiplan: gt::Guiplan)
:
gt::Guipane
=
{ gp_widget = guiplan;
#
(gp_widget__to__rg_widget #
{
gp_widget,
widgetspace_arg => [],
#
run_gun',
subwindow_info,
me,
widget_to_guiboss,
gadget_to_guiboss,
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
}
)
-> ( rg_widget,
#
{ guiboss_to_widgetspace: gt::Guiboss_To_Widgetspace,
shutdown_oneshot: Oneshot_Maildrop( Void )
}
);
{ id => issue_unique_id (),
rg_widget,
guiboss_to_widgetspace,
widget_to_guiboss,
space_to_gui,
subwindow_info,
hostwindow => hostwindow_for_gui,
needs_layout_and_redraw => REF FALSE
};
};
};
end;