# object-imp.pkg
#
# For background see comments at top of
# src/lib/x-kit/widget/gui/guiboss-imp.pkg#
# This file is like widget_imp, but for src/lib/x-kit/widget/space/object/objectspace-imp.pkg# instead of src/lib/x-kit/widget/space/widget/widgetspace-imp.pkg#
# Compare to:
# src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg# 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 xet = xevent_types; # xevent_types is from src/lib/x-kit/xclient/src/wire/xevent-types.pkg# package w2x = windowsystem_to_xserver; # windowsystem_to_xserver is from src/lib/x-kit/xclient/src/window/windowsystem-to-xserver.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 rgb = rgb; # rgb is from src/lib/x-kit/xclient/src/color/rgb.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 e2s = xevent_to_string; # xevent_to_string is from src/lib/x-kit/xclient/src/to-string/xevent-to-string.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 xt = xtypes; # xtypes is from src/lib/x-kit/xclient/src/wire/xtypes.pkg# package xtr = xlogger; # xlogger is from src/lib/x-kit/xclient/src/stuff/xlogger.pkg package gtg = guiboss_to_guishim; # guiboss_to_guishim is from src/lib/x-kit/widget/theme/guiboss-to-guishim.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 r8 = rgb8; # rgb8 is from src/lib/x-kit/xclient/src/color/rgb8.pkg #
package w2p = object_to_objectspace; # object_to_objectspace is from src/lib/x-kit/widget/space/object/object-to-objectspace.pkg package p2w = objectspace_to_object; # objectspace_to_object is from src/lib/x-kit/widget/space/object/objectspace-to-object.pkg #
package g2d = geometry2d; # geometry2d is from src/lib/std/2d/geometry2d.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 wt = widget_theme; # widget_theme is from src/lib/x-kit/widget/theme/widget/widget-theme.pkg package g2p = gadget_to_pixmap; # gadget_to_pixmap is from src/lib/x-kit/widget/theme/gadget-to-pixmap.pkg #
tracefile = "widget-unit-test.trace.log";
nb = log::note_on_stderr; # log is from src/lib/std/src/log.pkgherein
# This package is referenced in:
#
#
package object_imp
: Object_Imp # Object_Imp is from src/lib/x-kit/widget/xkit/theme/widget/default/look/object-imp.api {
Object # This turns out not to get used in practice, and probably should be dropped if no use turns up for it.
=
{ id: Id, # Unique id to facilitate storing node_state instances in indexed datastructures like red-black trees.
pass_something: Replyqueue -> (Int -> Void) -> Void,
do_something: Int -> Void,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
};
Startup_Fn
=
{
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
->
Void;
Shutdown_Fn
=
Void
->
Void; #
Initialize_Gadget_Fn
=
{
id: Id, # Unique id.
doc: String,
site: g2d::Box, # Window rectangle in which to draw.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
pass_font: List(String) -> Replyqueue
-> (evt::Font -> Void) -> Void, # Nonblocking version of next, for use in imps.
get_font: List(String) -> evt::Font, # Accepts a list of font names which are tried in order.
make_rw_pixmap: g2d::Size -> g2p::Gadget_To_Rw_Pixmap, # Make an Xserver-side rw_pixmap for scratch use by widget. In general there is no need for the object to explicitly free these -- guiboss_imp will do this automatically when the gui is killed.
#
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
->
Void;
Redraw_Request_Fn
=
{
id: Id, # Unique id.
doc: String,
frame_number: Int, # 1,2,3,... Purely for convenience of widget, guiboss-imp makes no use of this.
site: g2d::Box, # Window rectangle in which to draw.
popup_nesting_depth: Int, # 0 for gadgets on basewindow, 1 for gadgets on popup on basewindow, 2 for gadgets on popup on popup, etc.
#
duration_in_seconds: Float, # If state has changed look-imp should call redraw_gadget() before this time is up. Also useful for motionblur.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
gadget_mode: gt::Gadget_Mode,
#
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
->
Void;
Mouse_Click_Fn
=
{
id: Id, # Unique id.
doc: String,
event: gt::Mousebutton_Event, # MOUSEBUTTON_PRESS or MOUSEBUTTON_RELEASE.
button: evt::Mousebutton,
point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme
}
->
Void;
Mouse_Transit_Fn # Note that buttons are always all up in a mouse-transit event -- otherwise it is a mouse-drag event.
=
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
transit: gt::Gadget_Transit, # Mouse is entering (CAME) or leaving (LEFT) widget, or moving (MOVE) across it.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
->
Void;
Mouse_Drag_Fn
=
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase, # LAUNCH/MOTION/FINISH.
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
->
Void;
Key_Event_Fn
=
{
id: Id, # Unique id.
doc: String,
keystroke: gt::Keystroke_Info, # Keystring etc for event.
site: g2d::Box, # Widget's assigned area in window coordinates.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme
}
->
Void;
Note_Keyboard_Focus_Fn_Arg
=
{
id: Id, # Unique id.
doc: String,
have_keyboard_focus: Bool, #
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
};
Note_Keyboard_Focus_Fn = Note_Keyboard_Focus_Fn_Arg -> Void;
Object_Option
#
= MICROTHREAD_NAME String #
| ID Id # Unique ID for imp, issued by issue_unique_id::issue_unique_id().
| DOC String # Documentation string for widget, for debugging purposes.
#
| WIDGET_CONTROL_CALLBACK ( p2w::Objectspace_To_Object -> Void ) # Gui boss registers this maildrop to get a port to us once we start up.
| OBJECT_CALLBACK ( Null_Or(Object) -> Void ) # App registers this maildrop to get (THE object_port) from us once we start up, and NULL when we shut down.
#
| STARTUP_FN Startup_Fn # Application-specific handler for object-imp startup.
| SHUTDOWN_FN Shutdown_Fn # Application-specific handler for object-imp shutdown -- mainly saving state for possible later object restart.
# #
| INITIALIZE_GADGET_FN Initialize_Gadget_Fn # Typically used to set up widget background.
| REDRAW_REQUEST_FN Redraw_Request_Fn # Application-specific handler for please-redraw-yourself events from guiboss-imp.
#
| MOUSE_CLICK_FN Mouse_Click_Fn # Application-specific handler for mousebutton clicks.
#
| MOUSE_DRAG_FN Mouse_Drag_Fn # Application-specific handler for mouse motions.
| MOUSE_TRANSIT_FN Mouse_Transit_Fn # Application-specific handler for mouse motions.
#
| KEY_EVENT_FN Key_Event_Fn # Application-specific handler for keyboard key-press and key-release events.
| NOTE_KEYBOARD_FOCUS_FN Note_Keyboard_Focus_Fn
;
Object_Arg = List(Object_Option); # No required components at present.
# pprint_object_arg: pp::Prettyprinter -> Object_Arg -> Void;
#
Runstate = { # These values will be statically globally visible throughout the code body for the imp.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
id: Id,
doc: String,
#
startup_fn: Startup_Fn, #
shutdown_fn: Shutdown_Fn, #
#
initialize_gadget_fn: Initialize_Gadget_Fn,
redraw_request_fn: Redraw_Request_Fn,
#
mouse_click_fn: Mouse_Click_Fn,
#
mouse_drag_fn: Mouse_Drag_Fn,
mouse_transit_fn: Mouse_Transit_Fn,
#
key_event_fn: Key_Event_Fn,
note_keyboard_focus_fn: Note_Keyboard_Focus_Fn,
wants_keystrokes: Bool,
wants_mouseclicks: Bool,
# These five provide generic widget connectivity with the guiboss world.
gadget_to_guiboss: gt::Gadget_To_Guiboss, #
object_to_objectspace: w2p::Object_To_Objectspace, #
object_callbacks: List( Null_Or(Object) -> Void ), # In shut_down_object_imp' () we use these to inform app code that our object ports are no longer valid.
shutdown_oneshot: Oneshot_Maildrop( Void )
# THIS IS NO LONGER NEEDED now that Paused_Gui is gone. XXX SUCKO FIXME:
# object_start_fn: gt::Object_Start_Fn
};
Mailq = Mailqueue( Runstate -> Void );
fun default_startup_fn
{
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
do: (Void -> Void) -> Void # Used by widget subthreads to execute code in main widget microthread.
}
=
();
fun default_shutdown_fn ()
=
();
fun default_initialize_gadget_fn
{
id: Id, # Unique id.
doc: String,
site: g2d::Box, # Window rectangle in which to draw.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
pass_font: List(String) -> Replyqueue
-> (evt::Font -> Void) -> Void, # Nonblocking version of next, for use in imps.
get_font: List(String) -> evt::Font, # Accepts a list of font names which are tried in order.
make_rw_pixmap: g2d::Size -> g2p::Gadget_To_Rw_Pixmap,
#
do: (Void -> Void) -> Void # Used by widget subthreads to execute code in main widget microthread.
}
=
{
};
fun default_redraw_request_fn
{
id: Id, # Unique id.
doc: String,
frame_number: Int, # 1,2,3,... Purely for convenience of widget-imp, guiboss-imp makes no use of this.
site: g2d::Box, # Window rectangle in which to draw.
popup_nesting_depth: Int, # 0 for gadgets on basewindow, 1 for gadgets on popup on basewindow, 2 for gadgets on popup on popup, etc.
#
duration_in_seconds: Float, # If state has changed widget-imp should call redraw_gadget() before this time is up. Also useful for motionblur.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
gadget_mode: gt::Gadget_Mode,
#
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to execute code in main widget microthread.
}
=
{
};
fun default_mouse_click_fn
{
id: Id, # Unique id.
doc: String,
event: gt::Mousebutton_Event, # MOUSEBUTON_PRESS or MOUSEBUTTON_RELEASE.
button: evt::Mousebutton,
point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme
}
=
();
fun default_mouse_drag_fn
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
phase: gt::Drag_Phase,
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to execute code in main widget microthread.
}
=
();
fun default_mouse_transit_fn # Note that buttons are always all up in a mouse motion -- otherwise it is a mouse-drag event.
{
id: Id, # Unique id.
doc: String,
event_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
transit: gt::Gadget_Transit, # Mouse is entering (CAME) or leaving (LEFT) widget, or moving (MOVE) across it.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to execute code in main widget microthread.
}
=
();
fun default_key_event_fn
{
id: Id, # Unique id.
doc: String,
keystroke: gt::Keystroke_Info, # Keystring etc for event.
site: g2d::Box, # Widget's assigned area in window coordinates.
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme
}
=
();
fun default_note_keyboard_focus_fn
{
id: Id, # Unique id.
doc: String,
have_keyboard_focus: Bool, #
gadget_to_guiboss: gt::Gadget_To_Guiboss,
object_to_objectspace: w2p::Object_To_Objectspace,
theme: wt::Widget_Theme,
do: (Void -> Void) -> Void # Used by widget subthreads to run code in main widget microthread.
}
=
();
fun shut_down_object_imp (r: Runstate)
=
{ apply {. #callback NULL; } r.object_callbacks; # Tell guiboss that our object port is no longer valid.
#
put_in_oneshot (r.shutdown_oneshot, ()); # Signal guiboss that we've shut down.
# # The point here is that we could build and return a new closure locking in updated state if we wished.
thread_exit { success => TRUE }; # Will not return.
};
fun run (
mailq: Mailq, #
#
runstate as
{ # These values will be statically globally visible throughout the code body for the imp.
to: Replyqueue, # The name makes foo::pass_something(imp) to {. ... } syntax read well.
id: Id,
doc: String,
#
startup_fn: Startup_Fn, #
shutdown_fn: Shutdown_Fn, #
#
initialize_gadget_fn: Initialize_Gadget_Fn,
redraw_request_fn: Redraw_Request_Fn,
#
mouse_click_fn: Mouse_Click_Fn,
#
mouse_drag_fn: Mouse_Drag_Fn,
mouse_transit_fn: Mouse_Transit_Fn,
#
key_event_fn: Key_Event_Fn,
note_keyboard_focus_fn: Note_Keyboard_Focus_Fn,
#
wants_keystrokes: Bool,
wants_mouseclicks: Bool,
# These five provide generic widget connectivity with the guiboss world.
gadget_to_guiboss: gt::Gadget_To_Guiboss, #
object_to_objectspace: w2p::Object_To_Objectspace, #
object_callbacks: List( Null_Or(Object) -> Void ), # In shut_down_object_imp' () we use these to inform app code that our object ports are no longer valid.
shutdown_oneshot: Oneshot_Maildrop( Void )
# object_start_fn: gt::Object_Start_Fn
}
)
=
{
loop ();
}
where
fun loop () # Outer loop for the imp.
=
{ do_one_mailop' to [
#
(take_from_mailqueue' mailq ==> do_plea)
];
loop ();
}
where
fun do_plea thunk
=
thunk runstate;
fun shut_down_object_imp' ()
=
shut_down_object_imp runstate;
end;
end;
fun startup # Root fn of imp microthread.
{ id: Id,
doc: String,
reply_oneshot: Oneshot_Maildrop( gt::Object_Exports ),
#
object_callbacks,
widget_control_callbacks,
startup_fn: Startup_Fn, #
shutdown_fn: Shutdown_Fn, #
#
initialize_gadget_fn: Initialize_Gadget_Fn,
redraw_request_fn: Redraw_Request_Fn,
#
mouse_click_fn: Mouse_Click_Fn,
#
mouse_drag_fn: Mouse_Drag_Fn,
mouse_transit_fn: Mouse_Transit_Fn,
#
key_event_fn: Key_Event_Fn,
note_keyboard_focus_fn: Note_Keyboard_Focus_Fn,
#
wants_keystrokes: Bool,
wants_mouseclicks: Bool,
# These five provide generic widget connectivity with the guiboss world.
gadget_to_guiboss: gt::Gadget_To_Guiboss, #
object_to_objectspace: w2p::Object_To_Objectspace, #
run_gun': Run_Gun,
shutdown_oneshot: Oneshot_Maildrop( Void )
# object_start_fn: gt::Object_Start_Fn
}
() # Note currying.
=
{ objectspace_to_object = { id, do_something, pass_something, pass_draw_done_flag };
object = { id, do, do_something, pass_something };
guiboss_to_gadget = { id,
doc,
#
wants_keystrokes,
wants_mouseclicks,
#
initialize_gadget,
redraw_gadget_request,
#
note_keyboard_focus,
note_key_event,
#
note_mousebutton_event,
#
note_mouse_drag_event,
note_mouse_transit,
#
wakeup,
die
};
exports = { guiboss_to_gadget,
objectspace_to_object
};
to = make_replyqueue();
put_in_oneshot (reply_oneshot, exports); # Return value from object_start_fn().
apply {. #callback (THE object); } object_callbacks; # Pass our object port to everyone who asked for it.
apply {. #callback objectspace_to_object; } widget_control_callbacks; # Pass our port to everyone who asked for it.
block_until_mailop_fires run_gun'; # Wait for the starting gun.
startup_fn # Let application-specific code handle startup however it likes.
{ # Typically it will set widget foreground and background via
gadget_to_guiboss,
object_to_objectspace,
do
};
run (mailq, { # Will not return.
to,
id,
doc,
startup_fn, #
shutdown_fn, #
#
initialize_gadget_fn,
redraw_request_fn,
#
mouse_click_fn,
#
mouse_drag_fn,
mouse_transit_fn,
#
key_event_fn,
note_keyboard_focus_fn,
#
wants_keystrokes,
wants_mouseclicks,
# These five provide generic widget connectivity with the guiboss world.
gadget_to_guiboss, #
object_to_objectspace, #
object_callbacks, # In shut_down_object_imp' () we use these to inform app code that our object ports are no longer valid.
shutdown_oneshot
# object_start_fn
}
);
}
where
mailq = make_mailqueue (get_current_microthread()): Mailq;
doc = ""; # Docstring for this object. XXX SUCKO FIXME. This is a placeholder, doc functionality need to be coded up per the pattern in src/lib/x-kit/widget/xkit/theme/widget/default/look/widget-imp.pkg fun do (thunk: Void -> Void) # PUBLIC.
=
put_in_mailqueue (mailq,
#
\\ ({ gadget_to_guiboss, ... }: Runstate)
=
thunk ()
);
#######################################################################
# guiboss_to_gadget fns:
fun initialize_gadget # We get this call at the start of every frame from src/lib/x-kit/widget/gui/guiboss-imp.pkg {
site: g2d::Box, # Window rectangle in which to draw.
theme: wt::Widget_Theme,
get_font: List(String) -> evt::Font, # Accepts a list of font names which are tried in order; returns font 'ascent' and 'descent' in pixels -- sum them to get font height.
pass_font: List(String) -> Replyqueue #
-> ( evt::Font -> Void ) #
-> Void, # Nonblocking version of next, for use in imps.
make_rw_pixmap: g2d::Size -> g2p::Gadget_To_Rw_Pixmap
}
=
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
{
initialize_gadget_fn # Let application-specific code handle start-of-frame however it likes.
{
id,
site,
doc,
#
gadget_to_guiboss,
object_to_objectspace,
theme,
get_font,
pass_font,
make_rw_pixmap,
do
};
}
);
fun die ()
=
put_in_mailqueue (mailq,
#
\\ (runstate: Runstate)
=
shut_down_object_imp runstate
);
fun redraw_gadget_request # We get this call at the start of every frame from src/lib/x-kit/widget/gui/guiboss-imp.pkg {
frame_number: Int, # 1,2,3,... Purely for convenience of widget, guiboss-imp makes no use of this.
site: g2d::Box, # Window rectangle in which to draw.
duration_in_seconds: Float, # If state has changed look-imp should call redraw_gadget() before this time is up. Also useful for motionblur.
gadget_mode: gt::Gadget_Mode, # is_active/has_keyboard_focus/has_mouse_focus flags.
theme: wt::Widget_Theme,
popup_nesting_depth: Int # 0 for gadgets on basewindow, 1 for gadgets on popup on basewindow, 2 for gadgets on popup on popup, etc.
}
=
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
{
redraw_request_fn # Let application-specific code handle please-redraw-yourself however it likes.
{
id,
doc,
frame_number,
site,
duration_in_seconds,
popup_nesting_depth,
#
gadget_to_guiboss,
object_to_objectspace,
gadget_mode,
theme,
do
};
}
);
fun wakeup # These calls are scheduled via gadget_to_guiboss.wake_me.
{
wakeup_arg: gt::Wakeup_Arg, #
wakeup_fn: gt::Wakeup_Arg -> Void
}
=
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, ... }: Runstate)
=
wakeup_fn wakeup_arg
);
fun note_keyboard_focus
(
have_keyboard_focus: Bool, # TRUE means we now have keyboard focus, FALSE means we no longer have it. Allows gadget to visually display focus locus, typically via a black outline and/or dis/abling cursor. See also Gadget_To_Guiboss.request_keyboard_focus
theme: wt::Widget_Theme
)
=
{
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
note_keyboard_focus_fn
{
id,
doc,
have_keyboard_focus,
gadget_to_guiboss,
object_to_objectspace,
theme,
do
}
);
();
};
fun note_mouse_transit # Note that buttons are always all up in a mouse-transit event -- otherwise it is a mouse-drag event.
{
transit: gt::Gadget_Transit, # Mouse is entering (CAME) or leaving (LEFT) widget, or moving (MOVE) across it.
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
event_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
theme: wt::Widget_Theme
} # Note keyboard keypress at 'point'.
= # ^ # 'point' ise the click point the window's coordinate system.
{ # Keyboard key just pressed down. #
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
mouse_transit_fn
{
id,
doc,
event_point,
site,
transit,
modifier_keys_state,
gadget_to_guiboss,
object_to_objectspace,
theme,
do
}
);
();
};
fun note_mouse_drag_event
{
phase: gt::Drag_Phase, # LAUNCH/MOTION/FINISH.
button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
event_point: g2d::Point,
start_point: g2d::Point,
last_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
theme: wt::Widget_Theme
} # Note keyboard keypress at 'point'.
= # ^ # 'point' ise the click point the window's coordinate system.
{ # Keyboard key just pressed down. #
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
mouse_drag_fn
{
id,
doc,
event_point,
start_point,
last_point,
site,
phase,
button,
modifier_keys_state,
mousebuttons_state,
gadget_to_guiboss,
object_to_objectspace,
theme,
do
}
);
();
};
fun note_key_event
{
keystroke
as
{ key_event: gt::Key_Event, # KEY_PRESS or KEY_RELEASE.
keycode: evt::Keycode, # Keycode of the key.
keysym: evt::Keysym, # Keysym of the key.
keystring: String, # Ascii for the key.
keychar: Char, # First char of 'string' ('\0' if string-length != 1).
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State # State of mouse buttons as a bool record.
}: gt::Keystroke_Info,
site: g2d::Box, # Widget's assigned area in window coordinates.
theme: wt::Widget_Theme
} # Note keyboard keypress at 'point'.
= # ^ # 'point' ise the click point the window's coordinate system.
{ # Keyboard key just pressed down. #
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
key_event_fn
{
id,
doc,
keystroke,
site,
gadget_to_guiboss,
object_to_objectspace,
theme
}
);
};
fun note_mousebutton_event
{
mousebutton_event: gt::Mousebutton_Event, # MOUSEBUTTON_PRESS or MOUSEBUTTON_RELEASE.
mouse_button: evt::Mousebutton,
modifier_keys_state: evt::Modifier_Keys_State, # State of the modifier keys (shift, ctrl...).
mousebuttons_state: evt::Mousebuttons_State, # State of mouse buttons as a bool record.
event_point: g2d::Point,
site: g2d::Box, # Widget's assigned area in window coordinates.
theme: wt::Widget_Theme
} # Note mousebutton click at 'point'.
= # ^ # 'point' is the click point in the window's coordinate system.
{ # Mouse button just clicked down. #
put_in_mailqueue (mailq,
#
\\ ({ id, gadget_to_guiboss, object_to_objectspace, ... }: Runstate)
=
mouse_click_fn
{
id,
doc,
event => mousebutton_event,
button => mouse_button,
point => event_point,
site,
modifier_keys_state, # State of the modifier keys (shift, ctrl...).
mousebuttons_state, # State of mouse buttons as a bool record.
gadget_to_guiboss,
object_to_objectspace,
theme
}
);
};
#######################################################################
# objectspace_to_object fns:
fun do_something (i: Int) # PUBLIC.
=
put_in_mailqueue (mailq,
#
\\ ({ gadget_to_guiboss, ... }: Runstate)
=
()
);
fun pass_something (replyqueue: Replyqueue) (reply_handler: Int -> Void) # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Int );
#
put_in_mailqueue (mailq,
#
\\ (_: Runstate)
=
put_in_oneshot (reply_oneshot, 0)
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
fun pass_draw_done_flag (replyqueue: Replyqueue) (reply_handler: Void -> Void) # PUBLIC.
=
{ reply_oneshot = make_oneshot_maildrop(): Oneshot_Maildrop( Void );
#
put_in_mailqueue (mailq,
#
\\ (_: Runstate)
=
put_in_oneshot (reply_oneshot, ())
);
put_in_replyqueue (replyqueue, (get_from_oneshot' reply_oneshot) ==> reply_handler);
};
end;
fun process_options
( options: List(Object_Option),
#
{ name,
id,
doc,
#
object_callbacks,
widget_control_callbacks,
#
startup_fn,
shutdown_fn,
#
initialize_gadget_fn,
redraw_request_fn,
#
mouse_click_fn,
#
mouse_drag_fn,
mouse_transit_fn,
#
key_event_fn,
note_keyboard_focus_fn,
#
wants_keystrokes,
wants_mouseclicks
}
)
=
{ my_name = REF name;
my_id = REF id;
my_doc = REF doc;
#
my_object_callbacks = REF object_callbacks;
my_widget_control_callbacks = REF widget_control_callbacks;
#
my_startup_fn = REF startup_fn;
my_shutdown_fn = REF shutdown_fn;
#
my_initialize_gadget_fn = REF initialize_gadget_fn;
my_redraw_request_fn = REF redraw_request_fn;
#
my_mouse_click_fn = REF mouse_click_fn;
#
my_mouse_drag_fn = REF mouse_drag_fn;
my_mouse_transit_fn = REF mouse_transit_fn;
#
my_key_event_fn = REF key_event_fn;
my_note_keyboard_focus_fn = REF note_keyboard_focus_fn;
#
my_wants_keystrokes = REF wants_keystrokes;
my_wants_mouseclicks = REF wants_mouseclicks;
#
apply do_option options
where
fun do_option (MICROTHREAD_NAME n ) => my_name := n;
do_option (ID i ) => my_id := i;
do_option (DOC i) => my_doc := i;
#
do_option (OBJECT_CALLBACK c ) => my_object_callbacks := c ! *my_object_callbacks;
do_option (WIDGET_CONTROL_CALLBACK c ) => my_widget_control_callbacks := c ! *my_widget_control_callbacks;
#
do_option (STARTUP_FN fn) => my_startup_fn := fn;
do_option (SHUTDOWN_FN fn) => my_shutdown_fn := fn;
#
do_option (INITIALIZE_GADGET_FN fn) => my_initialize_gadget_fn := fn;
do_option (REDRAW_REQUEST_FN fn) => my_redraw_request_fn := fn;
#
do_option (MOUSE_CLICK_FN fn) => { my_mouse_click_fn := fn; my_wants_mouseclicks := TRUE; };
#
do_option (MOUSE_DRAG_FN fn) => { my_mouse_drag_fn := fn; };
do_option (MOUSE_TRANSIT_FN fn) => { my_mouse_transit_fn := fn; };
#
do_option (KEY_EVENT_FN fn) => { my_key_event_fn := fn; my_wants_keystrokes := TRUE; };
do_option (NOTE_KEYBOARD_FOCUS_FN fn) => { my_note_keyboard_focus_fn := fn; };
end;
end;
{ name => *my_name,
id => *my_id,
doc => *my_doc,
#
object_callbacks => *my_object_callbacks,
widget_control_callbacks => *my_widget_control_callbacks,
#
startup_fn => *my_startup_fn,
shutdown_fn => *my_shutdown_fn,
#
initialize_gadget_fn => *my_initialize_gadget_fn,
redraw_request_fn => *my_redraw_request_fn,
#
mouse_click_fn => *my_mouse_click_fn,
#
mouse_drag_fn => *my_mouse_drag_fn,
mouse_transit_fn => *my_mouse_transit_fn,
#
key_event_fn => *my_key_event_fn,
note_keyboard_focus_fn => *my_note_keyboard_focus_fn,
#
wants_keystrokes => *my_wants_keystrokes,
wants_mouseclicks => *my_wants_mouseclicks
};
};
# We do not use our usual Imports/Exports driven
# imp startup protocol here because we want to
# keep guiboss_imp from knowing anything about # guiboss_imp is from src/lib/x-kit/widget/gui/guiboss-imp.pkg # the state types of widgets to avoid an explosion
# of cases in guiboss_imp, one per widget, but we
# do want guiboss_imp to do the actual widget-imp
# startup.
#
fun make_object_start_fn (widget_options: List(Object_Option))
=
{
(process_options
( widget_options,
{ name => "object",
id => id_zero,
doc => "",
#
object_callbacks => [],
widget_control_callbacks => [],
#
startup_fn => default_startup_fn,
shutdown_fn => default_shutdown_fn,
#
initialize_gadget_fn => default_initialize_gadget_fn,
redraw_request_fn => default_redraw_request_fn,
#
mouse_click_fn => default_mouse_click_fn,
#
mouse_drag_fn => default_mouse_drag_fn,
mouse_transit_fn => default_mouse_transit_fn,
#
key_event_fn => default_key_event_fn,
note_keyboard_focus_fn => default_note_keyboard_focus_fn,
#
wants_keystrokes => FALSE,
wants_mouseclicks => FALSE
}
) )
->
{ name,
id,
doc,
#
object_callbacks,
widget_control_callbacks,
#
startup_fn,
shutdown_fn,
#
initialize_gadget_fn,
redraw_request_fn,
#
mouse_click_fn,
#
mouse_drag_fn,
mouse_transit_fn,
#
key_event_fn,
note_keyboard_focus_fn,
#
wants_keystrokes,
wants_mouseclicks
};
id = if (id_to_int(id) == 0) issue_unique_id(); # Allocate unique imp id.
else id;
fi;
fun object_start_fn
{ gadget_to_guiboss: gt::Gadget_To_Guiboss, #
object_to_objectspace: w2p::Object_To_Objectspace, #
run_gun': Run_Gun,
shutdown_oneshot: Oneshot_Maildrop( Void )
}
: gt::Object_Exports
=
{ reply_oneshot = make_oneshot_maildrop (): Oneshot_Maildrop( gt::Object_Exports );
#
xlogger::make_thread
name
(startup { id, # Note that startup() is curried.
doc,
reply_oneshot,
#
object_callbacks,
widget_control_callbacks,
startup_fn, # Pass in widget-specific args.
shutdown_fn, # Save state for possible widget restart.
#
initialize_gadget_fn,
redraw_request_fn,
#
mouse_click_fn,
#
mouse_drag_fn,
mouse_transit_fn,
#
key_event_fn,
note_keyboard_focus_fn,
#
wants_keystrokes,
wants_mouseclicks,
# These five args pass in the ports etc that guiboss-imp gave us.
gadget_to_guiboss, #
object_to_objectspace, #
run_gun',
shutdown_oneshot
# object_start_fn => gt::OBJECT_START_FN object_start_fn # OBSOLETE. Because we needed to put this in shutdown_oneshot at end of run.
}
);
(get_from_oneshot reply_oneshot); # Return gt::Object_Exports to guiboss-imp.
};
gt::OBJECT_START_FN object_start_fn; # The value-added is that we've locked in the values of *_fn etc, and guiboss-imp can be agnostic about their types.
};
fun pprint_object_arg
(pp: pp::Prettyprinter)
(object_arg: Object_Arg)
=
{
object_arg
->
( options: List(Object_Option)
);
pp.box {.
pp.txt " [";
pp::seqx {. pp.txt ", "; }
pprint_option
options
;
pp.txt " ]";
pp.txt " )";
};
}
where
fun pprint_option option
=
case option
#
MICROTHREAD_NAME name => { pp.lit (sprintf "MICROTHREAD_NAME \"%s\"" name); };
ID id => { pp.lit (sprintf "ID %d" (id_to_int id) ); };
DOC docstring => { pp.lit (sprintf "DOC \"%s\"" docstring ); };
#
WIDGET_CONTROL_CALLBACK _ => { pp.lit "WIDGET_CONTROL_CALLBACK (callback)"; };
OBJECT_CALLBACK _ => { pp.lit "OBJECT_CALLBACK (callback)"; };
#
STARTUP_FN _ => { pp.lit "STARTUP_FN _"; };
SHUTDOWN_FN _ => { pp.lit "SHUTDOWN_FN _"; };
#
INITIALIZE_GADGET_FN _ => { pp.lit "INITIALIZE_GADGET_FN _"; };
REDRAW_REQUEST_FN _ => { pp.lit "REDRAW_REQUEST_FN _"; };
#
MOUSE_CLICK_FN _ => { pp.lit "Mouse_Click_Fn _"; };
#
MOUSE_DRAG_FN _ => { pp.lit "MOUSE_DRAG_FN _"; };
MOUSE_TRANSIT_FN _ => { pp.lit "MOUSE_TRANSIT_FN _"; };
#
KEY_EVENT_FN _ => { pp.lit "KEY_EVENT_FN _"; };
NOTE_KEYBOARD_FOCUS_FN _ => { pp.lit "NOTE_KEYBOARD_FOCUS_FN _"; };
esac;
end;
};
end;